0.1.0

3 files changed, 17 insertions, 38 deletions

diff --git a/lib/hascheme/base.scm b/lib/hascheme/base.scm
index d96547d..8f2f927 100644
--- a/lib/hascheme/base.scm
+++ b/lib/hascheme/base.scm
@@ -2,26 +2,11 @@
   ;; Named let needs to be modified to use lazy lambda
   (syntax-rules ()
     ((let ((formal expr) ...) body ...)
-     (r7rs:let ((formal expr) ...) (seq body ...)))
+     (r7rs:let ((formal expr) ...) body ...))
     ((let name ((formal expr) ...) body ...)
-     (letrec ((name (lambda (formal ...) (seq body ...))))
+     (letrec ((name (lambda (formal ...) body ...)))
        (name expr ...)))))
 
-(define-syntax let*
-  (syntax-rules ()
-    ((let* bindings body ...)
-     (r7rs:let* bindings (seq body ...)))))
-
-(define-syntax letrec
-  (syntax-rules ()
-    ((letrec bindings body ...)
-     (r7rs:letrec bindings (seq body ...)))))
-
-(define-syntax letrec*
-  (syntax-rules ()
-    ((letrec* bindings body ...)
-     (r7rs:letrec* bindings (seq body ...)))))
-
 (define-syntax if
   (syntax-rules ()
     ((if x y ...) (delay-force (r7rs:if (! x) y ...)))))
@@ -63,7 +48,7 @@
     ((case key (else => result))
      (result key))
     ((case key (else result1 result2 ...))
-     (seq result1 result2 ...))
+     (let () result1 result2 ...))
     ((case key ((atoms ...) result1 result2 ...))
      (if (memv key '(atoms ...))
          (let () result1 result2 ...)))
@@ -109,7 +94,7 @@
        ()
        ((field accessor) ...)))
     ((_ "tmps" name _c _? (tmps ...) ((field accessor) rest ...))
-     (_ "tmps" name _c _? ((tmp field accessor) tmps ...) (rest ...)))
+     (define-record-type "tmps" name _c _? ((tmp field accessor) tmps ...) (rest ...)))
     ((_ "tmps" name (cstr cstr-tmp) (predicate predicate-tmp)
         ((accessor-tmp field accessor) ...) ())
      (r7rs:begin
@@ -247,7 +232,10 @@
   ((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?))
+  ((file-error? x) r7rs:file-error?)
+  ;; Ports
+  ((eof-object) r7rs:eof-object)
+  ((eof-object? x) r7rs:eof-object?))
 
 (define-binary-wrapper
     ;; Numbers
@@ -307,13 +295,6 @@
                 '()
                 (cons fill (loop (- k 1)))))))))
 
-(define (list-tabulate n proc)
-  (seq (ensure-exact-positive-integer n)
-       (let loop ((i 0))
-         (if (= i n)
-             '()
-             (cons (proc i) (loop (+ i 1)))))))
-
 (define (length list)
   (let loop ((list list)
              (i 0))
@@ -400,12 +381,6 @@
            (cons (apply f (map car lists))
                  (loop (map cdr lists))))))))
 
-
-(define (map1 f list)
-  (if (null? list)
-      '()
-      (cons (f (car list)) (map1 f (cdr list)))))
-
 ;;; list->string
 
 (define (list->string list) (r7rs:list->string (!list list)))
diff --git a/lib/hascheme/base.sld b/lib/hascheme/base.sld
index 7a93fcd..cefc26d 100644
--- a/lib/hascheme/base.sld
+++ b/lib/hascheme/base.sld
@@ -1,8 +1,10 @@
 (define-library (hascheme base)
   (import (prefix (except (scheme base)
-                          quote define-syntax syntax-rules)
+                          quote define-syntax syntax-rules
+                          let* letrec letrec*)
                   r7rs:)
-          (only (scheme base) define-syntax syntax-rules quote)
+          (only (scheme base) define-syntax syntax-rules quote
+                let* letrec letrec*)
           (scheme lazy)
           (rename (hascheme prelude)
                   (hs:lambda lambda)
@@ -52,5 +54,7 @@
           procedure? string-map apply map
           ;; exceptions
           error error-object? error-object-message error-object-irritants
-          read-error? file-error?)
+          read-error? file-error?
+          ;; Ports
+          eof-object eof-object?)
   (include "base.scm"))
\ No newline at end of file
diff --git a/lib/hascheme/eager.sld b/lib/hascheme/eager.sld
index 7111988..91b0ade 100644
--- a/lib/hascheme/eager.sld
+++ b/lib/hascheme/eager.sld
@@ -52,10 +52,10 @@
     (define-syntax let*!
       (syntax-rules ()
         ((_ ((formal expr) ...) body ...)
-         (let* ((formal (! expr)) ...) (seq body ...)))))
+         (let* ((formal (! expr)) ...) body ...))))
     (define-syntax let*-seq
       (syntax-rules ()
         ((_ ((formal expr) ...) body ...)
          (delay-force (let* ((formal (! expr)) ...)
-                        (seq body ...))))))))
+                        body ...)))))))