%dbg { #ff #0e DEO } %sp { #20 #18 DEO } %nl { #0a #18 DEO } %exit { #01 #0f DEO BRK } |0100 ;expr1 ;compile JSR2 dbg nl ;emit-stack JSR2 nl ;emit-arena JSR2 nl LIT '= ;emit JSR2 sp #01 ;emit-bool JSR2 sp #01 ;emit-bool JSR2 sp #00 ;emit-bool JSR2 sp #01 ;emit-bool JSR2 sp #01 ;emit-bool JSR2 sp #00 ;emit-bool JSR2 sp #00 ;emit-bool JSR2 sp #00 ;emit-bool JSR2 nl LIT 'A ;emit JSR2 sp ;test1 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test2 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test3 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test4 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test5 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test6 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test7 OVR2k ;match JSR2 ;emit-bool JSR2 sp ;test8 OVR2k ;match JSR2 ;emit-bool JSR2 nl LIT 'B ;emit JSR2 sp ;test1 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test2 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test3 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test4 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test5 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test6 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test7 ;graph1 ;match JSR2 ;emit-bool JSR2 sp ;test8 ;graph1 ;match JSR2 ;emit-bool JSR2 nl ;reset-arena JSR2 exit ( corresponds to regex: a(b|c)d* ) @expr1 "a(b|c)d* 00 ( corresponds to regex: a(b|c)d* ) ( accepts "ab" or "ac" followd by any number of d's ) @graph1 03 'a :x1 @x1 04 :x2 :x3 @x2 03 'b :x4 @x3 03 'c :x4 @x4 05 :x5 0000 @x5 03 'd :x4 ( test case strings to try matching ) @test1 "ab 00 ( yes ) @test2 "acdd 00 ( yes ) @test3 "add 00 ( no ) @test4 "abd 00 ( yes ) @test5 "acddddddddddd 00 ( yes ) @test6 "bd 00 ( no ) @test7 "z 00 ( no ) @test8 00 ( no ) ~regex.tal @emit ( c^ -- ) emit JMP2r @emit-short ( short* -- ) SWP ;emit-byte JSR2 ;emit-byte JSR2 JMP2r @emit-byte ( byte^ -- ) DUP #04 SFT ,&hex JSR #0f AND ,&hex JMP &hex #30 ADD DUP #39 GTH #27 MUL ADD emit JMP2r @emit-bool ( byte^ -- ) LIT '0 ADD emit JMP2r ( print stack size, followed by contents ) @emit-stack ( -> ) space LIT 'n emit LIT '= emit ;stack-pos LDA2 ;stack-bot SUB2 #0004 DIV2 ;emit-short JSR2 LIT ': emit ;stack-bot &loop DUP2 ;stack-pos LDA2 LTH2 ,&ok JCN POP2 newline JMP2r &ok space LDA2k ;emit-short JSR2 #0002 ADD2 ,&loop JMP ( emit n bytes from the given address ) @emit-n ( addr* count^ -> addr2* ) DUP #00 GTH ( addr count count>0? ) ,&ok JCN ( addr count ) POP newline JMP2r &ok STH ( addr [count] ) space LDAk ;emit-byte JSR2 INC2 ( addr+1 [count] ) STHr #01 SUB ( addr+1 count-1 ) ;emit-n JMP2 ( emit the arena, with one line per node ) ( parses node type, since node size is dynamic (3-5). ) @emit-arena ( -> ) ;arena-bot &loop DUP2 ;arena-pos LDA2 LTH2 ,&ok JCN POP2 JMP2r &ok DUP2 ;emit-short JSR2 LIT ': emit space LDAk #01 NEQ ,&!1 JCN #03 ;emit-n JSR2 ,&loop JMP &!1 LDAk #02 NEQ ,&!2 JCN #03 ;emit-n JSR2 ,&loop JMP &!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 ;unknown-node-type ;error! JSR2