extra/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: 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     promise-mailbox mailbox-empty? not ;\r
  13 \r
  14 : fulfill ( value promise -- )\r
  15     dup promise-fulfilled? [ \r
  16         "Promise already fulfilled" throw\r
  17     ] [\r
  18         promise-mailbox mailbox-put\r
  19     ] if ;\r
  20 \r
  21 : ?promise-timeout ( promise timeout -- result )\r
  22     >r promise-mailbox r> block-if-empty mailbox-peek ;\r
  23 \r
  24 : ?promise ( promise -- result )\r
  25     f ?promise-timeout ;\r