Add more of the standard library.

10 files changed, 774 insertions, 386 deletions

diff --git a/lib/csc/cps-test.csc b/lib/csc/cps-test.csc
index 156ba60..7aab023 100644
--- a/lib/csc/cps-test.csc
+++ b/lib/csc/cps-test.csc
@@ -256,7 +256,7 @@
           (list
             (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
               (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
-                (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                (make-primitive 'eq? (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
                   (make-fix
                     (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                             (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
@@ -322,7 +322,7 @@
         (make-fix
           (list (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
                   (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
-                    (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                    (make-primitive 'eq? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
                       (make-fix
                         (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                                 (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
@@ -357,7 +357,7 @@
             (list
               (make-closure (test-ref 'f) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
                 (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
-                  (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                  (make-primitive 'eq? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
                     (make-fix
                       (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                               (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
@@ -404,7 +404,7 @@
             (make-closure (test-ref 'f) (list (test-ref 'generated-symbol)
                                               (test-ref 'generated-symbol))
               (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
-                (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
+                (make-primitive 'eq? (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
                   (make-fix
                     (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                             (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
@@ -443,7 +443,7 @@
           (make-fix
             (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))
                     (make-primitive 'peek (list (test-ref 'generated-symbol) (make-constant 1)) (list (test-ref 'generated-symbol))
-                      (make-primitive 'int=? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
+                      (make-primitive 'eq? (list (test-ref 'generated-symbol) (make-constant 0)) (list (test-ref 'generated-symbol))
                         (make-fix
                           (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                                   (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
diff --git a/lib/csc/cps.csc b/lib/csc/cps.csc
index a3e829b..4fed47c 100644
--- a/lib/csc/cps.csc
+++ b/lib/csc/cps.csc
@@ -151,7 +151,7 @@
           (define argvec (new-ref))
           (define nargs (length args))
           (make-lambda (list argvec) #f
-            (make-if (make-call-builtin 'int=? (list (make-call-builtin 'peek (list argvec (make-constant 1)))
+            (make-if (make-call-builtin 'eq? (list (make-call-builtin 'peek (list argvec (make-constant 1)))
                                                      (make-constant nargs)))
               (loop for arg in (reverse args)
                     for i downfrom (+ 1 nargs)
@@ -294,6 +294,8 @@
                   (to-cps producer
                     (lambda (p)
                       (make-apply p (list consumer-func argvec)))))))))
+        ((% %call-builtin 'apply (proc args))
+          (to-cps (make-call proc (list args)) continuation))
         ((% %call-builtin op args)
           (define returns-value? (not (memq op '(poke exit))))
           (loop for arg in (reverse args)
diff --git a/lib/csc/ir1.csc b/lib/csc/ir1.csc
index efcd22f..a39c07d 100644
--- a/lib/csc/ir1.csc
+++ b/lib/csc/ir1.csc
@@ -171,6 +171,7 @@
     ;   - int<?: int * int -> bool
     ;   - call-with-current-continuation: proc -> result
     ;   - call-with-values: producer * consumer -> result
+    ;   - apply: proc * args -> result
     (define-match-record-type <call-builtin>
       (make-call-builtin operation arguments)
       call-builtin?
diff --git a/lib/csc/loop.csc b/lib/csc/loop.csc
index f07deae..445735f 100644
--- a/lib/csc/loop.csc
+++ b/lib/csc/loop.csc
@@ -39,381 +39,381 @@
                 (first #t))
             (letrec-syntax
               ((loop-aux
-                (... (syntax-rules (= above across and append below by collect count do downfrom downto else end finally for from if in into maximize minimize on return sum then to unless until when while with)
-                       ((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))
-                           (loop-aux "variable-clause-collector"
-                                     ((body ... (unless first
-                                                  (set! x (cdr x)))
-                                                (unless (pair? x)
-                                                  (raise *loop-termination*)))
-                                      fin)
-                                     clause* ...)))
-                       ((loop-aux "variable-clause-collector" ((body ...) fin) for x = init then subseq clause* ...)
-                         (let ((init-value (lambda () init)) ; put the body of init outside the scope of x.
-                               (x #f))
-                           (loop-aux "variable-clause-collector"
-                                     ((body ... (if first
-                                                  (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))
-                           (loop-aux "variable-clause-collector"
-                                     ((body ... (unless first
-                                                  (set! x (+ x inc*)))
-                                                (unless (<= x last*)
-                                                  (raise *loop-termination*)))
-                                      fin)
-                                     clause* ...)))
-                       ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start downto last by inc clause* ...)
-                         (let* ((last* last)
-                                (inc* inc)
-                                (x start))
-                           (loop-aux "variable-clause-collector"
-                                     ((body ... (unless first
-                                                  (set! x (+ x inc*)))
-                                                (unless (>= x last*)
-                                                  (raise *loop-termination*)))
-                                      fin)
-                                     clause* ...)))
-                       ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start below last by inc clause* ...)
-                         (let* ((last* last)
-                                (inc* inc)
-                                (x start))
-                           (loop-aux "variable-clause-collector"
-                                     ((body ... (unless first
-                                                  (set! x (+ x inc*)))
-                                                (unless (< x last*)
-                                                  (raise *loop-termination*)))
-                                      fin)
-                                     clause* ...)))
-                       ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start above last by inc clause* ...)
-                         (let* ((last* last)
-                                (inc* inc)
-                                (x start))
-                           (loop-aux "variable-clause-collector"
-                                     ((body ... (unless first
-                                                  (set! x (+ x inc)))
-                                                (unless (> x last*)
-                                                  (raise *loop-termination*)))
-                                      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))
-                           (loop-aux "variable-clause-collector"
-                                     ((body ... (unless first
-                                                  (set! x (+ x inc*))))
-                                      fin)
-                                     clause* ...)))
-                       ; The word `to' is ambiguous as to which stepping, so replace to with downto if stepping is -1.
-                       ((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 ...
-                             (set! first #f)
-                             (loop-name))))
-                       ((loop-aux "unconditional" continuation (compound ...) do (form1 form1* ...) (form2 form2* ...) clause* ...)
-                         (loop-aux "unconditional" continuation (compound ... (form1 form1* ...)) do (form2 form2* ...) clause* ...))
-                       ((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)))
-                                   clause* ... finally (return list-acc)))
-                       ((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)))
-                                   clause* ... finally (return list-acc)))
-                       ((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))))
-                                   clause* ... finally (return number-acc)))
-                       ((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)))
-                                   clause* ... finally (return number-acc)))
-                       ((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)))))
-                                   clause* ... finally (return number-acc)))
-                       ((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)))))
-                                   clause* ... finally (return number-acc)))
-                       ((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* ...))))))
+                (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))
+                      (loop-aux "variable-clause-collector"
+                                ((body ::: (unless first
+                                             (set! x (cdr x)))
+                                           (unless (pair? x)
+                                             (raise *loop-termination*)))
+                                 fin)
+                                clause* :::)))
+                  ((loop-aux "variable-clause-collector" ((body :::) fin) for x = init then subseq clause* :::)
+                    (let ((init-value (lambda () init)) ; put the body of init outside the scope of x.
+                          (x #f))
+                      (loop-aux "variable-clause-collector"
+                                ((body ::: (if first
+                                             (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))
+                      (loop-aux "variable-clause-collector"
+                                ((body ::: (unless first
+                                             (set! x (+ x inc*)))
+                                           (unless (<= x last*)
+                                             (raise *loop-termination*)))
+                                 fin)
+                                clause* :::)))
+                  ((loop-aux "variable-clause-collector" ((body :::) fin) for x from start downto last by inc clause* :::)
+                    (let* ((last* last)
+                           (inc* inc)
+                           (x start))
+                      (loop-aux "variable-clause-collector"
+                                ((body ::: (unless first
+                                             (set! x (+ x inc*)))
+                                           (unless (>= x last*)
+                                             (raise *loop-termination*)))
+                                 fin)
+                                clause* :::)))
+                  ((loop-aux "variable-clause-collector" ((body :::) fin) for x from start below last by inc clause* :::)
+                    (let* ((last* last)
+                           (inc* inc)
+                           (x start))
+                      (loop-aux "variable-clause-collector"
+                                ((body ::: (unless first
+                                             (set! x (+ x inc*)))
+                                           (unless (< x last*)
+                                             (raise *loop-termination*)))
+                                 fin)
+                                clause* :::)))
+                  ((loop-aux "variable-clause-collector" ((body :::) fin) for x from start above last by inc clause* :::)
+                    (let* ((last* last)
+                           (inc* inc)
+                           (x start))
+                      (loop-aux "variable-clause-collector"
+                                ((body ::: (unless first
+                                             (set! x (+ x inc)))
+                                           (unless (> x last*)
+                                             (raise *loop-termination*)))
+                                 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))
+                      (loop-aux "variable-clause-collector"
+                                ((body ::: (unless first
+                                             (set! x (+ x inc*))))
+                                 fin)
+                                clause* :::)))
+                  ; The word `to' is ambiguous as to which stepping, so replace to with downto if stepping is -1.
+                  ((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 :::
+                        (set! first #f)
+                        (loop-name))))
+                  ((loop-aux "unconditional" continuation (compound :::) do (form1 form1* :::) (form2 form2* :::) clause* :::)
+                    (loop-aux "unconditional" continuation (compound ::: (form1 form1* :::)) do (form2 form2* :::) clause* :::))
+                  ((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)))
+                              clause* ::: finally (return list-acc)))
+                  ((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)))
+                              clause* ::: finally (return list-acc)))
+                  ((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))))
+                              clause* ::: finally (return number-acc)))
+                  ((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)))
+                              clause* ::: finally (return number-acc)))
+                  ((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)))))
+                              clause* ::: finally (return number-acc)))
+                  ((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)))))
+                              clause* ::: finally (return number-acc)))
+                  ((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* ...)))))))))
diff --git a/lib/scheme/base.csc b/lib/scheme/base.csc
index 1bba9f4..1cb2aa0 100644
--- a/lib/scheme/base.csc
+++ b/lib/scheme/base.csc
@@ -1,4 +1,7 @@
 (define-library (scheme base)
   (include-library-declarations "base/10-define.csc")
   (include-library-declarations "base/20-let.csc")
-  (include-library-declarations "base/30-if.csc"))
+  (include-library-declarations "base/30-if.csc")
+  (include-library-declarations "base/40-values.csc")
+  (include-library-declarations "base/50-records.csc")
+  (include-library-declarations "base/60-list.csc"))
diff --git a/lib/scheme/base/10-define.csc b/lib/scheme/base/10-define.csc
index d110268..a4f254e 100644
--- a/lib/scheme/base/10-define.csc
+++ b/lib/scheme/base/10-define.csc
@@ -1,9 +1,12 @@
 (export
   define
-  define-syntax)
+  define-syntax
+  set!)
 (import (only (csc builtins)
           builtin-define
-          define-syntax))
+          define-syntax
+          lambda
+          set!))
 (begin
 
 
diff --git a/lib/scheme/base/30-if.csc b/lib/scheme/base/30-if.csc
index 09012fa..6262f5a 100644
--- a/lib/scheme/base/30-if.csc
+++ b/lib/scheme/base/30-if.csc
@@ -1,5 +1,6 @@
 (export
   and
+  case-lambda
   cond
   if
   or
@@ -73,4 +74,30 @@
     (syntax-rules ()
       ((unless test result1 result2 ...)
         (if (not test)
-          (begin result1 result2 ...))))))
+          (begin result1 result2 ...)))))
+
+
+  (define-syntax case-lambda
+    (syntax-rules ()
+      ((case-lambda (params body0 ...) ...)
+        (lambda args
+          (let ((len (length args)))
+            (let-syntax
+              ((cl (syntax-rules ::: ()
+                     ((cl)
+                       (error "no matching clause"))
+                     ((cl ((p :::) . body) . rest)
+                       (if (= len (length ’(p :::)))
+                         (apply (lambda (p :::)
+                                  . body)
+                                args)
+                         (cl . rest)))
+                    ((cl ((p ::: . tail) . body)
+                         . rest)
+                      (if (>= len (length ’(p :::)))
+                        (apply
+                          (lambda (p ::: . tail)
+                            . body)
+                          args)
+                        (cl . rest))))))
+              (cl (params body0 ...) ...))))))))
diff --git a/lib/scheme/base/40-values.csc b/lib/scheme/base/40-values.csc
new file mode 100644
index 0000000..3a175a5
--- /dev/null
+++ b/lib/scheme/base/40-values.csc
@@ -0,0 +1,125 @@
+(export
+  apply
+  call-with-current-continuation
+  call-with-values
+  call/cc
+  define-values
+  let*-values
+  let-values
+  values)
+(import (only (csc builtins)
+          call-builtin))
+(begin
+
+
+  (define (call-with-current-continuation proc)
+    (call-builtin call-with-current-continuation proc))
+
+
+  (define call/cc call-with-current-continuation)
+
+
+  (define (call-with-values producer consumer)
+    (call-builtin call-with-values producer consumer))
+
+
+  (define (values . things)
+    (call-with-current-continuation
+      (lambda (cont) (apply cont things))))
+
+
+  (define-syntax let-values
+    (syntax-rules ()
+      ((let-values (binding ...) body0 body1 ...)
+        (let-values "bind"
+          (binding ...) () (begin body0 body1 ...)))
+
+      ((let-values "bind" () tmps body)
+        (let tmps body))
+
+      ((let-values "bind" ((b0 e0)
+           binding ...) tmps body)
+        (let-values "mktmp" b0 e0 ()
+           (binding ...) tmps body))
+
+      ((let-values "mktmp" () e0 args
+           bindings tmps body)
+        (call-with-values
+          (lambda () e0)
+          (lambda args
+            (let-values "bind"
+                bindings tmps body))))
+
+      ((let-values "mktmp" (a . b) e0 (arg ...)
+           bindings (tmp ...) body)
+        (let-values "mktmp" b e0 (arg ... x)
+            bindings (tmp ... (a x)) body))
+
+      ((let-values "mktmp" a e0 (arg ...)
+           bindings (tmp ...) body)
+        (call-with-values
+          (lambda () e0)
+          (lambda (arg ... . x)
+            (let-values "bind"
+                bindings (tmp ... (a x)) body))))))
+
+
+  (define-syntax let*-values
+    (syntax-rules ()
+      ((let*-values () body0 body1 ...)
+        (let () body0 body1 ...))
+
+      ((let*-values (binding0 binding1 ...)
+           body0 body1 ...)
+        (let-values (binding0)
+          (let*-values (binding1 ...)
+            body0 body1 ...)))))
+
+
+  (define-syntax define-values
+    (syntax-rules ()
+      ((define-values () expr)
+        (define dummy
+          (call-with-values (lambda () expr)
+                            (lambda args #f))))
+      ((define-values (var) expr)
+        (define var expr))
+      ((define-values (var0 var1 ... varn) expr)
+        (begin
+          (define var0
+            (call-with-values (lambda () expr)
+                              list))
+          (define var1
+            (let ((v (cadr var0)))
+              (set-cdr! var0 (cddr var0))
+              v)) ...
+          (define varn
+            (let ((v (cadr var0)))
+              (set! var0 (car var0))
+              v))))
+      ((define-values (var0 var1 ... . varn) expr)
+        (begin
+          (define var0
+            (call-with-values (lambda () expr)
+                              list))
+          (define var1
+            (let ((v (cadr var0)))
+              (set-cdr! var0 (cddr var0))
+              v)) ...
+          (define varn
+            (let ((v (cdr var0)))
+              (set! var0 (car var0))
+              v))))
+      ((define-values var expr)
+        (define var
+          (call-with-values (lambda () expr)
+                            list)))))
+
+
+  (define (apply proc arg1 . args)
+    (define args*
+      (let loop ((args (cons arg1 args)))
+        (if (null? (cdr args))
+          (car args)
+          (cons (car args) (loop (cdr args))))))
+    (call-builtin apply proc (list->vector args*))))
diff --git a/lib/scheme/base/50-records.csc b/lib/scheme/base/50-records.csc
new file mode 100644
index 0000000..d7fa8d1
--- /dev/null
+++ b/lib/scheme/base/50-records.csc
@@ -0,0 +1,83 @@
+(export
+  define-record-type)
+(import (only (csc builtins)
+          call-builtin))
+(begin
+
+
+  ; There are a few builtin types such as vector, which uses type code 0. We'll
+  ; start at 10 to give some room for more in the future.
+  (define *next-type-id* 10)
+
+
+  (define-syntax macro-length
+    (syntax-rules ()
+      ((macro-length ()) 0)
+      ((macro-length (x xs ...))
+        (+ 1 (macro-length (xs ...))))))
+
+
+  (define-syntax set-arguments
+    (syntax-rules ()
+      ((set-arguments _ _)
+        #f)
+      ((set-arguments r n field1 field2 ...)
+        (begin
+          (call-builtin poke field1 r n)
+          (set-arguments r (+ 1 n) field2 ...)))))
+
+
+  (define-syntax define-selectors
+    (syntax-rules ()
+      ((define-selectors (selectors ...))
+        (values selectors ...))
+      ((define-selectors (selectors ...) (field getter) selector ...)
+        (define-selectors (selectors ... (lambda (r)
+                                           (call-builtin peek r field)))
+          selector ...))
+      ((define-selectors (selectors ...) (field getter setter) selector ...)
+        (define-selectors (selectors ... (lambda (r)
+                                           (call-builtin peek r field))
+                                         (lambda (r val)
+                                           (call-builtin poke val r field)))
+          selector ...))))
+
+
+  (define-syntax enumerate-fields
+    (syntax-rules ()
+      ((enumerate-fields _ selectors)
+        (define-selectors selectors))
+      ((enumerate-fields n selectors field1 field2 ...)
+        (begin
+          (define field1 n)
+          (enumerate-fields (+ 1 n) selectors field2 ...)))))
+
+
+  (define-syntax selector-names
+    (syntax-rules ()
+      ((selector-names selectors (field ...) (name ...))
+        (define-values (name ...)
+          (enumerate-fields 1 selectors field ...)))
+      ((selector-names selectors fields (names ...) (_ getter) selector ...)
+        (selector-names selectors fields (names ... getter) selector ...))
+      ((selector-names selectors fields (names ...) (_ getter setter) selector ...)
+        (selector-names selectors fields (names ... getter setter) selector ...))))
+
+
+  (define-syntax define-record-type
+    (syntax-rules ()
+      ((define-record-type _
+         (constructor field ...)
+         pred
+         selectors ...)
+        (define type-id
+          (let ((id *next-type-id*))
+            (set! *next-type-id* (call-builtin + 1 *next-type-id*))))
+        (define (pred r)
+          (call-builtin eq? type-id (call-builtin peek r 0)))
+        (define (constructor field ...)
+          (define r (call-builtin alloc (macro-length (field ...))))
+          (call-builtin poke type-id r 0)
+          (set-arguments r 1 field ...)
+          r)
+        (selector-names (selectors ...) (field ...) () selectors ...)))))
diff --git a/lib/scheme/base/60-list.csc b/lib/scheme/base/60-list.csc
new file mode 100644
index 0000000..cbfc12a
--- /dev/null
+++ b/lib/scheme/base/60-list.csc
@@ -0,0 +1,144 @@
+(export
+  append
+  caar
+  cadr
+  car
+  cdar
+  cddr
+  cdr
+  cons
+  length
+  list
+  list-copy
+  list-ref
+  list-set!
+  list-tail
+  list?
+  make-list
+  null?
+  pair?
+  reverse
+  set-car!
+  set-cdr!)
+(import (only (csc builtins)
+          call-builtin))
+(begin
+
+
+  (define-record-type <pair>
+    (cons x y)
+    pair?
+    (x car set-car!)
+    (y cdr set-cdr!))
+
+
+  (define (caar pair)
+    (car (car pair)))
+
+
+  (define (cadr pair)
+    (car (cdr pair)))
+
+
+  (define (cdar pair)
+    (cdr (car pair)))
+
+
+  (define (cddr pair)
+    (cdr (cdr pair)))
+
+
+  (define (null? obj)
+    (call-builtin eq? obj '()))
+
+
+  (define (list? obj)
+    (cond
+      ((null? obj) #t)
+      ((not (pair? obj)) #f)
+      (else
+        (let loop ((tortoise obj)
+                   (hare (cdr obj)))
+          (cond
+            ((null? hare) #t)
+            ((not (pair? hare)) #f)
+            ((null? (cdr hare)) #t)
+            ((not (pair? (cdr hare))) #f)
+            ((eq? tortoise hare) #f)  ; cycle detected
+            (else
+              (loop (cdr tortoise)
+                    (cddr hare))))))))
+
+
+  (define make-list
+    (case-lambda
+      ((k)
+        (make-list k #f))
+      ((k fill)
+        (let loop ((k k)
+                   (acc '()))
+          (if (zero? k)
+            acc
+            (loop (- k 1) (cons fill acc)))))))
+
+
+  (define (list . args)
+    args)
+
+
+  (define (length l)
+    (let loop ((l l)
+               (n 0))
+      (if (null? l)
+        n
+        (loop (cdr l) (+ 1 n)))))
+
+
+  (define (append2 l1 l2)
+    (let loop ((l1 l1))
+      (if (null? l1)
+        l2
+        (cons (car l1) (loop (cdr l1))))))
+
+
+  (define (append . ls)
+    (let loop ((ls ls))
+      (cond
+        ((null? ls) '())
+        ((null? (cdr ls))
+          (car ls))
+        (else
+          (append2 (car ls)
+                   (loop (cdr ls)))))))
+
+
+  (define (reverse l)
+    (let loop ((l l)
+               (acc '()))
+      (if (null? l)
+        acc
+        (loop (cdr l) (cons (car l) acc)))))
+
+
+  (define (list-tail l k)
+    (if (zero? k)
+      l
+      (list-tail (cdr l) (- k 1))))
+
+
+  (define (list-ref l k)
+    (car (list-tail l k)))
+
+
+  (define (list-set! l k obj)
+    (let loop ((l l)
+               (k k))
+      (if (zero? k)
+        (set-car! l obj)
+        (loop (cdr l) (- k 1)))))
+
+
+  (define (list-copy obj)
+    (if (pair? l)
+      (cons (car l) (list-copy (cdr l)))
+      l)))