Add range-pattern parser

extra/peg/parsers/parsers-docs.factor

@@ -159,3 +159,21 @@ HELP: 'string'
 } { $description
     "Returns a parser that matches an string composed of a \", anything that is not \", and another \"."
 } { $see-also 'integer' } ;
+
+HELP: range-pattern
+{ $values
+    { "pattern" "a string" }
+    { "parser" "a parser" }
+} { $description
+"Returns a parser that matches a single character based on the set "
+"of characters in the pattern string."
+"Any single character in the pattern matches that character. "
+"If the pattern begins with a ^ then the set is negated "
+"(the element matches any character not in the set). Any pair "
+"of characters separated with a dash (-) represents the "
+"range of characters from the first to the second, inclusive."
+{ $examples
+    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"_a-zA-Z\" range-pattern parse parse-result-ast 1string ." "\"a\"" } 
+    { $example "USING: peg peg.parsers prettyprint ;" "\"0\" \"^0-9\" range-pattern parse ." "f" } 
+}
+}  ;

extra/peg/parsers/parsers.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences strings namespaces math assocs shuffle 
      vectors arrays combinators.lib memoize math.parser match
-     unicode.categories sequences.deep peg peg.private ;
+     unicode.categories sequences.deep peg peg.private 
+     peg.search math.ranges ;
 IN: peg.parsers
 
 TUPLE: just-parser p1 ;
@@ -83,3 +84,30 @@ MEMO: 'string' ( -- parser )
     [ CHAR: " = not ] satisfy repeat0 ,
     [ CHAR: " = ] satisfy hide ,
   ] { } make seq [ first >string ] action ;
+
+: (range-pattern) ( pattern -- string )
+  #! Given a range pattern, produce a string containing
+  #! all characters within that range.
+  [ 
+    any-char , 
+    [ CHAR: - = ] satisfy hide , 
+    any-char , 
+  ] seq* [
+    first2 [a,b] >string    
+  ] action
+  replace ;
+
+MEMO: range-pattern ( pattern -- parser )
+  #! 'pattern' is a set of characters describing the
+  #! parser to be produced. Any single character in
+  #! the pattern matches that character. If the pattern
+  #! begins with a ^ then the set is negated (the element
+  #! matches any character not in the set). Any pair of
+  #! characters separated with a dash (-) represents the
+  #! range of characters from the first to the second,
+  #! inclusive.
+  dup first CHAR: ^ = [
+    1 tail (range-pattern) [ member? not ] curry satisfy 
+  ] [
+    (range-pattern) [ member? ] curry satisfy
+  ] if ;