[r6rs-discuss] [Formal] Delayed evaluation

Andre van Tonder andre at het.brown.edu
Thu Oct 19 13:02:10 EDT 2006


Here is a simpler less-boxed implementation that should be easier to understand
and should have better performance than the implementation in the formal 
comment.

This implementation is still pretty much a verbatim statement of "naive graph
reduction" as discussed, e.g., in the reference by Richard Jones in srfi-45. 
As such, it is formally known to be safe for space if used correctly.

I give two equivalent versions of it. I find the first on more readable. The
second one uses another representation that is a little more concise.

  Version 1:
  ==========

;; <promise> ::= (lazy   . <thunk of promise>)    (delayed promise)
;;             | (value  . <object>)              (forced  promise)
;;             | (shared . <promise>)             (shared  promise)

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

(define-syntax delay
   (syntax-rules ()
     ((delay exp) (lazy (cons 'value exp)))))

(define (force promise)
   (case (car promise)
     ((lazy)   (let ((promise* ((cdr promise))))
                 (if (not (eq? (car promise) 'value))         ; for reentrancy
                     (begin (set-car! promise (car promise*)) ; overwrite root
                            (set-cdr! promise (cdr promise*))
                            (set-car! promise* 'shared)       ; maintain sharing
                            (set-cdr! promise* promise)))
                 (force promise)))                            ; iterated force
     ((value)  (cdr promise))
     ((shared) (force (cdr promise)))
     (else (error "Not a promise"))))

The types can be spoofed, but it is obvious how to either convert it
to using unique tags or to using a record type.

  Version 2:
  ==========

;; <promise> ::= (make-promise <thunk of promise>)   (delayed promise)
;;             | (make-promise (list <object>))      (forced  promise)
;;             | (make-promise <promise>)            (shared  promise)

(define-struct promise (p))

(define-syntax lazy
   (syntax-rules ()
     ((lazy exp)
      (make-promise (lambda () exp)))))

(define-syntax delay
   (syntax-rules ()
     ((delay exp) (lazy (make-promise (list exp))))))

(define (force promise)
   (let ((p (promise-p promise)))
     (cond ((procedure? p) (let ((promise* (p)))
                             (if (not (pair? (promise-p promise)))
                                 (begin (set-promise-p! promise (promise-p promise*))
                                        (set-promise-p! promise* promise)))
                             (force promise)))
           ((pair? p)      (car p))
           ((promise? p)   (force p))
           (else           (error "Not a promise")))))

Andre






More information about the r6rs-discuss mailing list