Improve the loop macro collect statement.

Now you can use multiple collect statements and they will all accumulate
into the same variable. I think in common lisp you could collect into
the same variable even with collect x into, but it's pretty unclear to
me how to do that in Scheme. How would we know that they are the
same variable?

1 files changed, 393 insertions, 381 deletions

diff --git a/csc/loop.csc b/csc/loop.csc
index ffe0f3f..10e634b 100644
--- a/csc/loop.csc
+++ b/csc/loop.csc
@@ -26,389 +26,401 @@
       loop-termination?)
 
 
-    (define-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)
-        ((loop-aux "variable-clause-collector" args with x = expr and clause* ...)
-          (loop-aux "and-collector" args ((x expr)) and clause* ...))
-        ((loop-aux "variable-clause-collector" args with x = expr clause* ...)
-          (let ((x expr))
-            (loop-aux "variable-clause-collector" args clause* ...)))
-        ((loop-aux "variable-clause-collector" (body (fin ...)) finally (form1 form1* ...) (form2 form2* ...) clause* ...)
-          (loop-aux "variable-clause-collector" (body (fin ... (form1 form1* ...))) finally (form2 form2* ...) clause* ...))
-        ((loop-aux "variable-clause-collector" (body (fin ...)) finally (form form* ...) clause* ...)
-          (loop-aux "variable-clause-collector" (body (fin ... (form form* ...))) clause* ...))
-        ((loop-aux "variable-clause-collector" ((body ...) fin) for x in l clause* ...)
-          (let ((temp l)
-                (x #f))
-            (loop-aux "variable-clause-collector"
-                      ((body ... (when (null? temp)
-                                   (raise (make-loop-termination)))
-                                 (set! x (car temp))
-                                 (set! temp (cdr temp)))
-                       fin)
-                      clause* ...)))
-        ((loop-aux "variable-clause-collector" ((body ...) fin) for x on l clause* ...)
-          (let* ((x l)
-                 (next x))
-            (loop-aux "variable-clause-collector"
-                      ((body ... (set! x next)
-                                 (unless (pair? x)
-                                   (raise (make-loop-termination)))
-                                 (set! next (cdr x)))
-                       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.
-                (x #f))
-            (loop-aux "variable-clause-collector"
-                      ((body ... (if first
-                                   (begin
-                                     (set! first #f)
-                                     (set! x (init-value)))
-                                   (set! x subseq)))
-                       fin)
-                      clause* ...)))
-        ((loop-aux "variable-clause-collector" ((body ...) fin) for x = init clause* ...)
-          (let ((x #f))
-            (loop-aux "variable-clause-collector"
-                      ((body ... (set! x init))
-                       fin)
-                      clause* ...)))
-        ((loop-aux "variable-clause-collector" ((body ...) fin) for x across v clause* ...)
-          (let ((temp v)
-                (i 0)
-                (x #f))
-            (loop-aux "variable-clause-collector"
-                      ((body ... (unless (< i (vector-length temp))
-                                   (raise (make-loop-termination)))
-                                 (set! x (vector-ref temp i))
-                                 (set! i (+ 1 i)))
-                       fin)
-                      clause* ...)))
-        ((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))
-            (loop-aux "variable-clause-collector"
-                      ((body ... (set! x next)
-                                 (unless (<= x last*)
-                                   (raise (make-loop-termination)))
-                                 (set! next (+ x inc*)))
-                       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))
-            (loop-aux "variable-clause-collector"
-                      ((body ... (set! x next)
-                                 (unless (>= x last*)
-                                   (raise (make-loop-termination)))
-                                 (set! next (+ x inc*)))
-                       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))
-            (loop-aux "variable-clause-collector"
-                      ((body ... (set! x next)
-                                 (unless (< x last*)
-                                   (raise (make-loop-termination)))
-                                 (set! next (+ x inc*)))
-                       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))
-            (loop-aux "variable-clause-collector"
-                      ((body ... (set! x next)
-                                 (unless (> x last*)
-                                   (raise (make-loop-termination)))
-                                 (set! next (+ x inc)))
-                       fin)
-                      clause* ...)))
-        ((loop-aux "variable-clause-collector" args for x clause* ...)
-          (loop-aux "for-reordering" args for x #f #f #f #f clause* ...))
-        ((loop-aux "variable-clause-collector" args clause* ...)
-          (loop-aux "main-clause-collector" args clause* ...))
-        ((loop-aux "and-collector" args (and-vars ...) and x = expr and clause* ...)
-          (loop-aux "and-collector" args (and-vars ... (x expr)) and clause* ...))
-        ((loop-aux "and-collector" args (and-vars ...) and x = expr clause* ...)
-          (let (and-vars ... (x expr))
-            (loop-aux "variable-clause-collector" args clause* ...)))
-        ((loop-aux "for-reordering" args for x #f to-clause by-clause stepping from start clause* ...)
-          (let ((start* start))
-            (loop-aux "for-reordering" args for x start* to-clause by-clause stepping clause* ...)))
-        ((loop-aux "for-reordering" args for x #f to-clause by-clause 1 downfrom start clause* ...)
-          (syntax-error "inconsistent stepping"))
-        ((loop-aux "for-reordering" args for x #f to-clause by-clause _ downfrom start clause* ...)
-          (let ((start* start))
-            (loop-aux "for-reordering" args for x start* to-clause by-clause -1 clause* ...)))
-        ((loop-aux "for-reordering" args for x from-clause #f by-clause stepping to last clause* ...)
-          (let ((last* last))
-            (loop-aux "for-reordering" args for x from-clause (to last*) by-clause stepping clause* ...)))
-        ((loop-aux "for-reordering" args for x from-clause #f by-clause 1 downto last clause* ...)
-          (syntax-error "inconsistent stepping"))
-        ((loop-aux "for-reordering" args for x from-clause #f by-clause _ downto last clause* ...)
-          (let ((last* last))
-            (loop-aux "for-reordering" args for x from-clause (downto last*) by-clause -1 clause* ...)))
-        ((loop-aux "for-reordering" args for x from-clause #f by-clause -1 below last clause* ...)
-          (syntax-error "inconsistent stepping"))
-        ((loop-aux "for-reordering" args for x from-clause #f by-clause _ below last clause* ...)
-          (let ((last* last))
-            (loop-aux "for-reordering" args for x from-clause (below last*) by-clause 1 clause* ...)))
-        ((loop-aux "for-reordering" args for x from-clause #f by-clause 1 above last clause* ...)
-          (syntax-error "inconsistent stepping"))
-        ((loop-aux "for-reordering" args for x from-clause #f by-clause _ above last clause* ...)
-          (let ((last* last))
-            (loop-aux "for-reordering" args for x from-clause (above last*) by-clause -1 clause* ...)))
-        ((loop-aux "for-reordering" args for x from-clause to-clause #f stepping by inc clause* ...)
-          (let ((inc* inc))
-            (loop-aux "for-reordering" args for x from-clause to-clause inc* stepping clause* ...)))
-        ((loop-aux "for-reordering" args for x #f #f #f _ clause* ...)
-          (syntax-error "need at least one for subclause"))
-        ((loop-aux "for-reordering" args for x from-clause to-clause inc #f clause* ...)
-          (loop-aux "for-reordering" args for x from-clause to-clause inc 1 clause* ...))
-        ((loop-aux "for-reordering" args for x #f to-clause inc 1 clause* ...)
-          (loop-aux "for-reordering" args for x 0 to-clause inc 1 clause* ...))
-        ((loop-aux "for-reordering" args for x from-clause to-clause #f stepping clause* ...)
-          (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))
-            (loop-aux "variable-clause-collector"
-                      ((body ... (set! x next)
-                                 (set! next (+ x inc*)))
-                       fin)
-                      clause* ...)))
-        ; The word `to' is ambiguous as to which stepping, so replace to with downto if stepping is -1.
-        ((loop-aux "for-reordering" args for x start (to last) inc -1 clause* ...)
-          (loop-aux "for-reordering" args for x start (downto last) inc -1 clause* ...))
-        ; Put the reordered form back into variable-clause-collector.
-        ((loop-aux "for-reordering" args for x start (to-clause ...) inc stepping clause* ...)
-          (loop-aux "variable-clause-collector" args for x from start to-clause ... by (* stepping inc) clause* ...))
-        ((loop-aux "main-clause-collector" args do clause* ...)
-          (loop-aux "unconditional" ("unconditional-main-continuation" args) () do clause* ...))
-        ((loop-aux "main-clause-collector" args return clause* ...)
-          (loop-aux "unconditional" ("unconditional-main-continuation" args) () return clause* ...))
-        ((loop-aux "main-clause-collector" args collect clause* ...)
-          (loop-aux "accumulation" ("accumulation-main-continuation" args) () collect clause* ...))
-        ((loop-aux "main-clause-collector" args append clause* ...)
-          (loop-aux "accumulation" ("accumulation-main-continuation" args) () append clause* ...))
-        ((loop-aux "main-clause-collector" args count clause* ...)
-          (loop-aux "accumulation" ("accumulation-main-continuation" args) () count clause* ...))
-        ((loop-aux "main-clause-collector" args sum clause* ...)
-          (loop-aux "accumulation" ("accumulation-main-continuation" args) () sum clause* ...))
-        ((loop-aux "main-clause-collector" args maximize clause* ...)
-          (loop-aux "accumulation" ("accumulation-main-continuation" args) () maximize clause* ...))
-        ((loop-aux "main-clause-collector" args minimize clause* ...)
-          (loop-aux "accumulation" ("accumulation-main-continuation" args) () minimize clause* ...))
-        ((loop-aux "main-clause-collector" args if clause* ...)
-          (loop-aux "conditional" ("conditional-main-continuation" args) () if clause* ...))
-        ((loop-aux "main-clause-collector" args when clause* ...)
-          (loop-aux "conditional" ("conditional-main-continuation" args) () if clause* ...))
-        ((loop-aux "main-clause-collector" args unless clause* ...)
-          (loop-aux "conditional" ("conditional-main-continuation" args) () unless clause* ...))
-        ((loop-aux "main-clause-collector" ((body ...) fin) while expr clause* ...)
-          (loop-aux "main-clause-collector"
-                    ((body ... (unless expr
-                                 (raise (make-loop-termination))))
-                     fin)
-                    clause* ...))
-        ((loop-aux "main-clause-collector" args until expr clause* ...)
-          (loop-aux "main-clause-collector" args while (not expr) clause* ...))
-        ((loop-aux "main-clause-collector" (body (fin ...)) finally (form1 form1* ...) (form2 form2* ...) clause* ...)
-          (loop-aux "main-clause-collector" (body (fin ... (form1 form1* ...))) finally (form2 form2* ...) clause* ...))
-        ((loop-aux "main-clause-collector" (body (fin ...)) finally (form form* ...) clause* ...)
-          (loop-aux "main-clause-collector" (body (fin ... (form form* ...))) clause* ...))
-        ((loop-aux "main-clause-collector" ((body ...) (fin ...)))
-          (let loop-name ()
-            (guard (e ((loop-termination? e) fin ...))
-              body ...
-              (loop-name))))
-        ((loop-aux "unconditional" continuation (compound ...) do (form1 form1* ...) (form2 form2* ...) clause* ...)
-          (loop-aux "unconditional" continuation (compound ... (form1 form1* ...)) do (form2 form2* ...) clause* ...))
-        ((loop-aux "unconditional" (continuation ...) (compound ...) do (form form* ...) clause* ...)
-          (loop-aux continuation ... (compound ... (form form* ...)) clause* ...))
-        ((loop-aux "unconditional" continuation compound return expr (form ...) clause* ...)
-          (syntax-error "unexpected form after return" (form ...)))
-        ((loop-aux "unconditional" continuation compound return expr clause* ...)
-          (loop-aux "unconditional" continuation compound do (return expr) clause* ...))
-        ((loop-aux "unconditional-main-continuation" ((body ...) fin) (compound ...) clause* ...)
-          (loop-aux "main-clause-collector" ((body ... compound ...) fin) clause* ...))
-        ((loop-aux "accumulation" (continuation ...) (compound ...) collect x into l clause* ...)
-          (let ((l '())
-                (last #f))
-            (loop-aux continuation ...
-                      (compound ... (let ((p (list x)))
-                                      (if last
-                                        (set-cdr! last p)
-                                        (set! l p))
-                                      (set! last p)))
-                      clause* ...)))
-        ((loop-aux "accumulation" continuation compound collect x (form ...) clause* ...)
-          (syntax-error "unexpected form after collect" (form ...)))
-        ((loop-aux "accumulation" continuation compound collect x clause* ...)
-          (loop-aux "accumulation" continuation compound collect x into l finally (return l) clause* ...))
-        ((loop-aux "accumulation" (continuation ...) (compound ...) append x into l clause* ...)
-          (let ((l '())
-                (last #f))
-            (loop-aux continuation ...
-                      (compound ... (loop for elem in x
-                                          for p = (list elem)
-                                          do (if last
-                                               (set-cdr! last p)
-                                               (set! l p))
-                                             (set! last p)))
-                      clause* ...)))
-        ((loop-aux "accumulation" continuation compound append x clause* ...)
-          (loop-aux "accumulation" continuation compound append x into l finally (return l) clause* ...))
-        ((loop-aux "accumulation" (continuation ...) (compound ...) count x into n clause* ...)
-          (let ((n 0))
-            (loop-aux continuation ...
-                      (compound ... (when x
-                                      (set! n (+ 1 n))))
-                      clause* ...)))
-        ((loop-aux "accumulation" continuation compound count x clause* ...)
-          (loop-aux "accumulation" continuation compound count x into n finally (return n) clause* ...))
-        ((loop-aux "accumulation" (continuation ...) (compound ...) sum x into n clause* ...)
-          (let ((n 0))
-            (loop-aux continuation ...
-                      (compound ... (set! n (+ x n)))
-                      clause* ...)))
-        ((loop-aux "accumulation" continuation compound sum x clause* ...)
-          (loop-aux "accumulation" continuation compound sum x into n finally (return n) clause* ...))
-        ((loop-aux "accumulation" (continuation ...) (compound ...) maximize x into n clause* ...)
-          (let ((n #f))
-            (loop-aux continuation ...
-                      (compound ... (let ((temp x))
-                                      (if n
-                                        (set! n (max temp n))
-                                        (set! n temp))))
-                      clause* ...)))
-        ((loop-aux "accumulation" continuation compound maximize x clause* ...)
-          (loop-aux "accumulation" continuation compound maximize x into n finally (return n) clause* ...))
-        ((loop-aux "accumulation" (continuation ...) (compound ...) minimize x into n clause* ...)
-          (let ((n #f))
-            (loop-aux continuation ...
-                      (compound ... (let ((temp x))
-                                      (if n
-                                        (set! n (min temp n))
-                                        (set! n temp))))
-                      clause* ...)))
-        ((loop-aux "accumulation" continuation compound minimize x clause* ...)
-          (loop-aux "accumulation" continuation compound minimize x into n finally (return n) clause* ...))
-        ((loop-aux "accumulation-main-continuation" ((body ...) fin) (compound ...) clause* ...)
-          (loop-aux "main-clause-collector" ((body ... compound ...) fin) clause* ...))
-        ((loop-aux "conditional" continuation compound if condition clause* ...)
-          (loop-aux "selectable-clause" ("selectable-clause-if-continuation" continuation compound condition) () clause* ...))
-        ((loop-aux "conditional" continuation compound unless condition clause* ...)
-          (loop-aux "selectable-clause" ("selectable-clause-if-continuation" continuation compound (not condition)) () clause* ...))
-        ((loop-aux "conditional-main-continuation" ((body ...) fin) (compound ...) clause* ...)
-          (loop-aux "main-clause-collector" ((body ... compound ...) fin) clause* ...))
-        ((loop-aux "selectable-clause" continuation compound do clause* ...)
-          (loop-aux "unconditional" continuation compound do clause* ...))
-        ((loop-aux "selectable-clause" continuation compound return clause* ...)
-          (loop-aux "unconditional" continuation compound return clause* ...))
-        ((loop-aux "selectable-clause" continuation compound collect clause* ...)
-          (loop-aux "accumulation" continuation compound collect clause* ...))
-        ((loop-aux "selectable-clause" continuation compound append clause* ...)
-          (loop-aux "accumulation" continuation compound append clause* ...))
-        ((loop-aux "selectable-clause" continuation compound count clause* ...)
-          (loop-aux "accumulation" continuation compound count clause* ...))
-        ((loop-aux "selectable-clause" continuation compound sum clause* ...)
-          (loop-aux "accumulation" continuation compound sum clause* ...))
-        ((loop-aux "selectable-clause" continuation compound maximize clause* ...)
-          (loop-aux "accumulation" continuation compound maximize clause* ...))
-        ((loop-aux "selectable-clause" continuation compound minimize clause* ...)
-          (loop-aux "accumulation" continuation compound minimize clause* ...))
-        ((loop-aux "selectable-clause" continuation compound if clause* ...)
-          (loop-aux "conditional" continuation compound if clause* ...))
-        ((loop-aux "selectable-clause" continuation compound when clause* ...)
-          (loop-aux "conditional" continuation compound if clause* ...))
-        ((loop-aux "selectable-clause" continuation compound unless clause* ...)
-          (loop-aux "conditional" continuation compound unless clause* ...))
-        ((loop-aux "selectable-clause-if-continuation" continuation compound condition body and clause* ...)
-          (loop-aux "selectable-clause"
-                    ("selectable-clause-if-continuation" continuation compound condition)
-                    body
-                    clause* ...))
-        ((loop-aux "selectable-clause-if-continuation" continuation compound condition body else clause* ...)
-          (loop-aux "selectable-clause"
-                    ("selectable-clause-else-continuation" continuation compound condition body)
-                    ()
-                    clause* ...))
-        ((loop-aux "selectable-clause-if-continuation" (continuation ...) (compound ...) condition (body ...) end clause* ...)
-          (loop-aux continuation ...
-                    (compound ... (when condition
-                                    body ...))
-                    clause* ...))
-        ((loop-aux "selectable-clause-if-continuation" (continuation ...) (compound ...) condition (body ...) clause* ...)
-          (loop-aux continuation ...
-                    (compound ... (when condition
-                                    body ...))
-                    clause* ...))
-        ((loop-aux "selectable-clause-else-continuation" continuation compound condition body1 body2 and clause* ...)
-          (loop-aux "selectable-clause"
-                    ("selectable-clause-else-continuation" continuation compound condition body1)
-                    body2
-                    clause* ...))
-        ((loop-aux "selectable-clause-else-continuation" (continuation ...) (compound ...) condition (body1 ...) (body2 ...) end clause* ...)
-          (loop-aux continuation ...
-                    (compound ... (if condition
-                                    (begin body1 ...)
-                                    (begin body2 ...)))
-                    clause* ...))
-        ((loop-aux "selectable-clause-else-continuation" (continuation ...) (compound ...) condition (body1 ...) (body2 ...) clause* ...)
-          (loop-aux continuation ...
-                    (compound ... (if condition
-                                    (begin body1 ...)
-                                    (begin body2 ...)))
-                    clause* ...))))
+    (define *loop-termination* (make-loop-termination))
 
 
     ; loop is a general purpose looping construct cribbed from CL.
     (define-syntax loop
       (syntax-rules ()
-        ((loop clause* ...)
-          (guard (e ((return-exception? e) ((return-exception-values e))))
-            (loop-aux "variable-clause-collector" (() ()) clause* ...)))))))
+        ((loop loop-clauses* ...)
+          (let ((list-acc '())
+                (number-acc 0)
+                (acc-last #f))
+            (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)
+                       ((loop-aux "variable-clause-collector" args with x = expr and clause* ...)
+                         (loop-aux "and-collector" args ((x expr)) and clause* ...))
+                       ((loop-aux "variable-clause-collector" args with x = expr clause* ...)
+                         (let ((x expr))
+                           (loop-aux "variable-clause-collector" args clause* ...)))
+                       ((loop-aux "variable-clause-collector" (body (fin ...)) finally (form1 form1* ...) (form2 form2* ...) clause* ...)
+                         (loop-aux "variable-clause-collector" (body (fin ... (form1 form1* ...))) finally (form2 form2* ...) clause* ...))
+                       ((loop-aux "variable-clause-collector" (body (fin ...)) finally (form form* ...) clause* ...)
+                         (loop-aux "variable-clause-collector" (body (fin ... (form form* ...))) clause* ...))
+                       ((loop-aux "variable-clause-collector" ((body ...) fin) for x in l clause* ...)
+                         (let ((temp l)
+                               (x #f))
+                           (loop-aux "variable-clause-collector"
+                                     ((body ... (when (null? temp)
+                                                  (raise *loop-termination*))
+                                                (set! x (car temp))
+                                                (set! temp (cdr temp)))
+                                      fin)
+                                     clause* ...)))
+                       ((loop-aux "variable-clause-collector" ((body ...) fin) for x on l clause* ...)
+                         (let* ((x l)
+                                (next x))
+                           (loop-aux "variable-clause-collector"
+                                     ((body ... (set! x next)
+                                                (unless (pair? x)
+                                                  (raise *loop-termination*))
+                                                (set! next (cdr x)))
+                                      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.
+                               (x #f))
+                           (loop-aux "variable-clause-collector"
+                                     ((body ... (if first
+                                                  (begin
+                                                    (set! first #f)
+                                                    (set! x (init-value)))
+                                                  (set! x subseq)))
+                                      fin)
+                                     clause* ...)))
+                       ((loop-aux "variable-clause-collector" ((body ...) fin) for x = init clause* ...)
+                         (let ((x #f))
+                           (loop-aux "variable-clause-collector"
+                                     ((body ... (set! x init))
+                                      fin)
+                                     clause* ...)))
+                       ((loop-aux "variable-clause-collector" ((body ...) fin) for x across v clause* ...)
+                         (let ((temp v)
+                               (i 0)
+                               (x #f))
+                           (loop-aux "variable-clause-collector"
+                                     ((body ... (unless (< i (vector-length temp))
+                                                  (raise *loop-termination*))
+                                                (set! x (vector-ref temp i))
+                                                (set! i (+ 1 i)))
+                                      fin)
+                                     clause* ...)))
+                       ((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))
+                           (loop-aux "variable-clause-collector"
+                                     ((body ... (set! x next)
+                                                (unless (<= x last*)
+                                                  (raise *loop-termination*))
+                                                (set! next (+ x inc*)))
+                                      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))
+                           (loop-aux "variable-clause-collector"
+                                     ((body ... (set! x next)
+                                                (unless (>= x last*)
+                                                  (raise *loop-termination*))
+                                                (set! next (+ x inc*)))
+                                      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))
+                           (loop-aux "variable-clause-collector"
+                                     ((body ... (set! x next)
+                                                (unless (< x last*)
+                                                  (raise *loop-termination*))
+                                                (set! next (+ x inc*)))
+                                      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))
+                           (loop-aux "variable-clause-collector"
+                                     ((body ... (set! x next)
+                                                (unless (> x last*)
+                                                  (raise *loop-termination*))
+                                                (set! next (+ x inc)))
+                                      fin)
+                                     clause* ...)))
+                       ((loop-aux "variable-clause-collector" args for x clause* ...)
+                         (loop-aux "for-reordering" args for x #f #f #f #f clause* ...))
+                       ((loop-aux "variable-clause-collector" args clause* ...)
+                         (loop-aux "main-clause-collector" args clause* ...))
+                       ((loop-aux "and-collector" args (and-vars ...) and x = expr and clause* ...)
+                         (loop-aux "and-collector" args (and-vars ... (x expr)) and clause* ...))
+                       ((loop-aux "and-collector" args (and-vars ...) and x = expr clause* ...)
+                         (let (and-vars ... (x expr))
+                           (loop-aux "variable-clause-collector" args clause* ...)))
+                       ((loop-aux "for-reordering" args for x #f to-clause by-clause stepping from start clause* ...)
+                         (let ((start* start))
+                           (loop-aux "for-reordering" args for x start* to-clause by-clause stepping clause* ...)))
+                       ((loop-aux "for-reordering" args for x #f to-clause by-clause 1 downfrom start clause* ...)
+                         (syntax-error "inconsistent stepping"))
+                       ((loop-aux "for-reordering" args for x #f to-clause by-clause _ downfrom start clause* ...)
+                         (let ((start* start))
+                           (loop-aux "for-reordering" args for x start* to-clause by-clause -1 clause* ...)))
+                       ((loop-aux "for-reordering" args for x from-clause #f by-clause stepping to last clause* ...)
+                         (let ((last* last))
+                           (loop-aux "for-reordering" args for x from-clause (to last*) by-clause stepping clause* ...)))
+                       ((loop-aux "for-reordering" args for x from-clause #f by-clause 1 downto last clause* ...)
+                         (syntax-error "inconsistent stepping"))
+                       ((loop-aux "for-reordering" args for x from-clause #f by-clause _ downto last clause* ...)
+                         (let ((last* last))
+                           (loop-aux "for-reordering" args for x from-clause (downto last*) by-clause -1 clause* ...)))
+                       ((loop-aux "for-reordering" args for x from-clause #f by-clause -1 below last clause* ...)
+                         (syntax-error "inconsistent stepping"))
+                       ((loop-aux "for-reordering" args for x from-clause #f by-clause _ below last clause* ...)
+                         (let ((last* last))
+                           (loop-aux "for-reordering" args for x from-clause (below last*) by-clause 1 clause* ...)))
+                       ((loop-aux "for-reordering" args for x from-clause #f by-clause 1 above last clause* ...)
+                         (syntax-error "inconsistent stepping"))
+                       ((loop-aux "for-reordering" args for x from-clause #f by-clause _ above last clause* ...)
+                         (let ((last* last))
+                           (loop-aux "for-reordering" args for x from-clause (above last*) by-clause -1 clause* ...)))
+                       ((loop-aux "for-reordering" args for x from-clause to-clause #f stepping by inc clause* ...)
+                         (let ((inc* inc))
+                           (loop-aux "for-reordering" args for x from-clause to-clause inc* stepping clause* ...)))
+                       ((loop-aux "for-reordering" args for x #f #f #f _ clause* ...)
+                         (syntax-error "need at least one for subclause"))
+                       ((loop-aux "for-reordering" args for x from-clause to-clause inc #f clause* ...)
+                         (loop-aux "for-reordering" args for x from-clause to-clause inc 1 clause* ...))
+                       ((loop-aux "for-reordering" args for x #f to-clause inc 1 clause* ...)
+                         (loop-aux "for-reordering" args for x 0 to-clause inc 1 clause* ...))
+                       ((loop-aux "for-reordering" args for x from-clause to-clause #f stepping clause* ...)
+                         (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))
+                           (loop-aux "variable-clause-collector"
+                                     ((body ... (set! x next)
+                                                (set! next (+ x inc*)))
+                                      fin)
+                                     clause* ...)))
+                       ; The word `to' is ambiguous as to which stepping, so replace to with downto if stepping is -1.
+                       ((loop-aux "for-reordering" args for x start (to last) inc -1 clause* ...)
+                         (loop-aux "for-reordering" args for x start (downto last) inc -1 clause* ...))
+                       ; Put the reordered form back into variable-clause-collector.
+                       ((loop-aux "for-reordering" args for x start (to-clause ...) inc stepping clause* ...)
+                         (loop-aux "variable-clause-collector" args for x from start to-clause ... by (* stepping inc) clause* ...))
+                       ((loop-aux "main-clause-collector" args do clause* ...)
+                         (loop-aux "unconditional" ("unconditional-main-continuation" args) () do clause* ...))
+                       ((loop-aux "main-clause-collector" args return clause* ...)
+                         (loop-aux "unconditional" ("unconditional-main-continuation" args) () return clause* ...))
+                       ((loop-aux "main-clause-collector" args collect clause* ...)
+                         (loop-aux "accumulation" ("accumulation-main-continuation" args) () collect clause* ...))
+                       ((loop-aux "main-clause-collector" args append clause* ...)
+                         (loop-aux "accumulation" ("accumulation-main-continuation" args) () append clause* ...))
+                       ((loop-aux "main-clause-collector" args count clause* ...)
+                         (loop-aux "accumulation" ("accumulation-main-continuation" args) () count clause* ...))
+                       ((loop-aux "main-clause-collector" args sum clause* ...)
+                         (loop-aux "accumulation" ("accumulation-main-continuation" args) () sum clause* ...))
+                       ((loop-aux "main-clause-collector" args maximize clause* ...)
+                         (loop-aux "accumulation" ("accumulation-main-continuation" args) () maximize clause* ...))
+                       ((loop-aux "main-clause-collector" args minimize clause* ...)
+                         (loop-aux "accumulation" ("accumulation-main-continuation" args) () minimize clause* ...))
+                       ((loop-aux "main-clause-collector" args if clause* ...)
+                         (loop-aux "conditional" ("conditional-main-continuation" args) () if clause* ...))
+                       ((loop-aux "main-clause-collector" args when clause* ...)
+                         (loop-aux "conditional" ("conditional-main-continuation" args) () if clause* ...))
+                       ((loop-aux "main-clause-collector" args unless clause* ...)
+                         (loop-aux "conditional" ("conditional-main-continuation" args) () unless clause* ...))
+                       ((loop-aux "main-clause-collector" ((body ...) fin) while expr clause* ...)
+                         (loop-aux "main-clause-collector"
+                                   ((body ... (unless expr
+                                                (raise *loop-termination*)))
+                                    fin)
+                                   clause* ...))
+                       ((loop-aux "main-clause-collector" args until expr clause* ...)
+                         (loop-aux "main-clause-collector" args while (not expr) clause* ...))
+                       ((loop-aux "main-clause-collector" (body (fin ...)) finally (form1 form1* ...) (form2 form2* ...) clause* ...)
+                         (loop-aux "main-clause-collector" (body (fin ... (form1 form1* ...))) finally (form2 form2* ...) clause* ...))
+                       ((loop-aux "main-clause-collector" (body (fin ...)) finally (form form* ...) clause* ...)
+                         (loop-aux "main-clause-collector" (body (fin ... (form form* ...))) clause* ...))
+                       ((loop-aux "main-clause-collector" ((body ...) (fin ...)))
+                         (let loop-name ()
+                           (guard (e ((loop-termination? e) fin ...))
+                             body ...
+                             (loop-name))))
+                       ((loop-aux "unconditional" continuation (compound ...) do (form1 form1* ...) (form2 form2* ...) clause* ...)
+                         (loop-aux "unconditional" continuation (compound ... (form1 form1* ...)) do (form2 form2* ...) clause* ...))
+                       ((loop-aux "unconditional" (continuation ...) (compound ...) do (form form* ...) clause* ...)
+                         (loop-aux continuation ... (compound ... (form form* ...)) clause* ...))
+                       ((loop-aux "unconditional" continuation compound return expr (form ...) clause* ...)
+                         (syntax-error "unexpected form after return" (form ...)))
+                       ((loop-aux "unconditional" continuation compound return expr clause* ...)
+                         (loop-aux "unconditional" continuation compound do (return expr) clause* ...))
+                       ((loop-aux "unconditional-main-continuation" ((body ...) fin) (compound ...) clause* ...)
+                         (loop-aux "main-clause-collector" ((body ... compound ...) fin) clause* ...))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) collect x into l clause* ...)
+                         (let ((l '())
+                               (last #f))
+                           (loop-aux continuation ...
+                                     (compound ... (let ((p (list x)))
+                                                     (if last
+                                                       (set-cdr! last p)
+                                                       (set! l p))
+                                                     (set! last p)))
+                                     clause* ...)))
+                       ((loop-aux "accumulation" continuation compound collect x (form ...) clause* ...)
+                         (syntax-error "unexpected form after collect" (form ...)))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) collect x clause* ...)
+                         (loop-aux continuation ...
+                                   (compound ... (let ((p (list x)))
+                                                   (if acc-last
+                                                     (set-cdr! acc-last p)
+                                                     (set! list-acc p))
+                                                   (set! acc-last p)))
+                                   finally (return list-acc) clause* ...))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) append x into l clause* ...)
+                         (let ((l '())
+                               (last #f))
+                           (loop-aux continuation ...
+                                     (compound ... (loop for elem in x
+                                                         for p = (list elem)
+                                                         do (if last
+                                                              (set-cdr! last p)
+                                                              (set! l p))
+                                                            (set! last p)))
+                                     clause* ...)))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) append x clause* ...)
+                         (loop-aux continuation ...
+                                   (compound ... (loop for elem in x
+                                                       for p = (list elem)
+                                                       do (if acc-last
+                                                            (set-cdr! acc-last p)
+                                                            (set! list-acc p))
+                                                       (set! acc-last p)))
+                                   finally (return list-acc) clause* ...))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) count x into n clause* ...)
+                         (let ((n 0))
+                           (loop-aux continuation ...
+                                     (compound ... (when x
+                                                     (set! n (+ 1 n))))
+                                     clause* ...)))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) count x clause* ...)
+                         (loop-aux continuation ...
+                                   (compound ... (when x
+                                                   (set! number-acc (+ 1 number-acc))))
+                                   finally (return number-acc) clause* ...))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) sum x into n clause* ...)
+                         (let ((n 0))
+                           (loop-aux continuation ...
+                                     (compound ... (set! n (+ x n)))
+                                     clause* ...)))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) sum x clause* ...)
+                         (loop-aux continuation ...
+                                   (compound ... (set! number-acc (+ x number-acc)))
+                                   finally (return number-acc) clause* ...))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) maximize x into n clause* ...)
+                         (let ((n 0)
+                               (set #f))
+                           (loop-aux continuation ...
+                                     (compound ... (let ((temp x))
+                                                     (if set
+                                                       (set! n (max temp n))
+                                                       (begin
+                                                         (set! set #t)
+                                                         (set! n temp)))))
+                                     clause* ...)))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) maximize x clause* ...)
+                         (loop-aux continuation ...
+                                   (compound ... (let ((temp x))
+                                                   (if acc-last
+                                                     (set! number-acc (max temp number-acc))
+                                                     (begin
+                                                       (set! acc-last #t)
+                                                       (set! number-acc temp)))))
+                                   finally (return number-acc) clause* ...))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) minimize x into n clause* ...)
+                         (let ((n 0)
+                               (set #f))
+                           (loop-aux continuation ...
+                                     (compound ... (let ((temp x))
+                                                     (if set
+                                                       (set! n (min temp n))
+                                                       (begin
+                                                         (set! set #t)
+                                                         (set! n temp)))))
+                                     clause* ...)))
+                       ((loop-aux "accumulation" (continuation ...) (compound ...) minimize x clause* ...)
+                         (loop-aux continuation ...
+                                   (compound ... (let ((temp x))
+                                                   (if acc-last
+                                                     (set! number-acc (min temp number-acc))
+                                                     (begin
+                                                       (set! acc-last #t)
+                                                       (set! number-acc temp)))))
+                                   finally (return number-acc) clause* ...))
+                       ((loop-aux "accumulation-main-continuation" ((body ...) fin) (compound ...) clause* ...)
+                         (loop-aux "main-clause-collector" ((body ... compound ...) fin) clause* ...))
+                       ((loop-aux "conditional" continuation compound if condition clause* ...)
+                         (loop-aux "selectable-clause" ("selectable-clause-if-continuation" continuation compound condition) () clause* ...))
+                       ((loop-aux "conditional" continuation compound unless condition clause* ...)
+                         (loop-aux "selectable-clause" ("selectable-clause-if-continuation" continuation compound (not condition)) () clause* ...))
+                       ((loop-aux "conditional-main-continuation" ((body ...) fin) (compound ...) clause* ...)
+                         (loop-aux "main-clause-collector" ((body ... compound ...) fin) clause* ...))
+                       ((loop-aux "selectable-clause" continuation compound do clause* ...)
+                         (loop-aux "unconditional" continuation compound do clause* ...))
+                       ((loop-aux "selectable-clause" continuation compound return clause* ...)
+                         (loop-aux "unconditional" continuation compound return clause* ...))
+                       ((loop-aux "selectable-clause" continuation compound collect clause* ...)
+                         (loop-aux "accumulation" continuation compound collect clause* ...))
+                       ((loop-aux "selectable-clause" continuation compound append clause* ...)
+                         (loop-aux "accumulation" continuation compound append clause* ...))
+                       ((loop-aux "selectable-clause" continuation compound count clause* ...)
+                         (loop-aux "accumulation" continuation compound count clause* ...))
+                       ((loop-aux "selectable-clause" continuation compound sum clause* ...)
+                         (loop-aux "accumulation" continuation compound sum clause* ...))
+                       ((loop-aux "selectable-clause" continuation compound maximize clause* ...)
+                         (loop-aux "accumulation" continuation compound maximize clause* ...))
+                       ((loop-aux "selectable-clause" continuation compound minimize clause* ...)
+                         (loop-aux "accumulation" continuation compound minimize clause* ...))
+                       ((loop-aux "selectable-clause" continuation compound if clause* ...)
+                         (loop-aux "conditional" continuation compound if clause* ...))
+                       ((loop-aux "selectable-clause" continuation compound when clause* ...)
+                         (loop-aux "conditional" continuation compound if clause* ...))
+                       ((loop-aux "selectable-clause" continuation compound unless clause* ...)
+                         (loop-aux "conditional" continuation compound unless clause* ...))
+                       ((loop-aux "selectable-clause-if-continuation" continuation compound condition body and clause* ...)
+                         (loop-aux "selectable-clause"
+                                   ("selectable-clause-if-continuation" continuation compound condition)
+                                   body
+                                   clause* ...))
+                       ((loop-aux "selectable-clause-if-continuation" continuation compound condition body else clause* ...)
+                         (loop-aux "selectable-clause"
+                                   ("selectable-clause-else-continuation" continuation compound condition body)
+                                   ()
+                                   clause* ...))
+                       ((loop-aux "selectable-clause-if-continuation" (continuation ...) (compound ...) condition (body ...) end clause* ...)
+                         (loop-aux continuation ...
+                                   (compound ... (when condition
+                                                   body ...))
+                                   clause* ...))
+                       ((loop-aux "selectable-clause-if-continuation" (continuation ...) (compound ...) condition (body ...) clause* ...)
+                         (loop-aux continuation ...
+                                   (compound ... (when condition
+                                                   body ...))
+                                   clause* ...))
+                       ((loop-aux "selectable-clause-else-continuation" continuation compound condition body1 body2 and clause* ...)
+                         (loop-aux "selectable-clause"
+                                   ("selectable-clause-else-continuation" continuation compound condition body1)
+                                   body2
+                                   clause* ...))
+                       ((loop-aux "selectable-clause-else-continuation" (continuation ...) (compound ...) condition (body1 ...) (body2 ...) end clause* ...)
+                         (loop-aux continuation ...
+                                   (compound ... (if condition
+                                                   (begin body1 ...)
+                                                   (begin body2 ...)))
+                                   clause* ...))
+                       ((loop-aux "selectable-clause-else-continuation" (continuation ...) (compound ...) condition (body1 ...) (body2 ...) clause* ...)
+                         (loop-aux continuation ...
+                                   (compound ... (if condition
+                                                   (begin body1 ...)
+                                                   (begin body2 ...)))
+                                   clause* ...))))))
+              (guard (e ((return-exception? e) ((return-exception-values e))))
+                (loop-aux "variable-clause-collector" (() ()) loop-clauses* ...)))))))))