Put name in the exception_declaration record.

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

16 files changed, 56 insertions, 54 deletions

diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
index fdb325ce7c..e4f532ea28 100644
--- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
+++ b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
@@ -995,10 +995,9 @@ value varify_constructors var_names =
     | <:sig_item< $sg1$; $sg2$ >> -> sig_item sg1 (sig_item sg2 l)
     | SgDir _ _ _ -> l
     | <:sig_item@loc< exception $uid:s$ >> ->
-        [mksig loc (Psig_exception (with_loc (conv_con s) loc) {ped_args=[]; ped_attributes=[]}) :: l]
+        [mksig loc (Psig_exception {ped_name=with_loc (conv_con s) loc; ped_args=[]; ped_attributes=[]}) :: l]
     | <:sig_item@loc< exception $uid:s$ of $t$ >> ->
-        [mksig loc (Psig_exception (with_loc (conv_con s) loc)
-                                   {ped_args=List.map ctyp (list_of_ctyp t []); ped_attributes=[]}) :: l]
+        [mksig loc (Psig_exception {ped_name=with_loc (conv_con s) loc; ped_args=List.map ctyp (list_of_ctyp t []); ped_attributes=[]}) :: l]
     | SgExc _ _ -> assert False (*FIXME*)
     | SgExt loc n t sl -> [mksig loc (Psig_value (with_loc n loc) (mkvalue_desc loc t (list_of_meta_list sl))) :: l]
     | SgInc loc mt -> [mksig loc (Psig_include (module_type mt) []) :: l]
@@ -1063,10 +1062,9 @@ value varify_constructors var_names =
     | <:str_item< $st1$; $st2$ >> -> str_item st1 (str_item st2 l)
     | StDir _ _ _ -> l
     | <:str_item@loc< exception $uid:s$ >> ->
-        [mkstr loc (Pstr_exception (with_loc (conv_con s) loc) {ped_args=[]; ped_attributes=[]}) :: l ]
+        [mkstr loc (Pstr_exception {ped_name=with_loc (conv_con s) loc; ped_args=[]; ped_attributes=[]}) :: l ]
     | <:str_item@loc< exception $uid:s$ of $t$ >> ->
-        [mkstr loc (Pstr_exception (with_loc (conv_con s) loc)
-                      {ped_args=List.map ctyp (list_of_ctyp t []);ped_attributes=[]}) :: l ]
+        [mkstr loc (Pstr_exception {ped_name=with_loc (conv_con s) loc; ped_args=List.map ctyp (list_of_ctyp t []);ped_attributes=[]}) :: l ]
     | <:str_item@loc< exception $uid:s$ = $i$ >> ->
         [mkstr loc (Pstr_exn_rebind (with_loc (conv_con s) loc) (long_uident ~conv_con i)) :: l ]
     | <:str_item@loc< exception $uid:_$ of $_$ = $_$ >> ->
diff --git a/camlp4/boot/Camlp4.ml b/camlp4/boot/Camlp4.ml
index 1eca26077b..290ec19ad1 100644
--- a/camlp4/boot/Camlp4.ml
+++ b/camlp4/boot/Camlp4.ml
@@ -15317,14 +15317,14 @@ module Struct =
               | SgDir (_, _, _) -> l
               | Ast.SgExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s))))) ->
                   (mksig loc
-                     (Psig_exception ((with_loc (conv_con s) loc), {ped_args=[];ped_attributes=[]}))) ::
+                     (Psig_exception {ped_name=with_loc (conv_con s) loc; ped_args=[];ped_attributes=[]})) ::
                     l
               | Ast.SgExc (loc,
                   (Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, s)))), t))) ->
                   (mksig loc
-                     (Psig_exception ((with_loc (conv_con s) loc),
-                                      {ped_args=List.map ctyp (list_of_ctyp t []);
-                                       ped_attributes = []}))) :: l
+                     (Psig_exception {ped_name=with_loc (conv_con s) loc;
+                                      ped_args=List.map ctyp (list_of_ctyp t []);
+                                      ped_attributes = []})) :: l
               | SgExc (_, _) -> assert false
               | SgExt (loc, n, t, sl) ->
                   (mksig loc
@@ -15418,14 +15418,13 @@ module Struct =
               | Ast.StExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), Ast.
                   ONone) ->
                   (mkstr loc
-                     (Pstr_exception ((with_loc (conv_con s) loc), {ped_args=[];ped_attributes=[]}))) ::
+                     (Pstr_exception {ped_name=with_loc (conv_con s) loc;ped_args=[];ped_attributes=[]})) ::
                     l
               | Ast.StExc (loc,
                   (Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, s)))), t)), Ast.
                   ONone) ->
                   (mkstr loc
-                     (Pstr_exception ((with_loc (conv_con s) loc),
-                        {ped_args=List.map ctyp (list_of_ctyp t []);ped_attributes=[]}))) ::
+                     (Pstr_exception {ped_name=with_loc (conv_con s) loc; ped_args=List.map ctyp (list_of_ctyp t []);ped_attributes=[]})) ::
                     l
               | Ast.StExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))),
                   (Ast.OSome i)) ->
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index 89c4af5fac..d72ca69e33 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -1231,7 +1231,8 @@ module Analyser =
             let (maybe_more, eles) = f ~first: true 0 loc.Location.loc_start.Lexing.pos_cnum name_typedecl_list in
             (maybe_more, new_env, eles)
 
-      | Parsetree.Pstr_exception (name, excep_decl) ->
+      | Parsetree.Pstr_exception excep_decl ->
+          let name = excep_decl.Parsetree.ped_name in
           (* a new exception is defined *)
           let complete_name = Name.concat current_module_name name.txt in
           (* we get the exception declaration in the typed tree *)
diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml
index 7453da78a3..4dc803320b 100644
--- a/ocamldoc/odoc_sig.ml
+++ b/ocamldoc/odoc_sig.ml
@@ -270,7 +270,7 @@ module Analyser =
         match sig_item.Parsetree.psig_desc with
         | Parsetree.Psig_extension _
         | Parsetree.Psig_value (_, _)
-        | Parsetree.Psig_exception (_, _)
+        | Parsetree.Psig_exception _
         | Parsetree.Psig_open _
         | Parsetree.Psig_include _
         | Parsetree.Psig_class _
@@ -553,7 +553,8 @@ module Analyser =
             let new_env = Odoc_env.add_value env v.val_name in
             (maybe_more, new_env, [ Element_value v ])
 
-        | Parsetree.Psig_exception (name, exception_decl) ->
+        | Parsetree.Psig_exception exception_decl ->
+            let name = exception_decl.Parsetree.ped_name in
             let types_excep_decl =
               try Signature_search.search_exception table name.txt
               with Not_found ->
diff --git a/otherlibs/labltk/browser/searchid.ml b/otherlibs/labltk/browser/searchid.ml
index 2da2ce7764..2ec2d30992 100644
--- a/otherlibs/labltk/browser/searchid.ml
+++ b/otherlibs/labltk/browser/searchid.ml
@@ -467,7 +467,7 @@ let search_structure str ~name ~kind ~prefix =
               if s.txt = name then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
             end;
           false
-      | Pstr_exception (s, _) when kind = Pconstructor -> name = s.txt
+      | Pstr_exception ped when kind = Pconstructor -> name = ped.ped_name.txt
       | Pstr_module (s, _) when kind = Pmodule -> name = s.txt
       | Pstr_modtype (s, _) when kind = Pmodtype -> name = s.txt
       | Pstr_class l when kind = Pclass || kind = Ptype || kind = Pcltype ->
@@ -520,7 +520,7 @@ let search_signature sign ~name ~kind ~prefix =
               if s.txt = name then loc := td.ptype_loc.loc_start.Lexing.pos_cnum
             end;
           false
-      | Psig_exception (s, _) when kind = Pconstructor -> name = s.txt
+      | Psig_exception ped when kind = Pconstructor -> name = ped.ped_name.txt
       | Psig_module pmd when kind = Pmodule -> name = pmd.pmd_name.txt
       | Psig_modtype (s, _, _) when kind = Pmodtype -> name = s.txt
       | Psig_class l when kind = Pclass || kind = Ptype || kind = Pcltype ->
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index 34d90e3ba2..8d6ae13cb5 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -205,7 +205,7 @@ let rec search_pos_signature l ~pos ~env =
         Psig_value (_, desc) -> search_pos_type desc.pval_type ~pos ~env
       | Psig_type l ->
           List.iter l ~f:(fun (_,desc) -> search_pos_type_decl ~pos desc ~env)
-      | Psig_exception (_, ped) ->
+      | Psig_exception ped ->
           List.iter ped.ped_args ~f:(search_pos_type ~pos ~env);
           add_found_sig (`Type, Lident "exn") ~env ~loc:pt.psig_loc
       | Psig_module pmd ->
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index 4679649ddf..df99b34d0f 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -196,7 +196,7 @@ module MT = struct
 
   let value ?loc a b = mk_item ?loc (Psig_value (a, b))
   let type_ ?loc a = mk_item ?loc (Psig_type a)
-  let exception_ ?loc a b = mk_item ?loc (Psig_exception (a, b))
+  let exception_ ?loc a = mk_item ?loc (Psig_exception a)
   let module_ ?loc a = mk_item ?loc (Psig_module a)
   let rec_module ?loc a = mk_item ?loc (Psig_recmodule a)
   let modtype ?loc ?(attributes = []) a b = mk_item ?loc (Psig_modtype (a, b, attributes))
@@ -211,7 +211,7 @@ module MT = struct
     match desc with
     | Psig_value (s, vd) -> value ~loc (map_loc sub s) (sub # value_description vd)
     | Psig_type l -> type_ ~loc (List.map (map_tuple (map_loc sub) (sub # type_declaration)) l)
-    | Psig_exception (s, ed) -> exception_ ~loc (map_loc sub s) (sub # exception_declaration ed)
+    | Psig_exception ed -> exception_ ~loc (sub # exception_declaration ed)
     | Psig_module x -> module_ ~loc (sub # module_declaration x)
     | Psig_recmodule l -> rec_module ~loc (List.map (sub # module_declaration) l)
     | Psig_modtype (s, Pmodtype_manifest mt, attrs) -> modtype ~loc (map_loc sub s) (Pmodtype_manifest  (sub # module_type mt)) ~attributes:(map_attributes sub attrs)
@@ -254,7 +254,7 @@ module M = struct
   let value ?loc a b = mk_item ?loc (Pstr_value (a, b))
   let primitive ?loc a b = mk_item ?loc (Pstr_primitive (a, b))
   let type_ ?loc a = mk_item ?loc (Pstr_type a)
-  let exception_ ?loc a b = mk_item ?loc (Pstr_exception (a, b))
+  let exception_ ?loc a = mk_item ?loc (Pstr_exception a)
   let exn_rebind ?loc a b = mk_item ?loc (Pstr_exn_rebind (a, b))
   let module_ ?loc a b = mk_item ?loc (Pstr_module (a, b))
   let rec_module ?loc a = mk_item ?loc (Pstr_recmodule a)
@@ -272,7 +272,7 @@ module M = struct
     | Pstr_value (r, pel) -> value ~loc r (List.map (map_tuple (sub # pat) (sub # expr)) pel)
     | Pstr_primitive (name, vd) -> primitive ~loc (map_loc sub name) (sub # value_description vd)
     | Pstr_type l -> type_ ~loc (List.map (map_tuple (map_loc sub) (sub # type_declaration)) l)
-    | Pstr_exception (name, ed) -> exception_ ~loc (map_loc sub name) (sub # exception_declaration ed)
+    | Pstr_exception ed -> exception_ ~loc (sub # exception_declaration ed)
     | Pstr_exn_rebind (s, lid) -> exn_rebind ~loc (map_loc sub s) (map_loc sub lid)
     | Pstr_module (s, m) -> module_ ~loc (map_loc sub s) (sub # module_expr m)
     | Pstr_recmodule l -> rec_module ~loc (List.map (fun (s, mty, me) -> (map_loc sub s, sub # module_type mty, sub # module_expr me)) l)
@@ -529,13 +529,14 @@ class mapper =
 
     method exception_declaration ped =
       {
+       ped_name = map_loc this ped.ped_name;
        ped_args = List.map (this # typ) ped.ped_args;
        ped_attributes = map_attributes this ped.ped_attributes;
       }
     method module_declaration pmd =
       {
-       pmd_name = pmd.pmd_name;
-       pmd_type = pmd.pmd_type;
+       pmd_name = map_loc this pmd.pmd_name;
+       pmd_type = this # module_type pmd.pmd_type;
        pmd_attributes = map_attributes this pmd.pmd_attributes;
       }
 
diff --git a/parsing/ast_mapper.mli b/parsing/ast_mapper.mli
index 55eab2c0e3..f79f0f1446 100644
--- a/parsing/ast_mapper.mli
+++ b/parsing/ast_mapper.mli
@@ -146,7 +146,7 @@ module MT:
     val mk_item: ?loc:Location.t -> signature_item_desc -> signature_item
     val value: ?loc:Location.t -> string loc -> value_description -> signature_item
     val type_: ?loc:Location.t -> (string loc * type_declaration) list -> signature_item
-    val exception_: ?loc:Location.t -> string loc -> exception_declaration -> signature_item
+    val exception_: ?loc:Location.t -> exception_declaration -> signature_item
     val module_: ?loc:Location.t -> module_declaration -> signature_item
     val rec_module: ?loc:Location.t -> module_declaration list -> signature_item
     val modtype: ?loc:Location.t -> ?attributes:Parsetree.attribute list -> string loc -> modtype_declaration -> signature_item
@@ -172,7 +172,7 @@ module M:
     val value: ?loc:Location.t -> rec_flag -> (pattern * expression) list -> structure_item
     val primitive: ?loc:Location.t -> string loc -> value_description -> structure_item
     val type_: ?loc:Location.t -> (string loc * type_declaration) list -> structure_item
-    val exception_: ?loc:Location.t -> string loc -> exception_declaration -> structure_item
+    val exception_: ?loc:Location.t -> exception_declaration -> structure_item
     val exn_rebind: ?loc:Location.t -> string loc -> Longident.t loc -> structure_item
     val module_: ?loc:Location.t -> string loc -> module_expr -> structure_item
     val rec_module: ?loc:Location.t -> (string loc * module_type * module_expr)      list -> structure_item
diff --git a/parsing/parser.mly b/parsing/parser.mly
index b7764b82df..c8ee4a9f37 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -620,7 +620,7 @@ structure_item:
        mkstr(Pstr_type l)
        }
   | pre_item_attributes EXCEPTION UIDENT constructor_arguments post_item_attributes
-      { mkstr(Pstr_exception(mkrhs $3 3, {ped_args=$4;ped_attributes=$1 @ $5})) }
+      { mkstr(Pstr_exception {ped_name=mkrhs $3 3; ped_args=$4;ped_attributes=$1 @ $5}) }
   | pre_item_attributes EXCEPTION UIDENT EQUAL constr_longident post_item_attributes
       { mkstr(Pstr_exn_rebind(mkrhs $3 3, mkloc $5 (rhs_loc 5))) (* todo: keep attributes *) }
   | MODULE UIDENT module_binding
@@ -709,7 +709,7 @@ signature_item:
        mksig(Psig_type l)
        }
   | pre_item_attributes EXCEPTION UIDENT constructor_arguments post_item_attributes
-      { mksig(Psig_exception(mkrhs $3 3, {ped_args = $4; ped_attributes = $1 @ $5})) }
+      { mksig(Psig_exception {ped_name=mkrhs $3 3; ped_args = $4; ped_attributes = $1 @ $5}) }
   | pre_item_attributes MODULE UIDENT module_declaration post_item_attributes
       { mksig(Psig_module{pmd_name=mkrhs $3 3;pmd_type=$4;pmd_attributes=$1 @ $5}) }
   | pre_item_attributes MODULE REC module_rec_declarations
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index aa959f38ea..1a53ead35e 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -172,6 +172,7 @@ and constructor_declaration =
 
 and exception_declaration =
     {
+     ped_name: string loc;
      ped_args: core_type list;
      ped_attributes: attribute list;
     }
@@ -268,7 +269,7 @@ and signature_item =
 and signature_item_desc =
     Psig_value of string loc * value_description
   | Psig_type of (string loc * type_declaration) list
-  | Psig_exception of string loc * exception_declaration
+  | Psig_exception of exception_declaration
   | Psig_module of module_declaration
   | Psig_recmodule of module_declaration list
   | Psig_modtype of string loc * modtype_declaration * attribute list
@@ -322,7 +323,7 @@ and structure_item_desc =
   | Pstr_value of rec_flag * (pattern * expression) list
   | Pstr_primitive of string loc * value_description
   | Pstr_type of (string loc * type_declaration) list
-  | Pstr_exception of string loc * exception_declaration
+  | Pstr_exception of exception_declaration
   | Pstr_exn_rebind of string loc * Longident.t loc
   | Pstr_module of string loc * module_expr
   | Pstr_recmodule of (string loc * module_type * module_expr) list
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index 78640ece75..36b53090a2 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -697,8 +697,8 @@ class printer  ()= object(self:'self)
         end) x
 
 
-  method exception_declaration f (s,ed) =
-    pp f "@[<hov2>exception@ %s%a@]" s
+  method exception_declaration f ed =
+    pp f "@[<hov2>exception@ %s%a@]" ed.ped_name.txt
       (fun f ed -> match ed with
       |[] -> ()
       |_ -> pp f "@ of@ %a" (self#list ~sep:"*" self#core_type) ed) ed.ped_args
@@ -872,8 +872,8 @@ class printer  ()= object(self:'self)
             else
               pp f "%s@ %s@ :@ " intro s.txt;
             self#value_description f vd;) (s,vd)
-    | Psig_exception (s, ed) ->
-        self#exception_declaration f (s.txt,ed)
+    | Psig_exception ed ->
+        self#exception_declaration f ed
     | Psig_class l ->
         let class_description f ({pci_params=(ls,_);pci_name={txt;_};pci_variance;_} as x) =
           pp f "%a%a%s@;:@;%a" (* "@[<2>class %a%a%s@;:@;%a@]" *)
@@ -1009,7 +1009,7 @@ class printer  ()= object(self:'self)
     | Pstr_type l  -> self#type_def_list f l 
     | Pstr_value (rf, l) -> (* pp f "@[<hov2>let %a%a@]"  self#rec_flag rf self#bindings l *)
         pp f "@[<2>%a@]" self#bindings (rf,l)
-    | Pstr_exception (s, ed) -> self#exception_declaration f (s.txt,ed)
+    | Pstr_exception ed -> self#exception_declaration f ed
     | Pstr_module (s, me) ->
         let rec module_helper me = match me.pmod_desc with
         | Pmod_functor(s,mt,me) ->
diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli
index 97c38b1593..e99715373d 100644
--- a/parsing/pprintast.mli
+++ b/parsing/pprintast.mli
@@ -45,7 +45,7 @@ class printer :
     method directive_argument :
       Format.formatter -> Parsetree.directive_argument -> unit
     method exception_declaration :
-      Format.formatter -> string * Parsetree.exception_declaration -> unit
+      Format.formatter -> Parsetree.exception_declaration -> unit
     method expression : Format.formatter -> Parsetree.expression -> unit
     method expression1 : Format.formatter -> Parsetree.expression -> unit
     method expression2 : Format.formatter -> Parsetree.expression -> unit
diff --git a/parsing/printast.ml b/parsing/printast.ml
index e99baffe29..4c14223247 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -407,6 +407,7 @@ and type_kind i ppf x =
       list (i+1) string_x_mutable_flag_x_core_type_x_location ppf l;
 
 and exception_declaration i ppf x =
+  string_loc i ppf x.ped_name;
   list i core_type ppf x.ped_args;
   attributes i ppf x.ped_attributes
 
@@ -587,8 +588,8 @@ and signature_item i ppf x =
   | Psig_type (l) ->
       line i ppf "Psig_type\n";
       list i string_x_type_declaration ppf l;
-  | Psig_exception (s, ed) ->
-      line i ppf "Psig_exception %a\n" fmt_string_loc s;
+  | Psig_exception ed ->
+      line i ppf "Psig_exception\n";
       exception_declaration i ppf ed;
   | Psig_module pmd ->
       line i ppf "Psig_module %a\n" fmt_string_loc pmd.pmd_name;
@@ -686,9 +687,8 @@ and structure_item i ppf x =
   | Pstr_type l ->
       line i ppf "Pstr_type\n";
       list i string_x_type_declaration ppf l;
-  | Pstr_exception (s, ed) ->
-      line i ppf "Pstr_exception %a\n" fmt_string_loc s;
-      exception_declaration i ppf ed;
+  | Pstr_exception ed ->
+      exception_declaration i ppf ed
   | Pstr_exn_rebind (s, li) ->
       line i ppf "Pstr_exn_rebind\n";
       line (i+1) ppf "%a\n" fmt_string_loc s;
diff --git a/tools/depend.ml b/tools/depend.ml
index 7c5d284fbc..05b9c92905 100644
--- a/tools/depend.ml
+++ b/tools/depend.ml
@@ -221,7 +221,7 @@ and add_sig_item bv item =
       add_type bv vd.pval_type; bv
   | Psig_type dcls ->
       List.iter (fun (id, td) -> add_type_declaration bv td) dcls; bv
-  | Psig_exception(id, ped) ->
+  | Psig_exception ped ->
       List.iter (add_type bv) ped.ped_args; bv
   | Psig_module pmd ->
       add_modtype bv pmd.pmd_type; StringSet.add pmd.pmd_name.txt bv
@@ -277,7 +277,7 @@ and add_struct_item bv item =
       add_type bv vd.pval_type; bv
   | Pstr_type dcls ->
       List.iter (fun (id, td) -> add_type_declaration bv td) dcls; bv
-  | Pstr_exception(id, ped) ->
+  | Pstr_exception ped ->
       List.iter (add_type bv) ped.ped_args; bv
   | Pstr_exn_rebind(id, l) ->
       add bv l; bv
diff --git a/tools/untypeast.ml b/tools/untypeast.ml
index dd2e7e9f27..8e193a0d14 100644
--- a/tools/untypeast.ml
+++ b/tools/untypeast.ml
@@ -53,7 +53,7 @@ and untype_structure_item item =
         Pstr_type (List.map (fun (_id, name, decl) ->
               name, untype_type_declaration decl) list)
     | Tstr_exception (_id, name, decl) ->
-        Pstr_exception (name, untype_exception_declaration decl)
+        Pstr_exception (untype_exception_declaration name decl)
     | Tstr_exn_rebind (_id, name, _p, lid) ->
         Pstr_exn_rebind (name, lid)
     | Tstr_module (_id, name, mexpr) ->
@@ -127,8 +127,9 @@ and untype_type_declaration decl =
     ptype_loc = decl.typ_loc;
   }
 
-and untype_exception_declaration decl =
+and untype_exception_declaration name decl =
   {
+   ped_name = name;
    ped_args = List.map untype_core_type decl.exn_params;
    ped_attributes = [];
   }
@@ -316,7 +317,7 @@ and untype_signature_item item =
               name, untype_type_declaration decl
           ) list)
     | Tsig_exception (_id, name, decl) ->
-        Psig_exception (name, untype_exception_declaration decl)
+        Psig_exception (untype_exception_declaration name decl)
     | Tsig_module (_id, name, mtype) ->
         Psig_module {pmd_name = name; pmd_type = untype_module_type mtype; pmd_attributes = []}
     | Tsig_recmodule list ->
@@ -349,7 +350,7 @@ and untype_class_description cd =
     pci_expr = untype_class_type cd.ci_expr;
     pci_variance = cd.ci_variance;
     pci_loc = cd.ci_loc;
-   pci_attributes = [];
+    pci_attributes = [];
   }
 
 and untype_class_type_declaration cd =
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 548428a582..0ad93e4018 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -481,11 +481,11 @@ and transl_signature env sg =
             map_rec'' (fun rs (id, _, info) ->
                 Sig_type(id, info.typ_type, rs)) decls rem,
             final_env
-        | Psig_exception(name, sarg) ->
+        | Psig_exception sarg ->
             let arg = Typedecl.transl_exception env item.psig_loc sarg in
-            let (id, newenv) = Env.enter_exception name.txt arg.exn_exn env in
+            let (id, newenv) = Env.enter_exception sarg.ped_name.txt arg.exn_exn env in
             let (trem, rem, final_env) = transl_sig newenv srem in
-            mksig (Tsig_exception (id, name, arg)) env loc :: trem,
+            mksig (Tsig_exception (id, sarg.ped_name, arg)) env loc :: trem,
             Sig_exception(id, arg.exn_exn) :: rem,
             final_env
         | Psig_module pmd ->
@@ -994,10 +994,10 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
          map_rec'' (fun rs (id, _, info) -> Sig_type(id, info.typ_type, rs))
            decls sig_rem,
          final_env)
-    | Pstr_exception(name, sarg) ->
+    | Pstr_exception sarg ->
         let arg = Typedecl.transl_exception env loc sarg in
-        let (id, newenv) = Env.enter_exception name.txt arg.exn_exn env in
-        let item = mk (Tstr_exception(id, name, arg)) in
+        let (id, newenv) = Env.enter_exception sarg.ped_name.txt arg.exn_exn env in
+        let item = mk (Tstr_exception(id, sarg.ped_name, arg)) in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (item :: str_rem,
          Sig_exception(id, arg.exn_exn) :: sig_rem,