 ! concurrency.
 USING: vectors dlists threads sequences continuations
        namespaces random math quotations words kernel match
-       arrays io assocs init ;
+       arrays io assocs init shuffle system ;
 IN: concurrency
 
 TUPLE: mailbox threads data ;
+
+TUPLE: thread timeout continuation continued? ;
+
+: <thread> ( timeout continuation -- obj )
+    >r dup [ millis + ] when r>
+    {
+        set-thread-timeout
+        set-thread-continuation
+    } thread construct ;
 
 : make-mailbox ( -- mailbox )
     V{ } clone <dlist> mailbox construct-boa ;

<PRIVATE
: tag-message ( message -- tagged-message )
    #! Given a message, wrap it with the sending process and a unique tag.
    >r self random-64 r> 3array ;
PRIVATE>

: send-synchronous ( message process -- reply )

        [ set-promise-value ] keep
        [ t swap set-promise-fulfilled? ] keep
        [ promise-processes ] keep
        V{ } clone swap set-promise-processes
        [ thread-continuation schedule-thread ] each yield
    ] if ;

<PRIVATE
 : (maybe-block-promise) ( promise timeout -- promise )
    #! Block the process if the promise is unfulfilled. This is different from
    #! (mailbox-block-if-empty) in that when a promise is fulfilled, all threads
    #! need to be resumed, rather than just one.
    over promise-fulfilled? [
        drop
    ] [
        [ <thread> swap promise-processes push stop ] callcc0
        drop
    ] if ;
PRIVATE>

: ?promise* ( promise timeout -- result )
    (maybe-block-promise) promise-value ;

: ?promise ( promise -- result )
    f ?promise* ;

! ******************************
! Experimental code below
