Code generating code generators.

Which is furthermore motivated by writing a code generator. It's code
generators all the way down!

kutils.lisp

@@ -20,8 +20,8 @@ of the list."
 arg. If it's a vector, coerce it to a list. Otherwise, return nil."
   (cond
     ((listp   arg) (copy-list arg))
-    ((atom    arg) (list arg))
     ((vectorp arg) (coerce arg 'list))
+    ((atom    arg) (list arg))
     (t nil)))
 
 (defun partial (fn &rest initial-args)
@@ -76,19 +76,22 @@ additional args provided to the lambda."
 	 (slots (if (null slots)
 		    '()
 		    (apply #'build-slot-list name slots))))
-    `(closer-mop:ensure-finalized
+    `(progn
-      (defclass ,name ,superclass
+       (closer-mop:ensure-finalized
-	,slots
+	(defclass ,name ,superclass
-	,docstring
+	  ,slots
-	,@body))))
+	  ,docstring
-
+	  ,@body))
-(defmacro defconstructor (class-name)
+       (let* ((class     (find-class ',name))
-  (let* ((class     (find-class class-name))
+	      (slot-list (when class
-	 (slot-list (when class
+			   (mapcar #'closer-mop:slot-definition-name 
-		      (mapcar #'closer-mop:slot-definition-name 
+				   (closer-mop:class-slots class))))
-			      (closer-mop:class-slots class)))))
+	      (class-name ',name))
-    `(defun ,(mksymb "make-" class-name) (&key ,@slot-list)
+	 `(defun ,(kutils:mksymb "make-" (quote class-name))
-       (make-instance ',class-name ,@(flatten (build-arg-list slot-list))))))
+	      (cons '&key slot-list)
+	    (make-instance (quote ,class-name)
+			   ,@(kutils:flatten
+			      (build-arg-list slot-list))))))))
 
 ;;; hash-table functions.
 

package.lisp

@@ -3,22 +3,21 @@
 (defpackage #:kutils
   (:use #:cl)
   (:export #:mkstr     ; On Lisp utilities
-	   #:symb
+           #:symb
-	   #:group
+           #:group
-	   #:flatten
+           #:flatten
-	   #:compose
+           #:compose
-	   #:defmacro! ; Let Over Lambda utilities
+           #:defmacro! ; Let Over Lambda utilities
-	   #:interpose ; My utilities
+           #:interpose ; My utilities
-	   #:build-list
+           #:build-list
-	   #:partial
+           #:partial
-	   #:macroexpand-n
+           #:macroexpand-n
-	   #:mksymb
+           #:mksymb
-	   #:mkkw
+           #:mkkw
-	   #:defclass!
+           #:defclass!
-	   #:defconstructor
            #:enable-hash-table-reader
            #:hashkeys
-	   #:sethash
+           #:sethash
            #:hash-table-to-alist
-	   #:alist-to-hash-table
+           #:alist-to-hash-table
-	   ))
+           ))