nxu/regex.tal

( regex.tal                                                        )
(                                                                  )
( compiles regex expression strings into regex nodes, then uses    )
( regex nodes to match input strings.                              )
(                                                                  )
( two methods are currently supported:                             )
(                                                                  )
( 1. match                                                         )
(                                                                  )
( when matching the regex must match the entire string. this means )
( that it is unnecessary to use ^ and $ when matching, since their )
( effect is implied. it also means that that dot nodes will match  )
( any characters at all including newlines.                        )
(                                                                  )
( match returns 01 if the string was matched and 00 otherwise.     )
(                                                                  )
( 2. search                                                        )
(                                                                  )
( when searching the regex attempts to find matching substrings    )
( in the given string. this means that after successfully finding  )
( a match, search may be called on the remaining substring to find )
( more matches.                                                    )
(                                                                  )
( when searching, ^ matches the beginning of the string OR a line. )
( $ matches the end of a line OR the end of the entire string.     )
( (the ^ and $ operators aren't yet supported.) the dot nodes will )
( not match newline characters, which must be matched explicitly.  )
(                                                                  )
( search returns 01 if the string was matched and 00 otherwise.    )
( additionally, the @search-start and @search-end addresses will   )
( contain the starting location and match boundary of the matching )
( substring.                                                       )
(                                                                  )
( regex node types:                                                )
(                                                                  )
(   NAME    DESCRIPTION                      STRUCT                )
(   empty   matches empty string             [ #01 next* ]         )
(   dot     matches any one char             [ #02 next* ]         )
(   lit     matches one specific char (c)    [ #03 c^ next* ]      )
(   or      matches either left or right     [ #04 left* right* ]  )
(   star    matches expr zero-or-more times  [ #05 expr* next* ]   )
(           (NOTE: r.expr.next must be r)                          )
(   caret   matches start of line/string     [ #06 next* ]         )
(   dollar  matches end of line/string       [ #07 next* ]         )
(   lpar    starts subgroup region           [ #08 i* next* ]      )
(   rpar    ends subgroup region             [ #09 i* next* ]      )
(                                                                  )
( `or` and `star` have the same structure and are handled by the   )
( same code (;do-or). however, the node types are kept different   )
( to make it clearer how to parse and assemble the nodes.          )
(                                                                  )
( dollar nodes contain a next pointer even though this usually     )
( will not be needed.                                              )
(                                                                  )
( lpar and rpar contain addresses pointing between subgroup-bot    )
( and subgroup-bot. rpar's address will always be +2 relative to   )
( the corresponding lpar address.                                  )
(                                                                  )
( concatenation isn't a node, it is implied by the *next addr.     )
( a next value of #0000 signals the end of the regex.              )
(                                                                  )
( in these docs str* is an address to a null-terminated string.    )
( regexes should not include nulls and cannot match them (other    )
( than the null which signals the end of a string).                )

( TODO: we have lpar and rpar nodes but aren't using them yet      )
( 1. need to modify c-lpar and c-par                               )
( 2. we need to store subgroup-posd in regions during parsing:     )
(   a. need to store the current pos in the region                 )
(   b. need to call start to move subgroup-pos forward             )
( 3. when finishing parsing a region we need lpar/rpar nodes       )
( 4. we also need to store "last started subgroup" on the stack    )
( 5. when backtracking we must rewind to "last started" subgroup   )

%debug { #ff #0e DEO }
( %emit { #18 DEO } )
%space { #20 emit }
%newline { #0a emit }
( %quit! { #01 #0f DEO BRK } )

( now that uxnasm throws errors about writing into the zero page   )
( we have to do something like this to be able to compile library  )
( code. we have to guess what offset to use since it needs to      )
( avoid conficting with the program we're included in.             )
(                                                                  )
( remove this if needed when including it in other projects.       )
( |2000 )

( ERROR HANDLING )

( using error! will print the given message before causing )
( the interpreter to halt. )
( @error! ( msg* -> )
    LIT '! emit space
    &loop LDAk ,&continue JCN ,&done JMP
    &continue LDAk emit INC2 ,&loop JMP
    &done POP2 newline quit! )

( error messages )
@unknown-node-type "unknown 20 "node 20 "type 00
@mismatched-parens "mismatched 20 "parenthesis 00
@stack-is-full "stack 20 "is 20 "full 00
@stack-is-empty "stack 20 "is 20 "empty 00
@arena-is-full "arena 20 "is 20 "full 00
@star-invariant "star 20 "invariant 20 "failed 00
@plus-invariant "plus 20 "invariant 20 "failed 00
@qmark-invariant "question 20 "mark 20 "invariant 20 "failed 00

( REGEX MATCHING )

( use stored regex to match against a stored string. )
( )
( regex* should be the address of a compiled regex )
( such as that returned from ;compile. )
( )
( str* should be a null-terminated string. )
( )
( returns true if the string, and false otherwise. )
@match ( str* regex* -> bool^ )
    #01 ;match-multiline STA
    #00 ;search-mode STA
    ;reset-stack JSR2
    ;loop JMP2

@rx-search ( str* regex* -> bool^ )
    #00 ;match-multiline STA
    #01 ;search-mode STA
    ;_search JMP2

( @search-multiline ( str* regex* -> bool^ )
    #01 ;match-multiline STA
    #01 ;search-mode STA
    ;_search JMP2 )

@_search ( str* regex* -> bool^ )
    STH2                          ( s* [r*] )
    DUP2 ;string-start STA2       ( s* [r*] )
    &loop LDAk #00 EQU ,&eof JCN  ( s* [r*] )
          ;reset-stack JSR2       ( s* [r*] )
          DUP2 ;search-start STA2 ( s* [r*] )
          DUP2 STH2kr ;loop JSR2  ( s* b^ [r*] )
          ,&found JCN             ( s* [r*] )
          INC2 ,&loop JMP         ( s+1* [r*] )
    &found POP2 POP2r #01 JMP2r   ( 01 )
    &eof ;reset-stack JSR2        ( s* [r*] )
         DUP2 ;search-start STA2  ( s* [r*] )
         STH2r ;loop JMP2         ( b^ )    

( loop used during matching )
( )
( we don't use the return stack here since that )
( complicates the back-tracking we need to do. )
( ultimately this code will issue a JMP2r to )
( return a boolean, which is where the stack )
( effects signature comes from. )
@loop ( s* r* -> bool^ )
    LDAk #01 EQU ;do-empty   JCN2
    LDAk #02 EQU ;do-dot     JCN2
    LDAk #03 EQU ;do-literal JCN2
    LDAk #04 EQU ;do-or      JCN2
    LDAk #05 EQU ;do-or      JCN2 ( same code as the or case )
    LDAk #06 EQU ;do-caret   JCN2
    LDAk #07 EQU ;do-dollar  JCN2
    LDAk #08 EQU ;do-lpar    JCN2
    LDAk #09 EQU ;do-rpar    JCN2
    ;unknown-node-type ;error! JSR2

( used when we hit a dead-end during matching. )
( )
( if stack is non-empty we have a point we can resume from. )
@goto-backtrack ( -> bool^ )
    ;stack-exist JSR2 ,&has-stack JCN ( do we have stack? )
    #00 JMP2r ( no, return false )
    &has-stack ;pop4 JSR2 ;goto-next JMP2 ( yes, resume from the top )

( follow the given address (next*) to continue matching )
@goto-next ( str* next* -> bool^ )
    DUP2 #0000 GTH2 ,&has-next JCN
    POP2 LDAk #00 EQU ,&end-of-string JCN
    ;search-mode LDA ,&end-of-search JCN
    POP2 ;goto-backtrack JMP2
    &end-of-search DUP2 ;search-end STA2
    &end-of-string POP2 #01 JMP2r
    &has-next ;loop JMP2

( handle the empty node -- just follow the next pointer ) 
@do-empty ( str* regex* -> bool^ )
    INC2 LDA2 ( load next )
    ;goto-next JMP2 ( jump to next )

@do-lpar ( str* regex* -> bool^ )
    STH2 DUP2 ( s s [r] )
    INC2r LDA2kr STH2r ( s s i [r+1] )
    ;subgroup-start JSR2 ( s [r+1] )
    STH2r INC2 INC2 ( s r+3 )
    LDA2 ;goto-next JMP2 ( jump to next )

@do-rpar ( str* regex* -> bool^ )
    STH2 DUP2 ( s s [r] )
    INC2r LDA2kr STH2r ( s s i [r+1] )
    ;subgroup-finish JSR2 ( s [r+1] )
    STH2r INC2 INC2 ( s r+3 )
    LDA2 ;goto-next JMP2 ( jump to next )

( handle dot -- match any one character )
@do-dot ( str* regex* -> bool^ )
    INC2 LDA2 STH2                             ( load and stash next )
    LDAk #00 NEQ ,&non-empty JCN               ( is there a char? )
    &backtrack POP2r POP2 ;goto-backtrack JMP2 ( no, clear stacks and backtrack )
    &non-empty LDAk #0a NEQ ,&match JCN        ( yes, match unless \n in search-mode )
    ;search-mode LDA ,&backtrack JCN           ( if \n and search-mode, treat as EOF )
    &match INC2 STH2r ;goto-next JMP2          ( on match: inc s, restore and jump )

( hande caret -- match string start (or possibly after newline) without advancing )
@do-caret ( str* regex* -> bool^ )
    INC2 LDA2 STH2                              ( load and stash next )
    DUP2 ;string-start LDA2 EQU2 ,&at-start JCN ( at string start? )
    ;match-multiline LDA ,&no-match JCN         ( are we in multi-line mode? )
    #0001 SUB2 LDAk #0a EQU ,&at-start JCN      ( just after newline? )
    &no-match POP2r POP2 ;goto-backtrack JMP2   ( clear stacks and backtrack )
    &at-start STH2r ;goto-next JMP2             ( go to next without advancing )    

( hande dollar -- match string end (or possibly before newline) without advancing )
@do-dollar  ( str* regex* -> bool^ )
    INC2 LDA2 STH2                            ( load and stash next )
    LDAk #00 EQU ,&at-end JCN                 ( at string end? )
    ;match-multiline LDA ,&no-match JCN       ( are we in multi-line mode? )
    LDAk #0a EQU ,&at-end JCN                 ( at newline? )
    &no-match POP2r POP2 ;goto-backtrack JMP2 ( clear stacks and backtrack )    
    &at-end STH2r ;goto-next JMP2             ( go to next without advancing )

( handle literal -- match one specific character )
@do-literal ( str* regex* -> bool^ )
    INC2
    LDAk STH ( store c )
    INC2 LDA2 STH2 ROTr ( store next, move c to top )
    LDAk
    STHr EQU ,&matches JCN ( do we match this char? )
    POP2r POP2 ;goto-backtrack JMP2 ( no, clear stacks and backtrack )
    &matches
    INC2 STH2r ;goto-next JMP2 ( yes, inc s, restore and jump )

( handle or -- try the left branch but backtrack to the right if needed )
( )
( this also handles asteration, since it ends up having the same structure )
@do-or ( str* regex* -> bool^ )
    INC2 OVR2 OVR2 #0002 ADD2 ( s r+1 s r+3 )
    LDA2 ;push4 JSR2 ( save (s, right) in the stack for possible backtracking )
    LDA2 ;loop JMP2 ( continue on left branch )

( REGEX PARSING )

( do we match across lines? )
( - should be true when matching )
( - can be true or false when searching )
( - affects syntax of . ^ and $ )
@match-multiline $1

( are we in searching mode? )
( - should be true when searching )
( - should be false when matching )
@search-mode $1

( )
@string-start $2
@search-start $2
@search-end   $2

( track the position in the input string )
@pos $2

( track how many levels deep we are in parenthesis )
@parens $2

( read and increment pos )
@read ( -> c^ )
    ;pos LDA2k ( pos s )
    LDAk STHk #00 EQU ( pos s c=0 [c] )
    ,&is-eof JCN ( pos s [c] )
    INC2 ( pos s+1 [c] )
    SWP2 STA2 ,&return JMP ( [c] )
    &is-eof POP2 POP2 
    &return STHr ( c )
    JMP2r

( is pos currently pointing to a star? )
@peek-to-star ( -> is-star^ )
    ;pos LDA2 LDA LIT '* EQU JMP2r

( is pos currently pointing to a plus? )
@peek-to-plus ( -> is-plus^ )
    ;pos LDA2 LDA LIT '+ EQU JMP2r

( is pos currently pointing to a qmark? )
@peek-to-qmark ( -> is-qmark^ )
    ;pos LDA2 LDA LIT '? EQU JMP2r

( just increment pos )
@skip
    ;pos LDA2 INC2 ;pos STA2 JMP2r

( TODO: )
( 1. character groups: [] and [^] )
( 2. symbolic escapes, e.g. \n )

( STRETCH GOALS: )
( a. ^ and $ )
( b. counts: {n} and {m,n} )
( c. substring matching, i.e. searching )
( d. subgroup extraction )
( e. back-references, e.g \1 )
( f. non-capturing groups, e.g. (?:) )

( compile an expression string into a regex graph )
( )
( the regex will be allocated in the arena; if there is not )
( sufficient space an error will be thrown. )
( )
( the stack will also be used during parsing although unlike )
( the arena it will be released once compilation ends. )
@compile ( expr* -> regex* )
          ;pos    STA2
    #0000 ;parens STA2
    ;reset-stack JSR2
    ;compile-region JMP2

( the basic strategy here is to build a stack of non-or )
( expressions to be joined together at the end of the )
( region. each stack entry has two regex addresses: )
(   - the start of the regex )
(   - the current tail of the regex )
( when we concatenate a new node to a regex we update )
( the second of these but not the first. )
( )
( the bottom of the stack for a given region is denoted )
( by #ffff #ffff. above that we start with #0000 #0000 )
( to signal an empty node. )
@compile-region ( -> r2* )
    #ffff #ffff ;push4 JSR2 ( stack delimiter )
    #0000 #0000 ;push4 JSR2 ( stack frame start )
@compile-region-loop
    ;read JSR2
    DUP #00 EQU ;c-done JCN2
    DUP LIT '| EQU ;c-or   JCN2
    DUP LIT '. EQU ;c-dot  JCN2
    DUP LIT '^ EQU ;c-caret  JCN2
    DUP LIT '$ EQU ;c-dollar  JCN2
    DUP LIT '( EQU ;c-lpar JCN2
    DUP LIT ') EQU ;c-rpar JCN2
    DUP LIT '\ EQU ;c-esc  JCN2
    DUP LIT '* EQU ;c-star JCN2 
    DUP LIT '+ EQU ;c-plus JCN2 
    DUP LIT '? EQU ;c-qmark JCN2 
                   ;c-char JMP2

( either finalize the given r0/r1 or else wrap it in )
( a star node if a star is coming up next. )
( )
( we use this look-ahead approach rather than compiling )
( star nodes directly since the implementation is simpler. )
@c-peek-and-finalize ( r0* r1* -> r2* )
    ;peek-to-star JSR2 ( r0 r1 next-is-star? ) ,&next-is-star JCN
    ;peek-to-plus JSR2 ( r0 r1 next-is-plus? ) ,&next-is-plus JCN
    ;peek-to-qmark JSR2 ( r0 r1 next-is-qmark? ) ,&next-is-qmark JCN
    ,&finally JMP ( r0 r1 )
    &next-is-star ;skip JSR2 POP2 ;alloc-star JSR2 DUP2 ,&finally JMP
    &next-is-plus ;skip JSR2 POP2 ;alloc-plus JSR2 DUP2 ,&finally JMP
    &next-is-qmark ;skip JSR2 POP2 ;alloc-qmark JSR2 DUP2 ,&finally JMP
    &finally ;push-next JSR2 ;compile-region-loop JMP2

( called when we reach EOF of the input string )
( )
( as with c-rpar we have to unroll the current level )
( of the stack, building any or-nodes that are needed. )
( )
( this is where we detect unclosed parenthesis. )
@c-done ( c^ -> r2* )
    POP
    ;parens LDA2 #0000 GTH2 ,&mismatched-parens JCN
    ;unroll-stack JSR2 POP2 JMP2r
    &mismatched-parens ;mismatched-parens ;error! JSR2

( called when we read "|" )
( )
( since we defer building or-nodes until the end of the region )
( we just start a new stack frame and continue. )
@c-or ( c^ -> r2* )
    POP
    #0000 #0000 ;push4 JSR2
    ;compile-region-loop JMP2

( called when we read "(" )
( )
( this causes us to: )
( )
(  1. increment parens )
(  2. start a new region on the stack )
(  3. jump to compile-region to start parsing the new region )
@c-lpar ( c^ -> r2* )
    POP
    ;parens LDA2 INC2 ;parens STA2 ( parens++ )
    ;compile-region JMP2

( called when we read ")" )
( )
( this causes us to: )
( )
(  1. check for mismatched parens )
(  2. decrement parens )
(  3. unroll the current region on the stack into one regex node )
(  4. finalize that node and append it to the previous region )
(  5. continue parsing ) 
@c-rpar ( c^ -> r2* )
    POP
    ;parens LDA2 #0000 EQU2 ,&mismatched-parens JCN
    ;parens LDA2 #0001 SUB2 ;parens STA2 ( parens-- )
    ;unroll-stack JSR2
    ;c-peek-and-finalize JMP2
    &mismatched-parens ;mismatched-parens ;error! JSR2

( called when we read "." )
( )
( allocates a dot-node and continues. )
@c-dot ( c^ -> r2* )
    POP
    #02 ;alloc3 JSR2
    DUP2 ;c-peek-and-finalize JMP2

( called when we read "^" )
( )
( allocates a caret-node and continues. )
@c-caret ( c^ -> r2* )
    POP
    #06 ;alloc3 JMP2
    DUP2 ;c-peek-and-finalize JMP2

( called when we read "$" )
( )
( allocates a dollar-node and continues. )
@c-dollar ( c^ -> r2* )
    POP
    #07 ;alloc3 JMP2
    DUP2 ;c-peek-and-finalize JMP2

( called when we read "\" )
( )
( handles special sequences: \a \b \t \n \v \f \r )
( )
( otherwise, allocates a literal of the next character. )
@c-esc ( c^ -> r2* )
    POP ;read JSR2
    DUP LIT 'a EQU  ,&bel JCN
    DUP LIT 'b EQU   ,&bs JCN
    DUP LIT 't EQU  ,&tab JCN
    DUP LIT 'n EQU   ,&nl JCN
    DUP LIT 'v EQU ,&vtab JCN
    DUP LIT 'f EQU   ,&ff JCN
    DUP LIT 'r EQU   ,&cr JCN
    &default ;c-char JMP2
    &bel  POP #07 ,&default JMP
    &bs   POP #08 ,&default JMP
    &tab  POP #09 ,&default JMP
    &nl   POP #0a ,&default JMP
    &vtab POP #0b ,&default JMP
    &ff   POP #0c ,&default JMP
    &cr   POP #0d ,&default JMP

( called when we read any other character )
( )
( allocates a literal-node and continues. )
@c-char ( c^ -> r2* )
    ;alloc-lit JSR2 ( lit )
    DUP2 ;c-peek-and-finalize JMP2

( called if we parse a "*" )
( )
( actually calling this means the code broke an invariant somewhere. )
@c-star ( c^ -> regex* )
    POP
    ;star-invariant ;error! JSR2

( called if we parse a "+" )
( )
( actually calling this means the code broke an invariant somewhere. )
@c-plus ( c^ -> regex* )
    POP
    ;plus-invariant ;error! JSR2

( called if we parse a "?" )
( )
( actually calling this means the code broke an invariant somewhere. )
@c-qmark ( c^ -> regex* )
    POP
    ;qmark-invariant ;error! JSR2

( ALLOCATING REGEX NDOES )

@alloc3 ( mode^ -> r* )
    #0000 ROT ( 00 00 mode^ )
    #03 ;alloc JSR2 ( 00 00 mode^ addr* )
    STH2k STA ( addr <- mode )
    STH2kr INC2 STA2 ( addr+1 <- 0000 )
    STH2r JMP2r ( return addr )

@alloc-empty ( -> r* )
    #01 ;alloc3 JMP2

@alloc-lit ( c^ -> r* )
    #03 #0000 SWP2 ( 0000 c^ 03 )
    #04 ;alloc JSR2 ( 0000 c^ 03 addr* )
    STH2k STA ( addr <- 03 )
    STH2kr INC2 STA ( addr+1 <- c )
    STH2kr #0002 ADD2 STA2 ( addr+2 <- 0000 )
    STH2r JMP2r ( return addr )

@alloc-or ( right* left* -> r* )
    #05 ;alloc JSR2 STH2 ( r l [x] )
    #04 STH2kr            STA ( r l [x] )
        STH2kr       INC2 STA2 ( r [x] )
        STH2kr #0003 ADD2 STA2 ( [x] )
    STH2r JMP2r

@alloc-star ( expr* -> r* )
    #05 ;alloc JSR2 STH2  ( expr [r] )
    #05 STH2kr STA        ( expr [r] )
    DUP2 STH2kr INC2 STA2 ( expr [r] )
    #0000 STH2kr #0003 ADD2 STA2 ( expr [r] )
    STH2kr SWP2 ( r expr [r] )
    ;set-next JSR2 ( [r] )
    STH2r JMP2r

@alloc-plus ( expr* -> r* )
    #05 ;alloc JSR2 STH2  ( expr [r] )
    #05 STH2kr STA        ( expr [r] )
    DUP2 STH2kr INC2 STA2 ( expr [r] )
    #0000 STH2kr #0003 ADD2 STA2 ( expr [r] )
    STH2r SWP2 STH2k ( r expr [expr] )
    ;set-next JSR2 ( [expr] )
    STH2r JMP2r

@alloc-qmark ( expr* -> r* )
    ;alloc-empty JSR2 STH2k ( expr e [e] )
    OVR2 ;set-next JSR2 ( expr [e] )
    #05 ;alloc JSR2 STH2  ( expr [r e] )
    #04 STH2kr STA        ( expr [r e] )
    STH2kr INC2 STA2 ( [r e] )
    SWP2r STH2r STH2kr ( e r [r] )
    #0003 ADD2 STA2 ( [r] )
    STH2r JMP2r

( if r is 0000, allocate an empty node )
@alloc-if-null ( r* -> r2* )
    ORAk ,&return JCN POP2 ;alloc-empty JSR2 &return JMP2r

( unroll one region of the parsing stack, returning )
( a single node consisting of an alternation of )
( all elements on the stack. )
( )
( this unrolls until it hits #ffff #ffff, which it )
( also removes from the stack. )
@unroll-stack ( -> start* end* )
    ;pop4 JSR2 STH2 ( r )
    #00 STH ( count items in stack frame )
    ;alloc-if-null JSR2 ( replace 0000 with empty )
    &loop ( r* )
    ;pop4 JSR2 POP2 ( r x )
    DUP2 #ffff EQU2 ( r x x-is-end? ) ,&done JCN
    INCr ( items++ )
    ;alloc-or JSR2 ( r|x ) ,&loop JMP
    &done
    ( r ffff )
    POP2
    STHr ,&is-or JCN
    STH2r JMP2r
    &is-or
    POP2r
    ;alloc-empty JSR2 OVR2 OVR2 SWP2 ( r empty empty r )
    ;set-next-or JSR2
    JMP2r

( add r to the top of the stock. )
( )
( in particular, this will write r into tail.next )
( before replacing tail with r. )
@push-next ( r0 r1 -> )
    ;pop4 JSR2 ( r0 r1 x0 x1 )
    DUP2 #0000 EQU2 ( r0 r1 x0 x1 x1=0? ) ,&is-zero JCN
    STH2 ROT2 STH2r ( r1 x0 r0 x1 )
    ;set-next JSR2 SWP2 ( x0 r1 )
    ;push4 JSR2
    JMP2r
    &is-zero POP2 POP2 ;push4 JSR2 JMP2r

( load the given address:  )
( )
(  1. if it points to 0000, update it to target )
(  2. otherwise, call set-next on it )
@set-next-addr ( target* addr* -> )
    LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN
    LDA2 ;set-next JSR2 JMP2r
    &is-zero STA2 JMP2r

( set regex.next to target )
( )
( node types 1-7 are defined. )
( )
( all node types except star (5) and lit (3) store their next )
( pointer one byte off of their own address. )
( )
( since both branches of an or (4) node are supposed to meet )
( back up we only bother taking the left branch. otherwise )
( you can end up double-appending things. )
@set-next ( target* regex* -> )
        LDAk #01 LTH ,&unknown JCN
        LDAk #07 GTH ,&unknown JCN
        LDAk #05 NEQ ,&!5 JCN #0003 ADD2 ,&continue JMP
    &!5 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 ,&continue JMP
    &!3 INC2
    &continue ;set-next-addr JSR2 JMP2r
    &unknown ;unknown-node-type ;error! JSR2

@set-next-or-addr ( target* addr* -> )
    LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN
    LDA2 ;set-next-or JSR2 JMP2r
    &is-zero STA2 JMP2r

( this is used when first building or-nodes )
( structure will always be: )
( [x1, [x2, [x3, ..., [xm, xn]]]] )
( so we recurse on the right side but not the left. )
@set-next-or ( target* regex* -> )
    LDAk #04 NEQ ,&!4 JCN
    OVR2 OVR2 INC2 ;set-next-addr JSR2
        #0003 ADD2 ;set-next-or-addr JSR2 JMP2r
    &!4 ;set-next JMP2

( STACK OPERATIONS )
( )
( we always push/pop 4 bytes at a time. the stack has a fixed )
( maximum size it can use, defined by ;stack-top. )
( )
( the stack can be cleared using ;reset-stack, which resets )
( the stack pointers but does not zero out any memory. )
( )
( stack size is 4096 bytes here but is configurable. )
( in some cases it could be very small but this will limit )
( how many branches can be parsed and executed. )

( push 4 bytes onto the stack )
@push4 ( str* regex* -> )
    ;assert-stack-avail JSR2 ( check for space )
    ;stack-pos LDA2 #0002 ADD2 STA2 ( cell[2:3] <- regex )
    ;stack-pos LDA2 STA2 ( cell[0:1] <- str )
    ;stack-pos LDA2 #0004 ADD2 ;stack-pos STA2 ( pos += 4 )
    JMP2r

( pop 4 bytes from the stack )
@pop4 ( -> str* regex* )
    ;assert-stack-exist JSR2 ( check for space )
    ;stack-pos LDA2 ( load stack-pos )
    #0002 SUB2 LDA2k STH2 ( pop and stash regex )
    #0002 SUB2 LDA2k STH2 ( pop and stash str )
    ;stack-pos STA2 ( save new stack-pos )
    STH2r STH2r ( restore str and regex )
    JMP2r

(
( -> size^ )
@frame-size
    #00 STH ;stack-pos LDA2
    &loop
    #0004 SUB2 LDA2k #ffff EQU2 ,&done JCN
    INCr ,&loop JMP
    &done
    STHr JMP2r )

( reset stack pointers )
@reset-stack ( -> )
    ;stack-bot ;stack-pos STA2 JMP2r ( pos <- 0 )

( can more stack be allocated? )
@stack-avail ( -> bool^ )
    ;stack-pos LDA2 ;stack-top LTH2 JMP2r

( is the stack non-empty? )
@stack-exist ( -> bool^ )
    ;stack-pos LDA2 ;stack-bot GTH2 JMP2r

( error if stack is full )
@assert-stack-avail ( -> )
    ;stack-avail JSR2 ,&ok JCN ;stack-is-full ;error! JSR2 &ok JMP2r

( error is stack is empty )
@assert-stack-exist ( -> )
    ;stack-exist JSR2 ,&ok JCN ;stack-is-empty ;error! JSR2 &ok JMP2r

( stack-pos points to the next free stack position (or the top if full). )
@stack-pos :stack-bot ( the next position to insert at )

( stack-bot is the address of the first stack position. )
( stack-top is the address of the first byte beyond the stack. )
@stack-bot $1000 @stack-top ( holds 1024 steps (4096 bytes) )

( ARENA OPERATIONS )
( )
( the arena represents a heap of memory that can easily be )
( allocated in small amounts. )
( )
( the entire arena can be reclaimed using ;reset-arena, but )
( unlike systems such as malloc/free, the arena cannot relcaim )
( smaller amounts of memory. )
( )
( the arena is used to allocate regex graph nodes, which are )
( dynamically-allocated as the regex string is parsed. once )
( a regex is no longer needed the arena may be reclaimed. )
( )
( arena size is 1024 bytes here but is configurable. )
( smaller sizes would likely be fine but will limit the )
( overall complexity of regexes to be parsed and executed. )

( reclaim all the memory used by the arena )
@reset-arena ( -> )
    ;arena-bot ;arena-pos STA2 JMP2r

( currently caller is responsible for zeroing out memory if needed )
@alloc ( size^ -> addr* )
    #00 SWP ( size* )
    ;arena-pos LDA2 STH2k ADD2 ( pos+size* [pos] )
    DUP2 ;arena-top GTH2 ( pos+size pos+size>top? [pos] )
    ,&error JCN ( pos+size [pos] )
    ;arena-pos STA2 ( pos += size [pos] )
    STH2r JMP2r ( pos )
    &error POP2 POP2r ;arena-is-full ;error! JSR2

@arena-pos :arena-bot ( the next position to allocate )
@arena-bot $400 @arena-top ( holds up to 1024 bytes )

( SUBGROUP OPERATIONS )
( )
( subgroups are parts of the input string that are matched by )
( parenthesized subgroup expressions in a regex. )
( )
( for example, (a*)(b*)(c*) has 3 subgroup expressions. )
( )
( during matching, subgroups are represented by 4-bytes )
( which are interpreted as two short values: )
( )
( - bytes 0-1: absolute address of the start of the subgroup )
( - bytes 2-3: absolute address of the limit of the subgroup )
( )
( this means that to get a null-terminated subgroup string )
( you will need to copy it somewhere else with enough space, )
( or else mutate the input string to add a null. )
( )
( since input strings themselves are null-terminated, and since )
( subgroups never include null terminators, we will always have )
( a valid limit value even for input strings that end at #ffff. )
( )
( during regex parsing we will use subgroup-pos to track the )
( next available subgroup position. )

@subgroup-start ( s* i* -> )
    DUP2 ;subgroup-pos LDA2 LTH2 ,&write JCN ( s i )
    DUP2 #0004 ADD2 ;subgroup-pos STA2 ( s i )
    &write STA2 JMP2r

@subgroup-finish ( s* i* -> )
    STA2 JMP2r

@subgroup-backtrack ( i* -> )
    ;subgroup-pos LDA2
    &loop #0004 SUB2
          LTH2k ,&done JCN
          #0000 OVR2 STA2
          #0000 OVR2 #0002 ADD2 STA2
          ,&loop JMP
    &done POP2 ;subgroup-pos STA2
          JMP2r

@subgroup-reset ( -> )
    ;subgroup-bot ;subgroup-pos STA2
    ;subgroup-top ;subgroup-bot LIT2r 0000
    &loop GTH2k ,&continue JCN
          POP2 POP2 POP2r JMP2r
    &continue STH2kr OVR2 STA2
              INC2 INC2 ,&loop JMP

@subgroup-pos :subgroup-bot ( the position of the first unallocated subgroup )
@subgroup-bot $800 @subgroup-top ( holds up to 512 subgroups (2048 bytes) )

( INTERVAL OPERATIONS )
( )
( not baked yet )
(
@min ( first* last* -> min-addr* )
    SWP2 STH2k ,&incr JMP ( last first [first] )
    &loop LDAk LDAkr STHr LTH ,&replace JCN ,&incr JMP ( last a [c] )
    &replace POP2r STH2k ( last a [a] )
    &incr EQUk ,&done JCN INC2 ,&loop JMP ( last a+1 [c] )
    &done POP2 POP2 STH2r JMP2r ( c )

@sort ( first* last* -> )
    SWP2 ( last first )
    &loop ;min JSR2 NEQk ,&swap JCN POP2 ,&incr JMP
    &swap STH2 LDA2k ( last first fx [min] ) STH2kr STA STH2r SWP2 ( last min first )
          STH2 LDA2  ( last mx [first] )     STH2kr STA STH2r ( last first )
    &incr EQUk ,&done JCN INC2 ,&loop JMP
    &done POP2 POP2 JMP2r

@iv-in-range ( c^ b0^ b1^ -> bool^ )
    ROT STHk LTH ,&above JCN
        STHr GTH ,&below JCN #01 JMP2r
    &above POPr POP &below #00 JMP2r

@iv-find ( c^ iv* -> bool^ )
    )