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.
--- Begin Message ---* 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
--- End Message ---
