basis/concurrency/count-downs/count-downs.factor

   1 ! Copyright (C) 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: dlists kernel math concurrency.promises\r
   4 concurrency.mailboxes debugger accessors fry ;\r
   5 IN: concurrency.count-downs\r
   6 \r
   7 ! http://java.sun.com/j2se/1.5.0/docs/api/java/util/concurrent/CountDownLatch.html\r
   8 \r
   9 TUPLE: count-down n promise ;\r
  10 \r
  11 : count-down-check ( count-down -- )\r
  12     dup n>> zero? [ t swap promise>> fulfill ] [ drop ] if ;\r
  13 \r
  14 ERROR: invalid-count-down-count count ;\r
  15 \r
  16 : <count-down> ( n -- count-down )\r
  17     dup 0 < [ invalid-count-down-count ] when\r
  18     <promise> \ count-down boa\r
  19     dup count-down-check ;\r
  20 \r
  21 ERROR: count-down-already-done ;\r
  22 \r
  23 : count-down ( count-down -- )\r
  24     dup n>> dup zero?\r
  25     [ count-down-already-done ]\r
  26     [ 1 - >>n count-down-check ] if ;\r
  27 \r
  28 : await-timeout ( count-down timeout -- )\r
  29     [ promise>> ] dip ?promise-timeout ?linked t assert= ;\r
  30 \r
  31 : await ( count-down -- )\r
  32     f await-timeout ;\r
  33 \r
  34 : spawn-stage ( quot count-down -- )\r
  35     [ '[ @ _ count-down ] ] keep\r
  36     "Count down stage"\r
  37     swap promise>> mailbox>> spawn-linked-to drop ;\r