From 1494670b0b12207893d3dbc6dc35f7913551ca3e Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Thu, 20 Apr 2023 00:20:07 +0200 Subject: [PATCH 1/2] Compiler (Sourcemap): refactor --- CHANGES.md | 1 + compiler/lib/js_output.ml | 57 +++--- compiler/lib/source_map.ml | 219 ++++++++++++--------- compiler/lib/source_map.mli | 26 ++- compiler/tests-compiler/sourcemap.ml | 30 +-- compiler/tests-sourcemap/dump_sourcemap.ml | 26 +-- 6 files changed, 210 insertions(+), 149 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 8359b0ea42..64da495910 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,6 +8,7 @@ * Compiler: fix simplification of js with let and const * Compiler: reduce memory consumption when parsing js * Compiler: parsing js can return a list of token, the list was sometime incorrect +* Sourcemap: stop producing sourcemaps mappings with negative lines or columns # 5.1.1 (2023-03-15) - Lille ## Bug fixes diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml index 598c9ace82..c115f819ca 100644 --- a/compiler/lib/js_output.ml +++ b/compiler/lib/js_output.ml @@ -87,25 +87,17 @@ struct match loc with | N -> () | U | Pi { Parse_info.src = None | Some ""; _ } -> - push_mapping - (PP.pos f) - { Source_map.gen_line = -1 - ; gen_col = -1 - ; ori_source = -1 - ; ori_line = -1 - ; ori_col = -1 - ; ori_name = None - } + push_mapping (PP.pos f) (Source_map.Gen { gen_line = -1; gen_col = -1 }) | Pi { Parse_info.src = Some file; line; col; _ } -> push_mapping (PP.pos f) - { Source_map.gen_line = -1 - ; gen_col = -1 - ; ori_source = get_file_index file - ; ori_line = line - ; ori_col = col - ; ori_name = None - } + (Source_map.Gen_Ori + { gen_line = -1 + ; gen_col = -1 + ; ori_source = get_file_index file + ; ori_line = line + ; ori_col = col + }) let output_debug_info_ident f nm loc = if source_map_enabled @@ -115,13 +107,14 @@ struct | Some { Parse_info.src = Some file; line; col; _ } -> push_mapping (PP.pos f) - { Source_map.gen_line = -1 - ; gen_col = -1 - ; ori_source = get_file_index file - ; ori_line = line - ; ori_col = col - ; ori_name = Some (get_name_index nm) - } + (Source_map.Gen_Ori_Name + { gen_line = -1 + ; gen_col = -1 + ; ori_source = get_file_index file + ; ori_line = line + ; ori_col = col + ; ori_name = get_name_index nm + }) let ident f = function | S { name = Utf8 name; var = Some v; _ } -> @@ -1632,11 +1625,19 @@ let program ?(accept_unnamed_var = false) f ?source_map p = in let mappings = List.rev_append_map !temp_mappings sm.mappings ~f:(fun (pos, m) -> - { m with - (* [p_line] starts at zero, [gen_line] at 1 *) - Source_map.gen_line = pos.PP.p_line + 1 - ; Source_map.gen_col = pos.PP.p_col - }) + let gen_line = pos.PP.p_line + 1 in + let gen_col = pos.PP.p_col in + match m with + | Source_map.Gen { gen_col = _; gen_line = _ } -> + Source_map.Gen { gen_col; gen_line } + | Source_map.Gen_Ori + { gen_line = _; gen_col = _; ori_source; ori_line; ori_col } -> + Source_map.Gen_Ori { gen_line; gen_col; ori_source; ori_line; ori_col } + | Source_map.Gen_Ori_Name + { gen_line = _; gen_col = _; ori_source; ori_line; ori_col; ori_name } + -> + Source_map.Gen_Ori_Name + { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name }) in Some { sm with Source_map.sources; names; sources_content; mappings } in diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml index 1e0ce6429e..5fcf61aa2b 100644 --- a/compiler/lib/source_map.ml +++ b/compiler/lib/source_map.ml @@ -20,13 +20,25 @@ open! Stdlib type map = - { gen_line : int - ; gen_col : int - ; ori_source : int - ; ori_line : int - ; ori_col : int - ; ori_name : int option - } + | Gen of + { gen_line : int + ; gen_col : int + } + | Gen_Ori of + { gen_line : int + ; gen_col : int + ; ori_source : int + ; ori_line : int + ; ori_col : int + } + | Gen_Ori_Name of + { gen_line : int + ; gen_col : int + ; ori_source : int + ; ori_line : int + ; ori_col : int + ; ori_name : int + } type mapping = map list @@ -50,9 +62,27 @@ let empty ~filename = ; mappings = [] } -let map_line_number ~f = - let f i = if i < 0 then i else f i in - fun m -> { m with ori_line = f m.ori_line; gen_line = f m.gen_line } +let map_line_number ~f = function + | Gen { gen_line; gen_col } -> Gen { gen_line = f gen_line; gen_col } + | Gen_Ori { gen_line; gen_col; ori_source; ori_line; ori_col } -> + Gen_Ori + { gen_line = f gen_line; gen_col; ori_source; ori_line = f ori_line; ori_col } + | Gen_Ori_Name { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name } -> + Gen_Ori_Name + { gen_line = f gen_line + ; gen_col + ; ori_source + ; ori_line = f ori_line + ; ori_col + ; ori_name + } + +let gen_line = function + | Gen { gen_line; _ } | Gen_Ori { gen_line; _ } | Gen_Ori_Name { gen_line; _ } -> + gen_line + +let gen_col = function + | Gen { gen_col; _ } | Gen_Ori { gen_col; _ } | Gen_Ori_Name { gen_col; _ } -> gen_col let string_of_mapping mapping = let mapping = @@ -64,66 +94,71 @@ let string_of_mapping mapping = let len = Array.length a in Array.stable_sort ~cmp:(fun t1 t2 -> - match compare t1.gen_line t2.gen_line with - | 0 -> compare t1.gen_col t2.gen_col + match compare (gen_line t1) (gen_line t2) with + | 0 -> compare (gen_col t1) (gen_col t2) | n -> n) a; let buf = Buffer.create 1024 in - let gen_line = ref 0 in - let gen_col = ref 0 in - let ori_source = ref 0 in - let ori_line = ref 0 in - let ori_col = ref 0 in - let ori_name = ref 0 in + let gen_line_r = ref 0 in + let gen_col_r = ref 0 in + let ori_source_r = ref 0 in + let ori_line_r = ref 0 in + let ori_col_r = ref 0 in + let ori_name_r = ref 0 in let rec loop prev i = if i < len then let c = a.(i) in - if prev >= 0 - && c.ori_source = a.(prev).ori_source - && c.ori_line = a.(prev).ori_line - && c.ori_col = a.(prev).ori_col - then (* We already are at this location *) - loop prev (i + 1) - else if i + 1 < len - && c.gen_line = a.(i + 1).gen_line - && c.gen_col = a.(i + 1).gen_col + if i + 1 < len && gen_line c = gen_line a.(i + 1) && gen_col c = gen_col a.(i + 1) then (* Only keep one source location per generated location *) loop prev (i + 1) else ( - if !gen_line <> c.gen_line + if !gen_line_r <> gen_line c then ( - assert (!gen_line < c.gen_line); - for _i = !gen_line to c.gen_line - 1 do + assert (!gen_line_r < gen_line c); + for _i = !gen_line_r to gen_line c - 1 do Buffer.add_char buf ';' done; - gen_col := 0; - gen_line := c.gen_line) + gen_col_r := 0; + gen_line_r := gen_line c) else if i > 0 then Buffer.add_char buf ','; let l = - (c.gen_col - !gen_col) - :: - (if c.ori_source < 0 - then [] - else - (c.ori_source - !ori_source) - :: (c.ori_line - !ori_line) - :: (c.ori_col - !ori_col) - :: - (match c.ori_name with - | None -> [] - | Some n -> - let n' = !ori_name in - ori_name := n; - [ n - n' ])) + match c with + | Gen { gen_line = _; gen_col } -> + let res = [ gen_col - !gen_col_r ] in + gen_col_r := gen_col; + res + | Gen_Ori { gen_line = _; gen_col; ori_source; ori_line; ori_col } -> + let res = + [ gen_col - !gen_col_r + ; ori_source - !ori_source_r + ; ori_line - !ori_line_r + ; ori_col - !ori_col_r + ] + in + gen_col_r := gen_col; + ori_col_r := ori_col; + ori_line_r := ori_line; + ori_source_r := ori_source; + res + | Gen_Ori_Name + { gen_line = _; gen_col; ori_source; ori_line; ori_col; ori_name } -> + let res = + [ gen_col - !gen_col_r + ; ori_source - !ori_source_r + ; ori_line - !ori_line_r + ; ori_col - !ori_col_r + ; ori_name - !ori_name_r + ] + in + gen_col_r := gen_col; + ori_col_r := ori_col; + ori_line_r := ori_line; + ori_source_r := ori_source; + ori_name_r := ori_name; + res in - gen_col := c.gen_col; - if c.ori_source >= 0 - then ( - ori_source := c.ori_source; - ori_line := c.ori_line; - ori_col := c.ori_col); Vlq64.encode_l buf l; loop i (i + 1)) in @@ -158,38 +193,33 @@ let mapping_of_string str = match v with | [ g ] -> gen_col := !gen_col + g; - { gen_line = line - ; gen_col = !gen_col - ; ori_source = -1 - ; ori_line = -1 - ; ori_col = -1 - ; ori_name = None - } + Gen { gen_line = line; gen_col = !gen_col } | [ g; os; ol; oc ] -> gen_col := !gen_col + g; ori_source := !ori_source + os; ori_line := !ori_line + ol; ori_col := !ori_col + oc; - { gen_line = line - ; gen_col = !gen_col - ; ori_source = !ori_source - ; ori_line = !ori_line - ; ori_col = !ori_col - ; ori_name = None - } + Gen_Ori + { gen_line = line + ; gen_col = !gen_col + ; ori_source = !ori_source + ; ori_line = !ori_line + ; ori_col = !ori_col + } | [ g; os; ol; oc; on ] -> gen_col := !gen_col + g; ori_source := !ori_source + os; ori_line := !ori_line + ol; ori_col := !ori_col + oc; ori_name := !ori_name + on; - { gen_line = line - ; gen_col = !gen_col - ; ori_source = !ori_source - ; ori_line = !ori_line - ; ori_col = !ori_col - ; ori_name = Some !ori_name - } + Gen_Ori_Name + { gen_line = line + ; gen_col = !gen_col + ; ori_source = !ori_source + ; ori_line = !ori_line + ; ori_col = !ori_col + ; ori_name = !ori_name + } | _ -> invalid_arg "Source_map.mapping_of_string" in let acc = v :: acc in @@ -198,36 +228,47 @@ let mapping_of_string str = readline 0 0 [] let maps ~sources_offset ~names_offset x = - let gen_line = x.gen_line in - let ori_source = - if x.ori_source < 0 then x.ori_source else x.ori_source + sources_offset - in - let ori_name = - match x.ori_name with - | None -> None - | Some ori_name -> Some (ori_name + names_offset) - in - { x with gen_line; ori_source; ori_name } + match x with + | Gen _ -> x + | Gen_Ori { gen_line; gen_col; ori_source; ori_line; ori_col } -> + let ori_source = ori_source + sources_offset in + Gen_Ori { gen_line; gen_col; ori_source; ori_line; ori_col } + | Gen_Ori_Name { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name } -> + let ori_source = ori_source + sources_offset in + let ori_name = ori_name + names_offset in + Gen_Ori_Name { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name } let filter_map sm ~f = let a = Array.of_list sm.mappings in Array.stable_sort ~cmp:(fun t1 t2 -> - match compare t1.gen_line t2.gen_line with - | 0 -> compare t1.gen_col t2.gen_col + match compare (gen_line t1) (gen_line t2) with + | 0 -> compare (gen_col t1) (gen_col t2) | n -> n) a; - let l = Array.to_list a |> List.group ~f:(fun a b -> a.gen_line = b.gen_line) in + let l = Array.to_list a |> List.group ~f:(fun a b -> gen_line a = gen_line b) in let rec loop acc mapping = match mapping with | [] -> List.rev acc | x :: xs -> - let gen_line = (List.hd x).gen_line in + let gen_line = gen_line (List.hd x) in let acc = match f gen_line with | None -> acc - | Some gen_line -> List.rev_append_map x ~f:(fun x -> { x with gen_line }) acc + | Some gen_line -> + List.rev_append_map + x + ~f:(function + | Gen { gen_line = _; gen_col } -> Gen { gen_line; gen_col } + | Gen_Ori { gen_line = _; gen_col; ori_source; ori_line; ori_col } -> + Gen_Ori { gen_line; gen_col; ori_source; ori_line; ori_col } + | Gen_Ori_Name + { gen_line = _; gen_col; ori_source; ori_line; ori_col; ori_name } + -> + Gen_Ori_Name + { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name }) + acc in loop acc xs in diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli index c7e781f205..b394fe8970 100644 --- a/compiler/lib/source_map.mli +++ b/compiler/lib/source_map.mli @@ -18,13 +18,25 @@ *) type map = - { gen_line : int - ; gen_col : int - ; ori_source : int - ; ori_line : int - ; ori_col : int - ; ori_name : int option - } + | Gen of + { gen_line : int + ; gen_col : int + } + | Gen_Ori of + { gen_line : int + ; gen_col : int + ; ori_source : int + ; ori_line : int + ; ori_col : int + } + | Gen_Ori_Name of + { gen_line : int + ; gen_col : int + ; ori_source : int + ; ori_line : int + ; ori_col : int + ; ori_name : int + } type mapping = map list diff --git a/compiler/tests-compiler/sourcemap.ml b/compiler/tests-compiler/sourcemap.ml index 5a7a03c982..791cb94d27 100644 --- a/compiler/tests-compiler/sourcemap.ml +++ b/compiler/tests-compiler/sourcemap.ml @@ -24,17 +24,18 @@ let print_mapping (sm : Source_map.t) = let sources = Array.of_list sm.sources in let _names = Array.of_list sm.names in List.iter sm.mappings ~f:(fun (m : Source_map.map) -> - let file = function - | -1 -> "null" - | n -> normalize_path sources.(n) - in - Printf.printf - "%s:%d:%d -> %d:%d\n" - (file m.ori_source) - m.ori_line - m.ori_col - m.gen_line - m.gen_col) + match m with + | Gen_Ori { gen_line; gen_col; ori_line; ori_col; ori_source } + | Gen_Ori_Name { gen_line; gen_col; ori_line; ori_col; ori_source; ori_name = _ } -> + let file n = normalize_path sources.(n) in + Printf.printf + "%s:%d:%d -> %d:%d\n" + (file ori_source) + ori_line + ori_col + gen_line + gen_col + | Gen { gen_line; gen_col } -> Printf.printf "null -> %d:%d\n" gen_line gen_col) let%expect_test _ = with_temp_dir ~f:(fun () -> @@ -78,7 +79,7 @@ let%expect_test _ = /dune-root/test.ml:1:7 -> 6:25 /dune-root/test.ml:1:12 -> 6:27 /dune-root/test.ml:1:4 -> 7:18 - null:-1:-1 -> 10:2 + null -> 10:2 |}] let%expect_test _ = @@ -119,8 +120,9 @@ let%expect_test _ = ;;;;EAEE,EAAE,EAAC,CAAE;ECQY,UACC |}] let%expect_test _ = - let gen (gen_line, gen_col) (ori_line, ori_col) ori_source : Source_map.map = - { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name = None } + let gen (gen_line, gen_col) (line, col) source : Source_map.map = + Source_map.Gen_Ori + { gen_line; gen_col; ori_source = source; ori_line = line; ori_col = col } in let s1 : Source_map.t = { (Source_map.empty ~filename:"1.map") with diff --git a/compiler/tests-sourcemap/dump_sourcemap.ml b/compiler/tests-sourcemap/dump_sourcemap.ml index 67f72c8da1..eec55e5a8e 100644 --- a/compiler/tests-sourcemap/dump_sourcemap.ml +++ b/compiler/tests-sourcemap/dump_sourcemap.ml @@ -54,17 +54,21 @@ let print_mapping lines (sm : Source_map.t) = ^ "<>" ^ String.sub line ~pos:col ~len:(len - col) in - if match file m.ori_source with - | "a.ml" | "b.ml" | "c.ml" | "d.ml" -> true - | _ -> false - then - Printf.printf - "%s:%d:%d -> %d:%s\n" - (file m.ori_source) - m.ori_line - m.ori_col - m.gen_col - (mark m.gen_col lines.(m.gen_line - 1))) + match m with + | Gen _ -> () + | Gen_Ori { gen_line; gen_col; ori_line; ori_col; ori_source } + | Gen_Ori_Name { gen_line; gen_col; ori_line; ori_col; ori_source; ori_name = _ } + -> ( + match file ori_source with + | "a.ml" | "b.ml" | "c.ml" | "d.ml" -> + Printf.printf + "%s:%d:%d -> %d:%s\n" + (file ori_source) + ori_line + ori_col + gen_col + (mark gen_col lines.(gen_line - 1)) + | _ -> ())) let files = Sys.argv |> Array.to_list |> List.tl From 5586b31614a6741dda338778f02680ba6cd142b3 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Thu, 20 Apr 2023 01:29:01 +0200 Subject: [PATCH 2/2] Compiler: faster sourcemap --- compiler/lib/source_map.ml | 39 ++++++++++---------------------------- 1 file changed, 10 insertions(+), 29 deletions(-) diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml index 5fcf61aa2b..3d88b0d1bd 100644 --- a/compiler/lib/source_map.ml +++ b/compiler/lib/source_map.ml @@ -62,21 +62,6 @@ let empty ~filename = ; mappings = [] } -let map_line_number ~f = function - | Gen { gen_line; gen_col } -> Gen { gen_line = f gen_line; gen_col } - | Gen_Ori { gen_line; gen_col; ori_source; ori_line; ori_col } -> - Gen_Ori - { gen_line = f gen_line; gen_col; ori_source; ori_line = f ori_line; ori_col } - | Gen_Ori_Name { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name } -> - Gen_Ori_Name - { gen_line = f gen_line - ; gen_col - ; ori_source - ; ori_line = f ori_line - ; ori_col - ; ori_name - } - let gen_line = function | Gen { gen_line; _ } | Gen_Ori { gen_line; _ } | Gen_Ori_Name { gen_line; _ } -> gen_line @@ -85,11 +70,6 @@ let gen_col = function | Gen { gen_col; _ } | Gen_Ori { gen_col; _ } | Gen_Ori_Name { gen_col; _ } -> gen_col let string_of_mapping mapping = - let mapping = - (* The binary format encodes lines starting at zero, but - [ori_line] and [gen_line] are 1 based. *) - List.map mapping ~f:(map_line_number ~f:pred) - in let a = Array.of_list mapping in let len = Array.length a in Array.stable_sort @@ -99,10 +79,12 @@ let string_of_mapping mapping = | n -> n) a; let buf = Buffer.create 1024 in - let gen_line_r = ref 0 in + (* The binary format encodes lines starting at zero, but + [ori_line] and [gen_line] are 1 based. *) + let gen_line_r = ref 1 in let gen_col_r = ref 0 in let ori_source_r = ref 0 in - let ori_line_r = ref 0 in + let ori_line_r = ref 1 in let ori_col_r = ref 0 in let ori_name_r = ref 0 in let rec loop prev i = @@ -169,19 +151,16 @@ let mapping_of_string str = let total_len = String.length str in let gen_col = ref 0 in let ori_source = ref 0 in - let ori_line = ref 0 in + let ori_line = ref 1 in let ori_col = ref 0 in let ori_name = ref 0 in let rec readline line pos acc = if pos >= total_len - then - (* The binary format encodes lines starting at zero, but - [ori_line] and [gen_line] are 1 based. *) - List.rev_map acc ~f:(map_line_number ~f:succ) + then List.rev acc else let last = try String.index_from str pos ';' with Not_found -> total_len in gen_col := 0; - let pos, acc = read_tokens line pos last acc in + let pos, acc = if pos = last then pos + 1, acc else read_tokens line pos last acc in readline (succ line) pos acc and read_tokens line start stop acc = let last = try min (String.index_from str start ',') stop with Not_found -> stop in @@ -225,7 +204,9 @@ let mapping_of_string str = let acc = v :: acc in if last = stop then last + 1, acc else read_tokens line (last + 1) stop acc in - readline 0 0 [] + (* The binary format encodes lines starting at zero, but + [ori_line] and [gen_line] are 1 based. *) + readline 1 0 [] let maps ~sources_offset ~names_offset x = match x with