Finish the loop macro.

I also cleaned everything up a lot. Maybe there are still bugs because
the test coverage is awful, but for now I'm happy to be done.

3 files changed, 362 insertions, 164 deletions

diff --git a/csc/list-test.csc b/csc/list-test.csc
index 6e910c0..d4c145a 100644
--- a/csc/list-test.csc
+++ b/csc/list-test.csc
@@ -93,3 +93,10 @@
 
 (test filter-odd
   (assert-equal '(1 3 5 7 9) (filter odd? '(0 1 2 3 4 5 6 7 8 9))))
+
+
+(test unzip-empty
+  (assert (values= (values '() '()) (unzip '()))))
+
+(test unzip-simple
+  (assert (values= (values '(1 2 3) '(4 5 6)) (unzip '((1 . 4) (2 . 5) (3 . 6))))))
diff --git a/csc/list.csc b/csc/list.csc
index dcc1766..95fff04 100644
--- a/csc/list.csc
+++ b/csc/list.csc
@@ -5,7 +5,8 @@
     intercalate
     revappend
     split-at
-    take)
+    take
+    unzip)
   (import (scheme base)
           (only (csc loop)
             loop
@@ -22,11 +23,13 @@
 
 
     (define (split-at n xs)
-      (loop for i from 1 to n
-            for x in xs
-            collect x into first-half
-            for second-half = xs then (cdr second-half)
-            finally (return (values first-half second-half))))
+      (if (<= n 0)
+        (values '() xs)
+        (loop for i from 1 to n
+              for x in xs
+              for second-half = (cdr xs) then (cdr second-half)
+              collect x into first-half
+              finally (return (values first-half second-half)))))
 
 
     (define (revappend a b)
@@ -60,4 +63,11 @@
           ((x . xs)
            (if (p x)
              (loop xs (cons x acc))
-             (loop xs acc))))))))
+             (loop xs acc))))))
+
+
+    (define (unzip l)
+      (loop for x in l
+            collect (car x) into xs
+            collect (cdr x) into ys
+            finally (return (values xs ys))))))
diff --git a/csc/loop.csc b/csc/loop.csc
index c7331fe..9c776ca 100644
--- a/csc/loop.csc
+++ b/csc/loop.csc
@@ -1,136 +1,362 @@
 (define-library (csc loop)
-  (export loop return)
+  (export loop return loop-aux)
   (import (scheme base))
   (begin
 
 
-    (define-syntax initial-values
-      (syntax-rules (=
-                     by
-                     collect
-                     do
-                     for
-                     from
-                     in
-                     into
-                     then
-                     to)
-        ((initial-values loop-name (acc* ...) ((for _ in l temp-name) clause clause* ...) body)
-          (initial-values loop-name (acc* ... (temp-name l)) (clause clause* ...) body))
-        ((initial-values loop-name (acc* ...) ((for x from start to _ by _) clause clause* ...) body)
-          (initial-values loop-name (acc* ... (x start)) (clause clause* ...) body))
-        ((initial-values loop-name (acc* ...) ((for x = init then consequent) clause clause* ...) body)
-          (initial-values loop-name (acc* ... (x init)) (clause clause* ...) body))
-        ((initial-values loop-name (acc* ...) ((collect _ into l last) clause clause* ...) body)
-          (initial-values loop-name (acc* ... (l '()) (last #f)) (clause clause* ...) body))
-        ((initial-values loop-name (acc* ...) ((collect _ l last)) body)
-          (let loop-name (acc* ... (l '()) (last #f))
-            body))
-        ((initial-values loop-name (acc* ...) ((do _)) body)
-          (let loop-name (acc* ...)
-            body))))
-
-
-    (define-syntax subsequent-values
-      (syntax-rules (=
-                     by
-                     collect
-                     do
-                     for
-                     from
-                     in
-                     into
-                     then
-                     to)
-        ((subsequent-values loop-name (acc* ...) (for _ in _ l) clause clause* ...)
-          (subsequent-values loop-name (acc* ... (cdr l)) clause clause* ...))
-        ((subsequent-values loop-name (acc* ...) (for x from _ to _ by inc) clause clause* ...)
-          (subsequent-values loop-name (acc* ... (+ x inc)) clause clause* ...))
-        ((subsequent-values loop-name (acc* ...) (for x = _ then consequent) clause clause* ...)
-          (subsequent-values loop-name (acc* ... consequent) clause clause* ...))
-        ((subsequent-values loop-name (acc* ...) (collect expr into l last) clause clause* ...)
-          (if last
-            (begin
-              (set-cdr! last (list expr))
-              (subsequent-values loop-name (acc* ... l (cdr last)) clause clause* ...))
-            (begin
-              (set! l (list expr))
-              (subsequent-values loop-name (acc* ... l l) clause clause* ...))))
-        ((subsequent-values loop-name (acc* ...) (collect expr l last))
-          (if last
-            (begin
-              (set-cdr! last (list expr))
-              (loop-name acc* ... l (cdr last)))
-            (begin
-              (set! l (list expr))
-              (loop-name acc* ... l l))))
-        ((subsequent-values loop-name (acc* ...) (do expr))
-          (begin
-            expr
-            (loop-name acc* ...)))))
+    ; Once more, from the top!
 
 
-    (define-syntax condition
-      (syntax-rules (=
-                     by
-                     collect
-                     for
-                     from
-                     in
-                     into
-                     then
-                     to)
-        ((condition)
-          #t)
-        ((condition (for _ in _ l) clause* ...)
-          (and (pair? l) (condition clause* ...)))
-        ((condition (for x from _ to limit by _) clause* ...)
-          (and (<= x limit) (condition clause* ...)))
-        ((condition (for _ = _ then _) clause* ...)
-          (condition clause* ...))
-        ((condition (collect _ into _ _) clause* ...)
-          (condition clause* ...))))
+    (define (*current-loop-continuation* . args)
+      (error "Can't use return outside of a loop"))
 
 
-    (define-syntax result
-      (syntax-rules (collect)
-        ((result (collect _ l _))
-          l)
-        ((result (do _))
-          (if #f #f))))
+    (define-record-type <loop-termination>
+      (make-loop-termination)
+      loop-termination?)
 
 
-    (define-syntax bindings
+    (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)
-        ((bindings () body)
-          body)
-        ((bindings ((for x in _ l) clause* ...) body)
-          (let ((x (car l)))
-            (bindings (clause* ...)
-              body)))
-        ((bindings ((for _ from _ to _ by _) clause* ...) body)
-          (bindings (clause* ...) body))
-        ((bindings ((for _ = _ then _) clause* ...) body)
-          (bindings (clause* ...) body))
-        ((bindings ((collect _ into _ _) clause* ...) body)
-          (bindings (clause* ...) body))))
-
-
-    (define (*current-loop-continuation* . args)
-      (error "Can't use return outside of a loop"))
+                     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 ... (unless (pair? x)
+                                   (raise (make-loop-termination)))
+                                 (set! x next)
+                                 (set! next (cdr x)))
+                       fin)
+                      clause* ...)))
+        ((loop-aux "variable-clause-collector" ((body ...) fin) for x = init then subseq clause* ...)
+          (let ((first #t)
+                (x #f))
+            (loop-aux "variable-clause-collector"
+                      ((body ... (if first
+                                   (begin
+                                     (set! first #f)
+                                     (set! x init))
+                                   (set! x subseq)))
+                       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 ((x start)
+                (last* last)
+                (inc* inc))
+            (loop-aux "variable-clause-collector"
+                      ((body ... (unless (<= x last*)
+                                   (raise (make-loop-termination)))
+                                 (set! x (+ x inc*)))
+                       fin)
+                      clause* ...)))
+        ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start downto last by inc clause* ...)
+          (let ((x start)
+                (last* last)
+                (inc* inc))
+            (loop-aux "variable-clause-collector"
+                      ((body ... (unless (>= x last*)
+                                   (raise (make-loop-termination)))
+                                 (set! x (+ x inc*)))
+                       fin)
+                      clause* ...)))
+        ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start below last by inc clause* ...)
+          (let ((x start)
+                (last* last)
+                (inc* inc))
+            (loop-aux "variable-clause-collector"
+                      ((body ... (unless (< x last*)
+                                   (raise (make-loop-termination)))
+                                 (set! x (+ x inc*)))
+                       fin)
+                      clause* ...)))
+        ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start above last by inc clause* ...)
+          (let ((x start)
+                (last* last)
+                (inc* inc))
+            (loop-aux "variable-clause-collector"
+                      ((body ... (unless (> x last*)
+                                   (raise (make-loop-termination)))
+                                 (set! x (+ x inc)))
+                       fin)
+                      clause* ...)))
+        ((loop-aux "variable-clause-collector" args for x clause* ...)
+          (loop-aux "for-reordering" args for x #f #f #f 1 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 stepping 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 stepping 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* ...)
+          (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 _ 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 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" 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) () 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 ... (let ((p (list-copy x)))
+                                      (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-syntax loop-clauses
+    ; loop is a general purpose looping construct cribbed from CL.
+    (define-syntax loop
       (syntax-rules ()
-        ((loop-clauses (clause* ...) fin body)
+        ((loop clause* ...)
           (call/cc
             (lambda (k)
               (define prev-loop-continuation *current-loop-continuation*)
@@ -138,56 +364,11 @@
                 (lambda ()
                   (set! *current-loop-continuation* k))
                 (lambda ()
-                  (initial-values loop-name () (clause* ... body)
-                    (if (condition clause* ...)
-                      (bindings (clause* ...)
-                        (subsequent-values loop-name () clause* ... body))
-                      (begin
-                        fin
-                        (result body)))))
+                  (loop-aux "variable-clause-collector" (() ()) clause* ...))
                 (lambda ()
                   (set! *current-loop-continuation* prev-loop-continuation))))))))
 
 
-    (define-syntax clause-collector
-      (syntax-rules (=
-                     by
-                     collect
-                     do
-                     finally
-                     for
-                     from
-                     in
-                     into
-                     then
-                     to)
-        ((clause-collector (acc ...) fin for x in l clause clause* ...)
-          (clause-collector (acc ... (for x in l temp-name)) fin clause clause* ...))
-        ((clause-collector (acc ...) fin for x from start to limit by step clause clause* ...)
-          (clause-collector (acc ... (for x from start to limit by step)) fin clause clause* ...))
-        ((clause-collector (acc ...) fin for x from start to limit clause clause* ...)
-          (clause-collector (acc ... (for x from start to limit by 1)) fin clause clause* ...))
-        ((clause-collector (acc ...) fin for x = init then subsequent clause clause* ...)
-          (clause-collector (acc ... (for x = init then subsequent)) fin clause clause* ...))
-        ((clause-collector (acc ...) fin collect x into l clause clause* ...)
-          (clause-collector (acc ... (collect x into l temp-name)) fin clause clause* ...))
-        ((clause-collector (acc ...) #f finally expr)
-          (loop-clauses (acc ...) expr (do (if #f #f))))
-        ((clause-collector (acc ...) #f finally expr clause clause* ...)
-          (clause-collector (acc ...) expr clause clause* ...))
-        ((clause-collector (acc ...) fin collect expr)
-          (loop-clauses (acc ...) fin (collect expr temp1 temp2)))
-        ((clause-collector (acc ...) fin do body body* ...)
-          (loop-clauses (acc ...) fin (do (let () body body* ...))))))
-
-
-    ; loop is a general purpose looping construct cribbed from CL.
-    (define-syntax loop
-      (syntax-rules ()
-        ((loop clause clause* ...)
-          (clause-collector () #f clause clause* ...))))
-
-
     (define-syntax return
       (syntax-rules ()
         ((return expr)