From 4ffd80526b0826bedecde7137fa8e1905b566191 Mon Sep 17 00:00:00 2001 From: d6 Date: Sat, 2 Apr 2022 22:29:06 -0400 Subject: [PATCH] searching forward and back by regex works --- femto.tal | 121 +++++++++++++++++++++++++++++++------------------ regex.tal | 37 ++++++++------- repl-regex.tal | 8 ++-- 3 files changed, 99 insertions(+), 67 deletions(-) diff --git a/femto.tal b/femto.tal index c190e7d..b98ea10 100644 --- a/femto.tal +++ b/femto.tal @@ -94,8 +94,7 @@ @term [ &cols $2 ( relative x coordinate of cursor, from 0 ) - &rows $2 ( relative y coordinaet of cursor, from 1 ) -( &lmargin $2 ( left padding needed for line numbers ) ) + &rows $2 ( relative y coordinate of cursor, from 1 ) ] @config [ @@ -151,6 +150,8 @@ &orig-row $2 ( row we began the search at ) &orig-col $2 ( col we began the search at ) ®ex $2 ( regex to be stored if any ) + &start $2 ( absolute start pos of match ) + &end $2 ( absolute limit pos of match ) ] ( startup ) @@ -166,7 +167,6 @@ @init-zero-page ( -> ) #0050 .term/cols STZ2 #0018 .term/rows STZ2 -( #0006 .term/lmargin STZ2 ) #0004 .config/tab-width STZ2 #00 .config/insert-tabs STZ @@ -605,6 +605,8 @@ ;return JMP2 @do-search ( -> ) + .cursor/row LDZ2 .searching/orig-row STZ2 + .cursor/col LDZ2 .searching/orig-col STZ2 #0000 .searching/regex STZ2 ;move-to-next-match JSR2 ,&found JCN ;move-to-prev-match JSR2 ,&found JCN @@ -619,7 +621,10 @@ ;redraw-prompt-and-cursor JSR2 ;return JMP2 @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-prev-regex-match JSR2 ,&found JCN ;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK @@ -720,10 +725,16 @@ ( matches overlap. ) @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 ( -> ) - ;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^ ) .buffer/limit LDZ2 @@ -752,38 +763,42 @@ POP2 POP2 #00 JMP2r @move-to-next-regex-match ( -> ok^ ) - .buffer/limit LDZ2 - ;cur-pos JSR2 INC2 - &loop - GTH2k #00 EQU ,&fail JCN - ( ;search-start ;search-end ) - ( DUP2 ;matches-at JSR2 ) - DUP2 .searching/regex LDR2 ;rx-search - ,&found JCN - INC2 ( TODO move to next line ) - ,&loop JMP + .searching/end LDZ2 .buffer/limit LDZ2 OVR2 + GTH2 ,&ok JCN + POP2 #00 JMP2r + &ok + .searching/regex LDZ2 ;rx-search JSR2 ,&found JCN + #00 JMP2r &found - POP2 POP2 - ;search-start LDA2 + ;search-end LDA2 .searching/end STZ2 + ;search-start LDA2 DUP2 .searching/start STZ2 ;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^ ) - #00 JMP2r -( ;data - ;cur-pos JSR2 #0001 SUB2 - &loop - GTH2k ,&fail JCN - DUP2 ;matches-at JSR2 - ORA ,&found JCN - #0001 SUB2 ,&loop JMP - &found - NIP2 ;jump-to-pos JSR2 #01 ,&done JMP - &fail - POP2 POP2 #00 + LITr 00 + ;cur-pos JSR2 ;data ( limit pos [res] ) + &loop ( limit pos [res] ) + GTH2k #00 EQU ,&done JCN ( limit pos ) + DUP2 .searching/regex LDZ2 ;rx-search JSR2 ( limit pos match? ) + #00 EQU ,&done JCN ( limit pos ) + OVR2 ;search-end LDA2 LTH2 ,&done JCN + POP2 POPr LITr 01 + ;search-start LDA2 .searching/start STZ2 + ;search-end LDA2 DUP2 .searching/end STZ2 + ,&loop JMP &done - JMP2r ) + POP2 POP2 STHr DUP #00 EQU ,&fail JCN + .searching/start LDZ2 ;jump-to-pos JSR2 + &fail + JMP2r @on-key-searching .state/key LDZ #07 EQU ( C-g ) ;cancel-search JCN2 @@ -863,7 +878,7 @@ @draw-cursor ( -> ) .prompt/active LDZ ,&on-prompt JCN ( 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 ;term-move-cursor JMP2 &on-prompt @@ -971,15 +986,33 @@ ¬-end ;abs-line JMP2 -( TODO: enable drawing of regex matches ) -( requires a way to anchor our regex on the LHS (e.g. ^) ) +@draw-regex-matches ( -> ) + ;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 ( -> ) ( return if not searching ) .searching/active LDZ #00 EQU ,&return JCN ( ) + .searching/regex LDZ2 ORA ;draw-regex-matches JCN2 ;emit-color-reverse JSR2 - - ( .term/lmargin LDZ2 ) lmargin ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 ) - + lmargin ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 ) .buffer/offset LDZ2 DUP2 ;screen-limit JSR2 SUB2 STH2 ( offset [-count] ) @@ -1002,7 +1035,7 @@ ADD2 ADD2r ( offset+n [n-count] ) ,&loop JMP &newline ( offset [-count] ) - ( .term/lmargin LDZ2 ) lmargin ,&x STR2 + lmargin ,&x STR2 ,&y LDR2 INC2 ,&y STR2 INC2 INC2r ,&loop JMP @@ -1011,7 +1044,7 @@ ;emit-reset JSR2 &return JMP2r - [ &x $2 &y $2 ] + [ &x $2 &y $2 ] @emit-tab ( -> ) #0000 .config/tab-width LDZ2 SUB2 @@ -1041,7 +1074,7 @@ .buffer/offset LDZ2 &bol ADD2kr STH2r ;draw-linenum JSR2 - ( .term/lmargin LDZ2 ) lmargin INC2 ,&x STR2 + lmargin INC2 ,&x STR2 &loop ( offset [k line-offset] ) LDAk #00 EQU ,&eof JCN LDAk #0a EQU ,&eol JCN @@ -1067,7 +1100,7 @@ &eof-loop STH2kr .term/rows LDZ2 GTH2 ,&done JCN cr nl - ( .term/lmargin LDZ2 ) lmargin ;term-move-right JSR2 + lmargin ;term-move-right JSR2 emit-~ INC2r ,&eof-loop JMP &done POP2 POP2r POP2r @@ -1263,7 +1296,7 @@ ®ex-search-prompt "Regex 20 "to 20 "Search 20 "for: 20 00 &quit-prompt "Save 20 "modified 20 "file 20 "(y/n)? 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 &unsaved "** 20 00 &term-size-parse-error "error 20 "parsing 20 "term 20 "size 00 diff --git a/regex.tal b/regex.tal index d63742f..83f0081 100644 --- a/regex.tal +++ b/regex.tal @@ -73,10 +73,9 @@ ( 5. when backtracking we must rewind to "last started" subgroup ) %debug { #ff #0e DEO } -( %emit { #18 DEO } ) -%space { #20 emit } -%newline { #0a emit } -( %quit! { #01 #0f DEO BRK } ) +%emit! { #18 DEO } +%space { #20 emit! } +%newline { #0a emit! } ( now that uxnasm throws errors about writing into the zero page ) ( 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. ) ( ) ( remove this if needed when including it in other projects. ) -( |2000 ) +|2000 ( ERROR HANDLING ) ( using error! will print the given message before causing ) ( the interpreter to halt. ) -( @error! ( msg* -> ) - LIT '! emit space +@error!! ( msg* -> ) + LIT '! emit! space &loop LDAk ,&continue JCN ,&done JMP - &continue LDAk emit INC2 ,&loop JMP - &done POP2 newline quit! ) + &continue LDAk emit! INC2 ,&loop JMP + &done POP2 newline #010f DEO BRK ( error messages ) @unknown-node-type "unknown 20 "node 20 "type 00 @@ -163,7 +162,7 @@ LDAk #07 EQU ;do-dollar JCN2 LDAk #08 EQU ;do-lpar 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. ) ( ) @@ -378,7 +377,7 @@ POP ;parens LDA2 #0000 GTH2 ,&mismatched-parens JCN ;unroll-stack JSR2 POP2 JMP2r - &mismatched-parens ;mismatched-parens ;error! JSR2 + &mismatched-parens ;mismatched-parens ;error!! JSR2 ( called when we read "|" ) ( ) @@ -416,7 +415,7 @@ ;parens LDA2 #0001 SUB2 ;parens STA2 ( parens-- ) ;unroll-stack JSR2 ;c-peek-and-finalize JMP2 - &mismatched-parens ;mismatched-parens ;error! JSR2 + &mismatched-parens ;mismatched-parens ;error!! JSR2 ( called when we read "." ) ( ) @@ -477,21 +476,21 @@ ( actually calling this means the code broke an invariant somewhere. ) @c-star ( c^ -> regex* ) POP - ;star-invariant ;error! JSR2 + ;star-invariant ;error!! JSR2 ( called if we parse a "+" ) ( ) ( actually calling this means the code broke an invariant somewhere. ) @c-plus ( c^ -> regex* ) POP - ;plus-invariant ;error! JSR2 + ;plus-invariant ;error!! JSR2 ( called if we parse a "?" ) ( ) ( actually calling this means the code broke an invariant somewhere. ) @c-qmark ( c^ -> regex* ) POP - ;qmark-invariant ;error! JSR2 + ;qmark-invariant ;error!! JSR2 ( ALLOCATING REGEX NDOES ) @@ -617,7 +616,7 @@ &!5 LDAk #03 NEQ ,&!3 JCN #0002 ADD2 ,&continue JMP &!3 INC2 &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* -> ) LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN @@ -688,11 +687,11 @@ ( error if stack is full ) @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 ) @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 :stack-bot ( the next position to insert at ) @@ -730,7 +729,7 @@ ,&error JCN ( pos+size [pos] ) ;arena-pos STA2 ( pos += size [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-bot $400 @arena-top ( holds up to 1024 bytes ) diff --git a/repl-regex.tal b/repl-regex.tal index 7a7434d..6e18980 100644 --- a/repl-regex.tal +++ b/repl-regex.tal @@ -69,12 +69,12 @@ @emit-byte ( byte^ -- ) 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 ( 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 + 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 @@ -99,10 +99,10 @@ DUP2 ;arena-pos LDA2 LTH2 ,&ok JCN POP2 JMP2r &ok DUP2 ;emit-short JSR2 - LIT ': emit space + 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 + &!5 ;unknown-node-type ;error!! JSR2