refactor iterator definitions to define a "blank" iterator, which is then

modified by subsequent definitions.
This commit is contained in:
Jeremy Penner 2023-11-05 00:30:34 -04:00
parent 2007ba838c
commit 85f3767e1e
8 changed files with 39 additions and 26 deletions

Binary file not shown.

Binary file not shown.

View file

@ -57,6 +57,7 @@ nexttop :drop nextdrop
nexttop :ndrop n-nextdrop
: iterdrop ( n-next -- ) n-nextdrop idrop ;
: 1-iterdrop nextdrop idrop ;
{ : :push ( pixp -- )
:ASM >r
@ -134,6 +135,9 @@ nexttop :push >next
: iterate 0 nextpeek @ execute ;
: cancel 0 nextpeek cell + @ execute ;
: finished ( -- 0 ) cancel 0 ;
: finish? ( f -- f ) if 1 else finished then ;
: EACH_ <r iterate if cell + else @ then >r ;
{ ( Because we dereference pointers on the return stack, we must run this
@ -145,43 +149,49 @@ nexttop :push >next
:timm each t, EACH_ patchpt >i ;
: CONTINUE t, GOTO_ i cell - w>t ;
:timm continue CONTINUE ;
:timm next CONTINUE <i patch!t ;
: iter, ( xt-iter xt-cancel -- iter ) target >i swap w>t w>t ;
:timm >iter <i compilenum t, >next ; }
:timm next CONTINUE <i patch!t ;
: blankiter, t' finished w>t t' 1-iterdrop w>t ; }
: finished ( -- 0 ) cancel 0 ;
: finish? ( f -- f ) if 1 else finished then ;
{ : defiter CREATE blankiter, DOES} >next ;
{ : :iter CREATE blankiter, startcolon DOES}
>r r@ [ 2 cells lit ] + execute <r >next ;
( n ) ' finished ( c ) :noname nextdrop cancel ; iter, : >cancel >iter ;
{ : iter! ( val off -- ) cells latest entry>tcp + !t ;
: next! 2 iter! ; : cancel! 3 iter! ;
: :next target next! startcolon ; : :cancel target cancel! startcolon ; }
defiter >cancel
:cancel nextdrop cancel ;
{ : break ' >cancel , ['] continue ; immediate
:timm break t, >cancel CONTINUE ; }
( n ) ' 0 ( c ) ' nextdrop iter,
: nothing >iter ;
defiter nothing
' nextdrop cancel!
: 1cancel idrop nextdrop ;
defiter >single-done
:iter single >i ;
:next nextdrop 1 >single-done ;
( n ) ' finished ( c ) ' 1cancel iter,
( n ) :noname nextdrop 1 >iter ; ( c ) ' 1cancel iter,
: single >i >iter ;
:iter times ( n -- ) >i ;
:next <i dup 1- >i finish? ;
( n ) :noname <i dup 1- >i finish? ; ( c ) ' 1cancel iter,
: times ( n -- ) >i >iter ;
( n ) :noname <i @ dup >i finish? ; ( c ) ' 1cancel iter,
: links ( p -- ) dup if >i >iter else nothing then ;
defiter >links
:next <i @ dup >i finish? ;
: links ( p -- ) dup if >i >links else nothing then ;
: +for? ( n -- f ) <i + dup >i 1 nextpeek != finish? ;
( n ) :noname 1 +for? ; ( c ) :noname 2 iterdrop ; iter,
: for ( start lim -- ) >next 1- >i >iter ;
:iter for ( start lim -- ) >next 1- >i ;
:next 1 +for? ;
:cancel 2 iterdrop ;
( n ) :noname 2 nextpeek +for? ; ( c ) :noname 3 iterdrop ; iter,
: for+ ( start lim inc -- ) >next >next 1 nextpeek - >i >iter ;
:iter for+ ( start lim inc -- ) >next >next 1 nextpeek - >i ;
:next 2 nextpeek +for? ;
:cancel 3 iterdrop ;
( n ) :noname <i 1+ dup >i b@ finish? ; ( c ) ' 1cancel iter,
: pchars ( st -- ) 1- >i >iter ;
:iter pchars ( st -- ) 1- >i ;
:next <i 1+ dup >i b@ finish? ;
: nth ( i -- v ) 0 each 2dup = if drop i break then 1+ next swap drop ;
: count 0 each 1+ next ;
@ -228,8 +238,10 @@ nexttop :push >next
rswap _suspend>args n->next 2r>next 1 ;
: _cancel _resume>args n-nextdrop rdrop ;
( n ) :noname _resume>args n-<next ; ( c ) ' _cancel iter,
: GENSTART_ <r >next >iter ;
defiter >genstart
:next _resume>args n-<next ;
' _cancel cancel!
: GENSTART_ <r >next >genstart ;
( yielding from a generator has three moving parts:
suspend: run immediately when the generator yields. takes care of updating

BIN
swine.com

Binary file not shown.

Binary file not shown.

Binary file not shown.

View file

@ -129,7 +129,8 @@ s" coredefs.jrt" loadfile
dbg" CREATE"
: CREATE DEF t& $DOCREATE w>t 0 w>t ;
: FINISHCREATE ' latest ' tdict with-dict codepointer cell + @ cell + !t ;
: entry>tcp codepointer cell + @ ;
: FINISHCREATE ' latest ' tdict with-dict entry>tcp cell + !t ;
: DOES} target lit ' FINISHCREATE , ' return , } ; immediate
( s" blah.jrt" loadfile doesn't work in target mode because s" writes

Binary file not shown.