Merge git://factorcode.org/git/factor

core/alien/syntax/syntax.factor

@@ -59,4 +59,4 @@ M: alien pprint*
         { [ t ] [ \ ALIEN: [ alien-address pprint* ] pprint-prefix ] }
     } cond ;
 
-M: dll pprint* dll-path dup "DLL\" " pprint-string ;
+M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;

core/prettyprint/backend/backend.factor

@@ -89,19 +89,20 @@ M: f pprint* drop \ f pprint-word ;
         { 0.3 0.3 0.3 1.0 } foreground set
     ] H{ } make-assoc ;
 
-: unparse-string ( str prefix -- str )
-    [
-        % do-string-limit [ unparse-ch ] each CHAR: " ,
-    ] "" make ;
+: unparse-string ( str prefix suffix -- str )
+    [ >r % do-string-limit [ unparse-ch ] each r> % ] "" make ;
 
-: pprint-string ( obj str prefix -- )
+: pprint-string ( obj str prefix suffix -- )
     unparse-string swap string-style styled-text ;
 
-M: string pprint* dup "\"" pprint-string ;
+M: string pprint*
+    dup "\"" "\"" pprint-string ;
 
-M: sbuf pprint* dup "SBUF\" " pprint-string ;
+M: sbuf pprint*
+    dup "SBUF\" " "\"" pprint-string ;
 
-M: pathname pprint* dup pathname-string "P\" " pprint-string ;
+M: pathname pprint*
+    dup pathname-string "P\" " "\"" pprint-string ;
 
 ! Sequences
 : nesting-limit? ( -- ? )

extra/regexp/regexp-tests.factor

@@ -160,3 +160,15 @@ IN: regexp-tests
 [ 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

extra/regexp/regexp.factor

@@ -1,15 +1,20 @@
 USING: arrays combinators kernel lazy-lists math math.parser
 namespaces parser parser-combinators parser-combinators.simple
 promises quotations sequences combinators.lib strings macros
-assocs ;
+assocs prettyprint.backend ;
 IN: regexp
 
 : or-predicates ( quots -- quot )
     [ \ dup add* ] map [ [ t ] ] f short-circuit \ nip add ;
 
-: octal-digit? ( n -- ? ) CHAR: 0 CHAR: 7 between? ;
+MACRO: fast-member? ( str -- quot )
+    [ dup ] H{ } map>assoc [ key? ] curry ;
 
-: decimal-digit? ( n -- ? ) CHAR: 0 CHAR: 9 between? ;
+: octal-digit? ( n -- ? )
+    CHAR: 0 CHAR: 7 between? ;
+
+: decimal-digit? ( n -- ? )
+    CHAR: 0 CHAR: 9 between? ;
 
 : hex-digit? ( n -- ? )
     dup decimal-digit?
@@ -19,9 +24,6 @@ IN: regexp
     dup 0 HEX: 1f between?
     swap HEX: 7f = or ;
 
-MACRO: fast-member? ( str -- quot )
-    [ dup ] H{ } map>assoc [ key? ] curry ;
-
 : punct? ( n -- ? )
     "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~" fast-member? ;
 
@@ -54,13 +56,6 @@ MACRO: fast-member? ( str -- quot )
     "u" token 'hex-digit' 4 exactly-n &> <|>
     [ hex> ] <@ ;
 
-: 'control-character' ( -- parser )
-    "c" token [ LETTER? ] satisfy &> ;
-
-: 'simple-escape' ( -- parser )
-    'octal' 'hex' 'control-character' <|> <|>
-    [ [ = ] curry ] <@ ;
-
 : satisfy-tokens ( assoc -- parser )
     [ >r token r> [ nip ] curry <@ ] { } assoc>map <or-parser> ;
 
@@ -102,21 +97,26 @@ MACRO: fast-member? ( str -- quot )
         { "Space" [ java-blank? ] }
     } satisfy-tokens "p{" "}" surrounded-by ;
 
+: 'simple-escape' ( -- parser )
+    'octal'
+    'hex' <|>
+    "c" token [ LETTER? ] satisfy &> <|>
+    any-char-parser <|>
+    [ [ = ] curry ] <@ ;
+
 : 'escape' ( -- parser )
     "\\" token
-    'simple-escape'
-    'simple-escape-char' <|>
+    'simple-escape-char'
     'predefined-char-class' <|>
-    'posix-character-class' <|> &> ;
+    'posix-character-class' <|>
+    'simple-escape' <|> &> ;
 
-: 'any-char' "." token [ drop [ drop t ] ] <@ ;
+: 'any-char'
+    "." token [ drop [ drop t ] ] <@ ;
 
 : 'char'
     'any-char' 'escape' 'ordinary-char' <|> <|> [ satisfy ] <@ ;
 
-: 'string'
-    'char' <+> [ <and-parser> ] <@ ;
-
 DEFER: 'regexp'
 
 TUPLE: group-result str ;
@@ -152,47 +152,75 @@ C: <group-result> group-result
 : 'escaped-seq' ( -- parser )
     any-char-parser <*> [ token ] <@ "\\Q" "\\E" surrounded-by ;
 
-: 'term' ( -- parser )
+: 'simple' ( -- parser )
     'escaped-seq'
     'grouping' <|>
-    'string' <|>
-    'character-class' <|>
-    <+> [ <and-parser> ] <@ ;
+    'char' <|>
+    'character-class' <|> ;
 
 : 'interval' ( -- parser )
-    'term' 'integer' "{" "}" surrounded-by <&> [ first2 exactly-n ] <@
-    'term' 'integer' "{" ",}" surrounded-by <&> [ first2 at-least-n ] <@ <|>
-    'term' 'integer' "{," "}" surrounded-by <&> [ first2 at-most-n ] <@ <|>
-    'term' 'integer' "," token <& 'integer' <&> "{" "}" surrounded-by <&> [ first2 first2 from-m-to-n ] <@ <|> ;
+    '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 ] <@ <|> ;
 
 : 'repetition' ( -- parser )
-    'term' "*" token <& [ <*> ] <@ 
-    'term' "+" token <& [ <+> ] <@ <|>
-    'term' "?" token <& [ <?> ] <@ <|> ;
+    'simple' "*" token <& [ <*> ] <@
+    'simple' "+" token <& [ <+> ] <@ <|>
+    'simple' "?" token <& [ <?> ] <@ <|> ;
 
-: 'simple' 'term' 'repetition' 'interval' <|> <|> ;
-
-LAZY: 'union' ( -- parser )
-    'simple' "|" token nonempty-list-of [ <or-parser> ] <@ ;
+: 'term' ( -- parser )
+    'simple' 'repetition' 'interval' <|> <|>
+    <+> [ <and-parser> ] <@ ;
 
 LAZY: 'regexp' ( -- parser )
-    'repetition' 'union' <|> ;
+    'term' "|" token nonempty-list-of [ <or-parser> ] <@ ;
 
-: <regexp> 'regexp' just parse-1 ;
+TUPLE: regexp source parser ;
+
+: <regexp> dup 'regexp' just parse-1 regexp construct-boa ;
 
 GENERIC: >regexp ( obj -- parser )
-M: string >regexp 'regexp' just parse-1 ;
+
+M: string >regexp <regexp> ;
+
 M: object >regexp ;
 
-: matches? ( string regexp -- ? ) >regexp just parse nil? not ;
+: matches? ( string regexp -- ? )
+    >regexp regexp-parser just parse nil? not ;
 
+! Literal syntax for regexps
 : parse-regexp ( accum end -- accum )
     lexer get dup skip-blank [
         [ index* dup 1+ swap ] 2keep swapd subseq swap
     ] change-column  <regexp> parsed ;
 
-: R/ CHAR: / parse-regexp ; parsing
-: R| CHAR: | parse-regexp ; parsing
+: R! CHAR: ! parse-regexp ; parsing
 : R" CHAR: " parse-regexp ; parsing
+: R# CHAR: # parse-regexp ; parsing
 : R' CHAR: ' parse-regexp ; parsing
+: R( CHAR: ) parse-regexp ; parsing
+: R/ CHAR: / parse-regexp ; parsing
+: R@ CHAR: @ parse-regexp ; parsing
+: R[ CHAR: ] parse-regexp ; parsing
 : R` CHAR: ` parse-regexp ; parsing
+: R{ CHAR: } parse-regexp ; parsing
+: R| CHAR: | parse-regexp ; parsing
+
+: find-regexp-syntax ( string -- prefix suffix )
+    {
+        { "R/ "  "/"  }
+        { "R! "  "!"  }
+        { "R\" " "\"" }
+        { "R# "  "#"  }
+        { "R' "  "'"  }
+        { "R( "  ")"  }
+        { "R@ "  "@"  }
+        { "R[ "  "]"  }
+        { "R` "  "`"  }
+        { "R{ "  "}"  }
+        { "R| "  "|"  }
+    } swap [ subseq? not nip ] curry assoc-find drop ;
+
+M: regexp pprint*
+    dup regexp-source dup find-regexp-syntax pprint-string ;