Cleanup.

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

typing/datarepr.ml

@@ -99,14 +99,14 @@ let constructor_descrs ty_path decl cstrs =
           | _  -> (Cstr_block idx_nonconst,
                    describe_constructors idx_const (idx_nonconst+1) rem) in
 
-        let name = Ident.name cd_id in
+        let cstr_name = Ident.name cd_id in
         let existentials, cstr_args, cstr_inlined =
           constructor_args cd_args cd_res
-            (Path.Pdot (ty_path, name, Path.nopos))
+            (Path.Pdot (ty_path, cstr_name, Path.nopos))
             (Record_inlined idx_nonconst)
         in
         let cstr =
-          { cstr_name = Ident.name cd_id;
+          { cstr_name;
             cstr_res = ty_res;
             cstr_existentials = existentials;
             cstr_args;

typing/includecore.ml

@@ -120,7 +120,7 @@ type type_mismatch =
   | Field_arity of Ident.t
   | Field_names of int * Ident.t * Ident.t
   | Field_missing of bool * Ident.t
-  | Record_representation of record_representation * record_representation
+  | Record_representation of bool
 
 let report_type_mismatch0 first second decl ppf err =
   let pr fmt = Format.fprintf ppf fmt in
@@ -143,15 +143,10 @@ let report_type_mismatch0 first second decl ppf err =
   | Field_missing (b, s) ->
       pr "The field %s is only present in %s %s"
         (Ident.name s) (if b then second else first) decl
-  | Record_representation (r1, r2) ->
+  | Record_representation b ->
-      let repr = function
+      pr "Their internal representations differ:@ %s %s %s"
-        | Record_regular -> "regular"
+        (if b then second else first) decl
-        | Record_inlined _ | Record_extension -> "inlined record"
+        "uses unboxed float representation"
-        | Record_float -> "unboxed float"
-      in
-      pr "Their internal representations differ:@ %s vs %s"
-        (repr r1)
-        (repr r2)
 
 let report_type_mismatch first second decl ppf =
   List.iter
@@ -209,14 +204,6 @@ and compare_records env params1 params2 n labels1 labels2 =
       then compare_records env params1 params2 (n+1) rem1 rem2
       else [Field_type lab1]
 
-let record_representations r1 r2 =
-  match r1, r2 with
-  | Record_regular, Record_regular -> true
-  | Record_inlined i, Record_inlined j -> i = j
-  | Record_float, Record_float -> true
-  | Record_extension, Record_extension -> true
-  | _ -> false
-
 let type_declarations ?(equality = false) env name decl1 id decl2 =
   if decl1.type_arity <> decl2.type_arity then [Arity] else
   if not (private_flags decl1 decl2) then [Privacy] else
@@ -240,8 +227,8 @@ let type_declarations ?(equality = false) env name decl1 id decl2 =
     | (Type_record(labels1,rep1), Type_record(labels2,rep2)) ->
         let err = compare_records env decl1.type_params decl2.type_params
             1 labels1 labels2 in
-        if err <> [] || record_representations rep1 rep2 then err else
+        if err <> [] || rep1 = rep2 then err else
-        [Record_representation (rep1, rep2)]
+        [Record_representation (rep2 = Record_float)]
     | (Type_open, Type_open) -> []
     | (_, _) -> [Kind]
   in

typing/includecore.mli

@@ -29,7 +29,7 @@ type type_mismatch =
   | Field_arity of Ident.t
   | Field_names of int * Ident.t * Ident.t
   | Field_missing of bool * Ident.t
-  | Record_representation of record_representation * record_representation
+  | Record_representation of bool
 
 val value_descriptions:
     Env.t -> value_description -> value_description -> module_coercion

typing/mtype.ml

@@ -265,6 +265,11 @@ and contains_type_item env = function
                  {type_kind = Type_abstract; type_private = Private}),_)
   | Sig_modtype _
   | Sig_typext (_, {ext_args = Cstr_record _}, _) ->
+      (* We consider that extension constructors with an inlined
+         record create a type (the inlined record), even though
+         it would be technically safe to ignore that considering
+         the current constraints which guarantee that this type
+         is kept local to expressions.  *)
       raise Exit
   | Sig_module (_, {md_type = mty}, _) ->
       contains_type env mty

typing/typedecl.ml

@@ -414,7 +414,7 @@ let check_constraints env sdecl (_, decl) =
                 styl tyl
           | Cstr_record tyl, Pcstr_record styl ->
               check_constraints_labels env visited tyl styl
-          | _ -> assert false (* todo *)
+          | _ -> assert false
           end;
           match pcd_res, cd_res with
           | Some sr, Some r ->