Commit b804fc83 authored by bp's avatar bp
Browse files

Fixes for regexp

git-svn-id: https://forth-ev.de/repos/bigforth@1822 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent bfbf2f1c
This source diff could not be displayed because it is too large. You can view the blob instead.
No preview for this file type
...@@ -138,7 +138,7 @@ s" delete (test) and (another test) " delparents type cr ...@@ -138,7 +138,7 @@ s" delete (test) and (another test) " delparents type cr
\3 s>number drop + 0 <<# 's' hold #s #> #>> //g ; \3 s>number drop + 0 <<# 's' hold #s #> #>> //g ;
s" bla 12:34:56 fasel 00:01:57 blubber" 2dup type hms>s s" bla 12:34:56 fasel 00:01:57 blubber" 2dup type hms>s
.( ->) 2dup type ." -> " 2dup type
s" bla 45296s fasel 117s blubber" str= [IF] .( ok) [ELSE] .( failed) [THEN] cr s" bla 45296s fasel 117s blubber" str= [IF] .( ok) [ELSE] .( failed) [THEN] cr
: hms>s,del() ( addr u -- addr' u' ) : hms>s,del() ( addr u -- addr' u' )
...@@ -146,10 +146,9 @@ s" bla 45296s fasel 117s blubber" str= [IF] .( ok) [ELSE] .( failed) [THEN] cr ...@@ -146,10 +146,9 @@ s" bla 45296s fasel 117s blubber" str= [IF] .( ok) [ELSE] .( failed) [THEN] cr
>> \1 s>number drop 60 * >> \1 s>number drop 60 *
\2 s>number drop + 60 * \2 s>number drop + 60 *
\3 s>number drop + 0 <# 's' hold #s #> << \3 s>number drop + 0 <# 's' hold #s #> <<
|| ` ( // ` ) >> <<" " || ` ( // ` ) >> <<" ()"
}} LEAVE //s ; }} LEAVE //s ;
\ doesn't work yet s" (bla) 12:34:56 (fasel) 00:01:57 (blubber)" 2dup type hms>s,del() ." -> " type cr
\ s" (bla) 12:34:56 (fasel) 00:01:57 (blubber)" 2dup type hms>s,del() ." ->" type cr
script? [IF] bye [THEN] script? [IF] bye [THEN]
...@@ -104,11 +104,12 @@ Variable varsmax ...@@ -104,11 +104,12 @@ Variable varsmax
\ FORK/JOIN are like AHEAD THEN, but producing a call on AHEAD \ FORK/JOIN are like AHEAD THEN, but producing a call on AHEAD
\ instead of a jump. \ instead of a jump.
: (( ( addr u -- ) vars off varsmax off loops off : (( ( addr u -- )
vars off varsmax off loops off
]] FORK AHEAD BUT JOIN !end [[ BEGIN, ; immediate ]] FORK AHEAD BUT JOIN !end [[ BEGIN, ; immediate
: )) ( -- addr f ) : )) ( -- addr f )
]] ?end drop true EXIT [[ ]] ?end drop true UNNEST [[
DONE, ]] drop false EXIT THEN [[ ; immediate DONE, ]] drop false UNNEST THEN [[ ; immediate
\ greedy loops \ greedy loops
...@@ -120,12 +121,12 @@ Variable varsmax ...@@ -120,12 +121,12 @@ Variable varsmax
: {** ( addr -- addr addr ) : {** ( addr -- addr addr )
0 ]] Literal >r BEGIN dup [[ BEGIN, ; immediate 0 ]] Literal >r BEGIN dup [[ BEGIN, ; immediate
' {** Alias {++ ( addr -- addr addr ) immediate ' {** Alias {++ ( addr -- addr addr ) immediate
: n*} ( sys n -- ) >r ]] r> 1+ >r $? 0= UNTIL dup [[ DONE, ]] drop [[ : n*} ( sys n -- )
r@ IF r@ ]] r@ Literal u< IF r> 1+ drops false EXIT THEN [[ THEN >r ]] r> 1+ >r $? 0= UNTIL dup [[ DONE, ]] drop [[
r@ ]] r> 1+ Literal U+DO FORK BUT [[ r@ ]] r> 1+ Literal U+DO FORK BUT [[
]] IF I' I - [[ r@ 1- ]] Literal + drops true UNLOOP EXIT THEN LOOP [[ ]] IF I' I - [[ r@ 1- ]] Literal + drops true UNLOOP UNNEST THEN LOOP [[
r@ IF r@ ]] Literal drops [[ THEN r@ IF r@ ]] Literal drops [[ THEN
rdrop ]] false EXIT JOIN [[ ; immediate rdrop ]] dup LEAVE JOIN [[ ; immediate
: **} 0 postpone n*} ; immediate : **} 0 postpone n*} ; immediate
: ++} 1 postpone n*} ; immediate : ++} 1 postpone n*} ; immediate
...@@ -137,13 +138,13 @@ Variable varsmax ...@@ -137,13 +138,13 @@ Variable varsmax
: {+ ( addr -- addr addr ) : {+ ( addr -- addr addr )
]] BEGIN [[ BEGIN, ; immediate ]] BEGIN [[ BEGIN, ; immediate
: {* ( addr -- addr addr ) : {* ( addr -- addr addr )
]] {+ dup FORK BUT IF drop true EXIT THEN [[ ; immediate ]] {+ dup FORK BUT IF drop true UNNEST THEN [[ ; immediate
: *} ( addr addr' -- addr' ) : *} ( addr addr' -- addr' )
]] dup end$ u> UNTIL [[ ]] dup end$ u> UNTIL [[
DONE, ]] drop false EXIT JOIN [[ ; immediate DONE, ]] drop false UNNEST JOIN [[ ; immediate
: +} ( addr addr' -- addr' ) : +} ( addr addr' -- addr' )
]] dup FORK BUT IF drop true EXIT [[ ]] dup FORK BUT IF drop true UNNEST [[
DONE, ]] drop false EXIT THEN *} [[ ; immediate DONE, ]] drop dup LEAVE [[ BEGIN, ]] THEN *} [[ ; immediate
: // ( -- ) ]] {* 1+ *} [[ ; immediate : // ( -- ) ]] {* 1+ *} [[ ; immediate
...@@ -152,15 +153,17 @@ Variable varsmax ...@@ -152,15 +153,17 @@ Variable varsmax
\ idea: try to match one alternative and then the rest of regexp. \ idea: try to match one alternative and then the rest of regexp.
\ if that fails, jump back to second alternative \ if that fails, jump back to second alternative
: JOINs ( sys -- ) BEGIN dup WHILE ]] JOIN [[ REPEAT drop ; : THENs ( sys -- ) BEGIN dup WHILE ]] THEN [[ REPEAT drop ;
: {{ ( addr -- addr addr ) 0 ]] dup BEGIN [[ vars @ ; immediate : {{ ( addr -- addr addr ) \ regexp-pattern
: || ( addr addr -- addr addr ) vars @ varsmax @ max varsmax ! 0 ]] dup dup FORK IF 2drop true UNNEST BUT JOIN [[ vars @ ; immediate
]] dup FORK IF 2drop true EXIT THEN drop dup [[ >r vars ! : || ( addr addr -- addr addr ) \ regexp-pattern
]] DONE drop dup [[ r> ]] BEGIN [[ vars @ ; immediate vars @ varsmax @ max varsmax ! vars !
: }} ( addr addr -- addr addr ) vars @ varsmax @ max vars ! ]] AHEAD BUT THEN drop [[
]] dup FORK IF 2drop true EXIT THEN drop dup [[ >r drop ]] dup dup FORK IF 2drop true UNNEST BUT JOIN [[ vars @ ; immediate
]] DONE drop LEAVE noop [[ r> JOINs ; immediate : }} ( addr addr -- addr ) \ regexp-pattern
vars @ varsmax @ max vars ! drop
]] AHEAD BUT THEN drop LEAVE [[ THENs ; immediate
\ match variables \ 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