[gforth] / gforth / regexp.fs  

gforth: gforth/regexp.fs

Diff for /gforth/regexp.fs between version 1.21 and 1.22

version 1.21, Sun Sep 12 17:10:04 2010 UTC version 1.22, Sun Sep 12 21:46:30 2010 UTC
Line 113 
Line 113 
 : 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 
Line 148 
   
 \ 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 
Line 186 
 : 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 
Line 216 
 : +} ( 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 
Line 240 
 : }} ( 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
   

Generate output suitable for use with a patch program
Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help