fix with-macro definer when passing values from the with-macro body to the user body
Wed Feb 25 09:28:19 PST 2009 attila.lendvai@gmail.com
* fix with-macro definer when passing values from the with-macro body to the user body
Warning: CRC errors found. These are probably harmless but should be repaired.
See 'darcs gzcrcs --help' for more information.
diff -rN -u old-cl-def/definers.lisp new-cl-def/definers.lisp
--- old-cl-def/definers.lisp 2014-08-01 21:36:03.000000000 -0700
+++ new-cl-def/definers.lisp 2014-08-01 21:36:03.000000000 -0700
@@ -277,23 +277,25 @@
(setf inner-arguments nil))
(bind ((args-to-remove-from-fn ())
(fn-args args)
- (processed-inner-arguments
- (mapcar (lambda (el)
- (if (consp el)
- (progn
- (unless (and (length= 2 el)
- (notany (lambda (part)
- (or (not (symbolp part))
- (not (symbolp part))
- (member part '(&rest &optional &key &allow-other-keys))))
- el))
- (error "The arguemnts used to invoke (-body- foo1 foo2) may only contain symbols, or (with-macro-body-name lexically-visible-name) pairs denoting variables that are \"transferred\" from the call site in the with-macro into the lexical scope of the user provided body."))
- (push (second el) args-to-remove-from-fn)
- el)
- (list el `(quote ,el))))
- inner-arguments)))
- (bind ((inner-arguments/macro-body (mapcar (compose #'first #'ensure-list) processed-inner-arguments))
- (inner-arguments/fn-body (mapcar #'second processed-inner-arguments)))
+ (inner-arguments/macro-body ())
+ (inner-arguments/fn-body ()))
+ (dolist (el inner-arguments)
+ (if (consp el)
+ (progn
+ (unless (and (length= 2 el)
+ (notany (lambda (part)
+ (or (not (symbolp part))
+ (not (symbolp part))
+ (member part '(&rest &optional &key &allow-other-keys))))
+ el))
+ (error "The arguemnts used to invoke (-body- foo1 foo2) may only contain symbols, or (with-macro-body-name lexically-visible-name) pairs denoting variables that are \"transferred\" from the call site in the with-macro into the lexical scope of the user provided body."))
+ (push (second el) args-to-remove-from-fn)
+ (push (first el) inner-arguments/macro-body)
+ (push (second el) inner-arguments/fn-body))
+ (progn
+ (push el inner-arguments/macro-body)
+ (push el inner-arguments/fn-body))))
+ (bind ()
(dolist (arg args-to-remove-from-fn)
(removef fn-args arg))
(bind (((:values funcall-list rest-variable-name) (lambda-list-to-funcall-list fn-args))
@@ -315,7 +317,7 @@
(list macro-args))))
&body ,with-body)
`(,',call-funcion-name
- (named-lambda ,',body-fn-name ,(list ,@inner-arguments/fn-body)
+ (named-lambda ,',body-fn-name ,',inner-arguments/fn-body
,@,with-body)
,,@funcall-list
,@,rest-variable-name)))))))))))