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

reformatting

Browse Source 
svn: r8114
This commit is contained in:
Eli Barzilay 2007-12-24 11:29:33 +00:00
parent 4923f00a0d
commit 9ba922ff1c
1 changed files with 47 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
collects/scheme/promise.ss
View File

@ -33,15 +33,12 @@
;; single or multiple values ;; single or multiple values
(fprintf port (fprintf port
(if write? "#<promise!~a~s" "#<promise!~a~a") (if write? "#<promise!~a~s" "#<promise!~a~a")
(if (null? (cdr p)) (if (null? (cdr p)) "" "(values ")
""
"(values ")
(car p)) (car p))
(when (pair? (cdr p)) (when (pair? (cdr p))
(let ([fmt (if write? " ~s" " ~a")]) (let ([fmt (if write? " ~s" " ~a")])
(for-each (lambda (x) (fprintf port fmt x)) (cdr p)))) (for-each (lambda (x) (fprintf port fmt x)) (cdr p))))
(unless (null? (cdr p)) (unless (null? (cdr p)) (display ")" port))
(display ")" port))
(display ">" port)] (display ">" port)]
[(promise? p) (loop (promise-val p))] ; hide sharing [(promise? p) (loop (promise-val p))] ; hide sharing
[else (loop (list p))]))) [else (loop (list p))])))
@ -89,52 +86,50 @@
(define handle-results (define handle-results
(case-lambda (case-lambda
[(single) (values #t single)] [(single) (values #t single)]
[multi (values #f multi)])) [multi (values #f multi)]))
(define (force promise) (define (force promise)
(if (promise? promise) (if (promise? promise)
(let loop ([p (promise-val promise)]) (let loop ([p (promise-val promise)])
(cond (cond
[(procedure? p) [(procedure? p)
;; mark root for cycle detection: ;; mark root for cycle detection:
(set-promise-val! promise running) (set-promise-val! promise running)
(with-handlers* ([void (lambda (e) (with-handlers* ([void (lambda (e)
(set-promise-val! promise (lambda () (raise e))) (set-promise-val! promise
(raise e))]) (lambda () (raise e)))
(let-values ([(single? vals*) (raise e))])
(call-with-values p (let-values ([(single? vals*) (call-with-values p handle-results)])
handle-results)]) (if single?
(if single? (let loop1 ([val* vals*])
(let loop1 ([val* vals*]) (if (promise? val*)
(if (promise? val*) (let loop2 ([promise* val*])
(let loop2 ([promise* val*]) (let ([p* (promise-val promise*)])
(let ([p* (promise-val promise*)]) (set-promise-val! promise* promise) ; share with root
(set-promise-val! promise* promise) ; share with root (cond [(procedure? p*)
(cond [(procedure? p*) (let-values ([(single? vals)
(let-values ([(single? vals) (call-with-values
(call-with-values p* p* handle-results)])
handle-results)]) (if single?
(if single? (loop1 vals)
(loop1 vals) (begin (set-promise-val! promise vals)
(begin (apply values vals))))]
(set-promise-val! promise vals) [(or (pair? p*) (null? p*))
(apply values vals))))] (set-promise-val! promise p*)
[(or (pair? p*) (null? p*)) (apply values p*)]
(set-promise-val! promise p*) [(promise? p*) (loop2 p*)]
(apply values p*)] [else p*])))
[(promise? p*) (loop2 p*)] (begin ; error here for "library approach" (see above URL)
[else p*]))) (if (or (null? val*) (pair? val*) (procedure? val*))
(begin ; error here for "library approach" (see above URL) (set-promise-val! promise (list val*))
(if (or (null? val*) (pair? val*) (procedure? val*)) (set-promise-val! promise val*))
(set-promise-val! promise (list val*)) val*)))
(set-promise-val! promise val*)) (begin ; error here for "library approach" (see above URL)
val*))) (set-promise-val! promise vals*)
(begin ; error here for "library approach" (see above URL) (apply values vals*)))))]
(set-promise-val! promise vals*) [(or (pair? p) (null? p)) (apply values p)]
(apply values vals*)))))] [(promise? p) (loop (promise-val p))]
[(or (pair? p) (null? p)) (apply values p)] [else p]))
[(promise? p) (loop (promise-val p))] ;; different from srfi-45: identity for non-promises
[else p])) promise))
;; different from srfi-45: identity for non-promises
promise))