Skip to content

Commit

Permalink
No longer keep track of the location of identifiers
Browse files Browse the repository at this point in the history
  • Loading branch information
vouillon committed Oct 22, 2024
1 parent fbe4d3c commit 3a892e1
Show file tree
Hide file tree
Showing 8 changed files with 8 additions and 87 deletions.
21 changes: 1 addition & 20 deletions compiler/lib/code.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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

Expand Down
4 changes: 0 additions & 4 deletions compiler/lib/code.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
18 changes: 5 additions & 13 deletions compiler/lib/js_output.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
25 changes: 0 additions & 25 deletions compiler/lib/ocaml_compiler.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 0 additions & 2 deletions compiler/lib/ocaml_compiler.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
19 changes: 0 additions & 19 deletions compiler/lib/parse_bytecode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions compiler/tests-compiler/sourcemap.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 0 additions & 2 deletions compiler/tests-sourcemap/dump.reference
Original file line number Diff line number Diff line change
@@ -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];
Expand Down

0 comments on commit 3a892e1

Please sign in to comment.