camlspotter avatar camlspotter committed 981b73d

better path handling with hashconsing

Comments (0)

Files changed (7)

   (with-current-buffer (get-buffer-create ocamlspot-process-buffer)
     (ocamlspot-process-mode t)
     (erase-buffer)
-    (insert command)
+    (insert (prin1-to-string (cons ocamlspot-command args)))
     (insert "\n")
     ;; chdir is required
     (if chdir (cd chdir))
     
   let query_by_pos file orig_path pos = 
     (* CR jfuruse: probe should be created outside *)
-    let probe = Region.point orig_path pos in
+    let probe = Region.complete orig_path (Region.point orig_path pos) in
     Debug.format "probing by %s@." (Region.to_string probe);
     let treepath = 
       List.map fst (Tree.find_path_contains probe !!(file.Unit.tree))
   	  Option.map pos_start.Position.bytes ~f:(fun bytes ->
   	    bytes + diff.Lexing.pos_cnum ) }
       in
-      let subregion locid =
-        { region with
-          Region.start = position_add region.Region.start locid.lident_loc.Location.loc_start;
-          end_ = position_add region.Region.start locid.lident_loc.Location.loc_end }
+      let subregion locid = Region.change_positions region 
+        (position_add region.Region.start locid.lident_loc.Location.loc_start)
+        (position_add region.Region.start locid.lident_loc.Location.loc_end)
       in
       let search path locid = 
         (* The last id name can be different. For example,
 
 end
 
-module Region = struct
+module Region : sig
+
+  type t = private { 
+    fname : (string * (int * int) option) option; 
+    (* filename and device/inode. None = "_none_" *)
+    start : Position.t;
+    end_ : Position.t
+  }
+    
+  val compare : t -> t -> [> `Included | `Includes | `Left | `Overwrap | `Right | `Same ]
+
+  val to_string : t -> string
+  val to_string_no_path : t -> string
+  val of_parsing : string -> Location.t -> t
+  val split : t -> by:t -> (t * t) option
+  val point_by_byte : string -> int -> t  
+    (** works only if bytes are available *)
+  val point : string -> Position.t -> t
+  val change_positions : t -> Position.t -> Position.t -> t
+  val length_in_bytes : t -> int
+  val is_complete : t -> bool
+  val complete : string -> t -> t
+  val substring : string -> t -> t * string
+
+end = struct
+
   type t = { 
-    fname : string;
+    fname : (string * (int * int) option) option; 
+    (* filename and device/inode. None = "_none_" *)
     start : Position.t;
     end_ : Position.t
   }
 
+  let cache = Hashtbl.create 1023
+
+  let fname = function
+    | "_none_" -> None
+    | s ->
+        let s =
+          if Filename.is_relative s then 
+            Unix.getcwd () ^/ s
+          else s
+        in
+        Some (try 
+            Hashtbl.find cache s 
+          with
+          | Not_found ->
+              let dev_inode = Unix.dev_inode s in
+              if dev_inode = None then Format.eprintf "%s does not exist@." s;
+              let v = s, dev_inode in
+              Hashtbl.replace cache s v;
+              v
+        )
+
   let to_string t =
     Printf.sprintf "%s:%s:%s"
-      t.fname
+      (match t.fname with Some (fname, _) -> fname | None -> "_none_")
       (Position.to_string t.start)
       (Position.to_string t.end_)
 
       (Position.to_string t.start)
       (Position.to_string t.end_)
 
+  (* CR jfuruse: we should have path cache *)
+
   let of_parsing builddir l =
     let fname1 = l.Location.loc_start.Lexing.pos_fname in
     let fname2 = l.Location.loc_end.Lexing.pos_fname in
     if fname1 <> fname2 then
       Format.eprintf "Warning: A location contains strange file names %s and %s@." fname1 fname2;
-    let fname = match fname1 with
-      | "_none_" -> fname1
-      | _ when Filename.is_relative fname1 -> builddir ^/ fname1 
-      | _ -> fname1 
-    in
+    let fname = fname (if fname1 = "_none_" then fname1 else builddir ^/ fname1) in
     let start = Position.of_lexing_position l.Location.loc_start in
     let end_ = Position.of_lexing_position l.Location.loc_end in
     match Position.compare start end_ with
     | _ -> { fname; start = end_; end_ = start }
 
   let compare l1 l2 = 
-    match compare l1.fname l2.fname with
-    | 1 -> `Left
-    | -1 -> `Right
-    | _ ->
-        if Position.compare l1.start l2.start = 0 
-           && Position.compare l2.end_ l1.end_ = 0 then `Same
-        else if Position.compare l1.start l2.start <= 0 
-                && Position.compare l2.end_ l1.end_ <= 0 then `Includes
-        else if Position.compare l2.start l1.start <= 0 
-                && Position.compare l1.end_ l2.end_ <= 0 then `Included
-        else if Position.compare l1.end_ l2.start <= 0 then `Left
-        else if Position.compare l2.end_ l1.start <= 0 then `Right
-        else `Overwrap
-
-(*
-  let position_prev pos = { pos with pos_cnum = pos.pos_cnum - 1 }
-  let position_next pos = { pos with pos_cnum = pos.pos_cnum + 1 }
-*)
+    let same_files l1 l2 = 
+      match l1.fname, l2.fname with
+      | Some (_, Some di1), Some (_, Some di2) -> di1 = di2
+      | Some (f1, _), Some (f2, _) -> f1 = f2 (* weak guess *)
+      | None, None -> true (* ouch *)
+      | _ -> false
+    in
+    if not (same_files l1 l2) then
+      match compare l1.fname l2.fname with 
+      | 1 -> `Left
+      | -1 -> `Right
+      | _ -> assert false
+    else
+      if Position.compare l1.start l2.start = 0 
+         && Position.compare l2.end_ l1.end_ = 0 then `Same
+      else if Position.compare l1.start l2.start <= 0 
+              && Position.compare l2.end_ l1.end_ <= 0 then `Includes
+      else if Position.compare l2.start l1.start <= 0 
+              && Position.compare l1.end_ l2.end_ <= 0 then `Included
+      else if Position.compare l1.end_ l2.start <= 0 then `Left
+      else if Position.compare l2.end_ l1.start <= 0 then `Right
+      else `Overwrap
 
   let split l1 ~by:l2 =
     if compare l1 l2 = `Overwrap then
 
   open Position
 
-  let point_by_byte fname pos =
+  let point_by_byte fn pos =
+    let fname = fname fn in
     { fname;
       start = { line_column = None;
  		bytes = Some pos };
       end_ = { line_column = None;
                bytes = Some (pos + 1)} }
 
-  let point fname pos = { fname; start = pos; end_ = Position.next pos }
+  let point fn pos = 
+    let fname = fname fn in
+    { fname; start = pos; end_ = Position.next pos }
+
+  let change_positions t p1 p2 = { t with start = p1; end_ = p2 }
 
   let length_in_bytes t =
     let bytes = function
 
   (* CR jfuruse: fname is overwritten. Strange. *)      
   let complete mlpath t =
-    { fname = mlpath;
+    let fname = fname mlpath in
+    { fname;
       start = Position.complete mlpath t.start;
       end_ = Position.complete mlpath t.end_ }
 
 
 module Region : sig
 
-  type t = { fname : string; start : Position.t; end_ : Position.t; }
+  type t = private { fname : (string * (int * int) option) option; 
+                     (* filename and device/inode. None = "_none_" *)
+                     start : Position.t; 
+                     end_ : Position.t; }
   
   val compare : t -> t -> [> `Included | `Includes | `Left | `Overwrap | `Right | `Same ]
 
   val point_by_byte : string -> int -> t  
     (** works only if bytes are available *)
   val point : string -> Position.t -> t
+  val change_positions : t -> Position.t -> Position.t -> t
   val length_in_bytes : t -> int
   val is_complete : t -> bool
   val complete : string -> t -> t
 
   let timed f v = gen_timed Unix.gettimeofday (-.) f v
 
+  let dev_inode path =
+    try
+      let st = Unix.lstat path in
+      Some (st.Unix.st_dev, st.Unix.st_ino)
+    with
+    | _ -> None
+
   module Process_times = struct
     type t = process_times
     let (-) pt1 pt2 = {
-      tms_utime = pt1.tms_utime  -. pt2.tms_utime;
-      tms_stime = pt1.tms_stime  -. pt2.tms_stime;
+      tms_utime  = pt1.tms_utime -. pt2.tms_utime;
+      tms_stime  = pt1.tms_stime -. pt2.tms_stime;
       tms_cutime = pt1.tms_utime -. pt2.tms_cutime;
       tms_cstime = pt1.tms_utime -. pt2.tms_cstime;
     }
       Hashtbl.replace tbl k v) kvs;
     tbl
 end
+
+module Hashset = struct
+  (* poorman's hash set by hashtbl *)
+  type 'a t = ('a, 'a) Hashtbl.t
+  
+  let create = Hashtbl.create
+  let add set x = Hashtbl.replace set x x
+  let remove = Hashtbl.remove
+  let mem = Hashtbl.mem
+  let find = Hashtbl.find
+  let find_opt t k = try Some (Hashtbl.find t k) with Not_found -> None
+  let iter f = Hashtbl.iter (fun v _ -> f v)
+  let fold f = Hashtbl.fold (fun v _ st -> f v st)
+  let elements = Hashtbl.length
+  let clear = Hashtbl.clear
+  
+  let of_list size vs = 
+    let set = create size in
+    List.iter (add set) vs;
+    set
+  
+  let to_list set = fold (fun x y -> x::y) set []
+end
+
   val is_dir : string -> bool
   val gen_timed : (unit -> 't) -> ('t -> 't -> 't) -> ('a -> 'b) -> 'a -> 'b * 't
   val timed : ('a -> 'b) -> 'a -> 'b * float
+  val dev_inode : string -> (int * int) option
   module Process_times : sig
     type t = process_times
     val (-) : t -> t -> t
   include module type of Hashtbl with type ('a,'b) t = ('a, 'b) Hashtbl.t
   val of_list : int -> ('a * 'b) list -> ('a, 'b) Hashtbl.t
 end
+
+module Hashset : sig
+  (* poorman's hashset by hashtbl *)
+  
+  type 'a t
+  val create : ?random:bool -> int -> 'a t
+  val add : 'a t -> 'a -> unit
+  val remove : 'a t -> 'a -> unit
+  val mem : 'a t -> 'a -> bool
+  val find : 'a t -> 'a -> 'a (** good for hash consing *)
+  val find_opt : 'a t -> 'a -> 'a option (** good for hash consing *)
+  val iter : ('a -> unit) -> 'a t -> unit
+  val fold : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+  val elements : 'a t -> int
+  val clear : 'a t -> unit
+  val of_list : int -> 'a list -> 'a t
+  val to_list : 'a t -> 'a list
+end
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.