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

fix match-all, re-split

db4
Doug Coleman 2008-11-22 20:01:25 -06:00
parent fb8bdfe7e5
commit bcd75e97d3
2 changed files with 19 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/regexp/regexp-tests.factor
View File

@ -1,5 +1,5 @@
USING: regexp tools.test kernel sequences regexp.parser USING: regexp tools.test kernel sequences regexp.parser
regexp.traversal eval ; regexp.traversal eval strings ;
IN: regexp-tests IN: regexp-tests
\ <regexp> must-infer \ <regexp> must-infer
@ -350,3 +350,15 @@ IN: regexp-tests
[ t ] [ "a:b" ".+:?" <regexp> matches? ] unit-test [ t ] [ "a:b" ".+:?" <regexp> matches? ] unit-test
[ 1 ] [ "hello" ".+?" <regexp> match length ] unit-test [ 1 ] [ "hello" ".+?" <regexp> match length ] unit-test
[ { "1" "2" "3" "4" } ]
[ "1ABC2DEF3GHI4" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
[ { "1" "2" "3" "4" } ]
[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
[ { "ABC" "DEF" "GHI" } ]
[ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matches [ >string ] map ] unit-test
[ "1.2.3.4" ]
[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test

14
basis/regexp/regexp.factor
View File

@ -3,7 +3,7 @@
USING: accessors combinators kernel math sequences USING: accessors combinators kernel math sequences
sets assocs prettyprint.backend make lexer namespaces parser sets assocs prettyprint.backend make lexer namespaces parser
arrays fry regexp.backend regexp.utils regexp.parser regexp.nfa arrays fry regexp.backend regexp.utils regexp.parser regexp.nfa
regexp.dfa regexp.traversal regexp.transition-tables ; regexp.dfa regexp.traversal regexp.transition-tables splitting ;
IN: regexp IN: regexp
: default-regexp ( string -- regexp ) : default-regexp ( string -- regexp )
@ -52,27 +52,25 @@ IN: regexp
[ 3drop drop f f ] [ drop [ 1+ ] dip match-range ] if [ 3drop drop f f ] [ drop [ 1+ ] dip match-range ] if
] if ; ] if ;
: first-match ( string regexp -- pair/f ) : first-match ( string regexp -- slice/f )
dupd 0 swap match-range rot over [ <slice> ] [ 3drop f ] if ; dupd 0 swap match-range rot over [ <slice> ] [ 3drop f ] if ;
: re-cut ( string regexp -- end/f start ) : re-cut ( string regexp -- end/f start )
dupd first-match dupd first-match
[ [ second tail-slice ] [ first head ] 2bi ] [ split1-slice swap ] [ "" like f swap ] if* ;
[ "" like f swap ]
if* ;
: re-split ( string regexp -- seq ) : re-split ( string regexp -- seq )
[ dup ] swap '[ _ re-cut ] [ ] produce nip ; [ dup length 0 > ] swap '[ _ re-cut ] [ ] produce nip ;
: re-replace ( string regexp replacement -- result ) : re-replace ( string regexp replacement -- result )
[ re-split ] dip join ; [ re-split ] dip join ;
: next-match ( string regexp -- end/f match/f ) : next-match ( string regexp -- end/f match/f )
dupd first-match dup dupd first-match dup
[ [ length 1+ tail-slice ] keep ] [ 2drop f f ] if ; [ [ split1-slice nip ] keep ] [ 2drop f f ] if ;
: all-matches ( string regexp -- seq ) : all-matches ( string regexp -- seq )
[ dup ] swap '[ _ next-match ] [ ] produce nip ; [ dup ] swap '[ _ next-match ] [ ] produce nip harvest ;
: count-matches ( string regexp -- n ) : count-matches ( string regexp -- n )
all-matches length 1- ; all-matches length 1- ;