coroutines: 4-space style.

db4
John Benediktsson 2012-09-22 12:57:46 -07:00
parent fa310fe054
commit b9b5c6e927
1 changed files with 27 additions and 26 deletions

View File

@ -9,43 +9,44 @@ SYMBOL: current-coro
TUPLE: coroutine resumecc exitcc originalcc ;
: cocreate ( quot -- co )
coroutine new
dup current-coro associate
[ swapd , , \ with-variables ,
"Coroutine has terminated illegally." , \ throw ,
] [ ] make
[ >>resumecc ] [ >>originalcc ] bi ;
coroutine new
dup current-coro associate
[
swapd , , \ with-variables ,
"Coroutine has terminated illegally." , \ throw ,
] [ ] make
[ >>resumecc ] [ >>originalcc ] bi ;
: coresume ( v co -- result )
[
>>exitcc
resumecc>> call( -- )
#! At this point, the coroutine quotation must have terminated
#! normally (without calling coyield, coreset, or coterminate).
#! This shouldn't happen.
f over
] callcc1 2nip ;
[
>>exitcc
resumecc>> call( -- )
#! At this point, the coroutine quotation must have terminated
#! normally (without calling coyield, coreset, or coterminate).
#! This shouldn't happen.
f over
] callcc1 2nip ;
: coresume* ( v co -- ) coresume drop ; inline
: *coresume ( co -- result ) f swap coresume ; inline
: coyield ( v -- result )
current-coro get
[
[ continue-with ] curry
>>resumecc
exitcc>> continue-with
] callcc1 2nip ;
current-coro get
[
[ continue-with ] curry
>>resumecc
exitcc>> continue-with
] callcc1 2nip ;
: coyield* ( v -- ) coyield drop ; inline
: *coyield ( -- v ) f coyield ; inline
: coterminate ( v -- )
current-coro get
[ ] >>resumecc
exitcc>> continue-with ;
current-coro get
[ ] >>resumecc
exitcc>> continue-with ;
: coreset ( v -- )
current-coro get dup
originalcc>> >>resumecc
exitcc>> continue-with ;
current-coro get dup
originalcc>> >>resumecc
exitcc>> continue-with ;