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

separate out reify-result

Browse Source 
svn: r16793
This commit is contained in:
Eli Barzilay 2009-11-16 02:23:18 +00:00
parent 66ae1bea49
commit b79734941f
1 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/scheme/promise.ss
View File

@ -68,6 +68,13 @@
[(null? v) (values)] [(null? v) (values)]
[else (error 'force "composable promise with invalid contents: ~e" v)]))) [else (error 'force "composable promise with invalid contents: ~e" v)])))
(define (reify-result v)
(cond
[(pair? v) (if (null? (unsafe-cdr v)) (unsafe-car v) (apply values v))]
[(null? v) (values)]
[(reraise? v) (v)]
[else (error 'force "promise with invalid contents: ~e" v)]))
;; generic force for "old-style" promises -- they're still useful in ;; generic force for "old-style" promises -- they're still useful in
;; that they allow multiple values. In general, this is slower, but has ;; that they allow multiple values. In general, this is slower, but has
;; more features. (They could allow self loops, but this means holding ;; more features. (They could allow self loops, but this means holding
@ -77,22 +84,16 @@
;; first cannot be solved. I still didn't ever see any use for them, so ;; first cannot be solved. I still didn't ever see any use for them, so
;; they're still forbidden.) ;; they're still forbidden.)
(define (force/generic promise) (define (force/generic promise)
(let ([v (pref promise)]) (reify-result
(cond (let ([v (pref promise)])
[(procedure? v) (if (procedure? v)
(pset! promise (make-running (object-name v))) (begin
(call-with-exception-handler (pset! promise (make-running (object-name v)))
(lambda (e) (pset! promise (make-reraise e)) e) (call-with-exception-handler
(lambda () (lambda (e) (pset! promise (make-reraise e)) e)
(let ([vs (call-with-values v list)]) (lambda ()
(pset! promise vs) (let ([vs (call-with-values v list)]) (pset! promise vs) vs))))
(cond [(null? vs) (values)] v))))
[(null? (unsafe-cdr vs)) (unsafe-car vs)]
[else (apply values vs)]))))]
;; try to make the order efficient, with common cases first
[(pair? v) (if (null? (unsafe-cdr v)) (unsafe-car v) (apply values v))]
[(null? v) (values)]
[else (error 'force "generic promise with invalid contents: ~e" v)])))
;; dispatcher for composable promises, generic promises, and other values ;; dispatcher for composable promises, generic promises, and other values
(define (force promise) (define (force promise)