Slightly improve loop.

The advantage to this approach is that the user can modify the loop
variables and the variables will be stepped as expected, e.g.
(loop for i from 1 to 10
      do (set! i (+ 1 i))
      collect i)
should return '(2 4 6 8 10).

1 files changed, 28 insertions, 35 deletions

diff --git a/csc/loop.csc b/csc/loop.csc
index 69f9201..f07deae 100644
--- a/csc/loop.csc
+++ b/csc/loop.csc
@@ -35,7 +35,8 @@
         ((loop loop-clauses* ...)
           (let ((list-acc '())
                 (number-acc 0)
-                (acc-last #f))
+                (acc-last #f)
+                (first #t))
             (letrec-syntax
               ((loop-aux
                 (... (syntax-rules (= above across and append below by collect count do downfrom downto else end finally for from if in into maximize minimize on return sum then to unless until when while with)
@@ -59,24 +60,20 @@
                                       fin)
                                      clause* ...)))
                        ((loop-aux "variable-clause-collector" ((body ...) fin) for x on l clause* ...)
-                         (let* ((x l)
-                                (next x))
+                         (let* ((x l))
                            (loop-aux "variable-clause-collector"
-                                     ((body ... (set! x next)
+                                     ((body ... (unless first
+                                                  (set! x (cdr x)))
                                                 (unless (pair? x)
-                                                  (raise *loop-termination*))
-                                                (set! next (cdr x)))
+                                                  (raise *loop-termination*)))
                                       fin)
                                      clause* ...)))
                        ((loop-aux "variable-clause-collector" ((body ...) fin) for x = init then subseq clause* ...)
-                         (let ((first #t)
-                               (init-value (lambda () init)) ; put the body of init outside the scope of x.
+                         (let ((init-value (lambda () init)) ; put the body of init outside the scope of x.
                                (x #f))
                            (loop-aux "variable-clause-collector"
                                      ((body ... (if first
-                                                  (begin
-                                                    (set! first #f)
-                                                    (set! x (init-value)))
+                                                  (set! x (init-value))
                                                   (set! x subseq)))
                                       fin)
                                      clause* ...)))
@@ -100,49 +97,45 @@
                        ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start to last by inc clause* ...)
                          (let* ((last* last)
                                 (inc* inc)
-                                (x start)
-                                (next x))
+                                (x start))
                            (loop-aux "variable-clause-collector"
-                                     ((body ... (set! x next)
+                                     ((body ... (unless first
+                                                  (set! x (+ x inc*)))
                                                 (unless (<= x last*)
-                                                  (raise *loop-termination*))
-                                                (set! next (+ x inc*)))
+                                                  (raise *loop-termination*)))
                                       fin)
                                      clause* ...)))
                        ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start downto last by inc clause* ...)
                          (let* ((last* last)
                                 (inc* inc)
-                                (x start)
-                                (next x))
+                                (x start))
                            (loop-aux "variable-clause-collector"
-                                     ((body ... (set! x next)
+                                     ((body ... (unless first
+                                                  (set! x (+ x inc*)))
                                                 (unless (>= x last*)
-                                                  (raise *loop-termination*))
-                                                (set! next (+ x inc*)))
+                                                  (raise *loop-termination*)))
                                       fin)
                                      clause* ...)))
                        ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start below last by inc clause* ...)
                          (let* ((last* last)
                                 (inc* inc)
-                                (x start)
-                                (next x))
+                                (x start))
                            (loop-aux "variable-clause-collector"
-                                     ((body ... (set! x next)
+                                     ((body ... (unless first
+                                                  (set! x (+ x inc*)))
                                                 (unless (< x last*)
-                                                  (raise *loop-termination*))
-                                                (set! next (+ x inc*)))
+                                                  (raise *loop-termination*)))
                                       fin)
                                      clause* ...)))
                        ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start above last by inc clause* ...)
                          (let* ((last* last)
                                 (inc* inc)
-                                (x start)
-                                (next x))
+                                (x start))
                            (loop-aux "variable-clause-collector"
-                                     ((body ... (set! x next)
+                                     ((body ... (unless first
+                                                  (set! x (+ x inc)))
                                                 (unless (> x last*)
-                                                  (raise *loop-termination*))
-                                                (set! next (+ x inc)))
+                                                  (raise *loop-termination*)))
                                       fin)
                                      clause* ...)))
                        ((loop-aux "variable-clause-collector" args for x clause* ...)
@@ -193,11 +186,10 @@
                          (loop-aux "for-reordering" args for x from-clause to-clause 1 stepping clause* ...))
                        ((loop-aux "for-reordering" ((body ...) fin) for x start #f inc stepping clause* ...)
                          (let* ((inc* inc)
-                                (x start)
-                                (next x))
+                                (x start))
                            (loop-aux "variable-clause-collector"
-                                     ((body ... (set! x next)
-                                                (set! next (+ x inc*)))
+                                     ((body ... (unless first
+                                                  (set! x (+ x inc*))))
                                       fin)
                                      clause* ...)))
                        ; The word `to' is ambiguous as to which stepping, so replace to with downto if stepping is -1.
@@ -244,6 +236,7 @@
                          (let loop-name ()
                            (guard (e ((loop-termination? e) fin ...))
                              body ...
+                             (set! first #f)
                              (loop-name))))
                        ((loop-aux "unconditional" continuation (compound ...) do (form1 form1* ...) (form2 form2* ...) clause* ...)
                          (loop-aux "unconditional" continuation (compound ... (form1 form1* ...)) do (form2 form2* ...) clause* ...))