better literal syntax for regexps. support ^ and $ (not in multiline mode yet) but not yet in multiline mode. support for \A and \Z \z is next. removed some crud from the parser, and added more commented out unit tests...
Doug Coleman
parent
ce54c54ba0
commit
db3c21663e
|
|
@ -7,6 +7,7 @@ IN: regexp.classes
|
|||
GENERIC: class-member? ( obj class -- ? )
|
||||
|
||||
M: word class-member? ( obj class -- ? ) 2drop f ;
|
||||
|
||||
M: integer class-member? ( obj class -- ? ) 2drop f ;
|
||||
|
||||
M: character-class-range class-member? ( obj class -- ? )
|
||||
|
|
@ -60,3 +61,12 @@ M: java-blank-class class-member? ( obj class -- ? )
|
|||
|
||||
M: unmatchable-class class-member? ( obj class -- ? )
|
||||
2drop f ;
|
||||
|
||||
M: terminator-class class-member? ( obj class -- ? )
|
||||
drop {
|
||||
[ CHAR: \r = ]
|
||||
[ CHAR: \n = ]
|
||||
[ CHAR: \u000085 = ]
|
||||
[ CHAR: \u002028 = ]
|
||||
[ CHAR: \u002029 = ]
|
||||
} 1|| ;
|
||||
|
|
|
|||
|
|
@ -18,6 +18,9 @@ SINGLETON: lookbehind-on INSTANCE: lookbehind-on traversal-flag
|
|||
SINGLETON: lookbehind-off INSTANCE: lookbehind-off traversal-flag
|
||||
SINGLETON: capture-group-on INSTANCE: capture-group-on traversal-flag
|
||||
SINGLETON: capture-group-off INSTANCE: capture-group-off traversal-flag
|
||||
SINGLETON: front-anchor INSTANCE: front-anchor traversal-flag
|
||||
SINGLETON: back-anchor INSTANCE: back-anchor traversal-flag
|
||||
SINGLETON: word-boundary INSTANCE: word-boundary traversal-flag
|
||||
|
||||
: next-state ( regexp -- state )
|
||||
[ state>> ] [ [ 1+ ] change-state drop ] bi ;
|
||||
|
|
@ -135,7 +138,21 @@ M: non-capture-group nfa-node ( node -- )
|
|||
M: reluctant-kleene-star nfa-node ( node -- )
|
||||
term>> <kleene-star> nfa-node ;
|
||||
|
||||
!
|
||||
|
||||
: add-epsilon-flag ( flag -- )
|
||||
eps literal-transition add-simple-entry add-traversal-flag ;
|
||||
|
||||
M: beginning-of-line nfa-node ( node -- )
|
||||
drop beginning-of-line add-epsilon-flag ;
|
||||
|
||||
M: end-of-line nfa-node ( node -- )
|
||||
drop end-of-line add-epsilon-flag ;
|
||||
|
||||
M: beginning-of-input nfa-node ( node -- )
|
||||
drop beginning-of-input add-epsilon-flag ;
|
||||
|
||||
M: end-of-input nfa-node ( node -- )
|
||||
drop end-of-input add-epsilon-flag ;
|
||||
|
||||
M: negation nfa-node ( node -- )
|
||||
negation-mode inc
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: accessors arrays assocs combinators io io.streams.string
|
|||
kernel math math.parser namespaces qualified sets
|
||||
quotations sequences splitting symbols vectors math.order
|
||||
unicode.categories strings regexp.backend regexp.utils
|
||||
unicode.case words ;
|
||||
unicode.case words locals ;
|
||||
IN: regexp.parser
|
||||
|
||||
FROM: math.ranges => [a,b] ;
|
||||
|
|
@ -44,18 +44,21 @@ TUPLE: character-class-range from to ; INSTANCE: character-class-range node
|
|||
SINGLETON: epsilon INSTANCE: epsilon node
|
||||
SINGLETON: any-char INSTANCE: any-char node
|
||||
SINGLETON: any-char-no-nl INSTANCE: any-char-no-nl node
|
||||
SINGLETON: front-anchor INSTANCE: front-anchor node
|
||||
SINGLETON: back-anchor INSTANCE: back-anchor node
|
||||
SINGLETON: beginning-of-input INSTANCE: beginning-of-input node
|
||||
SINGLETON: end-of-input INSTANCE: end-of-input node
|
||||
SINGLETON: beginning-of-line INSTANCE: beginning-of-line node
|
||||
SINGLETON: end-of-line INSTANCE: end-of-line node
|
||||
|
||||
TUPLE: option-on option ; INSTANCE: option-on node
|
||||
TUPLE: option-off option ; INSTANCE: option-off node
|
||||
SINGLETONS: unix-lines dotall multiline comments case-insensitive unicode-case reversed-regexp ;
|
||||
SINGLETONS: unix-lines dotall multiline comments case-insensitive
|
||||
unicode-case reversed-regexp ;
|
||||
|
||||
SINGLETONS: letter-class LETTER-class Letter-class digit-class
|
||||
alpha-class non-newline-blank-class
|
||||
ascii-class punctuation-class java-printable-class blank-class
|
||||
control-character-class hex-digit-class java-blank-class c-identifier-class
|
||||
unmatchable-class ;
|
||||
terminator-class unmatchable-class word-boundary-class ;
|
||||
|
||||
SINGLETONS: beginning-of-group end-of-group
|
||||
beginning-of-character-class end-of-character-class
|
||||
|
|
@ -231,20 +234,6 @@ ERROR: invalid-range a b ;
|
|||
[ [ nip at-most-n ] [ at-least-n ] if* ] if
|
||||
] [ drop 0 max exactly-n ] if ;
|
||||
|
||||
SINGLETON: beginning-of-input
|
||||
SINGLETON: end-of-input
|
||||
|
||||
: newlines ( -- obj1 obj2 obj3 )
|
||||
CHAR: \r <constant>
|
||||
CHAR: \n <constant>
|
||||
2dup 2array <concatenation> ;
|
||||
|
||||
: beginning-of-line ( -- obj )
|
||||
beginning-of-input newlines 4array <alternation> lookbehind boa ;
|
||||
|
||||
: end-of-line ( -- obj )
|
||||
end-of-input newlines 4array <alternation> lookahead boa ;
|
||||
|
||||
: handle-front-anchor ( -- )
|
||||
get-multiline beginning-of-line beginning-of-input ? push-stack ;
|
||||
|
||||
|
|
@ -281,13 +270,26 @@ ERROR: expected-posix-class ;
|
|||
: parse-control-character ( -- n ) read1 ;
|
||||
|
||||
ERROR: bad-escaped-literals seq ;
|
||||
: parse-escaped-literals ( -- obj )
|
||||
"\\E" read-until [ bad-escaped-literals ] unless
|
||||
|
||||
: parse-til-E ( -- obj )
|
||||
"\\E" read-until [ bad-escaped-literals ] unless ;
|
||||
|
||||
:: (parse-escaped-literals) ( quot: ( obj -- obj' ) -- obj )
|
||||
parse-til-E
|
||||
drop1
|
||||
[ epsilon ] [
|
||||
[ <constant> ] V{ } map-as
|
||||
[ quot call <constant> ] V{ } map-as
|
||||
first|concatenation
|
||||
] if-empty ;
|
||||
] if-empty ; inline
|
||||
|
||||
: parse-escaped-literals ( -- obj )
|
||||
[ ] (parse-escaped-literals) ;
|
||||
|
||||
: lower-case-literals ( -- obj )
|
||||
[ ch>lower ] (parse-escaped-literals) ;
|
||||
|
||||
: upper-case-literals ( -- obj )
|
||||
[ ch>upper ] (parse-escaped-literals) ;
|
||||
|
||||
: parse-escaped ( -- obj )
|
||||
read1
|
||||
|
|
@ -299,12 +301,12 @@ ERROR: bad-escaped-literals seq ;
|
|||
{ CHAR: a [ HEX: 7 <constant> ] }
|
||||
{ CHAR: e [ HEX: 1b <constant> ] }
|
||||
|
||||
{ CHAR: d [ digit-class ] }
|
||||
{ CHAR: D [ digit-class <negation> ] }
|
||||
{ CHAR: s [ java-blank-class ] }
|
||||
{ CHAR: S [ java-blank-class <negation> ] }
|
||||
{ CHAR: w [ c-identifier-class ] }
|
||||
{ CHAR: W [ c-identifier-class <negation> ] }
|
||||
{ CHAR: s [ java-blank-class ] }
|
||||
{ CHAR: S [ java-blank-class <negation> ] }
|
||||
{ CHAR: d [ digit-class ] }
|
||||
{ CHAR: D [ digit-class <negation> ] }
|
||||
|
||||
{ CHAR: p [ parse-posix-class ] }
|
||||
{ CHAR: P [ parse-posix-class <negation> ] }
|
||||
|
|
@ -313,13 +315,19 @@ ERROR: bad-escaped-literals seq ;
|
|||
{ CHAR: 0 [ parse-octal <constant> ] }
|
||||
{ CHAR: c [ parse-control-character ] }
|
||||
|
||||
! { CHAR: b [ handle-word-boundary ] }
|
||||
! { CHAR: B [ handle-word-boundary <negation> ] }
|
||||
! { CHAR: A [ handle-beginning-of-input ] }
|
||||
! { CHAR: G [ end of previous match ] }
|
||||
! { CHAR: Z [ handle-end-of-input ] }
|
||||
! { CHAR: z [ handle-end-of-input ] } ! except for terminator
|
||||
{ CHAR: Q [ parse-escaped-literals ] }
|
||||
|
||||
! { CHAR: b [ word-boundary-class ] }
|
||||
! { CHAR: B [ word-boundary-class <negation> ] }
|
||||
! { CHAR: A [ handle-beginning-of-input ] }
|
||||
! { CHAR: z [ handle-end-of-input ] }
|
||||
|
||||
! { CHAR: Z [ handle-end-of-input ] } ! plus a final terminator
|
||||
|
||||
! m//g mode
|
||||
! { CHAR: G [ end of previous match ] }
|
||||
|
||||
! Group capture
|
||||
! { CHAR: 1 [ CHAR: 1 <constant> ] }
|
||||
! { CHAR: 2 [ CHAR: 2 <constant> ] }
|
||||
! { CHAR: 3 [ CHAR: 3 <constant> ] }
|
||||
|
|
@ -330,7 +338,11 @@ ERROR: bad-escaped-literals seq ;
|
|||
! { CHAR: 8 [ CHAR: 8 <constant> ] }
|
||||
! { CHAR: 9 [ CHAR: 9 <constant> ] }
|
||||
|
||||
{ CHAR: Q [ parse-escaped-literals ] }
|
||||
! Perl extensions
|
||||
! can't do \l and \u because \u is already a 4-hex
|
||||
{ CHAR: L [ lower-case-literals ] }
|
||||
{ CHAR: U [ upper-case-literals ] }
|
||||
|
||||
[ <constant> ]
|
||||
} case ;
|
||||
|
||||
|
|
|
|||
|
|
@ -45,6 +45,7 @@ IN: regexp-tests
|
|||
! Off by default.
|
||||
[ f ] [ "\n" "." <regexp> matches? ] unit-test
|
||||
[ t ] [ "\n" "(?s)." <regexp> matches? ] unit-test
|
||||
[ t ] [ "\n" R/ ./s matches? ] unit-test
|
||||
[ f ] [ "\n\n" "(?s).(?-s)." <regexp> matches? ] unit-test
|
||||
|
||||
[ f ] [ "" ".+" <regexp> matches? ] unit-test
|
||||
|
|
@ -210,34 +211,34 @@ IN: regexp-tests
|
|||
[ 3 ] [ "aaacb" "a*" <regexp> match-head ] unit-test
|
||||
[ 2 ] [ "aaacb" "aa?" <regexp> match-head ] unit-test
|
||||
|
||||
[ t ] [ "aaa" "AAA" <iregexp> matches? ] unit-test
|
||||
[ f ] [ "aax" "AAA" <iregexp> matches? ] unit-test
|
||||
[ t ] [ "aaa" "A*" <iregexp> matches? ] unit-test
|
||||
[ f ] [ "aaba" "A*" <iregexp> matches? ] unit-test
|
||||
[ t ] [ "b" "[AB]" <iregexp> matches? ] unit-test
|
||||
[ f ] [ "c" "[AB]" <iregexp> matches? ] unit-test
|
||||
[ t ] [ "c" "[A-Z]" <iregexp> matches? ] unit-test
|
||||
[ f ] [ "3" "[A-Z]" <iregexp> matches? ] unit-test
|
||||
[ t ] [ "aaa" R/ AAA/i matches? ] unit-test
|
||||
[ f ] [ "aax" R/ AAA/i matches? ] unit-test
|
||||
[ t ] [ "aaa" R/ A*/i matches? ] unit-test
|
||||
[ f ] [ "aaba" R/ A*/i matches? ] unit-test
|
||||
[ t ] [ "b" R/ [AB]/i matches? ] unit-test
|
||||
[ f ] [ "c" R/ [AB]/i matches? ] unit-test
|
||||
[ t ] [ "c" R/ [A-Z]/i matches? ] unit-test
|
||||
[ f ] [ "3" R/ [A-Z]/i matches? ] unit-test
|
||||
|
||||
[ t ] [ "a" "(?i)a" <regexp> matches? ] unit-test
|
||||
[ t ] [ "a" "(?i)a" <regexp> matches? ] unit-test
|
||||
[ t ] [ "A" "(?i)a" <regexp> matches? ] unit-test
|
||||
[ t ] [ "A" "(?i)a" <regexp> matches? ] unit-test
|
||||
|
||||
[ t ] [ "a" "(?-i)a" <iregexp> matches? ] unit-test
|
||||
[ t ] [ "a" "(?-i)a" <iregexp> matches? ] unit-test
|
||||
[ f ] [ "A" "(?-i)a" <iregexp> matches? ] unit-test
|
||||
[ f ] [ "A" "(?-i)a" <iregexp> matches? ] unit-test
|
||||
[ t ] [ "a" R/ (?-i)a/i matches? ] unit-test
|
||||
[ t ] [ "a" R/ (?-i)a/i matches? ] unit-test
|
||||
[ f ] [ "A" R/ (?-i)a/i matches? ] unit-test
|
||||
[ f ] [ "A" R/ (?-i)a/i matches? ] unit-test
|
||||
|
||||
[ f ] [ "A" "[a-z]" <regexp> matches? ] unit-test
|
||||
[ t ] [ "A" "[a-z]" <iregexp> matches? ] unit-test
|
||||
[ t ] [ "A" R/ [a-z]/i matches? ] unit-test
|
||||
|
||||
[ f ] [ "A" "\\p{Lower}" <regexp> matches? ] unit-test
|
||||
[ t ] [ "A" "\\p{Lower}" <iregexp> matches? ] unit-test
|
||||
[ t ] [ "A" R/ \p{Lower}/i matches? ] unit-test
|
||||
|
||||
[ t ] [ "abc" <reversed> "abc" <rregexp> matches? ] unit-test
|
||||
[ t ] [ "abc" <reversed> "a[bB][cC]" <rregexp> matches? ] unit-test
|
||||
[ t ] [ "adcbe" "a(?r)(bcd)(?-r)e" <rregexp> matches? ] unit-test
|
||||
[ t ] [ "abc" <reversed> R/ abc/r matches? ] unit-test
|
||||
[ t ] [ "abc" <reversed> R/ a[bB][cC]/r matches? ] unit-test
|
||||
[ t ] [ "adcbe" R/ a(?r)(bcd)(?-r)e/r matches? ] unit-test
|
||||
|
||||
[ t ] [ "s@f" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
|
||||
[ f ] [ "a" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
|
||||
|
|
@ -293,6 +294,9 @@ IN: regexp-tests
|
|||
[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test
|
||||
|
||||
[ f ] [ "ab" "a(?!b)" <regexp> first-match ] unit-test
|
||||
[ "a" ] [ "ac" "a(?!b)" <regexp> first-match >string ] 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> first-match >string ] unit-test
|
||||
[ "a" ] [ "ba" "a(?<=b)(?<=b)" <regexp> first-match >string ] unit-test
|
||||
[ "a" ] [ "cab" "a(?=b)(?<=c)" <regexp> first-match >string ] unit-test
|
||||
|
|
@ -305,19 +309,65 @@ IN: regexp-tests
|
|||
|
||||
! [ "{Lower}" <regexp> ] [ invalid-range? ] must-fail-with
|
||||
|
||||
! [ 1 ] [ "aaacb" "a+?" <regexp> match-head ] unit-test
|
||||
! [ 1 ] [ "aaacb" "aa??" <regexp> match-head ] unit-test
|
||||
! [ f ] [ "aaaab" "a++ab" <regexp> matches? ] unit-test
|
||||
! [ t ] [ "aaacb" "a++cb" <regexp> matches? ] unit-test
|
||||
! [ 3 ] [ "aacb" "aa?c" <regexp> match-head ] unit-test
|
||||
! [ 3 ] [ "aacb" "aa??c" <regexp> match-head ] unit-test
|
||||
[ t ] [ "a" R/ ^a/ matches? ] unit-test
|
||||
[ f ] [ "\na" R/ ^a/ matches? ] unit-test
|
||||
[ f ] [ "\r\na" R/ ^a/ matches? ] unit-test
|
||||
[ f ] [ "\ra" R/ ^a/ matches? ] unit-test
|
||||
|
||||
! [ t ] [ "fxxbar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
|
||||
! [ f ] [ "foobar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
|
||||
[ t ] [ "a" R/ a$/ matches? ] unit-test
|
||||
[ f ] [ "a\n" R/ a$/ matches? ] unit-test
|
||||
[ f ] [ "a\r" R/ a$/ matches? ] unit-test
|
||||
[ f ] [ "a\r\n" R/ a$/ matches? ] unit-test
|
||||
|
||||
! [ t ] [ "a" R/ \Aa/ matches? ] unit-test
|
||||
! [ f ] [ "\na" R/ \Aaa/ matches? ] unit-test
|
||||
! [ f ] [ "\r\na" R/ \Aa/ matches? ] unit-test
|
||||
! [ f ] [ "\ra" R/ \Aa/ matches? ] unit-test
|
||||
|
||||
! [ t ] [ "a" R/ \Aa/m matches? ] unit-test
|
||||
! [ f ] [ "\na" R/ \Aaa/m matches? ] unit-test
|
||||
! [ f ] [ "\r\na" R/ \Aa/m matches? ] unit-test
|
||||
! [ f ] [ "\ra" R/ \Aa/m matches? ] unit-test
|
||||
|
||||
! [ t ] [ "\r\n\n\n\nam" R/ ^am/m matches? ] unit-test
|
||||
|
||||
! [ t ] [ "a" R/ \Aa\z/m matches? ] unit-test
|
||||
! [ f ] [ "a\n" R/ \Aa\z/m matches? ] unit-test
|
||||
|
||||
! [ t ] [ "a\r\n" R/ \Aa\Z/m matches? ] unit-test
|
||||
! [ t ] [ "a\n" R/ \Aa\Z/m matches? ] unit-test
|
||||
|
||||
! [ t ] [ "a" R/ \Aa\Z/m matches? ] unit-test
|
||||
! [ f ] [ "\na" R/ \Aaa\Z/m matches? ] unit-test
|
||||
! [ f ] [ "\r\na" R/ \Aa\Z/m matches? ] unit-test
|
||||
! [ f ] [ "\ra" R/ \Aa\Z/m matches? ] unit-test
|
||||
|
||||
! [ t ] [ "a" R/ ^a/m matches? ] unit-test
|
||||
! [ t ] [ "\na" R/ ^a/m matches? ] unit-test
|
||||
! [ t ] [ "\r\na" R/ ^a/m matches? ] unit-test
|
||||
! [ t ] [ "\ra" R/ ^a/m matches? ] unit-test
|
||||
|
||||
! Convert to lowercase until E
|
||||
[ f ] [ "AA" R/ \LAA\E/ matches? ] unit-test
|
||||
[ t ] [ "aa" R/ \LAA\E/ matches? ] unit-test
|
||||
|
||||
! Convert to uppercase until E
|
||||
[ t ] [ "AA" R/ \Uaa\E/ matches? ] unit-test
|
||||
[ f ] [ "aa" R/ \Uaa\E/ matches? ] unit-test
|
||||
|
||||
! [ t ] [ "a" "a$" R/ a$/m matches? ] unit-test
|
||||
! [ t ] [ "a\n" "a$" R/ a$/m matches? ] unit-test
|
||||
! [ t ] [ "a\r" "a$" R/ a$/m matches? ] unit-test
|
||||
! [ t ] [ "a\r\n" "a$" R/ a$/m matches? ] unit-test
|
||||
|
||||
! [ f ] [ "foobxr" "foo\\z" <regexp> match-head ] unit-test
|
||||
! [ 3 ] [ "foo" "foo\\z" <regexp> match-head ] unit-test
|
||||
|
||||
! [ t ] [ "foo" "\\bfoo\\b" <regexp> matches? ] unit-test
|
||||
! [ t ] [ "afoob" "\\Bfoo\\B" <regexp> matches? ] unit-test
|
||||
! [ t ] [ "afoob" "\\bfoo\\b" <regexp> matches? ] unit-test
|
||||
! [ f ] [ "foo" "\\Bfoo\\B" <regexp> matches? ] unit-test
|
||||
|
||||
! [ 3 ] [ "foo bar" "foo\\b" <regexp> match-head ] unit-test
|
||||
! [ f ] [ "fooxbar" "foo\\b" <regexp> matches? ] unit-test
|
||||
! [ t ] [ "foo" "foo\\b" <regexp> matches? ] unit-test
|
||||
|
|
@ -332,34 +382,29 @@ IN: regexp-tests
|
|||
! [ t ] [ "fooxbar" "foo\\Bxbar" <regexp> matches? ] unit-test
|
||||
! [ f ] [ "foo" "foo\\Bbar" <regexp> matches? ] unit-test
|
||||
|
||||
! clear "a(?=b*)" <regexp> "ab" over match
|
||||
! clear "a(?=b*c)" <regexp> "abbbbbc" over match
|
||||
! clear "a(?=b*)" <regexp> "ab" over match
|
||||
! [ 1 ] [ "aaacb" "a+?" <regexp> match-head ] unit-test
|
||||
! [ 1 ] [ "aaacb" "aa??" <regexp> match-head ] unit-test
|
||||
! [ f ] [ "aaaab" "a++ab" <regexp> matches? ] unit-test
|
||||
! [ t ] [ "aaacb" "a++cb" <regexp> matches? ] unit-test
|
||||
! [ 3 ] [ "aacb" "aa?c" <regexp> match-head ] unit-test
|
||||
! [ 3 ] [ "aacb" "aa??c" <regexp> match-head ] unit-test
|
||||
|
||||
! clear "^a" <regexp> "a" over match
|
||||
! clear "^a" <regexp> "\na" over match
|
||||
! clear "^a" <regexp> "\r\na" over match
|
||||
! clear "^a" <regexp> "\ra" over match
|
||||
! "ab" "a(?=b*)" <regexp> match
|
||||
! "abbbbbc" "a(?=b*c)" <regexp> match
|
||||
! "ab" "a(?=b*)" <regexp> match
|
||||
|
||||
! clear "a$" <regexp> "a" over match
|
||||
! clear "a$" <regexp> "a\n" over match
|
||||
! clear "a$" <regexp> "a\r" over match
|
||||
! clear "a$" <regexp> "a\r\n" over match
|
||||
! "baz" "(az)(?<=b)" <regexp> first-match
|
||||
! "cbaz" "a(?<=b*)" <regexp> first-match
|
||||
! "baz" "a(?<=b)" <regexp> first-match
|
||||
|
||||
! "(az)(?<=b)" <regexp> "baz" over first-match
|
||||
! "a(?<=b*)" <regexp> "cbaz" over first-match
|
||||
! "a(?<=b)" <regexp> "baz" over first-match
|
||||
! "baz" "a(?<!b)" <regexp> first-match
|
||||
! "caz" "a(?<!b)" <regexp> first-match
|
||||
|
||||
! "a(?<!b)" <regexp> "baz" over first-match
|
||||
! "a(?<!b)" <regexp> "caz" over first-match
|
||||
! "abcdefg" "a(?=bcdefg)bcd" <regexp> first-match
|
||||
! "abcdefg" "a(?#bcdefg)bcd" <regexp> first-match
|
||||
! "abcdefg" "a(?:bcdefg)" <regexp> first-match
|
||||
|
||||
! "a(?=bcdefg)bcd" <regexp> "abcdefg" over first-match
|
||||
! "a(?#bcdefg)bcd" <regexp> "abcdefg" over first-match
|
||||
! "a(?:bcdefg)" <regexp> "abcdefg" over first-match
|
||||
|
||||
[ "a" ] [ "ac" "a(?!b)" <regexp> first-match >string ] unit-test
|
||||
|
||||
! "a(?<=b)" <regexp> "caba" over first-match
|
||||
! "caba" "a(?<=b)" <regexp> first-match
|
||||
|
||||
! capture group 1: "aaaa" 2: ""
|
||||
! "aaaa" "(a*)(a*)" <regexp> match*
|
||||
|
|
|
|||
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators kernel math sequences
|
||||
USING: accessors combinators kernel math sequences strings
|
||||
sets assocs prettyprint.backend make lexer namespaces parser
|
||||
arrays fry regexp.backend regexp.utils regexp.parser regexp.nfa
|
||||
regexp.dfa regexp.traversal regexp.transition-tables splitting ;
|
||||
regexp.dfa regexp.traversal regexp.transition-tables splitting
|
||||
sorting ;
|
||||
IN: regexp
|
||||
|
||||
: default-regexp ( string -- regexp )
|
||||
|
|
@ -75,40 +76,7 @@ IN: regexp
|
|||
: count-matches ( string regexp -- n )
|
||||
all-matches length ;
|
||||
|
||||
: initial-option ( regexp option -- regexp' )
|
||||
over options>> conjoin ;
|
||||
|
||||
: <regexp> ( string -- regexp )
|
||||
default-regexp construct-regexp ;
|
||||
|
||||
: <iregexp> ( string -- regexp )
|
||||
default-regexp
|
||||
case-insensitive initial-option
|
||||
construct-regexp ;
|
||||
|
||||
: <rregexp> ( string -- regexp )
|
||||
default-regexp
|
||||
reversed-regexp initial-option
|
||||
construct-regexp ;
|
||||
|
||||
: parsing-regexp ( accum end -- accum )
|
||||
lexer get dup skip-blank
|
||||
[ [ index-from dup 1+ swap ] 2keep swapd subseq swap ] change-lexer-column
|
||||
lexer get dup still-parsing-line?
|
||||
[ (parse-token) ] [ drop f ] if
|
||||
"i" = [ <iregexp> ] [ <regexp> ] if parsed ;
|
||||
|
||||
: R! CHAR: ! parsing-regexp ; parsing
|
||||
: R" CHAR: " parsing-regexp ; parsing
|
||||
: R# CHAR: # parsing-regexp ; parsing
|
||||
: R' CHAR: ' parsing-regexp ; parsing
|
||||
: R( CHAR: ) parsing-regexp ; parsing
|
||||
: R/ CHAR: / parsing-regexp ; parsing
|
||||
: R@ CHAR: @ parsing-regexp ; parsing
|
||||
: R[ CHAR: ] parsing-regexp ; parsing
|
||||
: R` CHAR: ` parsing-regexp ; parsing
|
||||
: R{ CHAR: } parsing-regexp ; parsing
|
||||
: R| CHAR: | parsing-regexp ; parsing
|
||||
<PRIVATE
|
||||
|
||||
: find-regexp-syntax ( string -- prefix suffix )
|
||||
{
|
||||
|
|
@ -125,14 +93,67 @@ IN: regexp
|
|||
{ "R| " "|" }
|
||||
} swap [ subseq? not nip ] curry assoc-find drop ;
|
||||
|
||||
: option? ( option regexp -- ? )
|
||||
options>> key? ;
|
||||
ERROR: unknown-regexp-option option ;
|
||||
|
||||
: option>ch ( option -- string )
|
||||
{
|
||||
{ case-insensitive [ CHAR: i ] }
|
||||
{ multiline [ CHAR: m ] }
|
||||
{ reversed-regexp [ CHAR: r ] }
|
||||
{ dotall [ CHAR: s ] }
|
||||
[ unknown-regexp-option ]
|
||||
} case ;
|
||||
|
||||
: ch>option ( ch -- option )
|
||||
{
|
||||
{ CHAR: i [ case-insensitive ] }
|
||||
{ CHAR: m [ multiline ] }
|
||||
{ CHAR: r [ reversed-regexp ] }
|
||||
{ CHAR: s [ dotall ] }
|
||||
[ unknown-regexp-option ]
|
||||
} case ;
|
||||
|
||||
: string>options ( string -- options )
|
||||
[ ch>option dup ] H{ } map>assoc ;
|
||||
|
||||
: options>string ( options -- string )
|
||||
keys [ option>ch ] map natural-sort >string ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: <optioned-regexp> ( string option-string -- regexp )
|
||||
[ default-regexp ] [ string>options ] bi* >>options
|
||||
construct-regexp ;
|
||||
|
||||
: <regexp> ( string -- regexp ) "" <optioned-regexp> ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: parsing-regexp ( accum end -- accum )
|
||||
lexer get dup skip-blank
|
||||
[ [ index-from dup 1+ swap ] 2keep swapd subseq swap ] change-lexer-column
|
||||
lexer get dup still-parsing-line?
|
||||
[ (parse-token) ] [ drop f ] if
|
||||
<optioned-regexp> parsed ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: R! CHAR: ! parsing-regexp ; parsing
|
||||
: R" CHAR: " parsing-regexp ; parsing
|
||||
: R# CHAR: # parsing-regexp ; parsing
|
||||
: R' CHAR: ' parsing-regexp ; parsing
|
||||
: R( CHAR: ) parsing-regexp ; parsing
|
||||
: R/ CHAR: / parsing-regexp ; parsing
|
||||
: R@ CHAR: @ parsing-regexp ; parsing
|
||||
: R[ CHAR: ] parsing-regexp ; parsing
|
||||
: R` CHAR: ` parsing-regexp ; parsing
|
||||
: R{ CHAR: } parsing-regexp ; parsing
|
||||
: R| CHAR: | parsing-regexp ; parsing
|
||||
|
||||
M: regexp pprint*
|
||||
[
|
||||
[
|
||||
dup raw>>
|
||||
dup find-regexp-syntax swap % swap % %
|
||||
case-insensitive swap option? [ "i" % ] when
|
||||
[ raw>> dup find-regexp-syntax swap % swap % % ]
|
||||
[ options>> options>string % ] bi
|
||||
] "" make
|
||||
] keep present-text ;
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ TUPLE: dfa-traverser
|
|||
capture-group-index
|
||||
last-state current-state
|
||||
text
|
||||
match-failed?
|
||||
start-index current-index
|
||||
matches ;
|
||||
|
||||
|
|
@ -37,14 +38,20 @@ TUPLE: dfa-traverser
|
|||
H{ } clone >>captured-groups ;
|
||||
|
||||
: final-state? ( dfa-traverser -- ? )
|
||||
[ current-state>> ] [ dfa-table>> final-states>> ] bi
|
||||
key? ;
|
||||
[ current-state>> ]
|
||||
[ dfa-table>> final-states>> ] bi key? ;
|
||||
|
||||
: beginning-of-text? ( dfa-traverser -- ? )
|
||||
current-index>> 0 <= ; inline
|
||||
|
||||
: end-of-text? ( dfa-traverser -- ? )
|
||||
[ current-index>> ] [ text>> length ] bi >= ; inline
|
||||
|
||||
: text-finished? ( dfa-traverser -- ? )
|
||||
{
|
||||
[ current-state>> empty? ]
|
||||
[ [ current-index>> ] [ text>> length ] bi >= ]
|
||||
! [ current-index>> 0 < ]
|
||||
[ end-of-text? ]
|
||||
[ match-failed?>> ]
|
||||
} 1|| ;
|
||||
|
||||
: save-final-state ( dfa-straverser -- )
|
||||
|
|
@ -55,8 +62,47 @@ TUPLE: dfa-traverser
|
|||
dup save-final-state
|
||||
] when text-finished? ;
|
||||
|
||||
: previous-text-character ( dfa-traverser -- ch )
|
||||
[ text>> ] [ current-index>> 1- ] bi nth ;
|
||||
|
||||
: current-text-character ( dfa-traverser -- ch )
|
||||
[ text>> ] [ current-index>> ] bi nth ;
|
||||
|
||||
: next-text-character ( dfa-traverser -- ch )
|
||||
[ text>> ] [ current-index>> 1+ ] bi nth ;
|
||||
|
||||
GENERIC: flag-action ( dfa-traverser flag -- )
|
||||
|
||||
|
||||
M: beginning-of-input flag-action ( dfa-traverser flag -- )
|
||||
drop
|
||||
dup beginning-of-text? [ t >>match-failed? ] unless drop ;
|
||||
|
||||
M: end-of-input flag-action ( dfa-traverser flag -- )
|
||||
drop
|
||||
dup end-of-text? [ t >>match-failed? ] unless drop ;
|
||||
|
||||
M: beginning-of-line flag-action ( dfa-traverser flag -- )
|
||||
drop
|
||||
dup {
|
||||
[ beginning-of-text? ]
|
||||
[ previous-text-character terminator-class class-member? ]
|
||||
} 1|| [ t >>match-failed? ] unless drop ;
|
||||
|
||||
M: end-of-line flag-action ( dfa-traverser flag -- )
|
||||
drop
|
||||
dup {
|
||||
[ end-of-text? ]
|
||||
[ next-text-character terminator-class class-member? ]
|
||||
} 1|| [ t >>match-failed? ] unless drop ;
|
||||
|
||||
M: word-boundary flag-action ( dfa-traverser flag -- )
|
||||
drop
|
||||
dup {
|
||||
[ end-of-text? ]
|
||||
[ current-text-character terminator-class class-member? ]
|
||||
} 1|| [ t >>match-failed? ] unless drop ;
|
||||
|
||||
M: lookahead-on flag-action ( dfa-traverser flag -- )
|
||||
drop
|
||||
lookahead-counters>> 0 swap push ;
|
||||
|
|
@ -110,11 +156,7 @@ M: capture-group-off flag-action ( dfa-traverser flag -- )
|
|||
[ [ 1+ ] change-current-index ]
|
||||
[ [ 1- ] change-current-index ] if
|
||||
dup current-state>> >>last-state
|
||||
] dip
|
||||
first >>current-state ;
|
||||
|
||||
: match-failed ( dfa-traverser -- dfa-traverser )
|
||||
V{ } clone >>matches ;
|
||||
] [ first ] bi* >>current-state ;
|
||||
|
||||
: match-literal ( transition from-state table -- to-state/f )
|
||||
transitions>> at at ;
|
||||
|
|
@ -131,11 +173,9 @@ M: capture-group-off flag-action ( dfa-traverser flag -- )
|
|||
{ [ match-literal ] [ match-class ] [ match-default ] } 3|| ;
|
||||
|
||||
: setup-match ( match -- obj state dfa-table )
|
||||
{
|
||||
[ current-index>> ] [ text>> ]
|
||||
[ current-state>> ] [ dfa-table>> ]
|
||||
} cleave
|
||||
[ nth ] 2dip ;
|
||||
[ [ current-index>> ] [ text>> ] bi nth ]
|
||||
[ current-state>> ]
|
||||
[ dfa-table>> ] tri ;
|
||||
|
||||
: do-match ( dfa-traverser -- dfa-traverser )
|
||||
dup process-flags
|
||||
|
|
|
|||
Loading…
Reference in New Issue