Simpler implementation Andre van Tonder (19 Oct 2006 16:50 UTC)
|
Re: Simpler implementation
Eli Barzilay
(20 Oct 2006 07:11 UTC)
|
Exceptions
Eli Barzilay
(24 Jul 2007 18:17 UTC)
|
Simpler implementation Andre van Tonder 19 Oct 2006 16:40 UTC
Inspired by Eli Barzilay's solutions, here is a simpler box-less implementation that should have much better performance than the reference implementation. 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, which is formally known to be safe for space. I give two equivalent versions of it. I find the first on more readable. The second one uses a representation similar to Eli Barzilay's and 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)) (begin (set-car! promise (car promise*)) (set-cdr! promise (cdr promise*)) (set-car! promise* 'shared) (set-cdr! promise* promise))) (force promise))) ((value) (cdr promise)) ((shared) (force (cdr promise))) (else (error "Not a promise")))) This version 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