Introduce Sourcemap

compiler/bsc/rescript_compiler_main.ml

@@ -209,6 +209,20 @@ let[@inline] string_optional_set s : Bsc_args.spec =
 let[@inline] unit_call s : Bsc_args.spec = Unit (Unit_call s)
 let[@inline] string_list_add s : Bsc_args.spec = String (String_list_add s)
 
+let parse_source_map value =
+  Js_config.source_map :=
+    match String.lowercase_ascii value with
+    | "true" | "linked" -> Linked
+    | "false" | "none" -> No_source_map
+    | value -> Bsc_args.bad_arg ("Unsupported sourceMap value: " ^ value)
+
+let parse_bool_ref target value =
+  target :=
+    match String.lowercase_ascii value with
+    | "true" -> true
+    | "false" -> false
+    | value -> Bsc_args.bad_arg ("Expected true or false, got: " ^ value)
+
 (* mostly common used to list in the beginning to make search fast
 *)
 let command_line_flags : (string * Bsc_args.spec * string) array =
@@ -259,6 +273,15 @@ let command_line_flags : (string * Bsc_args.spec * string) array =
       string_call ignore,
       "*internal* Set jsx mode, this is no longer used and is a no-op." );
     ("-bs-jsx-preserve", set Js_config.jsx_preserve, "*internal* Preserve jsx");
+    ( "-bs-source-map",
+      string_call parse_source_map,
+      "*internal* Configure source map output" );
+    ( "-bs-source-map-sources-content",
+      string_call (parse_bool_ref Js_config.source_map_sources_content),
+      "*internal* Include original source text in source maps" );
+    ( "-bs-source-map-root",
+      string_call (fun value -> Js_config.source_map_root := value),
+      "*internal* Set sourceRoot in source maps" );
     ( "-bs-package-output",
       string_call Js_packages_state.update_npm_package_path,
       "*internal* Set npm-output-path: [opt_module]:path, for example: \

compiler/common/js_config.ml

@@ -26,6 +26,7 @@
 
 type jsx_version = Jsx_v4
 type jsx_module = React | Generic of {module_name: string}
+type source_map = No_source_map | Linked
 
 let no_version_header = ref false
 
@@ -53,6 +54,9 @@ let jsx_version = ref None
 let jsx_module = ref React
 let jsx_preserve = ref false
 let js_stdout = ref true
+let source_map = ref No_source_map
+let source_map_sources_content = ref false
+let source_map_root = ref ""
 let all_module_aliases = ref false
 let no_stdlib = ref false
 let no_export = ref false

compiler/common/js_config.mli

@@ -24,6 +24,7 @@
 
 type jsx_version = Jsx_v4
 type jsx_module = React | Generic of {module_name: string}
+type source_map = No_source_map | Linked
 
 (* val get_packages_info :
    unit -> Js_packages_info.t *)
@@ -86,6 +87,12 @@ val jsx_preserve : bool ref
 
 val js_stdout : bool ref
 
+val source_map : source_map ref
+
+val source_map_sources_content : bool ref
+
+val source_map_root : string ref
+
 val all_module_aliases : bool ref
 
 val no_stdlib : bool ref

compiler/core/dune

@@ -6,4 +6,4 @@
    (run %{bin:cppo} %{env:CPPO_FLAGS=} %{input-file})))
  (flags
   (:standard -w +a-4-9-27-30-40-41-42-48-70))
- (libraries depends ext flow_parser frontend gentype))
+ (libraries depends ext flow_parser frontend gentype yojson))

compiler/core/js_dump.ml

@@ -1291,6 +1291,7 @@ and variable_declaration top cxt f (variable : J.variable_declaration) : cxt =
     | _ -> (
       match e.expression_desc with
       | Fun {is_method; params; body; env; return_unit; async; directive} ->
+        pp_comment_option f e.comment;
         pp_function ?directive ~is_method ~return_unit ~async
           ~fn_state:(if top then Name_top name else Name_non_top name)
           cxt f params body env
@@ -1311,7 +1312,8 @@ and ipp_comment : 'a. P.t -> 'a -> unit = fun _f _comment -> ()
 *)
 
 and pp_comment f comment =
-  if String.length comment > 0 then (
+  if Js_source_map.mark_comment f comment then ()
+  else if String.length comment > 0 then (
     P.string f "/* ";
     P.string f comment;
     P.string f " */")

compiler/core/js_implementation.ml

@@ -141,17 +141,18 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) =
       let typedtree_coercion = (typedtree, coercion) in
       print_if ppf Clflags.dump_typedtree
         Printtyped.implementation_with_coercion typedtree_coercion;
-      (if !Js_config.cmi_only then Warnings.check_fatal ()
-       else
-         let lambda, exports =
-           Translmod.transl_implementation modulename typedtree_coercion
-         in
-         let js_program =
-           print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda
-           |> Lam_compile_main.compile outputprefix exports
-         in
-         if not !Js_config.cmj_only then
-           Lam_compile_main.lambda_as_module js_program outputprefix);
+      Js_source_map.with_marker_scope (fun () ->
+          if !Js_config.cmi_only then Warnings.check_fatal ()
+          else
+            let lambda, exports =
+              Translmod.transl_implementation modulename typedtree_coercion
+            in
+            let js_program =
+              print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda
+              |> Lam_compile_main.compile outputprefix exports
+            in
+            if not !Js_config.cmj_only then
+              Lam_compile_main.lambda_as_module js_program outputprefix);
       process_with_gentype (outputprefix ^ ".cmt"))
 
 let implementation ~parser ppf ?outputprefix fname =