first attempt at moving over to SRFI-259

11 files changed, 211 insertions, 358 deletions

diff --git a/README.md b/README.md
index 3ab935b..4afab6d 100644
--- a/README.md
+++ b/README.md
@@ -7,12 +7,11 @@
 >
 > -- Revisedⁿ Reports on the Algorithmic Language Scheme (n ≥ 3, 1986–)
 
-HaScheme is a library that implements a subset of the R7RS's libraries
-in a lazy way, using `force` and `delay-force`.  When HaScheme is used
-by itself, it is a lazy functional programming language with the same
-syntax as Scheme, embedded within Scheme.
+HaScheme is a library that implements a subset of the R⁷RS in a lazy
+way. When HaScheme is used by itself, it is a lazy functional programming
+language with the same syntax as Scheme, embedded within Scheme.
 
-For instance, the following `map` implementation is both valid HaScheme
+For example, the following `map` implementation is both valid HaScheme
 (importing `(hascheme base)`) and Scheme (importing `(scheme base)`):
 
     (define (map f list)
@@ -33,25 +32,13 @@ code. HaScheme's datatypes are the same as regular Schemes. Hence lazy
 and non-lazy code can co-exist. It is easy to wrap eager Scheme procedures
 to be usable in HaScheme.
 
-HaScheme should run in any R7RS-compatible system that distinguishes
-promises from all other types, and that allows forcing non-promises.
-There is no need to support implicit forcing.
-
-HaScheme uses `delay-force`, which is not available in R6RS. HaScheme
-could be implemented on top of [SRFI-45][SRFI-45] if the representation
-of promises was changed to a `define-record-type` datatype instead of
-cons cells.
-
-See also [Lazy Racket][LazyRacket].
-
-[LazyRacket]: https://docs.racket-lang.org/lazy/index.html
-[SRFI-45]: https://srfi.schemers.org/srfi-45
-
 *Every* procedure in HaScheme is lazy. Values are forced in conditionals,
 or explicitly using `seq`. This allows for the call-by-value semantics
 of Scheme to be turned into call-by-need semantics without any syntactic
 cruft.
 
+HaScheme should run in any implemention of the R⁷RS.
+
 Why use this?
 
 1. To have fun playing around with functional infinite data structures.
@@ -59,6 +46,12 @@ Why use this?
 3. To show those dirty Haskellers that you don't need no stinkin'
    static type system.
 
+See also [Lazy Racket][LazyRacket].
+
+[LazyRacket]: https://docs.racket-lang.org/lazy/index.html
+
+HaScheme is licensed under the 0BSD license.
+
 ## Restrictions and Implementation Notes
 
 1. No `call/cc`. [Explanation](#multiple-values-and-continuations)
@@ -74,7 +67,7 @@ Why use this?
 7. Parameters are not supported because forcing a promise uses the
    parameters of the dynamic extent of the force, and not the dynamic
    extent of the delay. This makes them useless in this context.
-   This would be fixed by SRFI-226.
+   This would be fixed by SRFI 226.
 8. No quasiquote.
 
 ## Fun (or Pain) with Laziness
@@ -174,7 +167,7 @@ takes `n` forms, forces the first `n-1`, and returns the `n`th form.
 HaScheme doesn't have `call/cc`. `call/cc` is not a function because it
 does not return, so that's strike one for inclusion in a pure language.
 Reified continuations make sense in a call-by-value language, because
-there is a definite evaluation order (outermost first), but a lazy
+there is a definite evaluation order (innermost first), but a lazy
 language can execute any code at basically any time.
 
 A future implementation might be able to use SRFI-226's delimited
@@ -185,10 +178,65 @@ Multiple values are specified as returning values to their continuation.
 Since HaScheme does not (conceptually) have continuations, multiple
 values have to be interpreted differently. But a bigger issue occurs
 because a promise is a single value. It cannot be decomposed into more
-values without forcing the promise.
+values without forcing the promise. Multiple value returns are simulated
+using lists, although vectors could also work.
+
+## Why `delay` and `delay-force` Are Not Enough
+
+Scheme for a long time had `delay` and `force` that were never implemented
+very well. It was only in the R⁷RS that they were implemented in a
+safe-for-space way. However, the usual transformation does not handle
+higher-order procedures correctly.
 
-## License
+For example, consider the transformation advocated in [SRFI 45][SRFI-45].
+The `map` function, defined as
 
-0BSD for everything except for `(hascheme implemetation-support)`, which
-implements a modified version of the SRFI-45 sample implementation for
-systems that do not implement the requirements for promises here.
+    (define (map f lst)
+      (if (null? lst)
+          '()
+          (cons (f (car lst)) (map f (cdr lst)))))
+
+becomes
+
+    (define (map f lst)
+      (delay-force
+        (if (null? (force lst))
+            (delay '())
+            (delay (cons (f (car (force lst)))
+                         (map f (cdr (force lst))))))))
+
+So far, so good. But let us define
+
+    (define (add-n n)
+      (lambda (x)
+        (+ x n)))
+
+which then becomes
+
+    (define (add-n n)
+      (delay-force
+        (lambda (x)
+          (delay-force (+ (force x) (force n))))))
+
+If we evaluated, in normal Scheme,
+
+    (map (add-n 5) '(1 2 3 4))
+
+we would get `(6 7 8 9)` back. But if we evaluated this in our lazy
+language, we would get an error because we tried to apply arguments to
+a non-procedure.
+
+We could get around this by annotating each higher-order procedure with
+`force`. But this violates one of the principles of HaScheme, which is that
+the code should look natural.
+
+Instead, this library uses [SRFI 259][SRFI-259] tagged procedures to wrap
+promises. This allows for arbitrary higher-order procedures expressed
+in a natural way.
+
+Each `lambda` creates a procedure object that can be called with an
+arbitrary number of arguments to create another procedure. Procedure
+argument length is only checked when the procedure is forced.
+
+[SRFI-45]: https://srfi.schemers.org/srfi-45
+[SRFI-259]: https://srfi.schemers.org/srfi-259
diff --git a/hascheme.egg b/hascheme.egg
index 9041c5a..308fb02 100644
--- a/hascheme.egg
+++ b/hascheme.egg
@@ -3,35 +3,29 @@
  (synopsis "Implictly Lazy Scheme embedded into Scheme")
  (category lang-exts)
  (license "BSD 0-clause")
- (dependencies r7rs)
+ (dependencies r7rs srfi-259)
  (test-dependencies srfi-64)
  (components (extension hascheme.base
                (source "lib/hascheme/base.sld")
                (source-dependencies "lib/hascheme/base.scm")
                (component-dependencies hascheme.prelude
                                        hascheme.eager
-                                       hascheme.implementation-support
                                        hascheme.case-lambda)
                (csc-options "-R" "r7rs" "-X" "r7rs"))
-             (extension hascheme.implementation-support
-               (source "lib/hascheme/implementation-support.sld")
-               (csc-options "-R" "r7rs" "-X" "r7rs"))
              (extension hascheme.support
                (source "lib/hascheme/support.sld")
-               (component-dependencies hascheme.implementation-support)
+               (component-dependencies hascheme.prelude)
                (csc-options "-R" "r7rs" "-X" "r7rs"))
              (extension hascheme.prelude
                (source "lib/hascheme/prelude.sld")
-               (component-dependencies hascheme.implementation-support)
                (csc-options "-R" "r7rs" "-X" "r7rs"))
              (extension hascheme.case-lambda
                (source "lib/hascheme/case-lambda.sld")
-               (component-dependencies hascheme.eager hascheme.implementation-support)
+               (component-dependencies hascheme.eager hascheme.prelude)
                (csc-options "-R" "r7rs" "-X" "r7rs"))
              (extension hascheme.eager
                (source "lib/hascheme/eager.sld")
-               (component-dependencies hascheme.implementation-support
-                                       hascheme.prelude)
+               (component-dependencies hascheme.prelude)
                (csc-options "-R" "r7rs" "-X" "r7rs"))
              (extension hascheme.char
                (source "lib/hascheme/char.sld")
diff --git a/lib/hascheme/base.sld b/lib/hascheme/base.sld
index badb119..40b7c76 100644
--- a/lib/hascheme/base.sld
+++ b/lib/hascheme/base.sld
@@ -6,7 +6,6 @@
                   r7rs:)
           (only (scheme base) define-syntax syntax-rules quote
                 let* letrec letrec* ... _ let-syntax letrec-syntax)
-          (hascheme implementation-support)
           (rename (hascheme prelude)
                   (hs:lambda lambda)
                   (hs:define define))
diff --git a/lib/hascheme/case-lambda.sld b/lib/hascheme/case-lambda.sld
index b1b765c..f3918d1 100644
--- a/lib/hascheme/case-lambda.sld
+++ b/lib/hascheme/case-lambda.sld
@@ -1,10 +1,10 @@
 (define-library (hascheme case-lambda)
   (import (scheme base) (hascheme eager)
-          (hascheme implementation-support)
+          (hascheme prelude)
           (prefix (scheme case-lambda) r7rs:))
   (export case-lambda)
   (begin
     (define-syntax case-lambda
       (syntax-rules ()
         ((_ (clause body ...) ...)
-         (r7rs:case-lambda (clause (delay-force (let () body ...))) ...))))))
\ No newline at end of file
+         (r7rs:case-lambda (clause (hs:delay-force (let () body ...))) ...))))))
\ No newline at end of file
diff --git a/lib/hascheme/control.sld b/lib/hascheme/control.sld
index a94e7d7..dca2752 100644
--- a/lib/hascheme/control.sld
+++ b/lib/hascheme/control.sld
@@ -1,5 +1,6 @@
 (define-library (hascheme control)
-  (import (hascheme eager) (hascheme case-lambda)
+  (import (hascheme case-lambda)
+          (hascheme eager)
           (rename (hascheme base)
                   (if if*)
                   (cond cond*)
diff --git a/lib/hascheme/cxr.sld b/lib/hascheme/cxr.sld
index 4c44901..6c14836 100644
--- a/lib/hascheme/cxr.sld
+++ b/lib/hascheme/cxr.sld
@@ -1,5 +1,8 @@
 (define-library (hascheme cxr)
-  (import (hascheme base))
+  (import (hascheme base)
+          ;; TODO: Why does this not work in CHICKEN?
+          ;; This fails with a failure to find delay-force.
+          (hascheme eager))
   (export caaar caadr cadar caddr cdaar cdadr cddar cdddr
           caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
           cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr)
diff --git a/lib/hascheme/eager.sld b/lib/hascheme/eager.sld
index d3ae3bd..15df4ae 100644
--- a/lib/hascheme/eager.sld
+++ b/lib/hascheme/eager.sld
@@ -1,11 +1,15 @@
 (define-library (hascheme eager)
   (import (scheme base) (scheme case-lambda)
-          (hascheme implementation-support)
-          (hascheme prelude))
+          (rename (hascheme prelude)
+                  (hs:delay delay)
+                  (hs:force force)
+                  (hs:delay-force delay-force)
+                  (hs:promise? promise?)))
   (export define-wrappers-from-strict
           define-wrappers-for-lazy
           define-binary-wrapper
-          ! seq let*! let*-seq)
+          ! seq let*! let*-seq
+          delay force delay-force promise?)
   (begin
     (define ! force)
     (define-syntax define-wrappers-from-strict
diff --git a/lib/hascheme/implementation-support.sld b/lib/hascheme/implementation-support.sld
deleted file mode 100644
index 1b506eb..0000000
--- a/lib/hascheme/implementation-support.sld
+++ /dev/null
@@ -1,85 +0,0 @@
-#| Slightly modified from:
-
-Copyright (C) André van Tonder (2003). All Rights Reserved.
-
-Permission is hereby granted, free of charge, to any person obtaining a
-copy of this software and associated documentation files (the "Software"),
-to deal in the Software without restriction, including without limitation
-the rights to use, copy, modify, merge, publish, distribute, sublicense,
-and/or sell copies of the Software, and to permit persons to whom the
-Software is furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included
-in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
-THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
-OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
-ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
-OTHER DEALINGS IN THE SOFTWARE.
-|#
-
-(define-library (hascheme implementation-support)
-  (import (scheme base))
-  (cond-expand
-    ((or chicken gauche)
-     (import (scheme lazy))
-     (export delay force delay-force make-promise promise?))
-    (else
-     (export delay force delay-force make-promise promise?)
-     (begin
-       (define-record-type <promise>
-         (%make-promise cmd)
-         promise?
-         (cmd promise-cmd set-promise-cmd!))
-       (define (make-promise data)
-         (if (promise? data)
-             data
-             (%make-promise (cmd #t data))))
-       (define-record-type <cmd>
-         (cmd eager? thunk)
-         cmd?
-         (eager? cmd-eager? set-cmd-eager!)
-         (thunk cmd-thunk set-cmd-thunk!))
-       (define-syntax delay
-         (syntax-rules ()
-           ((_ exp) (delay-force (%make-promise (cmd #t exp))))))
-       (define-syntax delay-force
-         (syntax-rules () ((_ exp) (%make-promise (cmd #f (lambda () exp))))))
-       (define (force promise)
-         ;; The main driving loop.
-         ;; 
-         ;; Forcing a non-promise just returns a promise.
-         ;; Forcing a "delay" will run the thunk, store the returned value
-         ;; in the promise, and return the value.
-         ;; Forcing a "delay-force" will run the thunk, and then
-         ;;  
-         ;; 1. If the value is not a promise, store the retuend value and
-         ;;    return the value.
-         ;; 2. If the value is a promise, then the first promise becomes
-         ;;    the returned promise. This is done by copying the state of
-         ;;    the second promise into the first, and then *replacing* the
-         ;;    mutatable state of the second promise with the first
-         ;;    promise. The promise is then forced again, tail-recursively.
-         (cond
-           ((cmd? promise) (error 'force "internal error" promise))
-           ((not (promise? promise)) promise)
-           (else
-            (let ((cmd (promise-cmd promise)))
-              (if (cmd-eager? cmd)
-                  (cmd-thunk cmd)
-                  (let* ((promise* ((cmd-thunk cmd)))
-                         (cmd (promise-cmd promise)))
-                    (if (not (promise? promise*))
-                        (begin
-                          (set-cmd-eager! cmd #t)
-                          (set-cmd-thunk! cmd promise*)
-                          promise*)
-                        (let* ((cmd* (promise-cmd promise*)))
-                          (unless (cmd-eager? cmd)
-                            (set-cmd-eager! cmd (cmd-eager? cmd*))
-                            (set-cmd-thunk! cmd (cmd-thunk cmd*))
-                            (set-promise-cmd! promise* cmd))
-                          (force promise*)))))))))))))
\ No newline at end of file
diff --git a/lib/hascheme/prelude.sld b/lib/hascheme/prelude.sld
index 61a65e0..5eb4500 100644
--- a/lib/hascheme/prelude.sld
+++ b/lib/hascheme/prelude.sld
@@ -1,11 +1,34 @@
 (define-library (hascheme prelude)
-  (import (scheme base) (hascheme implementation-support))
-  (export hs:lambda hs:define)
+  (import (scheme base) (scheme lazy) (srfi 259))
+  (export hs:lambda hs:define hs:promise?
+          hs:delay hs:delay-force hs:force
+          %get-raw-promise)
   (begin
+    (define-procedure-tag %hascheme-promise
+      hs:promise? %get-raw-promise)
+    (define (make-callable-promise promise)
+      (%hascheme-promise promise
+                         (lambda subformals
+                           (make-callable-promise
+                            (delay-force
+                             (let ((resolved (force promise)))
+                               (apply resolved subformals)))))))
+    (define-syntax hs:delay-force
+      (syntax-rules ()
+        ((_ expr)
+         (make-callable-promise (delay-force expr)))))
+    (define-syntax hs:delay
+      (syntax-rules ()
+        ((_ expr)
+         (make-callable-promise (delay expr)))))
     (define-syntax hs:lambda
       (syntax-rules ()
         ((_ formal body ...)
-         (lambda formal (delay-force (let () body ...))))))
+         (hs:delay (lambda formal body ...)))))
+    (define (hs:force promise)
+      (if (hs:promise? promise)
+          (force (%get-raw-promise promise))
+          promise))
     (define-syntax hs:define
       (syntax-rules ()
         ((_ (name . formals) body ...)
diff --git a/lib/hascheme/support.sld b/lib/hascheme/support.sld
index 99d9a58..349d966 100644
--- a/lib/hascheme/support.sld
+++ b/lib/hascheme/support.sld
@@ -1,5 +1,5 @@
 (define-library (hascheme support)
-  (import (scheme base) (hascheme implementation-support))
+  (import (scheme base) (hascheme eager))
   (export user-defined-forcers recursive-force)
   (begin
     (define user-defined-forcers
diff --git a/lib/tests/hascheme/base.sld b/lib/tests/hascheme/base.sld
index 4ce4c79..1be93b4 100644
--- a/lib/tests/hascheme/base.sld
+++ b/lib/tests/hascheme/base.sld
@@ -1,6 +1,6 @@
 (define-library (tests hascheme base)
   (import (scheme base)
-          (hascheme implementation-support)
+          (hascheme eager)
           (hascheme support)
           (prefix (hascheme base) h:))
   (cond-expand
@@ -14,8 +14,6 @@
       (syntax-rules ()
         ((_ name value) (delay (set! name value)))))
     (define (test-base)
-      (test-group "SRFI-45" (test-srfi-45))
-      (test-group "preliminaries" (test-preliminaries))
       (test-group "lambda" (test-lambda))
       (test-group "if" (test-if))
       (test-group "cond" (test-cond))
@@ -53,144 +51,12 @@
       (test-group "list->vector" (test-list->vector))
       (test-group "list-copy" (test-list-copy))
       (test-group "other binding constructors" (test-other-binding-constructs)))
-    (define (test-srfi-45)
-      #| These tests are taken from SRFI-45.
-
-Copyright (C) André van Tonder (2003). All Rights Reserved.
-
-Permission is hereby granted, free of charge, to any person obtaining a
-copy of this software and associated documentation files (the "Software"),
-to deal in the Software without restriction, including without limitation
-the rights to use, copy, modify, merge, publish, distribute, sublicense,
-and/or sell copies of the Software, and to permit persons to whom the
-Software is furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in
-all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- DEALINGS IN THE SOFTWARE. |#
-      (test-group "memo 1"
-        (let* ((effect 0)
-               (expr (delay (begin (set! effect (+ effect 1)) 10))))
-          (test-equal 10 (force expr))
-          (test-equal 1 effect)
-          (test-equal 10 (force expr))
-          (test-equal 1 effect)))
-      (test-group "memo 2"
-        (let* ((effect 0)
-               (expr (delay (begin (set! effect (+ effect 1)) 2))))
-          (test-equal 4 (+ (force expr) (force expr)))
-          (test-equal 1 effect)))
-      (test-group "memo 3"
-        (let* ((effect 0)
-               (r (delay (begin (set! effect (+ effect 1)) 1)))
-               (s (delay-force r))
-               (t (delay-force s)))
-          (test-equal 1 (force s))
-          (test-equal 1 (force t))
-          (test-equal 1 effect)))
-      (test-group "memo 4"
-        (letrec* ((effect 0)
-                  (stream-drop (lambda (s index)
-                                 (delay-force
-                                  (if (zero? index)
-                                      s
-                                      (stream-drop (cdr (force s))
-                                                   (- index 1))))))
-                  (ones (lambda () (delay (begin
-                                            (set! effect (+ effect 1))
-                                            (cons 1 (ones))))))
-                  (s (ones)))
-          (test-equal 0 effect)
-          (test-equal 1 (car (force (stream-drop s 4))))
-          (test-equal "effect, 1" 5 effect)
-          (test-equal 1 (car (force (stream-drop s 4))))
-          (test-equal "effect, 2" 5 effect)
-          (test-equal 1 (car (force (stream-drop s 4))))
-          (test-equal "effect, 3" 5 effect)))
-      (test-group "reenter 1"
-        (letrec* ((count 0)
-                  (p (delay (begin (set! count (+ count 1))
-                                   (if (> count x)
-                                       count
-                                       (force p)))))
-                  (x 5))
-          (test-equal 6 (force p))
-          (set! x 10)
-          (test-equal 6 (force p))))
-      (test-group "reenter 2"
-        (letrec* ((first? #t)
-                  (f (delay (if first?
-                                (begin
-                                  (set! first? #f)
-                                  (force f))
-                                'second))))
-          (test-equal 'second (force f))))
-      (test-group "reenter 3"
-        (letrec* ((count 5)
-                  (p (delay (if (<= count 0)
-                                count
-                                (begin (set! count (- count 1))
-                                       (force p)
-                                       (set! count (- count 2))
-                                       count)))))
-          (test-assert 5 count)
-          (test-assert 0 (force p))
-          (test-assert 10 count))))
-    (define (test-preliminaries)
-      (test-assert "promises are a distinct type"
-        (let ((x (make-promise #t)))
-          (and (not (or (procedure? x)
-                        (pair? x)
-                        (vector? x)))
-               (promise? x))))
-      (test-assert "forcing a value is valid"
-        (let ((ok (lambda (x) (equal? (force x) x))))
-          (and (ok #t)
-               (ok #\x)
-               (ok 0)
-               (ok "a")
-               (ok 'a)
-               (ok '(1 2 3))
-               (ok '#(1 2 3))
-               (ok (list 1 2 3))
-               (ok (vector 1 2 3))
-               (ok '())
-               (ok #u8(1 2 3))
-               (ok (lambda (x) x)))))
-      (let* ((x 0)
-             (expr (h:set! x (+ x 1))))
-        (test-assert "set! returns a promise"
-          (promise? expr))
-        (test-equal "set! has not run yet"
-                    0
-                    x)
-        (force expr)
-        (test-equal "set! is effectful"
-                    1
-                    x)
-        (force expr)
-        (test-equal "set! does not run more than once"
-                    1
-                    x)))
     (define (test-lambda)
-      (test-assert "lambda returns a procedure"
-        (procedure? (h:lambda (x) x)))
       (test-assert "application of lambda returns a promise"
-        (promise? ((h:lambda (x) x) 5)))
+                   (promise? ((h:lambda (x) x) 5)))
       (test-equal "forcing a promise returns the value"
                   5
                   (force ((h:lambda (x) x) 5)))
-      (let ()
-        (h:define (id x) x)
-        (test-assert "internal define is a procedure"
-          (procedure? id)))
       (let* ((effect 'not-run)
              (expr (h:lambda (x y) x)))
         (force (expr (h:set! effect 'run) (h:set! effect 'error)))
@@ -199,7 +65,7 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                     effect)))
     (define (test-if)
       (test-assert "if returns a promise"
-        (promise? (h:if #t #t #f)))
+                   (promise? (h:if #t #t #f)))
       (test-equal "forcing if runs it"
                   'true
                   (force (h:if #t 'true 'false)))
@@ -226,13 +92,13 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
       (test-equal "let works as normal"
                   5
                   (h:let ((x 5))
-                    x))
+                         x))
       (let ((loop (h:let loop ((x 0))
-                    (if (< x 10)
-                        (loop (+ x 1))
-                        x))))
+                         (if (< x 10)
+                             (loop (+ x 1))
+                             x))))
         (test-assert "named let returns a promise"
-          (promise? loop))
+                     (promise? loop))
         (test-equal "forcing named let runs the promise"
                     10
                     (force loop))))
@@ -241,14 +107,14 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                          (acc 0 (h:+ acc 1)))
                         ((h:null? l) acc))))
         (test-assert "do returns a promise"
-          (promise? loop))
+                     (promise? loop))
         (test-equal "do runs when forced"
                     3
                     (force loop)))
       (let* ((effect 0)
              (loop (h:do ((l '(a b c) (h:cdr l)))
                          ((h:null? l))
-                     (h:set! effect (+ effect 1)))))
+                         (h:set! effect (+ effect 1)))))
         (test-equal "do has not run yet"
                     0
                     effect)
@@ -258,7 +124,7 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                     effect)))
     (define (test-seq)
       (test-assert "seq returns a promise"
-        (promise? (h:seq #t #t #t)))
+                   (promise? (h:seq #t #t #t)))
       (test-equal "seq returns its last argument"
                   5
                   (force (h:seq 0 1 2 3 4 5)))
@@ -274,52 +140,52 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
     (define (test-cond)
       ;; TODO: Test on non-CHICKEN systems.
       (cond-expand
-        (chicken
-         (test-assert "cond returns a promise"
-           (promise? (h:cond (#t #t) (else #f))))
-         (let ((x 1))
-           (test-equal "cond works like cond"
-                       'true
-                       (force (h:cond
-                                ((h:= x 0) 0)
-                                ((h:= x 1) 'true)
-                                (else 'false)))))
-         (let* ((effect 'not-run)
-                (expr (h:cond
-                        ((h:seq (h:set! effect 'run-once)
-                                #t) #t)
-                        (else (h:set! effect 'false) #f))))
-           (test-equal "cond has not run yet"
-                       'not-run
-                       effect)
-           (test-assert "cond works like cond, 2"
-             (force expr))
-           (test-equal "cond has made an effect"
-                       'run-once
-                       effect)))))
+       (chicken
+        (test-assert "cond returns a promise"
+                     (promise? (h:cond (#t #t) (else #f))))
+        (let ((x 1))
+          (test-equal "cond works like cond"
+                      'true
+                      (force (h:cond
+                              ((h:= x 0) 0)
+                              ((h:= x 1) 'true)
+                              (else 'false)))))
+        (let* ((effect 'not-run)
+               (expr (h:cond
+                       ((h:seq (h:set! effect 'run-once)
+                               #t) #t)
+                       (else (h:set! effect 'false) #f))))
+          (test-equal "cond has not run yet"
+                      'not-run
+                      effect)
+          (test-assert "cond works like cond, 2"
+                       (force expr))
+          (test-equal "cond has made an effect"
+                      'run-once
+                      effect)))))
     (define (test-case)
       (cond-expand
-        (chicken
-         (let ((expr (h:case 5
-                       ((1 2 3 4) 'a)
-                       ((5 6 7 8) 'b)
-                       (else 'c))))
-           (test-assert "case returns a promise"
-             (promise? expr))
-           (test-equal "case runs as normal"
-                       'b
-                       (force expr))))))
+       (chicken
+        (let ((expr (h:case 5
+                            ((1 2 3 4) 'a)
+                            ((5 6 7 8) 'b)
+                            (else 'c))))
+          (test-assert "case returns a promise"
+                       (promise? expr))
+          (test-equal "case runs as normal"
+                      'b
+                      (force expr))))))
     (define (test-and)
       (let* ((effect 0)
              (expr (h:and 1 2 3 (h:seq (h:set! effect 1) #f)
                           (h:seq (h:set! effect 2) #t))))
         (test-assert "and returns a promise"
-          (promise? expr))
+                     (promise? expr))
         (test-equal "and has not run yet"
                     0
                     effect)
         (test-assert "and runs as normal for falses"
-          (not (force expr)))
+                     (not (force expr)))
         (test-equal "and is non-strict"
                     1
                     effect))
@@ -327,33 +193,33 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                   5
                   (force (h:and 1 2 3 4 5)))
       (test-assert "and run as normal for the zero argument case"
-        (h:and)))
+                   (h:and)))
     (define (test-or)
       (let* ((effect 0)
              (expr (h:or #f #f #f (h:seq (h:set! effect 1) #t)
                          (h:seq (h:set! effect 2) #f))))
         (test-assert "or returns a promise"
-          (promise? expr))
+                     (promise? expr))
         (test-equal "or has not run yet"
                     0
                     effect)
         (test-assert "or runs as normal for truths"
-          (force expr))
+                     (force expr))
         (test-equal "or is non-strict"
                     1
                     effect))
       (test-assert "or runs as normal for falses"
-        (not (force (h:or #f #f))))
+                   (not (force (h:or #f #f))))
       (test-assert "or runs as normal for the zero argument case"
-        (not (force (h:or)))))
+                   (not (force (h:or)))))
     (define (test-when-and-unless)
       (let* ((effect 0)
              (expr1 (h:when #f (h:set! effect 1)))
              (expr2 (h:unless #t (h:set! effect 2))))
         (test-assert "when returns a promise"
-          (promise? expr1))
+                     (promise? expr1))
         (test-assert "unless returns a promise"
-          (promise? expr2))
+                     (promise? expr2))
         (test-equal "neither have run yet"
                     0
                     effect)
@@ -378,11 +244,11 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                     effect)))
     (define (test-record-types)
       (h:define-record-type <test>
-        (kons kar kdr kbr)
-        kons?
-        (kar kar)
-        (kdr kdr)
-        (kbr kbr))
+                            (kons kar kdr kbr)
+                            kons?
+                            (kar kar)
+                            (kdr kdr)
+                            (kbr kbr))
       (let* ((effect 0)
              (expr (kons (h:seq (h:set! effect 1)
                                 10)
@@ -391,9 +257,9 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                          (h:seq (h:set! effect 3)
                                 30))))
         (test-assert "constructor returns a promise"
-          (promise? expr))
+                     (promise? expr))
         (test-assert "forcing returns a value that the predicate accepts"
-          (force (kons? expr)))
+                     (force (kons? expr)))
         (test-equal "constructor is not strict in any argument"
                     0
                     effect)
@@ -423,7 +289,7 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                             (h:seq (h:set! effect2 1) 1)
                             (h:list (h:seq (h:set! effect3 1) 2)))))
         (test-assert "apply returns a promise"
-          (promise? expr))
+                     (promise? expr))
         (test-equal "apply has not run yet"
                     '(0 0 0)
                     (list effect effect2 effect3))
@@ -447,7 +313,7 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                          (h:seq (h:set! effect2 3)
                                 in2))))
         (test-assert "returns a promise"
-          (promise? expr))
+                     (promise? expr))
         (test-equal "not run yet"
                     '(0 0)
                     (list effect1 effect2))
@@ -463,7 +329,7 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                   (recursive-force (h:exact-integer-sqrt 5))))
     (define (test-wrappers-from-strict)
       (test-assert "pair?"
-        (force (h:pair? (h:cons 1 2)))))
+                   (force (h:pair? (h:cons 1 2)))))
     (define (test-constructors)
       (test-group "cons"
         (let* ((effect1 0)
@@ -499,12 +365,12 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                         (h:seq (h:set! effect3 1) 0)
                         (h:seq (h:set! effect4 1) 10))))
         (test-assert "< returns a promise"
-          (promise? expr))
+                     (promise? expr))
         (test-equal "< has not run yet"
                     '(0 0 0 0)
                     (list effect1 effect2 effect3 effect4))
         (test-assert "< works for the false case"
-          (not (force expr)))
+                     (not (force expr)))
         (test-equal "< is not necessarily strict"
                     '(1 1 1 0)
                     (list effect1 effect2 effect3 effect4))))
@@ -517,9 +383,9 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                                  (h:vector 4 5 6 (h:seq (h:set! effect2 1)
                                                         7)))))
         (test-assert "vector-map returns a promise"
-          (promise? expr))
+                     (promise? expr))
         (test-assert "vector-map forced returns a vector"
-          (vector? (force expr)))
+                     (vector? (force expr)))
         (test-equal "vector-map is non-strict"
                     '(1 0)
                     (list effect1 effect2))
@@ -585,7 +451,7 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                     '(0 0)
                     (list effect1 effect2))
         (test-assert "list? works"
-          (force expr))
+                     (force expr))
         (test-equal "list? does not force the values of the list"
                     '(0 1)
                     (list effect1 effect2))))
@@ -593,7 +459,7 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
       (let* ((effect 0)
              (expr (h:make-list (h:seq (h:set! effect (+ effect 1)) 5) 10)))
         (test-assert "expr makes a list"
-          (force (h:list? expr)))
+                     (force (h:list? expr)))
         (test-equal "make-list is strict in its first argument"
                     1
                     effect)
@@ -702,8 +568,8 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
     (define (test-member)
       (let* ((effect 0)
              (expr (h:member 10 (h:let loop ((x 0))
-                                  (h:seq (h:set! effect (force x))
-                                         (h:cons x (loop (h:+ x 1))))))))
+                                       (h:seq (h:set! effect (force x))
+                                              (h:cons x (loop (h:+ x 1))))))))
         (test-equal "member works as expected"
                     10
                     (force (h:car expr)))
@@ -714,10 +580,10 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
       (let* ((effect 0)
              (expr (h:assoc 10 (h:let loop ((x 0)
                                             (y 2))
-                                 (h:seq (h:set! effect (force x))
-                                        (h:cons (h:cons x y)
-                                                (loop (h:+ x 1)
-                                                      (h:* y 2))))))))
+                                      (h:seq (h:set! effect (force x))
+                                             (h:cons (h:cons x y)
+                                                     (loop (h:+ x 1)
+                                                           (h:* y 2))))))))
         (test-equal "assoc works as expected"
                     '(10 . 2048)
                     (recursive-force expr))
@@ -733,7 +599,7 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
       (let* ((expr1 (h:list->string (h:list #\x #\y #\z)))
              (expr2 (h:list->string '(#\x #\y #\z))))
         (test-assert "works"
-          (string=? (force expr1) (force expr2) "xyz"))))
+                     (string=? (force expr1) (force expr2) "xyz"))))
     (define (test-make-vector)
       (let* ((effect 0)
              (expr (h:make-vector (h:seq (h:set! effect (+ effect 1)) 10) 0)))
@@ -764,28 +630,28 @@ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
                   1
                   (force (h:let* ((x 0)
                                   (x (h:+ x 1)))
-                           x)))
+                                 x)))
       (test-assert "letrec"
-        (force (h:letrec ((odd? (h:lambda (x)
-                                  (h:if (h:zero? x)
-                                        #f
-                                        (even? (h:- x 1)))))
-                          (even? (h:lambda (x)
-                                   (h:if (h:zero? x)
-                                         #t
-                                         (odd? (h:- x 1))))))
-                 (even? 88))))
+                   (force (h:letrec ((odd? (h:lambda (x)
+                                                     (h:if (h:zero? x)
+                                                           #f
+                                                           (even? (h:- x 1)))))
+                                     (even? (h:lambda (x)
+                                           (h:if (h:zero? x)
+                                                 #t
+                                                 (odd? (h:- x 1))))))
+                                    (even? 88))))
       (test-equal "letrec*"
                   5
                   (force (h:letrec* ((p (h:lambda (x)
-                                          (h:+ 1 (q (h:- x 1)))))
+                                                  (h:+ 1 (q (h:- x 1)))))
                                      (q (h:lambda (y)
-                                          (h:if (h:zero? y)
-                                                0
-                                                (h:+ 1 (p (h:- y 1))))))
+                                                  (h:if (h:zero? y)
+                                                        0
+                                                        (h:+ 1 (p (h:- y 1))))))
                                      (x (p 5))
                                      (y x))
-                           y))))
+                                    y))))
     #;(define (test-misc-wrapped-procedures)
         (let-syntax ((test-wrapped
                       (syntax-rules ()