-

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3874 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2001-10-09 16:39:11 +00:00 · 2001-10-09 16:39:11 +00:00 · 83a6451e45
parent 5f1ae5e132
commit 83a6451e45
16 changed files with 217 additions and 104 deletions
--- a/camlp4/CHANGES
+++ b/camlp4/CHANGES
@ -5,7 +5,8 @@ Camlp4 Version 3.03
  named "True" of "False" (capitalized, i.e. not like the booleans), it
  did not work.
 - [04 Oct 01] Fixed some revised and quotation syntaxes in objects classes
-  and types (cleaner). Cleaned up also several parts of the parsers.
+  and types (cleaner). Cleaned up also several parts of the parsers. Completed
+  missing cases.
 - [02 Oct 01] In revised syntax, the warning for using old syntax for
  sequences is now by default. To remove it, the option -no-warn-seq
  of camlp4r has been added. Option -warn-seq has been removed.
--- a/camlp4/camlp4/ast2pt.ml
+++ b/camlp4/camlp4/ast2pt.ml
@ -628,8 +628,14 @@ and str_item s l =
       l]
  | StDcl loc sl -> List.fold_right str_item sl l
  | StDir loc _ _ -> l
-  | StExc loc n tl ->
-      [mkstr loc (Pstr_exception n (List.map ctyp tl)) :: l]
+  | StExc loc n tl sl ->
+      let si =
+        match (tl, sl) with
+        [ (tl, []) -> Pstr_exception n (List.map ctyp tl)
+        | ([], sl) -> Pstr_exn_rebind n (long_id_of_string_list loc sl)
+        | _ -> error loc "bad exception declaration" ]
+      in
+      [mkstr loc si :: l]
  | StExp loc e -> [mkstr loc (Pstr_eval (expr e)) :: l]
  | StExt loc n t p ->
      [mkstr loc (Pstr_primitive n (mkvalue_desc t p)) :: l]
--- a/camlp4/camlp4/mLast.mli
+++ b/camlp4/camlp4/mLast.mli
@ -138,7 +138,7 @@ and str_item =
  | StClt of loc and list (class_infos class_type)
  | StDcl of loc and list str_item
  | StDir of loc and string and option expr
-  | StExc of loc and string and list ctyp
+  | StExc of loc and string and list ctyp and list string
  | StExp of loc and expr
  | StExt of loc and string and ctyp and list string
  | StInc of loc and module_expr
--- a/camlp4/camlp4/reloc.ml
+++ b/camlp4/camlp4/reloc.ml
@ -206,7 +206,7 @@ and str_item floc sh =
        StClt (floc loc) (List.map (class_infos class_type floc sh) x1)
    | StDcl loc x1 -> StDcl (floc loc) (List.map self x1)
    | StDir loc x1 x2 -> StDir (floc loc) x1 x2
-    | StExc loc x1 x2 -> StExc (floc loc) x1 (List.map (ctyp floc sh) x2)
+    | StExc loc x1 x2 x3 -> StExc (floc loc) x1 (List.map (ctyp floc sh) x2) x3
    | StExp loc x1 -> StExp (floc loc) (expr floc sh x1)
    | StExt loc x1 x2 x3 -> StExt (floc loc) x1 (ctyp floc sh x2) x3
    | StInc loc x1 -> StInc (floc loc) (module_expr floc sh x1)
--- a/camlp4/etc/pa_o.ml
+++ b/camlp4/etc/pa_o.ml
@ -372,8 +372,8 @@ EXTEND
  ;
  str_item:
    [ "top"
-      [ "exception"; (c, tl) = constructor_declaration ->
-          <:str_item< exception $c$ of $list:tl$ >>
+      [ "exception"; (c, tl) = constructor_declaration; b = rebind_exn ->
+          <:str_item< exception $c$ of $list:tl$ = $b$ >>
      | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING ->
          <:str_item< external $i$ : $t$ = $list:pd$ >>
      | "external"; "("; i = operator_rparen; ":"; t = ctyp; "=";
@ -399,6 +399,10 @@ EXTEND
          <:str_item< let module $m$ = $mb$ in $e$ >>
      | e = expr -> <:str_item< $exp:e$ >> ] ]
  ;
+  rebind_exn:
+    [ [ "="; sl = mod_ident -> sl
+      | -> [] ] ]
+  ;
  module_binding:
    [ RIGHTA
      [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF ->
@ -1118,20 +1122,30 @@ EXTEND
      | "#"; t = mod_ident -> <:patt< # $list:t$ >> ] ]
  ;
  labeled_patt:
-    [ [ i = TILDEIDENTCOLON; p = patt LEVEL "simple" -> <:patt< ~ $i$ : $p$ >>
-      | i = TILDEIDENT -> <:patt< ~ $i$ >>
-      | i = QUESTIONIDENTCOLON; j = LIDENT -> <:patt< ? $i$ : $lid:j$ >>
-      | i = QUESTIONIDENTCOLON; "("; lp = let_pattern; "="; e = expr; ")" ->
-          <:patt< ? $i$ : ( $lp$ = $e$ ) >>
-      | i = QUESTIONIDENT -> <:patt< ? $i$ : $lid:i$ >>
+    [ [ i = TILDEIDENTCOLON; p = patt LEVEL "simple" ->
+           <:patt< ~ $i$ : $p$ >>
+      | i = TILDEIDENT ->
+           <:patt< ~ $i$ >>
+      | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" ->
+           <:patt< ~ $i$ : ($lid:i$ : $t$) >>
+      | i = QUESTIONIDENTCOLON; j = LIDENT ->
+           <:patt< ? $i$ : ($lid:j$) >>
+      | i = QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" ->
+          <:patt< ? $i$ : ( $p$ = $e$ ) >>
+      | i = QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" ->
+          <:patt< ? $i$ : ( $p$ : $t$ ) >>
+      | i = QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "=";
+        e = expr; ")" ->
+          <:patt< ? $i$ : ( $p$ : $t$ = $e$ ) >>
+      | i = QUESTIONIDENT -> <:patt< ? $i$ : ($lid:i$) >>
      | "?"; "("; i = LIDENT; "="; e = expr; ")" ->
          <:patt< ? $i$ : ( $lid:i$ = $e$ ) >>
      | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" ->
-          <:patt< ? $i$ : ( ($lid:i$ : $t$) = $e$ ) >> ] ]
-  ;
-  let_pattern:
-    [ [ p = patt -> p
-      | p = patt; ":"; t = ctyp -> <:patt< ($p$ : $t$) >> ] ]
+          <:patt< ? $i$ : ( $lid:i$ : $t$ = $e$ ) >>
+      | "?"; "("; i = LIDENT; ")" ->
+          <:patt< ? $i$ >>
+      | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" ->
+          <:patt< ? $i$ : ( $lid:i$ : $t$ ) >> ] ]
  ;
  class_type:
    [ [ i = LIDENT; ":"; t = ctyp LEVEL "ctyp1"; "->"; ct = SELF ->
--- a/camlp4/etc/pa_olabl.ml
+++ b/camlp4/etc/pa_olabl.ml
@ -1677,11 +1677,11 @@ EXTEND
  labeled_patt:
    [ [ i = LABEL; p = patt LEVEL "simple" -> <:patt< ~ $i$ : $p$ >>
      | i = ELABEL -> <:patt< ~ $i$ >>
-      | "?"; i = LABEL; j = LIDENT -> <:patt< ? $i$ : $lid:j$ >>
-      | "?"; "("; i = LABEL; j = LIDENT; ")" -> <:patt< ? $i$ : $lid:j$ >>
+      | "?"; i = LABEL; j = LIDENT -> <:patt< ? $i$ : ($lid:j$) >>
+      | "?"; "("; i = LABEL; j = LIDENT; ")" -> <:patt< ? $i$ : ($lid:j$) >>
      | "?"; "("; i = LABEL; j = LIDENT; "="; e = expr; ")" ->
          <:patt< ? $i$ : ( $lid:j$ = $e$ ) >>
-      | "?"; i = ELABEL -> <:patt< ? $i$ : $lid:i$ >>
+      | "?"; i = ELABEL -> <:patt< ? $i$ : ($lid:i$) >>
      | "?"; "("; i = ELABEL; "="; e = expr; ")" ->
          <:patt< ? $i$ : ( $lid:i$ = $e$ ) >> ] ]
  ;
--- a/camlp4/etc/pr_depend.ml
+++ b/camlp4/etc/pr_depend.ml
@ -172,7 +172,7 @@ and str_item =
  [ StCls _ cil -> list (fun ci -> class_expr ci.ciExp) cil
  | StDcl _ sil -> list str_item sil
  | StDir _ _ _ -> ()
-  | StExc _ _ tl -> list ctyp tl
+  | StExc _ _ tl _ -> list ctyp tl
  | StExp _ e -> expr e
  | StExt _ _ t _ -> ctyp t
  | StMod _ _ me -> module_expr me
--- a/camlp4/etc/pr_o.ml
+++ b/camlp4/etc/pr_o.ml
@ -393,7 +393,7 @@ value rec is_irrefut_patt =
      List.for_all (fun (_, p) -> is_irrefut_patt p) fpl
  | <:patt< ($p$ : $_$) >> -> is_irrefut_patt p
  | <:patt< ($list:pl$) >> -> List.for_all is_irrefut_patt pl
-  | <:patt< ? $_$ : $p$ >> -> is_irrefut_patt p
+  | <:patt< ? $_$ : ($p$) >> -> is_irrefut_patt p
  | <:patt< ? $_$ : ($p$ = $_$) >> -> is_irrefut_patt p
  | <:patt< ~ $_$ : $p$ >> -> is_irrefut_patt p
  | _ -> False ]
@ -872,9 +872,13 @@ pr_str_item.pr_levels :=
                " *)"
            in
            [: `S LR s :]
-      | <:str_item< exception $c$ of $list:tl$ >> ->
+      | <:str_item< exception $c$ of $list:tl$ = $b$ >> ->
          fun curr next dg k ->
-            [: `variant [: `S LR "exception" :] (c, tl) "" k :]
+             match b with
+            [ [] -> [: `variant [: `S LR "exception" :] (c, tl) "" k :]
+            | _ ->
+                [: `variant [: `S LR "exception" :] (c, tl) "" [: `S LR "=" :];
+                   mod_ident b "" k :] ]
      | <:str_item< include $me$ >> ->
          fun curr next dg k -> [: `S LR "include"; `module_expr me "" k :]
      | <:str_item< type $list:tdl$ >> ->
@ -1561,9 +1565,9 @@ pr_patt.pr_levels :=
      | <:patt< ~ $i$ : $p$ >> ->
          fun curr next dg k ->
            [: `S LO ("~" ^ i ^ ":"); `simple_patt p "" k :]
-      | <:patt< ? $i$ : $lid:j$ >> when i = j ->
+      | <:patt< ? $i$ : ($lid:j$) >> when i = j ->
          fun curr next dg k -> [: `S LR ("?" ^ i); k :]
-      | <:patt< ? $i$ : $p$ >> ->
+      | <:patt< ? $i$ : ($p$) >> ->
          fun curr next dg k ->
            [: `S LO ("?" ^ i ^ ":"); `simple_patt p "" k :]
      | <:patt< ? $i$ : ($lid:j$ = $e$) >> when i = j ->
--- a/camlp4/etc/pr_r.ml
+++ b/camlp4/etc/pr_r.ml
@ -296,7 +296,7 @@ value rec is_irrefut_patt =
      List.for_all (fun (_, p) -> is_irrefut_patt p) fpl
  | <:patt< ($p$ : $_$) >> -> is_irrefut_patt p
  | <:patt< ($list:pl$) >> -> List.for_all is_irrefut_patt pl
-  | <:patt< ? $_$ : $p$ >> -> is_irrefut_patt p
+  | <:patt< ? $_$ : ( $p$ ) >> -> is_irrefut_patt p
  | <:patt< ? $_$ : ($p$ = $_$) >> -> is_irrefut_patt p
  | <:patt< ~ $_$ : $p$ >> -> is_irrefut_patt p
  | _ -> False ]
@ -324,7 +324,7 @@ value rec get_defined_ident =
  | <:patt< $p1$ .. $p2$ >> -> get_defined_ident p1 @ get_defined_ident p2
  | <:patt< ($p$ : $_$) >> -> get_defined_ident p
  | <:patt< ~ $_$ : $p$ >> -> get_defined_ident p
-  | <:patt< ? $_$ : $p$ >> -> get_defined_ident p
+  | <:patt< ? $_$ : ($p$) >> -> get_defined_ident p
  | <:patt< ? $_$ : ($p$ = $e$) >> -> get_defined_ident p
  | MLast.PaAnt _ p -> get_defined_ident p ]
 ;
@ -870,9 +870,13 @@ pr_str_item.pr_levels :=
                " *)"
            in
            [: `S LR s :]
-      | <:str_item< exception $c$ of $list:tl$ >> ->
+      | <:str_item< exception $c$ of $list:tl$ = $b$ >> ->
          fun curr next _ k ->
-            [: `variant [: `S LR "exception" :] (c, tl) k :]
+            match b with
+            [ [] -> [: `variant [: `S LR "exception" :] (c, tl) k :]
+            | _ ->
+                [: `variant [: `S LR "exception" :] (c, tl) [: `S LR "=" :];
+                   mod_ident b k :] ]
      | <:str_item< include $me$ >> ->
          fun curr next _ k -> [: `S LR "include"; `module_expr me k :]
      | <:str_item< type $list:tdl$ >> ->
@ -1391,18 +1395,19 @@ pr_patt.pr_levels :=
      | <:patt< ` $i$ >> -> fun curr next _ k -> [: `S LR ("`" ^ i); k :]
      | <:patt< # $list:sl$ >> ->
          fun curr next _ k -> [: `S LO "#"; mod_ident sl k :]
-      | <:patt< ~ $i$ : $lid:j$ >> when i = j ->
-          fun curr next _ k -> [: `S LR ("~" ^ i); k :]
      | <:patt< ~ $i$ : $p$ >> ->
          fun curr next _ k -> [: `S LO ("~" ^ i ^ ":"); curr p "" k :]
-      | <:patt< ? $i$ : $lid:j$ >> when i = j ->
-          fun curr next _ k -> [: `S LR ("?" ^ i); k :]
-      | <:patt< ? $i$ : $p$ >> ->
-          fun curr next _ k -> [: `S LO ("?" ^ i ^ ":"); curr p "" k :]
-      | <:patt< ? $i$ : ($lid:j$ = $e$) >> when i = j ->
+      | <:patt< ? $i$ : ($p$ : $t$) >> ->
          fun curr next _ k ->
-            [: `S LO "?"; `S LO "("; `S LR (var_escaped j); `S LR "=";
-               `expr e [: `S RO ")"; k :] :]
+            [: `S LO ("?"^ i ^ ":"); `S LO "("; `patt p [: `S LR ":" :];
+               `ctyp t [: `S RO ")"; k :] :]
+      | <:patt< ? $i$ : ($p$) >> ->
+          fun curr next _ k ->
+            [: `S LO ("?"^ i ^ ":"); `S LO "("; `patt p [: `S RO ")"; k :] :]
+      | <:patt< ? $i$ : ($p$ : $t$ = $e$) >> ->
+          fun curr next _ k ->
+            [: `S LO ("?" ^ i ^ ":"); `S LO "("; `patt p [: `S LR ":" :];
+               `ctyp t [: `S LR "=" :]; `expr e [: `S RO ")"; k :] :]
      | <:patt< ? $i$ : ($p$ = $e$) >> ->
          fun curr next _ k ->
            [: `S LO ("?" ^ i ^ ":"); `S LO "("; `patt p [: `S LR "=" :];
--- a/camlp4/meta/pa_r.ml
+++ b/camlp4/meta/pa_r.ml
@ -180,8 +180,8 @@ EXTEND
    [ "top"
      [ "declare"; st = LIST0 [ s = str_item; ";" -> s ]; "end" ->
          <:str_item< declare $list:st$ end >>
-      | "exception"; (c, tl) = constructor_declaration ->
-          <:str_item< exception $c$ of $list:tl$ >>
+      | "exception"; (c, tl) = constructor_declaration; b = rebind_exn ->
+          <:str_item< exception $c$ of $list:tl$ = $b$ >>
      | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING ->
          <:str_item< external $i$ : $t$ = $list:pd$ >>
      | "include"; me = module_expr -> <:str_item< include $me$ >>
@ -196,6 +196,10 @@ EXTEND
          <:str_item< value $rec:o2b r$ $list:l$ >>
      | e = expr -> <:str_item< $exp:e$ >> ] ]
  ;
+  rebind_exn:
+    [ [ "="; sl = mod_ident -> sl
+      | -> [] ] ]
+  ;
  module_binding:
    [ RIGHTA
      [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF ->
@ -787,14 +791,21 @@ EXTEND
      | "#"; sl = mod_ident -> <:patt< # $list:sl$ >> ] ]
  ;
  ipatt:
-    [ [ i = TILDEIDENTCOLON; p = SELF -> <:patt< ~ $i$ : $p$ >>
-      | i = TILDEIDENT -> <:patt< ~ $i$ >>
-      | i = QUESTIONIDENTCOLON; j = LIDENT -> <:patt< ? $i$ : $lid:j$ >>
-      | i = QUESTIONIDENTCOLON; "("; j = LIDENT; "="; e = expr; ")" ->
-          <:patt< ? $i$ : ( $lid:j$ = $e$ ) >>
-      | i = QUESTIONIDENT -> <:patt< ? $i$ : $lid:i$ >>
-      | "?"; "("; i = LIDENT; "="; e = expr; ")" ->
-          <:patt< ? $i$ : ( $lid:i$ = $e$ ) >> ] ]
+    [ [ i = TILDEIDENTCOLON; p = SELF ->
+          <:patt< ~ $i$ : $p$ >>
+      | i = TILDEIDENT ->
+          <:patt< ~ $i$ >>
+      | i = QUESTIONIDENTCOLON; "("; p = ipatt; ")" ->
+          <:patt< ? $i$ : ( $p$ ) >>
+      | i = QUESTIONIDENTCOLON; "("; p = ipatt; "="; e = expr; ")" ->
+          <:patt< ? $i$ : ( $p$ = $e$ ) >>
+      | i = QUESTIONIDENTCOLON; "("; p = ipatt; ":"; t = ctyp; ")" ->
+          <:patt< ? $i$ : ( $p$ : $t$ ) >>
+      | i = QUESTIONIDENTCOLON; "("; p = ipatt; ":"; t = ctyp; "=";
+        e = expr; ")" ->
+          <:patt< ? $i$ : ( $p$ : $t$ = $e$ ) >>
+      | i = QUESTIONIDENT ->
+          <:patt< ? $i$ >> ] ]
  ;
  expr: AFTER "apply"
    [ "label"
--- a/camlp4/meta/q_MLast.ml
+++ b/camlp4/meta/q_MLast.ml
@ -124,9 +124,9 @@ EXTEND
    [ [ "declare"; st = SLIST0 [ s = str_item; ";" -> s ]; "end" ->
          Node "StDcl" [st]
      | "#"; n = lident; dp = dir_param -> Node "StDir" [n; dp]
-      | "exception"; ctl = constructor_declaration ->
+      | "exception"; ctl = constructor_declaration; b = rebind_exn ->
          match ctl with
-          [ Tuple ctl -> Node "StExc" ctl
+          [ Tuple ctl -> Node "StExc" (ctl @ [b])
          | _ -> match () with [] ]
      | "external"; i = lident; ":"; t = ctyp; "="; p = SLIST1 string ->
          Node "StExt" [i; t; p]
@ -142,6 +142,10 @@ EXTEND
      | e = expr -> Node "StExp" [e]
      | e = anti_exp -> Node "StExp" [e] ] ]
  ;
+  rebind_exn:
+    [ [ "="; sl = mod_ident -> sl
+      | -> List [] ] ]
+  ;
  module_binding:
    [ RIGHTA
      [ "("; m = uident; ":"; mt = module_type; ")"; mb = SELF ->
@ -384,12 +388,19 @@ EXTEND
    | [ p1 = SELF; p2 = SELF -> Node "PaApp" [p1; p2] ]
    | [ p1 = SELF; "."; p2 = SELF -> Node "PaAcc" [p1; p2] ]
    | NONA
-      [ "~"; i = lident; ":"; p = SELF -> Node "PaLab" [i; p]
-      | "~"; i = lident -> Node "PaLab" [i; Node "PaLid" [i]]
-      | "?"; i = lident; ":"; p = SELF -> Node "PaOlb" [i; p; Option None]
-      | "?"; i = lident; ":"; "("; p = SELF; "="; e = expr; ")" ->
-          Node "PaOlb" [i; p; Option (Some e)]
-      | "?"; i = lident -> Node "PaOlb" [i; Node "PaLid" [i]; Option None] ]
+      [ "~"; i = lident; ":"; p = SELF ->
+          Node "PaLab" [i; p]
+      | "~"; i = lident ->
+          Node "PaLab" [i; Node "PaLid" [i]]
+      | "?"; i = lident; ":"; "("; p = patt; e = OPT [ "="; e = expr -> e ];
+        ")" ->
+          Node "PaOlb" [i; p; Option e]
+      | "?"; i = lident; ":"; "("; p = patt; ":"; t = ctyp;
+        e = OPT [ "="; e = expr -> e ]; ")" ->
+          let p = Node "PaTyc" [p; t] in
+          Node "PaOlb" [i; p; Option e]
+      | "?"; i = lident ->
+          Node "PaOlb" [i; Node "PaLid" [i]; Option None] ]
    | "simple"
      [ v = LIDENT -> Node "PaLid" [Str v]
      | v = UIDENT -> Node "PaUid" [Str v]
--- a/camlp4/ocaml_src/camlp4/ast2pt.ml
+++ b/camlp4/ocaml_src/camlp4/ast2pt.ml
@ -636,8 +636,14 @@ and str_item s l =
      mkstr loc (Pstr_class_type (List.map (class_info class_type) ctd)) :: l
  | StDcl (loc, sl) -> List.fold_right str_item sl l
  | StDir (loc, _, _) -> l
-  | StExc (loc, n, tl) ->
-      mkstr loc (Pstr_exception (n, List.map ctyp tl)) :: l
+  | StExc (loc, n, tl, sl) ->
+      let si =
+        match tl, sl with
+          tl, [] -> Pstr_exception (n, List.map ctyp tl)
+        | [], sl -> Pstr_exn_rebind (n, long_id_of_string_list loc sl)
+        | _ -> error loc "bad exception declaration"
+      in
+      mkstr loc si :: l
  | StExp (loc, e) -> mkstr loc (Pstr_eval (expr e)) :: l
  | StExt (loc, n, t, p) ->
      mkstr loc (Pstr_primitive (n, mkvalue_desc t p)) :: l
--- a/camlp4/ocaml_src/camlp4/mLast.mli
+++ b/camlp4/ocaml_src/camlp4/mLast.mli
@ -136,7 +136,7 @@ and str_item =
  | StClt of loc * class_type class_infos list
  | StDcl of loc * str_item list
  | StDir of loc * string * expr option
-  | StExc of loc * string * ctyp list
+  | StExc of loc * string * ctyp list * string list
  | StExp of loc * expr
  | StExt of loc * string * ctyp * string list
  | StInc of loc * module_expr
--- a/camlp4/ocaml_src/camlp4/reloc.ml
+++ b/camlp4/ocaml_src/camlp4/reloc.ml
@ -222,7 +222,8 @@ and str_item floc sh =
        StClt (floc loc, List.map (class_infos class_type floc sh) x1)
    | StDcl (loc, x1) -> StDcl (floc loc, List.map self x1)
    | StDir (loc, x1, x2) -> StDir (floc loc, x1, x2)
-    | StExc (loc, x1, x2) -> StExc (floc loc, x1, List.map (ctyp floc sh) x2)
+    | StExc (loc, x1, x2, x3) ->
+        StExc (floc loc, x1, List.map (ctyp floc sh) x2, x3)
    | StExp (loc, x1) -> StExp (floc loc, expr floc sh x1)
    | StExt (loc, x1, x2, x3) -> StExt (floc loc, x1, ctyp floc sh x2, x3)
    | StInc (loc, x1) -> StInc (floc loc, module_expr floc sh x1)
--- a/camlp4/ocaml_src/meta/pa_r.ml
+++ b/camlp4/ocaml_src/meta/pa_r.ml
@ -148,6 +148,8 @@ Grammar.extend
   and str_item_semi : 'str_item_semi Grammar.Entry.e =
     grammar_entry_create "str_item_semi"
   and phrase : 'phrase Grammar.Entry.e = grammar_entry_create "phrase"
+   and rebind_exn : 'rebind_exn Grammar.Entry.e =
+     grammar_entry_create "rebind_exn"
   and module_binding : 'module_binding Grammar.Entry.e =
     grammar_entry_create "module_binding"
   and module_declaration : 'module_declaration Grammar.Entry.e =
@ -385,10 +387,13 @@ Grammar.extend
       Gramext.Snterm
         (Grammar.Entry.obj
            (constructor_declaration :
-             'constructor_declaration Grammar.Entry.e))],
+             'constructor_declaration Grammar.Entry.e));
+       Gramext.Snterm
+         (Grammar.Entry.obj (rebind_exn : 'rebind_exn Grammar.Entry.e))],
      Gramext.action
-        (fun (c, tl : 'constructor_declaration) _ (loc : int * int) ->
-           (MLast.StExc (loc, c, tl) : 'str_item));
+        (fun (b : 'rebind_exn) (c, tl : 'constructor_declaration) _
+           (loc : int * int) ->
+           (MLast.StExc (loc, c, tl, b) : 'str_item));
      [Gramext.Stoken ("", "declare");
       Gramext.Slist0
         (Gramext.srules
@ -401,6 +406,14 @@ Grammar.extend
      Gramext.action
        (fun _ (st : 'e__2 list) _ (loc : int * int) ->
           (MLast.StDcl (loc, st) : 'str_item))]];
+    Grammar.Entry.obj (rebind_exn : 'rebind_exn Grammar.Entry.e), None,
+    [None, None,
+     [[], Gramext.action (fun (loc : int * int) -> ([] : 'rebind_exn));
+      [Gramext.Stoken ("", "=");
+       Gramext.Snterm
+         (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))],
+      Gramext.action
+        (fun (sl : 'mod_ident) _ (loc : int * int) -> (sl : 'rebind_exn))]];
    Grammar.Entry.obj (module_binding : 'module_binding Grammar.Entry.e),
    None,
    [None, Some Gramext.RightA,
@ -2358,29 +2371,39 @@ Grammar.extend
           (MLast.PaVrn (loc, s) : 'patt))]];
    Grammar.Entry.obj (ipatt : 'ipatt Grammar.Entry.e), None,
    [None, None,
-     [[Gramext.Stoken ("", "?"); Gramext.Stoken ("", "(");
-       Gramext.Stoken ("LIDENT", ""); Gramext.Stoken ("", "=");
-       Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
-       Gramext.Stoken ("", ")")],
-      Gramext.action
-        (fun _ (e : 'expr) _ (i : string) _ _ (loc : int * int) ->
-           (MLast.PaOlb (loc, i, MLast.PaLid (loc, i), Some e) : 'ipatt));
-      [Gramext.Stoken ("QUESTIONIDENT", "")],
+     [[Gramext.Stoken ("QUESTIONIDENT", "")],
      Gramext.action
        (fun (i : string) (loc : int * int) ->
           (MLast.PaOlb (loc, i, MLast.PaLid (loc, i), None) : 'ipatt));
      [Gramext.Stoken ("QUESTIONIDENTCOLON", ""); Gramext.Stoken ("", "(");
-       Gramext.Stoken ("LIDENT", ""); Gramext.Stoken ("", "=");
+       Gramext.Sself; Gramext.Stoken ("", ":");
+       Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
+       Gramext.Stoken ("", "=");
       Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
       Gramext.Stoken ("", ")")],
      Gramext.action
-        (fun _ (e : 'expr) _ (j : string) _ (i : string) (loc : int * int) ->
-           (MLast.PaOlb (loc, i, MLast.PaLid (loc, j), Some e) : 'ipatt));
-      [Gramext.Stoken ("QUESTIONIDENTCOLON", "");
-       Gramext.Stoken ("LIDENT", "")],
+        (fun _ (e : 'expr) _ (t : 'ctyp) _ (p : 'ipatt) _ (i : string)
+           (loc : int * int) ->
+           (MLast.PaOlb (loc, i, MLast.PaTyc (loc, p, t), Some e) : 'ipatt));
+      [Gramext.Stoken ("QUESTIONIDENTCOLON", ""); Gramext.Stoken ("", "(");
+       Gramext.Sself; Gramext.Stoken ("", ":");
+       Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
+       Gramext.Stoken ("", ")")],
      Gramext.action
-        (fun (j : string) (i : string) (loc : int * int) ->
-           (MLast.PaOlb (loc, i, MLast.PaLid (loc, j), None) : 'ipatt));
+        (fun _ (t : 'ctyp) _ (p : 'ipatt) _ (i : string) (loc : int * int) ->
+           (MLast.PaOlb (loc, i, MLast.PaTyc (loc, p, t), None) : 'ipatt));
+      [Gramext.Stoken ("QUESTIONIDENTCOLON", ""); Gramext.Stoken ("", "(");
+       Gramext.Sself; Gramext.Stoken ("", "=");
+       Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
+       Gramext.Stoken ("", ")")],
+      Gramext.action
+        (fun _ (e : 'expr) _ (p : 'ipatt) _ (i : string) (loc : int * int) ->
+           (MLast.PaOlb (loc, i, p, Some e) : 'ipatt));
+      [Gramext.Stoken ("QUESTIONIDENTCOLON", ""); Gramext.Stoken ("", "(");
+       Gramext.Sself; Gramext.Stoken ("", ")")],
+      Gramext.action
+        (fun _ (p : 'ipatt) _ (i : string) (loc : int * int) ->
+           (MLast.PaOlb (loc, i, p, None) : 'ipatt));
      [Gramext.Stoken ("TILDEIDENT", "")],
      Gramext.action
        (fun (i : string) (loc : int * int) ->
--- a/camlp4/ocaml_src/meta/q_MLast.ml
+++ b/camlp4/ocaml_src/meta/q_MLast.ml
@ -124,7 +124,9 @@ Grammar.extend
   let grammar_entry_create s =
     Grammar.Entry.create (Grammar.of_entry sig_item) s
   in
-   let module_binding : 'module_binding Grammar.Entry.e =
+   let rebind_exn : 'rebind_exn Grammar.Entry.e =
+     grammar_entry_create "rebind_exn"
+   and module_binding : 'module_binding Grammar.Entry.e =
     grammar_entry_create "module_binding"
   and module_declaration : 'module_declaration Grammar.Entry.e =
     grammar_entry_create "module_declaration"
@ -399,14 +401,17 @@ Grammar.extend
       Gramext.Snterm
         (Grammar.Entry.obj
            (constructor_declaration :
-             'constructor_declaration Grammar.Entry.e))],
+             'constructor_declaration Grammar.Entry.e));
+       Gramext.Snterm
+         (Grammar.Entry.obj (rebind_exn : 'rebind_exn Grammar.Entry.e))],
      Gramext.action
-        (fun (ctl : 'constructor_declaration) _ (loc : int * int) ->
+        (fun (b : 'rebind_exn) (ctl : 'constructor_declaration) _
+           (loc : int * int) ->
           (match ctl with
-              Tuple ctl -> Node ("StExc", ctl)
+              Tuple ctl -> Node ("StExc", (ctl @ [b]))
            | _ ->
                match () with
-                _ -> raise (Match_failure ("meta/q_MLast.ml", 4375, 4391)) :
+                _ -> raise (Match_failure ("meta/q_MLast.ml", 4399, 4415)) :
            'str_item));
      [Gramext.Stoken ("", "#");
       Gramext.Snterm (Grammar.Entry.obj (lident : 'lident Grammar.Entry.e));
@ -436,6 +441,14 @@ Grammar.extend
      Gramext.action
        (fun _ (st : ast) _ (loc : int * int) ->
           (Node ("StDcl", [st]) : 'str_item))]];
+    Grammar.Entry.obj (rebind_exn : 'rebind_exn Grammar.Entry.e), None,
+    [None, None,
+     [[], Gramext.action (fun (loc : int * int) -> (List [] : 'rebind_exn));
+      [Gramext.Stoken ("", "=");
+       Gramext.Snterm
+         (Grammar.Entry.obj (mod_ident : 'mod_ident Grammar.Entry.e))],
+      Gramext.action
+        (fun (sl : 'mod_ident) _ (loc : int * int) -> (sl : 'rebind_exn))]];
    Grammar.Entry.obj (module_binding : 'module_binding Grammar.Entry.e),
    None,
    [None, Some Gramext.RightA,
@ -635,7 +648,7 @@ Grammar.extend
              Tuple ctl -> Node ("SgExc", ctl)
            | _ ->
                match () with
-                _ -> raise (Match_failure ("meta/q_MLast.ml", 6289, 6305)) :
+                _ -> raise (Match_failure ("meta/q_MLast.ml", 6388, 6404)) :
            'sig_item));
      [Gramext.Stoken ("", "#");
       Gramext.Snterm (Grammar.Entry.obj (lident : 'lident Grammar.Entry.e));
@ -1467,19 +1480,37 @@ Grammar.extend
      [Gramext.Stoken ("", "?");
       Gramext.Snterm (Grammar.Entry.obj (lident : 'lident Grammar.Entry.e));
       Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); Gramext.Sself;
-       Gramext.Stoken ("", "=");
-       Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e));
+       Gramext.Stoken ("", ":");
+       Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e));
+       Gramext.Sopt
+         (Gramext.srules
+            [[Gramext.Stoken ("", "=");
+              Gramext.Snterm
+                (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
+             Gramext.action
+               (fun (e : 'expr) _ (loc : int * int) -> (e : 'e__19))]);
       Gramext.Stoken ("", ")")],
      Gramext.action
-        (fun _ (e : 'expr) _ (p : 'patt) _ _ (i : 'lident) _
-           (loc : int * int) ->
-           (Node ("PaOlb", [i; p; Option (Some e)]) : 'patt));
+        (fun _ (e : 'e__19 option) (t : 'ctyp) _ (p : 'patt) _ _ (i : 'lident)
+           _ (loc : int * int) ->
+           (let p = Node ("PaTyc", [p; t]) in
+            Node ("PaOlb", [i; p; Option e]) :
+            'patt));
      [Gramext.Stoken ("", "?");
       Gramext.Snterm (Grammar.Entry.obj (lident : 'lident Grammar.Entry.e));
-       Gramext.Stoken ("", ":"); Gramext.Sself],
+       Gramext.Stoken ("", ":"); Gramext.Stoken ("", "("); Gramext.Sself;
+       Gramext.Sopt
+         (Gramext.srules
+            [[Gramext.Stoken ("", "=");
+              Gramext.Snterm
+                (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
             Gramext.action
-        (fun (p : 'patt) _ (i : 'lident) _ (loc : int * int) ->
-           (Node ("PaOlb", [i; p; Option None]) : 'patt));
+               (fun (e : 'expr) _ (loc : int * int) -> (e : 'e__18))]);
+       Gramext.Stoken ("", ")")],
+      Gramext.action
+        (fun _ (e : 'e__18 option) (p : 'patt) _ _ (i : 'lident) _
+           (loc : int * int) ->
+           (Node ("PaOlb", [i; p; Option e]) : 'patt));
      [Gramext.Stoken ("", "~");
       Gramext.Snterm (Grammar.Entry.obj (lident : 'lident Grammar.Entry.e))],
      Gramext.action
@ -1578,10 +1609,10 @@ Grammar.extend
              Gramext.Snterm
                (Grammar.Entry.obj (patt : 'patt Grammar.Entry.e))],
             Gramext.action
-               (fun (p : 'patt) _ (loc : int * int) -> (p : 'e__18))]);
+               (fun (p : 'patt) _ (loc : int * int) -> (p : 'e__20))]);
       Gramext.Stoken ("", "]")],
      Gramext.action
-        (fun _ (last : 'e__18 option) (pl : 'patt list) _ (loc : int * int) ->
+        (fun _ (last : 'e__20 option) (pl : 'patt list) _ (loc : int * int) ->
           (mklistpat last pl : 'patt));
      [Gramext.Stoken ("", "["); Gramext.Stoken ("", "]")],
      Gramext.action
@ -2586,9 +2617,9 @@ Grammar.extend
                  Gramext.Stoken ("", ";")],
                 Gramext.action
                   (fun _ (cf : 'class_str_item) (loc : int * int) ->
-                      (cf : 'e__19))])],
+                      (cf : 'e__21))])],
          Gramext.action
-            (fun (l : 'e__19 list) (loc : int * int) -> (list l : 'anti));
+            (fun (l : 'e__21 list) (loc : int * int) -> (list l : 'anti));
          [Gramext.Snterm
             (Grammar.Entry.obj (anti_list : 'anti_list Grammar.Entry.e))],
          Gramext.action
@ -2683,9 +2714,9 @@ Grammar.extend
                  Gramext.Stoken ("", ";")],
                 Gramext.action
                   (fun _ (s : 'class_str_item) (loc : int * int) ->
-                      (s : 'e__20))])],
+                      (s : 'e__22))])],
          Gramext.action
-            (fun (l : 'e__20 list) (loc : int * int) -> (list l : 'anti));
+            (fun (l : 'e__22 list) (loc : int * int) -> (list l : 'anti));
          [Gramext.Snterm
             (Grammar.Entry.obj (anti_list : 'anti_list Grammar.Entry.e))],
          Gramext.action
@ -2759,9 +2790,9 @@ Grammar.extend
                  Gramext.Stoken ("", ";")],
                 Gramext.action
                   (fun _ (csf : 'class_sig_item) (loc : int * int) ->
-                      (csf : 'e__21))])],
+                      (csf : 'e__23))])],
          Gramext.action
-            (fun (l : 'e__21 list) (loc : int * int) -> (list l : 'anti));
+            (fun (l : 'e__23 list) (loc : int * int) -> (list l : 'anti));
          [Gramext.Snterm
             (Grammar.Entry.obj (anti_list : 'anti_list Grammar.Entry.e))],
          Gramext.action
@ -2882,9 +2913,9 @@ Grammar.extend
                  Gramext.Stoken ("", ";")],
                 Gramext.action
                   (fun _ (s : 'class_sig_item) (loc : int * int) ->
-                      (s : 'e__22))])],
+                      (s : 'e__24))])],
          Gramext.action
-            (fun (l : 'e__22 list) (loc : int * int) -> (list l : 'anti));
+            (fun (l : 'e__24 list) (loc : int * int) -> (list l : 'anti));
          [Gramext.Snterm
             (Grammar.Entry.obj (anti_list : 'anti_list Grammar.Entry.e))],
          Gramext.action