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
Received on Thu Oct 19 2006 - 13:02:10 UTC