Commit 712f733f authored by bp's avatar bp

alternatives with backtracking

git-svn-id: https://forth-ev.de/repos/bigforth@1742 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent 1b122b65
......@@ -101,6 +101,12 @@ s" fofoofoofofooofoobarbar" ?foos1
s" bla baz bar" ?foos1
s" foofoofoo" ?foos1
\ backtracking on decissions
: ?aab ( addr u -- flag )
(( {{ =" aa" || =" a" }} {{ =" ab" || =" a" }} )) ;
s" aab" ?aab 0= [IF] .( aab failed!) cr [THEN]
\ simple replacement test
." --- simple replacement test ---" cr
......@@ -132,23 +138,18 @@ s" delete (test) and (another test) " delparents type cr
\3 s>number drop + 0 <<# 's' hold #s #> #>> //g ;
s" bla 12:34:56 fasel 00:01:57 blubber" 2dup type hms>s
." replaced by " 2dup type
.( ->) 2dup type
s" bla 45296s fasel 117s blubber" str= [IF] .( ok) [ELSE] .( failed) [THEN] cr
: delnum ( addr u -- addr' u' ) s// \d >> s" " //g ;
s" 0a" delnum type cr
s" a" delnum type cr
: hms>s,del() ( addr u -- addr' u' )
s// {{ \( \d \d \) ` : \( \d \d \) ` : \( \d \d \)
>> \1 s>number drop 60 *
\2 s>number drop + 60 *
\3 s>number drop + 0 <# 's' hold #s #> <<
|| ` ( {* .? *} ` ) >> <<" "
|| ` ( // ` ) >> <<" "
}} LEAVE //s ;
\ doesn't work yet
\ s" (bla) 12:34:56 (fasel) 00:01:57 (blubber)" 2dup type hms>s,del() space type cr
\ s" (bla) 12:34:56 (fasel) 00:01:57 (blubber)" 2dup type hms>s,del() ." ->" type cr
script? [IF] bye [THEN]
......@@ -51,6 +51,8 @@ charclass any 0 $FF ..char #lf -char
: -\s ( addr -- addr' ) ]] blanks -c? [[ ; immediate
: ` ( -- )
]] count [[ char ]] Literal <> ?LEAVE [[ ; immediate
: -` ( -- )
]] count [[ char ]] Literal = ?LEAVE [[ ; immediate
\ A word for string comparison
......@@ -150,15 +152,15 @@ Variable varsmax
\ idea: try to match one alternative and then the rest of regexp.
\ if that fails, jump back to second alternative
: THENs ( sys -- ) BEGIN dup WHILE ]] THEN [[ REPEAT drop ;
: JOINs ( sys -- ) BEGIN dup WHILE ]] JOIN [[ REPEAT drop ;
: {{ ( addr -- addr addr ) 0 ]] dup BEGIN [[ vars @ ; immediate
: || ( addr addr -- addr addr ) vars @ varsmax @ max varsmax !
]] nip AHEAD [[ >r vars !
]] dup FORK IF 2drop true EXIT THEN drop dup [[ >r vars !
]] DONE drop dup [[ r> ]] BEGIN [[ vars @ ; immediate
: }} ( addr addr -- addr addr ) vars @ varsmax @ max vars !
]] nip AHEAD [[ >r drop
]] DONE drop LEAVE [[ r> THENs ; immediate
]] dup FORK IF 2drop true EXIT THEN drop dup [[ >r drop
]] DONE drop LEAVE noop [[ r> JOINs ; immediate
\ match variables
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment