steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Get rid of match tuple

db4
Slava Pestov 2009-03-11 16:36:53 -05:00
parent 643da5f073
commit 7dac8de701
1 changed files with 10 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
basis/regexp/regexp.factor
View File

@ -56,28 +56,20 @@ PRIVATE>
<PRIVATE <PRIVATE
TUPLE: match { i read-only } { start read-only } { end read-only } { string read-only } ; :: (next-match) ( i string regexp word: ( i string -- j ) reverse? -- i start end ? )
i string regexp word execute dup [| j |
:: <match> ( i string quot: ( i string -- i seq j ) reverse? -- match/f )
i string quot call dup [| j |
j i j j i j
reverse? [ swap [ 1+ ] bi@ ] when reverse? [ swap [ 1+ ] bi@ ] when
string match boa string
] when ; inline ] [ drop f f f f ] if ; inline
: search-range ( i string reverse? -- seq ) : search-range ( i string reverse? -- seq )
[ drop 0 [a,b] ] [ length [a,b) ] if ; inline [ drop 0 [a,b] ] [ length [a,b) ] if ; inline
: match>result ( match -- i start end string ) :: next-match ( i string regexp word reverse? -- i start end ? )
dup f f f f
[ { [ i>> ] [ start>> ] [ end>> ] [ string>> ] } cleave ]
[ drop f f f f ]
if ; inline
:: next-match ( i string quot reverse? -- i start end ? )
i string reverse? search-range i string reverse? search-range
[ string quot reverse? <match> ] map-find drop [ [ 2drop 2drop ] dip string regexp word reverse? (next-match) dup ] find 2drop ; inline
match>result ; inline
: do-next-match ( i string regexp -- i start end ? ) : do-next-match ( i string regexp -- i start end ? )
dup next-match>> dup next-match>>
@ -89,11 +81,11 @@ TUPLE: match { i read-only } { start read-only } { end read-only } { string read
i' string regexp quot (each-match) i' string regexp quot (each-match)
] [ 3drop ] if ; inline recursive ] [ 3drop ] if ; inline recursive
PRIVATE>
: prepare-match-iterator ( string regexp -- i string regexp ) : prepare-match-iterator ( string regexp -- i string regexp )
[ check-string ] dip [ end/start nip ] 2keep ; inline [ check-string ] dip [ end/start nip ] 2keep ; inline
PRIVATE>
: each-match ( string regexp quot: ( start end string -- ) -- ) : each-match ( string regexp quot: ( start end string -- ) -- )
[ prepare-match-iterator ] dip (each-match) ; inline [ prepare-match-iterator ] dip (each-match) ; inline
@ -165,7 +157,7 @@ DEFER: compile-next-match
dup '[ dup '[
dup \ next-initial-word = [ dup \ next-initial-word = [
drop _ [ compile-regexp dfa>> ] [ reverse-regexp? ] bi drop _ [ compile-regexp dfa>> ] [ reverse-regexp? ] bi
'[ _ '[ _ _ execute ] _ next-match ] '[ _ _ next-match ]
(( i string regexp -- i start end string )) simple-define-temp (( i string regexp -- i start end string )) simple-define-temp
] when ] when
] change-next-match ; ] change-next-match ;