Commit 6892f7cb authored by bp's avatar bp

Real fix for greedy loop

git-svn-id: https://forth-ev.de/repos/bigforth@1825 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent 62ba0a72
......@@ -158,13 +158,13 @@ s" (bla) 12:34:56 (fasel) 00:01:57 (blubber)" 2dup type hms>s,del() ." -> " typ
{{ ` - || }} \d
|| \d
}} )) ;
s" -1dummy" underflow1 0= [IF] ." failed" cr [THEN]
s" -1dummy" underflow1 0= [IF] ." failed" cr [ELSE] ." underflow1 passed" cr [THEN]
: underflow2 ( -- )
(( \( {{ \s {** \s **}
|| =" /*" // =" */"
|| =" //" {** \d **} }} \) )) ;
s" /*10203030203030404*/ " underflow2 0= [IF] ." failed" cr [THEN]
s" /*10203030203030404*/ " underflow2 0= [IF] ." failed" cr [ELSE] ." underflow2 passed: " \1 type cr [THEN]
pad 0 underflow2 [IF] ." failed" cr [THEN]
charclass [*] '* +char
......@@ -173,15 +173,15 @@ charclass [*/] '* +char '/ +char
: underflow3 ( -- )
((
=" /*"
\( {** {{ [*] -c? || ` * [*/] -c? }} **} \)
\( {** {{ [*] -c? || ` * [*/] -c? }} **} \)
{++ ` * ++} ` /
)) ;
s" /*10203030203030404*/ " underflow3 0= [IF] ." failed" cr [THEN] \1 type cr
s" /*10203030203030404*/ " underflow3 0= [IF] ." failed" cr [ELSE] ." underflow3 passed: " \1 type cr [THEN]
: underflow4 ( -- )
(( \( {{ {** \d **} || {** \d **} }} \d \) )) ;
s" 0 " underflow4 0= [IF] ." failed" cr [THEN]
s" 0 " underflow4 0= [IF] ." failed" cr [ELSE] ." underflow4 passed: " \1 type cr [THEN]
script? [IF] bye [THEN]
......@@ -82,8 +82,6 @@ Variable varsmax
: var> ( -- addr ) -1 varstack +!
varstack @+ swap cells + @
1+ 2* cells vars + ;
Variable greed-counts 9 cells allot \ no more than 9 nested greedy loops
: greed' ( -- addr ) greed-counts dup @ + ;
\ start end
......@@ -107,7 +105,7 @@ Variable greed-counts 9 cells allot \ no more than 9 nested greedy loops
\ instead of a jump.
: (( ( addr u -- )
vars off varsmax off loops off greed-counts off
vars off varsmax off loops off
]] FORK AHEAD BUT JOIN !end [[ BEGIN, ; immediate
: )) ( -- addr f )
]] ?end drop true UNNEST [[
......@@ -121,18 +119,20 @@ Variable greed-counts 9 cells allot \ no more than 9 nested greedy loops
: drops ( n -- ) 1+ cells sp@ + sp! ;
: {** ( addr -- addr addr )
cell greed-counts +!
greed' ]] Literal off BEGIN dup [[ BEGIN, ; immediate
' {** Alias {++ ( addr -- addr addr ) immediate
: n*} ( sys n -- )
>r greed' ]] 1 Literal +! $? 0= UNTIL dup [[ DONE, ]] drop [[
r@ greed' ]] Literal @ 1+ Literal U+DO FORK BUT [[
]] IF I' I - [[ r@ 1- ]] Literal + drops true UNLOOP UNNEST THEN LOOP [[
r@ IF r@ ]] Literal drops [[ THEN
rdrop ]] dup LEAVE JOIN [[
-cell greed-counts +! ; immediate
: **} 0 postpone n*} ; immediate
: ++} 1 postpone n*} ; immediate
]] false >r BEGIN dup FORK BUT WHILE r> 1+ >r REPEAT [[
]] r> AHEAD BUT JOIN [[
BEGIN, ; immediate
: **} ( sys -- )
]] dup end$ u<= UNNEST [[ DONE, ]] false UNNEST THEN [[
]] nip 1+ false U+DO FORK BUT [[
]] IF I' I - 1- drops true UNLOOP UNNEST THEN LOOP [[
]] dup LEAVE JOIN [[ ; immediate
' {** Alias {++ immediate
: ++} ( sys -- )
]] dup end$ u<= UNNEST [[ DONE, ]] false UNNEST THEN [[
]] nip false U+DO FORK BUT [[
]] IF I' I - drops true UNLOOP UNNEST THEN LOOP [[
]] drop dup LEAVE JOIN [[ ; immediate
\ non-greedy loops
......@@ -160,11 +160,11 @@ Variable greed-counts 9 cells allot \ no more than 9 nested greedy loops
: THENs ( sys -- ) BEGIN dup WHILE ]] THEN [[ REPEAT drop ;
: {{ ( addr -- addr addr ) \ regexp-pattern
0 ]] dup dup FORK IF 2drop true UNNEST BUT JOIN [[ vars @ ; immediate
0 ]] dup dup FORK IF nip nip true UNNEST BUT JOIN [[ vars @ ; immediate
: || ( addr addr -- addr addr ) \ regexp-pattern
vars @ varsmax @ max varsmax ! vars !
]] AHEAD BUT THEN drop [[
]] dup dup FORK IF 2drop true UNNEST BUT JOIN [[ vars @ ; immediate
]] dup dup FORK IF nip nip true UNNEST BUT JOIN [[ vars @ ; immediate
: }} ( addr addr -- addr ) \ regexp-pattern
vars @ varsmax @ max vars ! drop
]] AHEAD BUT THEN drop LEAVE [[ THENs ; immediate
......
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