From 64f5df322db9073a536376d647bd3989eb2126da Mon Sep 17 00:00:00 2001 From: Olivier Nicole Date: Fri, 24 May 2024 16:21:10 +0200 Subject: [PATCH] Fix bug in format of sourceContents field, cleaner interface --- compiler/bin-js_of_ocaml/cmd_arg.ml | 4 +- compiler/bin-js_of_ocaml/link.ml | 2 +- compiler/lib/js_output.ml | 4 +- compiler/lib/link_js.ml | 5 +- compiler/lib/source_map.ml | 104 ++++++++------------------- compiler/lib/source_map.mli | 46 ++++++------ compiler/lib/source_map_io.yojson.ml | 31 +++++--- compiler/tests-compiler/sourcemap.ml | 8 +-- 8 files changed, 83 insertions(+), 121 deletions(-) diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml index 633f00cb56..762585e40f 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.ml +++ b/compiler/bin-js_of_ocaml/cmd_arg.ml @@ -321,7 +321,7 @@ let options = ; sources_contents = (if sourcemap_don't_inline_content then None - else Some (Source_map.Sources_contents.encode [])) + else Some []) ; names = [] ; mappings = Source_map.Mappings.empty } ) @@ -563,7 +563,7 @@ let options_runtime_only = ; sources_contents = (if sourcemap_don't_inline_content then None - else Some (Source_map.Sources_contents.encode [])) + else Some []) ; names = [] ; mappings = Source_map.Mappings.empty } ) diff --git a/compiler/bin-js_of_ocaml/link.ml b/compiler/bin-js_of_ocaml/link.ml index 6b0ffd55be..2719e7fb10 100644 --- a/compiler/bin-js_of_ocaml/link.ml +++ b/compiler/bin-js_of_ocaml/link.ml @@ -106,7 +106,7 @@ let options = ; file ; sourceroot = sourcemap_root ; sources = [] - ; sources_contents = Some (Source_map.Sources_contents.encode []) + ; sources_contents = Some [] ; names = [] ; mappings = Source_map.Mappings.empty } ) diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml index 2245098926..8c2da5f4bb 100644 --- a/compiler/lib/js_output.ml +++ b/compiler/lib/js_output.ml @@ -1926,7 +1926,7 @@ let program ?(accept_unnamed_var = false) f ?source_map p = loop xs ys in let sources_contents = - Option.map ~f:Source_map.Sources_contents.decode sm.sources_contents + Option.map ~f:(List.map ~f:Source_map.Source_text.decode) sm.sources_contents in loop sm.sources (Option.value ~default:[] sources_contents); List.iter sm.Source_map.names ~f:(fun f -> @@ -1985,7 +1985,7 @@ let program ?(accept_unnamed_var = false) f ?source_map p = let sources_contents = let open Option.Syntax in let* r = contents in - Option.return (Source_map.Sources_contents.encode (List.rev !r)) + Option.return (List.map ~f:Source_map.Source_text.encode (List.rev !r)) in let sources = List.map sources ~f:(fun filename -> diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml index ae7d2b401f..fea7cc2b24 100644 --- a/compiler/lib/link_js.ml +++ b/compiler/lib/link_js.ml @@ -470,10 +470,7 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source in let merged_sourcemap = let open Source_map in - assert ( - match init_sm.mappings with - | Uninterpreted "" -> true - | _ -> false); + assert (String.equal (Mappings.to_string init_sm.mappings) ""); { version = init_sm.version ; file = init_sm.file ; Index.sections = diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml index 3702ccbb52..163231231c 100644 --- a/compiler/lib/source_map.ml +++ b/compiler/lib/source_map.ml @@ -58,27 +58,14 @@ module Line_edits = struct let pp fmt = Format.(pp_print_list pp_action fmt) end -module Mappings : sig - type t = private Uninterpreted of string [@@unboxed] - - external uninterpreted : string -> t = "%identity" - - val empty : t - - val decode : t -> map list - - val encode : map list -> t - - val edit : strict:bool -> t -> Line_edits.t -> t - - (* Not for export *) - val concat : source_count1:int -> name_count1:int -> t -> t -> t -end = struct +module Mappings = struct type t = Uninterpreted of string [@@unboxed] let empty = Uninterpreted "" - external uninterpreted : string -> t = "%identity" + external of_string : string -> t = "%identity" + + external to_string : t -> string = "%identity" let update_carries_from_segment ~carry_source @@ -573,63 +560,35 @@ end = struct readline 1 0 [] end -module Sources_contents : sig - type t = private Uninterpreted of string [@@unboxed] +module Source_text = struct + type t = Uninterpreted of string [@@unboxed] - external uninterpreted : string -> t = "%identity" + external of_json_string : string -> t = "%identity" - val decode : t -> string option list + external to_json_string : t -> string = "%identity" + + let to_json = + function + | None -> `Null + | Some text -> `String text - val encode : string option list -> t -end = struct - type t = Uninterpreted of string [@@unboxed] + let encode t = + let json = Yojson.Basic.to_string (to_json t) in + Uninterpreted json - external uninterpreted : string -> t = "%identity" - - let to_json (cs : string option list) = - `List - (List.map - ~f:(function - | None -> `Null - | Some s -> `String s) - cs) - - let encode cs = - (* There are two stages to the encoding. First encoding the list as a JSON - array of strings... *) - let array = Yojson.Basic.to_string (to_json cs) in - (* ... and then reifying that array itself as a string, under the form of a - JSON string literal. *) - let reified = Yojson.Basic.to_string (`String array) in - Uninterpreted reified - - let of_json json = - match json with - | `List l -> - List.map - ~f:(function - | `String s -> Some s - | `Null -> None - | _ -> invalid_arg "Source_map.Sources_contents.of_json") - l - | _ -> invalid_arg "Source_map.Sources_contents.of_json" - - let decode (Uninterpreted s) : string option list = + let of_json = + function + | `String s -> Some s + | `Null -> None + | _ -> invalid_arg "Source_map.Sources_contents.of_json: expected string or null" + + let decode (Uninterpreted s) : string option = (* The two stages of the encoding, in reverse. *) - match Yojson.Basic.from_string s with - | `String array -> ( - try of_json (Yojson.Basic.from_string array) - with Yojson.Json_error s -> - invalid_arg - ("Source_map.Sources_contents.decode: This is a valid JSON literal, but it \ - does not encode a JSON array: " - ^ s)) - | _ -> - invalid_arg - "Source_map.Sources_contents.decode: This is a valid JSON object but not a \ - string literal" - | exception Yojson.Json_error s -> - invalid_arg ("Source_map.Sources_contents.decode: not a JSON string literal: " ^ s) + try of_json (Yojson.Basic.from_string s) with + | Yojson.Json_error s -> + invalid_arg + ("Source_map.Sources_contents.decode: This is not a valid JSON object: " + ^ s) end type t = @@ -637,7 +596,7 @@ type t = ; file : string ; sourceroot : string option ; sources : string list - ; sources_contents : Sources_contents.t option + ; sources_contents : Source_text.t list option ; names : string list ; mappings : Mappings.t } @@ -662,10 +621,7 @@ let concat ~file ~sourceroot s1 s2 = ; sources_contents = (match s1.sources_contents, s2.sources_contents with | None, contents | contents, None -> contents - | Some c1, Some c2 -> - let c1 = Sources_contents.decode c1 in - let c2 = Sources_contents.decode c2 in - Some (Sources_contents.encode (c1 @ c2))) + | Some c1, Some c2 -> Some (c1 @ c2)) ; names = s1.names @ s2.names ; mappings = Mappings.concat diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli index e99e687e65..e220619713 100644 --- a/compiler/lib/source_map.mli +++ b/compiler/lib/source_map.mli @@ -52,23 +52,23 @@ module Line_edits : sig end module Mappings : sig - (** Left uninterpreted, since many operations can be performed efficiently directly - on the encoded form. Instances of [t] produced by {!val:encode} are - guaranteed to be valid JSON string literals (surrounding double quotes - included). *) - type t = private Uninterpreted of string [@@unboxed] + type t val empty : t (** Represents the empty mapping. *) - external uninterpreted : string -> t = "%identity" - (** Create a value of type {!type:t} from a string, without attempting to - decode it. *) + val of_string : string -> t + (** By default, mappings are left uninterpreted, since many operations can be + performed efficiently directly on the encoded form. It is guaranteed that + {!val:of_string} and {!val:to_string} are inverse functions. *) val decode : t -> map list val encode : map list -> t + val to_string : t -> string + (** Returns the mappings as a string in the Source map v3 format. *) + val edit : strict:bool -> t -> Line_edits.t -> t (** Apply line edits in order. If the number of {!const:Line_edits.Keep} and {!const:Line_edits.Drop} actions does not match the number of lines in @@ -76,20 +76,21 @@ module Mappings : sig included in the result. *) end -module Sources_contents : sig - (** Left uninterpreted by default as decoding this field can be costly if the - amount of code is large, and is seldom required. Instances of [t] - produced by {!val:encode} are guaranteed to be valid JSON string - literals (surrounding double quotes included). *) - type t = private Uninterpreted of string [@@unboxed] +module Source_text : sig + type t + + val of_json_string : string -> t + (** By default, sources contents are left uninterpreted as decoding this field can be + costly if the amount of code is large, and is seldom required. It is guaranteed that + {!val:of_json_string} and {!val:to_json_string} are inverse functions. *) - external uninterpreted : string -> t = "%identity" - (** Create a value of type {!type:t} from a string, without attempting to - decode it. *) + val decode : t -> string option - val decode : t -> string option list + val encode : string option -> t - val encode : string option list -> t + val to_json_string : t -> string + (** Returns a valid JSON object (in this instance, a string literal, double quotes + included) representing the source text. *) end type t = @@ -97,7 +98,7 @@ type t = ; file : string ; sourceroot : string option ; sources : string list - ; sources_contents : Sources_contents.t option + ; sources_contents : Source_text.t list option (** Left uninterpreted by default, since decoding it requires to handle special characters, which can be costly for huge codebases. *) ; names : string list @@ -113,10 +114,7 @@ val concat : file:string -> sourceroot:string option -> t -> t -> t (** If [s1] encodes a mapping for a generated file [f1], and [s2] for a generated file [f2], then [concat ~file ~sourceroot s1 s2] encodes the union of these mappings for the concatenation of [f1] and [f2], with name - [file] and source root [sourceroot). Note that at the moment, this function - can be slow when the [sources_contents] field contains very large - codebases, as it decodes the whole source text. This may be fixed in the - future. *) + [file] and source root [sourceroot). *) module Index : sig type offset = diff --git a/compiler/lib/source_map_io.yojson.ml b/compiler/lib/source_map_io.yojson.ml index be2602e54f..101615e884 100644 --- a/compiler/lib/source_map_io.yojson.ml +++ b/compiler/lib/source_map_io.yojson.ml @@ -31,7 +31,9 @@ let rewrite_path path = let stringlit_of_string s = `Stringlit (Yojson.Basic.to_string (`String s)) let json t = - let (Source_map.Mappings.Uninterpreted mappings) = t.mappings in + let mappings = + `Stringlit ("\"" ^ Mappings.to_string t.mappings ^ "\"") (* Nothing to escape *) + in let fields = [ "version", `Intlit (Int.to_string t.version) ; "file", stringlit_of_string (rewrite_path t.file) @@ -43,18 +45,17 @@ let json t = ; "names", `List (List.map (fun s -> stringlit_of_string s) t.names) ; ( "sources" , `List (List.map (fun s -> stringlit_of_string (rewrite_path s)) t.sources) ) - ; "mappings", `Stringlit ("\"" ^ mappings ^ "\"") (* Nothing to escape *) + ; "mappings", mappings ] in match t.sources_contents with | None -> `Assoc fields - | Some (Source_map.Sources_contents.Uninterpreted cs) -> + | Some cs -> `Assoc (fields @ [ ( "sourcesContent" - (* It is the job of {!mod:Sources_contents} to enforce that [cs] is - already a valid JSON string literal *) - , `Stringlit cs ) + , `List (List.map (fun t -> `Stringlit (Source_text.to_json_string t)) + cs) ) ]) let invalid () = invalid_arg "Source_map.of_json" @@ -89,6 +90,17 @@ let stringlit_opt name assoc = | `Stringlit s -> Some s | _ | (exception Not_found) -> None +let stringlit_list_opt name assoc = + match List.assoc name assoc with + | `List l -> + Some (List.map + (function + | `Stringlit lit -> lit + | _ -> invalid ()) + l) + | _ -> invalid () + | exception Not_found -> None + let of_json json = match json with | `Assoc (("version", version) :: rest) -> @@ -105,7 +117,7 @@ let of_json json = let sourceroot = string "sourceRoot" rest in let names = list_string "names" rest in let sources = list_string "sources" rest in - let sources_contents = stringlit_opt "sourcesContent" rest in + let sources_contents = stringlit_list_opt "sourcesContent" rest in let mappings = stringlit_opt "mappings" rest in let mappings = Option.map @@ -114,15 +126,14 @@ let of_json json = String.length mappings >= 2 && Char.equal mappings.[0] '"' && Char.equal mappings.[String.length mappings - 1] '"'); - let mappings = String.sub mappings 1 (String.length mappings - 2) in - Mappings.uninterpreted mappings) + Mappings.of_string (String.sub mappings 1 (String.length mappings - 2))) mappings in { version = 3 ; file = Option.value file ~default:"" ; sourceroot ; names = Option.value names ~default:[] - ; sources_contents = Option.map Sources_contents.uninterpreted sources_contents + ; sources_contents = Option.map (List.map Source_text.of_json_string) sources_contents ; sources = Option.value sources ~default:[] ; mappings = Option.value mappings ~default:Mappings.empty } diff --git a/compiler/tests-compiler/sourcemap.ml b/compiler/tests-compiler/sourcemap.ml index f0d9d6d04d..65469a029e 100644 --- a/compiler/tests-compiler/sourcemap.ml +++ b/compiler/tests-compiler/sourcemap.ml @@ -112,8 +112,8 @@ function x (a, b) { let%expect_test _ = let map_str = ";;;;EAEE,EAAE,EAAC,CAAE;ECQY,UACC" in - let map = Source_map.Mappings.(decode (uninterpreted map_str)) in - let (Uninterpreted map_str') = Source_map.Mappings.encode map in + let map = Source_map.Mappings.(decode (of_string map_str)) in + let map_str' = Source_map.Mappings.(to_string (encode map)) in print_endline map_str; print_endline map_str'; [%expect @@ -148,8 +148,8 @@ let%expect_test _ = { 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 (Uninterpreted encoded_mappings) = m.Source_map.mappings in - print_endline encoded_mappings; + let encoded_mappings = m.Source_map.mappings in + print_endline (Source_map.Mappings.to_string encoded_mappings); print_mapping m; [%expect {|