From 6e2bd8d4b71bf9a61cf4e66d327cc59e1231719d Mon Sep 17 00:00:00 2001
From: Lukas Stoll <lukas@lusuba.de>
Date: Tue, 9 Jun 2020 14:55:44 +0200
Subject: [PATCH 1/3] Use r7rs lazy primitives in srfi 41

Rewrite srfi 41 primitive layer in terms of r7rs primitives for delayed
evaluation.
---
 lib/srfi/41.scm | 87 +++++++++++++++++++------------------------------
 1 file changed, 34 insertions(+), 53 deletions(-)

diff --git a/lib/srfi/41.scm b/lib/srfi/41.scm
index 6cba2443..ac973fca 100644
--- a/lib/srfi/41.scm
+++ b/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

From 4f23fb4e03a8c2fe7c193ce96c04f07fd5ca5216 Mon Sep 17 00:00:00 2001
From: Lukas Stoll <lukas@lusuba.de>
Date: Tue, 9 Jun 2020 15:05:41 +0200
Subject: [PATCH 2/3] Add (scheme lazy) to imports for srfi 41

---
 lib/srfi/41.sld | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/srfi/41.sld b/lib/srfi/41.sld
index 09d3daad..566d65fb 100644
--- a/lib/srfi/41.sld
+++ b/lib/srfi/41.sld
@@ -1,6 +1,6 @@
 
 (define-library (srfi 41)
-  (import (scheme base) (srfi 1))
+  (import (scheme base) (scheme lazy) (srfi 1))
   (export
    stream-null stream-cons stream? stream-null? stream-pair?
    stream-car stream-cdr stream-lambda)

From afba9d8c27cc06d4b84a4c55cf278d1704f217c5 Mon Sep 17 00:00:00 2001
From: Lukas Stoll <lukas@lusuba.de>
Date: Tue, 9 Jun 2020 19:50:13 +0200
Subject: [PATCH 3/3] Correct record-type names in srfi 41

---
 lib/srfi/41.scm | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/lib/srfi/41.scm b/lib/srfi/41.scm
index ac973fca..4392f97a 100644
--- a/lib/srfi/41.scm
+++ b/lib/srfi/41.scm
@@ -2,16 +2,16 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; primitive layer adapted from SRFI 41 reference impl
 
-(define-record-type <stream>
+(define-record-type Stream
   (make-stream promise)
   stream?
   (promise stream-promise))
 
-(define-record-type <stream-null>
+(define-record-type Stream-null
   (make-stream-null)
   %stream-null?)
 
-(define-record-type <stream-pair>
+(define-record-type Stream-pair
   (make-stream-pair head tail)
   %stream-pair?
   (head %stream-car)