cleaned up
This commit is contained in:
parent
72509dc43b
commit
5f7c93f959
91
regex.tal
91
regex.tal
|
|
@ -35,10 +35,13 @@
|
|||
%newline { #0a emit }
|
||||
%print { debug newline }
|
||||
|
||||
( test -> )
|
||||
|
||||
|0100
|
||||
;expr1 ;compile JSR2 print newline
|
||||
;emit-stack JSR2 newline
|
||||
;emit-arena JSR2 newline
|
||||
;expr1 ;compile JSR2
|
||||
print
|
||||
;emit-stack JSR2
|
||||
;emit-arena JSR2
|
||||
newline
|
||||
|
||||
;test1 OVR2k ;match JSR2 ;emit-byte JSR2 newline
|
||||
|
|
@ -220,8 +223,8 @@
|
|||
( LIT '@ emit DUP ;emit-byte JSR2 newline )
|
||||
;alloc-lit JSR2
|
||||
( LIT '# emit print )
|
||||
;emit-stack JSR2
|
||||
;emit-arena JSR2
|
||||
( ;emit-stack JSR2
|
||||
;emit-arena JSR2 )
|
||||
DUP2 ;push-next JSR2 ( print )
|
||||
( LIT '& emit print )
|
||||
;compile-region-loop JMP2
|
||||
|
|
@ -234,22 +237,22 @@
|
|||
|
||||
@c-star ( c^ -> regex* )
|
||||
( LIT '* emit print )
|
||||
POP print
|
||||
POP ( print )
|
||||
;pop4 JSR2 SWP2 STH2 STH2k ( x1 [x0 x1] )
|
||||
( LIT '! emit space print )
|
||||
;alloc-star JSR2 ( r )
|
||||
STH2r STH2kr ( r x1 x0 [x0] )
|
||||
( LIT '0 emit newline )
|
||||
;emit-arena JSR2
|
||||
( ;emit-arena JSR2 )
|
||||
;remove-from JSR2 ( r [x0] )
|
||||
LIT '1 emit newline
|
||||
;emit-arena JSR2
|
||||
( LIT '1 emit newline
|
||||
;emit-arena JSR2 )
|
||||
STH2r OVR2 OVR2 ( r x0 r x0 ) ;set-next JSR2
|
||||
OVR2 #0003 ADD2 #0000 SWP2 STA2 ( fixme )
|
||||
LIT '2 emit print
|
||||
;emit-arena JSR2
|
||||
( LIT '2 emit print
|
||||
;emit-arena JSR2 )
|
||||
( r x0 ) SWP2 ;push4 JSR2
|
||||
LIT '* emit print
|
||||
( LIT '* emit print )
|
||||
;compile-region-loop JMP2
|
||||
|
||||
|
||||
|
|
@ -289,15 +292,15 @@
|
|||
|
||||
@alloc-star ( expr* -> r* )
|
||||
( LIT '& emit space print )
|
||||
LIT 'a emit print
|
||||
#05 ;alloc JSR2 STH2 print ( expr [r] )
|
||||
#05 STH2kr STA print ( expr [r] )
|
||||
DUP2 STH2kr INC2 STA2 print ( expr [r] )
|
||||
#0000 STH2kr #0003 ADD2 STA2 print ( expr [r] )
|
||||
LIT 'a emit ;emit-arena JSR2 ;emit-stack JSR2
|
||||
( LIT 'a emit print )
|
||||
#05 ;alloc JSR2 STH2 ( print ) ( expr [r] )
|
||||
#05 STH2kr STA ( print ) ( expr [r] )
|
||||
DUP2 STH2kr INC2 STA2 ( print ) ( expr [r] )
|
||||
#0000 STH2kr #0003 ADD2 STA2 ( print ) ( expr [r] )
|
||||
( LIT 'a emit ;emit-arena JSR2 ;emit-stack JSR2 )
|
||||
|
||||
STH2kr SWP2 print ( r expr [r] )
|
||||
LIT 'x emit print
|
||||
STH2kr SWP2 ( print ) ( r expr [r] )
|
||||
( LIT 'x emit print )
|
||||
;set-next JSR2 ( [r] )
|
||||
STH2r JMP2r
|
||||
|
||||
|
|
@ -313,7 +316,7 @@
|
|||
;pop4 JSR2 STH2 ( r ) ( print )
|
||||
#00 STH
|
||||
DUP2 #0000 NEQ2 ,&loop JCN ;alloc-empty JSR2 ( print )
|
||||
&loop ( r* ) LIT 'L emit print
|
||||
&loop ( r* ) ( LIT 'L emit print )
|
||||
;pop4 JSR2 POP2 ( r x ) ( print )
|
||||
DUP2 #ffff EQU2 ( print ) ( r x x-is-end? ) ,&done JCN
|
||||
INCr
|
||||
|
|
@ -326,10 +329,10 @@
|
|||
STH2r JMP2r
|
||||
&is-or
|
||||
POP2r
|
||||
LIT 'b emit print
|
||||
( LIT 'b emit print )
|
||||
;alloc-empty JSR2 OVR2 OVR2 SWP2 ( r empty empty r )
|
||||
LIT 'c emit print
|
||||
;set-next JSR2 LIT 'd emit print
|
||||
( LIT 'c emit print )
|
||||
;set-next JSR2 ( LIT 'd emit print )
|
||||
( STH2 ;pop4 JSR2 POP2 STH2r ;push4 JSR2 )
|
||||
JMP2r
|
||||
|
||||
|
|
@ -341,22 +344,12 @@
|
|||
;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 )
|
||||
LIT 'p emit print
|
||||
( LIT 'p emit print )
|
||||
;set-next JSR2 SWP2 ( x0 r1 )
|
||||
LIT 'q emit print
|
||||
( LIT 'q emit print )
|
||||
;push4 JSR2
|
||||
JMP2r
|
||||
&is-zero POP2 POP2 ;push4 JSR2 JMP2r
|
||||
( ( r -> )
|
||||
( LIT 'N emit space print 0 )
|
||||
STH2k ( r [r] ) ( print )
|
||||
;pop4 JSR2 ( r x0 x1 [r] ) ( print )
|
||||
DUP2 #0000 EQU2 ( r x0 x1 x1=0? [r] ) ( print ) ,&is-zero JCN
|
||||
ROT2 SWP2 ( x0 r x1 [r] ) ( print )
|
||||
;set-next JSR2 ( x0 [r] ) STH2r ( x0 r ) ( print )
|
||||
;push4 JSR2 ( )
|
||||
JMP2r
|
||||
&is-zero POP2 POP2 STH2r ;push4 JSR2 ( print LIT '* emit newline ) JMP2r )
|
||||
|
||||
( for nodes (other than 'or') read their 'next' pointer )
|
||||
@get-next ( r* -> r.next* )
|
||||
|
|
@ -365,36 +358,36 @@
|
|||
&!2 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 LDA2 JMP2r
|
||||
&!3 LDAk #04 NEQ ,&!4 JCN INC2 LDA2 JMP2r
|
||||
&!4 LDAk #05 NEQ ,&!5 JCN #0003 ADD2 LDA2 JMP2r
|
||||
&!5 ( either #04 (or) or ??? ) LIT 'q emit #00 #00 DIV
|
||||
&!5 ( either #04 (or) or ??? ) ( LIT 'q emit ) #00 #00 DIV
|
||||
|
||||
@set-next-addr ( target* addr* -> )
|
||||
LIT 'Z emit print
|
||||
( LIT 'Z emit print )
|
||||
LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN
|
||||
LIT 'N emit print LDA2 ;set-next JSR2 JMP2r
|
||||
&is-zero ( print ) LIT 'z emit print STA2 JMP2r
|
||||
( LIT 'N emit print ) LDA2 ;set-next JSR2 JMP2r
|
||||
&is-zero ( print ) ( LIT 'z emit print ) STA2 JMP2r
|
||||
|
||||
( 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
|
||||
( 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
|
||||
&!2 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 ( STA2 ) ( LIT 'y emit print ) ;set-next-addr JSR2 JMP2r
|
||||
&!3 LDAk #04 NEQ ,&!4 JCN
|
||||
LIT 'w emit print
|
||||
( 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 #00 #00 DIV
|
||||
&!5 ( LIT '? emit LDAk ;emit-byte JSR2 ) #00 #00 DIV
|
||||
|
||||
@remove-addr ( target* addr* -> )
|
||||
LIT 'A emit print
|
||||
( 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 ( LIT 'r emit print ) POP2 POP2 JMP2r
|
||||
&is-equal ( LIT 's emit print ) NIP2 #0000 SWP2 STA2 JMP2r
|
||||
|
||||
( remove target from regex )
|
||||
@remove-from ( target* regex* -> )
|
||||
|
|
@ -408,7 +401,7 @@
|
|||
( 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 #00 #00 DIV
|
||||
&!5 ( LIT '? emit LDAk ;emit-byte JSR2 ) #00 #00 DIV
|
||||
|
||||
( test cases -------- )
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue