Re: Problem with (force (lazy (delay expr))) John Shutt 11 Jun 2004 12:42 UTC

There is also a second problem.  I believe I have solutions for both (given
below); unfortunately, as I understand the SRFI editorial policy, the only
changes allowed to finalized SRFIs are to correct typos --- which makes
some sense, since people can reasonably expect to write code based on a
finalized SRFI without having it change under them, but in this case
probably means that a new SRFI will be needed to fix the problems.

Here was my code for the problem you mentioned:

  (define p1 (lazy (begin (display "*") (eager ()))))
  (define p2 (lazy p1))

  p1          ==>   (lazy . #<procedure>)
  p2          ==>   (lazy . #<procedure>)
  (force p2)  ==>   *
                    ()
  p1          ==>   (lazy . #<procedure>)
  p2          ==>   (eager)
  (force p1)  ==>   *
                    ()

My solution is to have a third possible tag, 'delegated, indicating that the
cdr of the promise points to another promise.  When force stashes the concents
of another lazy promise into this one, and before it makes its tail call,
it sets the other promise to delegate to this one.  (I also changed 'lazy
to 'pending and 'eager to 'done, to help myself keep straight which versions
was which.)  So instead of the above dialogue,

  p1          ==>   (pending . #<procedure>)
  p2          ==>   (pending . #<procedure>)
  (force p2)  ==>   *
                    ()
  p1          ==>   (delegated done)
  p2          ==>   (done)
  (force p1)  ==>   ()

The other problem is one that actually existed in the R3RS, and was then
fixed in the R4RS (and stayed fixed in the R5RS).  It's mentioned in the
R4/5RS, but I don't think the sample code they give actually exercises the
bug.  Here's the test code I used:

  (define p
    (let ((count 5))
      (define (get-count) count)
      (define p (delay (if (<= count 0)
                           count
                           (begin (set! count (- count 1))
                                  (force p)
                                  (set! count (+ count 2))
                                  count))))
      (list get-count p)))
  (define get-count (car p))
  (define p (cadr p))

A correct dialogue using this code would be:

  (get-count)   =>   5
  (force p)     =>   0
  (get-count)   =>   10

Incorrect would be:

  (get-count)   =>   5
  (force p)     =>   10
  (get-count)   =>   10

This one is easy to fix; just check, after calling the procedure of a lazy
promise, to make sure the current promise hasn't been forced.

So here is my code; I found in practice that checking everywhere for the
'delegated tag was quite complicated.

  (define-syntax lazy
    (syntax-rules ()
      ((lazy exp) (cons 'pending (lambda () exp)))))

  (define (eager value) (cons 'done value))

  (define-syntax delay
    (syntax-rules ()
      ((delay exp) (lazy (eager exp)))))

  (define force
    (letrec

      ((force
        (lambda (promise)
          (case (car promise)
            ((done)  (cdr promise))
            ((pending)  (step promise ((cdr promise))))
            ((delegated)
               (shorten promise)
               (if (eq? (cadr promise) 'done)
                   (begin (set-car! promise 'done)
                          (set-cdr! promise (cddr promise))
                          (cdr promise))
                   (force (cdr promise)))))))

       (shorten            ; reduce depth of delegation
         (lambda (promise)
           (cond ((eq? (cadr promise) 'delegated)
                    (set-cdr! promise (cddr promise))
                    (shorten promise)))))

       (step
         (lambda (promise next)
           (case (car promise)
             ((done)  (cdr promise))
             ((delegated)
                ; if the delegatee weren't done,
                ; our eval couldn't have returned
                (shorten promise)
                (set-car! promise 'done)
                (set-cdr! promise (cddr promise))
                (cdr promise))
             ((pending)
                (case (car next)
                  ((done)
                     (set-car! promise 'done)
                     (set-cdr! promise (cdr next))
                     (cdr promise))
                  ((pending)
                     (set-car! promise 'pending)
                     (set-cdr! promise (cdr next))
                     (set-car! next 'delegated)
                     (set-cdr! next promise)
                     (force promise))
                  ((delegated)
                     (shorten next)
                     (step promise (cdr next)))))))))

      force))

JNS (John N. Shutt)
  WPI
  http://www.cs.wpi.edu/~jshutt/