extra/coroutines/coroutines.factor

   1 ! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither, 2008 James Cash.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel hashtables namespaces make continuations quotations
   4 accessors ;
   5 IN: coroutines
   6
   7 SYMBOL: current-coro
   8
   9 TUPLE: coroutine resumecc exitcc originalcc ;
  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 ] [ >>originalcc ] bi ;
  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, coreset, 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 ;
  46
  47 : coreset ( v --  )
  48   current-coro get dup
  49   originalcc>> >>resumecc
  50   exitcc>> continue-with ;