basis/concurrency/promises/promises.factor

   1 ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors concurrency.mailboxes kernel continuations ;
   4 IN: concurrency.promises
   5
   6 TUPLE: promise mailbox ;
   7
   8 : <promise> ( -- promise )
   9     <mailbox> promise boa ;
  10
  11 : promise-fulfilled? ( promise -- ? )
  12     mailbox>> mailbox-empty? not ;
  13
  14 ERROR: promise-already-fulfilled promise ;
  15
  16 : fulfill ( value promise -- )
  17     dup promise-fulfilled? [
  18         throw-promise-already-fulfilled
  19     ] [
  20         mailbox>> mailbox-put
  21     ] if ;
  22
  23 : ?promise-timeout ( promise timeout -- result )
  24     [ mailbox>> ] dip block-if-empty mailbox-peek ;
  25
  26 : ?promise ( promise -- result )
  27     f ?promise-timeout ;