dialer/iter.jrt

( iteration control stack
  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
4 cells userallot
{ userhere @ } const itop-init
uservar nexttop
16 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 ;
: EACH_ <r get-next if drop cell + else n-nextdrop @ 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 get-next if drop cell + else n-nextdrop @ then >r ;
  : each ' EACH_ , here 0 , ; immediate
  : continue ' GOTO_ , dup cell - , ; immediate
  : more ['] continue here swap ! ; immediate
  :timm each t, EACH_ patchpt ;
  : CONTINUE t, GOTO_ dup cell - w>t ;
  :timm continue CONTINUE ;
  :timm more CONTINUE patch!t ; }

0 var, cancelled
: cancel 1 cancelled ! 
  :| nextdrop get-next if idrop then 0 cancelled ! 0 swap |; >next ;

: 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 ;

( Mapping is complex because iterators use the i-stack to store their own
  state - when asking for the next value, we must restore the previous value.
  However, we do not want to touch the i-stack until the iterator has run,
  in case it is an empty iterator with no values. We want to handle this
  using a minimum of next-stack space; ideally never more than two slots. 
  
  The user defines a mapping iterator by defining a word or no-name that
  passes an anonymous function to "map" and returning. "map" must assume that
  the current i value sits below the mapper on the next-stack and
  the iterator to remap sits below that. 
  
  "initial-map" assumes a mapper is below it on the stack with no initial 
  i value, and the iterator to remap sits below that. It queries the iterator
  to ensure it's not empty, and then sets up the environment to allow the
  mapper to continue working. )

: initial-map ( -- f c )
  nextdrop <next get-next if ( cpnext c )
    ( inject a fake iterator that just returns the top i value so we can
      safely call get-next again from the mapper )
    swap :| 1 1 |; >next i >next >next get-next drop drop
    <next <next nextdrop >next >next ( remove the fake iterator )
    2 + 1 swap ( add mapper to count and return success )
  else drop drop 0 0 then ;

: map ( cp -- f c ) 
  <next swap <next idrop >i ( cpnext cp: restore i to previous value )
  get-next if ( cpnext cp c )
       >rot i >next <i swap execute >i >next 2 + 1 swap
  else >rot drop drop 0 swap then ;

: >map ( mapper -- ) >next ' initial-map >next ;

: filter ( cp -- f c )
  >r <next begin get-next ( cpnext c f )
    if i r@ execute
      if swap >next 1 swap 1+ rdrop return then ( filter hit -- f c )
      drop ( cpnext )
    else ( no more items )
      swap drop 0 swap rdrop return
    then again ;

: .all each i [ key 0 lit ] + draw-char more ;
: doubled :| ' 2* map |; >map ;