[gforth] / gforth / regexp.fs  

gforth: gforth/regexp.fs

Diff for /gforth/regexp.fs between version 1.8 and 1.18

version 1.8, Wed Oct 3 18:41:09 2007 UTC version 1.18, Sun Sep 5 22:18:54 2010 UTC
Line 1 
Line 1 
 \ Regexp compile  \ Regexp compile
   
 \ Copyright (C) 2005,2006 Free Software Foundation, Inc.  \ Copyright (C) 2005,2006,2007,2008 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
 \ Gforth is free software; you can redistribute it and/or  \ Gforth is free software; you can redistribute it and/or
 \ modify it under the terms of the GNU General Public License  \ modify it under the terms of the GNU General Public License
 \ as published by the Free Software Foundation; either version 2  \ as published by the Free Software Foundation, either version 3
 \ of the License, or (at your option) any later version.  \ of the License, or (at your option) any later version.
   
 \ This program is distributed in the hope that it will be useful,  \ This program is distributed in the hope that it will be useful,
Line 15 
Line 15 
 \ GNU General Public License for more details.  \ GNU General Public License for more details.
   
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software  \ along with this program. If not, see http://www.gnu.org/licenses/.
 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.  
   
 \ The idea of the parser is the following:  \ The idea of the parser is the following:
 \ As long as there's a match, continue  \ As long as there's a match, continue
Line 102 
Line 101 
 : ` ( "char" -- ) \ regexp-pattern  : ` ( "char" -- ) \ regexp-pattern
     \G check for particular char      \G check for particular char
     ]] count [[  char ]] Literal <> ?LEAVE [[ ;  immediate      ]] count [[  char ]] Literal <> ?LEAVE [[ ;  immediate
   : -` ( "char" -- ) \ regexp-pattern
 \ A word for string comparison      \G check for particular char
       ]] count [[  char ]] Literal = ?LEAVE [[ ;  immediate
 : $= ( addr1 addr2 u -- f )  tuck compare ;  
 : ,=" ( addr u -- ) tuck ]] dup SLiteral $= ?LEAVE Literal + noop [[ ;  
 : =" ( <string>" -- ) \ regexp-pattern  
     \G check for string  
     '" parse ,=" ; immediate  
   
 \ loop stack  \ loop stack
   
Line 138 
Line 132 
 0 Value end$  0 Value end$
 0 Value start$  0 Value start$
 : !end ( addr u -- addr )  over + to end$ dup to start$ ;  : !end ( addr u -- addr )  over + to end$ dup to start$ ;
 : $? ( addr -- addr flag ) dup end$ u< ;  : end-rex? ( addr -- addr flag ) dup end$ u< ;
 : ^? ( addr -- addr flag ) dup start$ u> ;  : start-rex? ( addr -- addr flag ) dup start$ u> ;
 : ?end ( addr -- addr ) ]] dup end$ u> ?LEAVE [[ ; immediate  : ?end ( addr -- addr ) ]] dup end$ u> ?LEAVE [[ ; immediate
   
 \ start and end  \ start and end
   
 : \^ ( addr -- addr ) \ regexp-pattern  : \^ ( addr -- addr ) \ regexp-pattern
     \G check for string start      \G check for string start
     ]] ^? ?LEAVE [[ ; immediate      ]] start-rex? ?LEAVE [[ ; immediate
 : \$ ( addr -- addr ) \ regexp-pattern  : \$ ( addr -- addr ) \ regexp-pattern
     \G check for string end      \G check for string end
     ]] $? ?LEAVE [[ ; immediate      ]] end-rex? ?LEAVE [[ ; immediate
   
   \ A word for string comparison
   
   : ,=" ( addr u -- ) tuck ]] dup SLiteral tuck compare ?LEAVE Literal + noop [[ ;
   : =" ( <string>" -- ) \ regexp-pattern
       \G check for string
       '" parse ,=" ; immediate
   
 \ regexp block  \ regexp block
   
Line 180 
Line 181 
     immediate      immediate
 : 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 $? 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  EXIT  THEN [[ THEN      r@ IF r@ ]] r@ Literal u< IF  r> 1+ drops false  EXIT  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 EXIT  THEN  LOOP [[      ]] IF  I' I - [[ r@ 1- ]] Literal + drops true UNLOOP EXIT  THEN  LOOP [[
Line 222 
Line 223 
 \ 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
   
 : THENs ( sys -- )  BEGIN  dup  WHILE  ]] THEN [[  REPEAT  drop ;  : JOINs ( sys -- )  BEGIN  dup  WHILE  ]] JOIN [[  REPEAT  drop ;
   
 : {{ ( addr -- addr addr ) \ regexp-pattern  : {{ ( addr -- addr addr ) \ regexp-pattern
     \G Start of alternatives      \G Start of alternatives
Line 230 
Line 231 
 : || ( addr addr -- addr addr ) \ regexp-pattern  : || ( addr addr -- addr addr ) \ regexp-pattern
     \G separator between alternatives      \G separator between alternatives
     vars @ varsmax @ max varsmax !      vars @ varsmax @ max varsmax !
     ]] nip AHEAD [[ >r >r >r vars !      ]] dup FORK  IF  2drop true  EXIT THEN  drop dup [[ >r >r >r vars !
     ]] DONE drop dup [[ r> r> r> ]] BEGIN [[ vars @ ; immediate      ]] DONE drop dup [[ r> r> r> ]] BEGIN [[ vars @ ; immediate
 : }} ( addr addr -- addr addr ) \ regexp-pattern  : }} ( addr addr -- addr addr ) \ regexp-pattern
     \G end of alternatives      \G end of alternatives
     vars @ varsmax @ max vars !      vars @ varsmax @ max vars !
     ]] nip AHEAD [[ >r >r >r drop      ]] dup FORK  IF  2drop true  EXIT THEN  drop dup [[ >r >r >r drop
     ]] DONE drop LEAVE [[ r> r> r> THENs ; immediate      ]] DONE drop LEAVE [[ r> r> r> JOINs ; immediate
   
 \ match variables  \ match variables
   
Line 264 
Line 265 
 0 Value >>ptr  0 Value >>ptr
 0 Value <<ptr  0 Value <<ptr
 Variable >>string  Variable >>string
 : >>  ( addr -- addr ) \ regexp-replace  : s>>  ( addr -- addr ) \ regexp-replace
     \G Start replace pattern region      \G Start replace pattern region
     dup to >>ptr ;      dup to >>ptr ;
 : << ( run-addr addr u -- run-addr ) \ regexp-replace  : << ( run-addr addr u -- run-addr ) \ regexp-replace
     \G Replace string from start of replace pattern region with      \G Replace string from start of replace pattern region with
     \G @var{addr} @var{u}      \G @var{addr} @var{u}
     <<ptr 0= IF  start$ to <<ptr  THEN  
     >>string @ 0= IF  s" " >>string $!  THEN  
     <<ptr >>ptr over - >>string $+!      <<ptr >>ptr over - >>string $+!
     >>string $+! dup to <<ptr ;      >>string $+! dup to <<ptr ;
 : <<" ( "string<">" -- ) \ regexp-replace  : <<" ( "string<">" -- ) \ regexp-replace
Line 279 
Line 278 
     \G @var{string}      \G @var{string}
     '" parse postpone SLiteral postpone << ; immediate      '" parse postpone SLiteral postpone << ; immediate
 : >>string@ ( -- addr u )  : >>string@ ( -- addr u )
     >>string $@ >>string off      >>string $@ ;
     0 to >>ptr  0 to <<ptr ;  : >>string0 ( addr u -- addr u )  s" " >>string $!
       0 to >>ptr  over to <<ptr ;
 : >>next ( -- addr u ) <<ptr end$ over - ;  : >>next ( -- addr u ) <<ptr end$ over - ;
 : s// ( -- sys ) \ regexp-replace  : >>rest ( -- ) >>next >>string $+! ;
   : s// ( addr u -- ptr )
     \G start search/replace loop      \G start search/replace loop
     ]] BEGIN [[ ; immediate      ]] >>string0 (( // s>> [[ ; immediate
 : //g ( sys -- ) \ regexp-replace  : >> ( addr -- addr )
     \G end search/replace loop      ]] <<ptr >>ptr u> ?LEAVE ?end [[ ; immediate
     ]] WHILE >>next REPEAT end$ [[  : //s ( ptr -- )
     s" " ]] SLiteral << >>string@ rot drop [[ ; immediate      \G search end
       ]] )) drop >>rest >>string@ [[ ; immediate
   : //o ( ptr addr u -- addr' u' )
       \G end search/replace single loop
       ]] << //s [[ ; immediate
   : //g ( ptr addr u -- addr' u' )
       \G end search/replace all loop
       ]] << LEAVE //s [[ ; immediate

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help