From f4cbcfc5f0a0d2a8a6d98f77e17a735177bb913a Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Mon, 25 Jul 2022 20:52:39 -0700
Subject: 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).
---
 csc/loop.csc | 63 +++++++++++++++++++++++++++---------------------------------
 1 file 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* ...))
-- 
cgit v1.3.1