camlspotter avatar camlspotter committed 270c49b

slight speedup

Comments (0)

Files changed (5)

 
   let rannots_full file = 
     eprintf "@[<2>rannots =@ [ @[<v>%a@]@] ]@."
-      (Format.list ";@ " (Regioned.format Annot.format))
-      file.File.rannots
+      (Format.list ";@ " (Regioned.format (Format.list ";@ " Annot.format)))
+      !!(file.File.rannots)
   ;;
   
   let rannots_summary file = 
     eprintf "@[<2>rannots =@ [ @[<v>%a@]@] ]@."
-      (Format.list ";@ " (Regioned.format Annot.summary))
-      file.File.rannots
+      (Format.list ";@ " (Regioned.format (Format.list ";@ " Annot.summary)))
+      !!(file.File.rannots)
   ;;
   
   let tree file = Tree.dump !!(file.File.tree)
       List.map fst (Tree.find_path_contains probe !!(file.File.tree))
     in
     match treepath with
-    | [] -> 
-	failwith (Printf.sprintf "nothing at %s" (Position.to_string pos))
+    | [] -> failwith (Printf.sprintf "nothing at %s" (Position.to_string pos))
     | { Regioned.region = r; _ } :: _ ->
 	
 	(* find annots bound to the region *)
         let annots = 
-	  List.filter_map (fun rannot ->
+	  List.concat_map (fun rannot ->
 	    if Region.compare r rannot.Regioned.region = `Same then 
-	      Some rannot.Regioned.value
-	    else None)
+	      rannot.Regioned.value
+	    else [])
 	    treepath
         in
 
         printf "XTree: <%s:%s>@." file.File.path (Region.to_string r);
 
 	(* Find the innermost module *)
-        let rec find_module_path = function
-          | [] -> []
-          | { Regioned.value = Annot.Str (Abstraction.AStr_module (id, _)); _ } :: ls
-          | { Regioned.value = Annot.Str (Abstraction.AStr_modtype (id, _)); _ } :: ls ->
-              id :: find_module_path ls
-          | _ :: ls -> find_module_path ls
+        let find_module_path treepath = List.concat_map (fun { Regioned.value = annots } ->
+          List.filter_map (function 
+            | Annot.Str (Abstraction.AStr_module (id, _)) -> Some id
+            | _ -> None) annots) treepath
         in
         printf "In_module: %s@."
           (String.concat "." (List.map Ident0.name (List.rev (find_module_path treepath))));
 	    | Path.Papply _ -> assert false
 	  in
 	  let base = base_ident path in
-	  List.iter (function
-	    | { Regioned.region= region; value= Annot.Use (k', path'); } when k = k' && base = base_ident path' ->
-	      begin match query_by_kind_path file k' path' with
-	      | Some found' when found = found' ->
-		  printf "<%s:%s>: %s@." 
-		    file.File.path
-		    (Region.to_string region)
-		    (Path.name path)
-	      | None | Some _ -> ()
-	      end
-	    | _ -> ()) file.File.rannots
+	  List.iter (fun { Regioned.region= region; value= annots } -> 
+                List.iter (function
+                  | Annot.Use (k', path') when k = k' && base = base_ident path' ->
+	              begin match query_by_kind_path file k' path' with
+	              | Some found' when found = found' ->
+		          printf "<%s:%s>: %s@." 
+		            file.File.path
+		            (Region.to_string region)
+		            (Path.name path)
+	              | None | Some _ -> ()
+	              end
+                  | _ -> ()) annots) !!(file.File.rannots)
 	| _ -> ());
     in
 
 
 (* annotation with region *)
 module RAnnot = struct
-  type t      = Annot.t Regioned.t
+  type t      = Annot.t list Regioned.t
   let split   = Regioned.split
   let compare = Regioned.compare
-  let format  = Regioned.format Annot.format
+  let format  = Regioned.format (Format.list ";@ " Annot.format)
 end
 
 module Tree = struct
   let iter = iter_elem
 
   let find_path_contains r t = 
-    let probe = { region = r; value = Annot.dummy } in
+    let probe = { region = r; value = [] (* dummy *) } in
     find_path_contains probe t
 
   let dump t = 
 end
 
 module Tree : sig
-  type elem = Annot.t Regioned.t
+  type elem = Annot.t list Regioned.t
   type t
   val empty : t
   val is_empty : t -> bool
   path           : string; (** source path. If packed, the .cmo itself *)
   flat           : Abstraction.structure;
   top            : Abstraction.structure;
-  id_def_regions : (Ident.t, Region.t) Hashtbl.t;
-  rannots        : Annot.t Regioned.t list;
+  id_def_regions : (Ident.t, Region.t) Hashtbl.t lazy_t;
+  rannots        : Annot.t list Regioned.t list lazy_t;
   tree           : Tree.t lazy_t
 }
 
           let str, loc_annots = abstraction_of_cmt cmt in
           Debug.format "cmt loaded: abstraction extracted from %s@." path;
           let path = Option.default (Filename.chop_extension path ^ ".cmo") (source_path_of_cmt cmt) in
-          let rannots = List.map (fun (loc, annot) -> 
-            { Regioned.region = Region.of_parsing loc;  value = annot }) loc_annots
+          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_list = 
-              List.filter_map (fun (loc, annot) -> match annot with
-              | Annot.Str sitem ->
-                  begin match Abstraction.ident_of_structure_item sitem with
-                  | None -> None
-                  | Some (_kind, id) -> 
-                      Some (id, Region.of_parsing loc)
-                  end
-              | _ -> None) loc_annots
+          let id_def_regions = lazy (
+            let tbl = Hashtbl.create 1023 in
+            Hashtbl.iter (fun loc (_,annots) ->
+              List.iter (function
+                | Annot.Str sitem ->
+                    Option.iter (Abstraction.ident_of_structure_item sitem) ~f:(fun (_kind, id) ->
+                      Hashtbl.add tbl id (Region.of_parsing loc))
+                | _ -> ()) annots) loc_annots;
+            tbl)
           in
-          let id_def_regions = Hashtbl.of_list 1023 id_def_regions_list in
           Debug.format "cmt loaded: id_def_regions created from %s@." path;
           let tree = lazy begin
-            List.fold_left Tree.add Tree.empty rannots
+            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 = List.filter_map (fun (_loc, annot) -> match annot with
+          let flat = Hashtbl.fold (fun _loc (_, annots) st -> 
+            List.filter_map (function
               | Annot.Str sitem -> Some sitem
-              | _ -> None) loc_annots
+              | _ -> None) annots @ st) loc_annots []
           in
           Debug.format "cmt loaded: flat created from %s@." path;
           Debug.format "cmt analysis done from %s@." path;
           | None -> File_itself (* the whole file *)
           | Some id -> 
               Found_at begin try
-                Hashtbl.find file.id_def_regions id
+                Hashtbl.find !!(file.id_def_regions) id
               with
               | Not_found ->
                   eprintf "Error: find location of id %a failed@."
   path           : string; (** cmt file itself if packed *)
   flat           : Abstraction.structure;
   top            : Abstraction.structure;
-  id_def_regions : (Ident.t, Region.t) Utils.Hashtbl.t;
-  rannots        : Annot.t Regioned.t list;
+  id_def_regions : (Ident.t, Region.t) Hashtbl.t lazy_t;
+  rannots        : Annot.t list Regioned.t list lazy_t;
   tree           : Tree.t lazy_t
 }
 
 val source_path_of_cmt : cmt_infos -> string option
 val dump_file : file -> unit
 val cmt_of_file : string -> string
-val abstraction_of_cmt : cmt_infos -> Abstraction.structure * (Location.t * Annot.t) list
+val abstraction_of_cmt : cmt_infos -> Abstraction.structure * (Location.t, (int (* CR jfuruse: useless *) * Annot.t list)) Hashtbl.t
 
 module Make(Spotconfig : Spotconfig_intf.S) : sig
   module Load : sig
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.