Compiler: Handle composite/Index sourcemaps

Author: OlivierNicole

compiler/bin-js_of_ocaml/build_fs.ml

@@ -74,7 +74,7 @@ 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.t option) =
+      let (_ : Source_map.Standard.t option) =
         Driver.f
           ~standalone:true
           ~wrap_with_fun:`Iife

compiler/bin-js_of_ocaml/cmd_arg.ml

@@ -43,7 +43,7 @@ type t =
   { common : Jsoo_cmdline.Arg.t
   ; (* compile option *)
     profile : Driver.profile option
-  ; source_map : (string option * Source_map.t) option
+  ; source_map : (string option * Source_map.Standard.t) option
   ; runtime_files : string list
   ; no_runtime : bool
   ; include_runtime : bool
@@ -308,7 +308,7 @@ let options =
         in
         Some
           ( sm_output_file
-          , { Source_map.version = 3
+          , { Source_map.Standard.version = 3
             ; file
             ; sourceroot = sourcemap_root
             ; sources = []
@@ -537,7 +537,7 @@ let options_runtime_only =
         in
         Some
           ( sm_output_file
-          , { Source_map.version = 3
+          , { Source_map.Standard.version = 3
             ; file
             ; sourceroot = sourcemap_root
             ; sources = []

compiler/bin-js_of_ocaml/cmd_arg.mli

@@ -23,7 +23,7 @@ type t =
   { common : Jsoo_cmdline.Arg.t
   ; (* compile option *)
     profile : Driver.profile option
-  ; source_map : (string option * Source_map.t) option
+  ; source_map : (string option * Source_map.Standard.t) option
   ; runtime_files : string list
   ; no_runtime : bool
   ; include_runtime : bool

compiler/bin-js_of_ocaml/compile.ml

@@ -47,6 +47,7 @@ let output_gen ~standalone ~custom_header ~build_info ~source_map output_file f
     match source_map, sm with
     | None, _ | _, None -> ()
     | Some (output_file, _), Some sm ->
+        let sm = `Standard sm in
         let urlData =
           match output_file with
           | None ->

compiler/bin-js_of_ocaml/link.ml

@@ -23,7 +23,7 @@ open Cmdliner
 
 type t =
   { common : Jsoo_cmdline.Arg.t
-  ; source_map : (string option * Source_map.t) option
+  ; source_map : (string option * Source_map.Standard.t) option
   ; js_files : string list
   ; output_file : string option
   ; resolve_sourcemap_url : bool
@@ -102,7 +102,7 @@ let options =
         in
         Some
           ( sm_output_file
-          , { Source_map.version = 3
+          , { Source_map.Standard.version = 3
             ; file
             ; sourceroot = sourcemap_root
             ; sources = []

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.t option) = Js_output.program pp p in
+    let (_ : Source_map.Standard.t option) = Js_output.program pp p in
     ()
   in
   with_output (fun out_channel ->

compiler/lib/driver.ml

@@ -713,7 +713,7 @@ 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.t option) =
+  let (_ : Source_map.Standard.t option) =
     full ~standalone ~wrap_with_fun ~profile ~link ~source_map:None ~formatter d p
   in
   ()

compiler/lib/driver.mli

@@ -35,11 +35,11 @@ val f :
   -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
   -> ?profile:profile
   -> link:[ `All | `All_from of string list | `Needed | `No ]
-  -> ?source_map:Source_map.t
+  -> ?source_map:Source_map.Standard.t
   -> formatter:Pretty_print.t
   -> Parse_bytecode.Debug.t
   -> Code.program
-  -> Source_map.t option
+  -> Source_map.Standard.t option
 
 val f' :
      ?standalone:bool

compiler/lib/js_assign.ml

@@ -425,7 +425,7 @@ let program' (module Strategy : Strategy) p =
            "Some variables escaped (#%d). Use [--debug js_assign] for more info.@."
            (IdentSet.cardinal free)
        else
-         let (_ : Source_map.t option) =
+         let (_ : Source_map.Standard.t option) =
            Js_output.program
              ~accept_unnamed_var:true
              (Pretty_print.to_out_channel stderr)

compiler/lib/js_output.ml

@@ -1905,8 +1905,8 @@ let program ?(accept_unnamed_var = false) f ?source_map p =
   let names = Hashtbl.create 17 in
   let contents : Source_map.Source_content.t option list ref option =
     match source_map with
-    | None | Some { Source_map.sources_content = None; _ } -> None
-    | Some { Source_map.sources_content = Some _; _ } -> Some (ref [])
+    | None | Some { Source_map.Standard.sources_content = None; _ } -> None
+    | Some { Source_map.Standard.sources_content = Some _; _ } -> Some (ref [])
   in
   let push_mapping, get_file_index, get_name_index, source_map_enabled =
     let source_map_enabled =
@@ -1926,7 +1926,7 @@ let program ?(accept_unnamed_var = false) f ?source_map p =
                 loop xs ys
           in
           loop sm.sources (Option.value ~default:[] sm.sources_content);
-          List.iter sm.Source_map.names ~f:(fun f ->
+          List.iter sm.Source_map.Standard.names ~f:(fun f ->
               Hashtbl.add names f (Hashtbl.length names));
           true
     in
@@ -2014,7 +2014,7 @@ let program ?(accept_unnamed_var = false) f ?source_map p =
                     { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name })
         in
         let mappings = Source_map.Mappings.encode mappings in
-        Some { sm with Source_map.sources; names; sources_content; mappings }
+        Some { sm with Source_map.Standard.sources; names; sources_content; mappings }
   in
   PP.check f;
   (if stats ()

compiler/lib/js_output.mli

@@ -21,6 +21,6 @@
 val program :
      ?accept_unnamed_var:bool
   -> Pretty_print.t
-  -> ?source_map:Source_map.t
+  -> ?source_map:Source_map.Standard.t
   -> Javascript.program
-  -> Source_map.t option
+  -> Source_map.Standard.t option

compiler/lib/link_js.ml

@@ -154,7 +154,7 @@ type action =
   | Drop
   | Unit
   | Build_info of Build_info.t
-  | Source_map of Source_map.t
+  | Source_map of Source_map.Standard.t
 
 let prefix_kind line =
   match String.is_prefix ~prefix:sourceMappingURL line with
@@ -170,14 +170,19 @@ let prefix_kind line =
       | true -> `Json_base64 (String.length sourceMappingURL_base64)
       | false -> `Url (String.length sourceMappingURL))
 
+let rule_out_index_map = function
+  | `Standard sm -> sm
+  | `Index _ -> failwith "unexpected index map at this stage"
+
 let action ~resolve_sourcemap_url ~drop_source_map file line =
   match prefix_kind line, drop_source_map with
   | `Other, (true | false) -> Keep
   | `Unit, (true | false) -> Unit
   | `Build_info bi, _ -> Build_info bi
   | (`Json_base64 _ | `Url _), true -> Drop
   | `Json_base64 offset, false ->
-      Source_map (Source_map.of_string (Base64.decode_exn ~off:offset line))
+      Source_map
+        (rule_out_index_map (Source_map.of_string (Base64.decode_exn ~off:offset line)))
   | `Url _, false when not resolve_sourcemap_url -> Drop
   | `Url offset, false ->
       let url = String.sub line ~pos:offset ~len:(String.length line - offset) in
@@ -186,7 +191,7 @@ let action ~resolve_sourcemap_url ~drop_source_map file line =
       let l = in_channel_length ic in
       let content = really_input_string ic l in
       close_in ic;
-      Source_map (Source_map.of_string content)
+      Source_map (rule_out_index_map (Source_map.of_string content))
 
 module Units : sig
   val read : Line_reader.t -> Unit_info.t -> Unit_info.t
@@ -444,18 +449,19 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
         List.rev_map !sm ~f:(fun (sm, reloc) ->
             let tbl = Hashtbl.create 17 in
             List.iter reloc ~f:(fun (a, b) -> Hashtbl.add tbl a b);
-            Source_map.filter_map sm ~f:(Hashtbl.find_opt tbl))
+            Source_map.Standard.filter_map sm ~f:(Hashtbl.find_opt tbl))
       in
-      (match Source_map.merge (init_sm :: sm) with
+      (match Source_map.Standard.merge (init_sm :: sm) with
       | None -> ()
       | Some sm -> (
           (* preserve some info from [init_sm] *)
           let sm =
-            { sm with
-              version = init_sm.version
-            ; file = init_sm.file
-            ; sourceroot = init_sm.sourceroot
-            }
+            `Standard
+              { sm with
+                version = init_sm.version
+              ; file = init_sm.file
+              ; sourceroot = init_sm.sourceroot
+              }
           in
           match file with
           | None ->

compiler/lib/link_js.mli

@@ -24,5 +24,5 @@ val link :
   -> toplevel:bool
   -> files:string list
   -> resolve_sourcemap_url:bool
-  -> source_map:(string option * Source_map.t) option
+  -> source_map:(string option * Source_map.Standard.t) option
   -> unit