nxu/repl-regex.tal

( repl-regex.tal )

%dbg { #ff #0e DEO }
%sp { #20 #18 DEO }
%nl { #0a #18 DEO }
%exit { #01 #0f DEO BRK }

( read in regular expressions )
( and emit internal structures parsed )
|0100
    ;r-prompt ;println JSR2
    ;r-read-stdin #10 DEO2 BRK

( we use two different prompts depending on what mode we're in )
@r-prompt "enter 20 "regex: 20 00
@s-prompt "string 20 "to 20 "match: 20 00


@regex $2     ( compiled regex address (if any) )
@buffer $1000 ( buffer to read user input )
@ptr :buffer  ( next byte to write in buffer )

@println ( s* -> )
    &loop LDAk #00 EQU ,&eof JCN
    LDAk #18 DEO INC2 ,&loop JMP
    &eof POP2 JMP2r

@r-read-stdin ( -> )
    #12 DEI #0a EQU ,&execute JCN
    #12 DEI ;ptr LDA2 STA
    ;ptr LDA2k INC2 SWP2 STA2
    BRK
    &execute
    #00 ;ptr LDA2 STA
    ;buffer ;ptr STA2
    ;buffer ;compile JSR2 dbg nl
    DUP2 ;regex STA2
    ;emit-stack JSR2 nl
    ;emit-arena JSR2 nl
    ;reset-arena JSR2
    POP2
    ;s-prompt ;println JSR2
    ;s-read-stdin #10 DEO2 BRK
    BRK

@s-read-stdin ( -> )
    #12 DEI #0a EQU ,&execute JCN
    #12 DEI ;ptr LDA2 STA
    ;ptr LDA2k INC2 SWP2 STA2
    BRK
    &execute
    #00 ;ptr LDA2 STA ( null terminate string )
    ;ptr LDA2 ;buffer EQU2 STH ( stash is-empty? )
    ;buffer ;ptr STA2 ( reset ptr )
    ;buffer ;regex LDA2 ;match JSR2 ( match regex )
    ;emit-byte JSR2 nl ( print result )
    STHr ,&was-empty JCN
    ;s-prompt ;println JSR2
    BRK
    &was-empty
    ;r-prompt ;println JSR2
    ;r-read-stdin #10 DEO2 BRK
    BRK

~regex.tal

@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

( 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