camlspotter avatar camlspotter committed bab26a1

hashtbl counter removal

Comments (0)

Files changed (6)

 xset.cmi :
 checksum.cmo :
 checksum.cmx :
+cmt.cmo :
+cmt.cmx :
 command.cmo : command.cmi
 command.cmx : command.cmi
 dotfile.cmo : utils.cmi
     spotconfig.cmx spot.cmx pathreparse.cmx ext.cmx command.cmx
 pathreparse.cmo : utils.cmi spot.cmi locident.cmi ext.cmo pathreparse.cmi
 pathreparse.cmx : utils.cmx spot.cmx locident.cmx ext.cmx pathreparse.cmi
-spot.cmo : utils.cmi ttfold.cmi treeset.cmi ext.cmo checksum.cmo spot.cmi
-spot.cmx : utils.cmx ttfold.cmx treeset.cmx ext.cmx checksum.cmx spot.cmi
+spot.cmo : utils.cmi ttfold.cmi treeset.cmi ext.cmo cmt.cmo checksum.cmo \
+    spot.cmi
+spot.cmx : utils.cmx ttfold.cmx treeset.cmx ext.cmx cmt.cmx checksum.cmx \
+    spot.cmi
 spotconfig.cmo : utils.cmi spot.cmi ext.cmo spotconfig.cmi
 spotconfig.cmx : utils.cmx spot.cmx ext.cmx spotconfig.cmi
 spotconfig_intf.cmo : spot.cmi ext.cmo
 treeset.cmx : xset.cmx treeset.cmi
 ttfold.cmo : ttfold.cmi
 ttfold.cmx : ttfold.cmi
+ttfold.out.cmo :
+ttfold.out.cmx :
 typeFix.cmo : utils.cmi name.cmi typeFix.cmi
 typeFix.cmx : utils.cmx name.cmx typeFix.cmi
 typedtreefold.cmo :
   
     let record tbl loc t = 
       let really_record () = 
-        let num_records, records = 
-          try Hashtbl.find tbl loc with Not_found -> 0, []
+        let records = 
+          try Hashtbl.find tbl loc with Not_found -> []
         in
+(*
         (* CR jfuruse: I am not really sure the below is correct now, 
            but I remember the huge compilation slow down... *)
         (* This caching works horribly when too many things are defined 
         *)
         if num_records <= 10 && List.exists (equal t) records then ()
         else Hashtbl.replace tbl loc (num_records + 1, t :: records)
+*)
+        Hashtbl.replace tbl loc (t :: records)
       in
       match check_location loc with
       | Wellformed -> really_record ()
     close_in ic;
     v
 
-  let of_cmt cmt =
-    let ext = if Cmt.is_opt cmt then ".cmx" else ".cmo" in
-    let path = Option.default (Filename.chop_extension path ^ ext) (Cmt.source_path cmt) in
-    { modname = cmt.cmt_modname;
+  open Cmt_format
+
+  let abstraction cmt = match cmt.cmt_annots with
+    | Implementation str -> 
+        let loc_annots = Annot.record_structure str in
+        begin match Abstraction.structure str with
+        | Abstraction.AMod_structure str -> str, loc_annots
+        | _ -> assert false
+        end
+    | Interface sg -> 
+        let loc_annots = Annot.record_signature sg in
+        begin match Abstraction.signature sg with
+        | Abstraction.AMod_structure str -> str, loc_annots
+        | _ -> assert false
+        end
+    | Packed (_sg, files) ->
+        (List.map (fun file ->
+          let fullpath = if Filename.is_relative file then cmt.cmt_builddir ^/ file else file in
+          let modname = match Filename.split_extension (Filename.basename file) with 
+            | modname, (".cmo" | ".cmx") -> String.capitalize modname
+            | _ -> assert false
+          in
+          Abstraction.AStr_module (Ident.create modname (* stamp is bogus *),
+                                   Abstraction.AMod_packed fullpath)) files),
+        (Hashtbl.create 1 (* empty *))
+    | Partial_implementation _parts | Partial_interface _parts -> assert false
+  
+  let abstraction cmt = 
+    try abstraction cmt with e -> 
+      Format.eprintf "Aiee %s@." (Printexc.to_string e);
+      raise e
+
+  let of_cmt path (* the output file *) cmt =
+    let path = Option.default (Cmt.source_path cmt) (fun () -> 
+      let ext = if Cmt.is_opt cmt then ".cmx" else ".cmo" in
+      Filename.chop_extension path ^ ext)
+    in
+    let top, loc_annots = abstraction cmt in
+    { modname  = cmt.cmt_modname;
       builddir = cmt.cmt_builddir;
       loadpath = cmt.cmt_loadpath;
-      args = cmt.cmt_args;
+      args     = cmt.cmt_args;
       path; 
       top;
       loc_annots;
     | Functor_parameter of Ident.t
     | Non_expansive of bool
 
-  val record_structure : Typedtree.structure -> (Location.t, int * t list) Hashtbl.t
-  val record_signature : Typedtree.signature -> (Location.t, int * t list) Hashtbl.t
+  val record_structure : Typedtree.structure -> (Location.t, t list) Hashtbl.t
+  val record_signature : Typedtree.signature -> (Location.t, t list) Hashtbl.t
 
   val format : Format.formatter -> t -> unit
   val summary : Format.formatter -> t -> unit
           let top, loc_annots = Cmt.abstraction cmt in
           Debug.format "cmt loaded: abstraction extracted from %s@." path;
 
-          let path = Option.default (Filename.chop_extension path ^ if Cmt.is_opt cmt then ".cmx" else ".cmo") (Cmt.source_path cmt) in
-          let rannots = lazy (Hashtbl.fold (fun loc (_,annots) st -> 
+          let path = Option.default (Cmt.source_path cmt) (fun () ->
+            Filename.chop_extension path ^ if Cmt.is_opt cmt then ".cmx" else ".cmo") in
+          let rannots = lazy (Hashtbl.fold (fun loc annots st -> 
             { Regioned.region = Region.of_parsing loc;  value = annots } :: st) loc_annots [])
           in
           Debug.format "cmt loaded: rannots created from %s@." path;
           let id_def_regions = lazy (
             let tbl = Hashtbl.create 1023 in
-            Hashtbl.iter (fun loc (_,annots) ->
+            Hashtbl.iter (fun loc annots ->
               List.iter (function
                 | Annot.Str sitem ->
                     Option.iter (Abstraction.ident_of_structure_item sitem) ~f:(fun (_kind, id) ->
           in
           Debug.format "cmt loaded: id_def_regions created from %s@." path;
           let tree = lazy begin
-            Hashtbl.fold (fun loc (_, annots) st ->
+            Hashtbl.fold (fun loc annots st ->
               Tree.add st { Regioned.region = Region.of_parsing loc; value = annots })
               loc_annots Tree.empty 
           end in
           (* CR jfuruse: it is almost the same as id_def_regions_list *)
-          let flat = Hashtbl.fold (fun _loc (_, annots) st -> 
+          let flat = Hashtbl.fold (fun _loc annots st -> 
             List.filter_map (function
               | Annot.Str sitem -> Some sitem
               | _ -> None) annots @ st) loc_annots []
     | None -> ()
     | Some v -> f v
 
-  let default df = function
+  let default v df = match v with
     | None -> df ()
     | Some v -> v
 end
   val map : f:('a -> 'b) -> 'a option -> 'b option
   val bind : 'a option -> ('a -> 'b option) -> 'b option
   val iter : f:('a -> unit) -> 'a option -> unit
-  val default : (unit -> 'a) -> 'a option -> 'a 
+  val default : 'a option -> (unit -> 'a) -> 'a 
 end
 
 exception Finally of exn * exn
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.