( 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.
  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
  the iter-next stack which calls out to the previous one. )

uservar itop
8 cells userallot
{ userhere @ } const itop-init
uservar nexttop
24 cells userallot
{ userhere @ } const nexttop-init

' task-init :chain 
  >r itop-init itop r@ !far
     nexttop-init nexttop r@ !far <r ;

taskseg task-init drop

{ : :peek 
:ASM ( pixp -- ) >r
  ( i -- v )
  POP AX
  SHL AX 1 #
  MOV BX @[ SS: <r @]
  ADD BX AX
  PUSH @[ SS: BX]
  NEXT ; }

itop    :peek ipeek
nexttop :peek nextpeek

{ : :drop ( pixp -- )
:ASM >r
  MOV BX @[ SS: r@ @]
  INC BX INC BX
  MOV @[ SS: <r @] BX
  NEXT ; }

itop    :drop idrop
nexttop :drop nextdrop

{ : :push ( pixp -- )
:ASM >r
  ( v -- )
  POP AX
  MOV BX @[ SS: r@ @]
  DEC BX DEC BX
  MOV @[ SS: <r @] BX
  MOV @[ SS: BX] AX
  NEXT ; }

itop    :push >i
nexttop :push >next

: <i    0 ipeek    idrop ;
: <next 0 nextpeek nextdrop ;
: i 0 ipeek ; : j 1 ipeek ;

( iterator words must have the following shape: )
( -- more nextcount )
( It must take care of updating the i-stack directly. if there are
  no more values, it must remove the values from the i-stack and return 
  0 in the "more" place.

  "nextcount" must be the number of items that are being taken up on the next
  stack by this word. For simple iterators this will be 1, for the space
  the iterator word takes. If "more" is 0, this number of items will be 
  dropped. This is always returned even if there are more items to iterate 
  over, in order to support efficient cancellation. ">cancel" will push a word 
  onto the next-stack that will query the iterator below it to determine how 
  many items need to be dropped. It will drop one item from the i-stack if the
  iterator indicates that there are more items.

  If an iterator requires any more complex cleanup to happen as the result
  of a cancellation, such as dropping multiple items off the i-stack, or
  aborting a task, it should check the "cancelled" flag to determine whether 
  to perform it. An iterator that returns 0 0 will not cause any further
  changes to occur to the iteration stacks, which allows it to be in complete
  control of this scenario if needed.

  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! )

( get-next returns the result of the iterator in swapped order - it is usually
  more convenient to specify the count last when writing iterators, but it's 
  always more convenient to check the flag first when consuming the result. )
: get-next ( -- c f ) 0 nextpeek execute swap ;
: n-nextdrop ( c -- ) dup if begin nextdrop 1- dup not until then drop ;
: iteration get-next if drop 1 else n-nextdrop 0 then ;
: EACH_ <r iteration if cell + else @ then >r ;

{ ( Because we dereference pointers on the return stack, we must run this 
    from the caller's segment. Copy the definition into the host segment. )
  : EACH_ <r iteration if cell + else @ then >r ;
  : each ' EACH_ , >i 0 , ; immediate
  : continue ' GOTO_ , i cell - , ; immediate
  : next ['] continue here <i ! ; immediate
  :timm each t, EACH_ patchpt >i ;
  : CONTINUE t, GOTO_ i cell - w>t ;
  :timm continue CONTINUE ;
  :timm next CONTINUE <i patch!t ; }

0 var, cancelled
: >cancel :| 1 cancelled ! nextdrop get-next if idrop then 
             0 cancelled ! 0 swap |; >next ;
{ : break ' >cancel , ['] continue ; immediate
  :timm break t, >cancel CONTINUE ; }

: nothing :| 0 1 |; >next ;
: single >i :| nextdrop :| idrop 0 1 |; >next 1 1 |; >next ;
: times ( n -- ) >i :| <i dup if 1- >i 1 then 1 |; >next ;
: links ( p -- )
  dup if >i :| <i @ dup if >i 1 then 1 |; >next else nothing then ;
: +for? ( n -- f ) <i + dup 1 nextpeek = if drop 0 else >i 1 then ;
: for ( start lim -- ) >next 1- >i :| 1 +for? 2 |; >next ;
: for+ ( start lim inc -- )
  >next >next 1 nextpeek - >i :| 2 nextpeek +for? 3 |; >next ;
: pchars ( st -- ) 1- >i :| <i 1+ dup b@ if >i 1 else drop 0 then 1 |; >next ;

:asm tail ( TODO: support CREATE words )
  LODSW
  MOV BX AX
  INC BX INC BX
  MOV SI BX
  NEXT

: gen-save-args ( extra-args... extra-arg-count -- )
  begin dup while swap >next 1- repeat drop ;
: gen-save ( 0 0 extra-args... extra-arg-count -- 1 cnext ) 
  >r r@ gen-save-args <r 2 + >rot drop drop 1 swap ;
: gen-restore ( arg-count -- args... )
  begin dup while <next swap 1- repeat drop ;

: cancel >cancel iteration drop ;
: _resume ( cpcancel -- c f args... )
  nextdrop 0 0 <rot 
  cancelled @ if <next ub@ n-nextdrop execute rdrop return then
  drop <next dup 1+ >r rswap ub@ gen-restore ;
: _suspend ( cpresume -- ) 
  rswap r@ ub@ swap >r gen-save <r <r >next >next ;

: GENSTART_ <r >next :| ' noop _resume |; >next ;

{ var gen-arg-count 
  :timm (( t:| t, GENSTART_ gen-arg-count @ >t ;
  :timm )) 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 ;
  : :yield } create immediate target , startcolon 
           does> @ w>t gen-arg-count @ >t ; }

:yield yield0 :| ' noop _resume |; _suspend ;
:yield yield  >i :| ' idrop _resume idrop |; _suspend ;
:yield yield> >i :| ' idrop _resume <i |; _suspend ;
:yield map    <i >next >i :| :| idrop <next >i cancel |; 
                             _resume idrop <next >i |; _suspend 1+ ;
: _pass-suspend rdrop :| ' cancel _resume |; _suspend ;
:yield pass _pass-suspend ;
:yield filter if _pass-suspend else <r 1+ >r then ;

: chars pchars (( each i b@ map next )) ;