Compiler: refactor sourcemap generation, use Index sourcemap

Author: hhugo

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)

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

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

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

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

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 ->

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 =