basis/concurrency/promises/promises.factor

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