From 44dc1aadc0bd68677cb201c87c78bd50f3e3e21f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Jul 2010 19:44:39 -0700 Subject: [PATCH] regexp: fix match iteration with empty matches, and fix reverse regexes since they were totally broken (bugs reported by Joe Groff and various others) --- basis/regexp/regexp-tests.factor | 61 +++++++++++++++++++++++----- basis/regexp/regexp.factor | 70 ++++++++++++++++++++------------ 2 files changed, 94 insertions(+), 37 deletions(-) diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index 2488f568da..609636c1d1 100644 --- a/basis/regexp/regexp-tests.factor +++ b/basis/regexp/regexp-tests.factor @@ -1,7 +1,5 @@ -! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg -! See http://factorcode.org/license.txt for BSD license. -USING: regexp tools.test kernel sequences regexp.parser regexp.private -eval strings multiline accessors ; +USING: arrays regexp tools.test kernel sequences regexp.parser +regexp.private eval strings multiline accessors ; IN: regexp-tests [ f ] [ "b" "a*" matches? ] unit-test @@ -241,6 +239,9 @@ IN: regexp-tests [ t ] [ 3 "xabc" R/ abc/r match-index-from >boolean ] unit-test [ t ] [ 3 "xabc" R/ a[bB][cC]/r match-index-from >boolean ] unit-test +[ 2 ] [ 0 "llamallol" R/ ll/ match-index-from ] unit-test +[ 5 ] [ 8 "lolmallol" R/ lol/r match-index-from ] unit-test + [ t ] [ "s@f" "[a-z.-]@[a-z]" matches? ] unit-test [ f ] [ "a" "[a-z.-]@[a-z]" matches? ] unit-test [ t ] [ ".o" "\\.[a-z]" matches? ] unit-test @@ -272,6 +273,10 @@ IN: regexp-tests [ "b" ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" first-match >string ] unit-test +[ T{ slice { from 5 } { to 10 } { seq "hellohello" } } ] +[ "hellohello" R/ hello/r first-match ] +unit-test + [ { "1" "2" "3" "4" } ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/ re-split [ >string ] map ] unit-test @@ -282,18 +287,52 @@ IN: regexp-tests [ { "a" "" } ] [ "a=" R/ =/ re-split [ >string ] map ] unit-test +[ { "he" "o" } ] [ "hello" R/ l+/ re-split [ >string ] map ] unit-test + +[ { "h" "llo" } ] [ "hello" R/ e+/ re-split [ >string ] map ] unit-test + +[ { "" "h" "l" "l" "o" "" } ] [ "hello" R/ e*/ re-split [ >string ] map ] unit-test + +[ { { 0 5 "hellohello" } { 5 10 "hellohello" } } ] +[ "hellohello" R/ hello/ [ 3array ] map-matches ] +unit-test + +[ { { 5 10 "hellohello" } { 0 5 "hellohello" } } ] +[ "hellohello" R/ hello/r [ 3array ] map-matches ] +unit-test + [ { "ABC" "DEF" "GHI" } ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matching-subseqs ] unit-test -[ 3 ] -[ "1ABC2DEF3GHI4" R/ [A-Z]+/ count-matches ] unit-test +[ { "ee" "e" } ] [ "heellohello" R/ e+/ all-matching-subseqs ] unit-test +[ { "e" "ee" } ] [ "heellohello" R/ e+/r all-matching-subseqs ] unit-test + +[ 3 ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/ count-matches ] unit-test + +[ 3 ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/r count-matches ] unit-test + +[ 1 ] [ "" R/ / count-matches ] unit-test + +[ 1 ] [ "" R/ /r count-matches ] unit-test + +[ 0 ] [ "123" R/ [A-Z]+/ count-matches ] unit-test + +[ 0 ] [ "123" R/ [A-Z]+/r count-matches ] unit-test + +[ 6 ] [ "hello" R/ e*/ count-matches ] unit-test + +[ 6 ] [ "hello" R/ e*/r count-matches ] unit-test + +[ 11 ] [ "hello world" R/ l*/ count-matches ] unit-test + +[ 11 ] [ "hello world" R/ l*/r count-matches ] unit-test + +[ 1 ] [ "hello" R/ e+/ count-matches ] unit-test -[ 0 ] -[ "123" R/ [A-Z]+/ count-matches ] unit-test +[ 2 ] [ "hello world" R/ l+/r count-matches ] unit-test -[ "1.2.3.4." ] -[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test - +[ "1.2.3.4." ] [ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test +[ "XhXXlXlXoX XwXoXrXlXdX" ] [ "hello world" R/ e*/ "X" re-replace ] unit-test [ "-- title --" ] [ "== title ==" R/ =/ "-" re-replace ] unit-test [ "" ] [ "ab" "a(?!b)" first-match >string ] unit-test diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index bbfe440967..de0c1a03a7 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -50,33 +50,49 @@ PRIVATE> > - execute( i string regexp -- i start end ? ) ; inline - -:: (each-match) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... ) - i string regexp do-next-match [| i' start end | - start end string quot call - i' string regexp quot (each-match) - ] [ 3drop ] if ; inline recursive + execute( i string regexp -- start end ? ) ; inline + +:: (each-match-forward) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... ) + i string length <= [ + i string regexp do-next-match [| start end | + start end string quot call + start end eq? [ end 1 + ] [ end ] if + string regexp quot (each-match-forward) + ] [ 2drop ] if + ] when ; inline recursive + +:: (each-match-backward) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... ) + i -1 >= [ + i string regexp do-next-match [| start end | + start 1 + end 1 + string quot call + start end eq? [ start 1 - ] [ start ] if + string regexp quot (each-match-backward) + ] [ 2drop ] if + ] when ; inline recursive + +: (each-match) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... ) + over reverse-regexp? [ (each-match-backward) ] [ (each-match-forward) ] if ; inline + +GENERIC: match-iterator-start ( string regexp -- start ) +M: regexp match-iterator-start 2drop 0 ; +M: reverse-regexp match-iterator-start drop length ; : prepare-match-iterator ( string regexp -- i string regexp ) - [ check-string ] dip [ end/start nip ] 2keep ; inline + [ check-string ] dip [ match-iterator-start ] 2keep ; inline PRIVATE> @@ -107,12 +123,14 @@ PRIVATE> PRIVATE> -: first-match ( string regexp -- slice/f ) - [ prepare-match-iterator do-next-match ] [ drop ] 2bi - '[ _ slice boa nip ] [ 3drop f ] if ; +:: first-match ( string regexp -- slice/f ) + string regexp prepare-match-iterator do-next-match [ + regexp reverse-regexp? [ [ 1 + ] bi@ ] when + string slice boa + ] [ 2drop f ] if ; : re-contains? ( string regexp -- ? ) - prepare-match-iterator do-next-match [ 3drop ] dip >boolean ; + prepare-match-iterator do-next-match [ 2drop ] dip >boolean ; : re-split ( string regexp -- seq ) [ slice boa ] (re-split) ; @@ -141,7 +159,7 @@ M: reverse-regexp compile-regexp ( regexp -- regexp ) DEFER: compile-next-match -: next-initial-word ( i string regexp -- i start end string ) +: next-initial-word ( i string regexp -- start end string ) [ compile-next-match ] with-compilation-unit do-next-match ; : compile-next-match ( regexp -- regexp ) @@ -149,7 +167,7 @@ DEFER: compile-next-match dup \ next-initial-word = [ drop _ [ compile-regexp dfa>> def>> ] [ reverse-regexp? ] bi '[ { array-capacity string regexp } declare _ _ next-match ] - (( i string regexp -- i start end string )) define-temp + (( i string regexp -- start end string )) define-temp ] when ] change-next-match ; -- 2.34.1