diff --git a/regex.tal b/regex.tal index 423e32b..656d67f 100644 --- a/regex.tal +++ b/regex.tal @@ -316,40 +316,33 @@ ( set regex.next to target ) @set-next ( target* regex* -> ) -( LIT 'n emit space LDAk ;emit-byte JSR2 print ) - LDAk #01 NEQ ,&!1 JCN INC2 ( STA2 ) ( LIT 't emit print ) ;set-next-addr JSR2 JMP2r - &!1 LDAk #02 NEQ ,&!2 JCN INC2 ( STA2 ) ;set-next-addr JSR2 JMP2r - &!2 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 ( STA2 ) ( LIT 'y emit print ) ;set-next-addr JSR2 JMP2r + LDAk #01 NEQ ,&!1 JCN INC2 ;set-next-addr JSR2 JMP2r + &!1 LDAk #02 NEQ ,&!2 JCN INC2 ;set-next-addr JSR2 JMP2r + &!2 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 ;set-next-addr JSR2 JMP2r &!3 LDAk #04 NEQ ,&!4 JCN -( LIT 'w emit print ) -( INC2k LDA2 space LIT '{ emit DUP2 ;emit-short JSR2 ;set-next JSR2 - #0003 ADD2 LDA2 space LIT '} emit DUP2 ;emit-short JSR2 ;set-next JSR2 JMP2r ) - OVR2 OVR2 INC2 ( LIT '{ emit space ) ;set-next-addr JSR2 - #0003 ADD2 ( LIT '} emit space ) ;set-next-addr JSR2 JMP2r - &!4 LDAk #05 NEQ ,&!5 JCN #0003 ADD2 ( STA2 ) ;set-next-addr JSR2 JMP2r - &!5 ( LIT '? emit LDAk ;emit-byte JSR2 ) error! + ( todo: this is probably broken ) + OVR2 OVR2 INC2 ;set-next-addr JSR2 + #0003 ADD2 ;set-next-addr JSR2 JMP2r + &!4 LDAk #05 NEQ ,&!5 JCN #0003 ADD2 ;set-next-addr JSR2 JMP2r + &!5 error! @remove-addr ( target* addr* -> ) -( LIT 'A emit print ) LDA2k #0000 EQU2 ( t a v=0? ) ,&is-zero JCN OVR2 OVR2 LDA2 EQU2 ( t a t=v? ) ,&is-equal JCN LDA2 ( t v ) ;remove-from JSR2 JMP2r - &is-zero ( LIT 'r emit print ) POP2 POP2 JMP2r - &is-equal ( LIT 's emit print ) NIP2 #0000 SWP2 STA2 JMP2r + &is-zero POP2 POP2 JMP2r + &is-equal NIP2 #0000 SWP2 STA2 JMP2r ( remove target from regex ) @remove-from ( target* regex* -> ) -( LIT 'R emit print ) LDAk #01 NEQ ,&!1 JCN INC2 ;remove-addr JSR2 JMP2r &!1 LDAk #02 NEQ ,&!2 JCN INC2 ;remove-addr JSR2 JMP2r &!2 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 ;remove-addr JSR2 JMP2r &!3 LDAk #04 NEQ ,&!4 JCN -( LIT 'Q emit print ) OVR2 OVR2 INC2 ;remove-addr JSR2 -( LIT 'q emit print ) #0003 ADD2 ;remove-addr JSR2 JMP2r &!4 LDAk #05 NEQ ,&!5 JCN #0003 ADD2 ;remove-addr JSR2 JMP2r - &!5 ( LIT '? emit LDAk ;emit-byte JSR2 ) error! + &!5 error! ( test cases -------- ) @@ -387,12 +380,6 @@ ( stack operations ---- ) -( @peek2 ( -> regex* ) - ;assert-exist JSR2 ( check for space ) - ;stack-pos LDA2 ( load stack-pos ) - #0002 SUB2 LDA2 ( get regex ) - JMP2r ) - @push4 ( str* regex* -> ) ;assert-avail JSR2 ( check for space ) ;stack-pos LDA2 #0002 ADD2 STA2 ( cell[2:3] <- regex ) @@ -400,13 +387,6 @@ ;stack-pos LDA2 #0004 ADD2 ;stack-pos STA2 ( pos += 4 ) JMP2r -( @peek4 ( -> str* regex* ) - ;assert-exist JSR2 ( check for space ) - ;stack-pos LDA2 ( load stack-pos ) - #0002 SUB2 LDA2k STH2 ( pop and stash regex ) - #0002 SUB2 LDA2 STH2r ( pop the str, restore the regex ) - JMP2r ) - @pop4 ( -> str* regex* ) ;assert-exist JSR2 ( check for space ) ;stack-pos LDA2 ( load stack-pos ) @@ -467,7 +447,6 @@ @emit-arena ( -> ) ;arena-bot &loop -( print ) DUP2 ;arena-pos LDA2 LTH2 ,&ok JCN POP2 JMP2r &ok DUP2 ;emit-short JSR2 @@ -477,5 +456,5 @@ &!2 LDAk #03 NEQ ,&!3 JCN #04 ;emit-n JSR2 ,&loop JMP &!3 LDAk #04 NEQ ,&!4 JCN #05 ;emit-n JSR2 ,&loop JMP &!4 LDAk #05 NEQ ,&!5 JCN #05 ;emit-n JSR2 ,&loop JMP - &!5 ( LDAk ;emit-byte JSR2 LIT '! emit newline ) error! + &!5 error! \ No newline at end of file