tests, chibi support

18 files changed, 1636 insertions, 132 deletions

diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..8bec17f
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,12 @@
+Copyright (C) Peter McGoron 2025
+
+Permission to use, copy, modify, and/or distribute this software for
+any purpose with or without fee is hereby granted.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..0355ac5
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,7 @@
+.POSIX:
+
+help:
+	echo 'make clean'
+
+clean:
+	rm -f *.so *.import.scm *.o *.link *.build.sh *.import.c *.install.sh
diff --git a/README.md b/README.md
index 568bda7..3ab935b 100644
--- a/README.md
+++ b/README.md
@@ -186,3 +186,9 @@ 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.
+
+## License
+
+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.
diff --git a/chicken.svnwiki b/chicken.svnwiki
index 23dd9b4..d03d749 100644
--- a/chicken.svnwiki
+++ b/chicken.svnwiki
@@ -34,6 +34,12 @@ Since HaScheme is lazy, one can write infinite lists with it:
 
 This code snippet will run in a constant amount of space. (The procedure {{!}} is a strictness annotation to avoid thunk buildup. Since HaScheme is emedded within a call-by-value language, the strictness annotation will always force {{i}} at every iteration of the loop, even if neither part of the pair is accessed.)
 
+Why use this?
+
+1. To have fun.
+2. To show Haskellers that you don't need some fancy static type system to have pervasive lazyness.
+3. To implement lazy code that can be used with strict code.
+
 HaScheme does not support continuations, parameters, exceptions, or multiple value returns.
 
 === Author
@@ -61,14 +67,16 @@ Exports everything from {{(scheme base)}} as lazy procedures, except
 * Anything to do with ports, except for {{eof-object}} and {{eof-object?}}
 * {{make-parameter}}, {{parameterize}}
 * Anything involving exceptions, except for {{error}}, {{error-object?}}, {{error-object-message}}, {{error-object-irritants}}
-* {{do}}
+* {{for-each}}, {{vector-for-each}}
 * {{floor/}}, {{truncate/}}, and {{exact-integer-sqrt}} are exported, but return lists.
 
 The functions act as one would expect they would act. Forcing {{(car x)}} forces {{x}}, but forcing {{(cons x y)}} does not force {{x}} or {{y}}.
 
 Syntax that introduces procedures, like {{lambda}}, {{define}}, and named {{let}} make lazy procedures. Lazy procedures return a promise that when forced, force the body of the procedure.
 
-Note that control syntax like {{if}} and {{cond}} are still syntax. They can be implemented as functions, but then they will have subtly different behavior when it comes to explicitly forcing values.
+Bodies are regular bodies: they can have internal {{define}}s.
+
+Note that control syntax like {{if}} and {{cond}} are still syntax. They can be implemented as functions, but then they will have subtly different behavior when it comes to explicitly forcing values. Conditinoals force tests.
 
 String, bytevector, and number constructors are always eager. List and vector constructors are lazy.
 
@@ -78,6 +86,16 @@ This library also exports {{seq}}.
 
 Forces all arguments except its last argument. Returns its last argument unchanged.
 
+<syntax>(define-record-type name (cstr name ...) predicate? (name accessor) ...)</syntax>
+
+Creates a record type, as if by the regular {{define-record-type}}. This form gives no way to create setters.
+
+The constructor is always non-strict in its arguments, and the accessors always force their arguments.
+
+<syntax>(do ((id init [update]) ...) (condition body ...) inner-body ...)</syntax>
+
+Like the do loop of before, except that the value that {{inner-body ...}} eventually evaluates to is forced for effect. Since {{inner-body ...}} is a body, nothing else is forced for effect. Consider using {{seq}} here.
+
 ==== {{(hascheme case-lambda)}}
 
 Exports {{case-lambda}}, which creates lazy procedures.
@@ -92,11 +110,11 @@ Exports lazy procedure versions of {{(scheme complex)}}.
 
 ==== {{(hascheme cxr)}}
 
-Exports lazy procedure versions of {{(hascheme cxr)}}.
+Exports lazy procedure versions of {{(scheme cxr)}}.
 
 ==== {{(hascheme inexact)}}
 
-Exports lazy procedure versions of {{(hascheme inexact)}}.
+Exports lazy procedure versions of {{(scheme inexact)}}.
 
 ==== {{(hascheme control)}}
 
@@ -147,6 +165,47 @@ Returns a promise to force each {{expr}}, bind it to {{formal}}, and then execut
 
 This library also exports {{seq}}.
 
+==== {{(hascheme lists)}}
+
+This library exports all identifiers from [[https://srfi.schemers.org/srfi-1|SRFI-1]], except for
+
+* {{circular-list?}}
+* {{car+cdr}}
+* {{length+}}
+* {{for-each}}, {{pair-for-each}}, {{map-in-order}}
+* {{set-car!}}, {{set-cdr!}}
+* {{unzip[n]}} (see below)
+
+All procedures that normally return multiple values return lists.
+
+In addition, this library exports other procedures.
+
+<procedure>(length>=? list n)</procedure>
+<procedure>(length>? list n)</procedure>
+<procedure>(length<=? list n)</procedure>
+<procedure>(length<? list n)</procedure>
+<procedure>(length=? list n)</procedure>
+
+Determine the size of the list by looking at only {{n}} elements. This
+will decide the size of finite or infinite lists in all cases where {{n}}
+is not infinite. All list lengths are less than or equal to infinity,
+and all lists are not greater than infinity.
+
+<procedure>(unzip lists)</procedure>
+
+Returns a list, whose first element is the first element of each {{lists}},
+the second element is the second element of each {{lists}}, and so on until
+the first empty list.
+
+<procedure>(list-iterate proc base)</procedure>
+
+This procedure is based off of the one in [[https://srfi.schemers.org/srfi-41/srfi-41.html|SRFI-41]].
+
+Create an infinite list where the first element is {{(proc base)}}, and
+the second element is {{(proc (proc base))}}, etc.
+
+This procedure is eager in {{base}}.
+
 === Misc. Information
 
 ==== How is it implemented?
@@ -163,7 +222,7 @@ Three critical things are needed to make HaScheme ergonomic:
 *# Forcing a value returns the value.
 *# Forcing {{(delay-force x)}} is equivalent to a tail call to {{(force x)}}.
 
-Chicken does all three. There is nothing fancy going on here, just some (relatively) easy-to-understand {{syntax-rules}} macros.
+Chicken does all three. There is nothing fancy going on here, just some (relatively) easy-to-understand {{syntax-rules}} macros. There is a shim for implementations that don't offer the above guarantees.
 
 ==== Fun (or pain) with Laziness
 
@@ -294,16 +353,22 @@ values without forcing the promise.
 * Lightly tested.
 * I want to implement some purely functional data structures.
 
+== Version History
+
+; 0.2.0 : Added missing {{do}} form, misc. fixes, alot more tests, lists library, change license to 0BSD
+; 0.1.0 : Initial Release
+
 === License
 
-Copyright 2025 Peter McGoron
+Copyright (C) Peter McGoron 2025
 
-Licensed under the Apache License, Version 2.0 (the "License");
-you may not use this file except in compliance with the License.
-You may obtain a copy of the License at [[http://www.apache.org/licenses/LICENSE-2.0]].
+Permission to use, copy, modify, and/or distribute this software for
+any purpose with or without fee is hereby granted.
 
-Unless required by applicable law or agreed to in writing, software
-distributed under the License is distributed on an "AS IS" BASIS,
-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-See the License for the specific language governing permissions and
-limitations under the License.
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
diff --git a/hascheme.egg b/hascheme.egg
index c92d2e9..3097481 100644
--- a/hascheme.egg
+++ b/hascheme.egg
@@ -2,7 +2,7 @@
  (version "0.1.0")
  (synopsis "Implictly Lazy Scheme embedded into Scheme")
  (category lang-exts)
- (license "Apache-2.0")
+ (license "BSD 0-clause")
  (dependencies r7rs)
  (test-dependencies srfi-64)
  (components (extension hascheme.base
@@ -10,17 +10,28 @@
                (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)
+               (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)
+               (component-dependencies hascheme.eager hascheme.implementation-support)
                (csc-options "-R" "r7rs" "-X" "r7rs"))
              (extension hascheme.eager
                (source "lib/hascheme/eager.sld")
+               (component-dependencies hascheme.implementation-support
+                                       hascheme.prelude)
                (csc-options "-R" "r7rs" "-X" "r7rs"))
              (extension hascheme.char
                (source "lib/hascheme/char.sld")
@@ -42,4 +53,8 @@
                (source "lib/hascheme/inexact.sld")
                (component-dependencies hascheme.base hascheme.eager)
                (csc-options "-R" "r7rs" "-X" "r7rs"))
-             ))
+             (extension hascheme.lists
+               (source "lib/hascheme/lists.sld")
+               (source-dependencies "lib/hascheme/lists.scm")
+               (component-dependencies hascheme.base hascheme.case-lambda hascheme.cxr)
+               (csc-options "-R" "r7rs" "-X" "r7rs"))))
diff --git a/lib/hascheme/base.scm b/lib/hascheme/base.scm
index 8f2f927..7a2a7a5 100644
--- a/lib/hascheme/base.scm
+++ b/lib/hascheme/base.scm
@@ -1,9 +1,10 @@
 (define-syntax let
   ;; Named let needs to be modified to use lazy lambda
   (syntax-rules ()
-    ((let ((formal expr) ...) body ...)
+    ((_ ()) #f)
+    ((_ ((formal expr) ...) body ...)
      (r7rs:let ((formal expr) ...) body ...))
-    ((let name ((formal expr) ...) body ...)
+    ((_ name ((formal expr) ...) body ...)
      (letrec ((name (lambda (formal ...) body ...)))
        (name expr ...)))))
 
@@ -11,59 +12,68 @@
   (syntax-rules ()
     ((if x y ...) (delay-force (r7rs:if (! x) y ...)))))
 
+(define-syntax do
+  (syntax-rules ()
+    ((_ ((arg init update ...) ...)
+        (condition body ...)
+        inner-body ...)
+     (let loop ((arg init) ...)
+       (if condition
+           (let () body ...)
+           (seq (let () inner-body ...)
+                (let-syntax ((do-update
+                              (syntax-rules ()
+                                ((_ %init) %init)
+                                ((_ _ %update) %update))))
+                  (loop (do-update init update ...) ...))))))))
+
 (define-syntax cond
   (syntax-rules (else =>)
-    ((cond "iter" (else result1 result2 ...))
+    ((cond (else result1 result2 ...))
      (let () result1 result2 ...))
-    ((cond "iter" (test => result))
+    ((cond (test => result))
      (let ((temp test))
        (if temp (result temp))))
-    ((cond "iter" (test => result) clause1 clause2 ...)
+    ((cond (test => result) clause1 clause2 ...)
      (let ((temp test))
        (if temp
            (result temp)
-           (cond "iter" clause1 clause2 ...))))
-    ((cond "iter" (test)) test)
-    ((cond "iter" (test) clause1 clause2 ...)
+           (cond clause1 clause2 ...))))
+    ((cond (test)) test)
+    ((cond (test) clause1 clause2 ...)
      (let ((temp test))
        (if temp
            temp
-           (cond "iter" clause1 clause2 ...))))
-    ((cond "iter" (test result1 result2 ...))
+           (cond clause1 clause2 ...))))
+    ((cond (test result1 result2 ...))
      (if test (let () result1 result2 ...)))
-    ((cond "iter" (test result1 result2 ...)
+    ((cond (test result1 result2 ...)
            clause1 clause2 ...)
      (if test
          (let () result1 result2 ...)
-         (cond "iter" clause1 clause2 ...)))
-    ((cond clauses ...)
-     (delay-force (cond "iter" clauses ...)))))
+         (cond clause1 clause2 ...)))))
 
 (define-syntax case
-  ;; TODO: fix with delay-force
   (syntax-rules (else =>)
-    ((case (key ...) clauses ...)
-     (let ((atom-key (key ...)))
-       (case atom-key clauses ...)))
+    ((_ (key ...) clauses ...)
+     (let ((tmp (key ...)))
+       (case tmp clauses ...)))
     ((case key (else => result))
      (result key))
     ((case key (else result1 result2 ...))
      (let () result1 result2 ...))
     ((case key ((atoms ...) result1 result2 ...))
-     (if (memv key '(atoms ...))
-         (let () result1 result2 ...)))
-    ((case key
-       ((atoms ...) => result))
-     (if (memv key '(atoms ...))
-         (result key)))
-    ((case key
-       ((atoms ...) => result)
+     (when (memv key '(atoms ...))
+       result1 result2 ...))
+    ((case key ((atoms ...) => result))
+     (when (memv key '(atoms ...))
+       (result key)))
+    ((case key ((atoms ...) => result)
        clause clauses ...)
      (if (memv key '(atoms ...))
          (result key)
          (case key clause clauses ...)))
-    ((case key
-       ((atoms ...) result1 result2 ...)
+    ((case key ((atoms ...) result1 result2 ...)
        clause clauses ...)
      (if (memv key '(atoms ...))
          (let () result1 result2 ...)
@@ -71,11 +81,20 @@
 
 (define-syntax and
   (syntax-rules ()
-    ((and x ...) (delay-force (r7rs:and (! x) ...)))))
+    ((_) #t)
+    ((_ x) x)
+    ((_ x y ...)
+     (if (! x) (and y ...) #f))))
 
 (define-syntax or
   (syntax-rules ()
-    ((or x ...) (delay-force (r7rs:or (! x) ...)))))
+    ((_) #f)
+    ((_ x) x)
+    ((_ x y ...)
+     (let ((tmp x))
+       (if (! tmp)
+           tmp
+           (or y ...))))))
 
 (define-syntax when
   (syntax-rules ()
@@ -87,57 +106,90 @@
 
 (define-syntax define-record-type
   (syntax-rules ()
-    ((_ name (cstr field ...) predicate (field accessor) ...)
+    ((_ name (cstr etc ...) predicate (field accessor) ...)
      (define-record-type "tmps" name
-       (cstr cstr-tmp)
+       (cstr (cstr-tmp etc ...))
        (predicate predicate-tmp)
        ()
        ((field accessor) ...)))
     ((_ "tmps" name _c _? (tmps ...) ((field accessor) rest ...))
      (define-record-type "tmps" name _c _? ((tmp field accessor) tmps ...) (rest ...)))
-    ((_ "tmps" name (cstr cstr-tmp) (predicate predicate-tmp)
+    ((_ "tmps" name (cstr (cstr-tmp etc ...)) (predicate predicate-tmp)
         ((accessor-tmp field accessor) ...) ())
-     (r7rs:begin
-      (r7rs:define-record-type name
-                               (cstr-tmp field ...)
-                               predicate-tmp
-                               (field accessor-tmp) ...)
-      (define-wrappers-for-lazy ((cstr field ...) cstr-tmp))
-      (define-wrappers-from-strict
-          ;; Record type
-        ((predicate x) predicate-tmp)
-        ((accessor x) accessor-tmp) ...)))))
-
-(define (apply proc . arguments) (r7rs:apply r7rs:apply (! proc) arguments))
+     (r7rs:define-values (cstr predicate accessor ...)
+       (let ()
+         (r7rs:define-record-type name
+                                  (cstr-tmp etc ...)
+                                  predicate-tmp
+                                  (field accessor-tmp) ...)
+         (define-wrappers-for-lazy ((cstr field ...) cstr-tmp))
+         (define-wrappers-from-strict
+             ;; Record type
+           ((predicate x) predicate-tmp)
+           ((accessor x) accessor-tmp) ...)
+         (r7rs:values cstr predicate accessor ...))))))
+
+(define (apply proc . arguments)
+  (if (null? arguments)
+      (! proc)
+      (r7rs:apply (! proc)
+                  (r7rs:let loop ((arguments arguments))
+                            (r7rs:if (r7rs:null? (r7rs:cdr arguments))
+                                     (!list (r7rs:car arguments))
+                                     (r7rs:cons (r7rs:car arguments)
+                                                (loop (r7rs:cdr arguments))))))))
 
 (define (error message . irritants)
-  (r7rs:apply r7rs:error message irritants))
+  (r7rs:apply r7rs:error (! message) irritants))
 
 (r7rs:define (!list list)
-             (let loop ((list (! list))
-                        (acc '()))
-               (if (null? list)
-                   (reverse acc)
-                   (loop (! (cdr list)) (cons (car list) acc)))))
-
-;;; Equivalence procedures
+             (r7rs:let loop ((list (! list))
+                             (acc '()))
+                       (r7rs:if (r7rs:null? list)
+                                (r7rs:reverse acc)
+                                (loop (! (r7rs:cdr list))
+                                      (r7rs:cons (r7rs:car list) acc)))))
 
 (define (floor/ x y)
   (r7rs:let-values (((r1 r2) (r7rs:floor/ (! x) (! y))))
-                   (r7rs:list x y)))
+                   (r7rs:list r1 r2)))
 (define (truncate/ x y)
   (r7rs:let-values (((r1 r2) (r7rs:truncate/ (! x) (! y))))
-                   (r7rs:list x y)))
+                   (r7rs:list r1 r2)))
 
-(define (exact-integer-sqrt x y)
+(define (exact-integer-sqrt x)
   (r7rs:let-values (((r1 r2) (r7rs:exact-integer-sqrt (! x))))
                    (r7rs:list r1 r2)))
 
+(define (equal? x y)
+  (or (eqv? x y)
+      (and (number? x) (number? y)
+           (= x y))
+      (and (pair? x) (pair? y)
+           (equal? (car x) (car y))
+           (equal? (cdr x) (cdr y)))
+      (and (vector? x) (vector? y)
+           (= (vector-length x) (vector-length y))
+           (let loop ((i 0))
+             (cond
+               ((= i (vector-length x)) #t)
+               ((equal? (vector-ref x i) (vector-ref y i))
+                (loop (+ i 1)))
+               (else #f))))
+      (and (string? x) (string? y) (string=? x y))
+      (and (bytevector? x) (bytevector? y)
+           (= (bytevector-length x) (bytevector-length y))
+           (let loop ((i 0))
+             (cond
+               ((= i (bytevector-length x)) #t)
+               ((= (bytevector-u8-ref x) (bytevector-u8-ref y))
+                (loop (+ i 1)))
+               (else #f))))))
+
 (define-wrappers-from-strict
     ;; Equivalence procedures
   ((eq? x y) r7rs:eq?)
   ((eqv? x y) r7rs:eqv?)
-  ((equal? x y) r7rs:equal?)
   ;; Numbers
   ((number? x) r7rs:number?)
   ((complex? x) r7rs:complex?)
@@ -222,6 +274,7 @@
   ((bytevector-length x) r7rs:bytevector-length)
   (bytevector-copy r7rs:bytevector-copy)
   (bytevector-append r7rs:bytevector-append)
+  ((bytevector-u8-ref bv x) r7rs:bytevector-u8-ref)
   (utf8->string r7rs:utf8->string)
   (string->utf8 r7rs:string->utf8)
   ;; Control feature
@@ -258,8 +311,7 @@
   (string<? r7rs:string<?)
   (string<=? r7rs:string<=?)
   (string>? r7rs:string>?)
-  (string>=? r7rs:string>=?)
-  (vector-map r7rs:vector-map))
+  (string>=? r7rs:string>=?))
 
 (define-wrappers-for-lazy
     ;;; Lists and pairs
@@ -301,7 +353,7 @@
     (cond
       ((pair? list) (loop (cdr list) (! (+ i 1))))
       ((null? list) i)
-      (else (error "not a list" list)))))
+      (else #f))))
 
 (define append
   (case-lambda
@@ -339,8 +391,7 @@
     ((obj list equal?)
      (let loop ((list list))
        (cond
-         ((null? list) #f)
-         ((not (pair? list) (error "not a pair" list)))
+         ((not (pair? list)) #f)
          ((equal? (car list) obj) list)
          (else (loop (cdr list))))))))
 
@@ -353,8 +404,7 @@
     ((obj list equal?)
      (let loop ((list list))
        (cond
-         ((null? list) #f)
-         ((not (pair? list) (error "not a pair" list)))
+         ((not (pair? list)) #f)
          ((equal? (caar list) obj) (car list))
          (else (loop (cdr list))))))))
 
@@ -395,3 +445,22 @@
 (define (list->vector list)
   (r7rs:list->vector (!list list)))
 
+(define (vector-map proc x1 . x-rest)
+  (define (ok? i vectors)
+    (or (null? vectors)
+        (and (< i (vector-length (car vectors)))
+             (ok? i (cdr vectors)))))
+  (define vectors (cons x1 x-rest))
+  (list->vector
+   (let loop ((i 0))
+     (if (not (ok? i vectors))
+         '()
+         (cons (apply proc (map (lambda (x) (vector-ref x i))
+                                vectors))
+               (loop (+ i 1)))))))
+
+(define (list-copy x)
+  (if (pair? x)
+      (cons (car x) (list-copy (cdr x)))
+      x))
+
diff --git a/lib/hascheme/base.sld b/lib/hascheme/base.sld
index cefc26d..badb119 100644
--- a/lib/hascheme/base.sld
+++ b/lib/hascheme/base.sld
@@ -1,19 +1,21 @@
 (define-library (hascheme base)
   (import (prefix (except (scheme base)
                           quote define-syntax syntax-rules
-                          let* letrec letrec*)
+                          let-syntax letrec-syntax
+                          let* letrec letrec* ... _)
                   r7rs:)
           (only (scheme base) define-syntax syntax-rules quote
-                let* letrec letrec*)
-          (scheme lazy)
+                let* letrec letrec* ... _ let-syntax letrec-syntax)
+          (hascheme implementation-support)
           (rename (hascheme prelude)
                   (hs:lambda lambda)
                   (hs:define define))
           (hascheme eager)
           (hascheme case-lambda))
-  (export lambda define let let* letrec letrec*
+  (export lambda define let let* letrec letrec* do
           if or and when unless cond case
           define-record-type
+          quote
           seq
           ;; equivalent procedures
           eq? eqv? equal?
@@ -35,6 +37,7 @@
           list-tail list-ref
           member memq memv
           assoc assq assv
+          list-copy
           ;; symbols
           symbol? symbol=? symbol->string string->symbol
           ;; chars
@@ -49,12 +52,17 @@
           vector-copy vector-append vector make-vector list->vector
           ;; bytevectors
           bytevector? make-bytevector bytevector bytevector-length
+          bytevector-u8-ref
           bytevector-copy bytevector-append utf8->string string->utf8
           ;; control features
           procedure? string-map apply map
           ;; exceptions
           error error-object? error-object-message error-object-irritants
           read-error? file-error?
+          vector-map
           ;; Ports
           eof-object eof-object?)
+  (cond-expand
+    ((not chicken) (export _ ... =>))
+    (else))
   (include "base.scm"))
\ No newline at end of file
diff --git a/lib/hascheme/case-lambda.sld b/lib/hascheme/case-lambda.sld
index 74646d7..b1b765c 100644
--- a/lib/hascheme/case-lambda.sld
+++ b/lib/hascheme/case-lambda.sld
@@ -1,5 +1,6 @@
 (define-library (hascheme case-lambda)
   (import (scheme base) (hascheme eager)
+          (hascheme implementation-support)
           (prefix (scheme case-lambda) r7rs:))
   (export case-lambda)
   (begin
diff --git a/lib/hascheme/cxr.sld b/lib/hascheme/cxr.sld
index 9435689..4c44901 100644
--- a/lib/hascheme/cxr.sld
+++ b/lib/hascheme/cxr.sld
@@ -1,8 +1,17 @@
 (define-library (hascheme cxr)
   (import (hascheme base))
-  (export caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
+  (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)
   (begin
+    (define (caaar x) (car (car (car x))))
+    (define (caadr x) (car (car (cdr x))))
+    (define (cadar x) (car (cdr (car x))))
+    (define (caddr x) (car (cdr (cdr x))))
+    (define (cdaar x) (cdr (car (car x))))
+    (define (cdadr x) (cdr (car (cdr x))))
+    (define (cddar x) (cdr (cdr (car x))))
+    (define (cdddr x) (cdr (cdr (cdr x))))
     (define (caaaar x) (car (car (car (car x)))))
     (define (caaadr x) (car (car (car (cdr x)))))
     (define (caadar x) (car (car (cdr (car x)))))
diff --git a/lib/hascheme/eager.sld b/lib/hascheme/eager.sld
index 91b0ade..d3ae3bd 100644
--- a/lib/hascheme/eager.sld
+++ b/lib/hascheme/eager.sld
@@ -1,5 +1,6 @@
 (define-library (hascheme eager)
-  (import (scheme base) (scheme lazy) (scheme case-lambda)
+  (import (scheme base) (scheme case-lambda)
+          (hascheme implementation-support)
           (hascheme prelude))
   (export define-wrappers-from-strict
           define-wrappers-for-lazy
@@ -45,10 +46,14 @@
                      #f)))))
            (define-binary-wrapper rest ...)))
         ((_) (begin))))
-    (define seq
-      (case-lambda
-        ((x) x)
-        ((x . y) (delay-force (begin (! x) (apply seq y))))))
+    (define (seq x . rest)
+      (delay-force
+       (let loop ((x x) (rest rest))
+         (if (null? rest)
+             x
+             (begin
+               (! x)
+               (loop (car rest) (cdr rest)))))))
     (define-syntax let*!
       (syntax-rules ()
         ((_ ((formal expr) ...) body ...)
diff --git a/lib/hascheme/implementation-support.sld b/lib/hascheme/implementation-support.sld
new file mode 100644
index 0000000..1b506eb
--- /dev/null
+++ b/lib/hascheme/implementation-support.sld
@@ -0,0 +1,85 @@
+#| 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/lists.scm b/lib/hascheme/lists.scm
new file mode 100644
index 0000000..1fb41e0
--- /dev/null
+++ b/lib/hascheme/lists.scm
@@ -0,0 +1,373 @@
+;;; TODO: Provably infinite lists.
+;;; 
+;;; Provable infinities are distinct data types than cons cells that can
+;;; still be car and cdr'd, along with all of the other operations. A
+;;; provably infinite pair is a list that is append to itself forever,
+;;; except that unlike truly infinite lists (like the naturals), it is
+;;; marked as infinite.
+;;; 
+;;; This should probably be in a separate library.
+
+;;; Constructors
+
+(define (xcons x y) (cons y x))
+
+(define cons*
+  (case-lambda
+    ((x) x)
+    ((x y . rest) (cons x (apply cons* y rest)))))
+
+(define (list-tabulate n init-proc)
+  (unless (and (number? n)
+               (or (= n +inf.0)
+                   (and (positive? n) (exact-integer? n))))
+    (error "invalid list-tabulate length" n))
+  (let loop ((i 0))
+    (if (= i n)
+        '()
+        (cons (init-proc i) (loop (+ i 1))))))
+
+(define (circular-list first . elements)
+  (define total (cons first elements))
+  (let loop ((elements total))
+    (if (null? elements)
+        (loop total)
+        (cons (car elements) (loop (cdr elements))))))
+
+(define iota
+  (case-lambda
+    ((count) (iota count 0))
+    ((count start) (iota count start 1))
+    ((count start step)
+     (unless (and (number? count) (number? start) (number? step)
+                  (or (= +inf.0 count)
+                      (positive? count) (exact-integer? count))
+                  (positive? start) (exact-integer? start)
+                  (positive? step) (exact-integer? step))
+       (error "invalid arguments" count start step))
+     (let loop ((i 0) (el start))
+       (if (= i count)
+           '()
+           (cons el (loop (+ i 1)
+                          (! (+ el step)))))))))
+
+;;; Predicates
+
+(define (not-pair? x) (not (pair? x)))
+(define null-list? list?)
+(define proper-list? list?)
+(define (dotted-list? x)
+  (or (not-pair? x) (and (pair? x) (dotted-list? (cdr x)))))
+
+(define list=
+  (case-lambda
+    ((=) #t)
+    ((= l1) #t)
+    ((= l1 l2)
+     (cond
+       ((and (null? l1) (null? l2)) #t)
+       ((not (and (pair? l1) (pair? l2))) #f)
+       ((= (car l1) (car l2))
+        => (lambda (res)
+             (if (and (null? (cdr l1) (cdr l2)))
+                 res
+                 (list= (cdr l1) (cdr l2)))))
+       (else #f)))
+    ((= l1 l2 . l-rest)
+     (and (list= l1 l2)
+          (apply list= l2 l-rest)))))
+
+;;; Selectors
+
+(define first car)
+(define second cadr)
+(define (third x) (list-ref x 3))
+(define (fourth x) (list-ref x 4))
+(define (fifth x) (list-ref x 5))
+(define (sixth x) (list-ref x 6))
+(define (seventh x) (list-ref x 7))
+(define (eighth x) (list-ref x 8))
+(define (ninth x) (list-ref x 9))
+(define (tenth x) (list-ref x 10))
+
+(define (take x i)
+  (unless (and (exact-integer? i) (>= i 0))
+    (error "invalid number" i))
+  (let loop ((x x) (i i))
+    (cond
+      ((zero? i) '())
+      ((null? x) (error "list too short" x))
+      (else (cons (car x) (loop (cdr x) (- i 1)))))))
+
+(define drop list-tail)
+
+(define (take-right x i) (drop x (- (length x) i)))
+(define (drop-right x i) (take x (- (length x) i)))
+(define drop-right! drop-right)
+
+(define (last x) (car (last-pair x)))
+(define (last-pair x) (take-right x 1))
+
+(define (split-at x i) (list (take x i) (drop x i)))
+(define split-at! split-at)
+
+;;; Misc
+
+(define (length>=? list n)
+  (let loop ((list list) (n n))
+    (cond
+      ((not (positive? n)) #t)
+      ((not-pair? list) #f)
+      (else (length>=? (cdr list) (- n 1))))))
+
+(define (length>? list n)
+  (and (not (= n +inf.0))
+       (length>=? list (+ n 1))))
+
+(define (length<=? list n)
+  (or (= n +inf.0)
+      (let loop ((list list) (n n))
+        (and (not (negative? n))
+             (or (not-pair? list)
+                 (length<=? (cdr list) (- n 1)))))))
+
+(define (length<? list n)
+  (or (= n +inf.0)
+      (length<=? list (- n 1))))
+
+(define (length=? list n)
+  (and (length>=? list n) (length<=? list n)))
+
+(define (concatenate ll)
+  (let loop ((ll ll))
+    (cond
+      ((null? ll) ll)
+      ((not-pair? ll) (error "not a proper list of lists" ll))
+      ((null? (cdr ll)) (car ll))
+      (else (let loop* ((x (car ll)))
+              (cond
+                ((null? x) (loop (cdr ll)))
+                ((not-pair? x) (error "not a proper list" x))
+                (else (cons (car x) (loop* (cdr x))))))))))
+(define concatenate! concatenate)
+(define append! append)
+(define reverse! reverse)
+
+(define (append-reverse rev-head tail)
+  (append (reverse rev-head) tail))
+(define append-reverse! append-reverse)
+
+(define (zip . lists) (apply map list lists))
+(define (unzip lists)
+  (if (any null? lists)
+      '()
+      (cons (map car lists) (unzip (map cdr lists)))))
+
+(define (count pred l1 . lists)
+  (let loop ((lists (cons l1 lists))
+             (count 0))
+    (cond
+      ((any null? lists) count)
+      ((apply pred lists) (loop (map cdr lists)
+                                (! (+ count 1))))
+      (else (loop (map cdr lists) count)))))
+
+;;; Fold, unfold, and map
+
+(define (%fold eager? kons knil . lists)
+  (cond
+    ((any null? lists) knil)
+    (else (%fold eager? kons
+                 (apply kons (append (map car lists)
+                                     (list (if eager?
+                                               (! knil)
+                                               knil))))
+                 (map cdr lists)))))
+
+(define (fold kons knil . lists)
+  (apply %fold #f kons knil lists))
+
+(define (fold! kons knil . lists)
+  (apply %fold #t kons knil lists))
+
+(define (fold-right kons knil . lists)
+  (cond
+    ((any null? lists) knil)
+    (else (apply kons
+                 (append (map car lists)
+                         (list (apply fold-right
+                                      kons
+                                      knil
+                                      (map cdr lists))))))))
+
+(define (reduce f ridentity list)
+  (if (null? list)
+      ridentity
+      (fold f (car list) (cdr list))))
+
+(define (reduce! f ridentity list)
+  (if (null? list)
+      ridentity
+      (fold! f (car list) (cdr list))))
+
+(define (reduce-right f ridentity list)
+  (cond
+    ((null? list) ridentity)
+    ((length=? list 1) (list-ref list 0))
+    (else (fold-right f (car list) (cdr list)))))
+
+(define unfold
+  (case-lambda
+    ((p f g seed) (unfold p f seed (lambda (x) '())))
+    ((p f g seed tail-gen)
+     (if (p seed)
+         (tail-gen seed)
+         (cons (f seed) (unfold p f g (g seed) tail-gen))))))
+
+(define unfold-right
+  (case-lambda
+    ((p f g seed) (unfold-right p f g seed '()))
+    ((p f g seed tail)
+     (let lp ((seed seed) (lis tail))
+       (if (p seed)
+           lis
+           (lp (g seed) (! (cons (f seed) lis))))))))
+
+(define (append-map f . lists)
+  (apply append (apply map f lists)))
+(define append-map! append-map)
+
+(define (filter-map f . lists)
+  (filter (lambda (x) x) (apply map f lists)))
+
+;;; Filtering and partitioning
+
+(define (filter pred x)
+  (cond
+    ((and (pair? x) (pred (car x)))
+     (cons (car x) (filter pred (cdr x))))
+    ((pair? x) (filter pred (cdr x)))
+    (else x)))
+(define filter! filter)
+
+(define (remove pred x) (filter (lambda (x) (not (pred x))) x))
+(define remove! remove)
+
+
+(define (partition pred list)
+  (list (filter pred list) (filter (lambda (x) (not (pred x))) list)))
+(define partition! partition)
+
+(define (find pred list)
+  (cond
+    ((not-pair? list) #f)
+    ((pred (car list)) (car list))
+    (else (find pred (cdr list)))))
+
+(define (find-tail pred list)
+  (cond
+    ((not-pair? list) #f)
+    ((pred (car list)) list)
+    (else (find-tail pred (cdr list)))))
+
+(define (take-while pred list)
+  (cond
+    ((not-pair? list) '())
+    ((pred (car list))
+     (cons (car list) (take-while pred (cdr list))))
+    (else (take-while pred (cdr list)))))
+(define take-while! take-while)
+
+(define (drop-while pred list)
+  (cond
+    ((not-pair? list) list)
+    ((pred (car list)) (drop-while pred (cdr list)))
+    (else list)))
+
+(define (span pred x)
+  (list (take-while pred x) (drop-while pred x)))
+(define span! span)
+(define (break pred x) (span (lambda (x) (not (pred x))) x))
+(define break! break)
+
+(define (any-null? lists)
+  (cond
+    ((null? lists) #f)
+    ((null? (car lists)) #t)
+    (else (any-null? (cdr lists)))))
+
+(define (any pred . lists)
+  (let loop ((lists lists))
+    (and (not (any-null? lists))
+         (or (apply pred (map car lists))
+             (loop (map cdr lists))))))
+
+(define (every pred . lists)
+  (let loop ((lists lists))
+    (or (any null? lists)
+        (let ((value (apply pred (map car lists)))
+              (next (map cdr lists)))
+          (if (any null? next)
+              value
+              (loop next))))))
+
+(define (list-index pred . lists)
+  (let loop ((lists lists)
+             (i 0))
+    (and (not (any null? lists))
+         (if (apply pred (map car lists))
+             i
+             (loop (map cdr lists) (! (+ i 1)))))))
+
+(define delete
+  (case-lambda
+    ((x list) (delete x list equal?))
+    ((x list =) (remove (lambda (y) (= x y)) list))))
+(define delete! delete)
+
+(define delete-duplicates
+  (case-lambda
+    ((list) (delete-duplicates list equal?))
+    ((list =)
+     (let loop ((list list) (found '()))
+       (cond
+         ((not-pair? list) list)
+         ((member (car list) found equal?)
+          (loop (cdr list) found))
+         (else (cons (car list)
+                     (loop (cdr list) (cons (car list) found)))))))))
+(define delete-duplicates! delete-duplicates)
+
+(define (list-set list n val)
+  (unless (and (exact-integer? n) (not (negative? n)))
+    (error "not a non-negative exact integer" n))
+  (let loop ((list list) (n n))
+    (cond
+      ((not-pair? list) (error "list truncated" list n val))
+      ((zero? n) (cons val (cdr list)))
+      (else (cons (car list) (loop (cdr list) (- n 1)))))))
+
+(define map! map)
+
+(define (alist-cons k v a) (cons (cons k v) a))
+(define (alist-copy x)
+  (if (null? x)
+      x
+      (cons (cons (caar x) (cdar x)) (alist-copy (cdr x)))))
+
+(define alist-delete
+  (case-lambda
+    ((k a) (alist-delete k a equal?))
+    ((k a =)
+     (if (null? a)
+         a
+         (let ((key2 (caar a)))
+           (if (= k key2)
+               (cons (car a) (alist-delete k (cdr a) =))
+               (alist-delete k (cdr a) =)))))))
+
+(define alist-delete! alist-delete)
+
+(define (list-iterate proc base)
+  (let ((new (proc (! base))))
+    (cons new (list-iterate proc new))))
diff --git a/lib/hascheme/lists.sld b/lib/hascheme/lists.sld
new file mode 100644
index 0000000..ba9490b
--- /dev/null
+++ b/lib/hascheme/lists.sld
@@ -0,0 +1,29 @@
+(define-library (hascheme lists)
+  (import (hascheme base) (hascheme case-lambda) (hascheme cxr) (hascheme eager))
+  (export cons list xcons cons* make-list list-tabulate circular-list iota
+          list-copy
+          pair? null? proper-list? dotted-list? null-list? not-pair? list=
+          car cdr
+          cadr caar cddr cdar
+          caaar caadr cadar caddr cdaar cdadr cddar cdddr
+          caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
+          cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
+          first second third fourth fifth sixth seventh eighth ninth tenth
+          list-ref take drop take-right drop-right drop-right!
+          split-at split-at! last last-pair
+          length length>=? length>? length<? length<=? length=?
+          append append! concatenate concatenate! reverse reverse!
+          append-reverse append-reverse!
+          zip unzip count
+          fold fold! fold-right reduce reduce!
+          unfold unfold-right append-map append-map! filter-map
+          map map!
+          filter remove partition
+          filter! remove! partition!
+          find find-tail take-while take-while! drop-while span break
+          span! break!
+          any every list-index member memv memq
+          delete delete-duplicates
+          delete! delete-duplicates!
+          assoc assq assv alist-cons alist-copy alist-delete alist-delete!)
+  (include "lists.scm"))
\ No newline at end of file
diff --git a/lib/hascheme/prelude.sld b/lib/hascheme/prelude.sld
index e532ab5..61a65e0 100644
--- a/lib/hascheme/prelude.sld
+++ b/lib/hascheme/prelude.sld
@@ -1,12 +1,11 @@
 (define-library (hascheme prelude)
-  (import (scheme base) (scheme lazy))
+  (import (scheme base) (hascheme implementation-support))
   (export hs:lambda hs:define)
   (begin
     (define-syntax hs:lambda
       (syntax-rules ()
         ((_ formal body ...)
-         (lambda formal (delay-force (let ()
-                                       (seq body ...)))))))
+         (lambda formal (delay-force (let () body ...))))))
     (define-syntax hs:define
       (syntax-rules ()
         ((_ (name . formals) body ...)
diff --git a/lib/hascheme/support.sld b/lib/hascheme/support.sld
new file mode 100644
index 0000000..99d9a58
--- /dev/null
+++ b/lib/hascheme/support.sld
@@ -0,0 +1,24 @@
+(define-library (hascheme support)
+  (import (scheme base) (hascheme implementation-support))
+  (export user-defined-forcers recursive-force)
+  (begin
+    (define user-defined-forcers
+      (make-parameter
+       (list (cons procedure?
+                   (lambda (x)
+                     (lambda args
+                       (recursive-force (apply x args))))))))
+    (define (find-user-defined-forcer x)
+      (let loop ((forcers (user-defined-forcers)))
+        (cond
+          ((null? forcers) #f)
+          (((caar forcers) x) (cdar forcers))
+          (else (loop (cdr forcers))))))
+    (define (recursive-force x)
+      (let ((x (force x)))
+        (cond
+          ((pair? x) (cons (recursive-force (car x))
+                           (recursive-force (cdr x))))
+          ((vector? x) (vector-map recursive-force x))
+          ((find-user-defined-forcer x) => (lambda (forcer) (forcer x)))
+          (else x))))))
\ No newline at end of file
diff --git a/lib/tests/hascheme/base.sld b/lib/tests/hascheme/base.sld
new file mode 100644
index 0000000..4ce4c79
--- /dev/null
+++ b/lib/tests/hascheme/base.sld
@@ -0,0 +1,825 @@
+(define-library (tests hascheme base)
+  (import (scheme base)
+          (hascheme implementation-support)
+          (hascheme support)
+          (prefix (hascheme base) h:))
+  (cond-expand
+    (chicken (import (srfi 64) (chicken condition)))
+    (chibi (import (except (chibi test) test test-equal)
+                   (rename (only (chibi test) test) (test test-equal))))
+    (else (import (srfi 64))))
+  (export test-base)
+  (begin
+    (define-syntax h:set!
+      (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))
+      (test-group "do" (test-do))
+      (test-group "case" (test-case))
+      (test-group "and" (test-and))
+      (test-group "or" (test-or))
+      (test-group "when and unless" (test-when-and-unless))
+      (test-group "record types" (test-record-types))
+      (test-group "apply" (test-apply))
+      (test-group "floor/" (test-converted-number-function h:floor/
+                                                           -5 2
+                                                           '(-3 1)))
+      (test-group "truncate/" (test-converted-number-function h:truncate/
+                                                              -5 2
+                                                              '(-2 -1)))
+      (test-group "exact-integer-sqrt" (test-exact-integer-sqrt))
+      (test-group "equal?" (my-test-equal?))
+      (test-group "wrappers from strict" (test-wrappers-from-strict))
+      (test-group "constructors" (test-constructors))
+      (test-group "binary wrappers" (test-binary-wrappers))
+      (test-group "vector-map" (test-vector-map))
+      (test-group "list?" (test-list?))
+      (test-group "make-list" (test-make-list))
+      (test-group "length" (test-length))
+      (test-group "append" (test-append))
+      (test-group "reverse" (test-reverse))
+      (test-group "list-tail" (test-list-tail))
+      (test-group "list-ref" (test-list-ref))
+      (test-group "member" (test-member))
+      (test-group "assoc" (test-assoc))
+      (test-group "map" (test-map))
+      (test-group "list->string" (test-list->string))
+      (test-group "make-vector" (test-make-vector))
+      (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)))
+      (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)))
+        (test-equal "lambda is not non-strict"
+                    'run
+                    effect)))
+    (define (test-if)
+      (test-assert "if returns a promise"
+        (promise? (h:if #t #t #f)))
+      (test-equal "forcing if runs it"
+                  'true
+                  (force (h:if #t 'true 'false)))
+      (let* ((effect 'not-run)
+             (test-effect 'not-run)
+             (expr (h:if (h:seq (h:set! test-effect 'run)
+                                #f)
+                         (h:set! effect 'true)
+                         (h:set! effect 'false))))
+        (test-equal "creation of if does not run anything"
+                    'not-run
+                    effect)
+        (test-equal "creation of if does not run anything, 2"
+                    'not-run
+                    test-effect)
+        (force expr)
+        (test-equal "if is eager in the predicate"
+                    'run
+                    test-effect)
+        (test-equal "forcing if forces the path"
+                    'false
+                    effect)))
+    (define (test-let)
+      (test-equal "let works as normal"
+                  5
+                  (h:let ((x 5))
+                    x))
+      (let ((loop (h:let loop ((x 0))
+                    (if (< x 10)
+                        (loop (+ x 1))
+                        x))))
+        (test-assert "named let returns a promise"
+          (promise? loop))
+        (test-equal "forcing named let runs the promise"
+                    10
+                    (force loop))))
+    (define (test-do)
+      (let ((loop (h:do ((l '(a b c) (h:cdr l))
+                         (acc 0 (h:+ acc 1)))
+                        ((h:null? l) acc))))
+        (test-assert "do returns a promise"
+          (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)))))
+        (test-equal "do has not run yet"
+                    0
+                    effect)
+        (force loop)
+        (test-equal "do runs its body for effects, fresh each time"
+                    3
+                    effect)))
+    (define (test-seq)
+      (test-assert "seq returns a promise"
+        (promise? (h:seq #t #t #t)))
+      (test-equal "seq returns its last argument"
+                  5
+                  (force (h:seq 0 1 2 3 4 5)))
+      (let ((effect1 0)
+            (effect2 0))
+        (test-equal "force has not run yet"
+                    '(0 0)
+                    (list effect1 effect2))
+        (force (h:seq (h:set! effect1 1) (h:set! effect2 2)))
+        (test-equal "seq forces all arguments"
+                    '(1 2)
+                    (list effect1 effect2))))
+    (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)))))
+    (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))))))
+    (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))
+        (test-equal "and has not run yet"
+                    0
+                    effect)
+        (test-assert "and runs as normal for falses"
+          (not (force expr)))
+        (test-equal "and is non-strict"
+                    1
+                    effect))
+      (test-equal "and runs as normal for truthy"
+                  5
+                  (force (h:and 1 2 3 4 5)))
+      (test-assert "and run as normal for the zero argument case"
+        (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))
+        (test-equal "or has not run yet"
+                    0
+                    effect)
+        (test-assert "or runs as normal for truths"
+          (force expr))
+        (test-equal "or is non-strict"
+                    1
+                    effect))
+      (test-assert "or runs as normal for falses"
+        (not (force (h:or #f #f))))
+      (test-assert "or runs as normal for the zero argument case"
+        (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))
+        (test-assert "unless returns a promise"
+          (promise? expr2))
+        (test-equal "neither have run yet"
+                    0
+                    effect)
+        (force expr1)
+        (test-equal "when acts as normal for false cases"
+                    0
+                    effect)
+        (force expr2)
+        (test-equal "unless acts as normal for true cases"
+                    0
+                    effect))
+      (let* ((effect 0)
+             (expr1 (h:when (h:and) (h:set! effect 1)))
+             (expr2 (h:unless (h:or) (h:set! effect 2))))
+        (force expr1)
+        (test-equal "when acts as normal for true cases"
+                    1
+                    effect)
+        (force expr2)
+        (test-equal "unless acts as normal for false cases"
+                    2
+                    effect)))
+    (define (test-record-types)
+      (h:define-record-type <test>
+        (kons kar kdr kbr)
+        kons?
+        (kar kar)
+        (kdr kdr)
+        (kbr kbr))
+      (let* ((effect 0)
+             (expr (kons (h:seq (h:set! effect 1)
+                                10)
+                         (h:seq (h:set! effect 2)
+                                20)
+                         (h:seq (h:set! effect 3)
+                                30))))
+        (test-assert "constructor returns a promise"
+          (promise? expr))
+        (test-assert "forcing returns a value that the predicate accepts"
+          (force (kons? expr)))
+        (test-equal "constructor is not strict in any argument"
+                    0
+                    effect)
+        (test-equal "accessor 2"
+                    20
+                    (force (kdr expr)))
+        (test-equal "accessor is strict in its argument"
+                    2
+                    effect)
+        (test-equal "accessor 3"
+                    30
+                    (force (kbr expr)))
+        (test-equal "accessor 3 is strict in its argument"
+                    3
+                    effect)
+        (test-equal "accessor 1"
+                    10
+                    (force (kar expr)))
+        (test-equal "accessor 1 is strict in its argument"
+                    1
+                    effect)))
+    (define (test-apply)
+      (let* ((effect 0)
+             (effect2 0)
+             (effect3 0)
+             (expr (h:apply (h:seq (h:set! effect 1) (h:lambda (x y) x))
+                            (h:seq (h:set! effect2 1) 1)
+                            (h:list (h:seq (h:set! effect3 1) 2)))))
+        (test-assert "apply returns a promise"
+          (promise? expr))
+        (test-equal "apply has not run yet"
+                    '(0 0 0)
+                    (list effect effect2 effect3))
+        (test-equal "apply runs as expected"
+                    1
+                    (force expr))
+        (test-equal "apply is strict in its first argument"
+                    1
+                    effect)
+        (test-equal "apply is strict as its input function"
+                    1
+                    effect2)
+        (test-equal "apply is not strict where its input is not"
+                    0
+                    effect3)))
+    (define (test-converted-number-function proc in1 in2 out)
+      (let* ((effect1 0)
+             (effect2 0)
+             (expr (proc (h:seq (h:set! effect1 2)
+                                in1)
+                         (h:seq (h:set! effect2 3)
+                                in2))))
+        (test-assert "returns a promise"
+          (promise? expr))
+        (test-equal "not run yet"
+                    '(0 0)
+                    (list effect1 effect2))
+        (test-equal "returns correct values"
+                    out
+                    (recursive-force expr))
+        (test-equal "effects"
+                    '(2 3)
+                    (list effect1 effect2))))
+    (define (test-exact-integer-sqrt)
+      (test-equal "works"
+                  '(2 1)
+                  (recursive-force (h:exact-integer-sqrt 5))))
+    (define (test-wrappers-from-strict)
+      (test-assert "pair?"
+        (force (h:pair? (h:cons 1 2)))))
+    (define (test-constructors)
+      (test-group "cons"
+        (let* ((effect1 0)
+               (effect2 0)
+               (expr (h:cons (h:seq (h:set! effect1 1) 1)
+                             (h:seq (h:set! effect2 1) 2))))
+          (force expr)
+          (test-equal "cons is not strict"
+                      '(0 0)
+                      (list effect1 effect2))
+          (test-equal "accessing car works"
+                      1
+                      (force (h:car expr)))
+          (test-equal "effects after car"
+                      '(1 0)
+                      (list effect1 effect2))
+          (test-equal "accessing cdr works"
+                      2
+                      (force (h:cdr expr)))
+          (test-equal "effects after cdr"
+                      '(1 1)
+                      (list effect1 effect2))
+          (test-equal "recursive force"
+                      '(1 . 2)
+                      (recursive-force expr)))))
+    (define (test-binary-wrappers)
+      (let* ((effect1 0)
+             (effect2 0)
+             (effect3 0)
+             (effect4 0)
+             (expr (h:< (h:seq (h:set! effect1 1) 1)
+                        (h:seq (h:set! effect2 1) 2)
+                        (h:seq (h:set! effect3 1) 0)
+                        (h:seq (h:set! effect4 1) 10))))
+        (test-assert "< returns a promise"
+          (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)))
+        (test-equal "< is not necessarily strict"
+                    '(1 1 1 0)
+                    (list effect1 effect2 effect3 effect4))))
+    (define (test-vector-map)
+      (let* ((effect1 0)
+             (effect2 0)
+             (expr (h:vector-map (h:lambda (x y) (h:+ x y))
+                                 (h:seq (h:set! effect1 1)
+                                        (h:vector 1 2 3))
+                                 (h:vector 4 5 6 (h:seq (h:set! effect2 1)
+                                                        7)))))
+        (test-assert "vector-map returns a promise"
+          (promise? expr))
+        (test-assert "vector-map forced returns a vector"
+          (vector? (force expr)))
+        (test-equal "vector-map is non-strict"
+                    '(1 0)
+                    (list effect1 effect2))
+        (test-equal "vector-map returns as expected"
+                    '#(5 7 9)
+                    (recursive-force expr))))
+    (define (my-test-equal?)
+      (test-group "equal? on equal lists"
+        (let* ((effect1 0)
+               (effect2 0)
+               (effect3 0)
+               (effect4 0)
+               (expr (h:equal? (h:list (h:seq (h:set! effect1 1) 1)
+                                       (h:seq (h:set! effect2 1) 2))
+                               (h:list (h:seq (h:set! effect3 1) 1)
+                                       (h:seq (h:set! effect4 1) 2)))))
+          (test-assert "equal" (force expr))
+          (test-equal "equal? is strict on equal values"
+                      '(1 1 1 1)
+                      (list effect1 effect2 effect3 effect4))))
+      (test-group "equal? on unequal lists"
+        (let* ((effect1 0)
+               (effect2 0)
+               (effect3 0)
+               (expr (h:equal? (h:list (h:seq (h:set! effect1 1) 1))
+                               (h:list (h:seq (h:set! effect2 1) 1)
+                                       (h:seq (h:set! effect3 1) 2)))))
+          (test-assert "not equal" (not (force expr)))
+          (test-equal "equal? is not strict in all values"
+                      '(1 1 0)
+                      (list effect1 effect2 effect3))))
+      (test-group "equal? on equal vectors"
+        (let* ((effect1 0)
+               (effect2 0)
+               (effect3 0)
+               (effect4 0)
+               (expr (h:equal? (h:vector (h:seq (h:set! effect1 1) 1)
+                                         (h:seq (h:set! effect2 1) 2))
+                               (h:vector (h:seq (h:set! effect3 1) 1)
+                                         (h:seq (h:set! effect4 1) 2)))))
+          (test-assert "equal" (force expr))
+          (test-equal "equal? is strict on equal values"
+                      '(1 1 1 1)
+                      (list effect1 effect2 effect3 effect4))))
+      (test-group "equal? on unequal vectors"
+        (let* ((effect1 0)
+               (effect2 0)
+               (effect3 0)
+               (expr (h:equal? (h:vector (h:seq (h:set! effect1 1) 1))
+                               (h:vector (h:seq (h:set! effect2 1) 1)
+                                         (h:seq (h:set! effect3 1) 2)))))
+          (test-assert "not equal" (not (force expr)))
+          (test-equal "equal? is not strict in all values"
+                      '(0 0 0)
+                      (list effect1 effect2 effect3)))))
+    (define (test-list?)
+      (let* ((effect1 0)
+             (effect2 0)
+             (expr (h:list? (h:cons (h:seq (h:set! effect1 1) 1)
+                                    (h:seq (h:set! effect2 1)
+                                           (h:cons 2 '()))))))
+        (test-equal "expression has not run yet"
+                    '(0 0)
+                    (list effect1 effect2))
+        (test-assert "list? works"
+          (force expr))
+        (test-equal "list? does not force the values of the list"
+                    '(0 1)
+                    (list effect1 effect2))))
+    (define (test-make-list)
+      (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)))
+        (test-equal "make-list is strict in its first argument"
+                    1
+                    effect)
+        (test-equal "first element"
+                    10
+                    (force (h:car expr)))
+        (test-equal "second element"
+                    10
+                    (force (h:cadr expr)))
+        (test-equal "recursive force"
+                    '(10 10 10 10 10)
+                    (recursive-force expr)))
+      (let* ((expr (h:make-list +inf.0 10)))
+        (test-equal "infinity is OK"
+                    10
+                    (force (h:cadr expr)))))
+    (define (test-length)
+      (let* ((effect1 0)
+             (effect2 0)
+             (effect3 0)
+             (expr (h:length (h:list (h:seq (h:set! effect1 1) 1)
+                                     (h:seq (h:set! effect2 1) 2)
+                                     (h:seq (h:set! effect3 1) 3)))))
+        (test-equal "length works on lists"
+                    3
+                    (force expr))
+        (test-equal "length does not force values in the list"
+                    '(0 0 0)
+                    (list effect1 effect2 effect3))))
+    (define (test-append)
+      (test-equal "zero argument case" '() (force (h:append)))
+      (test-group "single argument case"
+        (let* ((effect 0)
+               (expr (h:append (h:seq (h:set! effect 1) 1))))
+          (test-equal "returns its argument"
+                      1
+                      (force expr))))
+      (test-group "multiple lists"
+        (let* ((effect0 0)
+               (effect1 0)
+               (effect2 0)
+               (expr (h:append (h:seq (h:set! effect0 1)
+                                      (h:list (h:seq (h:set! effect1 1) 1)
+                                              2))
+                               (h:seq (h:set! effect2 1) '(3 4)))))
+          (force expr)
+          (test-equal "strict in all arguments except the last"
+                      '(1 0 0)
+                      (list effect0 effect1 effect2))
+          (test-equal "append works as expected"
+                      '(1 2 3 4)
+                      (recursive-force expr)))))
+    (define (test-reverse)
+      (let* ((effect0 0)
+             (effect1 0)
+             (expr (h:reverse (h:seq (h:set! effect0 1)
+                                     (h:list (h:seq (h:set! effect1 1) 1)
+                                             2
+                                             3)))))
+        (force expr)
+        (test-equal "reverse is strict in the pairs, not the values"
+                    '(1 0)
+                    (list effect0 effect1))
+        (test-equal "reverse works as expected"
+                    '(3 2 1)
+                    (recursive-force expr))))
+    (define (test-list-tail)
+      (let* ((effect0 0)
+             (effect1 0)
+             (effect2 0)
+             (expr (h:list-tail (h:seq (h:set! effect0 1)
+                                       (h:list (h:seq (h:set! effect1 1) 1)
+                                               2
+                                               3
+                                               4))
+                                (h:seq (h:set! effect2 1)
+                                       2))))
+        (force expr)
+        (test-equal "list-tail is strict in both arguments, pairs only"
+                    '(1 0 1)
+                    (list effect0 effect1 effect2))
+        (test-equal "list-tail works as expected"
+                    '(3 4)
+                    (recursive-force expr))
+        (test-equal "list-tail never evaluates discarded values"
+                    0
+                    effect1)))
+    (define (test-list-ref)
+      (let* ((effect0 0)
+             (effect1 0)
+             (effect2 0)
+             (effect3 0)
+             (effect4 0)
+             (expr (h:list-ref (h:seq (h:set! effect0 1)
+                                      (h:list (h:seq (h:set! effect1 1) 1)
+                                              2
+                                              (h:seq (h:set! effect2 1) 3)
+                                              (h:seq (h:set! effect3 1) 4)))
+                               (h:seq (h:set! effect4 1) 2))))
+        (test-equal "evaluated to"
+                    3
+                    (force expr))
+        (test-equal "strictness of forcing the expression"
+                    '(1 0 1 0 1)
+                    (list effect0 effect1 effect2 effect3 effect4))))
+    (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))))))))
+        (test-equal "member works as expected"
+                    10
+                    (force (h:car expr)))
+        (test-equal "side effects"
+                    10
+                    effect)))
+    (define (test-assoc)
+      (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))))))))
+        (test-equal "assoc works as expected"
+                    '(10 . 2048)
+                    (recursive-force expr))
+        (test-equal "side effects"
+                    10
+                    effect)))
+    (define (test-map)
+      (let* ((expr (h:map h:+ '(1 2 3 4) '(10 20 30 40))))
+        (test-equal "works"
+                    '(11 22 33 44)
+                    (recursive-force expr))))
+    (define (test-list->string)
+      (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"))))
+    (define (test-make-vector)
+      (let* ((effect 0)
+             (expr (h:make-vector (h:seq (h:set! effect (+ effect 1)) 10) 0)))
+        (test-equal "works"
+                    '#(0 0 0 0 0 0 0 0 0 0)
+                    (recursive-force expr))
+        (test-equal "effects" 1 effect)))
+    (define (test-list->vector)
+      (let* ((effect 0)
+             (expr1 (h:list->vector (h:list (h:seq (h:set! effect 1) 1)
+                                            2 3 4)))
+             (expr2 (h:list->vector '(1 2 3 4))))
+        (force expr1)
+        (test-equal "effect" 0 effect)
+        (test-equal "works"
+                    '#(1 2 3 4)
+                    (recursive-force expr1))
+        (test-equal "works with constant"
+                    '#(1 2 3 4)
+                    (recursive-force expr2))))
+    (define (test-list-copy)
+      (test-equal "works"
+                  '(1 2 3 4)
+                  (recursive-force
+                   (h:list-copy (h:list 1 2 3 4)))))
+    (define (test-other-binding-constructs)
+      (test-equal "let*"
+                  1
+                  (force (h:let* ((x 0)
+                                  (x (h:+ x 1)))
+                           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))))
+      (test-equal "letrec*"
+                  5
+                  (force (h:letrec* ((p (h:lambda (x)
+                                          (h:+ 1 (q (h:- x 1)))))
+                                     (q (h:lambda (y)
+                                          (h:if (h:zero? y)
+                                                0
+                                                (h:+ 1 (p (h:- y 1))))))
+                                     (x (p 5))
+                                     (y x))
+                           y))))
+    #;(define (test-misc-wrapped-procedures)
+        (let-syntax ((test-wrapped
+                      (syntax-rules ()
+                        ((_ proc h:proc (args ...) ...)
+                         (test-group (symbol->string 'proc)
+                           (test-equal (proc args ...)
+                                       (force (h:proc args ...)))
+                           ...)))))
+          (test-wrapped eq? h:eq?
+                        (#f #f)
+                        (#t #t)
+                        (#f #t)
+                        ('() '())
+                        ('() 'a)
+                        ('a 'a)
+                        ('a 'b))
+          (test-wrapped eqv? h:eqv?
+                        (#f #f)
+                        (#t #t)
+                        (#f #t)
+                        ('() '())
+                        ('() 'a)
+                        ('a 'a)
+                        ('a 'b)
+                        (1 1)
+                        (1 2))
+          (test-wrapped exact-integer? h:exact-integer?
+                        (1) (2) (0) (0.1))
+          (test-wrapped negative? h:negative?
+                        (-1) (0) (1))
+          (test-wrapped positive? h:positive?
+                        (-1) (0) (1))
+          (test-wrapped zero? h:zero?
+                        (-1) (0) (1))
+          (test-wrapped + h:+
+                        (0) (0 0) (1 0))
+          (test-wrapped)))))
\ No newline at end of file
diff --git a/tests/chibi.sh b/tests/chibi.sh
new file mode 100755
index 0000000..fb4bb02
--- /dev/null
+++ b/tests/chibi.sh
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+chibi-scheme -I ../lib run.scm
diff --git a/tests/run.scm b/tests/run.scm
index f9c5c26..5c02052 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -1,44 +1,13 @@
-(import r7rs
-        (prefix (hascheme base) ha:)
-        (hascheme eager)
-        (srfi 64))
+(cond-expand
+  (chicken-5 (import r7rs (srfi 64))
+             (load "../lib/tests/hascheme/base.sld"))
+  (chibi (import (chibi test)))
+  (else (import (srfi 64))))
 
 (cond-expand
   (chicken-5 (test-runner-current (test-runner-create)))
   (else))
 
-(ha:define
- (hascheme-natural-numbers)
- (ha:let loop ((i 0)) (ha:seq i (ha:cons i (loop (ha:+ i 1))))))
-
-(ha:define (square-of-list list) (ha:map ha:square list))
-
-(test-group "lists"
-  (test-assert
-   "cons is lazy, car"
-   (force (ha:car (ha:cons #t (ha:error "boom")))))
-  (test-assert
-   "cons is lazy, cdr"
-   (guard (x ((equal? (force (error-object-message x)) "boom") #t)
-             (else #f))
-     (force (ha:cdr (ha:cons #f (ha:error "boom"))))
-     #f))
-  (test-equal
-   1000
-   (force (ha:list-ref (hascheme-natural-numbers) 1000)))
-  (let ((flag '()))
-    (test-equal
-     "map is lazy"
-     '(1000)
-     (begin
-       (force (ha:list-ref (ha:map (ha:lambda (x) (set! flag
-                                                        (cons (force x) flag)))
-                                   (hascheme-natural-numbers))
-                           1000))
-       flag)))
-  (test-equal "runs in bounded space"
-              (square 1000)
-              (force (ha:list-ref (square-of-list (hascheme-natural-numbers))
-                                  1000))))
-
+(import (tests hascheme base))
+(test-group "base" (test-base))