Pushed. Thanks for the patches!
On Tue, Jun 30, 2009 at 7:39 PM, Daniel Gackledanielgackle@gmail.com wrote:
I've extended PS-LOOP to allow CL-style explicit accumulation variables to be introduced by INTO. Two examples, followed by a patch, are below. (Side note: Lisp still surprises me from time to time. That this feature could be added with a net increase of only 3 lines of code is an indication of something.)
Daniel
(ps (loop for x from 1 to 10 sum x into total finally (alert total)))
=>
"var total = 0; for (var x = 1; x <= 10; x += 1) { total += x; }; alert(total);"
(ps (loop for x from 1 to 10 for y = (foo x) collect y into z collect x into z sum x into w sum y into w))
=>
"var z = []; var w = 0; for (var x = 1, y = foo(x); x <= 10; x += 1, y = foo(x)) { z.push(y); z.push(x); w += x; w += y; };"
From 293fc20445cd44731c82a845401a8c897c851f6d Mon Sep 17 00:00:00 2001 From: Daniel Gackle danielgackle@gmail.com Date: Tue, 30 Jun 2009 19:29:44 -0600 Subject: [PATCH] Extended PS-LOOP to allow explicit accumulation variables (declared by INTO as in "sum x into y").
src/lib/ps-loop.lisp | 37 ++++++++++++++++++++----------------- 1 files changed, 20 insertions(+), 17 deletions(-)
diff --git a/src/lib/ps-loop.lisp b/src/lib/ps-loop.lisp index 87d2d84..1003b5d 100644 --- a/src/lib/ps-loop.lisp +++ b/src/lib/ps-loop.lisp @@ -7,7 +7,7 @@
(defvar *loop-keywords* '(:for :do :when :unless :initially :finally :first-time :last-time :while :until - :from :to :below :downto :above :by :in :across :index := :then :sum :collect)) + :from :to :below :downto :above :by :in :across :index := :then :sum :collect :into))
(defun normalize-loop-keywords (args) (mapcar @@ -22,7 +22,7 @@ init-step-forms end-test-forms initially finally first-time last-time - accum-var accum-kind + default-accum-var default-accum-kind destructurings body) (macrolet ((with-local-var ((name expr) &body body) (once-only (expr) @@ -55,22 +55,25 @@ (when (next? term) (consume) (consume))) - (establish-accum-var (kind initial-val) - (if accum-var - (error "PS-LOOP encountered illegal ~a: a ~a was previously declared, and there can only be one accumulation per loop." kind accum-kind) - (progn - (setf accum-var (ps-gensym kind) - accum-kind kind) - (push `(var ,accum-var ,initial-val) prologue)))) + (accumulate (kind term var) + (when (null var) + (when (and default-accum-kind (not (eq kind default-accum-kind))) + (error "PS-LOOP encountered illegal ~a: ~a was already declared, and there can only be one kind of default accumulation per loop." kind default-accum-kind)) + (unless default-accum-var + (setf default-accum-var (ps-gensym kind) + default-accum-kind kind)) + (setf var default-accum-var)) + (let ((initial (case kind (:sum 0) (:collect '(array))))) + (pushnew `(var ,var ,initial) prologue :key #'second)) + (case kind + (:sum `(incf ,var ,term)) + (:collect `((@ ,var :push) ,term)))) (body-clause (term) (case term ((:when :unless) (list (intern (symbol-name term)) (consume) (body-clause (consume-atom)))) - (:sum (establish-accum-var :sum 0) - `(incf ,accum-var ,(consume))) - (:collect (establish-accum-var :collect '(array)) - `((@ ,accum-var :push) ,(consume))) + ((:sum :collect) (accumulate term (consume) (consume-if :into))) (:do (consume-progn)) (otherwise (err "a PS-LOOP keyword" term)))) (for-from (var) @@ -149,7 +152,7 @@ (nreverse finally) (nreverse first-time) (nreverse last-time) - accum-var + default-accum-var (add-destructurings-to-body))))))
(defpsmacro loop (&rest args) @@ -157,12 +160,12 @@ init-step-forms end-test initially finally first-time last-time - accum-var + default-accum-var body) (parse-ps-loop (normalize-loop-keywords args)) (let ((first-guard (and first-time (ps-gensym))) (last-guard (and last-time (ps-gensym)))) - `(,@(if accum-var '(with-lambda ()) '(progn)) + `(,@(if default-accum-var '(with-lambda ()) '(progn)) ,@(when first-time `((var ,first-guard t))) ,@(when last-time `((var ,last-guard nil))) ,@prologue @@ -178,4 +181,4 @@ `((setf ,last-guard t)))) ,@(when last-time `((when ,last-guard ,@last-time))) ,@finally - ,@(when accum-var `((return ,accum-var)))))))
+ ,@(when default-accum-var `((return ,default-accum-var)))))))
1.6.1
parenscript-devel mailing list parenscript-devel@common-lisp.net http://common-lisp.net/cgi-bin/mailman/listinfo/parenscript-devel