Re: Sbcl-help Digest, Vol 206, Issue 14

I have never seen this interface before, wow.

If you are having problems naming functions from parameters I offer some code.

I have some more, let me know.

(defvar *file-prefix*)

(defun mapnconcat (fn sequences seperator)
  "Like MAPCONCAT but the function is desctuctive."
  (let ((seperator-length 0)
        (total 0) (times -1) result)
	(declare (fixnum seperator-length total times))
    (unless (eq fn #'identity)
      (map-into sequences fn sequences))
	(setq seperator-length (the fixnum (length seperator)))
    (dolist (seq sequences)
      (incf times) (incf total (+ (length seq) seperator-length)))
    (setq result (make-string (- total seperator-length)))
    (let ((pos -1)) (declare (fixnum pos))
      (loop repeat times do
               (let ((seq (pop sequences)))
                 (loop for i across seq do
                          (setf (schar result (incf pos)) i))
                 (loop for i across seperator do
                          (setf (aref result (incf pos)) i))))
      (loop for i across (car sequences) do
               (setf (schar result (incf pos)) i)))
    result))

(defun mapconcat (fn sequences seperator)
  "Applies <FN> to each element of <SEQUENCES>; the results, which
must be sequences of characters (strings, vectors, or lists), are
concatenated into a single string return value. Between each pair of
result sequences, <mapconcat> inserts the characters from <SEPARATOR>,
which also must be a string, or a vector or list of characters."
  (if (eq fn #'identity)
      (mapnconcat fn sequences seperator)
      (let ((result ""))
        (dolist (seq (cdr sequences))
          (setq result
                (concatenate 'string
                             result seperator (funcall fn seq))))
        (concatenate 'string (funcall fn (car sequences)) result))))

(defun flatten (l &optional res)
  (if (consp l)
      (flatten (car l)
               (flatten (cdr l) res))
      (cons l res)))

(defun generate-flattened-rule-name (pattern)
  "Transform <pattern> list into a readable name. Ex (on ?x ? ?y ?z) => ON-?X-?-?Y-?Z ."
  (mapconcat #'symbol-name (flatten pattern) "-"))

(defun generate-rule-procedure-name (pattern suffix)
  "Generate a readable and informative function name."
  ;; pattern: (ON ?Y ?X) suffix: "MATCHER"
  (when (or (null *file-prefix*) (string= "" *file-prefix*))
    (warn "*file-prefix* is unset, use RULE-FILE!")
    (setq *file-prefix* "REPL"))
  ;; the format control string upper cases the symbol
  (intern (format nil "~:@(~a-~a-~a/~d~)" *file-prefix*
				  (generate-flattened-rule-name pattern) suffix
				  ;; this is for the arity
				  (1- (length pattern)))))