diff --git a/CHANGES.md b/CHANGES.md index 46a6856ecb..6217c43fe6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -18,7 +18,7 @@ that follows the semantic of the backend (js or wasm) * Compiler: warn on joo_global_object * Compiler: revisit static env handling (#1708) -* Compiler: Emit index map when linking multiple js files together (#1714) +* Compiler: Emit index source_map to avoid changing mappings (#1714, #1715) * Runtime: change Sys.os_type on windows (Cygwin -> Win32) * Runtime: backtraces are really expensive, they need to be be explicitly requested at compile time (--enable with-js-error) or at startup (OCAMLRUNPARAM=b=1) diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml index 5911760091..68821c83be 100644 --- a/compiler/bin-js_of_ocaml/build_fs.ml +++ b/compiler/bin-js_of_ocaml/build_fs.ml @@ -74,12 +74,13 @@ function jsoo_create_file_extern(name,content){ let code = Code.prepend Code.empty instr in Filename.gen_file output_file (fun chan -> let pfs_fmt = Pretty_print.to_out_channel chan in - let (_ : Source_map.Standard.t option) = + let (_ : Source_map.info) = Driver.f ~standalone:true ~wrap_with_fun:`Iife ~link:`Needed ~formatter:pfs_fmt + ~source_map:false (Parse_bytecode.Debug.create ~include_cmis:false false) code in diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml index 98d1cfee8a..58cf490539 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.ml +++ b/compiler/bin-js_of_ocaml/cmd_arg.ml @@ -280,6 +280,7 @@ let options = input_file js_files keep_unit_names = + let inline_source_content = not sourcemap_don't_inline_content in let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in let runtime_files = js_files in let fs_external = fs_external || (toplevel && no_cmis) in @@ -308,13 +309,9 @@ let options = in Some ( sm_output_file - , { Source_map.Standard.version = 3 - ; file + , { (Source_map.Standard.empty ~inline_source_content) with + file ; sourceroot = sourcemap_root - ; sources = [] - ; sources_content = (if sourcemap_don't_inline_content then None else Some []) - ; names = [] - ; mappings = Source_map.Mappings.empty } ) else None in @@ -519,6 +516,7 @@ let options_runtime_only = target_env output_file js_files = + let inline_source_content = not sourcemap_don't_inline_content in let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in let runtime_files = js_files in let output_file = @@ -537,13 +535,9 @@ let options_runtime_only = in Some ( sm_output_file - , { Source_map.Standard.version = 3 - ; file + , { (Source_map.Standard.empty ~inline_source_content) with + file ; sourceroot = sourcemap_root - ; sources = [] - ; sources_content = (if sourcemap_don't_inline_content then None else Some []) - ; names = [] - ; mappings = Source_map.Mappings.empty } ) else None in diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml index 2a71d0f24e..8f4e184c34 100644 --- a/compiler/bin-js_of_ocaml/compile.ml +++ b/compiler/bin-js_of_ocaml/compile.ml @@ -34,26 +34,36 @@ let header formatter ~custom_header = | Some c -> Pretty_print.string formatter (c ^ "\n") let jsoo_header formatter build_info = - Pretty_print.string formatter "// Generated by js_of_ocaml\n"; + Pretty_print.string formatter (Printf.sprintf "%s\n" Global_constant.header); Pretty_print.string formatter (Build_info.to_string build_info) +type source_map_output = + | No_sourcemap + | Inline + | File of string + +let source_map_enabled = function + | No_sourcemap -> false + | Inline | File _ -> true + let output_gen ~standalone ~custom_header ~build_info ~source_map output_file f = let f chan k = let fmt = Pretty_print.to_out_channel chan in Driver.configure fmt; if standalone then header ~custom_header fmt; if Config.Flag.header () then jsoo_header fmt build_info; - let sm = f ~standalone ~source_map:(Option.map ~f:snd source_map) (k, fmt) in + let sm = f ~standalone ~source_map (k, fmt) in match source_map, sm with - | None, _ | _, None -> () - | Some (output_file, _), Some sm -> - let sm = `Standard sm in + | No_sourcemap, _ | _, None -> () + | ((Inline | File _) as output), Some sm -> + if Debug.find "invariant" () then Source_map.invariant sm; let urlData = - match output_file with - | None -> + match output with + | No_sourcemap -> assert false + | Inline -> let data = Source_map.to_string sm in "data:application/json;base64," ^ Base64.encode_exn data - | Some output_file -> + | File output_file -> Source_map.to_file sm output_file; Filename.basename output_file in @@ -65,6 +75,50 @@ let output_gen ~standalone ~custom_header ~build_info ~source_map output_file f | `Stdout -> f stdout `Stdout | `Name name -> Filename.gen_file name (fun chan -> f chan `File) +let find_source file = + match Builtins.find file with + | Some f -> Some (Source_map.Source_content.create (Builtins.File.content f)) + | None -> + if Sys.file_exists file && not (Sys.is_directory file) + then + let content = Fs.read_file file in + Some (Source_map.Source_content.create content) + else None + +let sourcemap_section_of_info + ~(base : Source_map.Standard.t) + { Source_map.sources; names; mappings } = + let sources_content = + match base.sources_content with + | None -> None + | Some _ -> Some (List.map ~f:find_source sources) + in + let sources = + List.map sources ~f:(fun filename -> + match Builtins.find filename with + | None -> filename + | Some _ -> Filename.concat "/builtin" filename) + in + let offset, mappings = Source_map.Mappings.encode_with_offset mappings in + let map = + { (base : Source_map.Standard.t) with sources; sources_content; names; mappings } + in + { Source_map.Index.offset; map } + +let sourcemap_of_infos ~base l = + match base with + | None -> None + | Some (base : Source_map.Standard.t) -> + let sections = List.map l ~f:(sourcemap_section_of_info ~base) in + Some + (Source_map.Index + { Source_map.Index.version = base.Source_map.Standard.version + ; file = base.file + ; sections + }) + +let sourcemap_of_info ~base info = sourcemap_of_infos ~base [ info ] + let run { Cmd_arg.common ; profile @@ -89,6 +143,13 @@ let run ; keep_unit_names ; include_runtime } = + let source_map_base = Option.map ~f:snd source_map in + let source_map = + match source_map with + | None -> No_sourcemap + | Some (None, _) -> Inline + | Some (Some file, _) -> File file + in let include_cmis = toplevel && not no_cmis in let custom_header = common.Jsoo_cmdline.Arg.custom_header in Config.set_target `JavaScript; @@ -148,9 +209,9 @@ let run Linker.check_deps (); if times () then Format.eprintf " parsing js: %a@." Timer.print t1; if times () then Format.eprintf "Start parsing...@."; - let need_debug = Option.is_some source_map || Config.Flag.debuginfo () in + let need_debug = source_map_enabled source_map || Config.Flag.debuginfo () in let check_debug (one : Parse_bytecode.one) = - if Option.is_some source_map && Parse_bytecode.Debug.is_empty one.debug + if source_map_enabled source_map && Parse_bytecode.Debug.is_empty one.debug then warn "Warning: '--source-map' is enabled but the bytecode program was compiled with \ @@ -202,7 +263,7 @@ let run ?profile ~link ~wrap_with_fun - ?source_map + ~source_map:(source_map_enabled source_map) ~formatter one.debug code @@ -226,7 +287,7 @@ let run ?profile ~link ~wrap_with_fun - ?source_map + ~source_map:(source_map_enabled source_map) ~formatter one.debug code @@ -310,7 +371,8 @@ let run ~source_map ~standalone ~link:`All - output_file) + output_file + |> sourcemap_of_info ~base:source_map_base) | (`Stdin | `File _) as bytecode -> let kind, ic, close_ic, include_dirs = match bytecode with @@ -348,7 +410,15 @@ let run ~build_info:(Build_info.create `Exe) ~source_map (fst output_file) - (output code ~check_sourcemap:true ~link:(if linkall then `All else `Needed)) + (fun ~standalone ~source_map output_file -> + output + code + ~check_sourcemap:true + ~standalone + ~source_map + ~link:(if linkall then `All else `Needed) + output_file + |> sourcemap_of_info ~base:source_map_base) | `Cmo cmo -> let output_file = match output_file, keep_unit_names with @@ -379,12 +449,14 @@ let run ~source_map output_file (fun ~standalone ~source_map output -> - let source_map = - if not include_runtime - then source_map - else output_partial_runtime ~standalone ~source_map output - in - output_partial cmo code ~standalone ~source_map output) + match include_runtime with + | true -> + let sm1 = output_partial_runtime ~standalone ~source_map output in + let sm2 = output_partial cmo code ~standalone ~source_map output in + sourcemap_of_infos ~base:source_map_base [ sm1; sm2 ] + | false -> + output_partial cmo code ~standalone ~source_map output + |> sourcemap_of_info ~base:source_map_base) | `Cma cma when keep_unit_names -> (if include_runtime then @@ -406,7 +478,8 @@ let run ~source_map (`Name output_file) (fun ~standalone ~source_map output -> - output_partial_runtime ~standalone ~source_map output)); + output_partial_runtime ~standalone ~source_map output + |> sourcemap_of_info ~base:source_map_base)); List.iter cma.lib_units ~f:(fun cmo -> let output_file = match output_file with @@ -440,32 +513,43 @@ let run ~build_info:(Build_info.create `Cma) ~source_map (`Name output_file) - (output_partial cmo code)) + (fun ~standalone ~source_map output -> + output_partial ~standalone ~source_map cmo code output + |> sourcemap_of_info ~base:source_map_base)) | `Cma cma -> let f ~standalone ~source_map output = - let source_map = + let source_map_runtime = if not include_runtime - then source_map - else output_partial_runtime ~standalone ~source_map output + then None + else Some (output_partial_runtime ~standalone ~source_map output) + in + + let source_map_units = + List.map cma.lib_units ~f:(fun cmo -> + let t1 = Timer.make () in + let code = + Parse_bytecode.from_cmo + ~includes:include_dirs + ~include_cmis + ~debug:need_debug + cmo + ic + in + if times () + then + Format.eprintf + " parsing: %a (%s)@." + Timer.print + t1 + (Ocaml_compiler.Cmo_format.name cmo); + output_partial ~standalone ~source_map cmo code output) + in + let sm = + match source_map_runtime with + | None -> source_map_units + | Some x -> x :: source_map_units in - List.fold_left cma.lib_units ~init:source_map ~f:(fun source_map cmo -> - let t1 = Timer.make () in - let code = - Parse_bytecode.from_cmo - ~includes:include_dirs - ~include_cmis - ~debug:need_debug - cmo - ic - in - if times () - then - Format.eprintf - " parsing: %a (%s)@." - Timer.print - t1 - (Ocaml_compiler.Cmo_format.name cmo); - output_partial cmo ~standalone ~source_map code output) + sourcemap_of_infos ~base:source_map_base sm in output_gen ~standalone:false diff --git a/compiler/bin-js_of_ocaml/link.ml b/compiler/bin-js_of_ocaml/link.ml index 6b0f8add7f..521ab6f70c 100644 --- a/compiler/bin-js_of_ocaml/link.ml +++ b/compiler/bin-js_of_ocaml/link.ml @@ -102,13 +102,9 @@ let options = in Some ( sm_output_file - , { Source_map.Standard.version = 3 - ; file + , { (Source_map.Standard.empty ~inline_source_content:true) with + file ; sourceroot = sourcemap_root - ; sources = [] - ; sources_content = Some [] - ; names = [] - ; mappings = Source_map.Mappings.empty } ) else None in diff --git a/compiler/bin-jsoo_minify/jsoo_minify.ml b/compiler/bin-jsoo_minify/jsoo_minify.ml index b05145386f..883b3ee78b 100644 --- a/compiler/bin-jsoo_minify/jsoo_minify.ml +++ b/compiler/bin-jsoo_minify/jsoo_minify.ml @@ -92,7 +92,7 @@ let f { Cmd_arg.common; output_file; use_stdin; files } = if t () then (m ())#program p else p) in let p = Js_assign.program p in - let (_ : Source_map.Standard.t option) = Js_output.program pp p in + let (_ : Source_map.info) = Js_output.program pp p in () in with_output (fun out_channel -> diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index 6dbeb4f772..b0580bef14 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -496,7 +496,7 @@ let coloring js = let output formatter ~source_map () js = let t = Timer.make () in if times () then Format.eprintf "Start Writing file...@."; - let sm = Js_output.program formatter ?source_map js in + let sm = Js_output.program formatter ~source_map js in if times () then Format.eprintf " write: %a@." Timer.print t; sm @@ -713,8 +713,8 @@ let full ~standalone ~wrap_with_fun ~profile ~link ~source_map ~formatter d p = emit formatter optimized_code let full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p = - let (_ : Source_map.Standard.t option) = - full ~standalone ~wrap_with_fun ~profile ~link ~source_map:None ~formatter d p + let (_ : Source_map.info) = + full ~standalone ~wrap_with_fun ~profile ~link ~source_map:false ~formatter d p in () @@ -723,7 +723,7 @@ let f ?(wrap_with_fun = `Iife) ?(profile = O1) ~link - ?source_map + ~source_map ~formatter d p = diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli index 5472edf5ae..07ec8f1da5 100644 --- a/compiler/lib/driver.mli +++ b/compiler/lib/driver.mli @@ -35,11 +35,11 @@ val f : -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ] -> ?profile:profile -> link:[ `All | `All_from of string list | `Needed | `No ] - -> ?source_map:Source_map.Standard.t + -> source_map:bool -> formatter:Pretty_print.t -> Parse_bytecode.Debug.t -> Code.program - -> Source_map.Standard.t option + -> Source_map.info val f' : ?standalone:bool diff --git a/compiler/lib/global_constant.ml b/compiler/lib/global_constant.ml index 0c87ef7776..bfcdceebc1 100644 --- a/compiler/lib/global_constant.ml +++ b/compiler/lib/global_constant.ml @@ -18,6 +18,8 @@ open! Stdlib +let header = "// Generated by js_of_ocaml" + let global_object = "globalThis" let global_object_ = Utf8_string.of_string_exn global_object diff --git a/compiler/lib/js_assign.ml b/compiler/lib/js_assign.ml index ca42b2ee9d..20d2e71f90 100644 --- a/compiler/lib/js_assign.ml +++ b/compiler/lib/js_assign.ml @@ -425,7 +425,7 @@ let program' (module Strategy : Strategy) p = "Some variables escaped (#%d). Use [--debug js_assign] for more info.@." (IdentSet.cardinal free) else - let (_ : Source_map.Standard.t option) = + let (_ : Source_map.info) = Js_output.program ~accept_unnamed_var:true (Pretty_print.to_out_channel stderr) diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml index 1c2fa741dc..6a44ee57b5 100644 --- a/compiler/lib/js_output.ml +++ b/compiler/lib/js_output.ml @@ -1899,68 +1899,24 @@ let hashtbl_to_list htb = |> List.sort ~cmp:(fun (_, a) (_, b) -> compare a b) |> List.map ~f:fst -let program ?(accept_unnamed_var = false) f ?source_map p = +let program ?(accept_unnamed_var = false) ?(source_map = false) f p = let temp_mappings = ref [] in let files = Hashtbl.create 17 in let names = Hashtbl.create 17 in - let contents : Source_map.Source_content.t option list ref option = - match source_map with - | None | Some { Source_map.Standard.sources_content = None; _ } -> None - | Some { Source_map.Standard.sources_content = Some _; _ } -> Some (ref []) - in - let push_mapping, get_file_index, get_name_index, source_map_enabled = - let source_map_enabled = - match source_map with - | None -> false - | Some sm -> - let rec loop s sc = - match s, sc with - | [], _ -> () - | x :: xs, [] -> - Hashtbl.add files x (Hashtbl.length files); - Option.iter contents ~f:(fun r -> r := None :: !r); - loop xs [] - | x :: xs, y :: ys -> - Hashtbl.add files x (Hashtbl.length files); - Option.iter contents ~f:(fun r -> r := y :: !r); - loop xs ys - in - loop sm.sources (Option.value ~default:[] sm.sources_content); - List.iter sm.Source_map.Standard.names ~f:(fun f -> - Hashtbl.add names f (Hashtbl.length names)); - true - in - let find_source file = - match Builtins.find file with - | Some f -> Some (Builtins.File.content f) - | None -> - if Sys.file_exists file && not (Sys.is_directory file) - then - let content = Fs.read_file file in - Some content - else None - in + let push_mapping, get_file_index, get_name_index = ( (fun pos m -> temp_mappings := (pos, m) :: !temp_mappings) , (fun file -> try Hashtbl.find files file with Not_found -> let pos = Hashtbl.length files in Hashtbl.add files file pos; - 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 -> + , fun name -> try Hashtbl.find names name with Not_found -> let pos = Hashtbl.length names in Hashtbl.add names name pos; - pos) - , source_map_enabled ) + pos ) in let module O = Make (struct let push_mapping = push_mapping @@ -1969,7 +1925,7 @@ let program ?(accept_unnamed_var = false) f ?source_map p = let get_file_index = get_file_index - let source_map_enabled = source_map_enabled + let source_map_enabled = source_map let accept_unnamed_var = accept_unnamed_var end) in @@ -1981,24 +1937,12 @@ let program ?(accept_unnamed_var = false) f ?source_map p = PP.newline f; let sm = match source_map with - | None -> None - | Some sm -> + | false -> { Source_map.sources = []; names = []; mappings = [] } + | true -> let sources = hashtbl_to_list files in let names = hashtbl_to_list names in - let sources_content = - match contents with - | None -> None - | Some r -> Some (List.rev !r) - in - let sources = - List.map sources ~f:(fun filename -> - match Builtins.find filename with - | None -> filename - | Some _ -> Filename.concat "/builtin" filename) - in - let sm_mappings = Source_map.Mappings.decode sm.mappings in let mappings = - List.rev_append_map !temp_mappings sm_mappings ~f:(fun (pos, m) -> + List.rev_map !temp_mappings ~f:(fun (pos, m) -> let gen_line = pos.PP.p_line + 1 in let gen_col = pos.PP.p_col in match m with @@ -2013,8 +1957,7 @@ let program ?(accept_unnamed_var = false) f ?source_map p = Source_map.Gen_Ori_Name { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name }) in - let mappings = Source_map.Mappings.encode mappings in - Some { sm with Source_map.Standard.sources; names; sources_content; mappings } + { Source_map.sources; names; mappings } in PP.check f; (if stats () diff --git a/compiler/lib/js_output.mli b/compiler/lib/js_output.mli index 3b69d3de24..dd74de8738 100644 --- a/compiler/lib/js_output.mli +++ b/compiler/lib/js_output.mli @@ -20,7 +20,7 @@ val program : ?accept_unnamed_var:bool + -> ?source_map:bool -> Pretty_print.t - -> ?source_map:Source_map.Standard.t -> Javascript.program - -> Source_map.Standard.t option + -> Source_map.info diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml index 3c17bfedae..28550099b3 100644 --- a/compiler/lib/link_js.ml +++ b/compiler/lib/link_js.ml @@ -99,49 +99,30 @@ module Line_writer : sig val of_channel : out_channel -> t - val write : ?source:Line_reader.t -> t -> string -> unit + val write : t -> string -> unit - val write_lines : ?source:Line_reader.t -> t -> string -> unit + val write_lines : t -> string -> unit val lnum : t -> int end = struct type t = { oc : out_channel ; mutable lnum : int - ; mutable source : (string * int) option } - let of_channel oc = { oc; source = None; lnum = 0 } + let of_channel oc = { oc; lnum = 0 } - let write ?source t s = - let source = - match source with - | None -> None - | Some ic -> Some (Line_reader.fname ic, Line_reader.lnum ic) - in - let emit fname lnum = - output_string t.oc (Printf.sprintf "//# %d %S\n" lnum fname); - 1 - in - let lnum_off = - match t.source, source with - | _, None -> 0 - | None, Some (fname, lnum) -> emit fname lnum - | Some (fname1, lnum1), Some (fname2, lnum2) -> - if String.equal fname1 fname2 && lnum1 + 1 = lnum2 then 0 else emit fname2 lnum2 - in + let write t s = output_string t.oc s; output_string t.oc "\n"; - let lnum_off = lnum_off + 1 in - t.source <- source; - t.lnum <- t.lnum + lnum_off + t.lnum <- t.lnum + 1 - let write_lines ?source t lines = + let write_lines t lines = let l = String.split_on_char ~sep:'\n' lines in let rec w = function | [ "" ] | [] -> () | s :: xs -> - write ?source t s; + write t s; w xs in w l @@ -154,7 +135,7 @@ type action = | Drop | Unit | Build_info of Build_info.t - | Source_map of Source_map.Standard.t + | Source_map of Source_map.t let prefix_kind line = match String.is_prefix ~prefix:sourceMappingURL line with @@ -170,19 +151,20 @@ 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 + | `Other, (true | false) -> ( + match line with + | "" -> Drop + | s when String.equal s Global_constant.header -> Drop + | _ -> Keep) | `Unit, (true | false) -> Unit | `Build_info bi, _ -> Build_info bi | (`Json_base64 _ | `Url _), true -> Drop | `Json_base64 offset, false -> - Source_map - (rule_out_index_map (Source_map.of_string (Base64.decode_exn ~off:offset line))) + let raw = Base64.decode_exn ~off:offset line in + let sm = Source_map.of_string raw in + Source_map sm | `Url _, false when not resolve_sourcemap_url -> Drop | `Url offset, false -> let url = String.sub line ~pos:offset ~len:(String.length line - offset) in @@ -191,7 +173,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 (rule_out_index_map (Source_map.of_string content)) + Source_map (Source_map.of_string content) module Units : sig val read : Line_reader.t -> Unit_info.t -> Unit_info.t @@ -227,11 +209,11 @@ end = struct | None -> None | Some line -> ( match prefix_kind line with - | `Json_base64 _ | `Url _ | `Other -> + | `Other -> Line_reader.drop ic; find_next ic | `Build_info bi -> Some bi - | `Unit -> None) + | `Unit | `Json_base64 _ | `Url _ -> None) in find_next ic @@ -328,8 +310,7 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source let reloc = ref [] in let copy ic oc = let line = Line_reader.next ic in - Line_writer.write ~source:ic oc line; - reloc := (Line_reader.lnum ic, Line_writer.lnum oc - line_offset) :: !reloc + Line_writer.write oc line in let rec read () = match Line_reader.peek ic with @@ -348,6 +329,7 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source if not !build_info_emitted then ( let bi = Build_info.with_kind bi (if mklib then `Cma else `Unknown) in + Line_writer.write oc Global_constant.header; Line_writer.write_lines oc (Build_info.to_string bi); build_info_emitted := true) | Drop -> skip ic @@ -365,24 +347,36 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source then let u = if linkall then { u with force_link = true } else u in Line_writer.write_lines oc (Unit_info.to_string u)); - let size = ref 0 in + Line_writer.write + oc + (Printf.sprintf + "//# %d %S" + (Line_reader.lnum ic) + (Line_reader.fname ic)); + let read_loffset = Line_reader.lnum ic in + let write_loffset = Line_writer.lnum oc in + let bsize = ref 0 in + let lsize = ref 0 in while match Line_reader.peek ic with | None -> false | Some line -> ( match prefix_kind line with - | `Other -> - size := !size + String.length line + 1; - true + | `Other -> true | `Json_base64 _ | `Url _ | `Build_info _ | `Unit -> false) do + bsize := !bsize + String.length line + 1; + incr lsize; copy ic oc done; + assert (read_loffset + !lsize = Line_reader.lnum ic); + assert (write_loffset + !lsize = Line_writer.lnum oc); + reloc := `Copy (read_loffset, write_loffset, !lsize) :: !reloc; if debug () then Format.eprintf "Copy %d bytes for %s@." - !size + !bsize (match is_runtime with | None -> String.concat ~sep:", " (StringSet.elements u.provides) | Some _ -> "the js runtime")) @@ -392,6 +386,8 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source Format.eprintf "Skip %s@." (String.concat ~sep:"," (StringSet.elements u.provides)); + let lnum = ref 0 in + let read_loffset = Line_reader.lnum ic in while match Line_reader.peek ic with | None -> false @@ -400,15 +396,17 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source | `Other -> true | `Json_base64 _ | `Url _ | `Build_info _ | `Unit -> false) do - skip ic - done) + skip ic; + incr lnum + done; + assert (read_loffset + !lnum = Line_reader.lnum ic); + reloc := `Drop (read_loffset, !lnum) :: !reloc) | Source_map x -> skip ic; sm_for_file := Some x); read () in read (); - Line_writer.write oc ""; Line_reader.close ic; (match is_runtime with | None -> () @@ -430,10 +428,11 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source (Parse_bytecode.Debug.create ~include_cmis:false false) code; let content = Buffer.contents b in - Line_writer.write_lines oc content); + Line_writer.write_lines oc content; + Line_writer.write oc ""); (match !sm_for_file with | None -> () - | Some x -> sm := (x, !reloc, line_offset) :: !sm); + | Some x -> sm := (x, List.rev !reloc, line_offset) :: !sm); match !build_info, build_info_for_file with | None, None -> () | Some _, None -> () @@ -447,22 +446,63 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source | None -> () | Some (file, init_sm) -> let sections = - List.rev_map !sm ~f:(fun (sm, reloc, offset) -> - let tbl = Hashtbl.create 17 in - List.iter reloc ~f:(fun (a, b) -> Hashtbl.add tbl a b); - ( { Source_map.Index.gen_line = offset; gen_column = 0 } - , `Map (Source_map.Standard.filter_map sm ~f:(Hashtbl.find_opt tbl)) )) + List.rev_map !sm ~f:(fun (sm, reloc, _offset) -> + let sm = + match (sm : Source_map.t) with + | Standard sm -> + [ ( Source_map.Mappings.first_line sm.mappings + , Source_map.Mappings.number_of_lines sm.mappings + , 0 + , 0 + , sm ) + ] + | Index sm -> + List.map + sm.Source_map.Index.sections + ~f:(fun { offset = { gen_line; gen_column }; map } -> + ( gen_line + Source_map.Mappings.first_line map.mappings + , gen_line + Source_map.Mappings.number_of_lines map.mappings + , gen_line + , gen_column + , map )) + in + (* select sourcemaps that cover copied section *) + let maps = + List.concat_map reloc ~f:(function + | `Drop _ -> [] + | `Copy (src, dst, len) -> + List.filter_map + sm + ~f:(fun (first, last, gen_line, gen_column, sm) -> + if first > src + len || last < src + then None + else ( + (* We don't want to deal with overlapping but not included + sourcemap, but we could in theory filter out part of it. *) + assert (src <= first && last <= src + len); + Some (first, last, gen_line + dst - src, gen_column, sm)))) + in + (* Make sure dropped sections are not overlapping selected sourcemap. *) + List.iter reloc ~f:(function + | `Copy _ -> () + | `Drop (src, len) -> + List.iter maps ~f:(fun (first, last, _, _, _) -> + if first > src + len || last < src then () else assert false)); + maps) in + let sections = List.concat sections in let sm = { Source_map.Index.version = init_sm.Source_map.Standard.version ; file = init_sm.file ; sections = (* preserve some info from [init_sm] *) - List.map sections ~f:(fun (ofs, `Map sm) -> - ofs, `Map { sm with sourceroot = init_sm.sourceroot }) + List.map sections ~f:(fun (_, _, gen_line, gen_column, sm) -> + { Source_map.Index.offset = { gen_line; gen_column } + ; map = { sm with sourceroot = init_sm.sourceroot } + }) } in - let sm = `Index sm in + let sm = Source_map.Index sm in (match file with | None -> let data = Source_map.to_string sm in diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml index 1ae1b2f099..96fe0a22b6 100644 --- a/compiler/lib/source_map.ml +++ b/compiler/lib/source_map.ml @@ -57,94 +57,150 @@ let gen_line = function let gen_col = function | Gen { gen_col; _ } | Gen_Ori { gen_col; _ } | Gen_Ori_Name { gen_col; _ } -> gen_col +module Offset = struct + type t = + { gen_line : int + ; gen_column : int + } +end + module Mappings = struct + type decoded = map list + type t = Uninterpreted of string [@@unboxed] let empty = Uninterpreted "" - let of_string : string -> t = fun s -> Uninterpreted s + let of_string_unsafe : string -> t = fun s -> Uninterpreted s let to_string : t -> string = fun (Uninterpreted s) -> s - let encode mapping = - let a = Array.of_list mapping in - let len = Array.length a in - Array.stable_sort - ~cmp:(fun t1 t2 -> - 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 - (* 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 1 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 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_r <> gen_line c - then ( - 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_r := 0; - gen_line_r := gen_line c) - else if i > 0 - then Buffer.add_char buf ','; - let l = - 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 - Vlq64.encode_l buf l; - loop i (i + 1)) + let number_of_lines (Uninterpreted s) = + match s with + | "" -> 0 + | _ -> + let c = ref 1 in + String.iter s ~f:(function + | ';' -> incr c + | _ -> ()); + !c + + let first_line (Uninterpreted s) = + let len = String.length s in + let rec loop i = + if i >= len + then i + else + match String.get s i with + | ';' -> loop (i + 1) + | _ -> i in - loop (-1) 0; - Uninterpreted (Buffer.contents buf) + loop 0 + + let encode' ~offset mapping = + match mapping with + | [] -> 0, empty + | _ -> + let a = Array.of_list mapping in + let len = Array.length a in + Array.stable_sort + ~cmp:(fun t1 t2 -> + 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 + (* 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 1 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 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_r <> gen_line c + then ( + 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_r := 0; + gen_line_r := gen_line c) + else if i > 0 + then Buffer.add_char buf ','; + let l = + 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 + Vlq64.encode_l buf l; + loop i (i + 1)) + in + + let offset = + let first_line = gen_line a.(0) in + assert (first_line > 0); + if offset + then ( + gen_line_r := first_line; + first_line - 1) + else 0 + in + loop (-1) 0; + offset, Uninterpreted (Buffer.contents buf) + + let encode mapping = + let gen_line, res = encode' ~offset:false mapping in + assert (gen_line = 0); + res - let decode (Uninterpreted str) = + let encode_with_offset mapping = + let gen_line, res = encode' ~offset:true mapping in + { Offset.gen_line; gen_column = 0 }, res + + let decode_exn (Uninterpreted str) = let total_len = String.length str in let gen_col = ref 0 in let ori_source = ref 0 in @@ -200,7 +256,7 @@ module Mappings = struct ; ori_col = !ori_col ; ori_name = !ori_name } - | _ -> invalid_arg "Source_map.mapping_of_string" + | _ -> invalid_arg "Source_map.Mappings.decode_exn" in let acc = v :: acc in if last = stop then last + 1, acc else read_tokens line (last + 1) stop acc @@ -208,8 +264,21 @@ module Mappings = struct (* The binary format encodes lines starting at zero, but [ori_line] and [gen_line] are 1 based. *) readline 1 0 [] + + let invariant ~names:_ ~sources:_ (Uninterpreted str) = + (* We can't check much without decoding (which is expensive) *) + (* Just do very simple checks *) + if not + (String.for_all str ~f:(function + | ';' | ',' -> true + | x -> Vlq64.in_alphabet x)) + then invalid_arg "Mappings.invariant" end +let version_is_valid = function + | 3 -> true + | _ -> false + let rewrite_path path = if Filename.is_relative path then path @@ -267,12 +336,12 @@ module Standard = struct ; mappings : Mappings.t } - let empty = + let empty ~inline_source_content = { version = 3 ; file = None ; sourceroot = None ; sources = [] - ; sources_content = None + ; sources_content = (if inline_source_content then Some [] else None) ; names = [] ; mappings = Mappings.empty } @@ -289,7 +358,7 @@ module Standard = struct 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 (Mappings.decode sm.mappings) in + let a = Array.of_list (Mappings.decode_exn sm.mappings) in Array.stable_sort ~cmp:(fun t1 t2 -> match compare (gen_line t1) (gen_line t2) with @@ -337,14 +406,22 @@ module Standard = struct sources = List.rev_append sm.sources acc_rev.sources ; names = List.rev_append sm.names acc_rev.names ; sources_content = - (match sm.sources_content, acc_rev.sources_content with - | Some x, Some acc_rev -> Some (List.rev_append x acc_rev) - | None, _ | _, None -> None) + (match acc_rev.sources_content with + | Some acc_rev -> + let contents = + match sm.sources_content with + | Some x -> + assert (List.length x = List.length sm.sources); + x + | None -> List.map sm.sources ~f:(fun _ -> None) + in + Some (List.rev_append contents acc_rev) + | None -> None) ; mappings = Mappings.empty } , List.rev_append_map ~f:(maps ~sources_offset ~names_offset) - (Mappings.decode sm.mappings) + (Mappings.decode_exn sm.mappings) mappings_rev ) in loop @@ -355,12 +432,7 @@ module Standard = struct rest in let acc_rev, mappings_rev = - loop - { empty with sources_content = Some [] } - [] - ~sources_offset:0 - ~names_offset:0 - l + loop (empty ~inline_source_content:true) [] ~sources_offset:0 ~names_offset:0 l in Some { acc_rev with @@ -404,7 +476,8 @@ module Standard = struct let of_json (json : Yojson.Raw.t) = match json with - | `Assoc (("version", `Intlit version) :: rest) when int_of_string version = 3 -> + | `Assoc (("version", `Intlit version) :: rest) + when version_is_valid (int_of_string version) -> let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in let file = string "file" rest in let sourceroot = string "sourceRoot" rest in @@ -430,9 +503,9 @@ module Standard = struct let mappings = match string "mappings" rest with | None -> Mappings.empty - | Some s -> Mappings.of_string s + | Some s -> Mappings.of_string_unsafe s in - { version = int_of_float (float_of_string version) + { version = int_of_string version ; file ; sourceroot ; names @@ -445,19 +518,32 @@ module Standard = struct let to_string m = Yojson.Raw.to_string (json m) let to_file m file = Yojson.Raw.to_file file (json m) + + let invariant + { version; file = _; sourceroot = _; names; sources_content; sources; mappings } = + if not (version_is_valid version) + then invalid_arg "Source_map.Standard.invariant: invalid version"; + match sources_content with + | None -> () + | Some x -> + if not (List.length sources = List.length x) + then + invalid_arg + "Source_map.Standard.invariant: sources and sourcesContent must have the \ + same size"; + Mappings.invariant ~names ~sources mappings end -(* IO *) module Index = struct - type offset = - { gen_line : int - ; gen_column : int + type section = + { offset : Offset.t + ; map : Standard.t } type t = { version : int ; file : string option - ; sections : (offset * [ `Map of Standard.t ]) list + ; sections : section list } let json t = @@ -477,14 +563,14 @@ module Index = struct , Some (`List (List.map - ~f:(fun ({ gen_line; gen_column }, `Map sm) -> + ~f:(fun { offset = { gen_line; gen_column }; map } -> `Assoc [ ( "offset" , `Assoc [ "line", `Intlit (string_of_int gen_line) ; "column", `Intlit (string_of_int gen_column) ] ) - ; "map", Standard.json sm + ; "map", Standard.json map ]) t.sections)) ) ]) @@ -495,7 +581,7 @@ module Index = struct | _ -> invalid_arg errmsg | exception Not_found -> invalid_arg errmsg - let section_of_json : Yojson.Raw.t -> offset * [ `Map of Standard.t ] = function + let section_of_json : Yojson.Raw.t -> section = function | `Assoc json -> let offset = match List.assoc "offset" json with @@ -505,7 +591,7 @@ module Index = struct "line" fields ~errmsg: - "Source_map_io.Index.of_json: field 'line' absent or invalid from \ + "Source_map.Index.of_json: field 'line' absent or invalid from \ section" in let gen_column = @@ -513,67 +599,94 @@ module Index = struct "column" fields ~errmsg: - "Source_map_io.Index.of_json: field 'column' absent or invalid from \ + "Source_map.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" + { Offset.gen_line; gen_column } + | _ -> invalid_arg "Source_map.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" + "Source_map.Index.of_json: URLs in index maps are not currently supported" | exception Not_found -> ()); let map = try Standard.of_json (List.assoc "map" json) with - | Not_found -> invalid_arg "Source_map_io.Index.of_json: field 'map' absent" + | Not_found -> invalid_arg "Source_map.Index.of_json: field 'map' absent" | Invalid_argument _ -> - invalid_arg "Source_map_io.Index.of_json: invalid sub-map object" + invalid_arg "Source_map.Index.of_json: invalid sub-map object" in - offset, `Map map - | _ -> invalid_arg "Source_map_io.Index.of_json: section of unexpected type" + { offset; map } + | _ -> invalid_arg "Source_map.Index.of_json: section of unexpected type" let of_json = function - | `Assoc fields -> ( + | `Assoc (("version", `Intlit version) :: fields) + when version_is_valid (int_of_string version) -> ( 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; sections } - | _ -> invalid_arg "Source_map_io.Index.of_json: `sections` is not an array" + { version = int_of_string version; file; sections } + | _ -> invalid_arg "Source_map.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" + invalid_arg "Source_map.Index.of_json: no `sections` field") + | _ -> invalid_arg "Source_map.Index.of_json" let to_string m = Yojson.Raw.to_string (json m) let to_file m file = Yojson.Raw.to_file file (json m) + + let invariant { version; file = _; sections } = + if not (version_is_valid version) + then invalid_arg "Source_map.Index.invariant: invalid version"; + let _ : int = + List.fold_left + sections + ~init:(-1) + ~f:(fun acc { offset = { gen_line; gen_column }; map } -> + if gen_line < 0 || gen_column < 0 + then invalid_arg "Source_map.Index.invariant: invalid offset"; + if acc >= gen_line + then + invalid_arg + "Source_map.Index.invariant: overlapping or unordered map in sections"; + Standard.invariant map; + gen_line + Mappings.number_of_lines map.mappings) + in + () end type t = - [ `Standard of Standard.t - | `Index of Index.t - ] + | Standard of Standard.t + | Index of Index.t let of_json = function | `Assoc fields as json -> ( match List.assoc "sections" fields with - | _ -> `Index (Index.of_json json) - | exception Not_found -> `Standard (Standard.of_json json)) - | _ -> invalid_arg "Source_map_io.of_json: map is not an object" + | _ -> Index (Index.of_json json) + | exception Not_found -> Standard (Standard.of_json json)) + | _ -> invalid_arg "Source_map.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) let to_string = function - | `Standard m -> Standard.to_string m - | `Index i -> Index.to_string i + | Standard m -> Standard.to_string m + | Index i -> Index.to_string i let to_file x f = match x with - | `Standard m -> Standard.to_file m f - | `Index i -> Index.to_file i f + | Standard m -> Standard.to_file m f + | Index i -> Index.to_file i f + +let invariant = function + | Standard m -> Standard.invariant m + | Index i -> Index.invariant i + +type info = + { mappings : Mappings.decoded + ; sources : string list + ; names : string list + } diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli index c00e8872b9..78c1972048 100644 --- a/compiler/lib/source_map.mli +++ b/compiler/lib/source_map.mli @@ -44,27 +44,46 @@ type map = ; ori_name : int } +module Offset : sig + type t = + { gen_line : int + ; gen_column : int + } +end + module Mappings : sig + type decoded = map list + type t + (** Represent the a list of mapping in its encoded form. *) val empty : t - (** Represents the empty mapping. *) + (** The empty mapping. *) - val of_string : string -> t - (** By default, mappings are left uninterpreted, since many operations can be - performed efficiently directly on the encoded form. Therefore this - function is mostly a no-op and very cheap. It does not perform any + val of_string_unsafe : string -> t + (** [of_string_unsafe] does not perform any validation of its argument, unlike {!val:decode}. It is guaranteed that - {!val:of_string} and {!val:to_string} are inverse functions. *) + {!val:of_string_unsafe} and {!val:to_string} are inverse functions. + Time complexity O(1) *) - val decode : t -> map list + val decode_exn : t -> decoded (** Parse the mappings. *) - val encode : map list -> t + val encode : decoded -> t + (** Encode the mappings. *) + + val encode_with_offset : decoded -> Offset.t * t + (** Encode the mappings shifted by the returned offset so that the + encoded mapping is more compact. This is useful to combining + multiple mappings into an [Index.t] *) + + val number_of_lines : t -> int + + val first_line : t -> int val to_string : t -> string - (** Returns the mappings as a string in the Source map v3 format. This - function is mostly a no-op and is very cheap. *) + (** Returns the mappings as a string in the Source map v3 format. + Time complexity O(1) *) end module Standard : sig @@ -90,26 +109,25 @@ module Standard : sig (** 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. *) - val empty : t + val empty : inline_source_content:bool -> t end module Index : sig - type offset = - { gen_line : int - ; gen_column : int + type section = + { offset : Offset.t + ; map : Standard.t } - type nonrec t = + type t = { version : int ; file : string option - ; sections : (offset * [ `Map of Standard.t ]) list + ; sections : section list } end type t = - [ `Standard of Standard.t - | `Index of Index.t - ] + | Standard of Standard.t + | Index of Index.t val to_string : t -> string @@ -118,3 +136,11 @@ val to_file : t -> string -> unit val of_string : string -> t val of_file : string -> t + +val invariant : t -> unit + +type info = + { mappings : Mappings.decoded + ; sources : string list + ; names : string list + } diff --git a/compiler/lib/vlq64.ml b/compiler/lib/vlq64.ml index 2c49cadb2a..22f71ce5fc 100644 --- a/compiler/lib/vlq64.ml +++ b/compiler/lib/vlq64.ml @@ -19,15 +19,17 @@ open! Stdlib -let code = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" +let alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" let code_rev = let a = Array.make 255 (-1) in - for i = 0 to String.length code - 1 do - a.(Char.code code.[i]) <- i + for i = 0 to String.length alphabet - 1 do + a.(Char.code alphabet.[i]) <- i done; a +let in_alphabet x = code_rev.(Char.code x) <> -1 + let vlq_base_shift = 5 (* binary: 100000 *) @@ -56,7 +58,7 @@ let fromVLQSigned v = (* assert (fromVLQSigned 3 = -1); *) (* assert (fromVLQSigned 5 = -2);; *) -let add_char buf x = Buffer.add_char buf code.[x] +let add_char buf x = Buffer.add_char buf alphabet.[x] let rec encode' buf x = let digit = x land vlq_base_mask in diff --git a/compiler/lib/vlq64.mli b/compiler/lib/vlq64.mli index 8866a58c4d..c3accf5215 100644 --- a/compiler/lib/vlq64.mli +++ b/compiler/lib/vlq64.mli @@ -17,6 +17,8 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val in_alphabet : char -> bool + val encode_l : Buffer.t -> int list -> unit val decode_l : string -> pos:int -> len:int -> int list diff --git a/compiler/tests-compiler/build_path_prefix_map.ml b/compiler/tests-compiler/build_path_prefix_map.ml index 29f9f7c8c3..8dcd2b3c3c 100644 --- a/compiler/tests-compiler/build_path_prefix_map.ml +++ b/compiler/tests-compiler/build_path_prefix_map.ml @@ -35,9 +35,13 @@ let%expect_test _ = |> compile_cmo_to_javascript ~sourcemap:true ~pretty:false |> extract_sourcemap |> function - | Some (`Standard (sm : Js_of_ocaml_compiler.Source_map.Standard.t)) -> + | Some (Standard (sm : Js_of_ocaml_compiler.Source_map.Standard.t)) -> print_section sm - | Some (`Index i) -> List.iter i.sections ~f:(fun (_, `Map sm) -> print_section sm) + | Some (Index i) -> + List.iter + i.sections + ~f:(fun { Js_of_ocaml_compiler.Source_map.Index.offset = _; map } -> + print_section map) | None -> failwith "no sourcemap generated!"); [%expect {| diff --git a/compiler/tests-compiler/macro.ml b/compiler/tests-compiler/macro.ml index 843583c4fa..e5036e25bb 100644 --- a/compiler/tests-compiler/macro.ml +++ b/compiler/tests-compiler/macro.ml @@ -31,9 +31,7 @@ let print_macro_transformed source = in let parsed = Util.parse_js source in let transformed, _ = Jsoo.Macro.f ~flags:false parsed in - let (_ : Jsoo.Source_map.Standard.t option) = - Jsoo.Js_output.program pp transformed - in + let (_ : Jsoo.Source_map.info) = Jsoo.Js_output.program pp transformed in print_endline (Buffer.contents buffer)) let print_macro_transformed source = diff --git a/compiler/tests-compiler/sourcemap.ml b/compiler/tests-compiler/sourcemap.ml index 2aa2cdb9e1..704774fcd0 100644 --- a/compiler/tests-compiler/sourcemap.ml +++ b/compiler/tests-compiler/sourcemap.ml @@ -23,7 +23,7 @@ open Util let print_mapping ~line_offset ~col_offset (sm : Source_map.Standard.t) = let sources = Array.of_list sm.sources in let _names = Array.of_list sm.names in - let mappings = Source_map.Mappings.decode sm.mappings in + let mappings = Source_map.Mappings.decode_exn sm.mappings in List.iter mappings ~f:(fun (m : Source_map.map) -> match m with | Gen_Ori { gen_line; gen_col; ori_line; ori_col; ori_source } @@ -56,14 +56,15 @@ 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 (`Standard sm) -> print_mapping ~line_offset:0 ~col_offset:0 sm - | Some (`Index i) -> + | Some (Standard sm) -> print_mapping ~line_offset:0 ~col_offset:0 sm + | Some (Index i) -> List.iter i.sections ~f:(fun - ( ({ gen_line; gen_column } : Js_of_ocaml_compiler.Source_map.Index.offset) - , `Map sm ) - -> print_mapping ~line_offset:gen_line ~col_offset:gen_column sm)); + { Js_of_ocaml_compiler.Source_map.Index.offset = { gen_line; gen_column } + ; map + } + -> print_mapping ~line_offset:gen_line ~col_offset:gen_column map)); [%expect {| $ cat "test.ml" @@ -119,7 +120,7 @@ function x (a, b) { let%expect_test _ = let map_str = ";;;;EAEE,EAAE,EAAC,CAAE;ECQY,UACC" in - let map = Source_map.Mappings.(decode (of_string map_str)) in + let map = Source_map.Mappings.(decode_exn (of_string_unsafe map_str)) in let map_str' = Source_map.Mappings.(to_string (encode map)) in print_endline map_str; print_endline map_str'; @@ -134,7 +135,7 @@ let%expect_test _ = { gen_line; gen_col; ori_source = source; ori_line = line; ori_col = col } in let s1 : Source_map.Standard.t = - { Source_map.Standard.empty with + { (Source_map.Standard.empty ~inline_source_content:false) with names = [ "na"; "nb"; "nc" ] ; sources = [ "sa"; "sb" ] ; mappings = @@ -142,7 +143,7 @@ let%expect_test _ = } in let s2 : Source_map.Standard.t = - { Source_map.Standard.empty with + { (Source_map.Standard.empty ~inline_source_content:false) with names = [ "na2"; "nb2" ] ; sources = [ "sa2" ] ; mappings = Source_map.Mappings.encode [ gen (3, 3) (5, 5) 0 ] diff --git a/compiler/tests-compiler/util/util.ml b/compiler/tests-compiler/util/util.ml index 965e3e0519..2a69f3cb81 100644 --- a/compiler/tests-compiler/util/util.ml +++ b/compiler/tests-compiler/util/util.ml @@ -421,7 +421,7 @@ let program_to_string ?(compact = false) p = let buffer = Buffer.create 17 in let pp = Jsoo.Pretty_print.to_buffer buffer in Jsoo.Pretty_print.set_compact pp compact; - let (_ : Jsoo.Source_map.Standard.t option) = Jsoo.Js_output.program pp p in + let (_ : Jsoo.Source_map.info) = Jsoo.Js_output.program pp p in (* This final comment should help to keep merge-confict inside {| .. |}, allowing to resolve confict with [dune promote]. *) Buffer.add_string buffer "//end\n"; diff --git a/compiler/tests-sourcemap/dump_sourcemap.ml b/compiler/tests-sourcemap/dump_sourcemap.ml index 59bb828bd9..c0b6d81028 100644 --- a/compiler/tests-sourcemap/dump_sourcemap.ml +++ b/compiler/tests-sourcemap/dump_sourcemap.ml @@ -40,7 +40,7 @@ let print_mapping lines ?(line_offset = 0) (sm : Source_map.Standard.t) = let lines = Array.of_list lines in let sources = Array.of_list sm.sources in let _names = Array.of_list sm.names in - let mappings = Source_map.Mappings.decode sm.mappings in + let mappings = Source_map.Mappings.decode_exn sm.mappings in List.iter mappings ~f:(fun (m : Source_map.map) -> let file = function | -1 -> "null" @@ -78,13 +78,13 @@ let print_mapping lines ?(line_offset = 0) (sm : Source_map.Standard.t) = | _ -> ())) let print_sourcemap lines = function - | `Standard sm -> print_mapping lines sm - | `Index l -> + | Source_map.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) -> + ~f:(fun { Source_map.Index.offset = { gen_line; gen_column }; map } -> assert (gen_column = 0); - print_mapping lines ~line_offset:gen_line sm) + print_mapping lines ~line_offset:gen_line map) let files = Sys.argv |> Array.to_list |> List.tl