the rest of r7rs

12 files changed, 413 insertions, 124 deletions

diff --git a/README.md b/README.md
index 7a83fda..8ae18a4 100644
--- a/README.md
+++ b/README.md
@@ -9,8 +9,26 @@
 
 HaScheme is a pure, call-by-need dialect of Scheme (R7RS), embedded within
 Scheme itself. Procedures in HaScheme can be written in ways that look
-identical to regular Scheme. These procedures return promises which can
-be forced by non-lazy code. Hence lazy and non-lazy code can co-exist.
+identical to regular Scheme. They do not need to be explicitly `delay`ed
+or `delay-force`ed, and they only need to `force` to reduce space usage.
+HaScheme procedures return promises which can be forced by regular
+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
@@ -24,13 +42,31 @@ Why use this?
 3. To show those dirty Haskellers that you don't need no stinkin'
    static type system.
 
+## Restrictions and Implementation Notes
+
+1. No `call/cc`. [Explanation](#multiple-values-and-continuations)
+2. No `call-with-values` or multiple-valued returns.
+   [Explanation](#multiple-values-and-continuations)
+3. No exceptions (but `error` exists).
+4. Strings and bytevectors are eager objects. For example, forcing a
+   string will also force any characters and strings used to build
+   the string.
+5. Pairs and vectors are lazy objects. Forcing a pair will not force its
+   components.
+6. No mutation and no I/O (i.e. no ports).
+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.
+8. No quasiquote.
+
 ## Fun (or Pain) with Laziness
 
 You need to be careful with lazy functions because they can cause
 space leaks. This is a problem in general with lazy languages ([like
-in Haskell][1]). Here is an example:
+in Haskell][HaskellFolds]). Here is an example:
 
-[1]: https://wiki.haskell.org/Foldr_Foldl_Foldl%27
+[HaskellFolds]: https://wiki.haskell.org/Foldr_Foldl_Foldl%27
 
     (define (list-tail list n)
       (if (zero? n)
@@ -115,3 +151,21 @@ takes `n` forms, forces the first `n-1`, and returns the `n`th form.
            list
            (seq (cdr list)
                 (list-tail (cdr list) (- n 1)))))
+
+## Multiple Values and Continuations
+
+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
+language can execute any code at basically any time.
+
+A future implementation might be able to use SRFI-226's delimited
+control structures to implement continuations, because they are actual
+functions.
+
+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.
diff --git a/hascheme.egg b/hascheme.egg
index 5e9fea4..7827b22 100644
--- a/hascheme.egg
+++ b/hascheme.egg
@@ -6,12 +6,38 @@
  (components (extension hascheme.base
                (source "lib/hascheme/base.sld")
                (source-dependencies "lib/hascheme/base.scm")
-               (component-dependencies hascheme.internal hascheme.case-lambda)
+               (component-dependencies hascheme.prelude
+                                       hascheme.eager
+                                       hascheme.case-lambda)
+               (csc-options "-R" "r7rs" "-X" "r7rs"))
+             (extension hascheme.prelude
+               (source "lib/hascheme/prelude.sld")
                (csc-options "-R" "r7rs" "-X" "r7rs"))
              (extension hascheme.case-lambda
                (source "lib/hascheme/case-lambda.sld")
-               (component-dependencies hascheme.internal)
+               (component-dependencies hascheme.eager)
+               (csc-options "-R" "r7rs" "-X" "r7rs"))
+             (extension hascheme.eager
+               (source "lib/hascheme/eager.sld")
+               (csc-options "-R" "r7rs" "-X" "r7rs"))
+             (extension hascheme.char
+               (source "lib/hascheme/char.sld")
+               (component-dependencies hascheme.base hascheme.eager)
+               (csc-options "-R" "r7rs" "-X" "r7rs"))
+             (extension hascheme.complex
+               (source "lib/hascheme/complex.sld")
+               (component-dependencies hascheme.base hascheme.eager)
+               (csc-options "-R" "r7rs" "-X" "r7rs"))
+             (extension hascheme.control
+               (source "lib/hascheme/control.sld")
+               (component-dependencies hascheme.base hascheme.case-lambda)
+               (csc-options "-R" "r7rs" "-X" "r7rs"))
+             (extension hascheme.cxr
+               (source "lib/hascheme/cxr.sld")
+               (component-dependencies hascheme.base)
+               (csc-options "-R" "r7rs" "-X" "r7rs"))
+             (extension hascheme.inexact
+               (source "lib/hascheme/inexact.sld")
+               (component-dependencies hascheme.base hascheme.eager)
                (csc-options "-R" "r7rs" "-X" "r7rs"))
-             (extension hascheme.internal
-               (source "lib/hascheme/internal.sld")
-               (csc-options "-R" "r7rs" "-X" "r7rs"))))
+             ))
diff --git a/lib/hascheme/base.scm b/lib/hascheme/base.scm
index 5df19df..c00ff49 100644
--- a/lib/hascheme/base.scm
+++ b/lib/hascheme/base.scm
@@ -2,48 +2,130 @@
   ;; Named let needs to be modified to use lazy lambda
   (syntax-rules ()
     ((let ((formal expr) ...) body ...)
-     (r7rs:let ((formal expr) ...) body ...))
+     (r7rs:let ((formal expr) ...) (seq body ...)))
     ((let name ((formal expr) ...) body ...)
-     (letrec ((name (lambda (formal ...) body ...)))
+     (letrec ((name (lambda (formal ...) (seq body ...))))
        (name expr ...)))))
 
-(define if
-  (case-lambda
-    ((x y) (r7rs:if (force x) y #f))
-    ((x y z) (r7rs:if (force x) y z))))
+(define-syntax let*
+  (syntax-rules ()
+    ((let* bindings body ...)
+     (r7rs:let* bindings (seq body ...)))))
 
-(define seq
-  (case-lambda
-    ((x) x)
-    ((x . y) (force x) (apply seq y))))
+(define-syntax letrec
+  (syntax-rules ()
+    ((letrec bindings body ...)
+     (r7rs:letrec bindings (seq body ...)))))
 
-(define ! force)
+(define-syntax letrec*
+  (syntax-rules ()
+    ((letrec* bindings body ...)
+     (r7rs:letrec* bindings (seq body ...)))))
 
-(define cond*
-  (case-lambda
-    (() #f)
-    ((x) x)
-    ((x y) (if x y))
-    ((x y . rest) (if x y (apply cond* rest)))))
+(define-syntax if
+  (syntax-rules ()
+    ((if x y ...) (r7rs:if (! x) y ...))))
+
+(define-syntax cond
+  (syntax-rules (else =>)
+    ((cond (else result1 result2 ...))
+     (let () result1 result2 ...))
+    ((cond (test => result))
+     (let ((temp test))
+       (if temp (result temp))))
+    ((cond (test => result) clause1 clause2 ...)
+     (let ((temp test))
+       (if temp
+           (result temp)
+           (cond clause1 clause2 ...))))
+    ((cond (test)) test)
+    ((cond (test) clause1 clause2 ...)
+     (let ((temp test))
+       (if temp
+           temp
+           (cond clause1 clause2 ...))))
+    ((cond (test result1 result2 ...))
+     (if test (let () result1 result2 ...)))
+    ((cond (test result1 result2 ...)
+           clause1 clause2 ...)
+     (if test
+         (let () result1 result2 ...)
+         (cond clause1 clause2 ...)))))
+
+(define-syntax case
+  (syntax-rules (else =>)
+    ((case (key ...) clauses ...)
+     (let ((atom-key (key ...)))
+       (case atom-key clauses ...)))
+    ((case key (else => result))
+     (result key))
+    ((case key (else result1 result2 ...))
+     (seq 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)
+       clause clauses ...)
+     (if (memv key '(atoms ...))
+         (result key)
+         (case key clause clauses ...)))
+    ((case key
+       ((atoms ...) result1 result2 ...)
+       clause clauses ...)
+     (if (memv key '(atoms ...))
+         (let () result1 result2 ...)
+         (case key clause clauses ...)))))
+
+(define-syntax and
+  (syntax-rules ()
+    ((and x ...) (r7rs:and (! x) ...))))
 
-(define and
-  (case-lambda
-    (() #t)
-    ((x) x)
-    ((x . y) (if x (apply and y) #f))))
+(define-syntax or
+  (syntax-rules ()
+    ((or x ...) (r7rs:or (! x) ...))))
 
-(define or
-  (case-lambda
-    (() #f)
-    ((x) x)
-    ((x . y) (if x x (apply or y)))))
+(define-syntax when
+  (syntax-rules ()
+    ((when pred x ...) (r7rs:when (! pred) x ...))))
+
+(define-syntax unless
+  (syntax-rules ()
+    ((unless pred x ...) (r7rs:unless (! pred) x ...))))
 
-(define (apply proc . arguments) (r7rs:apply r7rs:apply (force proc) arguments))
+(define-syntax define-record-type
+  (syntax-rules ()
+    ((_ name (cstr field ...) predicate (field accessor) ...)
+     (define-record-type "tmps" name
+       (cstr cstr-tmp)
+       (predicate predicate-tmp)
+       ()
+       ((field accessor) ...)))
+    ((_ "tmps" name _c _? (tmps ...) ((field accessor) rest ...))
+     (_ "tmps" name _c _? ((tmp field accessor) tmps ...) (rest ...)))
+    ((_ "tmps" name (cstr cstr-tmp) (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))
 
 (define error
   (r7rs:lambda formals (delay (r7rs:apply error formals))))
 
-(r7rs:define (make-finite-list list)
+(r7rs:define (!list list)
              (let loop ((list (! list))
                         (acc '()))
                (if (null? list)
@@ -52,6 +134,17 @@
 
 ;;; Equivalence procedures
 
+(define (floor/ x y)
+  (r7rs:let-values (((r1 r2) (r7rs:floor/ (! x) (! y))))
+                   (r7rs:list x y)))
+(define (truncate/ x y)
+  (r7rs:let-values (((r1 r2) (r7rs:truncate/ (! x) (! y))))
+                   (r7rs:list x y)))
+
+(define (exact-integer-sqrt x y)
+  (r7rs:let-values (((r1 r2) (r7rs:exact-integer-sqrt (! x))))
+                   (r7rs:list r1 r2)))
+
 (define-wrappers-from-strict
     ;; Equivalence procedures
   ((eq? x y) r7rs:eq?)
@@ -59,7 +152,7 @@
   ((equal? x y) r7rs:equal?)
   ;; Numbers
   ((number? x) r7rs:number?)
-  ((complex? x) (r7rs:complex?))
+  ((complex? x) r7rs:complex?)
   ((real? x) r7rs:real?)
   ((rational? x) r7rs:rational?)
   ((integer? x) r7rs:integer?)
@@ -78,10 +171,8 @@
   (* r7rs:*)
   (/ r7rs:/)
   ((abs x) r7rs:abs)
-  ((floor/ x y) r7rs:floor/)
   ((floor-quotient x y) r7rs:floor-quotient)
   ((floor-remainder x y) r7rs:floor-remainder)
-  ((truncate/ x y) r7rs:truncate)
   ((truncate-quotient x y) r7rs:truncate-quotient)
   ((truncate-remainder x y) r7rs:truncate-remainder)
   ((quotient x y) r7rs:quotient)
@@ -97,7 +188,6 @@
   ((round x) r7rs:round)
   ((rationalize x y) r7rs:rationalize)
   ((square x) r7rs:square)
-  ((exact-integer-sqrt x) r7rs:exact-integer-sqrt)
   ((expt x y) r7rs:expt)
   ((inexact x) r7rs:inexact)
   ((exact x) r7rs:exact)
@@ -150,8 +240,8 @@
   ((procedure? x) r7rs:procedure?)
   (string-map r7rs:string-map)
   ;; Exceptions (very limited)
-  ((error-object? x) r7rs:error-object)
-  ((error-object-message x) r7rs:error-message-object)
+  ((error-object? x) r7rs:error-object?)
+  ((error-object-message x) r7rs:error-object-message)
   ((error-object-irritants x) r7rs:error-object-irritants)
   ((read-error? x) r7rs:read-error?)
   ((file-error? x) r7rs:file-error?))
@@ -161,8 +251,8 @@
   (= r7rs:=)
   (< r7rs:<)
   (> r7rs:>)
-  (= r7rs:=)
-  (= r7rs:=)
+  (<= r7rs:<=)
+  (>= r7rs:>=)
   (boolean=? r7rs:boolean=?)
   ;; Symbols
   (symbol=? r7rs:symbol=?)
@@ -177,35 +267,27 @@
   (string<? r7rs:string<?)
   (string<=? r7rs:string<=?)
   (string>? r7rs:string>?)
-  (string>=? r7rs:string>=?))
+  (string>=? r7rs:string>=?)
+  (vector-map r7rs:vector-map))
 
 (define-wrappers-for-lazy
     ;;; Lists and pairs
   ((cons x y) r7rs:cons)
   (list r7rs:list)
-  (vector r7rs:vector)
-  (values r7rs:values))
+  (vector r7rs:vector))
 
 ;;; Lists and pairs
 
-(define (list-traverse x path)
-  (cond*
-   (null? path) x
-   (not (pair? x)) (error "not a pair" x)
-   (eq? (car path) 'a) (list-traverse (car x) (cdr path))
-   (eq? (cdr path) 'd) (list-traverse (cdr x) (cdr path))
-   #t (error "invalid path" x path)))
-
-(define (caar x) (list-traverse x '(a a)))
-(define (cadr x) (list-traverse x '(d a)))
-(define (cdar x) (list-traverse x '(a d)))
-(define (cddr x) (list-traverse x '(d d)))
+(define (caar x) (car (car x)))
+(define (cadr x) (car (cdr x)))
+(define (cdar x) (cdr (car x)))
+(define (cddr x) (cdr (cdr x)))
 
 (define (list? x)
-  (cond*
-   (null? x) #t
-   (pair? x) (list? (cdr x))
-   #t #f))
+  (cond
+    ((null? x) #t)
+    ((pair? x) (list? (cdr x)))
+    (else #f)))
 
 (define (ensure-exact-positive-integer n k)
   (if (not (and (exact-integer? k) (positive? k)))
@@ -232,10 +314,10 @@
 (define (length list)
   (let loop ((list list)
              (i 0))
-    (cond*
-     (pair? list) (loop (cdr list) (! (+ i 1)))
-     (null? list) i
-     #t (error "not a list" list))))
+    (cond
+      ((pair? list) (loop (cdr list) (! (+ i 1))))
+      ((null? list) i)
+      (else (error "not a list" list)))))
 
 (define append
   (case-lambda
@@ -243,25 +325,24 @@
     ((x) x)
     ((x . y)
      (let loop ((x x))
-       (cond*
-        (pair? x) (cons (car x) (loop (cdr x)))
-        (null? x) (apply append y)
-        #t (error "invalid value" x))))))
+       (cond
+         ((pair? x) (cons (car x) (loop (cdr x))))
+         ((null? x) (apply append y))
+         (else (error "invalid value" x)))))))
 
 (define (reverse x)
   (let loop ((x x) (a '()))
-    (cond*
-     (null? x) a
-     (pair? x) (loop (cdr x) (cons (car x) a))
-     #t (error "not a pair" x))))
+    (cond
+      ((null? x) a)
+      ((pair? x) (loop (cdr x) (cons (car x) a)))
+      (else (error "not a pair" x)))))
 
 (define (list-tail list n)
   (seq (ensure-exact-positive-integer n)
        (let loop ((list list) (n n))
          (if (zero? n)
              list
-             (let ((x (! (cdr list))))
-               (list-tail x (- n 1)))))))
+             (list-tail (! (cdr list)) (- n 1))))))
 
 (define (list-ref list n)
   (car (list-tail list n)))
@@ -271,11 +352,11 @@
     ((obj list) (member obj list equal?))
     ((obj list equal?)
      (let loop ((list list))
-       (cond*
-        (null? list) #f
-        (not (pair? list) (error "not a pair" list))
-        (equal? (car list) obj) list
-        #t (loop (cdr list)))))))
+       (cond
+         ((null? list) #f)
+         ((not (pair? list) (error "not a pair" list)))
+         ((equal? (car list) obj) list)
+         (else (loop (cdr list))))))))
 
 (define (memq obj list) (member obj list eq?))
 (define (memv obj list) (member obj list eqv?))
@@ -285,14 +366,36 @@
     ((obj list) (assoc obj list equal?))
     ((obj list equal?)
      (let loop ((list list))
-       (cond*
-        (null? list) #f
-        (not (pair? list) (error "not a pair" list))
-        (equal? (caar list) obj) (car list)
-        #t (loop (cdr list)))))))
+       (cond
+         ((null? list) #f)
+         ((not (pair? list) (error "not a pair" list)))
+         ((equal? (caar list) obj) (car list))
+         (else (loop (cdr list))))))))
 
 (define (assq obj list) (assoc obj list eq?))
 (define (assv obj list) (assoc obj list eqv?))
+
+(define (any-null? lists)
+  (cond
+    ((null? lists) #f)
+    ((null? (car lists)) #t)
+    (else (any-null? (cdr lists)))))
+
+(define map
+  (case-lambda
+    ((f list)
+     (let loop ((list list))
+       (if (null? list)
+           '()
+           (cons (f (car list)) (loop (cdr list))))))
+    ((f . lists)
+     (let loop ((lists lists))
+       (if (any-null? lists)
+           '()
+           (cons (apply f (map car lists))
+                 (loop (map cdr lists))))))))
+
+
 (define (map1 f list)
   (if (null? list)
       '()
@@ -300,7 +403,7 @@
 
 ;;; list->string
 
-(define (list->string list) (r7rs:list->string (make-finite-list list)))
+(define (list->string list) (r7rs:list->string (!list list)))
 
 ;;; Vectors
 
@@ -310,5 +413,5 @@
     ((k fill) (r7rs:make-vector (! k) fill))))
 
 (define (list->vector list)
-  (r7rs:list->vector (make-finite-list list)))
+  (r7rs:list->vector (!list list)))
 
diff --git a/lib/hascheme/base.sld b/lib/hascheme/base.sld
index a2543e1..7a93fcd 100644
--- a/lib/hascheme/base.sld
+++ b/lib/hascheme/base.sld
@@ -1,27 +1,56 @@
 (define-library (hascheme base)
   (import (prefix (except (scheme base)
-                          quote quasiquote
-                          define-syntax syntax-rules
-                          let* letrec letrec*)
+                          quote define-syntax syntax-rules)
                   r7rs:)
-          (only (scheme base) define-syntax syntax-rules
-                let* letrec letrec* quote)
+          (only (scheme base) define-syntax syntax-rules quote)
           (scheme lazy)
-          (rename (hascheme internal)
+          (rename (hascheme prelude)
                   (hs:lambda lambda)
                   (hs:define define))
+          (hascheme eager)
           (hascheme case-lambda))
-  (export ! lambda define let if cond* or and error seq
+  (export lambda define let let* letrec letrec*
+          if or and when unless cond case
+          define-record-type
+          seq
+          ;; equivalent procedures
           eq? eqv? equal?
-          + - * negative? positive? zero?
+          ;; numbers
+          = < > <= >=
+          number? complex? real? rational? integer? exact? inexact?
+          exact-integer? negative? positive? zero? odd? even?
+          max min + - * / abs floor/ floor-quotient floor-remainder
+          truncate/ truncate-quotient truncate-remainder quotient
+          remainder modulo gcd lcm numerator denominator floor
+          ceiling truncate round rationalize square exact-integer-sqrt
+          expt inexact exact number->string string->number
+          ;; booleans
           boolean? not boolean=?
-          car cdr null? pair? list-traverse
-          list-tabulate
+          ;; pairs and lists
+          car cdr null? pair? cons list
           caar cadr cdar cddr
           list? make-list length append reverse
           list-tail list-ref
           member memq memv
           assoc assq assv
-          symbol? symbol->string string->symbol symbol=?
-          map1)
+          ;; symbols
+          symbol? symbol=? symbol->string string->symbol
+          ;; chars
+          char? char->integer integer->char
+          char=? char<? char<=? char>? char>=?
+          ;; strings
+          string? make-string string-length substring
+          string-append string->list string-copy
+          string=? string<=? string>? string>=? list->string
+          ;; vectors
+          vector? vector-length vector-ref vector->string string->vector
+          vector-copy vector-append vector make-vector list->vector
+          ;; bytevectors
+          bytevector? make-bytevector bytevector bytevector-length
+          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?)
   (include "base.scm"))
\ No newline at end of file
diff --git a/lib/hascheme/case-lambda.sld b/lib/hascheme/case-lambda.sld
index 5278f8d..74646d7 100644
--- a/lib/hascheme/case-lambda.sld
+++ b/lib/hascheme/case-lambda.sld
@@ -1,5 +1,5 @@
 (define-library (hascheme case-lambda)
-  (import (scheme base) (hascheme internal)
+  (import (scheme base) (hascheme eager)
           (prefix (scheme case-lambda) r7rs:))
   (export case-lambda)
   (begin
diff --git a/lib/hascheme/char.sld b/lib/hascheme/char.sld
index f589c1b..73b010e 100644
--- a/lib/hascheme/char.sld
+++ b/lib/hascheme/char.sld
@@ -1,11 +1,11 @@
 (define-library (hascheme char)
-  (import (hascheme base) (hascheme internal)
+  (import (hascheme base) (hascheme eager)
           (prefix (scheme char) r7rs:))
   (export char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?
           char-alphabetic? char-numeric? char-whitespace? char-upper-case?
           char-lower-case? digit-value char-upcase char-downcase char-foldcase
           string-ci=? string-ci<? string-ci<=? string-ci>? string-ci>=?
-          )
+          string-upcase string-downcase string-foldcase)
   (begin
     (define-binary-wrapper
         (char-ci=? r7rs:char-ci=?)
@@ -18,7 +18,8 @@
       (string-ci<=? r7rs:string-ci<=?)
       (string-ci>? r7rs:string-ci>?)
       (string-ci>=? r7rs:string-ci>=?))
-    (define-wrapper-from-strict ((char-alphabetic? x) r7rs:char-alphabetic?)
+    (define-wrappers-from-strict
+        ((char-alphabetic? x) r7rs:char-alphabetic?)
       ((char-numeric? x) r7rs:char-numeric?)
       ((char-whitespace? x) r7rs:char-whitespace?)
       ((char-upper-case? x) r7rs:char-upper-case?)
diff --git a/lib/hascheme/complex.sld b/lib/hascheme/complex.sld
index 5a5b676..6bd199f 100644
--- a/lib/hascheme/complex.sld
+++ b/lib/hascheme/complex.sld
@@ -1,6 +1,8 @@
 (define-library (hascheme complex)
-  (import (hascheme base) (hascheme internal)
-          (prefix (hascheme complex) r7rs:))
+  (import (hascheme base) (hascheme eager)
+          (prefix (scheme complex) r7rs:))
+  (export make-rectangular make-polar real-part imag-part
+          magnitude angle)
   (begin
     (define-wrappers-from-strict
         ;; Numbers
diff --git a/lib/hascheme/control.sld b/lib/hascheme/control.sld
new file mode 100644
index 0000000..a94e7d7
--- /dev/null
+++ b/lib/hascheme/control.sld
@@ -0,0 +1,33 @@
+(define-library (hascheme control)
+  (import (hascheme eager) (hascheme case-lambda)
+          (rename (hascheme base)
+                  (if if*)
+                  (cond cond*)
+                  (and and*)
+                  (or or*)))
+  (export if cond and or when unless)
+  (begin
+    (define if
+      (case-lambda
+        ((x y) (if* (! x) y #f))
+        ((x y z) (if* (! x) y z))))
+    (define cond
+      (case-lambda
+        (() #f)
+        ((x) x)
+        ((x y) (if x y))
+        ((x y . rest) (if x y (apply cond rest)))))
+    (define and
+      (case-lambda
+        (() #t)
+        ((x) x)
+        ((x . y) (if x (apply and y) #f))))
+    (define or
+      (case-lambda
+        (() #f)
+        ((x) x)
+        ((x . y) (if x x (apply or y)))))
+    (define (when pred . subsequent)
+      (if pred (apply seq subsequent)))
+    (define (unless pred . subsequent)
+      (if (not pred) (apply seq subsequent)))))
\ No newline at end of file
diff --git a/lib/hascheme/cxr.sld b/lib/hascheme/cxr.sld
new file mode 100644
index 0000000..9435689
--- /dev/null
+++ b/lib/hascheme/cxr.sld
@@ -0,0 +1,21 @@
+(define-library (hascheme cxr)
+  (import (hascheme base))
+  (export caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
+          cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr)
+  (begin
+    (define (caaaar x) (car (car (car (car x)))))
+    (define (caaadr x) (car (car (car (cdr x)))))
+    (define (caadar x) (car (car (cdr (car x)))))
+    (define (caaddr x) (car (car (cdr (cdr x)))))
+    (define (cadaar x) (car (cdr (car (car x)))))
+    (define (cadadr x) (car (cdr (car (cdr x)))))
+    (define (caddar x) (car (cdr (cdr (car x)))))
+    (define (cadddr x) (car (cdr (cdr (cdr x)))))
+    (define (cdaaar x) (cdr (car (car (car x)))))
+    (define (cdaadr x) (cdr (car (car (cdr x)))))
+    (define (cdadar x) (cdr (car (cdr (car x)))))
+    (define (cdaddr x) (cdr (car (cdr (cdr x)))))
+    (define (cddaar x) (cdr (cdr (car (car x)))))
+    (define (cddadr x) (cdr (cdr (car (cdr x)))))
+    (define (cdddar x) (cdr (cdr (cdr (car x)))))
+    (define (cddddr x) (cdr (cdr (cdr (cdr x)))))))
\ No newline at end of file
diff --git a/lib/hascheme/internal.sld b/lib/hascheme/eager.sld
index fe0eb26..7111988 100644
--- a/lib/hascheme/internal.sld
+++ b/lib/hascheme/eager.sld
@@ -1,10 +1,12 @@
-(define-library (hascheme internal)
-  (import (scheme base) (scheme lazy) (scheme case-lambda))
-  (export hs:lambda hs:define
-          define-wrappers-from-strict
+(define-library (hascheme eager)
+  (import (scheme base) (scheme lazy) (scheme case-lambda)
+          (hascheme prelude))
+  (export define-wrappers-from-strict
           define-wrappers-for-lazy
-          define-binary-wrapper)
+          define-binary-wrapper
+          ! seq let*! let*-seq)
   (begin
+    (define ! force)
     (define-syntax define-wrappers-from-strict
       (syntax-rules ()
         ((_ ((wrapper formals ...) name) rest ...)
@@ -15,7 +17,7 @@
         ((_ (wrapper name) rest ...)
          (begin
            (hs:define wrapper
-                      (lambda formal (apply name (map force formal))))
+                      (hs:lambda formal (apply name (map force formal))))
            (define-wrappers-from-strict rest ...)))
         ((_) (begin))))
     (define-syntax define-wrappers-for-lazy
@@ -43,13 +45,17 @@
                      #f)))))
            (define-binary-wrapper rest ...)))
         ((_) (begin))))
-    (define-syntax hs:lambda
+    (define seq
+      (case-lambda
+        ((x) x)
+        ((x . y) (delay-force (begin (! x) (apply seq y))))))
+    (define-syntax let*!
       (syntax-rules ()
-        ((_ formal body ...)
-         (lambda formal (delay-force (let () body ...))))))
-    (define-syntax hs:define
+        ((_ ((formal expr) ...) body ...)
+         (let* ((formal (! expr)) ...) (seq body ...)))))
+    (define-syntax let*-seq
       (syntax-rules ()
-        ((_ (name . formals) body ...)
-         (define name (hs:lambda formals body ...)))
-        ((_ name body) (define name body))))))
+        ((_ ((formal expr) ...) body ...)
+         (delay-force (let* ((formal (! expr)) ...)
+                        (seq body ...))))))))
 
diff --git a/lib/hascheme/inexact.sld b/lib/hascheme/inexact.sld
index 07b6927..907dd4a 100644
--- a/lib/hascheme/inexact.sld
+++ b/lib/hascheme/inexact.sld
@@ -1,7 +1,7 @@
 (define-library (hascheme inexact)
-  (import (hascheme base) (hascheme internal)
+  (import (hascheme base) (hascheme eager)
           (prefix (scheme inexact) r7rs:))
-  (export)
+  (export finite? infinite? nan? exp log sin cos tan asin acos atan sqrt)
   (begin
     (define-wrappers-from-strict
         ;; Numbers
diff --git a/lib/hascheme/prelude.sld b/lib/hascheme/prelude.sld
new file mode 100644
index 0000000..e532ab5
--- /dev/null
+++ b/lib/hascheme/prelude.sld
@@ -0,0 +1,14 @@
+(define-library (hascheme prelude)
+  (import (scheme base) (scheme lazy))
+  (export hs:lambda hs:define)
+  (begin
+    (define-syntax hs:lambda
+      (syntax-rules ()
+        ((_ formal body ...)
+         (lambda formal (delay-force (let ()
+                                       (seq body ...)))))))
+    (define-syntax hs:define
+      (syntax-rules ()
+        ((_ (name . formals) body ...)
+         (define name (hs:lambda formals body ...)))
+        ((_ name body) (define name body))))))
\ No newline at end of file