&rest support for with-macro
Sun Dec 7 07:30:04 PST 2008 attila.lendvai@gmail.com
* &rest support for with-macro
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-07-31 18:45:47.000000000 -0700
+++ new-cl-def/definers.lisp 2014-07-31 18:45:47.000000000 -0700
@@ -292,26 +292,29 @@
(inner-arguments/fn-body (mapcar #'second processed-inner-arguments)))
(dolist (arg args-to-remove-from-fn)
(removef fn-args arg))
- `(progn
- (defun ,call-funcion-name (,fn ,@fn-args)
- (declare (type function ,fn))
- ,@(function-like-definer-declarations -options-)
- (flet ((-body- (,@inner-arguments/macro-body)
- (funcall ,fn ,@inner-arguments/macro-body)))
- (declare (inline -body-))
- (block ,name
- ,@body)))
- (defmacro ,name (,@(when (or args must-have-args)
- (bind ((macro-args (lambda-list-to-lambda-list-with-quoted-defaults
- args)))
- (if flat
- macro-args
- (list macro-args))))
- &body ,with-body)
- `(,',call-funcion-name
- (named-lambda ,',(format-symbol *package* "~A-BODY" name) ,(list ,@inner-arguments/fn-body)
- ,@,with-body)
- ,,@(lambda-list-to-funcall-list fn-args)))))))))))
+ (bind (((:values funcall-list rest-variable-name) (lambda-list-to-funcall-list fn-args))
+ (body-fn-name (format-symbol *package* "~A-BODY" name)))
+ `(progn
+ (defun ,call-funcion-name (,fn ,@fn-args)
+ (declare (type function ,fn))
+ ,@(function-like-definer-declarations -options-)
+ (flet ((-body- (,@inner-arguments/macro-body)
+ (funcall ,fn ,@inner-arguments/macro-body)))
+ (declare (inline -body-))
+ (block ,name
+ ,@body)))
+ (defmacro ,name (,@(when (or args must-have-args)
+ (bind ((macro-args (lambda-list-to-lambda-list-with-quoted-defaults
+ args)))
+ (if flat
+ macro-args
+ (list macro-args))))
+ &body ,with-body)
+ `(,',call-funcion-name
+ (named-lambda ,',body-fn-name ,(list ,@inner-arguments/fn-body)
+ ,@,with-body)
+ ,,@funcall-list
+ ,@,rest-variable-name)))))))))))
(def (definer e :available-flags "eo") with-macro (name args &body body)
"(def with-macro with-foo (arg1 arg2)
diff -rN -u old-cl-def/duplicates.lisp new-cl-def/duplicates.lisp
--- old-cl-def/duplicates.lisp 2014-07-31 18:45:47.000000000 -0700
+++ new-cl-def/duplicates.lisp 2014-07-31 18:45:47.000000000 -0700
@@ -257,8 +257,9 @@
(declare (ignore entry default))
(case kind
(&key
- (push external-name result)
- (push name result))
+ (unless rest-variable-name
+ (push external-name result)
+ (push name result)))
(&allow-other-keys)
(&rest (setf rest-variable-name name))
(t (push name result)))))
@@ -284,8 +285,10 @@
((nil) (push name primaries)))))
(values `(,@(nreverse primaries)
,@(when optionals (cons '&optional (nreverse optionals)))
- ,@(when keywords (cons '&key (nreverse keywords)))
- ,@(when allow-other-keys? (list '&allow-other-keys)))
+ ,@(if rest-variable-name
+ `(&rest ,rest-variable-name)
+ (when keywords (cons '&key (nreverse keywords))))
+ ,@(when (and allow-other-keys? (not rest-variable-name)) (list '&allow-other-keys)))
rest-variable-name)))
;; from dwim-utils