[parenscript-devel] Patch: ps loop now supports :ON type of iteration over lists

[Vladimir Sedach]

Pushed.

On Fri, Jul 10, 2009 at 8:30 PM, Daniel Gackle<danielgackle at gmail.com> wrote:
> Two examples followed by patch. Note that I haven't added any functions for
> #'cdr, #'cddr etc. (it's arguable whether those belong in PS proper, since
> the mapping of Lisp lists to JS arrays is only partly satisfactory), so if
> you want to write stuff like "(ps (loop for (a b) on list by #'cddr))", you
> can, but you have to define your own #'cddr.
>
> Dan
>
> (ps (loop for (a b) on y do (blah a b)))
> =>
> "for (var _js46 = y; !(_js46 == null || _js46.length == 0); _js46 =
> _js46.slice(1)) {
>     var a = _js46[0];
>     var b = _js46[1];
>     blah(a, b);
> };"
>
> (ps (loop for (a b . c) on list by somefn do (blah a b c)))
> =>
> "for (var _js48 = list; !(_js48 == null || _js48.length == 0); _js48 =
> somefn(_js48)) {
>     var a = _js48[0];
>     var b = _js48[1];
>     var c = _js48.length > 2 ? slice(_js48, 2) : null;
>     blah(a, b, c);
> };"
>
> From 4122fd1552b35f9bc46d723cf1651fdc8cf20748 Mon Sep 17 00:00:00 2001
> From: Daniel Gackle <danielgackle at gmail.com>
> Date: Fri, 10 Jul 2009 19:17:39 -0600
> Subject: [PATCH 2/2] PS LOOP now supports ON.
>
> ---
>  src/lib/ps-loop.lisp |   22 +++++++++++++++++++---
>  1 files changed, 19 insertions(+), 3 deletions(-)
>
> diff --git a/src/lib/ps-loop.lisp b/src/lib/ps-loop.lisp
> index 0e20c9c..c7334fa 100644
> --- a/src/lib/ps-loop.lisp
> +++ b/src/lib/ps-loop.lisp
> @@ -2,12 +2,13 @@
>
>  (defun complex-js-expr? (expr)
>    (if (symbolp expr)
> -      (find #\. (symbol-name expr))
> +      (or (find #\. (symbol-name expr))
> +          (not (eq (ps-macroexpand expr) expr)))
>        (consp expr)))
>
>  (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 :on :index := :then
> :sum :collect
>      :count :minimize :maximize :into))
>
>  (defun normalize-loop-keywords (args)
> @@ -18,6 +19,11 @@
>           x))
>     args))
>
> +(defun reduce-function-symbol (sym)
> +  (if (and (consp sym) (eq 'function (first sym)))
> +      (second sym)
> +      sym))
> +
>  (defun parse-ps-loop (terms)
>    (let (prologue
>          init-step-forms end-test-forms
> @@ -115,6 +121,15 @@
>                       (setf terms (append equiv terms))
>                       (clause)
>                       (clause))))
> +               (for-on (var)
> +                 (with-local-var (arr (consume))
> +                   (push `(or (null ,var) (= (length ,var) 0))
> end-test-forms)
> +                   (let* ((by (aif (consume-if :by)
> +                                   `(,(reduce-function-symbol it) ,var)
> +                                   `((@ ,var :slice) 1)))
> +                          (equiv `(:for ,var := ,arr :then ,by)))
> +                     (setf terms (append equiv terms))
> +                     (clause))))
>                 (for-clause ()
>                   (let* ((place (consume))
>                          (var (when (atom place) place))
> @@ -122,13 +137,14 @@
>                          (term (consume-atom)))
>                     (when varlist
>                       (when (eq term :from)
> -                       (err "an atom after FROM" varlist))
> +                       (err "an atom after FOR" varlist))
>                       (setf var (ps-gensym))
>                       (push (list varlist var) destructurings))
>                     (case term
>                       (:from (for-from var))
>                       (:= (for-= var))
>                       ((:in :across) (for-in var))
> +                     (:on (for-on var))
>                       (otherwise (error "FOR ~s ~s is not valid in PS-LOOP."
> var term)))))
>                 (clause ()
>                   (let ((term (consume-atom)))
> --
> 1.6.1
>
>
>
> _______________________________________________
> parenscript-devel mailing list
> parenscript-devel at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/parenscript-devel
>
>