Add defconstructor.
This commit is contained in:
parent
35888b9b26
commit
addde28629
|
@ -5,6 +5,7 @@
|
||||||
:author "K. Isom <kyle@metacircular.net>"
|
:author "K. Isom <kyle@metacircular.net>"
|
||||||
:license "MIT License"
|
:license "MIT License"
|
||||||
:serial t
|
:serial t
|
||||||
|
:depends-on (#:closer-mop)
|
||||||
:components ((:file "package")
|
:components ((:file "package")
|
||||||
(:file "on")
|
(:file "on")
|
||||||
(:file "lol")
|
(:file "lol")
|
||||||
|
|
17
kutils.lisp
17
kutils.lisp
|
@ -75,11 +75,18 @@ additional args provided to the lambda."
|
||||||
'()
|
'()
|
||||||
(apply #'build-slot-list name slots)))
|
(apply #'build-slot-list name slots)))
|
||||||
(args (build-arg-list slots)))
|
(args (build-arg-list slots)))
|
||||||
`(progn
|
`(defclass ,name ,superclass
|
||||||
(defclass ,name ,superclass
|
,slots
|
||||||
,slots
|
,docstring
|
||||||
,docstring
|
,@body)))
|
||||||
,@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))))))
|
||||||
|
|
||||||
;;; hash-table functions.
|
;;; hash-table functions.
|
||||||
|
|
||||||
|
|
|
@ -15,6 +15,7 @@
|
||||||
#:mksymb
|
#:mksymb
|
||||||
#:mkkw
|
#:mkkw
|
||||||
#:defclass!
|
#:defclass!
|
||||||
|
#:defconstructor
|
||||||
#:enable-hash-table-reader
|
#:enable-hash-table-reader
|
||||||
#:hashkeys
|
#:hashkeys
|
||||||
#:sethash
|
#:sethash
|
||||||
|
|
Loading…
Reference in New Issue