suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix+reinstall last force version

Browse Source 
svn: r6934
This commit is contained in:
Eli Barzilay 2007-07-19 02:48:42 +00:00
parent b5861250f7
commit f4a7b72482
1 changed files with 3 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/lazy/promise.ss
View File

@ -143,15 +143,14 @@
;; actually it doesn't work with `lazy' holding `lazy' of multiple values, so ;; actually it doesn't work with `lazy' holding `lazy' of multiple values, so
;; `lazy' works with multiple values unless rewrapped in `lazy'.) ;; `lazy' works with multiple values unless rewrapped in `lazy'.)
;; #; ;; #;
#;(define (force promise) (define (force promise)
(if (promise? promise) (if (promise? promise)
(let loop ([p (p:ref promise)]) (let loop ([p (p:ref promise)])
(cond (cond
[(procedure? p) [(procedure? p)
(p:set! promise #f) ; mark root for cycle detection (p:set! promise #f) ; mark root for cycle detection
(let ([vals* (call-with-values p list)]) (let ([vals* (call-with-values p list)])
(if (and (pair? vals*) (if (and (pair? vals*) (null? (cdr vals*)))
(null? (cdr vals*)))
(let loop1 ([val* (car vals*)]) (let loop1 ([val* (car vals*)])
(if (promise? val*) (if (promise? val*)
(let loop2 ([promise* val*]) (let loop2 ([promise* val*])
@ -166,7 +165,7 @@
[else (error 'force [else (error 'force
"invalid promise, contains ~e" p*)]))) "invalid promise, contains ~e" p*)])))
(begin ; error here for "library approach" (see above URL) (begin ; error here for "library approach" (see above URL)
(p:set! promise vals*) (p:set! promise (list val*))
val*))) val*)))
(begin ; error here for "library approach" (see above URL) (begin ; error here for "library approach" (see above URL)
(p:set! promise vals*) (p:set! promise vals*)
@ -178,32 +177,6 @@
;; different from srfi-45: identity for non-promises ;; different from srfi-45: identity for non-promises
promise)) promise))
(define (force promise)
(if (promise? promise)
(let loop ([p (p:ref promise)])
(cond
[(procedure? p)
(p:set! promise #f) ; mark root for cycle detection
(let loop ([promise* (p)])
(if (promise? promise*)
(let ([p* (p:ref promise*)])
(p:set! promise* promise) ; share with root
(cond [(procedure? p*) (loop (p*))]
[(pair? p*) (p:set! promise p*) (car p*)]
[(promise? p*) (loop p*)]
[(not p*) (error 'force "reentrant promise")]
[else (error 'force
"invalid promise, contains ~e" p*)]))
(begin ; error here for "library approach" (see above URL)
(p:set! promise (list promise*))
promise*)))]
[(pair? p) (car p)]
[(promise? p) (loop (p:ref p))]
[(not p) (error 'force "reentrant promise")]
[else (error 'force "invalid promise, contains ~e" p)]))
;; different from srfi-45: identity for non-promises
promise))
#| #|
Timing results (#1, #2, #3 are the above versions), in Lazy Scheme: Timing results (#1, #2, #3 are the above versions), in Lazy Scheme: