Re: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-291-g4a1cdc9

["Chris K. Jester-Young" <cky944@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 853 bytes --]

On Fri, Apr 05, 2013 at 08:36:51AM -0400, Chris K. Jester-Young wrote:
> > The clarity of this code could greatly benefit from some helper
> > procedures.  One possibility would be a procedure that takes a promise
> > and two continuation arguments: one to call if the promise has already
> > been computed, and another to call if it has not yet been.  Another
> > possibility would be to simply have a predicate that tells whether a
> > promise has already been computed.
> 
> I was actually mimicking the style used in the SRFI 45 reference
> implementation of delay. If we change this here, we should also
> correspondingly change delay. The two continuations thing is probably
> worth trying.

Attached is a patch for implementing this. Whether this results in
"greatly benefitted clarity" is debateable, but it was worth a try. :-)

Cheers,
Chris.

[-- Attachment #2: 0001-Implement-stream-promise-visit.patch --]
[-- Type: message/rfc822, Size: 3895 bytes --]

From: Chris K. Jester-Young <cky944@gmail.com>
Subject: [PATCH] Implement stream-promise-visit.
Date: Fri, 5 Apr 2013 09:08:51 -0400

* module/srfi/srfi-41.scm (stream-promise-visit): New procedure for
  cleanly visiting a promise based on whether its value is materialised
  or not. Based on feedback from Mark H Weaver.
  (stream-force, <stream printer>): Use stream-promise-visit.
---
 module/srfi/srfi-41.scm |   60 +++++++++++++++++++++++++---------------------
 1 files changed, 33 insertions(+), 27 deletions(-)

diff --git a/module/srfi/srfi-41.scm b/module/srfi/srfi-41.scm
index 243bd44..108592f 100644
--- a/module/srfi/srfi-41.scm
+++ b/module/srfi/srfi-41.scm
@@ -127,19 +127,25 @@
 (define-syntax-rule (stream-delay exp)
   (stream-lazy (stream-eager exp)))
 
+(define (stream-promise-visit promise on-eager on-lazy)
+  (define content (stream-promise-val promise))
+  (case (stream-value-tag content)
+    ((eager) (on-eager (stream-value-proc content)))
+    ((lazy)  (on-lazy (stream-value-proc content)))))
+
 (define (stream-force promise)
-  (let ((content (stream-promise-val promise)))
-    (case (stream-value-tag content)
-      ((eager) (stream-value-proc content))
-      ((lazy)  (let* ((promise* ((stream-value-proc content)))
-                      (content  (stream-promise-val promise)))
-                 (if (not (eqv? (stream-value-tag content) 'eager))
-                     (begin (stream-value-tag-set! content
-                                                   (stream-value-tag (stream-promise-val promise*)))
-                            (stream-value-proc-set! content
-                                                    (stream-value-proc (stream-promise-val promise*)))
-                            (stream-promise-val-set! promise* content)))
-                 (stream-force promise))))))
+  (stream-promise-visit promise
+    values
+    (lambda (proc)
+      (let* ((promise* (proc))
+             (content  (stream-promise-val promise)))
+        (if (not (eqv? (stream-value-tag content) 'eager))
+            (begin (stream-value-tag-set! content
+                                          (stream-value-tag (stream-promise-val promise*)))
+                   (stream-value-proc-set! content
+                                           (stream-value-proc (stream-promise-val promise*)))
+                   (stream-promise-val-set! promise* content)))
+        (stream-force promise)))))
 
 ;;
 ;; End of the copy of the code from srfi-45.scm
@@ -185,21 +191,21 @@
   (lambda (strm port)
     (display "#<stream" port)
     (let loop ((strm strm))
-      (define value (stream-promise-val strm))
-      (case (stream-value-tag value)
-        ((eager)
-         (let ((pare (stream-value-proc value)))
-           (if (eq? pare %stream-null)
-               (write-char #\> port)
-               (let* ((kar (stream-kar pare))
-                      (kar-value (stream-promise-val kar)))
-                 (write-char #\space port)
-                 (case (stream-value-tag kar-value)
-                   ((eager) (write (stream-value-proc kar-value) port))
-                   ((lazy)  (write-char #\? port)))
-                 (loop (stream-kdr pare))))))
-        ((lazy)
-         (display " ...>" port))))))
+      (stream-promise-visit strm
+        ;; eager
+        (lambda (pare)
+          (if (eq? pare %stream-null)
+              (write-char #\> port)
+              (begin
+                (write-char #\space port)
+                (stream-promise-visit (stream-kar pare)
+                  (cut write <> port)           ; eager
+                  (lambda (_)                   ; lazy
+                    (write-char #\? port)))
+                (loop (stream-kdr pare)))))
+        ;; lazy
+        (lambda (_)
+          (display " ...>" port))))))
 
 ;;; Derived stream functions and macros: (streams derived)
 
-- 
1.7.2.5