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

[Chris K. Jester-Young]

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 ---
>
>
>
> 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
>
>
> --- End Message ---