merge from 2004-12-10objvariants

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

1 files changed, 51 insertions, 21 deletions

diff --git a/typing/mtype.ml b/typing/mtype.ml
index 0b4805c144..b7b58ae39d 100644
--- a/typing/mtype.ml
+++ b/typing/mtype.ml
@@ -28,6 +28,9 @@ let rec scrape env mty =
       end
   | _ -> mty
 
+let freshen mty =
+  Subst.modtype Subst.identity mty
+
 let rec strengthen env mty p =
   match scrape env mty with
     Tmty_signature sg ->
@@ -42,7 +45,7 @@ and strengthen_sig env sg p =
     [] -> []
   | (Tsig_value(id, desc) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
-  | Tsig_type(id, decl) :: rem ->
+  | Tsig_type(id, decl, rs) :: rem ->
       let newdecl =
         match decl.type_manifest with
           None ->
@@ -50,12 +53,12 @@ and strengthen_sig env sg p =
                 Some(Btype.newgenty(Tconstr(Pdot(p, Ident.name id, nopos),
                                             decl.type_params, ref Mnil))) }
         | _ -> decl in
-      Tsig_type(id, newdecl) :: strengthen_sig env rem p
+      Tsig_type(id, newdecl, rs) :: strengthen_sig env rem p
   | (Tsig_exception(id, d) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
-  | Tsig_module(id, mty) :: rem ->
-      Tsig_module(id, strengthen env mty (Pdot(p, Ident.name id, nopos))) ::
-      strengthen_sig (Env.add_module id mty env) rem p
+  | Tsig_module(id, mty, rs) :: rem ->
+      Tsig_module(id, strengthen env mty (Pdot(p, Ident.name id, nopos)), rs)
+      :: strengthen_sig (Env.add_module id mty env) rem p
       (* Need to add the module in case it defines manifest module types *)
   | Tsig_modtype(id, decl) :: rem ->
       let newdecl =
@@ -67,9 +70,9 @@ and strengthen_sig env sg p =
       Tsig_modtype(id, newdecl) ::
       strengthen_sig (Env.add_modtype id decl env) rem p
       (* Need to add the module type in case it is manifest *)
-  | (Tsig_class(id, decl) as sigelt) :: rem ->
+  | (Tsig_class(id, decl, rs) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
-  | (Tsig_cltype(id, decl) as sigelt) :: rem ->
+  | (Tsig_cltype(id, decl, rs) as sigelt) :: rem ->
       sigelt :: strengthen_sig env rem p
 
 (* In nondep_supertype, env is only used for the type it assigns to id.
@@ -101,12 +104,13 @@ let nondep_supertype env mid mty =
         Tsig_value(id, d) ->
           Tsig_value(id, {val_type = Ctype.nondep_type env mid d.val_type;
                           val_kind = d.val_kind}) :: rem'
-      | Tsig_type(id, d) ->
-          Tsig_type(id, Ctype.nondep_type_decl env mid id (va = Co) d) :: rem'
+      | Tsig_type(id, d, rs) ->
+          Tsig_type(id, Ctype.nondep_type_decl env mid id (va = Co) d, rs)
+          :: rem'
       | Tsig_exception(id, d) ->
           Tsig_exception(id, List.map (Ctype.nondep_type env mid) d) :: rem'
-      | Tsig_module(id, mty) ->
-          Tsig_module(id, nondep_mty va mty) :: rem'
+      | Tsig_module(id, mty, rs) ->
+          Tsig_module(id, nondep_mty va mty, rs) :: rem'
       | Tsig_modtype(id, d) ->
           begin try
             Tsig_modtype(id, nondep_modtype_decl d) :: rem'
@@ -115,10 +119,12 @@ let nondep_supertype env mid mty =
               Co -> Tsig_modtype(id, Tmodtype_abstract) :: rem'
             | _  -> raise Not_found
           end
-      | Tsig_class(id, d) ->
-          Tsig_class(id, Ctype.nondep_class_declaration env mid d) :: rem'
-      | Tsig_cltype(id, d) ->
-          Tsig_cltype(id, Ctype.nondep_cltype_declaration env mid d) :: rem'
+      | Tsig_class(id, d, rs) ->
+          Tsig_class(id, Ctype.nondep_class_declaration env mid d, rs)
+          :: rem'
+      | Tsig_cltype(id, d, rs) ->
+          Tsig_cltype(id, Ctype.nondep_cltype_declaration env mid d, rs)
+          :: rem'
 
   and nondep_modtype_decl = function
       Tmodtype_abstract -> Tmodtype_abstract
@@ -148,10 +154,12 @@ let rec enrich_modtype env p mty =
       mty
 
 and enrich_item env p = function
-    Tsig_type(id, decl) ->
-      Tsig_type(id, enrich_typedecl env (Pdot(p, Ident.name id, nopos)) decl)
-  | Tsig_module(id, mty) ->
-      Tsig_module(id, enrich_modtype env (Pdot(p, Ident.name id, nopos)) mty)
+    Tsig_type(id, decl, rs) ->
+      Tsig_type(id,
+                enrich_typedecl env (Pdot(p, Ident.name id, nopos)) decl, rs)
+  | Tsig_module(id, mty, rs) ->
+      Tsig_module(id,
+                  enrich_modtype env (Pdot(p, Ident.name id, nopos)) mty, rs)
   | item -> item
 
 let rec type_paths env p mty =
@@ -166,9 +174,9 @@ and type_paths_sig env p pos sg =
   | Tsig_value(id, decl) :: rem ->
       let pos' = match decl.val_kind with Val_prim _ -> pos | _ -> pos + 1 in
       type_paths_sig env p pos' rem
-  | Tsig_type(id, decl) :: rem ->
+  | Tsig_type(id, decl, _) :: rem ->
       Pdot(p, Ident.name id, nopos) :: type_paths_sig env p pos rem
-  | Tsig_module(id, mty) :: rem ->
+  | Tsig_module(id, mty, _) :: rem ->
       type_paths env (Pdot(p, Ident.name id, pos)) mty @
       type_paths_sig (Env.add_module id mty env) p (pos+1) rem
   | Tsig_modtype(id, decl) :: rem ->
@@ -177,3 +185,25 @@ and type_paths_sig env p pos sg =
       type_paths_sig env p (pos+1) rem
   | (Tsig_cltype _) :: rem ->
       type_paths_sig env p pos rem
+
+let rec no_code_needed env mty =
+  match scrape env mty with
+    Tmty_ident p -> false
+  | Tmty_signature sg -> no_code_needed_sig env sg
+  | Tmty_functor(_, _, _) -> false  
+
+and no_code_needed_sig env sg =
+  match sg with
+    [] -> true
+  | Tsig_value(id, decl) :: rem ->
+      begin match decl.val_kind with
+      | Val_prim _ -> no_code_needed_sig env rem
+      | _ -> false
+      end
+  | Tsig_module(id, mty, _) :: rem ->
+      no_code_needed env mty &&
+      no_code_needed_sig (Env.add_module id mty env) rem
+  | (Tsig_type _ | Tsig_modtype _ | Tsig_cltype _) :: rem ->
+      no_code_needed_sig env rem
+  | (Tsig_exception _ | Tsig_class _) :: rem ->
+      false