From f4a7b72482bf6975a0d2944d8108451b24b42e3f Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Thu, 19 Jul 2007 02:48:42 +0000
Subject: [PATCH] fix+reinstall last force version

svn: r6934
---
 collects/lazy/promise.ss | 33 +++------------------------------
 1 file changed, 3 insertions(+), 30 deletions(-)

diff --git a/collects/lazy/promise.ss b/collects/lazy/promise.ss
index 4d053737af..bb69bf5398 100644
--- a/collects/lazy/promise.ss
+++ b/collects/lazy/promise.ss
@@ -143,15 +143,14 @@
   ;; actually it doesn't work with `lazy' holding `lazy' of multiple values, so
   ;; `lazy' works with multiple values unless rewrapped in `lazy'.)
   ;; #;
-  #;(define (force 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 ([vals* (call-with-values p list)])
-             (if (and (pair? vals*)
-                      (null? (cdr vals*)))
+             (if (and (pair? vals*) (null? (cdr vals*)))
                (let loop1 ([val* (car vals*)])
                  (if (promise? val*)
                    (let loop2 ([promise* val*])
@@ -166,7 +165,7 @@
                              [else (error 'force
                                           "invalid promise, contains ~e" p*)])))
                    (begin ; error here for "library approach" (see above URL)
-                     (p:set! promise vals*)
+                     (p:set! promise (list val*))
                      val*)))
                (begin ; error here for "library approach" (see above URL)
                  (p:set! promise vals*)
@@ -178,32 +177,6 @@
       ;; different from srfi-45: identity for non-promises
       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: