star refactor working

This commit is contained in:
~d6 2022-01-30 15:11:03 -05:00
parent 127379830e
commit d21a8b56f1
1 changed files with 19 additions and 20 deletions

View File

@ -76,6 +76,7 @@
@stack-is-full "stack 20 "is 20 "full 00 @stack-is-full "stack 20 "is 20 "full 00
@stack-is-empty "stack 20 "is 20 "empty 00 @stack-is-empty "stack 20 "is 20 "empty 00
@arena-is-full "arena 20 "is 20 "full 00 @arena-is-full "arena 20 "is 20 "full 00
@star-invariant "star 20 "invariant 20 "failed 00
@match ( str* regex* -> bool^ ) @match ( str* regex* -> bool^ )
;reset-stack JSR2 ;reset-stack JSR2
@ -149,7 +150,9 @@
INC2 ( pos s+1 [c] ) INC2 ( pos s+1 [c] )
SWP2 STA2 ,&return JMP ( [c] ) SWP2 STA2 ,&return JMP ( [c] )
&is-eof POP2 POP2 &is-eof POP2 POP2
&return STHr ( c ) JMP2r &return STHr ( c )
;pos LDA2 ;emit-short JSR2 LIT '> emit DUP ;emit-byte JSR2 newline
JMP2r
( read pos ) ( read pos )
@peek ( -> c^ ) @peek ( -> c^ )
@ -160,7 +163,10 @@
( pos += 1 ) ( pos += 1 )
@skip @skip
;pos LDA2 INC2 ;pos STA2 JMP2r ;pos LDA2 ;emit-short JSR2 LIT '! emit
;pos LDA2 INC2 ;pos STA2
;pos LDA2 ;emit-short JSR2 newline
JMP2r
( TODO: [] + ? ) ( TODO: [] + ? )
( compile an expression string into a regex graph ) ( compile an expression string into a regex graph )
@ -195,11 +201,11 @@
DUP LIT '* EQU ;c-star JCN2 DUP LIT '* EQU ;c-star JCN2
;c-char JMP2 ;c-char JMP2
@c-peek-and-finalize ( r* -> r2* ) @c-peek-and-finalize ( r0* r1* -> r2* )
;peek-to-star JSR2 ( r next-is-star? ) ;peek-to-star JSR2 ( r0 r1 next-is-star? )
,&next-is-star JCN ,&finally JMP ( r ) ,&next-is-star JCN ,&finally JMP ( r0 r1 )
&next-is-star ;skip JSR2 ;alloc-star JSR2 ( star ) &next-is-star ;skip JSR2 POP2 ;alloc-star JSR2 DUP2 ( star )
&finally DUP2 ;push-next JSR2 ;compile-region-loop JMP2 &finally ;push-next JSR2 ;compile-region-loop JMP2
@c-done ( c^ -> r2* ) @c-done ( c^ -> r2* )
POP POP
@ -222,18 +228,17 @@
;parens LDA2 #0000 EQU2 ,&mismatched-parens JCN ;parens LDA2 #0000 EQU2 ,&mismatched-parens JCN
;parens LDA2 #0001 SUB2 ;parens STA2 ( parens-- ) ;parens LDA2 #0001 SUB2 ;parens STA2 ( parens-- )
;unroll-stack JSR2 ;unroll-stack JSR2
;push-next JSR2 ;c-peek-and-finalize JMP2
;compile-region-loop JMP2
&mismatched-parens ;mismatched-parens ;error! JSR2 &mismatched-parens ;mismatched-parens ;error! JSR2
@c-dot ( c^ -> r2* ) @c-dot ( c^ -> r2* )
POP POP
;alloc-dot JSR2 ( dot ) ;alloc-dot JSR2 ( dot )
;c-peek-and-finalize JMP2 DUP2 ;c-peek-and-finalize JMP2
@c-char ( c^ -> r2* ) @c-char ( c^ -> r2* )
;alloc-lit JSR2 ( lit ) ;alloc-lit JSR2 ( lit )
;c-peek-and-finalize JMP2 DUP2 ;c-peek-and-finalize JMP2
( TODO: escaping rules not quite right ) ( TODO: escaping rules not quite right )
@c-esc ( c^ -> r2* ) @c-esc ( c^ -> r2* )
@ -241,16 +246,10 @@
;read JSR2 ;read JSR2
;c-char JMP2 ;c-char JMP2
( we don't expect to actually handle this )
@c-star ( c^ -> regex* ) @c-star ( c^ -> regex* )
POP POP
;pop4 JSR2 SWP2 STH2 STH2k ( x1 [x0 x1] ) ;star-invariant ;error! JSR2
;alloc-star JSR2 ( r )
STH2r STH2kr ( r x1 x0 [x0] )
;remove-from JSR2 ( r [x0] )
STH2r OVR2 OVR2 ( r x0 r x0 ) ;set-next JSR2
OVR2 #0003 ADD2 #0000 SWP2 STA2 ( fixme: manually zeroing next )
( r x0 ) SWP2 ;push4 JSR2
;compile-region-loop JMP2
( allocate node types ------ ) ( allocate node types ------ )