Code generating code generators.

Which is furthermore motivated by writing a code generator. It's code
generators all the way down!
This commit is contained in:
Kyle 2015-04-10 21:10:58 -07:00
parent bde35eb6b3
commit f115ab9ed5
2 changed files with 32 additions and 30 deletions

View File

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

View File

@ -15,7 +15,6 @@
#:mksymb #:mksymb
#:mkkw #:mkkw
#:defclass! #:defclass!
#:defconstructor
#:enable-hash-table-reader #:enable-hash-table-reader
#:hashkeys #:hashkeys
#:sethash #:sethash