Use r7rs lazy primitives in srfi 41

Rewrite srfi 41 primitive layer in terms of r7rs primitives for delayed
evaluation.

lib/srfi/41.scm

@@ -1,73 +1,54 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; primitive layer adapted from SRFI 41 reference impl
-;; TODO: rewrite this in terms or R7RS lazy primitives
 
-(define-record-type Stream
-  (make-stream box)
+(define-record-type <stream>
+  (make-stream promise)
   stream?
-  (box stream-promise stream-promise!))
+  (promise stream-promise))
 
-(define-record-type Stream-Pare
-  (make-stream-pare kar kdr)
-  stream-pare?
-  (kar stream-kar)
-  (kdr stream-kdr))
+(define-record-type <stream-null>
+  (make-stream-null)
+  %stream-null?)
 
-(define-syntax stream-lazy
-  (syntax-rules ()
-    ((lazy expr)
-     (make-stream (cons 'lazy (lambda () expr))))))
+(define-record-type <stream-pair>
+  (make-stream-pair head tail)
+  %stream-pair?
+  (head %stream-car)
+  (tail %stream-cdr))
 
-(define (stream-eager expr)
-  (make-stream (cons 'eager expr)))
-
-(define-syntax stream-delay
-  (syntax-rules ()
-    ((stream-delay expr)
-     (stream-lazy (stream-eager expr)))))
-
-(define (stream-force promise)
-  (let ((content (stream-promise promise)))
-    (case (car content)
-      ((eager) (cdr content))
-      ((lazy)  (let* ((promise* ((cdr content)))
-                      (content  (stream-promise promise)))
-                 (if (not (eqv? (car content) 'eager))
-                     (begin (set-car! content (car (stream-promise promise*)))
-                            (set-cdr! content (cdr (stream-promise promise*)))
-                            (stream-promise! promise* content)))
-                 (stream-force promise))))))
-
-(define stream-null (stream-delay (cons 'stream 'null)))
-
-(define (stream-pair? obj)
-  (and (stream? obj) (stream-pare? (stream-force obj))))
-
-(define (stream-null? obj)
-  (and (stream? obj)
-       (eqv? (stream-force obj)
-             (stream-force stream-null))))
+(define stream-null (make-stream (make-promise (make-stream-null))))
 
 (define-syntax stream-cons
   (syntax-rules ()
-    ((stream-cons obj strm)
-     (stream-delay (make-stream-pare (stream-delay obj) (stream-lazy strm))))))
+    ((stream-cons object stream) 
+     (make-stream
+       (make-promise
+         (make-stream-pair
+           (delay object)
+           (delay-force (stream-promise stream))))))))
 
-(define (stream-car strm)
-  (cond ((not (stream? strm)) (error 'stream-car "non-stream"))
-        ((stream-null? strm) (error 'stream-car "null stream"))
-        (else (stream-force (stream-kar (stream-force strm))))))
+(define (stream-null? stream)
+  (and (stream? stream)
+       (%stream-null? (force (stream-promise stream)))))
 
-(define (stream-cdr strm)
-  (cond ((not (stream? strm)) (error 'stream-cdr "non-stream"))
-        ((stream-null? strm) (error 'stream-cdr "null stream"))
-        (else (stream-kdr (stream-force strm)))))
+(define (stream-pair? stream)
+  (and (stream? stream)
+       (%stream-pair? (force (stream-promise stream)))))
+
+(define (stream-car stream)
+  (force (%stream-car (force (stream-promise stream)))))
+
+(define (stream-cdr stream) 
+  (let ((t (force (%stream-cdr (force (stream-promise stream))))))
+    (make-stream (make-promise t))))
 
 (define-syntax stream-lambda
   (syntax-rules ()
     ((stream-lambda formals body0 body1 ...)
-     (lambda formals (stream-lazy (let () body0 body1 ...))))))
+     (lambda formals
+       (make-stream
+         (delay-force (stream-promise (let () body0 body1 ...))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; derived