steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Adding coreset to extra/coroutines, plus docs and tests

db4
James Cash 2008-11-06 20:01:31 -05:00
parent c645613afd
commit 1ca40efa12
3 changed files with 16 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extra/coroutines/coroutines-docs.factor
View File

@ -46,7 +46,13 @@ HELP: coyield*
HELP: coterminate HELP: coterminate
{ $values { "v" "an object" } } { $values { "v" "an object" } }
{ $description "Terminate the current coroutine, leaving the value v on the stack when control is passed to the " { $link coresume } " caller. Resuming a terminated coroutine is a no-op." } { $description "Terminate the current coroutine, leaving the value v on the stack when control is passed to the " { $link coresume } " caller. Resuming a terminated coroutine is a no-op." }
{ $see-also coyield } { $see-also coyield coreset }
;
HELP: coreset
{ $values { "v" "an object" } }
{ $description "Reset the current coroutine, leaving the value v on the stack when control is passed to the " { $link coresume } " caller. When the coroutine is resumed, it will continue at the beginning of the coroutine." }
{ $see-also coyield coterminate }
; ;
HELP: current-coro HELP: current-coro

2
extra/coroutines/coroutines-tests.factor
View File

@ -17,3 +17,5 @@ test1 dup *coresume . dup *coresume . dup *coresume . dup *coresume 2drop
[ [ coyield* ] each ] cocreate ; [ [ coyield* ] each ] cocreate ;
{ "c" "b" "a" } [ test3 { "a" "b" "c" } over coresume >r dup *coresume >r *coresume r> r> ] unit-test { "c" "b" "a" } [ test3 { "a" "b" "c" } over coresume >r dup *coresume >r *coresume r> r> ] unit-test
{ 4+2/3 } [ [ 1+ coyield 2 * coyield 3 / coreset ] cocreate 1 5 [ over coresume ] times nip ] unit-test

9
extra/coroutines/coroutines.factor
View File

@ -6,7 +6,7 @@ IN: coroutines
SYMBOL: current-coro SYMBOL: current-coro
TUPLE: coroutine resumecc exitcc ; TUPLE: coroutine resumecc exitcc originalcc ;
: cocreate ( quot -- co ) : cocreate ( quot -- co )
coroutine new coroutine new
@ -14,7 +14,7 @@ TUPLE: coroutine resumecc exitcc ;
[ swapd , , \ bind , [ swapd , , \ bind ,
"Coroutine has terminated illegally." , \ throw , "Coroutine has terminated illegally." , \ throw ,
] [ ] make ] [ ] make
>>resumecc ; [ >>resumecc ] [ >>originalcc ] bi ;
: coresume ( v co -- result ) : coresume ( v co -- result )
[ [
@ -43,3 +43,8 @@ TUPLE: coroutine resumecc exitcc ;
current-coro get current-coro get
[ ] >>resumecc [ ] >>resumecc
exitcc>> continue-with ; exitcc>> continue-with ;
: coreset ( v -- )
current-coro get dup
originalcc>> >>resumecc
exitcc>> continue-with ;