Regexp improvements

diff --git a/extra/regexp/regexp-tests.factor b/extra/regexp/regexp-tests.factor
index 5cec0af0a9351294bd1d36c8b2fd079a0782f6ce..d76b038ffa33c649135240cd6503a771480c301a 100755 (executable)
--- 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
-
-[ 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
-
-[ 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 ] [ "" "a+" matches? ] unit-test
-[ t ] [ "a" "a+" matches? ] unit-test
-[ t ] [ "aa" "a+" matches? ] unit-test
-
-[ t ] [ "" "a?" matches? ] unit-test
-[ t ] [ "a" "a?" matches? ] unit-test
-[ f ] [ "aa" "a?" matches? ] unit-test
-
-[ f ] [ "" "." matches? ] unit-test
-[ t ] [ "a" "." matches? ] unit-test
-[ t ] [ "." "." matches? ] unit-test
-! [ f ] [ "\n" "." matches? ] unit-test
-
-[ f ] [ "" ".+" matches? ] unit-test
-[ t ] [ "a" ".+" matches? ] unit-test
-[ t ] [ "ab" ".+" 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 ] [ "foo" "foo|bar" matches? ] unit-test
-[ t ] [ "bar" "foo|bar" matches? ] unit-test
-[ f ] [ "foobar" "foo|bar" 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 ] [ "aababaaabbac" "(a|b)+" matches? ] unit-test
-[ t ] [ "ababaaabba" "(a|b)+" 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" "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
-
-[ 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
-
-[ 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]" 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]" 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
-
-[ t ] [ "]" "[]]" matches? ] unit-test
-[ f ] [ "]" "[^]]" matches? ] unit-test
-
-! [ "^" "[^]" matches? ] unit-test-fails
-[ t ] [ "^" "[]^]" matches? ] unit-test
-[ t ] [ "]" "[]^]" matches? ] unit-test
-
-[ t ] [ "[" "[[]" matches? ] unit-test
-[ f ] [ "^" "[^^]" matches? ] unit-test
-[ t ] [ "a" "[^^]" matches? ] unit-test
-
-[ t ] [ "-" "[-]" matches? ] unit-test
-[ f ] [ "a" "[-]" matches? ] unit-test
-[ f ] [ "-" "[^-]" matches? ] unit-test
-[ t ] [ "a" "[^-]" 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
-
-[ 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
-
-[ t ] [ "-" "[a-c-]" matches? ] unit-test
-[ f ] [ "-" "[^a-c-]" matches? ] unit-test
-
-[ t ] [ "\\" "[\\\\]" matches? ] unit-test
-[ f ] [ "a" "[\\\\]" matches? ] unit-test
-[ f ] [ "\\" "[^\\\\]" matches? ] unit-test
-[ t ] [ "a" "[^\\\\]" 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 ] [ "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 ] [ "1000" "\\d{4,6}" matches? ] unit-test
-[ t ] [ "1000" "[0-9]{4,6}" 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
-
-[ f ] [ "abc" "[\\p{Upper}]{3}" matches? ] unit-test
-[ t ] [ "ABC" "[\\p{Upper}]{3}" 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 ] [ "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 ] [ "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 ] [ "abbbb" "ab*" matches? ] unit-test
-[ t ] [ "a" "ab*" matches? ] unit-test
-[ f ] [ "abab" "ab*" matches? ] unit-test
-
-[ f ] [ "x" "\\." matches? ] unit-test
-[ t ] [ "." "\\." matches? ] unit-test
+[ f ] [ "b" "a*" f <regexp> matches? ] unit-test
+[ t ] [ "" "a*" f <regexp> matches? ] unit-test
+[ t ] [ "a" "a*" f <regexp> matches? ] unit-test
+[ t ] [ "aaaaaaa" "a*" f <regexp> matches? ] unit-test
+[ f ] [ "ab" "a*" f <regexp> matches? ] unit-test
+
+[ t ] [ "abc" "abc" f <regexp> matches? ] unit-test
+[ t ] [ "a" "a|b|c" f <regexp> matches? ] unit-test
+[ t ] [ "b" "a|b|c" f <regexp> matches? ] unit-test
+[ t ] [ "c" "a|b|c" f <regexp> matches? ] unit-test
+[ f ] [ "c" "d|e|f" f <regexp> matches? ] unit-test
+
+[ f ] [ "aa" "a|b|c" f <regexp> matches? ] unit-test
+[ f ] [ "bb" "a|b|c" f <regexp> matches? ] unit-test
+[ f ] [ "cc" "a|b|c" f <regexp> matches? ] unit-test
+[ f ] [ "cc" "d|e|f" f <regexp> matches? ] unit-test
+
+[ f ] [ "" "a+" f <regexp> matches? ] unit-test
+[ t ] [ "a" "a+" f <regexp> matches? ] unit-test
+[ t ] [ "aa" "a+" f <regexp> matches? ] unit-test
+
+[ t ] [ "" "a?" f <regexp> matches? ] unit-test
+[ t ] [ "a" "a?" f <regexp> matches? ] unit-test
+[ f ] [ "aa" "a?" f <regexp> matches? ] unit-test
+
+[ f ] [ "" "." f <regexp> matches? ] unit-test
+[ t ] [ "a" "." f <regexp> matches? ] unit-test
+[ t ] [ "." "." f <regexp> matches? ] unit-test
+! [ f ] [ "\n" "." f <regexp> matches? ] unit-test
+
+[ f ] [ "" ".+" f <regexp> matches? ] unit-test
+[ t ] [ "a" ".+" f <regexp> matches? ] unit-test
+[ t ] [ "ab" ".+" f <regexp> matches? ] unit-test
+
+[ t ] [ "" "a|b*|c+|d?" f <regexp> matches? ] unit-test
+[ t ] [ "a" "a|b*|c+|d?" f <regexp> matches? ] unit-test
+[ t ] [ "c" "a|b*|c+|d?" f <regexp> matches? ] unit-test
+[ t ] [ "cc" "a|b*|c+|d?" f <regexp> matches? ] unit-test
+[ f ] [ "ccd" "a|b*|c+|d?" f <regexp> matches? ] unit-test
+[ t ] [ "d" "a|b*|c+|d?" f <regexp> matches? ] unit-test
+
+[ t ] [ "foo" "foo|bar" f <regexp> matches? ] unit-test
+[ t ] [ "bar" "foo|bar" f <regexp> matches? ] unit-test
+[ f ] [ "foobar" "foo|bar" f <regexp> matches? ] unit-test
+
+[ f ] [ "" "(a)" f <regexp> matches? ] unit-test
+[ t ] [ "a" "(a)" f <regexp> matches? ] unit-test
+[ f ] [ "aa" "(a)" f <regexp> matches? ] unit-test
+[ t ] [ "aa" "(a*)" f <regexp> matches? ] unit-test
+
+[ f ] [ "aababaaabbac" "(a|b)+" f <regexp> matches? ] unit-test
+[ t ] [ "ababaaabba" "(a|b)+" f <regexp> matches? ] unit-test
+
+[ f ] [ "" "a{1}" f <regexp> matches? ] unit-test
+[ t ] [ "a" "a{1}" f <regexp> matches? ] unit-test
+[ f ] [ "aa" "a{1}" f <regexp> matches? ] unit-test
+
+[ f ] [ "a" "a{2,}" f <regexp> matches? ] unit-test
+[ t ] [ "aaa" "a{2,}" f <regexp> matches? ] unit-test
+[ t ] [ "aaaa" "a{2,}" f <regexp> matches? ] unit-test
+[ t ] [ "aaaaa" "a{2,}" f <regexp> matches? ] unit-test
+
+[ t ] [ "" "a{,2}" f <regexp> matches? ] unit-test
+[ t ] [ "a" "a{,2}" f <regexp> matches? ] unit-test
+[ t ] [ "aa" "a{,2}" f <regexp> matches? ] unit-test
+[ f ] [ "aaa" "a{,2}" f <regexp> matches? ] unit-test
+[ f ] [ "aaaa" "a{,2}" f <regexp> matches? ] unit-test
+[ f ] [ "aaaaa" "a{,2}" f <regexp> matches? ] unit-test
+
+[ f ] [ "" "a{1,3}" f <regexp> matches? ] unit-test
+[ t ] [ "a" "a{1,3}" f <regexp> matches? ] unit-test
+[ t ] [ "aa" "a{1,3}" f <regexp> matches? ] unit-test
+[ t ] [ "aaa" "a{1,3}" f <regexp> matches? ] unit-test
+[ f ] [ "aaaa" "a{1,3}" f <regexp> matches? ] unit-test
+
+[ f ] [ "" "[a]" f <regexp> matches? ] unit-test
+[ t ] [ "a" "[a]" f <regexp> matches? ] unit-test
+[ t ] [ "a" "[abc]" f <regexp> matches? ] unit-test
+[ f ] [ "b" "[a]" f <regexp> matches? ] unit-test
+[ f ] [ "d" "[abc]" f <regexp> matches? ] unit-test
+[ t ] [ "ab" "[abc]{1,2}" f <regexp> matches? ] unit-test
+[ f ] [ "abc" "[abc]{1,2}" f <regexp> matches? ] unit-test
+
+[ f ] [ "" "[^a]" f <regexp> matches? ] unit-test
+[ f ] [ "a" "[^a]" f <regexp> matches? ] unit-test
+[ f ] [ "a" "[^abc]" f <regexp> matches? ] unit-test
+[ t ] [ "b" "[^a]" f <regexp> matches? ] unit-test
+[ t ] [ "d" "[^abc]" f <regexp> matches? ] unit-test
+[ f ] [ "ab" "[^abc]{1,2}" f <regexp> matches? ] unit-test
+[ f ] [ "abc" "[^abc]{1,2}" f <regexp> matches? ] unit-test
+
+[ t ] [ "]" "[]]" f <regexp> matches? ] unit-test
+[ f ] [ "]" "[^]]" f <regexp> matches? ] unit-test
+
+! [ "^" "[^]" f <regexp> matches? ] unit-test-fails
+[ t ] [ "^" "[]^]" f <regexp> matches? ] unit-test
+[ t ] [ "]" "[]^]" f <regexp> matches? ] unit-test
+
+[ t ] [ "[" "[[]" f <regexp> matches? ] unit-test
+[ f ] [ "^" "[^^]" f <regexp> matches? ] unit-test
+[ t ] [ "a" "[^^]" f <regexp> matches? ] unit-test
+
+[ t ] [ "-" "[-]" f <regexp> matches? ] unit-test
+[ f ] [ "a" "[-]" f <regexp> matches? ] unit-test
+[ f ] [ "-" "[^-]" f <regexp> matches? ] unit-test
+[ t ] [ "a" "[^-]" f <regexp> matches? ] unit-test
+
+[ t ] [ "-" "[-a]" f <regexp> matches? ] unit-test
+[ t ] [ "a" "[-a]" f <regexp> matches? ] unit-test
+[ t ] [ "-" "[a-]" f <regexp> matches? ] unit-test
+[ t ] [ "a" "[a-]" f <regexp> matches? ] unit-test
+[ f ] [ "b" "[a-]" f <regexp> matches? ] unit-test
+[ f ] [ "-" "[^-]" f <regexp> matches? ] unit-test
+[ t ] [ "a" "[^-]" f <regexp> matches? ] unit-test
+
+[ f ] [ "-" "[a-c]" f <regexp> matches? ] unit-test
+[ t ] [ "-" "[^a-c]" f <regexp> matches? ] unit-test
+[ t ] [ "b" "[a-c]" f <regexp> matches? ] unit-test
+[ f ] [ "b" "[^a-c]" f <regexp> matches? ] unit-test
+
+[ t ] [ "-" "[a-c-]" f <regexp> matches? ] unit-test
+[ f ] [ "-" "[^a-c-]" f <regexp> matches? ] unit-test
+
+[ t ] [ "\\" "[\\\\]" f <regexp> matches? ] unit-test
+[ f ] [ "a" "[\\\\]" f <regexp> matches? ] unit-test
+[ f ] [ "\\" "[^\\\\]" f <regexp> matches? ] unit-test
+[ t ] [ "a" "[^\\\\]" f <regexp> matches? ] unit-test
+
+[ t ] [ "0" "[\\d]" f <regexp> matches? ] unit-test
+[ f ] [ "a" "[\\d]" f <regexp> matches? ] unit-test
+[ f ] [ "0" "[^\\d]" f <regexp> matches? ] unit-test
+[ t ] [ "a" "[^\\d]" f <regexp> matches? ] unit-test
+
+[ t ] [ "a" "[a-z]{1,}|[A-Z]{2,4}|b*|c|(f|g)*" f <regexp> matches? ] unit-test
+[ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}|b*|c|(f|g)*" f <regexp> matches? ] unit-test
+[ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}" f <regexp> matches? ] unit-test
+
+[ t ] [ "1000" "\\d{4,6}" f <regexp> matches? ] unit-test
+[ t ] [ "1000" "[0-9]{4,6}" f <regexp> matches? ] unit-test
+
+[ t ] [ "abc" "\\p{Lower}{3}" f <regexp> matches? ] unit-test
+[ f ] [ "ABC" "\\p{Lower}{3}" f <regexp> matches? ] unit-test
+[ t ] [ "ABC" "\\p{Upper}{3}" f <regexp> matches? ] unit-test
+[ f ] [ "abc" "\\p{Upper}{3}" f <regexp> matches? ] unit-test
+
+[ f ] [ "abc" "[\\p{Upper}]{3}" f <regexp> matches? ] unit-test
+[ t ] [ "ABC" "[\\p{Upper}]{3}" f <regexp> matches? ] unit-test
+
+[ t ] [ "" "\\Q\\E" f <regexp> matches? ] unit-test
+[ f ] [ "a" "\\Q\\E" f <regexp> matches? ] unit-test
+[ t ] [ "|*+" "\\Q|*+\\E" f <regexp> matches? ] unit-test
+[ f ] [ "abc" "\\Q|*+\\E" f <regexp> matches? ] unit-test
+
+[ t ] [ "S" "\\0123" f <regexp> matches? ] unit-test
+[ t ] [ "SXY" "\\0123XY" f <regexp> matches? ] unit-test
+[ t ] [ "x" "\\x78" f <regexp> matches? ] unit-test
+[ f ] [ "y" "\\x78" f <regexp> matches? ] unit-test
+[ t ] [ "x" "\\u0078" f <regexp> matches? ] unit-test
+[ f ] [ "y" "\\u0078" f <regexp> matches? ] unit-test
+
+[ t ] [ "ab" "a+b" f <regexp> matches? ] unit-test
+[ f ] [ "b" "a+b" f <regexp> matches? ] unit-test
+[ t ] [ "aab" "a+b" f <regexp> matches? ] unit-test
+[ f ] [ "abb" "a+b" f <regexp> matches? ] unit-test
+
+[ t ] [ "abbbb" "ab*" f <regexp> matches? ] unit-test
+[ t ] [ "a" "ab*" f <regexp> matches? ] unit-test
+[ f ] [ "abab" "ab*" f <regexp> matches? ] unit-test
+
+[ f ] [ "x" "\\." f <regexp> matches? ] unit-test
+[ t ] [ "." "\\." f <regexp> matches? ] unit-test
+
+[ t ] [ "aaaab" "a+ab" f <regexp> matches? ] unit-test
+[ f ] [ "aaaxb" "a+ab" f <regexp> matches? ] unit-test
+[ t ] [ "aaacb" "a+cb" f <regexp> matches? ] unit-test
+[ f ] [ "aaaab" "a++ab" f <regexp> matches? ] unit-test
+[ t ] [ "aaacb" "a++cb" f <regexp> matches? ] unit-test
+
+[ 3 ] [ "aaacb" "a*" f <regexp> match-head ] unit-test
+[ 1 ] [ "aaacb" "a+?" f <regexp> match-head ] unit-test
+[ 2 ] [ "aaacb" "aa?" f <regexp> match-head ] unit-test
+[ 1 ] [ "aaacb" "aa??" f <regexp> match-head ] unit-test
+[ 3 ] [ "aacb" "aa?c" f <regexp> match-head ] unit-test
+[ 3 ] [ "aacb" "aa??c" f <regexp> match-head ] unit-test
+
+[ t ] [ "aaa" "AAA" t <regexp> matches? ] unit-test
+[ f ] [ "aax" "AAA" t <regexp> matches? ] unit-test
+[ t ] [ "aaa" "A*" t <regexp> matches? ] unit-test
+[ f ] [ "aaba" "A*" t <regexp> matches? ] unit-test
+[ t ] [ "b" "[AB]" t <regexp> matches? ] unit-test
+[ f ] [ "c" "[AB]" t <regexp> matches? ] unit-test
+[ t ] [ "c" "[A-Z]" t <regexp> matches? ] unit-test
+[ f ] [ "3" "[A-Z]" t <regexp> 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 <regexp> drop
+] unit-test

diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor
index 55d15aed4211cdd2063ad407621cf87fedb1792d..1447456e54a4d25188d42f517b3ce74b3e801086 100755 (executable)
--- a/extra/regexp/regexp.factor
+++ b/extra/regexp/regexp.factor
@@ -5,11 +5,35 @@ assocs prettyprint.backend ;
 USE: io
 IN: regexp
 
+<PRIVATE
+
+SYMBOL: ignore-case?
+
+: char=-quot ( ch -- quot )
+    ignore-case? get
+    [ ch>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 <or-parser> ;
+    [ >r token r> <@literal ] { } assoc>map <or-parser> ;
 
 : '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> group-result
 
-: 'grouping'
+: 'non-capturing-group' ( -- parser )
+    'regexp' "(?:" ")" surrounded-by ;
+
+: 'group' ( -- parser )
     'regexp' [ [ <group-result> ] <@ ] <@
     "(" ")" 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> group-result
     "[" "]" surrounded-by [ satisfy ] <@ ;
 
 : 'escaped-seq' ( -- parser )
-    any-char-parser <*> [ token ] <@ "\\Q" "\\E" surrounded-by ;
+    any-char-parser <*>
+    [ ignore-case? get <token-parser> ] <@
+    "\\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' <|> <|>
-    <+> [ <and-parser> ] <@ ;
+    'simple'
+    'repetition' 'interval' 'dummy' <|> <|> <&> [ first2 call ] <@
+    <!+> [ <and-parser> ] <@ ;
 
 LAZY: 'regexp' ( -- parser )
-    'term' "|" token nonempty-list-of [ <or-parser> ] <@
-    "^" token 'term' "|" token nonempty-list-of [ <or-parser> ] <@
-        &> [ "caret" print ] <@ <|>
-    'term' "|" token nonempty-list-of [ <or-parser> ] <@
-        "$" token <& [ "dollar" print ] <@ <|>
-    "^" token 'term' "|" token nonempty-list-of [ <or-parser> ] <@ &>
-        "$" token [ "caret dollar" print ] <@ <& <|> ;
-
-TUPLE: regexp source parser ;
-
-: <regexp> dup 'regexp' just parse-1 regexp construct-boa ;
-
-GENERIC: >regexp ( obj -- parser )
-
-M: string >regexp <regexp> ;
-
-M: object >regexp ;
+    'term' "|" token nonempty-list-of [ <or-parser> ] <@ ;
+!    "^" token 'term' "|" token nonempty-list-of [ <or-parser> ] <@
+!        &> [ "caret" print ] <@ <|>
+!    'term' "|" token nonempty-list-of [ <or-parser> ] <@
+!        "$" token <& [ "dollar" print ] <@ <|>
+!    "^" token 'term' "|" token nonempty-list-of [ <or-parser> ] <@ &>
+!        "$" token [ "caret dollar" print ] <@ <& <|> ;
+
+TUPLE: regexp source parser ignore-case? ;
+
+: <regexp> ( string ignore-case? -- regexp )
+    [
+        ignore-case? [
+            dup 'regexp' just parse-1
+        ] with-variable
+    ] keep regexp construct-boa ;
+
+: 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  <regexp> parsed ;
+    ] change-column
+    lexer get (parse-token) parse-options <regexp> 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 ;