new accessors
parent
7d1e346cec
commit
41fc9eac0f
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither.
|
! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: kernel hashtables namespaces continuations quotations
|
||||||
|
accessors ;
|
||||||
IN: coroutines
|
IN: coroutines
|
||||||
USING: kernel hashtables namespaces continuations quotations ;
|
|
||||||
|
|
||||||
SYMBOL: current-coro
|
SYMBOL: current-coro
|
||||||
|
|
||||||
|
@ -13,12 +14,12 @@ TUPLE: coroutine resumecc exitcc ;
|
||||||
[ swapd , , \ bind ,
|
[ swapd , , \ bind ,
|
||||||
"Coroutine has terminated illegally." , \ throw ,
|
"Coroutine has terminated illegally." , \ throw ,
|
||||||
] [ ] make
|
] [ ] make
|
||||||
over set-coroutine-resumecc ;
|
>>resumecc ;
|
||||||
|
|
||||||
: coresume ( v co -- result )
|
: coresume ( v co -- result )
|
||||||
[
|
[
|
||||||
over set-coroutine-exitcc
|
>>exitcc
|
||||||
coroutine-resumecc call
|
resumecc>> call
|
||||||
#! At this point, the coroutine quotation must have terminated
|
#! At this point, the coroutine quotation must have terminated
|
||||||
#! normally (without calling coyield or coterminate). This shouldn't happen.
|
#! normally (without calling coyield or coterminate). This shouldn't happen.
|
||||||
f over
|
f over
|
||||||
|
@ -31,8 +32,8 @@ TUPLE: coroutine resumecc exitcc ;
|
||||||
current-coro get
|
current-coro get
|
||||||
[
|
[
|
||||||
[ continue-with ] curry
|
[ continue-with ] curry
|
||||||
over set-coroutine-resumecc
|
>>resumecc
|
||||||
coroutine-exitcc continue-with
|
exitcc>> continue-with
|
||||||
] callcc1 2nip ;
|
] callcc1 2nip ;
|
||||||
|
|
||||||
: coyield* ( v -- ) coyield drop ; inline
|
: coyield* ( v -- ) coyield drop ; inline
|
||||||
|
@ -40,5 +41,5 @@ TUPLE: coroutine resumecc exitcc ;
|
||||||
|
|
||||||
: coterminate ( v -- )
|
: coterminate ( v -- )
|
||||||
current-coro get
|
current-coro get
|
||||||
[ ] over set-coroutine-resumecc
|
[ ] >>resumecc
|
||||||
coroutine-exitcc continue-with ;
|
exitcc>> continue-with ;
|
||||||
|
|
Loading…
Reference in New Issue