diff --git a/extra/regexp/regexp-tests.factor b/extra/regexp/regexp-tests.factor index 5cec0af0a9..d76b038ffa 100755 --- a/extra/regexp/regexp-tests.factor +++ b/extra/regexp/regexp-tests.factor @@ -1,174 +1,201 @@ -USING: regexp tools.test ; +USING: regexp tools.test kernel ; IN: regexp-tests -[ f ] [ "b" "a*" matches? ] unit-test -[ t ] [ "" "a*" matches? ] unit-test -[ t ] [ "a" "a*" matches? ] unit-test -[ t ] [ "aaaaaaa" "a*" matches? ] unit-test -[ f ] [ "ab" "a*" matches? ] unit-test +[ f ] [ "b" "a*" f matches? ] unit-test +[ t ] [ "" "a*" f matches? ] unit-test +[ t ] [ "a" "a*" f matches? ] unit-test +[ t ] [ "aaaaaaa" "a*" f matches? ] unit-test +[ f ] [ "ab" "a*" f matches? ] unit-test -[ t ] [ "abc" "abc" matches? ] unit-test -[ t ] [ "a" "a|b|c" matches? ] unit-test -[ t ] [ "b" "a|b|c" matches? ] unit-test -[ t ] [ "c" "a|b|c" matches? ] unit-test -[ f ] [ "c" "d|e|f" matches? ] unit-test +[ t ] [ "abc" "abc" f matches? ] unit-test +[ t ] [ "a" "a|b|c" f matches? ] unit-test +[ t ] [ "b" "a|b|c" f matches? ] unit-test +[ t ] [ "c" "a|b|c" f matches? ] unit-test +[ f ] [ "c" "d|e|f" f matches? ] unit-test -[ f ] [ "aa" "a|b|c" matches? ] unit-test -[ f ] [ "bb" "a|b|c" matches? ] unit-test -[ f ] [ "cc" "a|b|c" matches? ] unit-test -[ f ] [ "cc" "d|e|f" matches? ] unit-test +[ f ] [ "aa" "a|b|c" f matches? ] unit-test +[ f ] [ "bb" "a|b|c" f matches? ] unit-test +[ f ] [ "cc" "a|b|c" f matches? ] unit-test +[ f ] [ "cc" "d|e|f" f matches? ] unit-test -[ f ] [ "" "a+" matches? ] unit-test -[ t ] [ "a" "a+" matches? ] unit-test -[ t ] [ "aa" "a+" matches? ] unit-test +[ f ] [ "" "a+" f matches? ] unit-test +[ t ] [ "a" "a+" f matches? ] unit-test +[ t ] [ "aa" "a+" f matches? ] unit-test -[ t ] [ "" "a?" matches? ] unit-test -[ t ] [ "a" "a?" matches? ] unit-test -[ f ] [ "aa" "a?" matches? ] unit-test +[ t ] [ "" "a?" f matches? ] unit-test +[ t ] [ "a" "a?" f matches? ] unit-test +[ f ] [ "aa" "a?" f matches? ] unit-test -[ f ] [ "" "." matches? ] unit-test -[ t ] [ "a" "." matches? ] unit-test -[ t ] [ "." "." matches? ] unit-test -! [ f ] [ "\n" "." matches? ] unit-test +[ f ] [ "" "." f matches? ] unit-test +[ t ] [ "a" "." f matches? ] unit-test +[ t ] [ "." "." f matches? ] unit-test +! [ f ] [ "\n" "." f matches? ] unit-test -[ f ] [ "" ".+" matches? ] unit-test -[ t ] [ "a" ".+" matches? ] unit-test -[ t ] [ "ab" ".+" matches? ] unit-test +[ f ] [ "" ".+" f matches? ] unit-test +[ t ] [ "a" ".+" f matches? ] unit-test +[ t ] [ "ab" ".+" f matches? ] unit-test -[ t ] [ "" "a|b*|c+|d?" matches? ] unit-test -[ t ] [ "a" "a|b*|c+|d?" matches? ] unit-test -[ t ] [ "c" "a|b*|c+|d?" matches? ] unit-test -[ t ] [ "cc" "a|b*|c+|d?" matches? ] unit-test -[ f ] [ "ccd" "a|b*|c+|d?" matches? ] unit-test -[ t ] [ "d" "a|b*|c+|d?" matches? ] unit-test +[ t ] [ "" "a|b*|c+|d?" f matches? ] unit-test +[ t ] [ "a" "a|b*|c+|d?" f matches? ] unit-test +[ t ] [ "c" "a|b*|c+|d?" f matches? ] unit-test +[ t ] [ "cc" "a|b*|c+|d?" f matches? ] unit-test +[ f ] [ "ccd" "a|b*|c+|d?" f matches? ] unit-test +[ t ] [ "d" "a|b*|c+|d?" f matches? ] unit-test -[ t ] [ "foo" "foo|bar" matches? ] unit-test -[ t ] [ "bar" "foo|bar" matches? ] unit-test -[ f ] [ "foobar" "foo|bar" matches? ] unit-test +[ t ] [ "foo" "foo|bar" f matches? ] unit-test +[ t ] [ "bar" "foo|bar" f matches? ] unit-test +[ f ] [ "foobar" "foo|bar" f matches? ] unit-test -[ f ] [ "" "(a)" matches? ] unit-test -[ t ] [ "a" "(a)" matches? ] unit-test -[ f ] [ "aa" "(a)" matches? ] unit-test -[ t ] [ "aa" "(a*)" matches? ] unit-test +[ f ] [ "" "(a)" f matches? ] unit-test +[ t ] [ "a" "(a)" f matches? ] unit-test +[ f ] [ "aa" "(a)" f matches? ] unit-test +[ t ] [ "aa" "(a*)" f matches? ] unit-test -[ f ] [ "aababaaabbac" "(a|b)+" matches? ] unit-test -[ t ] [ "ababaaabba" "(a|b)+" matches? ] unit-test +[ f ] [ "aababaaabbac" "(a|b)+" f matches? ] unit-test +[ t ] [ "ababaaabba" "(a|b)+" f matches? ] unit-test -[ f ] [ "" "a{1}" matches? ] unit-test -[ t ] [ "a" "a{1}" matches? ] unit-test -[ f ] [ "aa" "a{1}" matches? ] unit-test +[ f ] [ "" "a{1}" f matches? ] unit-test +[ t ] [ "a" "a{1}" f matches? ] unit-test +[ f ] [ "aa" "a{1}" f matches? ] unit-test -[ f ] [ "a" "a{2,}" matches? ] unit-test -[ t ] [ "aaa" "a{2,}" matches? ] unit-test -[ t ] [ "aaaa" "a{2,}" matches? ] unit-test -[ t ] [ "aaaaa" "a{2,}" matches? ] unit-test +[ f ] [ "a" "a{2,}" f matches? ] unit-test +[ t ] [ "aaa" "a{2,}" f matches? ] unit-test +[ t ] [ "aaaa" "a{2,}" f matches? ] unit-test +[ t ] [ "aaaaa" "a{2,}" f matches? ] unit-test -[ t ] [ "" "a{,2}" matches? ] unit-test -[ t ] [ "a" "a{,2}" matches? ] unit-test -[ t ] [ "aa" "a{,2}" matches? ] unit-test -[ f ] [ "aaa" "a{,2}" matches? ] unit-test -[ f ] [ "aaaa" "a{,2}" matches? ] unit-test -[ f ] [ "aaaaa" "a{,2}" matches? ] unit-test +[ t ] [ "" "a{,2}" f matches? ] unit-test +[ t ] [ "a" "a{,2}" f matches? ] unit-test +[ t ] [ "aa" "a{,2}" f matches? ] unit-test +[ f ] [ "aaa" "a{,2}" f matches? ] unit-test +[ f ] [ "aaaa" "a{,2}" f matches? ] unit-test +[ f ] [ "aaaaa" "a{,2}" f matches? ] unit-test -[ f ] [ "" "a{1,3}" matches? ] unit-test -[ t ] [ "a" "a{1,3}" matches? ] unit-test -[ t ] [ "aa" "a{1,3}" matches? ] unit-test -[ t ] [ "aaa" "a{1,3}" matches? ] unit-test -[ f ] [ "aaaa" "a{1,3}" matches? ] unit-test +[ f ] [ "" "a{1,3}" f matches? ] unit-test +[ t ] [ "a" "a{1,3}" f matches? ] unit-test +[ t ] [ "aa" "a{1,3}" f matches? ] unit-test +[ t ] [ "aaa" "a{1,3}" f matches? ] unit-test +[ f ] [ "aaaa" "a{1,3}" f matches? ] unit-test -[ f ] [ "" "[a]" matches? ] unit-test -[ t ] [ "a" "[a]" matches? ] unit-test -[ t ] [ "a" "[abc]" matches? ] unit-test -[ f ] [ "b" "[a]" matches? ] unit-test -[ f ] [ "d" "[abc]" matches? ] unit-test -[ t ] [ "ab" "[abc]{1,2}" matches? ] unit-test -[ f ] [ "abc" "[abc]{1,2}" matches? ] unit-test +[ f ] [ "" "[a]" f matches? ] unit-test +[ t ] [ "a" "[a]" f matches? ] unit-test +[ t ] [ "a" "[abc]" f matches? ] unit-test +[ f ] [ "b" "[a]" f matches? ] unit-test +[ f ] [ "d" "[abc]" f matches? ] unit-test +[ t ] [ "ab" "[abc]{1,2}" f matches? ] unit-test +[ f ] [ "abc" "[abc]{1,2}" f matches? ] unit-test -[ f ] [ "" "[^a]" matches? ] unit-test -[ f ] [ "a" "[^a]" matches? ] unit-test -[ f ] [ "a" "[^abc]" matches? ] unit-test -[ t ] [ "b" "[^a]" matches? ] unit-test -[ t ] [ "d" "[^abc]" matches? ] unit-test -[ f ] [ "ab" "[^abc]{1,2}" matches? ] unit-test -[ f ] [ "abc" "[^abc]{1,2}" matches? ] unit-test +[ f ] [ "" "[^a]" f matches? ] unit-test +[ f ] [ "a" "[^a]" f matches? ] unit-test +[ f ] [ "a" "[^abc]" f matches? ] unit-test +[ t ] [ "b" "[^a]" f matches? ] unit-test +[ t ] [ "d" "[^abc]" f matches? ] unit-test +[ f ] [ "ab" "[^abc]{1,2}" f matches? ] unit-test +[ f ] [ "abc" "[^abc]{1,2}" f matches? ] unit-test -[ t ] [ "]" "[]]" matches? ] unit-test -[ f ] [ "]" "[^]]" matches? ] unit-test +[ t ] [ "]" "[]]" f matches? ] unit-test +[ f ] [ "]" "[^]]" f matches? ] unit-test -! [ "^" "[^]" matches? ] unit-test-fails -[ t ] [ "^" "[]^]" matches? ] unit-test -[ t ] [ "]" "[]^]" matches? ] unit-test +! [ "^" "[^]" f matches? ] unit-test-fails +[ t ] [ "^" "[]^]" f matches? ] unit-test +[ t ] [ "]" "[]^]" f matches? ] unit-test -[ t ] [ "[" "[[]" matches? ] unit-test -[ f ] [ "^" "[^^]" matches? ] unit-test -[ t ] [ "a" "[^^]" matches? ] unit-test +[ t ] [ "[" "[[]" f matches? ] unit-test +[ f ] [ "^" "[^^]" f matches? ] unit-test +[ t ] [ "a" "[^^]" f matches? ] unit-test -[ t ] [ "-" "[-]" matches? ] unit-test -[ f ] [ "a" "[-]" matches? ] unit-test -[ f ] [ "-" "[^-]" matches? ] unit-test -[ t ] [ "a" "[^-]" matches? ] unit-test +[ t ] [ "-" "[-]" f matches? ] unit-test +[ f ] [ "a" "[-]" f matches? ] unit-test +[ f ] [ "-" "[^-]" f matches? ] unit-test +[ t ] [ "a" "[^-]" f matches? ] unit-test -[ t ] [ "-" "[-a]" matches? ] unit-test -[ t ] [ "a" "[-a]" matches? ] unit-test -[ t ] [ "-" "[a-]" matches? ] unit-test -[ t ] [ "a" "[a-]" matches? ] unit-test -[ f ] [ "b" "[a-]" matches? ] unit-test -[ f ] [ "-" "[^-]" matches? ] unit-test -[ t ] [ "a" "[^-]" matches? ] unit-test +[ t ] [ "-" "[-a]" f matches? ] unit-test +[ t ] [ "a" "[-a]" f matches? ] unit-test +[ t ] [ "-" "[a-]" f matches? ] unit-test +[ t ] [ "a" "[a-]" f matches? ] unit-test +[ f ] [ "b" "[a-]" f matches? ] unit-test +[ f ] [ "-" "[^-]" f matches? ] unit-test +[ t ] [ "a" "[^-]" f matches? ] unit-test -[ f ] [ "-" "[a-c]" matches? ] unit-test -[ t ] [ "-" "[^a-c]" matches? ] unit-test -[ t ] [ "b" "[a-c]" matches? ] unit-test -[ f ] [ "b" "[^a-c]" matches? ] unit-test +[ f ] [ "-" "[a-c]" f matches? ] unit-test +[ t ] [ "-" "[^a-c]" f matches? ] unit-test +[ t ] [ "b" "[a-c]" f matches? ] unit-test +[ f ] [ "b" "[^a-c]" f matches? ] unit-test -[ t ] [ "-" "[a-c-]" matches? ] unit-test -[ f ] [ "-" "[^a-c-]" matches? ] unit-test +[ t ] [ "-" "[a-c-]" f matches? ] unit-test +[ f ] [ "-" "[^a-c-]" f matches? ] unit-test -[ t ] [ "\\" "[\\\\]" matches? ] unit-test -[ f ] [ "a" "[\\\\]" matches? ] unit-test -[ f ] [ "\\" "[^\\\\]" matches? ] unit-test -[ t ] [ "a" "[^\\\\]" matches? ] unit-test +[ t ] [ "\\" "[\\\\]" f matches? ] unit-test +[ f ] [ "a" "[\\\\]" f matches? ] unit-test +[ f ] [ "\\" "[^\\\\]" f matches? ] unit-test +[ t ] [ "a" "[^\\\\]" f matches? ] unit-test -[ t ] [ "0" "[\\d]" matches? ] unit-test -[ f ] [ "a" "[\\d]" matches? ] unit-test -[ f ] [ "0" "[^\\d]" matches? ] unit-test -[ t ] [ "a" "[^\\d]" matches? ] unit-test +[ t ] [ "0" "[\\d]" f matches? ] unit-test +[ f ] [ "a" "[\\d]" f matches? ] unit-test +[ f ] [ "0" "[^\\d]" f matches? ] unit-test +[ t ] [ "a" "[^\\d]" f matches? ] unit-test -[ t ] [ "a" "[a-z]{1,}|[A-Z]{2,4}|b*|c|(f|g)*" matches? ] unit-test -[ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}|b*|c|(f|g)*" matches? ] unit-test -[ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}" matches? ] unit-test +[ t ] [ "a" "[a-z]{1,}|[A-Z]{2,4}|b*|c|(f|g)*" f matches? ] unit-test +[ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}|b*|c|(f|g)*" f matches? ] unit-test +[ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}" f matches? ] unit-test -[ t ] [ "1000" "\\d{4,6}" matches? ] unit-test -[ t ] [ "1000" "[0-9]{4,6}" matches? ] unit-test +[ t ] [ "1000" "\\d{4,6}" f matches? ] unit-test +[ t ] [ "1000" "[0-9]{4,6}" f matches? ] unit-test -[ t ] [ "abc" "\\p{Lower}{3}" matches? ] unit-test -[ f ] [ "ABC" "\\p{Lower}{3}" matches? ] unit-test -[ t ] [ "ABC" "\\p{Upper}{3}" matches? ] unit-test -[ f ] [ "abc" "\\p{Upper}{3}" matches? ] unit-test +[ t ] [ "abc" "\\p{Lower}{3}" f matches? ] unit-test +[ f ] [ "ABC" "\\p{Lower}{3}" f matches? ] unit-test +[ t ] [ "ABC" "\\p{Upper}{3}" f matches? ] unit-test +[ f ] [ "abc" "\\p{Upper}{3}" f matches? ] unit-test -[ f ] [ "abc" "[\\p{Upper}]{3}" matches? ] unit-test -[ t ] [ "ABC" "[\\p{Upper}]{3}" matches? ] unit-test +[ f ] [ "abc" "[\\p{Upper}]{3}" f matches? ] unit-test +[ t ] [ "ABC" "[\\p{Upper}]{3}" f matches? ] unit-test -[ t ] [ "" "\\Q\\E" matches? ] unit-test -[ f ] [ "a" "\\Q\\E" matches? ] unit-test -[ t ] [ "|*+" "\\Q|*+\\E" matches? ] unit-test -[ f ] [ "abc" "\\Q|*+\\E" matches? ] unit-test +[ t ] [ "" "\\Q\\E" f matches? ] unit-test +[ f ] [ "a" "\\Q\\E" f matches? ] unit-test +[ t ] [ "|*+" "\\Q|*+\\E" f matches? ] unit-test +[ f ] [ "abc" "\\Q|*+\\E" f matches? ] unit-test -[ t ] [ "S" "\\0123" matches? ] unit-test -[ t ] [ "SXY" "\\0123XY" matches? ] unit-test -[ t ] [ "x" "\\x78" matches? ] unit-test -[ f ] [ "y" "\\x78" matches? ] unit-test -[ t ] [ "x" "\\u0078" matches? ] unit-test -[ f ] [ "y" "\\u0078" matches? ] unit-test +[ t ] [ "S" "\\0123" f matches? ] unit-test +[ t ] [ "SXY" "\\0123XY" f matches? ] unit-test +[ t ] [ "x" "\\x78" f matches? ] unit-test +[ f ] [ "y" "\\x78" f matches? ] unit-test +[ t ] [ "x" "\\u0078" f matches? ] unit-test +[ f ] [ "y" "\\u0078" f matches? ] unit-test -[ t ] [ "ab" "a+b" matches? ] unit-test -[ f ] [ "b" "a+b" matches? ] unit-test -[ t ] [ "aab" "a+b" matches? ] unit-test -[ f ] [ "abb" "a+b" matches? ] unit-test +[ t ] [ "ab" "a+b" f matches? ] unit-test +[ f ] [ "b" "a+b" f matches? ] unit-test +[ t ] [ "aab" "a+b" f matches? ] unit-test +[ f ] [ "abb" "a+b" f matches? ] unit-test -[ t ] [ "abbbb" "ab*" matches? ] unit-test -[ t ] [ "a" "ab*" matches? ] unit-test -[ f ] [ "abab" "ab*" matches? ] unit-test +[ t ] [ "abbbb" "ab*" f matches? ] unit-test +[ t ] [ "a" "ab*" f matches? ] unit-test +[ f ] [ "abab" "ab*" f matches? ] unit-test -[ f ] [ "x" "\\." matches? ] unit-test -[ t ] [ "." "\\." matches? ] unit-test +[ f ] [ "x" "\\." f matches? ] unit-test +[ t ] [ "." "\\." f matches? ] unit-test + +[ t ] [ "aaaab" "a+ab" f matches? ] unit-test +[ f ] [ "aaaxb" "a+ab" f matches? ] unit-test +[ t ] [ "aaacb" "a+cb" f matches? ] unit-test +[ f ] [ "aaaab" "a++ab" f matches? ] unit-test +[ t ] [ "aaacb" "a++cb" f matches? ] unit-test + +[ 3 ] [ "aaacb" "a*" f match-head ] unit-test +[ 1 ] [ "aaacb" "a+?" f match-head ] unit-test +[ 2 ] [ "aaacb" "aa?" f match-head ] unit-test +[ 1 ] [ "aaacb" "aa??" f match-head ] unit-test +[ 3 ] [ "aacb" "aa?c" f match-head ] unit-test +[ 3 ] [ "aacb" "aa??c" f match-head ] unit-test + +[ t ] [ "aaa" "AAA" t matches? ] unit-test +[ f ] [ "aax" "AAA" t matches? ] unit-test +[ t ] [ "aaa" "A*" t matches? ] unit-test +[ f ] [ "aaba" "A*" t matches? ] unit-test +[ t ] [ "b" "[AB]" t matches? ] unit-test +[ f ] [ "c" "[AB]" t matches? ] unit-test +[ t ] [ "c" "[A-Z]" t matches? ] unit-test +[ f ] [ "3" "[A-Z]" t matches? ] unit-test + +[ ] [ + "(0[lL]?|[1-9]\\d{0,9}(\\d{0,9}[lL])?|0[xX]\\p{XDigit}{1,8}(\\p{XDigit}{0,8}[lL])?|0[0-7]{1,11}([0-7]{0,11}[lL])?|([0-9]+\\.[0-9]*|\\.[0-9]+)([eE][+-]?[0-9]+)?[fFdD]?|[0-9]+([eE][+-]?[0-9]+[fFdD]?|([eE][+-]?[0-9]+)?[fFdD]))" + f drop +] unit-test diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor index 55d15aed42..1447456e54 100755 --- a/extra/regexp/regexp.factor +++ b/extra/regexp/regexp.factor @@ -5,11 +5,35 @@ assocs prettyprint.backend ; USE: io IN: regexp +upper [ swap ch>upper = ] ] [ [ = ] ] if + curry ; + +: char-between?-quot ( ch1 ch2 -- quot ) + ignore-case? get + [ [ ch>upper ] 2apply [ >r >r ch>upper r> r> between? ] ] + [ [ between? ] ] + if 2curry ; + : or-predicates ( quots -- quot ) [ \ dup add* ] map [ [ t ] ] f short-circuit \ nip add ; MACRO: fast-member? ( str -- quot ) - [ dup ] H{ } map>assoc [ key? ] curry ; + [ [ t ] 2array ] { } map-as [ drop f ] add [ case ] curry ; + +: <@literal [ nip ] curry <@ ; + +: <@delay [ curry ] curry <@ ; + +PRIVATE> + +: ascii? ( n -- ? ) + 0 HEX: 7f between? ; : octal-digit? ( n -- ? ) CHAR: 0 CHAR: 7 between? ; @@ -19,7 +43,8 @@ MACRO: fast-member? ( str -- quot ) : hex-digit? ( n -- ? ) dup decimal-digit? - swap CHAR: a CHAR: f between? or ; + over CHAR: a CHAR: f between? or + swap CHAR: A CHAR: F between? or ; : control-char? ( n -- ? ) dup 0 HEX: 1f between? @@ -33,6 +58,7 @@ MACRO: fast-member? ( str -- quot ) : java-blank? ( n -- ? ) { + CHAR: \s CHAR: \t CHAR: \n CHAR: \r HEX: c HEX: 7 HEX: 1b } fast-member? ; @@ -42,7 +68,7 @@ MACRO: fast-member? ( str -- quot ) : 'ordinary-char' ( -- parser ) [ "\\^*+?|(){}[$" fast-member? not ] satisfy - [ [ = ] curry ] <@ ; + [ char=-quot ] <@ ; : 'octal-digit' ( -- parser ) [ octal-digit? ] satisfy ; @@ -58,7 +84,7 @@ MACRO: fast-member? ( str -- quot ) [ hex> ] <@ ; : satisfy-tokens ( assoc -- parser ) - [ >r token r> [ nip ] curry <@ ] { } assoc>map ; + [ >r token r> <@literal ] { } assoc>map ; : 'simple-escape-char' ( -- parser ) { @@ -69,7 +95,7 @@ MACRO: fast-member? ( str -- quot ) { "f" HEX: c } { "a" HEX: 7 } { "e" HEX: 1b } - } [ [ = ] curry ] assoc-map satisfy-tokens ; + } [ char=-quot ] assoc-map satisfy-tokens ; : 'predefined-char-class' ( -- parser ) { @@ -85,7 +111,7 @@ MACRO: fast-member? ( str -- quot ) { { "Lower" [ letter? ] } { "Upper" [ LETTER? ] } - { "ASCII" [ 0 HEX: 7f between? ] } + { "ASCII" [ ascii? ] } { "Alpha" [ Letter? ] } { "Digit" [ digit? ] } { "Alnum" [ alpha? ] } @@ -103,7 +129,7 @@ MACRO: fast-member? ( str -- quot ) 'hex' <|> "c" token [ LETTER? ] satisfy &> <|> any-char-parser <|> - [ [ = ] curry ] <@ ; + [ char=-quot ] <@ ; : 'escape' ( -- parser ) "\\" token @@ -113,7 +139,7 @@ MACRO: fast-member? ( str -- quot ) 'simple-escape' <|> &> ; : 'any-char' - "." token [ drop [ drop t ] ] <@ ; + "." token [ drop t ] <@literal ; : 'char' 'any-char' 'escape' 'ordinary-char' <|> <|> [ satisfy ] <@ ; @@ -124,21 +150,24 @@ TUPLE: group-result str ; C: group-result -: 'grouping' +: 'non-capturing-group' ( -- parser ) + 'regexp' "(?:" ")" surrounded-by ; + +: 'group' ( -- parser ) 'regexp' [ [ ] <@ ] <@ "(" ")" surrounded-by ; : 'range' ( -- parser ) any-char-parser "-" token <& any-char-parser <&> - [ first2 [ between? ] 2curry ] <@ ; + [ first2 char-between?-quot ] <@ ; : 'character-class-term' ( -- parser ) 'range' 'escape' <|> - [ "\\]" member? not ] satisfy [ [ = ] curry ] <@ <|> ; + [ "\\]" member? not ] satisfy [ char=-quot ] <@ <|> ; : 'positive-character-class' ( -- parser ) - "]" token [ drop [ CHAR: ] = ] ] <@ 'character-class-term' <*> <&:> + "]" token [ CHAR: ] = ] <@literal 'character-class-term' <*> <&:> 'character-class-term' <+> <|> [ or-predicates ] <@ ; @@ -151,66 +180,101 @@ C: group-result "[" "]" surrounded-by [ satisfy ] <@ ; : 'escaped-seq' ( -- parser ) - any-char-parser <*> [ token ] <@ "\\Q" "\\E" surrounded-by ; + any-char-parser <*> + [ ignore-case? get ] <@ + "\\Q" "\\E" surrounded-by ; : 'simple' ( -- parser ) 'escaped-seq' - 'grouping' <|> + 'non-capturing-group' <|> + 'group' <|> 'char' <|> 'character-class' <|> ; +: 'exactly-n' ( -- parser ) + 'integer' [ exactly-n ] <@delay ; + +: 'at-least-n' ( -- parser ) + 'integer' "," token <& [ at-least-n ] <@delay ; + +: 'at-most-n' ( -- parser ) + "," token 'integer' &> [ at-most-n ] <@delay ; + +: 'from-m-to-n' ( -- parser ) + 'integer' "," token <& 'integer' <&> [ first2 from-m-to-n ] <@delay ; + : 'greedy-interval' ( -- parser ) - 'simple' 'integer' "{" "}" surrounded-by <&> [ first2 exactly-n ] <@ - 'simple' 'integer' "{" ",}" surrounded-by <&> [ first2 at-least-n ] <@ <|> - 'simple' 'integer' "{," "}" surrounded-by <&> [ first2 at-most-n ] <@ <|> - 'simple' 'integer' "," token <& 'integer' <&> "{" "}" surrounded-by <&> [ first2 first2 from-m-to-n ] <@ <|> ; + 'exactly-n' 'at-least-n' <|> 'at-most-n' <|> 'from-m-to-n' <|> ; : 'interval' ( -- parser ) 'greedy-interval' 'greedy-interval' "?" token <& [ "reluctant {}" print ] <@ <|> - 'greedy-interval' "+" token <& [ "possessive {}" print ] <@ <|> ; - -: 'greedy-repetition' ( -- parser ) - 'simple' "*" token <& [ <*> ] <@ - 'simple' "+" token <& [ <+> ] <@ <|> - 'simple' "?" token <& [ ] <@ <|> ; + 'greedy-interval' "+" token <& [ "possessive {}" print ] <@ <|> + "{" "}" surrounded-by ; : 'repetition' ( -- parser ) - 'greedy-repetition' - 'greedy-repetition' "?" token <& [ "reluctant" print ] <@ <|> - 'greedy-repetition' "+" token <& [ "possessive" print ] <@ <|> ; + ! Posessive + "*+" token [ ] <@literal + "++" token [ ] <@literal <|> + "?+" token [ ] <@literal <|> + ! Reluctant + "*?" token [ <(*)> ] <@literal <|> + "+?" token [ <(+)> ] <@literal <|> + "??" token [ <(?)> ] <@literal <|> + ! Greedy + "*" token [ <*> ] <@literal <|> + "+" token [ <+> ] <@literal <|> + "?" token [ ] <@literal <|> ; + +: 'dummy' ( -- parser ) + epsilon [ ] <@literal ; : 'term' ( -- parser ) - 'simple' 'repetition' 'interval' <|> <|> - <+> [ ] <@ ; + 'simple' + 'repetition' 'interval' 'dummy' <|> <|> <&> [ first2 call ] <@ + [ ] <@ ; LAZY: 'regexp' ( -- parser ) - 'term' "|" token nonempty-list-of [ ] <@ - "^" token 'term' "|" token nonempty-list-of [ ] <@ - &> [ "caret" print ] <@ <|> - 'term' "|" token nonempty-list-of [ ] <@ - "$" token <& [ "dollar" print ] <@ <|> - "^" token 'term' "|" token nonempty-list-of [ ] <@ &> - "$" token [ "caret dollar" print ] <@ <& <|> ; + 'term' "|" token nonempty-list-of [ ] <@ ; +! "^" token 'term' "|" token nonempty-list-of [ ] <@ +! &> [ "caret" print ] <@ <|> +! 'term' "|" token nonempty-list-of [ ] <@ +! "$" token <& [ "dollar" print ] <@ <|> +! "^" token 'term' "|" token nonempty-list-of [ ] <@ &> +! "$" token [ "caret dollar" print ] <@ <& <|> ; -TUPLE: regexp source parser ; +TUPLE: regexp source parser ignore-case? ; -: dup 'regexp' just parse-1 regexp construct-boa ; +: ( string ignore-case? -- regexp ) + [ + ignore-case? [ + dup 'regexp' just parse-1 + ] with-variable + ] keep regexp construct-boa ; -GENERIC: >regexp ( obj -- parser ) - -M: string >regexp ; - -M: object >regexp ; +: do-ignore-case ( string regexp -- string regexp ) + dup regexp-ignore-case? [ >r >upper r> ] when ; : matches? ( string regexp -- ? ) - >regexp regexp-parser just parse nil? not ; + do-ignore-case regexp-parser just parse nil? not ; + +: match-head ( string regexp -- end ) + do-ignore-case regexp-parser parse dup nil? + [ drop f ] [ car parse-result-unparsed slice-from ] if ; ! Literal syntax for regexps +: parse-options ( string -- ? ) + #! Lame + { + { "" [ f ] } + { "i" [ t ] } + } case ; + : parse-regexp ( accum end -- accum ) lexer get dup skip-blank [ [ index* dup 1+ swap ] 2keep swapd subseq swap - ] change-column parsed ; + ] change-column + lexer get (parse-token) parse-options parsed ; : R! CHAR: ! parse-regexp ; parsing : R" CHAR: " parse-regexp ; parsing @@ -240,4 +304,9 @@ M: object >regexp ; } swap [ subseq? not nip ] curry assoc-find drop ; M: regexp pprint* - dup regexp-source dup find-regexp-syntax pprint-string ; + [ + dup regexp-source + dup find-regexp-syntax swap % swap % % + dup regexp-ignore-case? [ "i" % ] when + ] "" make + swap present-text ;