diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml index fea7cc2b24..285b465da0 100644 --- a/compiler/lib/link_js.ml +++ b/compiler/lib/link_js.ml @@ -35,7 +35,9 @@ module Line_reader : sig val peek : t -> string option - val drop : t -> unit + val drop : t -> drop_action:(unit -> unit) -> unit + (** [drop_action] is the function to call if a line was effectively dropped + (if EOF is reached, this function may return without dropping a line). *) val close : t -> unit @@ -78,15 +80,17 @@ end = struct Some s with End_of_file -> None) - let drop t = + let drop t ~drop_action = match t.next with | Some _ -> t.next <- None; - t.lnum <- t.lnum + 1 + t.lnum <- t.lnum + 1; + drop_action () | None -> ( try let (_ : string) = input_line t.ic in - t.lnum <- t.lnum + 1 + t.lnum <- t.lnum + 1; + drop_action () with End_of_file -> ()) let lnum t = t.lnum @@ -99,9 +103,15 @@ module Line_writer : sig val of_channel : out_channel -> t - val write : ?source:Line_reader.t -> t -> string -> int + val write : ?source:Line_reader.t -> t -> add:(int -> unit) -> string -> unit + (** [write ~source t s ~add] writes [s], followed by a newline, and calls + [edit], giving it in argument the number of "line number" pragma lines + emitted before writing [s]. *) - val write_lines : ?source:Line_reader.t -> t -> string -> int + val write_lines : ?source:Line_reader.t -> t -> total:(int -> unit) -> string -> unit + (** [write_lines ~source t s ~total] writes all lines in [s], ensures that the last + line ends with a newline, and calls [total], giving it in argument the total number + of lines written, including "line number" pragma lines. *) val lnum : t -> int end = struct @@ -113,7 +123,7 @@ end = struct let of_channel oc = { oc; source = None; lnum = 0 } - let write ?source t s = + let write ?source t ~add s = let source = match source with | None -> None @@ -130,24 +140,24 @@ end = struct | Some (fname1, lnum1), Some (fname2, lnum2) -> if String.equal fname1 fname2 && lnum1 + 1 = lnum2 then 0 else emit fname2 lnum2 in + add lnum_off; 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; - lnum_off + t.lnum <- t.lnum + lnum_off - let write_lines ?source t lines = - let lnum = t.lnum in + let write_lines ?source t ~total lines = let l = String.split_on_char ~sep:'\n' lines in + let lcount = ref 0 in let rec w = function | [ "" ] | [] -> () | s :: xs -> - let _ = write ?source t s in + let _ = write ?source t s ~add:(fun n -> lcount := !lcount + n + 1) in w xs in w l; - t.lnum - lnum + total !lcount let lnum t = t.lnum end @@ -197,41 +207,41 @@ let action ~resolve_sourcemap_url ~drop_source_map file line = Source_map (rule_out_index_map (Source_map_io.of_string content)) module Units : sig - val read : Line_reader.t -> Unit_info.t -> Unit_info.t + val read : Line_reader.t -> drop_action:(unit -> unit) -> Unit_info.t -> Unit_info.t val scan_file : string -> Build_info.t option * Unit_info.t list end = struct - let rec read ic uinfo = + let rec read ic ~drop_action uinfo = match Line_reader.peek ic with | None -> uinfo | Some line -> ( match Unit_info.parse uinfo line with | None -> uinfo | Some uinfo -> - Line_reader.drop ic; - read ic uinfo) + Line_reader.drop ~drop_action ic; + read ic ~drop_action uinfo) - let find_unit_info ic = + let find_unit_info ~drop_action ic = let rec find_next ic = match Line_reader.peek ic with | None -> None | Some line -> ( match prefix_kind line with | `Json_base64 _ | `Url _ | `Other | `Build_info _ -> - Line_reader.drop ic; + Line_reader.drop ~drop_action ic; find_next ic - | `Unit -> Some (read ic Unit_info.empty)) + | `Unit -> Some (read ic ~drop_action Unit_info.empty)) in find_next ic - let find_build_info ic = + let find_build_info ~drop_action ic = let rec find_next ic = match Line_reader.peek ic with | None -> None | Some line -> ( match prefix_kind line with | `Json_base64 _ | `Url _ | `Other -> - Line_reader.drop ic; + Line_reader.drop ~drop_action ic; find_next ic | `Build_info bi -> Some bi | `Unit -> None) @@ -240,12 +250,13 @@ end = struct let scan_file file = let ic = Line_reader.open_ file in + let drop_action () = () in let rec scan_all ic acc = - match find_unit_info ic with + match find_unit_info ~drop_action ic with | None -> List.rev acc | Some x -> scan_all ic (x :: acc) in - let build_info = find_build_info ic in + let build_info = find_build_info ~drop_action ic in let units = scan_all ic [] in Line_reader.close ic; build_info, units @@ -328,24 +339,33 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source let ic = Line_reader.open_ file in let old_line_count = Line_writer.lnum oc in let edits = ref [] in - let skip ic = - edits := Source_map.Line_edits.Drop :: !edits; - Line_reader.drop ic - in + let emit_drop_action edits () = edits := Source_map.Line_edits.Drop :: !edits in + let skip ic = Line_reader.drop ~drop_action:(emit_drop_action edits) ic in let copy ic oc = let line = Line_reader.next ic in - let count = Line_writer.write ~source:ic oc line in - if count > 1 - then edits := Source_map.Line_edits.Add { count = count - 1 } :: !edits; + Line_writer.write + ~source:ic + ~add:(fun count -> + edits := Add { count } :: !edits) + oc + line; + (* Note: line actions are in reverse order compared to the actual generated + lines *) edits := Source_map.Line_edits.Keep :: !edits in let write_line oc str = - let count = Line_writer.write oc str in - edits := Source_map.Line_edits.(Add { count }) :: !edits + Line_writer.write + oc + str + ~add:(fun count -> + edits := Source_map.Line_edits.(Add { count = count + 1 }) :: !edits) in let write_lines oc str = - let count = Line_writer.write_lines oc str in - edits := Source_map.Line_edits.(Add { count }) :: !edits + Line_writer.write_lines + oc + str + ~total:(fun count -> + edits := Source_map.Line_edits.(Add { count }) :: !edits) in let rec read () = match Line_reader.peek ic with @@ -368,7 +388,7 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source build_info_emitted := true) | Drop -> skip ic | Unit -> - let u = Units.read ic Unit_info.empty in + let u = Units.read ic ~drop_action:(emit_drop_action edits) Unit_info.empty in if StringSet.cardinal (StringSet.inter u.Unit_info.provides to_link) > 0 then ( if u.effects_without_cps && not !warn_effects @@ -449,7 +469,7 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source write_lines oc content); (match !sm_for_file with | None -> () - | Some x -> sm := (x, List.rev !edits, Line_writer.lnum oc - old_line_count) :: !sm); + | Some x -> sm := (file, x, List.rev !edits, Line_writer.lnum oc - old_line_count) :: !sm); match !build_info, build_info_for_file with | None, None -> () | Some _, None -> () @@ -463,7 +483,12 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source | None -> () | Some (file, init_sm) -> let sourcemaps_and_line_counts = - List.rev_map !sm ~f:(fun (sm, edits, lcount) -> + List.rev_map !sm ~f:(fun (file, sm, edits, lcount) -> + if debug () then ( + Format.eprintf "@[line actions for '%s' (lcount %d)@," file lcount; + Format.eprintf "%a@," Source_map.Line_edits.pp edits; + Format.eprintf "@]"; + ); let mappings = sm.Source_map.mappings in let mappings = Source_map.Mappings.edit ~strict:false mappings edits in { sm with mappings }, lcount) @@ -475,9 +500,9 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source ; file = init_sm.file ; Index.sections = (let _, sections = - List.fold_right + List.fold_left sourcemaps_and_line_counts - ~f:(fun (sm, generated_line_count) (cur_ofs, sections) -> + ~f:(fun (cur_ofs, sections) (sm, generated_line_count) -> let offset = Index.{ gen_line = cur_ofs; gen_column = 0 } in cur_ofs + generated_line_count, (offset, `Map sm) :: sections) ~init:(0, []) @@ -497,11 +522,11 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source | None -> let data = Source_map_io.Index.to_string merged_sourcemap in let s = sourceMappingURL_base64 ^ Base64.encode_exn data in - Line_writer.write oc s |> ignore + Line_writer.write oc s ~add:(fun _ -> ()) |> ignore | Some file -> Source_map_io.Index.to_file merged_sourcemap file; let s = sourceMappingURL ^ Filename.basename file in - Line_writer.write oc s |> ignore); + Line_writer.write oc s ~add:(fun _ -> ()) |> ignore); if times () then Format.eprintf " sourcemap: %a@." Timer.print t let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source_map = diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml index ac62c5d0cf..52f9a08e9a 100644 --- a/compiler/lib/source_map.ml +++ b/compiler/lib/source_map.ml @@ -130,7 +130,7 @@ module Mappings = struct try min (String.index_from str pos ',') end_ with Not_found -> end_ in let len = next_delim - pos in - if len = 0 then acc else loop (f acc str ~pos ~len) next_delim end_ + if len <= 0 then acc else loop (f acc str ~pos ~len) (next_delim + 1) end_ in loop init pos (pos + len) @@ -177,14 +177,16 @@ module Mappings = struct ~len str ~buf = - let carries = + let _, carries = fold_on_segments ~str ~pos ~len - ~init:{ carry_source; carry_line; carry_col; carry_name } - (fun acc str ~pos ~len -> + ~init:(true, { carry_source; carry_line; carry_col; carry_name }) + (fun (is_first, acc) str ~pos ~len -> let { carry_source; carry_line; carry_col; carry_name } = acc in + if not is_first then + Buffer.add_char buf ','; let carry_source, carry_line, carry_col, carry_name = update_carries_and_write_segment ~carry_source @@ -196,7 +198,7 @@ module Mappings = struct str ~buf in - { carry_source; carry_line; carry_col; carry_name }) + false, { carry_source; carry_line; carry_col; carry_name }) in Buffer.add_char buf ';'; carries diff --git a/compiler/lib/source_map_io.yojson.ml b/compiler/lib/source_map_io.yojson.ml index 101615e884..f44b2e3858 100644 --- a/compiler/lib/source_map_io.yojson.ml +++ b/compiler/lib/source_map_io.yojson.ml @@ -101,7 +101,7 @@ let stringlit_list_opt name assoc = | _ -> invalid () | exception Not_found -> None -let of_json json = +let standard_map_of_json json = match json with | `Assoc (("version", version) :: rest) -> (match version with @@ -110,8 +110,7 @@ let of_json json = | `Floatlit _ | `Intlit _ -> invalid_arg "Source_map_io.of_json: version != 3" | _ -> invalid_arg "Source_map_io.of_json: version field is not a number"); (match List.assoc "sections" rest with - | _ -> - invalid_arg "Source_map_io.of_json: this seems to be an index map. Reading index maps is currently not supported." + | _ -> invalid_arg "Source_map_io.standard_map_of_json: not a standard map" | exception Not_found -> ()); let file = string "file" rest in let sourceroot = string "sourceRoot" rest in @@ -139,8 +138,6 @@ let of_json json = } | _ -> invalid () -let of_string s = `Standard (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) @@ -167,7 +164,63 @@ module Index = struct 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 -> Index.offset * [`Map of t] = 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 + Index.{ 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 file = string "file" fields in + match List.assoc "sections" fields with + | `List sections -> + let sections = + List.map + section_of_json + sections + in + { + Index.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) diff --git a/compiler/tests-sourcemap/dump_sourcemap.ml b/compiler/tests-sourcemap/dump_sourcemap.ml index 0ab1dda057..cca4f35946 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_io.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,23 @@ 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); + (* + Format.eprintf "[@SOURCEMAP (line = %d)@," gen_line; + Yojson.Raw.pretty_print Format.err_formatter sm; + *) + print_mapping lines ~line_offset:gen_line sm + ) + let files = Sys.argv |> Array.to_list |> List.tl let () = @@ -80,4 +94,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)