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     [
  15         swapd , , \ with-variables ,
  16         "Coroutine has terminated illegally." , \ throw ,
  17     ] [ ] make
  18     [ >>resumecc ] [ >>originalcc ] bi ;
  19
  20 : coresume ( v co -- result )
  21     [
  22         >>exitcc
  23         resumecc>> call( -- )
  24         ! At this point, the coroutine quotation must have terminated
  25         ! normally (without calling coyield, coreset, or coterminate).
  26         ! This shouldn't happen.
  27         f over
  28     ] callcc1 2nip ;
  29
  30 : coresume* ( v co -- ) coresume drop ; inline
  31 : *coresume ( co -- result ) f swap coresume ; inline
  32
  33 : coyield ( v -- result )
  34     current-coro get
  35     [
  36         [ continue-with ] curry
  37         >>resumecc
  38         exitcc>> continue-with
  39     ] callcc1 2nip ;
  40
  41 : coyield* ( v -- ) coyield drop ; inline
  42 : *coyield ( -- v ) f coyield ; inline
  43
  44 : coterminate ( v -- )
  45     current-coro get
  46     [ ] >>resumecc
  47     exitcc>> continue-with ;
  48
  49 : coreset ( v --  )
  50     current-coro get dup
  51     originalcc>> >>resumecc
  52     exitcc>> continue-with ;