[parenscript-devel] Added count, minimize, and maximize to ps-loop

[Vladimir Sedach]

Pushed.

On Tue, Jun 30, 2009 at 7:56 PM, Daniel Gackle<danielgackle at gmail.com> wrote:
> 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 at 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
>
>
>
> _______________________________________________
> parenscript-devel mailing list
> parenscript-devel at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/parenscript-devel
>
>