From e9a63d7a2c2d080e778a3f3e8bd4b99d2867588f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 9 Feb 2008 14:10:52 -0600
Subject: [PATCH] Arrggh

---
 extra/concurrency/concurrency.factor | 34 ++++++++++++++++++----------
 1 file changed, 22 insertions(+), 12 deletions(-)

diff --git a/extra/concurrency/concurrency.factor b/extra/concurrency/concurrency.factor
index b46439b583..3c8011cc6b 100755
--- a/extra/concurrency/concurrency.factor
+++ b/extra/concurrency/concurrency.factor
@@ -264,26 +264,36 @@ PRIVATE>
     #! so the server continuation gets its new self updated.
     self swap call ;
 
-TUPLE: future status value processes ;
+TUPLE: future value processes ;
 
+: notify-future ( value future -- )
+    tuck set-future-value
+    dup future-processes [ schedule-thread ] each
+    f swap set-future-processes ;
+ 
 : future ( quot -- future )
-    #! Spawn a process to call the quotation and immediately return
-    #! a 'future' on the stack. The future can later be queried with
-    #! ?future. If the quotation has completed the result will be returned.
-    #! If not, the process will block until the quotation completes.
-    #! 'quot' must have stack effect ( -- X ).
+    #! Spawn a process to call the quotation and immediately return.
+    \ future construct-empty [
     [
         [
+            >r [ t 2array ] compose [ f 2array ] recover r>
+            notify-future
+        ] 2curry spawn drop
+    ] keep ;
             t 
         ] compose
     ] spawn drop
     [ self send ] compose spawn ;
-
-: ?future ( future -- result )
-    #! Block the process until the future has completed and then
-    #! place the result on the stack. Return the result
-    #! immediately if the future has completed.
-    process-mailbox mailbox-get ;
+ 
+ : ?future ( future -- result )
+     #! Block the process until the future has completed and then
+     #! place the result on the stack. Return the result
+     #! immediately if the future has completed.
+    dup future-value [
+        first2 [ throw ] unless
+    ] [
+        dup [ future-processes push stop ] curry callcc0 ?future
+    ] ?if ;
 
 : parallel-map ( seq quot -- newseq )
     #! Spawn a process to apply quot to each element of seq,