Fix the bugs in loop.

It works! Sometimes it emits nested loops!

1 files changed, 73 insertions, 32 deletions

diff --git a/csc/loop.csc b/csc/loop.csc
index 9c776ca..7f59f9e 100644
--- a/csc/loop.csc
+++ b/csc/loop.csc
@@ -1,5 +1,5 @@
 (define-library (csc loop)
-  (export loop return loop-aux)
+  (export loop return)
   (import (scheme base))
   (begin
 
@@ -72,9 +72,9 @@
           (let* ((x l)
                  (next x))
             (loop-aux "variable-clause-collector"
-                      ((body ... (unless (pair? x)
+                      ((body ... (set! x next)
+                                 (unless (pair? x)
                                    (raise (make-loop-termination)))
-                                 (set! x next)
                                  (set! next (cdr x)))
                        fin)
                       clause* ...)))
@@ -89,6 +89,12 @@
                                    (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)
@@ -101,47 +107,55 @@
                        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))
+          (let* ((last* last)
+                 (inc* inc)
+                 (x start)
+                 (next x))
             (loop-aux "variable-clause-collector"
-                      ((body ... (unless (<= x last*)
+                      ((body ... (set! x next)
+                                 (unless (<= x last*)
                                    (raise (make-loop-termination)))
-                                 (set! x (+ x inc*)))
+                                 (set! next (+ 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))
+          (let* ((last* last)
+                 (inc* inc)
+                 (x start)
+                 (next x))
             (loop-aux "variable-clause-collector"
-                      ((body ... (unless (>= x last*)
+                      ((body ... (set! x next)
+                                 (unless (>= x last*)
                                    (raise (make-loop-termination)))
-                                 (set! x (+ x inc*)))
+                                 (set! next (+ 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))
+          (let* ((last* last)
+                 (inc* inc)
+                 (x start)
+                 (next x))
             (loop-aux "variable-clause-collector"
-                      ((body ... (unless (< x last*)
+                      ((body ... (set! x next)
+                                 (unless (< x last*)
                                    (raise (make-loop-termination)))
-                                 (set! x (+ x inc*)))
+                                 (set! next (+ 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))
+          (let* ((last* last)
+                 (inc* inc)
+                 (x start)
+                 (next x))
             (loop-aux "variable-clause-collector"
-                      ((body ... (unless (> x last*)
+                      ((body ... (set! x next)
+                                 (unless (> x last*)
                                    (raise (make-loop-termination)))
-                                 (set! x (+ x inc)))
+                                 (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 1 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* ...)
@@ -152,28 +166,53 @@
         ((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* ...)
+        ((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 stepping downto last 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* ...)
+        ((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* ...)
@@ -189,6 +228,8 @@
         ((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* ...))
@@ -241,11 +282,11 @@
           (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)))
+                      (compound ... (loop for elem in x
+                                          for p = (list elem)
+                                          if last do (set-cdr! last p)
+                                          else do (set! l p)
+                                          do (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* ...))