switch to 'pat -> .' and add P/Texp_unreachablegadt-warnings

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

7 files changed, 18 insertions, 23 deletions

diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml
index 0c7357f34d..276603d846 100644
--- a/parsing/ast_helper.ml
+++ b/parsing/ast_helper.ml
@@ -115,19 +115,13 @@ module Exp = struct
   let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)
   let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c))
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a)
+  let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable
 
   let case lhs ?guard rhs =
     {
      pc_lhs = lhs;
      pc_guard = guard;
-     pc_rhs = Some rhs;
-    }
-
-  let case_lhs lhs =
-    {
-     pc_lhs = lhs;
-     pc_guard = None;
-     pc_rhs = None;
+     pc_rhs = rhs;
     }
 end
 
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
index 1b42a24034..90c5bf9a2e 100644
--- a/parsing/ast_helper.mli
+++ b/parsing/ast_helper.mli
@@ -139,9 +139,9 @@ module Exp:
     val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression
     val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression
+    val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression
 
     val case: pattern -> ?guard:expression -> expression -> case
-    val case_lhs: pattern -> case
   end
 
 (** Value declarations *)
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index 12298c96c9..05823a7ee8 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -376,6 +376,7 @@ module E = struct
     | Pexp_open (ovf, lid, e) ->
         open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)
     | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x)
+    | Pexp_unreachable -> unreachable ~loc ~attrs ()
 end
 
 module P = struct
@@ -600,7 +601,7 @@ let default_mapper =
          {
            pc_lhs = this.pat this pc_lhs;
            pc_guard = map_opt (this.expr this) pc_guard;
-           pc_rhs = map_opt (this.expr this) pc_rhs;
+           pc_rhs = this.expr this pc_rhs;
          }
       );
 
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 3f20e46d2c..2f8d65f84c 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -1490,8 +1490,8 @@ match_case:
       { Exp.case $1 $3 }
   | pattern WHEN seq_expr MINUSGREATER seq_expr
       { Exp.case $1 ~guard:$3 $5 }
-  | pattern MINUSGREATER UNDERSCORE
-      { Exp.case_lhs $1 }
+  | pattern MINUSGREATER DOT
+      { Exp.case $1 (Exp.unreachable ~loc:(rhs_loc 3) ())}
 ;
 fun_def:
     MINUSGREATER seq_expr                       { $2 }
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index d9a4d7cd01..95dbd4f83c 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -320,12 +320,14 @@ and expression_desc =
         *)
   | Pexp_extension of extension
         (* [%id] *)
+  | Pexp_unreachable
+        (* . *)
 
 and case =   (* (P -> E) or (P when E0 -> E) *)
     {
      pc_lhs: pattern;
      pc_guard: expression option;
-     pc_rhs: expression option;
+     pc_rhs: expression;
     }
 
 (* Value descriptions *)
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index def0099718..bf563edb71 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -614,6 +614,8 @@ class printer  ()= object(self:'self)
     | Pexp_variant (l,Some eo) ->
         pp f "@[<2>`%s@;%a@]" l  self#simple_expr eo
     | Pexp_extension e -> self#extension f e
+    | Pexp_unreachable ->
+        pp f "."
     | _ -> self#expression1 f x
   method expression1 f x =
     if x.pexp_attributes <> [] then self#expression f x
@@ -1341,15 +1343,9 @@ class printer  ()= object(self:'self)
 
   method case_list f l : unit =
     let aux f {pc_lhs; pc_guard; pc_rhs} =
-      match pc_rhs with
-      | Some pc_rhs ->
-          pp f "@;| @[<2>%a%a@;->@;%a@]"
-            self#pattern pc_lhs
-            (self#option self#expression ~first:"@;when@;") pc_guard
-            self#under_pipe#expression pc_rhs
-      | None ->
-          pp f "@;| @[<2>%a@;-> _@]"
-            self#pattern pc_lhs
+      pp f "@;| @[<2>%a%a@;->@;%a@]"
+        self#pattern pc_lhs (self#option self#expression ~first:"@;when@;")
+        pc_guard self#under_pipe#expression pc_rhs
     in
     self#list aux f l ~sep:""
   method label_x_expression_param f (l,e) =
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 9aa10b6751..8297ac9ef4 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -365,6 +365,8 @@ and expression i ppf x =
   | Pexp_extension (s, arg) ->
       line i ppf "Pexp_extension \"%s\"\n" s.txt;
       payload i ppf arg
+  | Pexp_unreachable ->
+      line i ppf "Pexp_unreachable"
 
 and value_description i ppf x =
   line i ppf "value_description %a %a\n" fmt_string_loc
@@ -842,7 +844,7 @@ and case i ppf {pc_lhs; pc_guard; pc_rhs} =
   | None -> ()
   | Some g -> line (i+1) ppf "<when>\n"; expression (i + 2) ppf g
   end;
-  option (i+1) expression ppf pc_rhs;
+  expression (i+1) ppf pc_rhs;
 
 and value_binding i ppf x =
   line i ppf "<def>\n";