refactor iterator definitions to define a "blank" iterator, which is then
modified by subsequent definitions.
This commit is contained in:
parent
2007ba838c
commit
85f3767e1e
BIN
dialer.com
BIN
dialer.com
Binary file not shown.
BIN
dialtest.com
BIN
dialtest.com
Binary file not shown.
62
iter.jrt
62
iter.jrt
|
@ -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
zipmin.com
BIN
zipmin.com
Binary file not shown.
BIN
zipoff.com
BIN
zipoff.com
Binary file not shown.
|
@ -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
|
||||
|
|
BIN
zipstub.seg
BIN
zipstub.seg
Binary file not shown.
Loading…
Reference in a new issue