camlspotter avatar camlspotter committed 3a6d385

type envs are now recovered before scraping. All tests now pass with rev 12699

Comments (0)

Files changed (4)

 cmt.cmi :
 command.cmi :
+dotfile.cmi :
 locident.cmi :
 name.cmi :
 pathreparse.cmi : spot.cmi
 spot.cmi : utils.cmi
 spotconfig.cmi : spotconfig_intf.cmo
 spoteval.cmi : utils.cmi spot.cmi
-spotfile.cmi : spoteval.cmi spotconfig_intf.cmo spot.cmi
+spotfile.cmi : spoteval.cmi spot.cmi
 treeset.cmi : xset.cmi
 ttfold.cmi :
 typeFix.cmi :
 cmt.cmx : utils.cmx cmt.cmi
 command.cmo : command.cmi
 command.cmx : command.cmi
-dotfile.cmo : utils.cmi
-dotfile.cmx : utils.cmx
+dotfile.cmo : utils.cmi dotfile.cmi
+dotfile.cmx : utils.cmx dotfile.cmi
 ext.cmo : xprinttyp.cmi xpath.cmi xlongident.cmi xident.cmi
 ext.cmx : xprinttyp.cmx xpath.cmx xlongident.cmx xident.cmx
 locident.cmo : locident.cmi
 spotconfig_intf.cmx : spot.cmx ext.cmx
 spoteval.cmo : utils.cmi spot.cmi ext.cmo spoteval.cmi
 spoteval.cmx : utils.cmx spot.cmx ext.cmx spoteval.cmi
-spotfile.cmo : utils.cmi spoteval.cmi spotconfig_intf.cmo spot.cmi \
-    dotfile.cmo cmt.cmi spotfile.cmi
-spotfile.cmx : utils.cmx spoteval.cmx spotconfig_intf.cmx spot.cmx \
-    dotfile.cmx cmt.cmx spotfile.cmi
+spotfile.cmo : utils.cmi spoteval.cmi spotconfig.cmi spot.cmi dotfile.cmi \
+    cmt.cmi spotfile.cmi
+spotfile.cmx : utils.cmx spoteval.cmx spotconfig.cmx spot.cmx dotfile.cmx \
+    cmt.cmx spotfile.cmi
 treeset.cmo : xset.cmi treeset.cmi
 treeset.cmx : xset.cmx treeset.cmi
 ttfold.cmo : ttfold.cmi
 ttfold.out.cmx :
 typeFix.cmo : utils.cmi name.cmi typeFix.cmi
 typeFix.cmx : utils.cmx name.cmx typeFix.cmi
-typedtreefold.cmo :
-typedtreefold.cmx :
 typeexpand.cmo : utils.cmi typeexpand.cmi
 typeexpand.cmx : utils.cmx typeexpand.cmi
 utils.cmo : utils.cmi
   List.exists (fun x -> match Filename.split_extension x with 
     | (_, ".cmx") -> true 
     | _ -> false) (Array.to_list cmt.cmt_args)
+
+let recover_env env =
+
+  let module Envaux = struct (* copied from debugger/envaux.ml *)
+    open Misc
+    open Types
+    open Env
+  
+    type error =
+        Module_not_found of Path.t
+    
+    exception Error of error
+    
+    let env_cache =
+      (Hashtbl.create 59 : ((Env.summary * Subst.t), Env.t) Hashtbl.t)
+    
+    let reset_cache () =
+      Hashtbl.clear env_cache;
+      Env.reset_cache()
+    
+    let extract_sig env mty =
+      match Mtype.scrape env mty with
+        Mty_signature sg -> sg
+      | _ -> fatal_error "Envaux.extract_sig"
+    
+    let rec env_from_summary sum subst =
+    try
+      Hashtbl.find env_cache (sum, subst)
+    with Not_found ->
+      let env =
+        match sum with
+          Env_empty ->
+            Env.empty
+        | Env_value(s, id, desc) ->
+            Env.add_value id (Subst.value_description subst desc) (env_from_summary s subst)
+        | Env_type(s, id, desc) ->
+            Env.add_type id (Subst.type_declaration subst desc) (env_from_summary s subst)
+        | Env_exception(s, id, desc) ->
+            Env.add_exception id (Subst.exception_declaration subst desc) (env_from_summary s subst)
+        | Env_module(s, id, desc) ->
+            Env.add_module id (Subst.modtype subst desc) (env_from_summary s subst)
+        | Env_modtype(s, id, desc) ->
+            Env.add_modtype id (Subst.modtype_declaration subst desc) (env_from_summary s subst)
+        | Env_class(s, id, desc) ->
+            Env.add_class id (Subst.class_declaration subst desc) (env_from_summary s subst)
+        | Env_cltype (s, id, desc) ->
+            Env.add_cltype id (Subst.cltype_declaration subst desc) (env_from_summary s subst)
+        | Env_open(s, path) ->
+            let env = env_from_summary s subst in
+            let path' = Subst.module_path subst path in
+            let mty =
+              try
+                Env.find_module path' env
+              with Not_found ->
+                raise (Error (Module_not_found path'))
+            in
+            Env.open_signature path' (extract_sig env mty) env
+      in
+        Hashtbl.add env_cache (sum, subst) env;
+        env
+  end in
+  Envaux.reset_cache ();
+  Envaux.env_from_summary (Env.summary env) Subst.identity
+
+  
 
 val is_opt : cmt_infos -> bool
   (** Guess the cmt is created by opt(native code) compilation *)
+
+val recover_env : Env.t -> Env.t
+  (** Type environments in cmt are simplified and just have env summaries.
+      If we want the real environment, we need to recover it from the summary. *)
     res
 
   let aliases_of_include mexp ids =
-    let sg = try match Mtype.scrape mexp.mod_env mexp.mod_type with Mty_signature sg -> sg | _ -> assert false with _ -> assert false in
+    let sg = try match Mtype.scrape (Cmt.recover_env mexp.mod_env) mexp.mod_type with Mty_signature sg -> sg | _ -> assert false with _ -> assert false in
     aliases_of_include' true sg ids
 
   let rec module_expr mexp =
     | Tsig_open _ -> []
     | Tsig_include (mty, sg) -> 
         let m = module_type mty in
-        let sg0 = try match Mtype.scrape mty.mty_env mty.mty_type with Mty_signature sg -> sg | _ -> assert false with _ -> assert false in
+        let sg0 = try match Mtype.scrape (Cmt.recover_env mty.mty_env) mty.mty_type with Mty_signature sg -> sg | _ -> assert false with _ -> assert false in
         let ids = List.map (fun si -> snd (T.kident_of_sigitem si)) sg in
         let aliases = try aliases_of_include' false sg0 ids with _ -> assert false in
         List.map (fun (id, (k, id')) -> AStr_included (id, m, k, id')) aliases
         | Tsig_include (mty, sg) -> 
             let loc = si.sig_loc in
             let m = Abstraction.module_type mty in
-            let sg0 = match Mtype.scrape mty.mty_env mty.mty_type with 
+            let sg0 = match Mtype.scrape (Cmt.recover_env mty.mty_env) mty.mty_type with 
               | Types.Mty_signature sg -> sg 
               | Types.Mty_functor _ -> assert false
               | Types.Mty_ident _path -> 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.