extra/coroutines/coroutines.factor

   1 ! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel hashtables namespaces continuations quotations
   4 accessors ;
   5 IN: coroutines
   6
   7 SYMBOL: current-coro
   8
   9 TUPLE: coroutine resumecc exitcc ;
  10
  11 : cocreate ( quot -- co )
  12   coroutine new
  13   dup current-coro associate
  14   [ swapd , , \ bind ,
  15     "Coroutine has terminated illegally." , \ throw ,
  16   ] [ ] make
  17   >>resumecc ;
  18
  19 : coresume ( v co -- result )
  20   [
  21     >>exitcc
  22     resumecc>> call
  23     #! At this point, the coroutine quotation must have terminated
  24     #! normally (without calling coyield or coterminate). This shouldn't happen.
  25     f over
  26   ] callcc1 2nip ;
  27
  28 : coresume* ( v co -- ) coresume drop ; inline
  29 : *coresume ( co -- result ) f swap coresume ; inline
  30
  31 : coyield ( v -- result )
  32   current-coro get
  33   [
  34     [ continue-with ] curry
  35     >>resumecc
  36     exitcc>> continue-with
  37   ] callcc1 2nip ;
  38
  39 : coyield* ( v -- ) coyield drop ; inline
  40 : *coyield ( -- v ) f coyield ; inline
  41
  42 : coterminate ( v -- )
  43   current-coro get
  44   [ ] >>resumecc
  45   exitcc>> continue-with ;