Skip to content

Commit 68c516b

Browse files
committed
introduce linked external source map
1 parent 4d93364 commit 68c516b

30 files changed

Lines changed: 734 additions & 88 deletions

compiler/bsc/rescript_compiler_main.ml

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -209,6 +209,20 @@ let[@inline] string_optional_set s : Bsc_args.spec =
209209
let[@inline] unit_call s : Bsc_args.spec = Unit (Unit_call s)
210210
let[@inline] string_list_add s : Bsc_args.spec = String (String_list_add s)
211211

212+
let parse_source_map value =
213+
Js_config.source_map :=
214+
match String.lowercase_ascii value with
215+
| "true" | "linked" -> Linked
216+
| "false" | "none" -> No_source_map
217+
| value -> Bsc_args.bad_arg ("Unsupported sourceMap value: " ^ value)
218+
219+
let parse_bool_ref target value =
220+
target :=
221+
match String.lowercase_ascii value with
222+
| "true" -> true
223+
| "false" -> false
224+
| value -> Bsc_args.bad_arg ("Expected true or false, got: " ^ value)
225+
212226
(* mostly common used to list in the beginning to make search fast
213227
*)
214228
let command_line_flags : (string * Bsc_args.spec * string) array =
@@ -259,6 +273,15 @@ let command_line_flags : (string * Bsc_args.spec * string) array =
259273
string_call ignore,
260274
"*internal* Set jsx mode, this is no longer used and is a no-op." );
261275
("-bs-jsx-preserve", set Js_config.jsx_preserve, "*internal* Preserve jsx");
276+
( "-bs-source-map",
277+
string_call parse_source_map,
278+
"*internal* Configure source map output" );
279+
( "-bs-source-map-sources-content",
280+
string_call (parse_bool_ref Js_config.source_map_sources_content),
281+
"*internal* Include original source text in source maps" );
282+
( "-bs-source-map-root",
283+
string_call (fun value -> Js_config.source_map_root := value),
284+
"*internal* Set sourceRoot in source maps" );
262285
( "-bs-package-output",
263286
string_call Js_packages_state.update_npm_package_path,
264287
"*internal* Set npm-output-path: [opt_module]:path, for example: \

compiler/common/js_config.ml

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@
2626

2727
type jsx_version = Jsx_v4
2828
type jsx_module = React | Generic of {module_name: string}
29+
type source_map = No_source_map | Linked
2930

3031
let no_version_header = ref false
3132

@@ -53,6 +54,9 @@ let jsx_version = ref None
5354
let jsx_module = ref React
5455
let jsx_preserve = ref false
5556
let js_stdout = ref true
57+
let source_map = ref No_source_map
58+
let source_map_sources_content = ref false
59+
let source_map_root = ref ""
5660
let all_module_aliases = ref false
5761
let no_stdlib = ref false
5862
let no_export = ref false

compiler/common/js_config.mli

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@
2424

2525
type jsx_version = Jsx_v4
2626
type jsx_module = React | Generic of {module_name: string}
27+
type source_map = No_source_map | Linked
2728

2829
(* val get_packages_info :
2930
unit -> Js_packages_info.t *)
@@ -86,6 +87,12 @@ val jsx_preserve : bool ref
8687

8788
val js_stdout : bool ref
8889

90+
val source_map : source_map ref
91+
92+
val source_map_sources_content : bool ref
93+
94+
val source_map_root : string ref
95+
8996
val all_module_aliases : bool ref
9097

9198
val no_stdlib : bool ref

compiler/core/dune

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,4 +6,4 @@
66
(run %{bin:cppo} %{env:CPPO_FLAGS=} %{input-file})))
77
(flags
88
(:standard -w +a-4-9-27-30-40-41-42-48-70))
9-
(libraries depends ext flow_parser frontend gentype))
9+
(libraries depends ext flow_parser frontend gentype yojson))

compiler/core/js_dump.ml

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1291,6 +1291,7 @@ and variable_declaration top cxt f (variable : J.variable_declaration) : cxt =
12911291
| _ -> (
12921292
match e.expression_desc with
12931293
| Fun {is_method; params; body; env; return_unit; async; directive} ->
1294+
pp_comment_option f e.comment;
12941295
pp_function ?directive ~is_method ~return_unit ~async
12951296
~fn_state:(if top then Name_top name else Name_non_top name)
12961297
cxt f params body env
@@ -1311,7 +1312,8 @@ and ipp_comment : 'a. P.t -> 'a -> unit = fun _f _comment -> ()
13111312
*)
13121313

13131314
and pp_comment f comment =
1314-
if String.length comment > 0 then (
1315+
if Js_source_map.mark_comment f comment then ()
1316+
else if String.length comment > 0 then (
13151317
P.string f "/* ";
13161318
P.string f comment;
13171319
P.string f " */")

compiler/core/js_source_map.ml

Lines changed: 275 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,275 @@
1+
type source = {relative_path: string; content: string option}
2+
3+
type mapping = {
4+
generated_line: int;
5+
generated_column: int;
6+
source_index: int;
7+
original_line: int;
8+
original_column: int;
9+
}
10+
11+
type t = {
12+
generated_file: string;
13+
generated_dir: string;
14+
source_root: string;
15+
sources_content: bool;
16+
sources: (string, int) Hashtbl.t;
17+
mutable source_list: source list;
18+
mutable mappings: mapping list;
19+
mutable last_generated: (int * int) option;
20+
}
21+
22+
let current : t option ref = ref None
23+
24+
let marker_prefix = "\000RESCRIPT_SOURCE_MAP:"
25+
let next_marker = ref 0
26+
let marker_locs : (int, Location.t) Hashtbl.t = Hashtbl.create 128
27+
28+
let is_prefix ~prefix s =
29+
let prefix_len = String.length prefix in
30+
String.length s >= prefix_len
31+
&&
32+
let rec loop i =
33+
i = prefix_len
34+
|| (String.unsafe_get s i = String.unsafe_get prefix i && loop (i + 1))
35+
in
36+
loop 0
37+
38+
let comment_of_loc (loc : Location.t) =
39+
match !Js_config.source_map with
40+
| No_source_map -> None
41+
| Linked ->
42+
if loc.loc_ghost || loc.loc_start.pos_cnum < 0 then None
43+
else
44+
let id = !next_marker in
45+
incr next_marker;
46+
Hashtbl.replace marker_locs id loc;
47+
Some (marker_prefix ^ string_of_int id)
48+
49+
let with_builder builder f =
50+
let old = !current in
51+
current := builder;
52+
Ext_pervasives.finally () ~clean:(fun () -> current := old) f
53+
54+
let normalize_slashes s =
55+
String.map
56+
(function
57+
| '\\' -> '/'
58+
| c -> c)
59+
s
60+
61+
let absolute_path path =
62+
if path = "" then path
63+
else if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path
64+
else path
65+
66+
let split_path path =
67+
path |> normalize_slashes |> String.split_on_char '/'
68+
|> List.filter (fun part -> part <> "")
69+
70+
let rec drop_common xs ys =
71+
match (xs, ys) with
72+
| x :: xs, y :: ys when x = y -> drop_common xs ys
73+
| _ -> (xs, ys)
74+
75+
let repeat x n =
76+
let rec loop acc n = if n <= 0 then acc else loop (x :: acc) (n - 1) in
77+
loop [] n
78+
79+
let relative_path ~from_dir ~to_file =
80+
let from_dir = absolute_path from_dir in
81+
let to_file = absolute_path to_file in
82+
let from_parts = split_path from_dir in
83+
let to_parts = split_path to_file in
84+
match (from_parts, to_parts) with
85+
| from_root :: _, to_root :: _ when from_root = to_root ->
86+
let from_rest, to_rest = drop_common from_parts to_parts in
87+
let parts = repeat ".." (List.length from_rest) @ to_rest in
88+
if parts = [] then Filename.basename to_file else String.concat "/" parts
89+
| _ -> Filename.basename to_file
90+
91+
let make ~generated_file ~source_root ~sources_content =
92+
{
93+
generated_file = Filename.basename generated_file;
94+
generated_dir = Filename.dirname generated_file;
95+
source_root;
96+
sources_content;
97+
sources = Hashtbl.create 4;
98+
source_list = [];
99+
mappings = [];
100+
last_generated = None;
101+
}
102+
103+
let load_content filename =
104+
try Some (Ext_io.load_file filename) with _ -> None
105+
106+
let add_source builder filename =
107+
let filename =
108+
match filename with
109+
| "" | "_none_" -> !Location.input_name
110+
| filename -> filename
111+
in
112+
let filename = absolute_path filename in
113+
match Hashtbl.find_opt builder.sources filename with
114+
| Some index -> (index, List.nth builder.source_list index)
115+
| None ->
116+
let source =
117+
{
118+
relative_path =
119+
relative_path ~from_dir:builder.generated_dir ~to_file:filename;
120+
content = load_content filename;
121+
}
122+
in
123+
let index = List.length builder.source_list in
124+
builder.source_list <- builder.source_list @ [source];
125+
Hashtbl.add builder.sources filename index;
126+
(index, source)
127+
128+
let utf16_units_in_utf8_slice s start stop =
129+
let len = String.length s in
130+
let stop = min stop len in
131+
let rec loop i count =
132+
if i >= stop then count
133+
else
134+
match String.unsafe_get s i with
135+
| '\n' -> loop (i + 1) 0
136+
| c ->
137+
let byte = Char.code c in
138+
if byte < 0x80 then loop (i + 1) (count + 1)
139+
else if byte land 0xE0 = 0xC0 && i + 1 < stop then
140+
loop (i + 2) (count + 1)
141+
else if byte land 0xF0 = 0xE0 && i + 2 < stop then
142+
loop (i + 3) (count + 1)
143+
else if byte land 0xF8 = 0xF0 && i + 3 < stop then
144+
loop (i + 4) (count + 2)
145+
else loop (i + 1) (count + 1)
146+
in
147+
loop (max 0 start) 0
148+
149+
let original_column source (pos : Lexing.position) =
150+
match source.content with
151+
| None -> max 0 (pos.pos_cnum - pos.pos_bol)
152+
| Some content -> utf16_units_in_utf8_slice content pos.pos_bol pos.pos_cnum
153+
154+
let add_mapping builder ~generated_line ~generated_column (loc : Location.t) =
155+
if loc.loc_ghost || loc.loc_start.pos_cnum < 0 then ()
156+
else
157+
match builder.last_generated with
158+
| Some (line, column)
159+
when line = generated_line && column = generated_column ->
160+
()
161+
| _ ->
162+
let source_index, source = add_source builder loc.loc_start.pos_fname in
163+
let original_line = max 0 (loc.loc_start.pos_lnum - 1) in
164+
let original_column = original_column source loc.loc_start in
165+
builder.mappings <-
166+
{
167+
generated_line;
168+
generated_column;
169+
source_index;
170+
original_line;
171+
original_column;
172+
}
173+
:: builder.mappings;
174+
builder.last_generated <- Some (generated_line, generated_column)
175+
176+
let mark_comment fmt comment =
177+
if is_prefix ~prefix:marker_prefix comment then (
178+
let prefix_len = String.length marker_prefix in
179+
let id =
180+
int_of_string
181+
(String.sub comment prefix_len (String.length comment - prefix_len))
182+
in
183+
(match (!current, Hashtbl.find_opt marker_locs id) with
184+
| Some builder, Some loc ->
185+
let generated_line, generated_column = Ext_pp.position fmt in
186+
add_mapping builder ~generated_line ~generated_column loc
187+
| _ -> ());
188+
true)
189+
else false
190+
191+
let base64_vlq_chars =
192+
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
193+
194+
let add_vlq buf value =
195+
let value = if value < 0 then (-value lsl 1) + 1 else value lsl 1 in
196+
let rec loop value =
197+
let digit = value land 31 in
198+
let value = value lsr 5 in
199+
let digit = if value > 0 then digit lor 32 else digit in
200+
Buffer.add_char buf base64_vlq_chars.[digit];
201+
if value > 0 then loop value
202+
in
203+
loop value
204+
205+
let compare_mapping a b =
206+
match compare a.generated_line b.generated_line with
207+
| 0 -> compare a.generated_column b.generated_column
208+
| n -> n
209+
210+
let encode_mappings mappings =
211+
let buf = Buffer.create 256 in
212+
let current_line = ref 0 in
213+
let previous_generated_column = ref 0 in
214+
let previous_source = ref 0 in
215+
let previous_original_line = ref 0 in
216+
let previous_original_column = ref 0 in
217+
let first_segment = ref true in
218+
mappings |> List.sort compare_mapping
219+
|> List.iter (fun mapping ->
220+
while !current_line < mapping.generated_line do
221+
Buffer.add_char buf ';';
222+
incr current_line;
223+
previous_generated_column := 0;
224+
first_segment := true
225+
done;
226+
if not !first_segment then Buffer.add_char buf ',';
227+
first_segment := false;
228+
add_vlq buf (mapping.generated_column - !previous_generated_column);
229+
add_vlq buf (mapping.source_index - !previous_source);
230+
add_vlq buf (mapping.original_line - !previous_original_line);
231+
add_vlq buf (mapping.original_column - !previous_original_column);
232+
previous_generated_column := mapping.generated_column;
233+
previous_source := mapping.source_index;
234+
previous_original_line := mapping.original_line;
235+
previous_original_column := mapping.original_column);
236+
Buffer.contents buf
237+
238+
let json builder =
239+
let mappings = encode_mappings builder.mappings in
240+
let fields =
241+
[
242+
("version", `Int 3);
243+
("file", `String builder.generated_file);
244+
( "sources",
245+
`List
246+
(List.map
247+
(fun source -> `String source.relative_path)
248+
builder.source_list) );
249+
("names", `List []);
250+
("mappings", `String mappings);
251+
]
252+
in
253+
let fields =
254+
if builder.source_root = "" then fields
255+
else fields @ [("sourceRoot", `String builder.source_root)]
256+
in
257+
let fields =
258+
if builder.sources_content then
259+
fields
260+
@ [
261+
( "sourcesContent",
262+
`List
263+
(List.map
264+
(fun source ->
265+
match source.content with
266+
| None -> `Null
267+
| Some content -> `String content)
268+
builder.source_list) );
269+
]
270+
else fields
271+
in
272+
Yojson.Safe.to_string (`Assoc fields)
273+
274+
let linked_comment ~map_file =
275+
"//# sourceMappingURL=" ^ Filename.basename map_file ^ "\n"

compiler/core/js_source_map.mli

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
type t
2+
3+
val make :
4+
generated_file:string -> source_root:string -> sources_content:bool -> t
5+
6+
val with_builder : t option -> (unit -> 'a) -> 'a
7+
8+
val comment_of_loc : Location.t -> string option
9+
10+
val mark_comment : Ext_pp.t -> string -> bool
11+
12+
val json : t -> string
13+
14+
val linked_comment : map_file:string -> string

0 commit comments

Comments
 (0)