PR#5584: merge open extensible types, extension-patch-4.0.2

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

1 files changed, 20 insertions, 20 deletions

diff --git a/typing/includemod.ml b/typing/includemod.ml
index 54aca4a7c4..9bdebd6701 100644
--- a/typing/includemod.ml
+++ b/typing/includemod.ml
@@ -22,8 +22,8 @@ type symptom =
   | Value_descriptions of Ident.t * value_description * value_description
   | Type_declarations of Ident.t * type_declaration
         * type_declaration * Includecore.type_mismatch list
-  | Exception_declarations of
-      Ident.t * exception_declaration * exception_declaration
+  | Extension_constructors of
+      Ident.t * extension_constructor * extension_constructor
   | Module_types of module_type * module_type
   | Modtype_infos of Ident.t * modtype_declaration * modtype_declaration
   | Modtype_permutation
@@ -68,14 +68,13 @@ let type_declarations env cxt subst id decl1 decl2 =
   if err <> [] then
     raise(Error[cxt, env, Type_declarations(id, decl1, decl2, err)])
 
-(* Inclusion between exception declarations *)
+(* Inclusion between extension constructors *)
 
-let exception_declarations env cxt subst id decl1 decl2 =
-  Env.mark_exception_used Env.Positive decl1 (Ident.name id);
-  let decl2 = Subst.exception_declaration subst decl2 in
-  if Includecore.exception_declarations env decl1 decl2
+let extension_constructors env cxt subst id ext1 ext2 =
+  let ext2 = Subst.extension_constructor subst ext2 in
+  if Includecore.extension_constructors env id ext1 ext2
   then ()
-  else raise(Error[cxt, env, Exception_declarations(id, decl1, decl2)])
+  else raise(Error[cxt, env, Extension_constructors(id, ext1, ext2)])
 
 (* Inclusion between class declarations *)
 
@@ -124,7 +123,7 @@ let rec normalize_module_path env cxt path =
 type field_desc =
     Field_value of string
   | Field_type of string
-  | Field_exception of string
+  | Field_typext of string
   | Field_module of string
   | Field_modtype of string
   | Field_class of string
@@ -133,7 +132,7 @@ type field_desc =
 let kind_of_field_desc = function
   | Field_value _ -> "value"
   | Field_type _ -> "type"
-  | Field_exception _ -> "exception"
+  | Field_typext _ -> "extension constructor"
   | Field_module _ -> "module"
   | Field_modtype _ -> "module type"
   | Field_class _ -> "class"
@@ -142,7 +141,7 @@ let kind_of_field_desc = function
 let item_ident_name = function
     Sig_value(id, d) -> (id, d.val_loc, Field_value(Ident.name id))
   | Sig_type(id, d, _) -> (id, d.type_loc, Field_type(Ident.name id))
-  | Sig_exception(id, d) -> (id, d.exn_loc, Field_exception(Ident.name id))
+  | Sig_typext(id, d, _) -> (id, d.ext_loc, Field_typext(Ident.name id))
   | Sig_module(id, d, _) -> (id, d.md_loc, Field_module(Ident.name id))
   | Sig_modtype(id, d) -> (id, d.mtd_loc, Field_modtype(Ident.name id))
   | Sig_class(id, d, _) -> (id, d.cty_loc, Field_class(Ident.name id))
@@ -154,7 +153,7 @@ let is_runtime_component = function
   | Sig_modtype(_,_)
   | Sig_class_type(_,_,_) -> false
   | Sig_value(_,_)
-  | Sig_exception(_,_)
+  | Sig_typext(_,_,_)
   | Sig_module(_,_,_)
   | Sig_class(_, _,_) -> true
 
@@ -312,7 +311,8 @@ and signatures env cxt subst sig1 sig2 =
                 Subst.add_module id2 (Pident id1) subst
             | Sig_modtype _ ->
                 Subst.add_modtype id2 (Mty_ident (Pident id1)) subst
-            | Sig_value _ | Sig_exception _ | Sig_class _ | Sig_class_type _ ->
+            | Sig_value _ | Sig_typext _
+            | Sig_class _ | Sig_class_type _ ->
                 subst
           in
           pair_components new_subst
@@ -341,9 +341,9 @@ and signature_components env cxt subst = function
   | (Sig_type(id1, tydecl1, _), Sig_type(id2, tydecl2, _), pos) :: rem ->
       type_declarations env cxt subst id1 tydecl1 tydecl2;
       signature_components env cxt subst rem
-  | (Sig_exception(id1, excdecl1), Sig_exception(id2, excdecl2), pos)
+  | (Sig_typext(id1, ext1, _), Sig_typext(id2, ext2, _), pos)
     :: rem ->
-      exception_declarations env cxt subst id1 excdecl1 excdecl2;
+      extension_constructors env cxt subst id1 ext1 ext2;
       (pos, Tcoerce_none) :: signature_components env cxt subst rem
   | (Sig_module(id1, mty1, _), Sig_module(id2, mty2, _), pos) :: rem ->
       let cc =
@@ -447,13 +447,13 @@ let include_err ppf = function
         show_locs (d1.type_loc, d2.type_loc)
         (Includecore.report_type_mismatch
            "the first" "the second" "declaration") errs
-  | Exception_declarations(id, d1, d2) ->
+  | Extension_constructors(id, x1, x2) ->
       fprintf ppf
-       "@[<hv 2>Exception declarations do not match:@ \
+       "@[<hv 2>Extension declarations do not match:@ \
         %a@;<1 -2>is not included in@ %a@]"
-        (exception_declaration id) d1
-        (exception_declaration id) d2;
-      show_locs ppf (d1.exn_loc, d2.exn_loc)
+      (extension_constructor id) x1
+      (extension_constructor id) x2;
+      show_locs ppf (x1.ext_loc, x2.ext_loc)
   | Module_types(mty1, mty2)->
       fprintf ppf
        "@[<hv 2>Modules do not match:@ \