d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

searching forward and back by regex works

This commit is contained in:
~d6 2022-04-02 22:29:06 -04:00
parent da49d8bd69
commit 4ffd80526b
3 changed files with 99 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

121
femto.tal
View File

@ -94,8 +94,7 @@
@term [ @term [
&cols $2 ( relative x coordinate of cursor, from 0 ) &cols $2 ( relative x coordinate of cursor, from 0 )
&rows $2 ( relative y coordinaet of cursor, from 1 ) &rows $2 ( relative y coordinate of cursor, from 1 )
( &lmargin $2 ( left padding needed for line numbers ) )
] ]
@config [ @config [
@ -151,6 +150,8 @@
&orig-row $2 ( row we began the search at ) &orig-row $2 ( row we began the search at )
&orig-col $2 ( col we began the search at ) &orig-col $2 ( col we began the search at )
&regex $2 ( regex to be stored if any ) &regex $2 ( regex to be stored if any )
&start $2 ( absolute start pos of match )
&end $2 ( absolute limit pos of match )
] ]
( startup ) ( startup )
@ -166,7 +167,6 @@
@init-zero-page ( -> ) @init-zero-page ( -> )
#0050 .term/cols STZ2 #0050 .term/cols STZ2
#0018 .term/rows STZ2 #0018 .term/rows STZ2
( #0006 .term/lmargin STZ2 )
#0004 .config/tab-width STZ2 #0004 .config/tab-width STZ2
#00 .config/insert-tabs STZ #00 .config/insert-tabs STZ
@ -605,6 +605,8 @@
;return JMP2 ;return JMP2
@do-search ( -> ) @do-search ( -> )
.cursor/row LDZ2 .searching/orig-row STZ2
.cursor/col LDZ2 .searching/orig-col STZ2
#0000 .searching/regex STZ2 #0000 .searching/regex STZ2
;move-to-next-match JSR2 ,&found JCN ;move-to-next-match JSR2 ,&found JCN
;move-to-prev-match JSR2 ,&found JCN ;move-to-prev-match JSR2 ,&found JCN
@ -619,7 +621,10 @@
;redraw-prompt-and-cursor JSR2 ;return JMP2 ;redraw-prompt-and-cursor JSR2 ;return JMP2
@do-regex-search ( -> ) @do-regex-search ( -> )
;tmp/data ;compile .searching/regex STZ2 ;cur-pos JSR2 DUP2 .searching/start STZ2 .searching/end STZ2
.cursor/row LDZ2 .searching/orig-row STZ2
.cursor/col LDZ2 .searching/orig-col STZ2
;tmp/data ;compile JSR2 .searching/regex STZ2
;move-to-next-regex-match JSR2 ,&found JCN ;move-to-next-regex-match JSR2 ,&found JCN
;move-to-prev-regex-match JSR2 ,&found JCN ;move-to-prev-regex-match JSR2 ,&found JCN
;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK ;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK
@ -720,10 +725,16 @@
( matches overlap. ) ( matches overlap. )
@jump-to-next-match ( -> ) @jump-to-next-match ( -> )
;move-to-next-match JSR2 POP ;return JMP2 .searching/regex LDZ2 ORA ,&is-regex JCN
;move-to-next-match JSR2 POP ;return JMP2
&is-regex
;move-to-next-regex-match JSR2 POP ;return JMP2
@jump-to-prev-match ( -> ) @jump-to-prev-match ( -> )
;move-to-prev-match JSR2 POP ;return JMP2 .searching/regex LDZ2 ORA ,&is-regex JCN
;move-to-prev-match JSR2 POP ;return JMP2
&is-regex
;move-to-prev-regex-match JSR2 POP ;return JMP2
@move-to-next-match ( -> ok^ ) @move-to-next-match ( -> ok^ )
.buffer/limit LDZ2 .buffer/limit LDZ2
@ -752,38 +763,42 @@
POP2 POP2 #00 JMP2r POP2 POP2 #00 JMP2r
@move-to-next-regex-match ( -> ok^ ) @move-to-next-regex-match ( -> ok^ )
.buffer/limit LDZ2 .searching/end LDZ2 .buffer/limit LDZ2 OVR2
;cur-pos JSR2 INC2 GTH2 ,&ok JCN
&loop POP2 #00 JMP2r
GTH2k #00 EQU ,&fail JCN &ok
( ;search-start ;search-end ) .searching/regex LDZ2 ;rx-search JSR2 ,&found JCN
( DUP2 ;matches-at JSR2 ) #00 JMP2r
DUP2 .searching/regex LDR2 ;rx-search
,&found JCN
INC2 ( TODO move to next line )
,&loop JMP
&found &found
POP2 POP2 ;search-end LDA2 .searching/end STZ2
;search-start LDA2 ;search-start LDA2 DUP2 .searching/start STZ2
;jump-to-pos JSR2 #01 JMP2r ;jump-to-pos JSR2 #01 JMP2r
&fail
POP2 POP2 #00 JMP2r
( compared to move-to-next-regex-match this is kind of inefficient. )
( that's because we have no easy way to search backwards from a point. )
( )
( we could do some kind of fancy thing where we search the previous )
( N bytes, then the 2N bytes before that, etc. )
( )
( however, 64K is small enough that just searching from the beginning )
( and then taking the last match before the cursor works. )
@move-to-prev-regex-match ( -> ok^ ) @move-to-prev-regex-match ( -> ok^ )
#00 JMP2r LITr 00
( ;data ;cur-pos JSR2 ;data ( limit pos [res] )
;cur-pos JSR2 #0001 SUB2 &loop ( limit pos [res] )
&loop GTH2k #00 EQU ,&done JCN ( limit pos )
GTH2k ,&fail JCN DUP2 .searching/regex LDZ2 ;rx-search JSR2 ( limit pos match? )
DUP2 ;matches-at JSR2 #00 EQU ,&done JCN ( limit pos )
ORA ,&found JCN OVR2 ;search-end LDA2 LTH2 ,&done JCN
#0001 SUB2 ,&loop JMP POP2 POPr LITr 01
&found ;search-start LDA2 .searching/start STZ2
NIP2 ;jump-to-pos JSR2 #01 ,&done JMP ;search-end LDA2 DUP2 .searching/end STZ2
&fail ,&loop JMP
POP2 POP2 #00
&done &done
JMP2r ) POP2 POP2 STHr DUP #00 EQU ,&fail JCN
.searching/start LDZ2 ;jump-to-pos JSR2
&fail
JMP2r
@on-key-searching @on-key-searching
.state/key LDZ #07 EQU ( C-g ) ;cancel-search JCN2 .state/key LDZ #07 EQU ( C-g ) ;cancel-search JCN2
@ -863,7 +878,7 @@
@draw-cursor ( -> ) @draw-cursor ( -> )
.prompt/active LDZ ,&on-prompt JCN .prompt/active LDZ ,&on-prompt JCN
( TODO: handle long lines ) ( TODO: handle long lines )
;cur-w-col JSR2 ( .term/lmargin LDZ2 ) lmargin ADD2 ;cur-w-col JSR2 lmargin ADD2
.cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2 .cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2
;term-move-cursor JMP2 ;term-move-cursor JMP2
&on-prompt &on-prompt
@ -971,15 +986,33 @@
&not-end &not-end
;abs-line JMP2 ;abs-line JMP2
( TODO: enable drawing of regex matches ) @draw-regex-matches ( -> )
( requires a way to anchor our regex on the LHS (e.g. ^) ) ;emit-color-reverse JSR2 ( )
;screen-limit JSR2 .buffer/offset LDZ2 ( limit pos )
&loop ( limit pos )
GTH2k #00 EQU ( limit pos limit>pos=0? )
,&done JCN ( limit pos )
DUP2 .searching/regex LDZ2 ( limit pos pos rx )
;rx-search JSR2 #00 EQU ( limit pos found=0? )
,&done JCN ( limit pos )
POP2 ;search-start LDA2 ( limit start )
GTH2k #00 EQU ( limit start limit>start=0? )
,&done JCN ( limit start )
;search-end LDA2 OVR2 ( limit start end start )
;pos-to-row-col JSR2 ( limit start end row col )
lmargin ADD2 ( limit start end row col+lm )
SWP2 .buffer/line-offset LDZ2 SUB2 ( limit start end col+lm row-lo )
;draw-region JSR2 ( limit )
;search-end LDA2 ( limit end ) ,&loop JMP
&done ( limit pos )
POP2 POP2 JMP2r
@draw-matches ( -> ) @draw-matches ( -> )
( return if not searching ) ( return if not searching )
.searching/active LDZ #00 EQU ,&return JCN ( ) .searching/active LDZ #00 EQU ,&return JCN ( )
.searching/regex LDZ2 ORA ;draw-regex-matches JCN2
;emit-color-reverse JSR2 ;emit-color-reverse JSR2
lmargin ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 )
( .term/lmargin LDZ2 ) lmargin ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 )
.buffer/offset LDZ2 DUP2 .buffer/offset LDZ2 DUP2
;screen-limit JSR2 SUB2 STH2 ( offset [-count] ) ;screen-limit JSR2 SUB2 STH2 ( offset [-count] )
@ -1002,7 +1035,7 @@
ADD2 ADD2r ( offset+n [n-count] ) ADD2 ADD2r ( offset+n [n-count] )
,&loop JMP ,&loop JMP
&newline ( offset [-count] ) &newline ( offset [-count] )
( .term/lmargin LDZ2 ) lmargin ,&x STR2 lmargin ,&x STR2
,&y LDR2 INC2 ,&y STR2 ,&y LDR2 INC2 ,&y STR2
INC2 INC2r INC2 INC2r
,&loop JMP ,&loop JMP
@ -1011,7 +1044,7 @@
;emit-reset JSR2 ;emit-reset JSR2
&return &return
JMP2r JMP2r
[ &x $2 &y $2 ] [ &x $2 &y $2 ]
@emit-tab ( -> ) @emit-tab ( -> )
#0000 .config/tab-width LDZ2 SUB2 #0000 .config/tab-width LDZ2 SUB2
@ -1041,7 +1074,7 @@
.buffer/offset LDZ2 .buffer/offset LDZ2
&bol &bol
ADD2kr STH2r ;draw-linenum JSR2 ADD2kr STH2r ;draw-linenum JSR2
( .term/lmargin LDZ2 ) lmargin INC2 ,&x STR2 lmargin INC2 ,&x STR2
&loop ( offset [k line-offset] ) &loop ( offset [k line-offset] )
LDAk #00 EQU ,&eof JCN LDAk #00 EQU ,&eof JCN
LDAk #0a EQU ,&eol JCN LDAk #0a EQU ,&eol JCN
@ -1067,7 +1100,7 @@
&eof-loop &eof-loop
STH2kr .term/rows LDZ2 GTH2 ,&done JCN STH2kr .term/rows LDZ2 GTH2 ,&done JCN
cr nl cr nl
( .term/lmargin LDZ2 ) lmargin ;term-move-right JSR2 lmargin ;term-move-right JSR2
emit-~ INC2r emit-~ INC2r
,&eof-loop JMP ,&eof-loop JMP
&done POP2 POP2r POP2r &done POP2 POP2r POP2r
@ -1263,7 +1296,7 @@
&regex-search-prompt "Regex 20 "to 20 "Search 20 "for: 20 00 &regex-search-prompt "Regex 20 "to 20 "Search 20 "for: 20 00
&quit-prompt "Save 20 "modified 20 "file 20 "(y/n)? 20 00 &quit-prompt "Save 20 "modified 20 "file 20 "(y/n)? 20 00
&unknown-input "Unknown 20 "input: 20 00 &unknown-input "Unknown 20 "input: 20 00
&no-matches-found "No 20 "matches 20 "found 00 &no-matches-found "No 20 "matches 20 "found: 20 00
&saved "-- 20 00 &saved "-- 20 00
&unsaved "** 20 00 &unsaved "** 20 00
&term-size-parse-error "error 20 "parsing 20 "term 20 "size 00 &term-size-parse-error "error 20 "parsing 20 "term 20 "size 00

37
regex.tal
View File

@ -73,10 +73,9 @@
( 5. when backtracking we must rewind to "last started" subgroup ) ( 5. when backtracking we must rewind to "last started" subgroup )
%debug { #ff #0e DEO } %debug { #ff #0e DEO }
( %emit { #18 DEO } ) %emit! { #18 DEO }
%space { #20 emit } %space { #20 emit! }
%newline { #0a emit } %newline { #0a emit! }
( %quit! { #01 #0f DEO BRK } )
( now that uxnasm throws errors about writing into the zero page ) ( now that uxnasm throws errors about writing into the zero page )
( we have to do something like this to be able to compile library ) ( we have to do something like this to be able to compile library )
@ -84,17 +83,17 @@
( avoid conficting with the program we're included in. ) ( avoid conficting with the program we're included in. )
( ) ( )
( remove this if needed when including it in other projects. ) ( remove this if needed when including it in other projects. )
( |2000 ) |2000
( ERROR HANDLING ) ( ERROR HANDLING )
( using error! will print the given message before causing ) ( using error! will print the given message before causing )
( the interpreter to halt. ) ( the interpreter to halt. )
( @error! ( msg* -> ) @error!! ( msg* -> )
LIT '! emit space LIT '! emit! space
&loop LDAk ,&continue JCN ,&done JMP &loop LDAk ,&continue JCN ,&done JMP
&continue LDAk emit INC2 ,&loop JMP &continue LDAk emit! INC2 ,&loop JMP
&done POP2 newline quit! ) &done POP2 newline #010f DEO BRK
( error messages ) ( error messages )
@unknown-node-type "unknown 20 "node 20 "type 00 @unknown-node-type "unknown 20 "node 20 "type 00
@ -163,7 +162,7 @@
LDAk #07 EQU ;do-dollar JCN2 LDAk #07 EQU ;do-dollar JCN2
LDAk #08 EQU ;do-lpar JCN2 LDAk #08 EQU ;do-lpar JCN2
LDAk #09 EQU ;do-rpar JCN2 LDAk #09 EQU ;do-rpar JCN2
;unknown-node-type ;error! JSR2 LDAk ;unknown-node-type ;error!! JSR2
( used when we hit a dead-end during matching. ) ( used when we hit a dead-end during matching. )
( ) ( )
@ -378,7 +377,7 @@
POP POP
;parens LDA2 #0000 GTH2 ,&mismatched-parens JCN ;parens LDA2 #0000 GTH2 ,&mismatched-parens JCN
;unroll-stack JSR2 POP2 JMP2r ;unroll-stack JSR2 POP2 JMP2r
&mismatched-parens ;mismatched-parens ;error! JSR2 &mismatched-parens ;mismatched-parens ;error!! JSR2
( called when we read "|" ) ( called when we read "|" )
( ) ( )
@ -416,7 +415,7 @@
;parens LDA2 #0001 SUB2 ;parens STA2 ( parens-- ) ;parens LDA2 #0001 SUB2 ;parens STA2 ( parens-- )
;unroll-stack JSR2 ;unroll-stack JSR2
;c-peek-and-finalize JMP2 ;c-peek-and-finalize JMP2
&mismatched-parens ;mismatched-parens ;error! JSR2 &mismatched-parens ;mismatched-parens ;error!! JSR2
( called when we read "." ) ( called when we read "." )
( ) ( )
@ -477,21 +476,21 @@
( actually calling this means the code broke an invariant somewhere. ) ( actually calling this means the code broke an invariant somewhere. )
@c-star ( c^ -> regex* ) @c-star ( c^ -> regex* )
POP POP
;star-invariant ;error! JSR2 ;star-invariant ;error!! JSR2
( called if we parse a "+" ) ( called if we parse a "+" )
( ) ( )
( actually calling this means the code broke an invariant somewhere. ) ( actually calling this means the code broke an invariant somewhere. )
@c-plus ( c^ -> regex* ) @c-plus ( c^ -> regex* )
POP POP
;plus-invariant ;error! JSR2 ;plus-invariant ;error!! JSR2
( called if we parse a "?" ) ( called if we parse a "?" )
( ) ( )
( actually calling this means the code broke an invariant somewhere. ) ( actually calling this means the code broke an invariant somewhere. )
@c-qmark ( c^ -> regex* ) @c-qmark ( c^ -> regex* )
POP POP
;qmark-invariant ;error! JSR2 ;qmark-invariant ;error!! JSR2
( ALLOCATING REGEX NDOES ) ( ALLOCATING REGEX NDOES )
@ -617,7 +616,7 @@
&!5 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 ,&continue JMP &!5 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 ,&continue JMP
&!3 INC2 &!3 INC2
&continue ;set-next-addr JSR2 JMP2r &continue ;set-next-addr JSR2 JMP2r
&unknown ;unknown-node-type ;error! JSR2 &unknown LDAk ;unknown-node-type ;error!! JSR2
@set-next-or-addr ( target* addr* -> ) @set-next-or-addr ( target* addr* -> )
LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN
@ -688,11 +687,11 @@
( error if stack is full ) ( error if stack is full )
@assert-stack-avail ( -> ) @assert-stack-avail ( -> )
;stack-avail JSR2 ,&ok JCN ;stack-is-full ;error! JSR2 &ok JMP2r ;stack-avail JSR2 ,&ok JCN ;stack-is-full ;error!! JSR2 &ok JMP2r
( error is stack is empty ) ( error is stack is empty )
@assert-stack-exist ( -> ) @assert-stack-exist ( -> )
;stack-exist JSR2 ,&ok JCN ;stack-is-empty ;error! JSR2 &ok JMP2r ;stack-exist JSR2 ,&ok JCN ;stack-is-empty ;error!! JSR2 &ok JMP2r
( stack-pos points to the next free stack position (or the top if full). ) ( stack-pos points to the next free stack position (or the top if full). )
@stack-pos :stack-bot ( the next position to insert at ) @stack-pos :stack-bot ( the next position to insert at )
@ -730,7 +729,7 @@
,&error JCN ( pos+size [pos] ) ,&error JCN ( pos+size [pos] )
;arena-pos STA2 ( pos += size [pos] ) ;arena-pos STA2 ( pos += size [pos] )
STH2r JMP2r ( pos ) STH2r JMP2r ( pos )
&error POP2 POP2r ;arena-is-full ;error! JSR2 &error POP2 POP2r ;arena-is-full ;error!! JSR2
@arena-pos :arena-bot ( the next position to allocate ) @arena-pos :arena-bot ( the next position to allocate )
@arena-bot $400 @arena-top ( holds up to 1024 bytes ) @arena-bot $400 @arena-top ( holds up to 1024 bytes )

8
repl-regex.tal
View File

@ -69,12 +69,12 @@
@emit-byte ( byte^ -- ) @emit-byte ( byte^ -- )
DUP #04 SFT ,&hex JSR #0f AND ,&hex JMP DUP #04 SFT ,&hex JSR #0f AND ,&hex JMP
&hex #30 ADD DUP #39 GTH #27 MUL ADD emit &hex #30 ADD DUP #39 GTH #27 MUL ADD emit!
JMP2r JMP2r
( print stack size, followed by contents ) ( print stack size, followed by contents )
@emit-stack ( -> ) @emit-stack ( -> )
space LIT 'n emit LIT '= emit ;stack-pos LDA2 ;stack-bot SUB2 #0004 DIV2 ;emit-short JSR2 LIT ': emit space LIT 'n emit! LIT '= emit! ;stack-pos LDA2 ;stack-bot SUB2 #0004 DIV2 ;emit-short JSR2 LIT ': emit!
;stack-bot ;stack-bot
&loop &loop
DUP2 ;stack-pos LDA2 LTH2 ,&ok JCN DUP2 ;stack-pos LDA2 LTH2 ,&ok JCN
@ -99,10 +99,10 @@
DUP2 ;arena-pos LDA2 LTH2 ,&ok JCN POP2 JMP2r DUP2 ;arena-pos LDA2 LTH2 ,&ok JCN POP2 JMP2r
&ok &ok
DUP2 ;emit-short JSR2 DUP2 ;emit-short JSR2
LIT ': emit space LIT ': emit! space
LDAk #01 NEQ ,&!1 JCN #03 ;emit-n JSR2 ,&loop JMP LDAk #01 NEQ ,&!1 JCN #03 ;emit-n JSR2 ,&loop JMP
&!1 LDAk #02 NEQ ,&!2 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 &!2 LDAk #03 NEQ ,&!3 JCN #04 ;emit-n JSR2 ,&loop JMP
&!3 LDAk #04 NEQ ,&!4 JCN #05 ;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 &!4 LDAk #05 NEQ ,&!5 JCN #05 ;emit-n JSR2 ,&loop JMP
&!5 ;unknown-node-type ;error! JSR2 &!5 ;unknown-node-type ;error!! JSR2