Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
7d9389ad9e
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: sequences kernel regexp.combinators regexp.matchers strings unicode.case
|
||||
USING: sequences kernel regexp.combinators strings unicode.case
|
||||
peg.ebnf regexp arrays ;
|
||||
IN: globs
|
||||
|
||||
|
|
|
|||
|
|
@ -30,15 +30,15 @@ IN: regexp.classes.tests
|
|||
[ T{ or-class { seq { 3 2 } } } ] [ { 2 3 } <or-class> 1 <not-class> 2array <and-class> ] unit-test
|
||||
[ f ] [ t <not-class> ] unit-test
|
||||
[ t ] [ f <not-class> ] unit-test
|
||||
[ f ] [ 1 <not-class> 1 t replace-question ] unit-test
|
||||
[ f ] [ 1 <not-class> 1 t answer ] unit-test
|
||||
|
||||
! Making classes into nested conditionals
|
||||
|
||||
[ V{ 1 2 3 4 } ] [ T{ and-class f { 1 T{ not-class f 2 } T{ or-class f { 3 4 } } 2 } } class>questions ] unit-test
|
||||
[ { 3 } ] [ { { 3 t } } table>condition ] unit-test
|
||||
[ { T{ primitive-class } } ] [ { { 1 t } { 2 T{ primitive-class } } } table>questions ] unit-test
|
||||
[ { { 1 t } { 2 t } } ] [ { { 1 t } { 2 T{ primitive-class } } } T{ primitive-class } t answer ] unit-test
|
||||
[ { { 1 t } } ] [ { { 1 t } { 2 T{ primitive-class } } } T{ primitive-class } f answer ] unit-test
|
||||
[ { { 1 t } { 2 t } } ] [ { { 1 t } { 2 T{ primitive-class } } } T{ primitive-class } t assoc-answer ] unit-test
|
||||
[ { { 1 t } } ] [ { { 1 t } { 2 T{ primitive-class } } } T{ primitive-class } f assoc-answer ] unit-test
|
||||
[ T{ condition f T{ primitive-class } { 1 2 } { 1 } } ] [ { { 1 t } { 2 T{ primitive-class } } } table>condition ] unit-test
|
||||
|
||||
SYMBOL: foo
|
||||
|
|
@ -46,13 +46,13 @@ SYMBOL: bar
|
|||
|
||||
[ T{ condition f T{ primitive-class f bar } T{ condition f T{ primitive-class f foo } { 1 3 2 } { 1 3 } } T{ condition f T{ primitive-class f foo } { 1 2 } { 1 } } } ] [ { { 1 t } { 3 T{ primitive-class f bar } } { 2 T{ primitive-class f foo } } } table>condition ] unit-test
|
||||
|
||||
[ t ] [ foo <primitive-class> dup t replace-question ] unit-test
|
||||
[ f ] [ foo <primitive-class> dup f replace-question ] unit-test
|
||||
[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> t replace-question ] unit-test
|
||||
[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> f replace-question ] unit-test
|
||||
[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> bar <primitive-class> t replace-question ] unit-test
|
||||
[ T{ primitive-class f bar } ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> foo <primitive-class> t replace-question ] unit-test
|
||||
[ f ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> foo <primitive-class> f replace-question ] unit-test
|
||||
[ f ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> bar <primitive-class> f replace-question ] unit-test
|
||||
[ t ] [ foo <primitive-class> bar <primitive-class> 2array <or-class> bar <primitive-class> t replace-question ] unit-test
|
||||
[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> 2array <or-class> bar <primitive-class> f replace-question ] unit-test
|
||||
[ t ] [ foo <primitive-class> dup t answer ] unit-test
|
||||
[ f ] [ foo <primitive-class> dup f answer ] unit-test
|
||||
[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> t answer ] unit-test
|
||||
[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> f answer ] unit-test
|
||||
[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> bar <primitive-class> t answer ] unit-test
|
||||
[ T{ primitive-class f bar } ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> foo <primitive-class> t answer ] unit-test
|
||||
[ f ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> foo <primitive-class> f answer ] unit-test
|
||||
[ f ] [ foo <primitive-class> bar <primitive-class> 2array <and-class> bar <primitive-class> f answer ] unit-test
|
||||
[ t ] [ foo <primitive-class> bar <primitive-class> 2array <or-class> bar <primitive-class> t answer ] unit-test
|
||||
[ T{ primitive-class f foo } ] [ foo <primitive-class> bar <primitive-class> 2array <or-class> bar <primitive-class> f answer ] unit-test
|
||||
|
|
|
|||
|
|
@ -163,20 +163,32 @@ M: integer combine-or
|
|||
: try-combine ( elt1 elt2 quot -- combined/f ? )
|
||||
3dup call [ [ 3drop ] dip t ] [ drop swapd call ] if ; inline
|
||||
|
||||
DEFER: answer
|
||||
|
||||
:: try-cancel ( elt1 elt2 empty -- combined/f ? )
|
||||
[ elt1 elt2 empty answer dup elt1 = not ] try-combine ;
|
||||
|
||||
:: prefix-combining ( seq elt quot: ( elt1 elt2 -- combined/f ? ) -- newseq )
|
||||
f :> combined!
|
||||
seq [ elt quot try-combine swap combined! ] find drop
|
||||
seq [ elt quot call swap combined! ] find drop
|
||||
[ seq remove-nth combined prefix ]
|
||||
[ seq elt prefix ] if* ; inline
|
||||
|
||||
: combine-by ( seq quot -- new-seq )
|
||||
{ } swap '[ _ prefix-combining ] reduce ; inline
|
||||
|
||||
:: seq>instance ( seq empty class -- instance )
|
||||
seq length {
|
||||
{ 0 [ empty ] }
|
||||
{ 1 [ seq first ] }
|
||||
[ drop class new seq >>seq ]
|
||||
} case ; inline
|
||||
|
||||
:: combine ( seq quot: ( elt1 elt2 -- combined/f ? ) empty class -- newseq )
|
||||
seq class flatten
|
||||
{ } [ quot prefix-combining ] reduce
|
||||
dup length {
|
||||
{ 0 [ drop empty ] }
|
||||
{ 1 [ first ] }
|
||||
[ drop class new swap >>seq ]
|
||||
} case ; inline
|
||||
[ quot try-combine ] combine-by
|
||||
! [ empty try-cancel ] combine-by ! This makes the algorithm O(n^4)
|
||||
empty class seq>instance ; inline
|
||||
|
||||
: <and-class> ( seq -- class )
|
||||
[ combine-and ] t and-class combine ;
|
||||
|
|
@ -218,36 +230,36 @@ UNION: class primitive-class not-class or-class and-class range ;
|
|||
TUPLE: condition question yes no ;
|
||||
C: <condition> condition
|
||||
|
||||
GENERIC# replace-question 2 ( class from to -- new-class )
|
||||
GENERIC# answer 2 ( class from to -- new-class )
|
||||
|
||||
M:: object replace-question ( class from to -- new-class )
|
||||
M:: object answer ( class from to -- new-class )
|
||||
class from = to class ? ;
|
||||
|
||||
: replace-compound ( class from to -- seq )
|
||||
[ seq>> ] 2dip '[ _ _ replace-question ] map ;
|
||||
[ seq>> ] 2dip '[ _ _ answer ] map ;
|
||||
|
||||
M: and-class replace-question
|
||||
M: and-class answer
|
||||
replace-compound <and-class> ;
|
||||
|
||||
M: or-class replace-question
|
||||
M: or-class answer
|
||||
replace-compound <or-class> ;
|
||||
|
||||
M: not-class replace-question
|
||||
[ class>> ] 2dip replace-question <not-class> ;
|
||||
M: not-class answer
|
||||
[ class>> ] 2dip answer <not-class> ;
|
||||
|
||||
: answer ( table question answer -- new-table )
|
||||
'[ _ _ replace-question ] assoc-map
|
||||
: assoc-answer ( table question answer -- new-table )
|
||||
'[ _ _ answer ] assoc-map
|
||||
[ nip ] assoc-filter ;
|
||||
|
||||
: answers ( table questions answer -- new-table )
|
||||
'[ _ answer ] each ;
|
||||
: assoc-answers ( table questions answer -- new-table )
|
||||
'[ _ assoc-answer ] each ;
|
||||
|
||||
DEFER: make-condition
|
||||
|
||||
: (make-condition) ( table questions question -- condition )
|
||||
[ 2nip ]
|
||||
[ swap [ t answer ] dip make-condition ]
|
||||
[ swap [ f answer ] dip make-condition ] 3tri
|
||||
[ swap [ t assoc-answer ] dip make-condition ]
|
||||
[ swap [ f assoc-answer ] dip make-condition ] 3tri
|
||||
2dup = [ 2nip ] [ <condition> ] if ;
|
||||
|
||||
: make-condition ( table questions -- condition )
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2009 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: regexp.combinators tools.test regexp kernel sequences regexp.matchers ;
|
||||
USING: regexp.combinators tools.test regexp kernel sequences ;
|
||||
IN: regexp.combinators.tests
|
||||
|
||||
: strings ( -- regexp )
|
||||
|
|
@ -16,7 +16,7 @@ USE: multiline
|
|||
{ R' .*a' R' b.*' } <and> ;
|
||||
|
||||
[ t ] [ "bljhasflsda" conj matches? ] unit-test
|
||||
[ f ] [ "bsdfdfs" conj matches? ] unit-test ! why does this fail?
|
||||
[ f ] [ "bsdfdfs" conj matches? ] unit-test
|
||||
[ f ] [ "fsfa" conj matches? ] unit-test
|
||||
|
||||
[ f ] [ "bljhasflsda" conj <not> matches? ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,19 +1,19 @@
|
|||
! Copyright (C) 2009 Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: regexp.classes kernel sequences regexp.negation
|
||||
quotations regexp.minimize assocs fry math locals combinators
|
||||
quotations assocs fry math locals combinators
|
||||
accessors words compiler.units kernel.private strings
|
||||
sequences.private arrays regexp.matchers call namespaces
|
||||
sequences.private arrays call namespaces
|
||||
regexp.transition-tables combinators.short-circuit ;
|
||||
IN: regexp.compiler
|
||||
|
||||
GENERIC: question>quot ( question -- quot )
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOL: shortest?
|
||||
SYMBOL: backwards?
|
||||
|
||||
<PRIVATE
|
||||
|
||||
M: t question>quot drop [ 2drop t ] ;
|
||||
|
||||
M: beginning-of-input question>quot
|
||||
|
|
@ -64,7 +64,7 @@ C: <box> box
|
|||
|
||||
: non-literals>dispatch ( literals non-literals -- quot )
|
||||
[ swap ] assoc-map ! we want state => predicate, and get the opposite as input
|
||||
swap keys f answers
|
||||
swap keys f assoc-answers
|
||||
table>condition [ <box> ] condition-map condition>quot ;
|
||||
|
||||
: literals>cases ( literal-transitions -- case-body )
|
||||
|
|
@ -106,13 +106,15 @@ C: <box> box
|
|||
transitions>quot ;
|
||||
|
||||
: states>code ( words dfa -- )
|
||||
'[
|
||||
[ ! with-compilation-unit doesn't compile, so we need call( -- )
|
||||
[
|
||||
dup _ word>quot
|
||||
(( last-match index string -- ? ))
|
||||
define-declared
|
||||
] each
|
||||
] with-compilation-unit ;
|
||||
'[
|
||||
dup _ word>quot
|
||||
(( last-match index string -- ? ))
|
||||
define-declared
|
||||
] each
|
||||
] with-compilation-unit
|
||||
] call( words dfa -- ) ;
|
||||
|
||||
: states>words ( dfa -- words dfa )
|
||||
dup transitions>> keys [ gensym ] H{ } map>assoc
|
||||
|
|
@ -120,34 +122,23 @@ C: <box> box
|
|||
[ values ]
|
||||
bi swap ;
|
||||
|
||||
: dfa>word ( dfa -- word )
|
||||
: dfa>main-word ( dfa -- word )
|
||||
states>words [ states>code ] keep start-state>> ;
|
||||
|
||||
: check-string ( string -- string )
|
||||
! Make this configurable
|
||||
dup string? [ "String required" throw ] unless ;
|
||||
|
||||
: setup-regexp ( start-index string -- f start-index string )
|
||||
[ f ] [ >fixnum ] [ check-string ] tri* ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
! The quotation returned is ( start-index string -- i/f )
|
||||
: simple-define-temp ( quot effect -- word )
|
||||
[ [ define-temp ] with-compilation-unit ] call( quot effect -- word ) ;
|
||||
|
||||
: dfa>quotation ( dfa -- quot )
|
||||
dfa>word execution-quot '[ setup-regexp @ ] ;
|
||||
: dfa>word ( dfa -- quot )
|
||||
dfa>main-word execution-quot '[ drop [ f ] 2dip @ ]
|
||||
(( start-index string regexp -- i/f )) simple-define-temp ;
|
||||
|
||||
: dfa>shortest-quotation ( dfa -- quot )
|
||||
t shortest? [ dfa>quotation ] with-variable ;
|
||||
: dfa>shortest-word ( dfa -- word )
|
||||
t shortest? [ dfa>word ] with-variable ;
|
||||
|
||||
: dfa>reverse-quotation ( dfa -- quot )
|
||||
t backwards? [ dfa>quotation ] with-variable ;
|
||||
: dfa>reverse-word ( dfa -- word )
|
||||
t backwards? [ dfa>word ] with-variable ;
|
||||
|
||||
: dfa>reverse-shortest-quotation ( dfa -- quot )
|
||||
t backwards? [ dfa>shortest-quotation ] with-variable ;
|
||||
|
||||
TUPLE: quot-matcher quot ;
|
||||
C: <quot-matcher> quot-matcher
|
||||
|
||||
M: quot-matcher match-index-from
|
||||
quot>> call( index string -- i/f ) ;
|
||||
: dfa>reverse-shortest-word ( dfa -- word )
|
||||
t backwards? [ dfa>shortest-word ] with-variable ;
|
||||
|
|
|
|||
|
|
@ -6,9 +6,6 @@ regexp.ast regexp.transition-tables regexp.minimize
|
|||
regexp.dfa namespaces ;
|
||||
IN: regexp.negation
|
||||
|
||||
: ast>dfa ( parse-tree -- minimal-dfa )
|
||||
construct-nfa disambiguate construct-dfa minimize ;
|
||||
|
||||
CONSTANT: fail-state -1
|
||||
|
||||
: add-default-transition ( state's-transitions -- new-state's-transitions )
|
||||
|
|
@ -49,5 +46,8 @@ CONSTANT: fail-state -1
|
|||
[ final-states>> keys first ]
|
||||
[ nfa-table get [ transitions>> ] bi@ swap update ] tri ;
|
||||
|
||||
: ast>dfa ( parse-tree -- minimal-dfa )
|
||||
construct-nfa disambiguate construct-dfa minimize ;
|
||||
|
||||
M: negation nfa-node ( node -- start end )
|
||||
term>> ast>dfa negate-table adjoin-dfa ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel strings help.markup help.syntax regexp.matchers math ;
|
||||
USING: kernel strings help.markup help.syntax math ;
|
||||
IN: regexp
|
||||
|
||||
ABOUT: "regexp"
|
||||
|
|
@ -39,13 +39,14 @@ ARTICLE: { "regexp" "theory" } "The theory of regular expressions"
|
|||
"The Factor regular expression engine was built with the design decision to support negation and intersection at the expense of backreferences. This lets us have a guaranteed linear-time matching algorithm. Systems like Ragel and Lex also use this algorithm, but in the Factor regular expression engine, all other features of regexps are still present." ;
|
||||
|
||||
ARTICLE: { "regexp" "operations" } "Matching operations with regular expressions"
|
||||
{ $subsection all-matches }
|
||||
{ $subsection matches? }
|
||||
{ $subsection re-contains? }
|
||||
{ $subsection first-match }
|
||||
{ $subsection all-matches }
|
||||
{ $subsection re-split1 }
|
||||
{ $subsection re-split }
|
||||
{ $subsection re-replace }
|
||||
{ $subsection count-matches }
|
||||
{ $subsection re-replace } ;
|
||||
{ $subsection count-matches } ;
|
||||
|
||||
HELP: <regexp>
|
||||
{ $values { "string" string } { "regexp" regexp } }
|
||||
|
|
@ -63,25 +64,33 @@ HELP: regexp
|
|||
{ $class-description "The class of regular expressions. To construct these, see " { $link { "regexp" "construction" } } "." } ;
|
||||
|
||||
HELP: matches?
|
||||
{ $values { "string" string } { "matcher" regexp } { "?" "a boolean" } }
|
||||
{ $values { "string" string } { "regexp" regexp } { "?" "a boolean" } }
|
||||
{ $description "Tests if the string as a whole matches the given regular expression." } ;
|
||||
|
||||
HELP: re-split1
|
||||
{ $values { "string" string } { "matcher" regexp } { "before" string } { "after/f" string } }
|
||||
{ $values { "string" string } { "regexp" regexp } { "before" string } { "after/f" string } }
|
||||
{ $description "Searches the string for a substring which matches the pattern. If found, the input string is split on the leftmost and longest occurence of the match, and the two halves are given as output. If no match is found, then the input string and " { $link f } " are output." } ;
|
||||
|
||||
HELP: all-matches
|
||||
{ $values { "string" string } { "matcher" regexp } { "seq" "a sequence of slices of the input" } }
|
||||
{ $values { "string" string } { "regexp" regexp } { "seq" "a sequence of slices of the input" } }
|
||||
{ $description "Finds a sequence of disjoint substrings which each match the pattern. It chooses this by finding the leftmost longest match, and then the leftmost longest match which starts after the end of the previous match, and so on." } ;
|
||||
|
||||
HELP: count-matches
|
||||
{ $values { "string" string } { "matcher" regexp } { "n" integer } }
|
||||
{ $values { "string" string } { "regexp" regexp } { "n" integer } }
|
||||
{ $description "Counts how many disjoint matches the regexp has in the string, as made unambiguous by " { $link all-matches } "." } ;
|
||||
|
||||
HELP: re-split
|
||||
{ $values { "string" string } { "matcher" regexp } { "seq" "a sequence of slices of the input" } }
|
||||
{ $values { "string" string } { "regexp" regexp } { "seq" "a sequence of slices of the input" } }
|
||||
{ $description "Splits the input string into chunks separated by the regular expression. Each chunk contains no match of the regexp. The chunks are chosen by the strategy of " { $link all-matches } "." } ;
|
||||
|
||||
HELP: re-replace
|
||||
{ $values { "string" string } { "matcher" regexp } { "replacement" string } { "result" string } }
|
||||
{ $values { "string" string } { "regexp" regexp } { "replacement" string } { "result" string } }
|
||||
{ $description "Replaces substrings which match the input regexp with the given replacement text. The boundaries of the substring are chosen by the strategy used by " { $link all-matches } "." } ;
|
||||
|
||||
HELP: first-match
|
||||
{ $values { "string" string } { "regexp" regexp } { "slice/f" "the match, if one exists" } }
|
||||
{ $description "Finds the first match of the regular expression in the string, and returns it as a slice. If there is no match, then " { $link f } " is returned." } ;
|
||||
|
||||
HELP: re-contains?
|
||||
{ $values { "string" string } { "regexp" regexp } { "?" "a boolean" } }
|
||||
{ $description "Determines whether the string has a substring which matches the regular expression given." } ;
|
||||
|
|
|
|||
|
|
@ -1,13 +1,12 @@
|
|||
! 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 regexp.matchers ;
|
||||
eval strings multiline accessors ;
|
||||
IN: regexp-tests
|
||||
|
||||
\ <regexp> must-infer
|
||||
! the following don't compile because [ ] with-compilation-unit doesn't compile
|
||||
! \ compile-regexp must-infer
|
||||
! \ matches? must-infer
|
||||
\ compile-regexp must-infer
|
||||
\ matches? must-infer
|
||||
|
||||
[ f ] [ "b" "a*" <regexp> matches? ] unit-test
|
||||
[ t ] [ "" "a*" <regexp> matches? ] unit-test
|
||||
|
|
@ -212,8 +211,8 @@ IN: regexp-tests
|
|||
[ f ] [ "aaaxb" "a+ab" <regexp> matches? ] unit-test
|
||||
[ t ] [ "aaacb" "a+cb" <regexp> matches? ] unit-test
|
||||
|
||||
[ 3 ] [ "aaacb" "a*" <regexp> match-index-head ] unit-test
|
||||
[ 2 ] [ "aaacb" "aa?" <regexp> match-index-head ] unit-test
|
||||
[ "aaa" ] [ "aaacb" "a*" <regexp> first-match >string ] unit-test
|
||||
[ "aa" ] [ "aaacb" "aa?" <regexp> first-match >string ] unit-test
|
||||
|
||||
[ t ] [ "aaa" R/ AAA/i matches? ] unit-test
|
||||
[ f ] [ "aax" R/ AAA/i matches? ] unit-test
|
||||
|
|
@ -240,11 +239,11 @@ IN: regexp-tests
|
|||
[ f ] [ "A" "\\p{Lower}" <regexp> matches? ] unit-test
|
||||
[ t ] [ "A" R/ \p{Lower}/i matches? ] unit-test
|
||||
|
||||
[ t ] [ "abc" reverse R/ abc/r matches? ] unit-test
|
||||
[ t ] [ "abc" reverse R/ a[bB][cC]/r matches? ] unit-test
|
||||
[ t ] [ "abc" R/ abc/r matches? ] unit-test
|
||||
[ t ] [ "abc" R/ a[bB][cC]/r matches? ] unit-test
|
||||
|
||||
[ t ] [ 3 "xabc" R/ abc/ <reverse-matcher> match-index-from >boolean ] unit-test
|
||||
[ t ] [ 3 "xabc" R/ a[bB][cC]/ <reverse-matcher> match-index-from >boolean ] unit-test
|
||||
[ 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
|
||||
|
||||
[ t ] [ "s@f" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
|
||||
[ f ] [ "a" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
|
||||
|
|
@ -269,13 +268,13 @@ IN: regexp-tests
|
|||
|
||||
[ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" eval ] unit-test
|
||||
|
||||
[ "ab" ] [ "ab" "(a|ab)(bc)?" <regexp> match-head >string ] unit-test
|
||||
[ "abc" ] [ "abc" "(a|ab)(bc)?" <regexp> match-head >string ] unit-test
|
||||
[ "ab" ] [ "ab" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
|
||||
[ "abc" ] [ "abc" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
|
||||
|
||||
[ "ab" ] [ "ab" "(ab|a)(bc)?" <regexp> match-head >string ] unit-test
|
||||
[ "abc" ] [ "abc" "(ab|a)(bc)?" <regexp> match-head >string ] unit-test
|
||||
[ "ab" ] [ "ab" "(ab|a)(bc)?" <regexp> first-match >string ] unit-test
|
||||
[ "abc" ] [ "abc" "(ab|a)(bc)?" <regexp> first-match >string ] unit-test
|
||||
|
||||
[ "b" ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> match-head >string ] unit-test
|
||||
[ "b" ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match >string ] unit-test
|
||||
|
||||
[ { "1" "2" "3" "4" } ]
|
||||
[ "1ABC2DEF3GHI4" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
|
||||
|
|
@ -301,18 +300,18 @@ IN: regexp-tests
|
|||
|
||||
[ "-- title --" ] [ "== title ==" R/ =/ "-" re-replace ] unit-test
|
||||
|
||||
[ "" ] [ "ab" "a(?!b)" <regexp> match-head >string ] unit-test
|
||||
[ "a" ] [ "ac" "a(?!b)" <regexp> match-head >string ] unit-test
|
||||
[ "" ] [ "ab" "a(?!b)" <regexp> first-match >string ] unit-test
|
||||
[ "a" ] [ "ac" "a(?!b)" <regexp> first-match >string ] unit-test
|
||||
[ t ] [ "fxxbar" ".{3}(?!foo)bar" <regexp> matches? ] unit-test
|
||||
[ t ] [ "foobar" ".{3}(?!foo)bar" <regexp> matches? ] unit-test
|
||||
[ t ] [ "fxxbar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
|
||||
[ f ] [ "foobar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
|
||||
[ "a" ] [ "ab" "a(?=b)(?=b)" <regexp> match-head >string ] unit-test
|
||||
[ "a" ] [ "ba" "(?<=b)(?<=b)a" <regexp> match-head >string ] unit-test
|
||||
[ "a" ] [ "cab" "(?<=c)a(?=b)" <regexp> match-head >string ] unit-test
|
||||
[ "a" ] [ "ab" "a(?=b)(?=b)" <regexp> first-match >string ] unit-test
|
||||
[ "a" ] [ "ba" "(?<=b)(?<=b)a" <regexp> first-match >string ] unit-test
|
||||
[ "a" ] [ "cab" "(?<=c)a(?=b)" <regexp> first-match >string ] unit-test
|
||||
|
||||
[ 3 ] [ "foobar" "foo(?=bar)" <regexp> match-index-head ] unit-test
|
||||
[ f ] [ "foobxr" "foo(?=bar)" <regexp> match-index-head ] unit-test
|
||||
[ 3 ] [ "foobar" "foo(?=bar)" <regexp> first-match length ] unit-test
|
||||
[ f ] [ "foobxr" "foo(?=bar)" <regexp> first-match ] unit-test
|
||||
|
||||
! Bug in parsing word
|
||||
[ t ] [ "a" R' a' matches? ] unit-test
|
||||
|
|
@ -342,9 +341,19 @@ IN: regexp-tests
|
|||
|
||||
[ t ] [ "aaaa" R/ .*a./ matches? ] unit-test
|
||||
|
||||
[ f ] [ "ab" R/ (?~ac|\p{Lower}b)/ matches? ] unit-test
|
||||
[ f ] [ "ab" R/ (?~ac|[a-z]b)/ matches? ] unit-test
|
||||
[ f ] [ "ac" R/ (?~ac|\p{Lower}b)/ matches? ] unit-test
|
||||
[ f ] [ "ac" R/ (?~ac|[a-z]b)/ matches? ] unit-test
|
||||
[ f ] [ "ac" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
|
||||
[ f ] [ "ab" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
|
||||
[ f ] [ "πb" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
|
||||
[ t ] [ "πc" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
|
||||
[ t ] [ "Ab" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
|
||||
|
||||
! DFA is compiled when needed, or when literal
|
||||
[ f ] [ "foo" <regexp> dfa>> >boolean ] unit-test
|
||||
[ t ] [ R/ foo/ dfa>> >boolean ] unit-test
|
||||
[ regexp-initial-word ] [ "foo" <regexp> dfa>> ] unit-test
|
||||
[ f ] [ R/ foo/ dfa>> \ regexp-initial-word = ] unit-test
|
||||
|
||||
[ t ] [ "a" R/ ^a/ matches? ] unit-test
|
||||
[ f ] [ "\na" R/ ^a/ matches? ] unit-test
|
||||
|
|
@ -415,8 +424,12 @@ IN: regexp-tests
|
|||
[ 1 ] [ "a\r" R/ a$/m count-matches ] unit-test
|
||||
[ 1 ] [ "a\r\n" R/ a$/m count-matches ] unit-test
|
||||
|
||||
[ f ] [ "foobxr" "foo\\z" <regexp> match-index-head ] unit-test
|
||||
[ 3 ] [ "foo" "foo\\z" <regexp> match-index-head ] unit-test
|
||||
[ f ] [ "foobxr" "foo\\z" <regexp> first-match ] unit-test
|
||||
[ 3 ] [ "foo" "foo\\z" <regexp> first-match length ] unit-test
|
||||
|
||||
[ t ] [ "a foo b" R/ foo/ re-contains? ] unit-test
|
||||
[ f ] [ "a bar b" R/ foo/ re-contains? ] unit-test
|
||||
[ t ] [ "foo" R/ foo/ re-contains? ] unit-test
|
||||
|
||||
! [ t ] [ "foo" "\\bfoo\\b" <regexp> matches? ] unit-test
|
||||
! [ t ] [ "afoob" "\\Bfoo\\B" <regexp> matches? ] unit-test
|
||||
|
|
|
|||
|
|
@ -2,71 +2,166 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators kernel math sequences strings sets
|
||||
assocs prettyprint.backend prettyprint.custom make lexer
|
||||
namespaces parser arrays fry locals regexp.minimize
|
||||
regexp.parser regexp.nfa regexp.dfa regexp.classes
|
||||
regexp.transition-tables splitting sorting regexp.ast
|
||||
regexp.negation regexp.matchers regexp.compiler ;
|
||||
namespaces parser arrays fry locals regexp.parser splitting
|
||||
sorting regexp.ast regexp.negation regexp.compiler words
|
||||
call call.private math.ranges ;
|
||||
IN: regexp
|
||||
|
||||
TUPLE: regexp
|
||||
{ raw read-only }
|
||||
{ parse-tree read-only }
|
||||
{ options read-only }
|
||||
dfa reverse-dfa ;
|
||||
dfa next-match ;
|
||||
|
||||
: make-regexp ( string ast -- regexp )
|
||||
f f <options> f f regexp boa ; foldable
|
||||
! Foldable because, when the dfa slot is set,
|
||||
! it'll be set to the same thing regardless of who sets it
|
||||
TUPLE: reverse-regexp < regexp ;
|
||||
|
||||
: <optioned-regexp> ( string options -- regexp )
|
||||
[ dup parse-regexp ] [ string>options ] bi*
|
||||
f f regexp boa ;
|
||||
<PRIVATE
|
||||
|
||||
: <regexp> ( string -- regexp ) "" <optioned-regexp> ;
|
||||
: maybe-negated ( lookaround quot -- regexp-quot )
|
||||
'[ term>> @ ] [ positive?>> [ ] [ not ] ? ] bi compose ; inline
|
||||
|
||||
TUPLE: reverse-matcher regexp ;
|
||||
C: <reverse-matcher> reverse-matcher
|
||||
! Reverse matchers won't work properly with most combinators, for now
|
||||
M: lookahead question>quot ! Returns ( index string -- ? )
|
||||
[ ast>dfa dfa>shortest-word '[ f _ execute ] ] maybe-negated ;
|
||||
|
||||
: <reversed-option> ( ast -- reversed )
|
||||
"r" string>options <with-options> ;
|
||||
|
||||
M: lookbehind question>quot ! Returns ( index string -- ? )
|
||||
[
|
||||
<reversed-option>
|
||||
ast>dfa dfa>reverse-shortest-word
|
||||
'[ [ 1- ] dip f _ execute ]
|
||||
] maybe-negated ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: check-string ( string -- string )
|
||||
! Make this configurable
|
||||
dup string? [ "String required" throw ] unless ;
|
||||
|
||||
: match-index-from ( i string regexp -- index/f )
|
||||
! This word is unsafe. It assumes that i is a fixnum
|
||||
! and that string is a string.
|
||||
dup dfa>> execute( index string regexp -- i/f ) ;
|
||||
|
||||
GENERIC: end/start ( string regexp -- end start )
|
||||
M: regexp end/start drop length 0 ;
|
||||
M: reverse-regexp end/start drop length 1- -1 swap ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: matches? ( string regexp -- ? )
|
||||
[ end/start ] 2keep
|
||||
[ check-string ] dip
|
||||
match-index-from
|
||||
[ swap = ] [ drop f ] if* ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: match-slice ( i string quot -- slice/f )
|
||||
[ 2dup ] dip call
|
||||
[ swap <slice> ] [ 2drop f ] if* ; inline
|
||||
|
||||
: match-from ( i string quot -- slice/f )
|
||||
[ [ length [a,b) ] keep ] dip
|
||||
'[ _ _ match-slice ] map-find drop ; inline
|
||||
|
||||
: next-match ( i string quot -- i match/f )
|
||||
match-from [ dup [ to>> ] when ] keep ; inline
|
||||
|
||||
: do-next-match ( i string regexp -- i match/f )
|
||||
dup next-match>> execute( i string regexp -- i match/f ) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: all-matches ( string regexp -- seq )
|
||||
[ check-string ] dip
|
||||
[ 0 [ dup ] ] 2dip '[ _ _ do-next-match ] produce
|
||||
nip but-last ;
|
||||
|
||||
: count-matches ( string regexp -- n )
|
||||
all-matches length ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
:: split-slices ( string slices -- new-slices )
|
||||
slices [ to>> ] map 0 prefix
|
||||
slices [ from>> ] map string length suffix
|
||||
[ string <slice> ] 2map ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: first-match ( string regexp -- slice/f )
|
||||
[ 0 ] [ check-string ] [ ] tri*
|
||||
do-next-match nip ;
|
||||
|
||||
: re-contains? ( string regexp -- ? )
|
||||
first-match >boolean ;
|
||||
|
||||
: re-split1 ( string regexp -- before after/f )
|
||||
dupd first-match [ 1array split-slices first2 ] [ f ] if* ;
|
||||
|
||||
: re-split ( string regexp -- seq )
|
||||
dupd all-matches split-slices ;
|
||||
|
||||
: re-replace ( string regexp replacement -- result )
|
||||
[ re-split ] dip join ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: get-ast ( regexp -- ast )
|
||||
[ parse-tree>> ] [ options>> ] bi <with-options> ;
|
||||
|
||||
: compile-regexp ( regexp -- regexp )
|
||||
dup '[ [ _ get-ast ast>dfa dfa>quotation ] unless* ] change-dfa ;
|
||||
GENERIC: compile-regexp ( regex -- regexp )
|
||||
|
||||
: <reversed-option> ( ast -- reversed )
|
||||
"r" string>options <with-options> ;
|
||||
: regexp-initial-word ( i string regexp -- i/f )
|
||||
compile-regexp match-index-from ;
|
||||
|
||||
: maybe-negated ( lookaround quot -- regexp-quot )
|
||||
'[ term>> @ ] [ positive?>> [ ] [ not ] ? ] bi compose ; inline
|
||||
|
||||
M: lookahead question>quot ! Returns ( index string -- ? )
|
||||
[ ast>dfa dfa>shortest-quotation ] maybe-negated ;
|
||||
|
||||
M: lookbehind question>quot ! Returns ( index string -- ? )
|
||||
[
|
||||
<reversed-option>
|
||||
ast>dfa dfa>reverse-shortest-quotation
|
||||
[ [ 1- ] dip ] prepose
|
||||
] maybe-negated ;
|
||||
|
||||
: compile-reverse ( regexp -- regexp )
|
||||
: do-compile-regexp ( regexp -- regexp )
|
||||
dup '[
|
||||
[
|
||||
_ get-ast <reversed-option>
|
||||
ast>dfa dfa>reverse-quotation
|
||||
] unless*
|
||||
] change-reverse-dfa ;
|
||||
dup \ regexp-initial-word =
|
||||
[ drop _ get-ast ast>dfa dfa>word ] when
|
||||
] change-dfa ;
|
||||
|
||||
M: regexp match-index-from
|
||||
compile-regexp dfa>> <quot-matcher> match-index-from ;
|
||||
M: regexp compile-regexp ( regexp -- regexp )
|
||||
do-compile-regexp ;
|
||||
|
||||
M: reverse-matcher match-index-from
|
||||
regexp>> compile-reverse reverse-dfa>>
|
||||
<quot-matcher> match-index-from ;
|
||||
M: reverse-regexp compile-regexp ( regexp -- regexp )
|
||||
t backwards? [ do-compile-regexp ] with-variable ;
|
||||
|
||||
GENERIC: compile-next-match ( regexp -- regexp )
|
||||
|
||||
: next-initial-word ( i string regexp -- i slice/f )
|
||||
compile-next-match do-next-match ;
|
||||
|
||||
M: regexp compile-next-match ( regexp -- regexp )
|
||||
dup '[
|
||||
dup \ next-initial-word = [
|
||||
drop _ compile-regexp dfa>>
|
||||
'[ _ '[ _ _ execute ] next-match ]
|
||||
(( i string -- i match/f )) simple-define-temp
|
||||
] when
|
||||
] change-next-match ;
|
||||
|
||||
! Write M: reverse-regexp compile-next-match
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: new-regexp ( string ast options class -- regexp )
|
||||
[ \ regexp-initial-word \ next-initial-word ] dip boa ; inline
|
||||
|
||||
: make-regexp ( string ast -- regexp )
|
||||
f f <options> regexp new-regexp ;
|
||||
|
||||
: <optioned-regexp> ( string options -- regexp )
|
||||
[ dup parse-regexp ] [ string>options ] bi*
|
||||
dup on>> reversed-regexp swap member?
|
||||
[ reverse-regexp new-regexp ]
|
||||
[ regexp new-regexp ] if ;
|
||||
|
||||
: <regexp> ( string -- regexp ) "" <optioned-regexp> ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
! The following two should do some caching
|
||||
|
||||
|
|
@ -97,7 +192,7 @@ M: reverse-matcher match-index-from
|
|||
|
||||
: parsing-regexp ( accum end -- accum )
|
||||
lexer get [ take-until ] [ parse-noblank-token ] bi
|
||||
<optioned-regexp> compile-regexp parsed ;
|
||||
<optioned-regexp> compile-next-match parsed ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
@ -120,3 +215,4 @@ M: regexp pprint*
|
|||
[ options>> options>string % ] bi
|
||||
] "" make
|
||||
] keep present-text ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel continuations sequences math namespaces make sets
|
||||
math.parser math.ranges assocs regexp regexp.matchers unicode.categories arrays
|
||||
math.parser math.ranges assocs regexp unicode.categories arrays
|
||||
hashtables words classes quotations xmode.catalog unicode.case ;
|
||||
IN: validators
|
||||
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: xmode.marker
|
||||
USING: kernel namespaces make xmode.rules xmode.tokens
|
||||
xmode.marker.state xmode.marker.context xmode.utilities
|
||||
xmode.catalog sequences math assocs combinators strings
|
||||
regexp splitting ascii unicode.case regexp.matchers
|
||||
ascii combinators.short-circuit accessors ;
|
||||
regexp splitting unicode.case
|
||||
combinators.short-circuit accessors ;
|
||||
IN: xmode.marker
|
||||
|
||||
! Next two words copied from parser-combinators
|
||||
! Just like head?, but they optionally ignore case
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors regexp.matchers prettyprint io io.encodings.ascii
|
||||
USING: accessors prettyprint io io.encodings.ascii
|
||||
io.files kernel sequences assocs namespaces regexp ;
|
||||
IN: benchmark.regex-dna
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue