From 9fea74c8ab9286abd7ea8d85f459aeb3261c16c6 Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Wed, 4 Sep 2024 14:07:34 +0200 Subject: [PATCH] Support the parsing of composite sourcemaps --- compiler/lib/link_js.ml | 9 +- compiler/lib/source_map.ml | 133 ++++++++++++++++-- compiler/lib/source_map.mli | 33 ++++- .../tests-compiler/build_path_prefix_map.ml | 3 +- compiler/tests-compiler/sourcemap.ml | 22 +-- compiler/tests-compiler/util/util.mli | 7 +- compiler/tests-sourcemap/dump_sourcemap.ml | 15 +- 7 files changed, 191 insertions(+), 31 deletions(-) diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml index e4d3d2989e..b0879c3eb5 100644 --- a/compiler/lib/link_js.ml +++ b/compiler/lib/link_js.ml @@ -170,6 +170,10 @@ let prefix_kind line = | true -> `Json_base64 (String.length sourceMappingURL_base64) | false -> `Url (String.length sourceMappingURL)) +let rule_out_index_map = function + | `Standard sm -> sm + | `Index _ -> failwith "unexpected index map at this stage" + let action ~resolve_sourcemap_url ~drop_source_map file line = match prefix_kind line, drop_source_map with | `Other, (true | false) -> Keep @@ -177,7 +181,8 @@ let action ~resolve_sourcemap_url ~drop_source_map file line = | `Build_info bi, _ -> Build_info bi | (`Json_base64 _ | `Url _), true -> Drop | `Json_base64 offset, false -> - Source_map (Source_map.of_string (Base64.decode_exn ~off:offset line)) + Source_map + (rule_out_index_map (Source_map.of_string (Base64.decode_exn ~off:offset line))) | `Url _, false when not resolve_sourcemap_url -> Drop | `Url offset, false -> let url = String.sub line ~pos:offset ~len:(String.length line - offset) in @@ -186,7 +191,7 @@ let action ~resolve_sourcemap_url ~drop_source_map file line = let l = in_channel_length ic in let content = really_input_string ic l in close_in ic; - Source_map (Source_map.of_string content) + Source_map (rule_out_index_map (Source_map.of_string content)) module Units : sig val read : Line_reader.t -> Unit_info.t -> Unit_info.t diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml index 17a8090236..4c12f59e05 100644 --- a/compiler/lib/source_map.ml +++ b/compiler/lib/source_map.ml @@ -57,7 +57,6 @@ let gen_line = function let gen_col = function | Gen { gen_col; _ } | Gen_Ori { gen_col; _ } | Gen_Ori_Name { gen_col; _ } -> gen_col - module Line_edits = struct type action = | Keep @@ -76,7 +75,6 @@ module Line_edits = struct let pp fmt = Format.(pp_print_list pp_action fmt) end - module Mappings = struct type t = Uninterpreted of string [@@unboxed] @@ -579,7 +577,6 @@ let empty ~filename = ; mappings = Mappings.empty } - let concat ~file ~sourceroot s1 s2 = if not (Int.equal s1.version s2.version) then invalid_arg "Source_map.concat: different versions"; @@ -695,15 +692,15 @@ let merge = function (* IO *) +let rewrite_path path = + if Filename.is_relative path + then path + else + match Build_path_prefix_map.get_build_path_prefix_map () with + | Some map -> Build_path_prefix_map.rewrite map path + | None -> path + let json t = - let rewrite_path path = - if Filename.is_relative path - then path - else - match Build_path_prefix_map.get_build_path_prefix_map () with - | Some map -> Build_path_prefix_map.rewrite map path - | None -> path - in let stringlit s = `Stringlit (Yojson.Safe.to_string (`String s)) in `Assoc [ "version", `Intlit (string_of_int t.version) @@ -764,7 +761,7 @@ let list_stringlit_opt name rest = | _ -> invalid () with Not_found -> None -let of_json (json : Yojson.Raw.t) = +let standard_map_of_json (json : Yojson.Raw.t) = match json with | `Assoc (("version", `Intlit version) :: rest) when int_of_string version = 3 -> let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in @@ -808,8 +805,116 @@ let of_json (json : Yojson.Raw.t) = } | _ -> invalid () -let of_string s = of_json (Yojson.Raw.from_string s) - let to_string m = Yojson.Raw.to_string (json m) let to_file m file = Yojson.Raw.to_file file (json m) + +module Index = struct + type offset = + { gen_line : int + ; gen_column : int + } + + (* Type synonym to avoid confusion between toplevel [t] and this submodule's [t]. *) + type map = t + + type t = + { version : int + ; file : string + ; sections : (offset * [ `Map of map ]) list + } + + let json t = + let stringlit s = `Stringlit (Yojson.Safe.to_string (`String s)) in + `Assoc + [ "version", `Intlit (string_of_int t.version) + ; "file", stringlit (rewrite_path t.file) + ; ( "sections" + , `List + (List.map + ~f:(fun ({ gen_line; gen_column }, `Map sm) -> + `Assoc + [ ( "offset" + , `Assoc + [ "line", `Intlit (string_of_int gen_line) + ; "column", `Intlit (string_of_int gen_column) + ] ) + ; "map", json sm + ]) + t.sections) ) + ] + + let intlit ~errmsg name json = + match List.assoc name json with + | `Intlit i -> int_of_string i + | _ -> invalid_arg errmsg + | exception Not_found -> invalid_arg errmsg + + let section_of_json : Yojson.Raw.t -> offset * [ `Map of map ] = function + | `Assoc json -> + let offset = + match List.assoc "offset" json with + | `Assoc fields -> + let gen_line = + intlit + "line" + fields + ~errmsg: + "Source_map_io.Index.of_json: field 'line' absent or invalid from \ + section" + in + let gen_column = + intlit + "column" + fields + ~errmsg: + "Source_map_io.Index.of_json: field 'column' absent or invalid from \ + section" + in + { gen_line; gen_column } + | _ -> + invalid_arg "Source_map_io.Index.of_json: 'offset' field of unexpected type" + in + (match List.assoc "url" json with + | _ -> + invalid_arg + "Source_map_io.Index.of_json: URLs in index maps are not currently \ + supported" + | exception Not_found -> ()); + let map = + try standard_map_of_json (List.assoc "map" json) with + | Not_found -> invalid_arg "Source_map_io.Index.of_json: field 'map' absent" + | Invalid_argument _ -> + invalid_arg "Source_map_io.Index.of_json: invalid sub-map object" + in + offset, `Map map + | _ -> invalid_arg "Source_map_io.Index.of_json: section of unexpected type" + + let of_json = function + | `Assoc fields -> ( + let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in + let file = string "file" fields in + match List.assoc "sections" fields with + | `List sections -> + let sections = List.map ~f:section_of_json sections in + { version = 3; file = Option.value file ~default:""; sections } + | _ -> invalid_arg "Source_map_io.Index.of_json: `sections` is not an array" + | exception Not_found -> + invalid_arg "Source_map_io.Index.of_json: no `sections` field") + | _ -> invalid_arg "Source_map_io.of_json: map is not an object" + + let to_string m = Yojson.Raw.to_string (json m) + + let to_file m file = Yojson.Raw.to_file file (json m) +end + +let of_json = function + | `Assoc fields as json -> ( + match List.assoc "sections" fields with + | _ -> `Index (Index.of_json json) + | exception Not_found -> `Standard (standard_map_of_json json)) + | _ -> invalid_arg "Source_map_io.of_json: map is not an object" + +let of_string s = of_json (Yojson.Raw.from_string s) + +let of_file f = of_json (Yojson.Raw.from_file f) diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli index 82483ec034..05fd72d0dc 100644 --- a/compiler/lib/source_map.mli +++ b/compiler/lib/source_map.mli @@ -108,8 +108,16 @@ type t = } val filter_map : t -> f:(int -> int option) -> t +(** If [f l] returns [Some l'], map line [l] to [l'] (in the generated file) in + the returned debug mappings. If [f l] returns [None], remove debug mappings + which concern line [l] of the generated file. The time cost of this + function is more than linear in the size of the input mappings. When + possible, prefer using {!val:Mappings.edit}. *) val merge : t list -> t option +(** Merge two lists of debug mappings. The time cost of the merge is more than + linear in function of the size of the input mappings. When possible, prefer + using {!val:concat}. *) val empty : filename:string -> t @@ -119,8 +127,31 @@ val concat : file:string -> sourceroot:string option -> t -> t -> t union of these mappings for the concatenation of [f1] and [f2], with name [file] and source root [sourceroot). *) +module Index : sig + type offset = + { gen_line : int + ; gen_column : int + } + + type nonrec t = + { version : int + ; file : string + ; sections : (offset * [ `Map of t ]) list + (** List of [(offset, map)] pairs. The sourcemap spec allows for [map] to be + either a sourcemap object or a URL, but we don't need to generate + composite sourcemaps with URLs for now, and it is therefore not + implemented. *) + } + + val to_string : t -> string + + val to_file : t -> string -> unit +end + val to_string : t -> string val to_file : t -> string -> unit -val of_string : string -> t +val of_string : string -> [ `Standard of t | `Index of Index.t ] + +val of_file : string -> [ `Standard of t | `Index of Index.t ] diff --git a/compiler/tests-compiler/build_path_prefix_map.ml b/compiler/tests-compiler/build_path_prefix_map.ml index 6e2ce10fdc..00117ee13e 100644 --- a/compiler/tests-compiler/build_path_prefix_map.ml +++ b/compiler/tests-compiler/build_path_prefix_map.ml @@ -29,12 +29,13 @@ let%expect_test _ = |> compile_cmo_to_javascript ~sourcemap:true ~pretty:false |> extract_sourcemap |> function - | Some (sm : Js_of_ocaml_compiler.Source_map.t) -> + | Some (`Standard (sm : Js_of_ocaml_compiler.Source_map.t)) -> Printf.printf "file: %s\n" sm.file; Printf.printf "sourceRoot: %s\n" (Option.value ~default:"" sm.sourceroot); Printf.printf "sources:\n"; List.iter sm.sources ~f:(fun source -> Printf.printf "- %s\n" (normalize_path source)) + | Some (`Index _) -> failwith "unexpected index map" | None -> failwith "no sourcemap generated!"); [%expect {| diff --git a/compiler/tests-compiler/sourcemap.ml b/compiler/tests-compiler/sourcemap.ml index 6625996539..65469a029e 100644 --- a/compiler/tests-compiler/sourcemap.ml +++ b/compiler/tests-compiler/sourcemap.ml @@ -55,7 +55,8 @@ let%expect_test _ = print_file (Filetype.path_of_js_file js_file); match extract_sourcemap js_file with | None -> Printf.printf "No sourcemap found\n" - | Some sm -> print_mapping sm); + | Some (`Standard sm) -> print_mapping sm + | Some (`Index _) -> failwith "unexpected index map"); [%expect {| $ cat "test.ml" @@ -140,16 +141,19 @@ let%expect_test _ = ; mappings = Source_map.Mappings.encode [ gen (3, 3) (5, 5) 0 ] } in - let m = Source_map.merge [ s1; Source_map.filter_map s2 ~f:(fun x -> Some (x + 20)) ] in - (match m with - | None -> () - | Some sm -> - let encoded_mappings = sm.Source_map.mappings in - print_endline (Source_map.Mappings.to_string encoded_mappings); - print_mapping sm); + let edits = + Source_map.Line_edits.([ Add { count = 17 } ] @ List.init ~len:3 ~f:(Fun.const Keep)) + in + let s2 = + { s2 with mappings = Source_map.Mappings.edit ~strict:true s2.mappings edits } + in + let m = Source_map.concat ~file:"" ~sourceroot:None s1 s2 in + let encoded_mappings = m.Source_map.mappings in + print_endline (Source_map.Mappings.to_string encoded_mappings); + print_mapping m; [%expect {| - CASU;;GCUU;;;;;;;;;;;;;;;;;;;;GCff + CASU;;GCUU;;;;;;;;;;;;;;;;;;;;GCff; sa:10:10 -> 1:1 sb:20:20 -> 3:3 sa2:5:5 -> 23:3 |}] diff --git a/compiler/tests-compiler/util/util.mli b/compiler/tests-compiler/util/util.mli index 5788400928..99b0581637 100644 --- a/compiler/tests-compiler/util/util.mli +++ b/compiler/tests-compiler/util/util.mli @@ -53,7 +53,12 @@ val compile_bc_to_javascript : val jsoo_minify : ?flags:string list -> pretty:bool -> Filetype.js_file -> Filetype.js_file -val extract_sourcemap : Filetype.js_file -> Js_of_ocaml_compiler.Source_map.t option +val extract_sourcemap : + Filetype.js_file + -> [ `Standard of Js_of_ocaml_compiler.Source_map.t + | `Index of Js_of_ocaml_compiler.Source_map.Index.t + ] + option val run_javascript : Filetype.js_file -> string diff --git a/compiler/tests-sourcemap/dump_sourcemap.ml b/compiler/tests-sourcemap/dump_sourcemap.ml index 27dfa136f3..efc03a6fc9 100644 --- a/compiler/tests-sourcemap/dump_sourcemap.ml +++ b/compiler/tests-sourcemap/dump_sourcemap.ml @@ -36,7 +36,7 @@ let extract_sourcemap lines = Some (Source_map.of_string content) | _ -> None -let print_mapping lines (sm : Source_map.t) = +let print_mapping lines ?(line_offset = 0) (sm : Source_map.t) = let lines = Array.of_list lines in let sources = Array.of_list sm.sources in let _names = Array.of_list sm.names in @@ -68,9 +68,18 @@ let print_mapping lines (sm : Source_map.t) = ori_line ori_col gen_col - (mark gen_col lines.(gen_line - 1)) + (mark gen_col lines.(gen_line - 1 + line_offset)) | _ -> ())) +let print_sourcemap lines = function + | `Standard sm -> print_mapping lines sm + | `Index l -> + List.iter + l.Source_map.Index.sections + ~f:(fun (Source_map.Index.{ gen_line; gen_column }, `Map sm) -> + assert (gen_column = 0); + print_mapping lines ~line_offset:gen_line sm) + let files = Sys.argv |> Array.to_list |> List.tl let () = @@ -80,4 +89,4 @@ let () = | None -> Printf.printf "not sourcemap for %s\n" f | Some sm -> Printf.printf "sourcemap for %s\n" f; - print_mapping lines sm) + print_sourcemap lines sm)