Keep interval pattern sugar in the Parsetree (Camlp4 parsers still expand them).

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/extension_points@13546 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

7 files changed, 14 insertions, 33 deletions

diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml
index 999ba8ba9a..c1d028a8a8 100644
--- a/parsing/ast_helper.ml
+++ b/parsing/ast_helper.ml
@@ -59,6 +59,7 @@ module Pat = struct
   let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a)
   let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b))
   let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a)
+  let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b))
   let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a)
   let construct ?loc ?attrs a b c = mk ?loc ?attrs (Ppat_construct (a, b, c))
   let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b))
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
index 6358ee29a7..2d5c22e0ed 100644
--- a/parsing/ast_helper.mli
+++ b/parsing/ast_helper.mli
@@ -62,6 +62,7 @@ module Pat:
     val var: ?loc:loc -> ?attrs:attrs -> str -> pattern
     val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern
     val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern
+    val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern
     val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
     val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> bool -> pattern
     val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index 8959300508..4153c105df 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -250,6 +250,7 @@ module P = struct
     | Ppat_var s -> var ~loc ~attrs (map_loc sub s)
     | Ppat_alias (p, s) -> alias ~loc ~attrs (sub # pat p) (map_loc sub s)
     | Ppat_constant c -> constant ~loc ~attrs c
+    | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2
     | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub # pat) pl)
     | Ppat_construct (l, p, b) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub # pat) p) b
     | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub # pat) p)
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 4574f5fc9d..449fb4fd5f 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -153,16 +153,6 @@ let mkstrexp e attrs =
 let array_function str name =
   ghloc (Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name)))
 
-let rec deep_mkrangepat c1 c2 =
-  if c1 = c2 then ghpat(Ppat_constant(Const_char c1)) else
-  ghpat(Ppat_or(ghpat(Ppat_constant(Const_char c1)),
-                deep_mkrangepat (Char.chr(Char.code c1 + 1)) c2))
-
-let rec mkrangepat c1 c2 =
-  if c1 > c2 then mkrangepat c2 c1 else
-  if c1 = c2 then mkpat(Ppat_constant(Const_char c1)) else
-  reloc_pat (deep_mkrangepat c1 c2)
-
 let syntax_error () =
   raise Syntaxerr.Escape_error
 
@@ -1363,8 +1353,8 @@ simple_pattern:
       { mkpat(Ppat_any) }
   | signed_constant
       { mkpat(Ppat_constant $1) }
-  | CHAR DOTDOT CHAR
-      { mkrangepat $1 $3 }
+  | signed_constant DOTDOT signed_constant
+      { mkpat(Ppat_interval ($1, $3)) }
   | constr_longident
       { mkpat(Ppat_construct(mkrhs $1 1, None, false)) }
   | name_tag
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index 8386cc00e5..dedab06a95 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -138,6 +138,11 @@ and pattern_desc =
         (* P as 'a *)
   | Ppat_constant of constant
         (* 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+  | Ppat_interval of constant * constant
+        (* 'a'..'z'
+
+           Other forms of interval are recognized by the parser
+           but rejected by the type-checker. *)
   | Ppat_tuple of pattern list
         (* (P1, ..., Pn)   (n >= 2) *)
   | Ppat_construct of Longident.t loc * pattern option * bool
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index d80e6a3324..ad8d98e3ca 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -114,6 +114,7 @@ let rec is_irrefut_patt x =
   | Ppat_record (ls,_) -> List.for_all (fun (_,x) -> is_irrefut_patt x) ls
   | Ppat_lazy p -> is_irrefut_patt p 
   | Ppat_extension _ -> assert false
+  | Ppat_interval _
   | Ppat_constant _ | Ppat_construct _  | Ppat_variant _ | Ppat_array _ | Ppat_type _-> false (*conservative*)
 class printer  ()= object(self:'self)
   val pipe = false
@@ -315,18 +316,6 @@ class printer  ()= object(self:'self)
           (********************pattern********************)
           (* be cautious when use [pattern], [pattern1] is preferred *)         
   method pattern f x =
-    let rec pattern_or_helper  cur = function
-      |{ppat_desc = Ppat_constant (Const_char a);_}
-        -> 
-          if Char.code a = Char.code cur + 1 then
-            Some a
-          else None
-      |{ppat_desc =
-        Ppat_or({ppat_desc=Ppat_constant (Const_char a);_}, p2);_} -> 
-          if Char.code a = Char.code cur + 1 then
-            pattern_or_helper a p2
-          else None
-      | _ -> None in
     let rec list_of_pattern acc = function (* only consider ((A|B)|C)*)
       | {ppat_desc= Ppat_or (p1,p2);_} ->
           list_of_pattern  (p2::acc) p1
@@ -339,15 +328,7 @@ class printer  ()= object(self:'self)
             then pp f "( %s )" s.txt
             else pp f "%s" s.txt ) s (* RA*)
     | Ppat_or (p1, p2) -> (* *)
-        (match p1 with
-        | {ppat_desc=Ppat_constant (Const_char a);_} -> 
-            (match pattern_or_helper a p2 with
-            |Some b -> pp f "@[<2>%C..%C@]" a b 
-            |None ->
-                pp f "@[<hov0>%a@]" (self#list ~sep:"@,|" self#pattern ) (list_of_pattern [] x))
-        | _ ->
-            pp f "@[<hov0>%a@]" (self#list ~sep:"@,|" self#pattern) (list_of_pattern [] x)
-        )
+        pp f "@[<hov0>%a@]" (self#list ~sep:"@,|" self#pattern) (list_of_pattern [] x)
     | _ -> self#pattern1 f x
   method pattern1 (f:Format.formatter) (x:pattern) :unit =
     let rec pattern_list_helper f  =  function
@@ -404,6 +385,7 @@ class printer  ()= object(self:'self)
               (self#list longident_x_pattern ~sep:";@;") l)
     | Ppat_tuple l -> pp f "@[<1>(%a)@]" (self#list  ~sep:"," self#pattern1)  l (* level1*)
     | Ppat_constant (c) -> pp f "%a" self#constant c
+    | Ppat_interval (c1, c2) -> pp f "%a..%a" self#constant c1 self#constant c2
     | Ppat_variant (l,None) ->  pp f "`%s" l
     | Ppat_constraint (p, ct) ->
         pp f "@[<2>(%a@;:@;%a)@]" self#pattern1 p self#core_type ct
diff --git a/parsing/printast.ml b/parsing/printast.ml
index b868008845..d3663985e6 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -194,6 +194,7 @@ and pattern i ppf x =
       line i ppf "Ppat_alias %a\n" fmt_string_loc s;
       pattern i ppf p;
   | Ppat_constant (c) -> line i ppf "Ppat_constant %a\n" fmt_constant c;
+  | Ppat_interval (c1, c2) -> line i ppf "Ppat_interval %a..%a\n" fmt_constant c1 fmt_constant c2;
   | Ppat_tuple (l) ->
       line i ppf "Ppat_tuple\n";
       list i pattern ppf l;