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

[Daniel Gackle]

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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/parenscript-devel/attachments/20090710/ce882892/attachment.html>