No longer keep track of the location of identifiers

Author: vouillon

compiler/lib/code.ml

@@ -75,10 +75,6 @@ module Var : sig
 
   val compare : t -> t -> int
 
-  val get_loc : t -> Parse_info.t option
-
-  val loc : t -> Parse_info.t -> unit
-
   val name : t -> string -> unit
 
   val get_name : t -> string option
@@ -157,13 +153,10 @@ end = struct
 
   let printer = Var_printer.create Var_printer.Alphabet.javascript
 
-  let locations = Hashtbl.create 17
-
   let last_var = ref 0
 
   let reset () =
     last_var := 0;
-    Hashtbl.clear locations;
     Var_printer.reset printer
 
   let to_string ?origin i = Var_printer.to_string printer ?origin i
@@ -174,14 +167,6 @@ end = struct
 
   let name i nm = Var_printer.name printer i nm
 
-  let loc i pi = Hashtbl.add locations i pi
-
-  (*;
-    Format.eprintf "loc for %d : %d-%d\n%!"
-                   i pi.Parse_info.line pi.Parse_info.col
-  *)
-  let get_loc i = try Some (Hashtbl.find locations i) with Not_found -> None
-
   let fresh () =
     incr last_var;
     !last_var
@@ -199,11 +184,7 @@ end = struct
 
   let get_name i = Var_printer.get_name printer i
 
-  let propagate_name i j =
-    Var_printer.propagate_name printer i j;
-    match get_loc i with
-    | None -> ()
-    | Some l -> loc j l
+  let propagate_name i j = Var_printer.propagate_name printer i j
 
   let set_pretty b = Var_printer.set_pretty printer b
 

compiler/lib/code.mli

@@ -68,10 +68,6 @@ module Var : sig
 
   val compare : t -> t -> int
 
-  val loc : t -> Parse_info.t -> unit
-
-  val get_loc : t -> Parse_info.t option
-
   val get_name : t -> string option
 
   val name : t -> string -> unit

compiler/lib/js_output.ml

@@ -194,22 +194,14 @@ struct
         current_loc := loc;
         on_ident := false
 
-  let output_debug_info_ident f nm loc =
+  let output_debug_info_ident f nm =
     if source_map_enabled
     then (
-      let loc =
-        (* Keep the current location if possible, since we don't care
-           about the actual identifier's location *)
-        match !current_loc, loc with
-        | (N | U | Pi { Parse_info.src = Some "" | None; _ }), Some _ -> loc
-        | Pi ({ Parse_info.src = Some _; _ } as loc), _ -> Some loc
-        | _, None -> None
-      in
       on_ident := true;
       push_mapping
         (PP.pos f)
-        (match loc with
-        | None | Some { Parse_info.src = Some "" | None; _ } ->
+        (match !current_loc with
+        | N | U | Pi { Parse_info.src = Some "" | None; _ } ->
             (* Use a dummy location. It is going to be ignored anyway *)
             let ori_source =
               match hidden_location with
@@ -224,7 +216,7 @@ struct
               ; ori_col = 0
               ; ori_name = get_name_index nm
               }
-        | Some { Parse_info.src = Some file; line; col; _ } ->
+        | Pi { Parse_info.src = Some file; line; col; _ } ->
             Source_map.Gen_Ori_Name
               { gen_line = -1
               ; gen_col = -1
@@ -237,7 +229,7 @@ struct
   let ident f ~kind = function
     | S { name = Utf8 name; var = Some v; _ } ->
         (match kind, Code.Var.get_name v with
-        | `Binding, Some nm -> output_debug_info_ident f nm (Code.Var.get_loc v)
+        | `Binding, Some nm -> output_debug_info_ident f nm
         | `Reference, _ | `Binding, None -> ());
         if false then PP.string f (Printf.sprintf "/* %d */" (Code.Var.idx v));
         PP.string f name

compiler/lib/ocaml_compiler.ml

@@ -46,31 +46,6 @@ let rec constant_of_const c : Code.constant =
       let l = Array.of_list (List.map l ~f:constant_of_const) in
       Tuple (tag, l, Unknown)
 
-let rec find_loc_in_summary ident' = function
-  | Env.Env_empty -> None
-  | Env.Env_value (_summary, ident, description) when Poly.(ident = ident') ->
-      Some description.Types.val_loc
-  | Env.Env_module (_summary, ident, _, description) when Ident.same ident ident' ->
-      Some description.Types.md_loc
-  | Env.Env_extension (_summary, ident, description) when Ident.same ident ident' ->
-      Some description.Types.ext_loc
-  | Env.Env_value (summary, _, _)
-  | Env.Env_type (summary, _, _)
-  | Env.Env_extension (summary, _, _)
-  | Env.Env_module (summary, _, _, _)
-  | Env.Env_modtype (summary, _, _)
-  | Env.Env_class (summary, _, _)
-  | Env.Env_cltype (summary, _, _)
-  | Env.Env_open (summary, _)
-  | Env.Env_functor_arg (summary, _)
-  | Env.Env_constraints (summary, _)
-  | ((Env.Env_copy_types (summary, _)) [@if ocaml_version < (4, 10, 0)])
-  | ((Env.Env_copy_types summary) [@if ocaml_version >= (4, 10, 0)])
-  | Env.Env_persistent (summary, _)
-  | ((Env.Env_value_unbound (summary, _, _)) [@if ocaml_version >= (4, 10, 0)])
-  | ((Env.Env_module_unbound (summary, _, _)) [@if ocaml_version >= (4, 10, 0)]) ->
-      find_loc_in_summary ident' summary
-
 module Symtable = struct
   (* Copied from ocaml/bytecomp/symtable.ml *)
   module Num_tbl (M : Map.S) = struct

compiler/lib/ocaml_compiler.mli

@@ -18,8 +18,6 @@
 
 val constant_of_const : Lambda.structured_constant -> Code.constant
 
-val find_loc_in_summary : Ident.t -> Env.summary -> Location.t option
-
 module Symtable : sig
   module Global : sig
     type t =

compiler/lib/parse_bytecode.ml

@@ -67,8 +67,6 @@ module Debug : sig
     -> event:Instruct.debug_event
     -> Parse_info.t
 
-  val find_source : t -> string -> string option
-
   val read_event :
        paths:string list
     -> crcs:(string, string option) Hashtbl.t
@@ -234,15 +232,6 @@ end = struct
       let paths = read_paths ic @ includes in
       List.iter evl ~f:(read_event ~paths ~crcs ~orig debug)
 
-  let find_source { pos_fname_to_source; _ } pos_fname =
-    match pos_fname with
-    | "_none_" -> None
-    | _ -> (
-        match String_table.find_all pos_fname_to_source pos_fname with
-        | [ x ] -> Some x
-        | _ :: _ :: _ -> None
-        | [] -> None)
-
   let read t ~crcs ~includes ic =
     let len = input_binary_int ic in
     for _i = 0 to len - 1 do
@@ -696,18 +685,10 @@ module State = struct
       print_env
       st.env
 
-  let pi_of_loc debug location =
-    let pos = location.Location.loc_start in
-    let src = Debug.find_source debug pos.Lexing.pos_fname in
-    Parse_info.t_of_position ~src pos
-
   let rec name_rec debug i l s summary =
     match l, s with
     | [], _ -> ()
     | (j, ident) :: lrem, Var v :: srem when i = j ->
-        (match Ocaml_compiler.find_loc_in_summary ident summary with
-        | None -> ()
-        | Some loc -> Var.loc v (pi_of_loc debug loc));
         Var.name v (Ident.name ident);
         name_rec debug (i + 1) lrem srem summary
     | (j, _) :: _, _ :: srem when i < j -> name_rec debug (i + 1) l srem summary

compiler/tests-compiler/sourcemap.ml

@@ -86,8 +86,8 @@ let%expect_test _ =
       /builtin/blackbox.ml:1:0 -> 5:7
       /builtin/blackbox.ml:1:0 -> 5:17
       /builtin/blackbox.ml:1:0 -> 6:0
-      /dune-root/test.ml:1:4 -> 6:12
-      /dune-root/test.ml:1:7 -> 6:15
+      /builtin/blackbox.ml:1:0 -> 6:12
+      /builtin/blackbox.ml:1:0 -> 6:15
       /dune-root/test.ml:1:11 -> 6:18
       /dune-root/test.ml:1:12 -> 6:27
       /dune-root/test.ml:1:12 -> 7:0

compiler/tests-sourcemap/dump.reference

@@ -1,6 +1,4 @@
 sourcemap for test.bc.js
-/my/sourceRoot#b.ml:1:4 -> 12:   function <>f(x){return x - 1 | 0;}
-/my/sourceRoot#b.ml:1:6 -> 14:   function f(<>x){return x - 1 | 0;}
 /my/sourceRoot#b.ml:1:10 -> 17:   function f(x){<>return x - 1 | 0;}
 /my/sourceRoot#b.ml:1:15 -> 34:   function f(x){return x - 1 | 0;<>}
 /my/sourceRoot#b.ml:1:15 -> 0:<>   var Testlib_B = [0, f];