From bcad8dd6e81ddb53c7389e3e8c111b0226b4e437 Mon Sep 17 00:00:00 2001 From: hhugo Date: Sun, 4 Aug 2024 00:20:05 +0200 Subject: [PATCH] Compiler: speedup json parsing, relying on Yojson.Raw (#1640) --- compiler/lib/js_output.ml | 10 +++- compiler/lib/source_map.ml | 113 +++++++++++++++++++++++------------- compiler/lib/source_map.mli | 8 ++- 3 files changed, 87 insertions(+), 44 deletions(-) diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml index d1b3e3267..c003ef47b 100644 --- a/compiler/lib/js_output.ml +++ b/compiler/lib/js_output.ml @@ -1738,7 +1738,7 @@ let program ?(accept_unnamed_var = false) f ?source_map p = let temp_mappings = ref [] in let files = Hashtbl.create 17 in let names = Hashtbl.create 17 in - let contents : string option list ref option = + let contents : Source_map.Source_content.t option list ref option = match source_map with | None | Some { Source_map.sources_content = None; _ } -> None | Some { Source_map.sources_content = Some _; _ } -> Some (ref []) @@ -1781,7 +1781,13 @@ let program ?(accept_unnamed_var = false) f ?source_map p = with Not_found -> let pos = Hashtbl.length files in Hashtbl.add files file pos; - Option.iter contents ~f:(fun r -> r := find_source file :: !r); + Option.iter contents ~f:(fun r -> + let source_contents = + match find_source file with + | None -> None + | Some s -> Some (Source_map.Source_content.create s) + in + r := source_contents :: !r); pos) , (fun name -> try Hashtbl.find names name diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml index b8af36bf8..e66dc3871 100644 --- a/compiler/lib/source_map.ml +++ b/compiler/lib/source_map.ml @@ -19,6 +19,16 @@ open! Stdlib +module Source_content = struct + type t = Sc_as_Stringlit of string + + let create s = Sc_as_Stringlit (Yojson.Safe.to_string (`String s)) + + let of_stringlit (`Stringlit s) = Sc_as_Stringlit s + + let to_json (Sc_as_Stringlit s) = `Stringlit s +end + type map = | Gen of { gen_line : int @@ -47,7 +57,7 @@ type t = ; file : string ; sourceroot : string option ; sources : string list - ; sources_content : string option list option + ; sources_content : Source_content.t option list option ; names : string list ; mappings : mapping } @@ -310,18 +320,18 @@ let json ?replace_mappings t = | 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", `Float (float_of_int t.version) - ; "file", `String (rewrite_path t.file) + [ "version", `Intlit (string_of_int t.version) + ; "file", stringlit (rewrite_path t.file) ; ( "sourceRoot" - , `String + , stringlit (match t.sourceroot with | None -> "" | Some s -> rewrite_path s) ) - ; "names", `List (List.map t.names ~f:(fun s -> `String s)) - ; "sources", `List (List.map t.sources ~f:(fun s -> `String (rewrite_path s))) - ; ( "mappings" - , `String (Option.value ~default:(string_of_mapping t.mappings) replace_mappings) ) + ; "names", `List (List.map t.names ~f:(fun s -> stringlit s)) + ; "sources", `List (List.map t.sources ~f:(fun s -> stringlit (rewrite_path s))) + ; "mappings", stringlit (Option.value ~default:(string_of_mapping t.mappings) replace_mappings) ; ( "sourcesContent" , `List (match t.sources_content with @@ -329,78 +339,99 @@ let json ?replace_mappings t = | Some l -> List.map l ~f:(function | None -> `Null - | Some s -> `String s)) ) + | Some x -> Source_content.to_json x)) ) ] let invalid () = invalid_arg "Source_map.of_json" -let string name rest = +let string_of_stringlit (`Stringlit s) = + match Yojson.Safe.from_string s with + | `String s -> s + | _ -> invalid () + +let stringlit name rest : [ `Stringlit of string ] option = try match List.assoc name rest with - | `String s -> Some s + | `Stringlit _ as s -> Some s | `Null -> None | _ -> invalid () with Not_found -> None -let list_string name rest = +let list_stringlit name rest = try match List.assoc name rest with | `List l -> Some (List.map l ~f:(function - | `String s -> s + | `Stringlit _ as s -> s | _ -> invalid ())) | _ -> invalid () with Not_found -> None -let list_string_opt name rest = +let list_stringlit_opt name rest = try match List.assoc name rest with | `List l -> Some (List.map l ~f:(function - | `String s -> Some s + | `Stringlit _ as s -> Some s | `Null -> None | _ -> invalid ())) | _ -> invalid () with Not_found -> None -let of_json ~parse_mappings json = - let parse ~version rest = - let def v d = - match v with - | None -> d - | Some v -> v +let of_json ~parse_mappings (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 + let file = + match string "file" rest with + | None -> "" + | Some s -> s in - let file = string "file" rest in let sourceroot = string "sourceRoot" rest in - let names = list_string "names" rest in - let sources = list_string "sources" rest in - let sources_content = list_string_opt "sourcesContent" rest in - let mappings = string "mappings" rest in - ( { version - ; file = def file "" + let names = + match list_stringlit "names" rest with + | None -> [] + | Some l -> List.map ~f:string_of_stringlit l + in + let sources = + match list_stringlit "sources" rest with + | None -> [] + | Some l -> List.map ~f:string_of_stringlit l + in + let sources_content = + match list_stringlit_opt "sourcesContent" rest with + | None -> None + | Some l -> + Some + (List.map l ~f:(function + | None -> None + | Some s -> Some (Source_content.of_stringlit s))) + in + let mappings = + match string "mappings" rest with + | None -> mapping_of_string "" + | Some s -> mapping_of_string s + in + ( { version = int_of_float (float_of_string version) + ; file ; sourceroot - ; names = def names [] + ; names ; sources_content - ; sources = def sources [] - ; mappings = mapping_of_string (def mappings "") + ; sources + ; mappings } - , if parse_mappings then None else mappings ) - in - match json with - | `Assoc (("version", `Float version) :: rest) when int_of_float version = 3 -> - parse ~version:3 rest - | `Assoc (("version", `Int 3) :: rest) -> parse ~version:3 rest + , if parse_mappings then None else Some mappings ) | _ -> invalid () -let of_string s = of_json ~parse_mappings:true (Yojson.Basic.from_string s) |> fst +let of_string s = of_json ~parse_mappings:true (Yojson.Raw.from_string s) |> fst -let to_string m = Yojson.Basic.to_string (json m) +let to_string m = Yojson.Raw.to_string (json m) let to_file ?mappings m ~file = let replace_mappings = mappings in - Yojson.Basic.to_file file (json ?replace_mappings m) + Yojson.Raw.to_file file (json ?replace_mappings m) let of_file_no_mappings filename = - of_json ~parse_mappings:false (Yojson.Basic.from_file filename) + of_json ~parse_mappings:false (Yojson.Raw.from_file filename) diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli index c928aae9f..5c3d7543e 100644 --- a/compiler/lib/source_map.mli +++ b/compiler/lib/source_map.mli @@ -17,6 +17,12 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +module Source_content : sig + type t + + val create : string -> t +end + type map = | Gen of { gen_line : int @@ -45,7 +51,7 @@ type t = ; file : string ; sourceroot : string option ; sources : string list - ; sources_content : string option list option + ; sources_content : Source_content.t option list option ; names : string list ; mappings : mapping }