From d9b08fe9a96840078f1edddf01801d394148b50a Mon Sep 17 00:00:00 2001 From: Alex Klinkhamer Date: Tue, 24 Jun 2008 11:38:55 -0400 Subject: [PATCH] Modified the tails-do* macro. Now allows declarations, and an explicitly declared value for the first accumulated element. --- src/overload/concatenate.lisp | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/src/overload/concatenate.lisp b/src/overload/concatenate.lisp index 251ba67..5cc3400 100644 --- a/src/overload/concatenate.lisp +++ b/src/overload/concatenate.lisp @@ -23,9 +23,16 @@ (end-loop-tag (gensym)) pre-inits post-inits do-setqs tail-setqs - s-conditail-setqs) + s-conditail-setqs + s-declarations + var-init-p) (loop :for (v a ta condit) :in tails-args + ;V See if /v/ has an initial value.V + :for init-v = (when (consp v) + (setq var-init-p t) + (prog1 (cadr v) + (setq v (car v)))) ;V Find if the tail should be V ;V initialized as something. V :for tadef = @@ -61,7 +68,7 @@ (list v nil))) ;V Collect variables and initializations V ;V to be used in the outer let form. V - :collect v :into vlist + :collect (if init-v (list v init-v) v) :into vlist :when a :collect (if adef (list a adef) a) :into vlist :collect (if tadef (list ta tadef) ta) :into vlist @@ -91,9 +98,16 @@ :and :collect a :into alist :finally (nconc pre-inits vlist) (setq do-setqs alist)) + (loop :while (and (consp (car s-proc)) + (eq 'declare (caar s-proc))) + :collect (pop s-proc) :into decl + :finally (setq s-declarations decl)) `(let* (,@pre-inits);< All variable initializations. + ,@s-declarations (unless ,s-pred - ,@s-proc;< Run inner loop. + ;V Run loop contents here only if the first V + ;V value to accumulate is not specified. V + ,@(unless var-init-p s-proc) ;V Give all tails a value if they don't have one, V (setq ,@post-inits);< update some nil lists too. (tagbody -- 2.11.4.GIT