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:
parent
bde35eb6b3
commit
f115ab9ed5
31
kutils.lisp
31
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
|
||||
(defclass ,name ,superclass
|
||||
,slots
|
||||
,docstring
|
||||
,@body))))
|
||||
|
||||
(defmacro defconstructor (class-name)
|
||||
(let* ((class (find-class class-name))
|
||||
(slot-list (when class
|
||||
(mapcar #'closer-mop:slot-definition-name
|
||||
(closer-mop:class-slots class)))))
|
||||
`(defun ,(mksymb "make-" class-name) (&key ,@slot-list)
|
||||
(make-instance ',class-name ,@(flatten (build-arg-list slot-list))))))
|
||||
`(progn
|
||||
(closer-mop:ensure-finalized
|
||||
(defclass ,name ,superclass
|
||||
,slots
|
||||
,docstring
|
||||
,@body))
|
||||
(let* ((class (find-class ',name))
|
||||
(slot-list (when class
|
||||
(mapcar #'closer-mop:slot-definition-name
|
||||
(closer-mop:class-slots class))))
|
||||
(class-name ',name))
|
||||
`(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.
|
||||
|
||||
|
|
31
package.lisp
31
package.lisp
|
@ -3,22 +3,21 @@
|
|||
(defpackage #:kutils
|
||||
(:use #:cl)
|
||||
(:export #:mkstr ; On Lisp utilities
|
||||
#:symb
|
||||
#:group
|
||||
#:flatten
|
||||
#:compose
|
||||
#:defmacro! ; Let Over Lambda utilities
|
||||
#:interpose ; My utilities
|
||||
#:build-list
|
||||
#:partial
|
||||
#:macroexpand-n
|
||||
#:mksymb
|
||||
#:mkkw
|
||||
#:defclass!
|
||||
#:defconstructor
|
||||
#:symb
|
||||
#:group
|
||||
#:flatten
|
||||
#:compose
|
||||
#:defmacro! ; Let Over Lambda utilities
|
||||
#:interpose ; My utilities
|
||||
#:build-list
|
||||
#:partial
|
||||
#:macroexpand-n
|
||||
#:mksymb
|
||||
#:mkkw
|
||||
#:defclass!
|
||||
#:enable-hash-table-reader
|
||||
#:hashkeys
|
||||
#:sethash
|
||||
#:sethash
|
||||
#:hash-table-to-alist
|
||||
#:alist-to-hash-table
|
||||
))
|
||||
#:alist-to-hash-table
|
||||
))
|
||||
|
|
Loading…
Reference in New Issue