Cleanup defclass!, interpose.
This commit is contained in:
parent
addde28629
commit
5904cf167c
20
kutils.lisp
20
kutils.lisp
|
@ -9,9 +9,11 @@
|
||||||
(defun interpose (x sep)
|
(defun interpose (x sep)
|
||||||
"Takes a list and a separator, and places separator between element
|
"Takes a list and a separator, and places separator between element
|
||||||
of the list."
|
of the list."
|
||||||
(mapcar (lambda (y)
|
(let ((x (coerce x 'list)))
|
||||||
(list y sep))
|
(apply #'append
|
||||||
x))
|
(mapcar (lambda (y)
|
||||||
|
(list y sep))
|
||||||
|
x))))
|
||||||
|
|
||||||
(defun build-list (arg)
|
(defun build-list (arg)
|
||||||
"If arg is an atom, return it as a list. If it's a list, return the
|
"If arg is an atom, return it as a list. If it's a list, return the
|
||||||
|
@ -73,12 +75,12 @@ additional args provided to the lambda."
|
||||||
(body (if docstring (rest body) body))
|
(body (if docstring (rest body) body))
|
||||||
(slots (if (null slots)
|
(slots (if (null slots)
|
||||||
'()
|
'()
|
||||||
(apply #'build-slot-list name slots)))
|
(apply #'build-slot-list name slots))))
|
||||||
(args (build-arg-list slots)))
|
`(closer-mop:ensure-finalized
|
||||||
`(defclass ,name ,superclass
|
(defclass ,name ,superclass
|
||||||
,slots
|
,slots
|
||||||
,docstring
|
,docstring
|
||||||
,@body)))
|
,@body))))
|
||||||
|
|
||||||
(defmacro defconstructor (class-name)
|
(defmacro defconstructor (class-name)
|
||||||
(let* ((class (find-class class-name))
|
(let* ((class (find-class class-name))
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
#:flatten
|
#:flatten
|
||||||
#:compose
|
#:compose
|
||||||
#:defmacro! ; Let Over Lambda utilities
|
#:defmacro! ; Let Over Lambda utilities
|
||||||
#:join ; My utilities
|
#:interpose ; My utilities
|
||||||
#:build-list
|
#:build-list
|
||||||
#:partial
|
#:partial
|
||||||
#:macroexpand-n
|
#:macroexpand-n
|
||||||
|
|
Loading…
Reference in New Issue