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 accessors ;
   4 IN: coroutines
   5
   6 SYMBOL: current-coro
   7
   8 TUPLE: coroutine resumecc exitcc originalcc ;
   9
  10 : cocreate ( quot -- co )
  11     coroutine new
  12     dup current-coro associate
  13     [
  14         swapd , , \ with-variables ,
  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).
  25         ! This shouldn't happen.
  26         f over
  27     ] callcc1 2nip ;
  28
  29 : coresume* ( v co -- ) coresume drop ; inline
  30 : *coresume ( co -- result ) f swap coresume ; inline
  31
  32 : coyield ( v -- result )
  33     current-coro get
  34     [
  35         [ continue-with ] curry
  36         >>resumecc
  37         exitcc>> continue-with
  38     ] callcc1 2nip ;
  39
  40 : coyield* ( v -- ) coyield drop ; inline
  41 : *coyield ( -- v ) f coyield ; inline
  42
  43 : coterminate ( v -- )
  44     current-coro get
  45     [ ] >>resumecc
  46     exitcc>> continue-with ;
  47
  48 : coreset ( v --  )
  49     current-coro get dup
  50     originalcc>> >>resumecc
  51     exitcc>> continue-with ;