new accessors
parent
44ad8b5f3f
commit
9febce42e6
|
@ -1,13 +1,13 @@
|
||||||
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
|
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: concurrency.promises concurrency.mailboxes kernel arrays
|
USING: concurrency.promises concurrency.mailboxes kernel arrays
|
||||||
continuations ;
|
continuations accessors ;
|
||||||
IN: concurrency.futures
|
IN: concurrency.futures
|
||||||
|
|
||||||
: future ( quot -- future )
|
: future ( quot -- future )
|
||||||
<promise> [
|
<promise> [
|
||||||
[ [ >r call r> fulfill ] 2curry "Future" ] keep
|
[ [ >r call r> fulfill ] 2curry "Future" ] keep
|
||||||
promise-mailbox spawn-linked-to drop
|
mailbox>> spawn-linked-to drop
|
||||||
] keep ; inline
|
] keep ; inline
|
||||||
|
|
||||||
: ?future-timeout ( future timeout -- value )
|
: ?future-timeout ( future timeout -- value )
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
|
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: concurrency.mailboxes kernel continuations ;
|
USING: accessors concurrency.mailboxes kernel continuations ;
|
||||||
IN: concurrency.promises
|
IN: concurrency.promises
|
||||||
|
|
||||||
TUPLE: promise mailbox ;
|
TUPLE: promise mailbox ;
|
||||||
|
@ -9,17 +9,17 @@ TUPLE: promise mailbox ;
|
||||||
<mailbox> promise boa ;
|
<mailbox> promise boa ;
|
||||||
|
|
||||||
: promise-fulfilled? ( promise -- ? )
|
: promise-fulfilled? ( promise -- ? )
|
||||||
promise-mailbox mailbox-empty? not ;
|
mailbox>> mailbox-empty? not ;
|
||||||
|
|
||||||
: fulfill ( value promise -- )
|
: fulfill ( value promise -- )
|
||||||
dup promise-fulfilled? [
|
dup promise-fulfilled? [
|
||||||
"Promise already fulfilled" throw
|
"Promise already fulfilled" throw
|
||||||
] [
|
] [
|
||||||
promise-mailbox mailbox-put
|
mailbox>> mailbox-put
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: ?promise-timeout ( promise timeout -- result )
|
: ?promise-timeout ( promise timeout -- result )
|
||||||
>r promise-mailbox r> block-if-empty mailbox-peek ;
|
>r mailbox>> r> block-if-empty mailbox-peek ;
|
||||||
|
|
||||||
: ?promise ( promise -- result )
|
: ?promise ( promise -- result )
|
||||||
f ?promise-timeout ;
|
f ?promise-timeout ;
|
||||||
|
|
Loading…
Reference in New Issue