version 1.21, 2010/09/12 17:10:04
|
version 1.22, 2010/09/12 21:46:30
|
Line 113 Variable loops $40 3 * cells allot
|
Line 113 Variable loops $40 3 * cells allot
|
: loops> ( -- addr ) -3 loops +! loops @+ swap cells + 3@ ; |
: loops> ( -- addr ) -3 loops +! loops @+ swap cells + 3@ ; |
: >loops ( addr -- ) loops @+ swap cells + 3! 3 loops +! ; |
: >loops ( addr -- ) loops @+ swap cells + 3! 3 loops +! ; |
: BEGIN, ( -- ) ]] BEGIN [[ >loops ; |
: BEGIN, ( -- ) ]] BEGIN [[ >loops ; |
: DONE, ( -- ) loops @ IF loops> ]] DONE [[ THEN ]] noop [[ ; |
: DONE, ( -- ) loops @ IF loops> ]] DONE [[ THEN ; |
|
|
\ variables |
\ variables |
|
|
Line 148 Variable varsmax
|
Line 148 Variable varsmax
|
|
|
\ A word for string comparison |
\ A word for string comparison |
|
|
: =str ( addr1 addr u -- addr2 ) |
: (str=?) ( addr1 addr u -- addr2 ) |
dup >r 2>r rest$ r@ umin 2r> compare IF rdrop true ELSE r> + false THEN ; |
dup >r 2>r rest$ r@ umin 2r> compare IF rdrop true ELSE r> + false THEN ; |
: $= ( addr1 addr u -- addr2 ) ]] =str ?LEAVE [[ ; immediate |
: str=? ( addr1 addr u -- addr2 ) ]] (str=?) ?LEAVE [[ ; immediate |
: ,=" ( addr u -- ) tuck dup ]] rest$ Literal umin SLiteral compare ?LEAVE Literal + noop [[ ; |
: ,=" ( addr u -- ) tuck dup ]] rest$ Literal umin SLiteral compare ?LEAVE Literal + [[ ; |
: =" ( <string>" -- ) \ regexp-pattern |
: =" ( <string>" -- ) \ regexp-pattern |
\G check for string |
\G check for string |
'" parse ,=" ; immediate |
'" parse ,=" ; immediate |
Line 186 Variable varsmax
|
Line 186 Variable varsmax
|
: n*} ( sys n -- ) \ regexp-pattern |
: n*} ( sys n -- ) \ regexp-pattern |
\G At least @var{n} pattern |
\G At least @var{n} pattern |
>r ]] r> 1+ >r end-rex? 0= UNTIL dup [[ DONE, ]] drop [[ |
>r ]] r> 1+ >r end-rex? 0= UNTIL dup [[ DONE, ]] drop [[ |
r@ IF r@ ]] r@ Literal u< IF r> 1+ drops false ;S THEN [[ THEN |
r@ IF r@ ]] r@ Literal u< IF r> 1+ drops dup LEAVE THEN [[ THEN |
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 ;S THEN LOOP [[ |
]] IF I' I - [[ r@ 1- ]] Literal + drops true UNLOOP ;S THEN LOOP [[ |
r@ IF r@ ]] Literal drops [[ THEN |
r@ IF r@ ]] Literal drops [[ THEN |
rdrop ]] false ;S JOIN [[ ; immediate |
rdrop ]] dup LEAVE JOIN [[ ; immediate |
: **} ( sys -- ) \ regexp-pattern |
: **} ( sys -- ) \ regexp-pattern |
\G end of greedy zero-or-more pattern |
\G end of greedy zero-or-more pattern |
0 postpone n*} ; immediate |
0 postpone n*} ; immediate |
Line 216 Variable varsmax
|
Line 216 Variable varsmax
|
: +} ( addr addr' -- addr' ) \ regexp-pattern |
: +} ( addr addr' -- addr' ) \ regexp-pattern |
\G end of non-greedy one-or-more pattern |
\G end of non-greedy one-or-more pattern |
]] dup FORK BUT IF drop true ;S [[ |
]] dup FORK BUT IF drop true ;S [[ |
DONE, ]] drop false ;S THEN *} [[ ; immediate |
DONE, ]] drop dup LEAVE THEN *} [[ ; immediate |
|
|
: // ( -- ) \ regexp-pattern |
: // ( -- ) \ regexp-pattern |
\G search for string |
\G search for string |
Line 240 Variable varsmax
|
Line 240 Variable varsmax
|
: }} ( addr addr -- addr ) \ regexp-pattern |
: }} ( addr addr -- addr ) \ regexp-pattern |
\G end of alternatives |
\G end of alternatives |
vars @ varsmax @ max vars ! |
vars @ varsmax @ max vars ! |
]] dup FORK IF 2drop true ;S THEN dup [[ >r >r >r drop |
]] dup FORK IF 2drop true ;S THEN drop dup [[ >r >r >r drop |
]] DONE drop LEAVE [[ r> r> r> JOINs ; immediate |
]] DONE drop LEAVE ;S [[ r> r> r> JOINs ; immediate |
|
|
\ match variables |
\ match variables |
|
|