From 20649302fa59634b8bf3fc5aa99f72b94f2d2c10 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 8 Feb 2008 21:47:35 -0600
Subject: [PATCH] Fix a couple of issues with futures

---
 extra/concurrency/concurrency-tests.factor | 14 +++++++---
 extra/concurrency/concurrency.factor       | 30 +++++++++++++---------
 2 files changed, 28 insertions(+), 16 deletions(-)

diff --git a/extra/concurrency/concurrency-tests.factor b/extra/concurrency/concurrency-tests.factor
index b6f62d1779..1a19ce7096 100755
--- a/extra/concurrency/concurrency-tests.factor
+++ b/extra/concurrency/concurrency-tests.factor
@@ -112,9 +112,9 @@ SYMBOL: value
 ! The following unit test blocks forever if the
 ! exception does not propogate. Uncomment when
 ! this is fixed (via a timeout).
-! [
-!  [ "this should propogate" throw ] future ?future 
-! ] must-fail
+[
+ [ "this should propogate" throw ] future ?future 
+] must-fail
 
 [ ] [
   [ "this should not propogate" throw ] future drop 
@@ -127,4 +127,10 @@ SYMBOL: value
 [ f ] [
   [ "testing unregistering on error" throw ] spawn 
   100 sleep process-pid get-process
-] unit-test 
\ No newline at end of file
+] unit-test 
+
+! Race condition with futures
+[ 3 3 ] [
+    [ 3 ] future
+    dup ?future swap ?future
+] unit-test
\ No newline at end of file
diff --git a/extra/concurrency/concurrency.factor b/extra/concurrency/concurrency.factor
index cf44ab125c..e4972c9030 100755
--- a/extra/concurrency/concurrency.factor
+++ b/extra/concurrency/concurrency.factor
@@ -264,29 +264,35 @@ PRIVATE>
     #! so the server continuation gets its new self updated.
     self swap call ;
 
+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 ).
-    [ self send ] compose spawn ;
+    \ future construct-empty [
+        [
+            >r [ t 2array ] compose [ f 2array ] recover r>
+            notify-future
+        ] 2curry spawn drop
+    ] keep ;
 
 : ?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 ;
-
-: parallel-map ( seq quot -- newseq )
-    #! Spawn a process to apply quot to each element of seq,
-    #! joining the results into a sequence at the end.
-    [ curry future ] curry map [ ?future ] map ;
-
-: parallel-each ( seq quot -- )
-    #! Spawn a process to apply quot to each element of seq,
-    #! and waits for all processes to complete.
-    [ f ] compose parallel-map drop ;
+    dup future-value [
+        first2 [ throw ] unless
+    ] [
+        dup [ future-processes push stop ] curry callcc0 ?future
+    ] ?if ;
 
 TUPLE: promise fulfilled? value processes ;