Resolve PR#6742: remove duplicate virtual_flag information from Tstr_class

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

7 files changed, 19 insertions, 22 deletions

diff --git a/typing/printtyped.ml b/typing/printtyped.ml
index 3965b2284..4111c4836 100644
--- a/typing/printtyped.ml
+++ b/typing/printtyped.ml
@@ -751,7 +751,7 @@ and structure_item i ppf x =
       attributes i ppf od.open_attributes
   | Tstr_class (l) ->
       line i ppf "Tstr_class\n";
-      list i class_declaration ppf (List.map (fun (cl, _,_) -> cl) l);
+      list i class_declaration ppf (List.map (fun (cl, _) -> cl) l);
   | Tstr_class_type (l) ->
       line i ppf "Tstr_class_type\n";
       list i class_type_declaration ppf (List.map (fun (_, _, cl) -> cl) l);
diff --git a/typing/tast_mapper.ml b/typing/tast_mapper.ml
index 400ad38f9..6f3236ea2 100644
--- a/typing/tast_mapper.ml
+++ b/typing/tast_mapper.ml
@@ -111,7 +111,7 @@ let structure_item sub {str_desc; str_loc; str_env} =
     | Tstr_modtype x -> Tstr_modtype (sub.module_type_declaration sub x)
     | Tstr_class list ->
         Tstr_class
-          (List.map (tuple3 (sub.class_declaration sub) id id) list)
+          (List.map (tuple2 (sub.class_declaration sub) id) list)
     | Tstr_class_type list ->
         Tstr_class_type
           (List.map (tuple3 id id (sub.class_type_declaration sub)) list)
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index 9483449c0..1f49ac202 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -217,7 +217,7 @@ and structure_item_desc =
   | Tstr_recmodule of module_binding list
   | Tstr_modtype of module_type_declaration
   | Tstr_open of open_description
-  | Tstr_class of (class_declaration * string list * virtual_flag) list
+  | Tstr_class of (class_declaration * string list) list
   | Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
   | Tstr_include of include_declaration
   | Tstr_attribute of attribute
@@ -441,9 +441,9 @@ and extension_constructor =
   {
     ext_id: Ident.t;
     ext_name: string loc;
-    ext_type : Types.extension_constructor;
-    ext_kind : extension_constructor_kind;
-    ext_loc : Location.t;
+    ext_type: Types.extension_constructor;
+    ext_kind: extension_constructor_kind;
+    ext_loc: Location.t;
     ext_attributes: attribute list;
   }
 
@@ -466,9 +466,9 @@ and class_type_desc =
   | Tcty_arrow of arg_label * core_type * class_type
 
 and class_signature = {
-    csig_self : core_type;
-    csig_fields : class_type_field list;
-    csig_type : Types.class_signature;
+    csig_self: core_type;
+    csig_fields: class_type_field list;
+    csig_type: Types.class_signature;
   }
 
 and class_type_field = {
@@ -496,14 +496,14 @@ and class_type_declaration =
 and 'a class_infos =
   { ci_virt: virtual_flag;
     ci_params: (core_type * variance) list;
-    ci_id_name : string loc;
+    ci_id_name: string loc;
     ci_id_class: Ident.t;
-    ci_id_class_type : Ident.t;
-    ci_id_object : Ident.t;
-    ci_id_typesharp : Ident.t;
+    ci_id_class_type: Ident.t;
+    ci_id_object: Ident.t;
+    ci_id_typesharp: Ident.t;
     ci_expr: 'a;
     ci_decl: Types.class_declaration;
-    ci_type_decl : Types.class_type_declaration;
+    ci_type_decl: Types.class_type_declaration;
     ci_loc: Location.t;
     ci_attributes: attribute list;
    }
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index 4f0e32ce9..8e3986df5 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -216,7 +216,7 @@ and structure_item_desc =
   | Tstr_recmodule of module_binding list
   | Tstr_modtype of module_type_declaration
   | Tstr_open of open_description
-  | Tstr_class of (class_declaration * string list * virtual_flag) list
+  | Tstr_class of (class_declaration * string list) list
   | Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
   | Tstr_include of include_declaration
   | Tstr_attribute of attribute
diff --git a/typing/typedtreeIter.ml b/typing/typedtreeIter.ml
index 28026b598..c0e64e18b 100644
--- a/typing/typedtreeIter.ml
+++ b/typing/typedtreeIter.ml
@@ -141,7 +141,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
         | Tstr_modtype mtd -> iter_module_type_declaration mtd
         | Tstr_open _ -> ()
         | Tstr_class list ->
-            List.iter (fun (ci, _, _) -> iter_class_declaration ci) list
+            List.iter (fun (ci, _) -> iter_class_declaration ci) list
         | Tstr_class_type list ->
             List.iter
               (fun (id, _, ct) -> iter_class_type_declaration ct)
diff --git a/typing/typedtreeMap.ml b/typing/typedtreeMap.ml
index 6b28cc850..332129f8d 100644
--- a/typing/typedtreeMap.ml
+++ b/typing/typedtreeMap.ml
@@ -134,8 +134,8 @@ module MakeMap(Map : MapArgument) = struct
         | Tstr_class list ->
           let list =
             List.map
-              (fun (ci, string_list, virtual_flag) ->
-                 map_class_declaration ci, string_list, virtual_flag)
+              (fun (ci, string_list) ->
+                 map_class_declaration ci, string_list)
               list
           in
             Tstr_class list
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 95c6352d4..b645dc501 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -1353,10 +1353,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
           cl;
         let (classes, new_env) = Typeclass.class_declarations env cl in
         Tstr_class
-          (List.map (fun (i, _, d, _,_,_,_,_,_, s, m, c) ->
-               let vf = if d.cty_new = None then Virtual else Concrete in
-               (* (i, s, m, c, vf) *) (c, m, vf))
-              classes),
+          (List.map (fun (_,_,_,_,_,_,_,_,_,_, m, c) -> (c, m)) classes),
 (* TODO: check with Jacques why this is here
       Tstr_class_type
           (List.map (fun (_,_, i, d, _,_,_,_,_,_,c) -> (i, c)) classes) ::