I've added count, minimize, and maximize to ps-loop. Examples and patch
follow.
Daniel
(ps (loop for x from 1 to 10 count x into c))
=>
"var c = 0;
for (var x = 1; x <= 10; x += 1) {
++c;
};"
(ps (loop for x from 1 to 10 minimize x into y maximize x into z))
=>
"var y = null;
var z = null;
for (var x = 1; x <= 10; x += 1) {
y = y == null ? x : Math.min(y, x);
z = z == null ? x : Math.max(z, x);
};"
>From ee44a1647b9289c50c5fe1f2bc62c569aa0c990e Mon Sep 17 00:00:00 2001
From: Daniel Gackle <danielgackle(a)gmail.com>
Date: Tue, 30 Jun 2009 19:52:12 -0600
Subject: [PATCH] Added support for COUNT, MINIMIZE and MAXIMIZE to PS-LOOP.
---
src/lib/ps-loop.lisp | 18 ++++++++++++++----
1 files changed, 14 insertions(+), 4 deletions(-)
diff --git a/src/lib/ps-loop.lisp b/src/lib/ps-loop.lisp
index 1003b5d..0e20c9c 100644
--- a/src/lib/ps-loop.lisp
+++ b/src/lib/ps-loop.lisp
@@ -7,7 +7,8 @@
(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 :into))
+ :from :to :below :downto :above :by :in :across :index := :then :sum
:collect
+ :count :minimize :maximize :into))
(defun normalize-loop-keywords (args)
(mapcar
@@ -60,20 +61,29 @@
(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)
+ (setf default-accum-var (ps-gensym (case kind
+ (:minimize 'min)
+ (:maximize 'max)
+ (t kind)))
default-accum-kind kind))
(setf var default-accum-var))
- (let ((initial (case kind (:sum 0) (:collect '(array)))))
+ (let ((initial (case kind
+ ((:sum :count) 0)
+ ((:maximize :minimize) nil)
+ (:collect '(array)))))
(pushnew `(var ,var ,initial) prologue :key #'second))
(case kind
(:sum `(incf ,var ,term))
+ (:count `(incf ,var))
+ (:minimize `(setf ,var (if (null ,var) ,term (min ,var
,term))))
+ (:maximize `(setf ,var (if (null ,var) ,term (max ,var
,term))))
(:collect `((@ ,var :push) ,term))))
(body-clause (term)
(case term
((:when :unless) (list (intern (symbol-name term))
(consume)
(body-clause (consume-atom))))
- ((:sum :collect) (accumulate term (consume) (consume-if
:into)))
+ ((:sum :collect :count :minimize :maximize) (accumulate
term (consume) (consume-if :into)))
(:do (consume-progn))
(otherwise (err "a PS-LOOP keyword" term))))
(for-from (var)
--
1.6.1
