Make result of DEFINE-MODIFY-MACRO available at compilation time.

Thanks to Cyrus Harmon.

Fixes <http://abcl.org/trac/ticket/368> in support of not needing the
ugliness of
<https://github.com/easye/cffi/commit/03624e609cd48cc065bd15c8dcea715f287b6bbc>.
parent 0f25d9b5
......@@ -61,21 +61,22 @@
(push (car arg) other-args))
(t (error "Illegal stuff in DEFINE-MODIFY-MACRO lambda list."))))
(setq other-args (nreverse other-args))
`(defmacro ,name (,reference ,@lambda-list &environment ,env)
,doc-string
(multiple-value-bind (dummies vals newval setter getter)
(get-setf-expansion ,reference ,env)
(do ((d dummies (cdr d))
(v vals (cdr v))
(let-list nil (cons (list (car d) (car v)) let-list)))
((null d)
(push (list (car newval)
,(if rest-arg
`(list* ',function getter ,@other-args ,rest-arg)
`(list ',function getter ,@other-args)))
let-list)
`(let* ,(nreverse let-list)
,setter)))))))
`(eval-when (:compile-toplevel :load-toplevel :execute)
(defmacro ,name (,reference ,@lambda-list &environment ,env)
,doc-string
(multiple-value-bind (dummies vals newval setter getter)
(get-setf-expansion ,reference ,env)
(do ((d dummies (cdr d))
(v vals (cdr v))
(let-list nil (cons (list (car d) (car v)) let-list)))
((null d)
(push (list (car newval)
,(if rest-arg
`(list* ',function getter ,@other-args ,rest-arg)
`(list ',function getter ,@other-args)))
let-list)
`(let* ,(nreverse let-list)
,setter))))))))
(define-modify-macro incf-complex (&optional (delta 1)) +
"The first argument is some location holding a number. This number is
......
......@@ -41,7 +41,7 @@
(parse-defmacro lambda-list whole body access-fn
'define-setf-expander
:environment environment)
`(progn
`(eval-when (:compile-toplevel :load-toplevel :execute)
,@(when doc
`((%set-documentation ',access-fn 'setf ,doc)))
(setf (get ',access-fn 'setf-expander)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment