Skip to content

Commit

Permalink
Fix bugs in sourcemap processing and parse index maps
Browse files Browse the repository at this point in the history
  • Loading branch information
@OlivierNicole
OlivierNicole committed Jun 4, 2024
1 parent e25050c commit 3ffa259
Show file tree
Hide file tree
Showing 4 changed files with 149 additions and 55 deletions.
109 changes: 67 additions & 42 deletions compiler/lib/link_js.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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 -> ()
Expand All @@ -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 "@[<v>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)
Expand All @@ -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, [])
Expand All @@ -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 =
Expand Down
12 changes: 7 additions & 5 deletions compiler/lib/source_map.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
63 changes: 58 additions & 5 deletions compiler/lib/source_map_io.yojson.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Loading

0 comments on commit 3ffa259

Please sign in to comment.