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

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