refactor iterators to be pointers to a two-cell structure

main
Jeremy Penner 2023-11-04 23:39:30 -04:00
parent 6c31f368c3
commit 2007ba838c
8 changed files with 107 additions and 52 deletions

Binary file not shown.

Binary file not shown.

156
iter.jrt
View File

@ -1,8 +1,10 @@
( iteration control stacks
We create two new stacks - a small stack to hold the "current" value
of the loop, or the "i" stack, and a larger stack to hold any extra
state, as well as the cp of a word that moves to the next value, which
we call the "next" stack.
state, which we call the "next" stack. Typically the top of the next
stack would contain an "iterator" that knows how to advance to the next
value and how to be cancelled, depending on the needs of the calling code.
With these two new stacks, we can create a generic loop construct for
iterating over streaming values. Not only that, but those values can be
arbitrarily filtered and transformed simply by pushing a new value onto
@ -44,6 +46,7 @@ nexttop :peek nextpeek
:ASM >r ( c -- )
MOV BX @[ SS: r@ @]
POP CX
SHL CX 1 #
ADD BX CX
MOV @[ SS: <r @] BX
NEXT ; }
@ -53,9 +56,7 @@ itop :ndrop n-idrop
nexttop :drop nextdrop
nexttop :ndrop n-nextdrop
: iterdrop ( ci cnext -- ) n-nextdrop n-idrop ;
: finished ( -- 0 ) cancel 0 ;
: finish? ( f -- f ) if 1 else finished then ;
: iterdrop ( n-next -- ) n-nextdrop idrop ;
{ : :push ( pixp -- )
:ASM >r
@ -75,6 +76,8 @@ nexttop :push >next
: i 0 ipeek ; : j 1 ipeek ;
:asm n-<next ( n |n| args... -- args... |n| )
MOV AX SS
MOV ES AX
POP CX
JCXZ 2 @>
MOV DI @[ SS: nexttop @]
@ -95,6 +98,8 @@ nexttop :push >next
NEXT
:asm n->next ( args... n |n| -- |n| args... )
MOV AX SS
MOV ES AX
POP CX
JCXZ 1 @>
MOV DI @[ SS: nexttop @]
@ -109,26 +114,25 @@ nexttop :push >next
1 <:
NEXT
( iterator words must have the following shape: )
( -- xt-iter xt-cancel )
( The xt-iter word must take care of updating the stacks directly. If
( iterators are pointers to an array containing two function pointers:
xt-iter xt-cancel
The xt-iter word must take care of updating the stacks directly. If
there are no more values, it must remove the values from the i-stack,
drop itself from the next-stack, and return 0. "finished" and "finish?"
are useful words to help with this.
The xt-cancel word should remove all of the iterator's state from the
iteration stacks and return nothing. "iterdrop" is a useful word to help
with this. If the iterator is itself making use of an iterator below it
on the stack, the xt-cancel word should call "cancel" to recursively clean
that up once it's done.
iteration stacks and return nothing. "n-nextdrop" and "iterdrop" are useful
words to help with this. If the iterator is itself making use of an
iterator below it on the stack, the xt-cancel word should call "cancel" to
recursively clean that up once it's done.
Note that all "next" words _must_ be defined in the target Forth!
This means that any iterator that dereferences near memory, such as "links",
WILL NOT WORK on the host Forth! )
: call-next ( -- xt-iter xt-cancel ) 0 nextpeek execute ;
: iterate call-next drop execute ;
: cancel call-next swap drop execute ;
: iterate 0 nextpeek @ execute ;
: cancel 0 nextpeek cell + @ execute ;
: EACH_ <r iterate if cell + else @ then >r ;
@ -141,40 +145,67 @@ 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 ; }
: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 ; }
: >cancel :| ' finished :| nextdrop cancel |; |; >next ;
{ : break ' >cancel , ['] continue ; immediate
: finished ( -- 0 ) cancel 0 ;
: finish? ( f -- f ) if 1 else finished then ;
( n ) ' finished ( c ) :noname nextdrop cancel ; iter, : >cancel >iter ;
{ : break ' >cancel , ['] continue ; immediate
:timm break t, >cancel CONTINUE ; }
: nothing :| ' 0 ' nextdrop |; >next ;
: 1cancel 1 1 iterdrop ;
: single >i :| nextdrop :| ' finished ' 1cancel |; >next 1 |;
' 1cancel |; >next ;
: times ( n -- ) >i :| :| <i dup 1- >i finish? |; ' 1cancel |; >next ;
: links ( p -- ) dup
if >i :| :| <i @ dup >i finish? |; ' 1cancel |; >next else nothing then ;
: +for? ( n -- f ) <i + dup >i 1 nextpeek = finish? ;
: for ( start lim -- )
>next 1- >i :| :| 1 +for? |; :| 1 2 iterdrop |; |; >next ;
: for+ ( start lim inc -- )
>next >next 1 nextpeek - >i
:| :| 2 nextpeek +for? |; :| 1 3 iterdrop |; |; >next ;
: pchars ( st -- ) 1- >i
:| :| <i 1+ dup >i b@ finished? |; ' 1cancel |; >next ;
( n ) ' 0 ( c ) ' nextdrop iter,
: nothing >iter ;
: 1cancel idrop nextdrop ;
( n ) ' finished ( c ) ' 1cancel iter,
( n ) :noname nextdrop 1 >iter ; ( c ) ' 1cancel iter,
: single >i >iter ;
( 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 ;
: +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 ;
( n ) :noname 2 nextpeek +for? ; ( c ) :noname 3 iterdrop ; iter,
: for+ ( start lim inc -- ) >next >next 1 nextpeek - >i >iter ;
( n ) :noname <i 1+ dup >i b@ finish? ; ( c ) ' 1cancel iter,
: pchars ( st -- ) 1- >i >iter ;
: nth ( i -- v ) 0 each 2dup = if drop i break then 1+ next swap drop ;
: count 0 each 1+ next ;
:asm _suspend>args ( |n| |r| yieldpoint -- argcount |n| yieldpoint |r| )
DEC BP DEC BP
MOV DI @[ BP]
:asm _suspend>args
( iter |r| yieldpoint -- argcount |r| yieldpoint iter )
MOV DI @[ -2 @+ BP]
POP @[ BP]
INC BP INC BP
XOR AH AH
MOV AL @[ SS: DI]
MOV AL @[ DS: DI]
PUSH AX
NEXT
:asm 2r>next
MOV BX @[ SS: nexttop @]
DEC BX DEC BX
MOV @[ SS: BX] DI
( bp grows up. top: BP-2, second: BP-4
nexttop grows down. top: nexttop, second: nexttop+2 )
SUB BX 4 # ( make room for 2 more items on next stack )
MOV AX @[ -4 @+ BP]
MOV @[ SS: 2 @+ BX] AX
MOV AX @[ -2 @+ BP]
MOV @[ SS: BX] AX
SUB BP 4 # ( pop two off return stack )
MOV @[ SS: nexttop @] BX
NEXT
@ -187,39 +218,62 @@ nexttop :push >next
MOV AL @[ DS: DI]
INC DI
PUSH AX ( argcount )
MOV DI @[ BP]
MOV @[ BP] DI
INC BP INC BP
NEXT
: _resume _resume>args n-<next rswap ;
: _suspend rswap _suspend>args swap >r n->next <r >next ;
: _suspend
( args... iter |r| yieldpoint ret -- 1 |r| ret |n| args... yieldpoint iter )
rswap _suspend>args n->next 2r>next 1 ;
: _cancel _resume>args n-nextdrop rdrop ;
: GENSTART_ <r >next :| :| _resume |; ' _cancel |; >next ;
( n ) :noname _resume>args n-<next ; ( c ) ' _cancel iter,
: GENSTART_ <r >next >iter ;
( yielding from a generator has three moving parts:
)
suspend: run immediately when the generator yields. takes care of updating
the i-stack appropriately, as well as potentially saving any
yield-specific state to the next-stack. After this runs, the
generator's extra parameters are pushed to the next-stack, along
with the generator's "resume" pointer and the yielder's iterator.
resume: run when the generator is resumed by iterating. Before this runs,
the yielder will take care of placing the "resume" pointer back
on the stack and restoring the generator's arguments, so the
stack environments should match what they were when the suspension
happened. This deals with cleaning up after the yielder so the
rest of the generator can run.
cancel: run when the generator is aborted. Before this runs, the next-stack
is cleared of the "resume" pointer and all of the generator's
arguments. This should remove any yield-specific data from the
iteration stacks, and potentially call "cancel" to clean up the
iterator underneath if the yielder is intended to map or filter
another iterator. )
{ var gen-arg-count
:timm (( t:| t, GENSTART_ gen-arg-count @ >t ;
:timm )) t|; t, execute 0 gen-arg-count ! ;
:timm )) t, 0 t|; t, execute 0 gen-arg-count ! ;
: +arg 1 gen-arg-count !+ ; :timm +arg +arg ;
: -arg -1 gen-arg-count !+ ; :timm -arg -arg ;
:timm >arg t, >next +arg ;
( TODO: totally wrong now )
: :yield } create immediate target , startcolon
does> @ w>t gen-arg-count @ >t ; }
: colonpair ( xt-first xt-second -- xt )
target <rot gencolon w>t swap w>t t, return ;
: :yield ( xt-suspend xt-resume xt-cancel -- )
} t' _cancel swap colonpair swap t' _resume swap colonpair
target >r w>t w>t gencolon w>t r@ compilenum t, _suspend t, return
create immediate <r 2 cells + , does> @ w>t gen-arg-count @ >t ; }
: i>next <i >next >i ; : 2>i >i >i ; : 2idrop idrop idrop ;
: shadow-i <i >next >i ; : 2>i >i >i ; : 2idrop idrop idrop ;
: unmap idrop <next >i ; : mapcancel unmap cancel ;
: unsuspend rdrop <r 1+ >r ; ( don't yield at all, skip past the yielder )
: unsuspend rdrop rdrop <r 1+ >r ; ( don't yield at all, skip past the yielder )
: suspend? not if unsuspend then ;
( suspend resume cancel )
' noop ' noop ' noop :yield yield0
' noop ' noop ' noop :yield yield0 [
' >i ' idrop ' idrop :yield yield
' >i ' <i ' idrop :yield yield>
' 2>i ' 2idrop dup :yield yield2
' i>next ' unmap ' mapcancel :yield map
' shadow-i ' unmap ' mapcancel :yield map
' noop ' noop ' cancel :yield pass
' suspend? ' noop ' cancel :yield filter

BIN
swine.com

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -102,7 +102,8 @@ s" coredefs.jrt" loadfile
: t" t, INLINEDATA_ patchpt t", patch!t ;
:timm s" state if t" else target t", then ;
: startcolon t& $DOCOLON w>t ] ;
: gencolon t& $DOCOLON w>t ;
: startcolon gencolon ] ;
: t:| t, INLINEDATA_ patchpt startcolon ;
: t|; t, return patch!t ;
:timm :| t:| ;

Binary file not shown.