basis/concurrency/conditions/conditions.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: deques threads kernel arrays sequences timers fry ;
   4 IN: concurrency.conditions
   5
   6 : notify-1 ( deque -- )
   7     dup deque-empty? [ drop ] [ pop-back resume-now ] if ; inline
   8
   9 : notify-all ( deque -- )
  10     [ resume-now ] slurp-deque ; inline
  11
  12 : queue-timeout ( queue timeout -- timer )
  13     ! Add an timer which removes the current thread from the
  14     ! queue, and resumes it, passing it a value of t.
  15     [
  16         [ self swap push-front* ] keep '[
  17             _ _
  18             [ delete-node ] [ drop node-value ] 2bi
  19             t swap resume-with
  20         ]
  21     ] dip later ;
  22
  23 ERROR: timed-out-error timer ;
  24
  25 : queue ( queue -- )
  26     [ self ] dip push-front ; inline
  27
  28 : wait ( queue timeout status -- )
  29     over [
  30         [ queue-timeout ] dip suspend
  31         [ timed-out-error ] [ stop-timer ] if
  32     ] [
  33         [ drop queue ] dip suspend drop
  34     ] if ; inline