CR

Author: hhugo

compiler/bin-js_of_ocaml/compile.ml

@@ -84,8 +84,8 @@ let find_source file =
         Some (Source_map.Source_content.create content)
       else None
 
-let build_source_map_with_offset
-    (sm : Source_map.Standard.t)
+let sourcemap_section_of_info
+    ~base:(sm : Source_map.Standard.t)
     { Source_map.sources; names; mappings } =
   let sources_content =
     match sm.sources_content with
@@ -98,27 +98,25 @@ let build_source_map_with_offset
         | None -> filename
         | Some _ -> Filename.concat "/builtin" filename)
   in
-  let line_offset, mappings = Source_map.Mappings.encode_with_offset mappings in
-  ( line_offset
-  , { (sm : Source_map.Standard.t) with sources; sources_content; names; mappings } )
+  let offset, mappings = Source_map.Mappings.encode_with_offset mappings in
+  let map =
+    { (sm : Source_map.Standard.t) with sources; sources_content; names; mappings }
+  in
+  { Source_map.Index.offset; map }
 
-let build_source_map_many base l =
+let sourcemap_of_infos ~base l =
   match base with
   | None -> None
   | Some (sm : Source_map.Standard.t) ->
-      let sections =
-        List.map l ~f:(fun info ->
-            let line_offset, sm = build_source_map_with_offset sm info in
-            { Source_map.Index.gen_line = line_offset; gen_column = 0 }, `Map sm)
-      in
+      let sections = List.map l ~f:(sourcemap_section_of_info ~base:sm) in
       Some
         (Source_map.Index
            { Source_map.Index.version = sm.Source_map.Standard.version
            ; file = sm.file
            ; sections
            })
 
-let build_source_map_one base info = build_source_map_many base [ info ]
+let sourcemap_of_info ~base info = sourcemap_of_infos ~base [ info ]
 
 let run
     { Cmd_arg.common
@@ -373,7 +371,7 @@ let run
             ~standalone
             ~link:`All
             output_file
-          |> build_source_map_one source_map_base)
+          |> sourcemap_of_info ~base:source_map_base)
   | (`Stdin | `File _) as bytecode ->
       let kind, ic, close_ic, include_dirs =
         match bytecode with
@@ -419,7 +417,7 @@ let run
                 ~source_map
                 ~link:(if linkall then `All else `Needed)
                 output_file
-              |> build_source_map_one source_map_base)
+              |> sourcemap_of_info ~base:source_map_base)
       | `Cmo cmo ->
           let output_file =
             match output_file, keep_unit_names with
@@ -454,10 +452,10 @@ let run
               | true ->
                   let sm1 = output_partial_runtime ~standalone ~source_map output in
                   let sm2 = output_partial cmo code ~standalone ~source_map output in
-                  build_source_map_many source_map_base [ sm1; sm2 ]
+                  sourcemap_of_infos ~base:source_map_base [ sm1; sm2 ]
               | false ->
                   output_partial cmo code ~standalone ~source_map output
-                  |> build_source_map_one source_map_base)
+                  |> sourcemap_of_info ~base:source_map_base)
       | `Cma cma when keep_unit_names ->
           (if include_runtime
            then
@@ -480,7 +478,7 @@ let run
                (`Name output_file)
                (fun ~standalone ~source_map output ->
                  output_partial_runtime ~standalone ~source_map output
-                 |> build_source_map_one source_map_base));
+                 |> sourcemap_of_info ~base:source_map_base));
           List.iter cma.lib_units ~f:(fun cmo ->
               let output_file =
                 match output_file with
@@ -516,7 +514,7 @@ let run
                 (`Name output_file)
                 (fun ~standalone ~source_map output ->
                   output_partial ~standalone ~source_map cmo code output
-                  |> build_source_map_one source_map_base))
+                  |> sourcemap_of_info ~base:source_map_base))
       | `Cma cma ->
           let f ~standalone ~source_map output =
             let source_map_runtime =
@@ -550,7 +548,7 @@ let run
               | None -> source_map_units
               | Some x -> x :: source_map_units
             in
-            build_source_map_many source_map_base sm
+            sourcemap_of_infos ~base:source_map_base sm
           in
           output_gen
             ~standalone:false

compiler/lib/link_js.ml

@@ -162,7 +162,9 @@ let action ~resolve_sourcemap_url ~drop_source_map file line =
   | `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))
+      let raw = Base64.decode_exn ~off:offset line in
+      let sm = Source_map.of_string raw in
+      Source_map sm
   | `Url _, false when not resolve_sourcemap_url -> Drop
   | `Url offset, false ->
       let url = String.sub line ~pos:offset ~len:(String.length line - offset) in
@@ -385,6 +387,7 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
                       "Skip %s@."
                       (String.concat ~sep:"," (StringSet.elements u.provides));
                   let lnum = ref 0 in
+                  let read_loffset = Line_reader.lnum ic in
                   while
                     match Line_reader.peek ic with
                     | None -> false
@@ -396,8 +399,8 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
                     skip ic;
                     incr lnum
                   done;
-                  let data_r = Line_reader.lnum ic - !lnum in
-                  reloc := `Drop (data_r, !lnum) :: !reloc)
+                  assert (read_loffset + !lnum = Line_reader.lnum ic);
+                  reloc := `Drop (read_loffset, !lnum) :: !reloc)
             | Source_map x ->
                 skip ic;
                 sm_for_file := Some x);
@@ -456,12 +459,12 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
               | Index sm ->
                   List.map
                     sm.Source_map.Index.sections
-                    ~f:(fun ({ gen_line; gen_column }, `Map sm) ->
-                      ( gen_line + Source_map.Mappings.first_line sm.mappings
-                      , gen_line + Source_map.Mappings.number_of_lines sm.mappings
+                    ~f:(fun { offset = { gen_line; gen_column }; map } ->
+                      ( gen_line + Source_map.Mappings.first_line map.mappings
+                      , gen_line + Source_map.Mappings.number_of_lines map.mappings
                       , gen_line
                       , gen_column
-                      , sm ))
+                      , map ))
             in
             (* select sourcemaps that cover copied section *)
             let maps =
@@ -494,8 +497,9 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
         ; sections =
             (* preserve some info from [init_sm] *)
             List.map sections ~f:(fun (_, _, gen_line, gen_column, sm) ->
-                ( { Source_map.Index.gen_line; gen_column }
-                , `Map { sm with sourceroot = init_sm.sourceroot } ))
+                { Source_map.Index.offset = { gen_line; gen_column }
+                ; map = { sm with sourceroot = init_sm.sourceroot }
+                })
         }
       in
       let sm = Source_map.Index sm in

compiler/lib/source_map.ml

@@ -57,14 +57,21 @@ let gen_line = function
 let gen_col = function
   | Gen { gen_col; _ } | Gen_Ori { gen_col; _ } | Gen_Ori_Name { gen_col; _ } -> gen_col
 
+module Offset = struct
+  type t =
+    { gen_line : int
+    ; gen_column : int
+    }
+end
+
 module Mappings = struct
   type decoded = map list
 
   type t = Uninterpreted of string [@@unboxed]
 
   let empty = Uninterpreted ""
 
-  let of_string : string -> t = fun s -> Uninterpreted s
+  let of_string_unsafe : string -> t = fun s -> Uninterpreted s
 
   let to_string : t -> string = fun (Uninterpreted s) -> s
 
@@ -185,13 +192,15 @@ module Mappings = struct
         offset, Uninterpreted (Buffer.contents buf)
 
   let encode mapping =
-    let offset, res = encode' ~offset:false mapping in
-    assert (offset = 0);
+    let gen_line, res = encode' ~offset:false mapping in
+    assert (gen_line = 0);
     res
 
-  let encode_with_offset mapping = encode' ~offset:true mapping
+  let encode_with_offset mapping =
+    let gen_line, res = encode' ~offset:true mapping in
+    { Offset.gen_line; gen_column = 0 }, res
 
-  let decode (Uninterpreted str) =
+  let decode_exn (Uninterpreted str) =
     let total_len = String.length str in
     let gen_col = ref 0 in
     let ori_source = ref 0 in
@@ -336,7 +345,7 @@ module Standard = struct
         Gen_Ori_Name { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name }
 
   let filter_map sm ~f =
-    let a = Array.of_list (Mappings.decode sm.mappings) in
+    let a = Array.of_list (Mappings.decode_exn sm.mappings) in
     Array.stable_sort
       ~cmp:(fun t1 t2 ->
         match compare (gen_line t1) (gen_line t2) with
@@ -391,7 +400,7 @@ module Standard = struct
                   }
                 , List.rev_append_map
                     ~f:(maps ~sources_offset ~names_offset)
-                    (Mappings.decode sm.mappings)
+                    (Mappings.decode_exn sm.mappings)
                     mappings_rev )
               in
               loop
@@ -477,7 +486,7 @@ module Standard = struct
         let mappings =
           match string "mappings" rest with
           | None -> Mappings.empty
-          | Some s -> Mappings.of_string s
+          | Some s -> Mappings.of_string_unsafe s
         in
         { version = int_of_float (float_of_string version)
         ; file
@@ -496,15 +505,15 @@ end
 (* IO *)
 
 module Index = struct
-  type offset =
-    { gen_line : int
-    ; gen_column : int
+  type section =
+    { offset : Offset.t
+    ; map : Standard.t
     }
 
   type t =
     { version : int
     ; file : string option
-    ; sections : (offset * [ `Map of Standard.t ]) list
+    ; sections : section list
     }
 
   let json t =
@@ -524,14 +533,14 @@ module Index = struct
            , Some
                (`List
                  (List.map
-                    ~f:(fun ({ gen_line; gen_column }, `Map sm) ->
+                    ~f:(fun { offset = { gen_line; gen_column }; map } ->
                       `Assoc
                         [ ( "offset"
                           , `Assoc
                               [ "line", `Intlit (string_of_int gen_line)
                               ; "column", `Intlit (string_of_int gen_column)
                               ] )
-                        ; "map", Standard.json sm
+                        ; "map", Standard.json map
                         ])
                     t.sections)) )
          ])
@@ -542,7 +551,7 @@ module Index = struct
     | _ -> invalid_arg errmsg
     | exception Not_found -> invalid_arg errmsg
 
-  let section_of_json : Yojson.Raw.t -> offset * [ `Map of Standard.t ] = function
+  let section_of_json : Yojson.Raw.t -> section = function
     | `Assoc json ->
         let offset =
           match List.assoc "offset" json with
@@ -563,7 +572,7 @@ module Index = struct
                     "Source_map_io.Index.of_json: field 'column' absent or invalid from \
                      section"
               in
-              { gen_line; gen_column }
+              { Offset.gen_line; gen_column }
           | _ ->
               invalid_arg "Source_map_io.Index.of_json: 'offset' field of unexpected type"
         in
@@ -579,7 +588,7 @@ module Index = struct
           | Invalid_argument _ ->
               invalid_arg "Source_map_io.Index.of_json: invalid sub-map object"
         in
-        offset, `Map map
+        { offset; map }
     | _ -> invalid_arg "Source_map_io.Index.of_json: section of unexpected type"
 
   let of_json = function

compiler/lib/source_map.mli

@@ -44,35 +44,46 @@ type map =
       ; ori_name : int
       }
 
+module Offset : sig
+  type t =
+    { gen_line : int
+    ; gen_column : int
+    }
+end
+
 module Mappings : sig
   type decoded = map list
 
   type t
+  (** Represent the a list of mapping in its encoded form. *)
 
   val empty : t
-  (** Represents the empty mapping. *)
+  (** The empty mapping. *)
 
-  val of_string : string -> t
-  (** By default, mappings are left uninterpreted, since many operations can be
-      performed efficiently directly on the encoded form. Therefore this
-      function is mostly a no-op and very cheap. It does not perform any
+  val of_string_unsafe : string -> t
+  (** [of_string_unsafe] does not perform any
       validation of its argument, unlike {!val:decode}. It is guaranteed that
-      {!val:of_string} and {!val:to_string} are inverse functions. *)
+      {!val:of_string_unsafe} and {!val:to_string} are inverse functions.
+      Time complexity O(1) *)
 
-  val decode : t -> decoded
+  val decode_exn : t -> decoded
   (** Parse the mappings. *)
 
   val encode : decoded -> t
+  (** Encode the mappings. *)
 
-  val encode_with_offset : decoded -> int * t
+  val encode_with_offset : decoded -> Offset.t * t
+  (** Encode the mappings shifted by the returned offset so that the
+      encoded mapping is more compact. This is useful to combining
+      multiple mappings into an [Index.t] *)
 
   val number_of_lines : t -> int
 
   val first_line : t -> int
 
   val to_string : t -> string
-  (** Returns the mappings as a string in the Source map v3 format. This
-      function is mostly a no-op and is very cheap. *)
+  (** Returns the mappings as a string in the Source map v3 format.
+    Time complexity O(1) *)
 end
 
 module Standard : sig
@@ -102,15 +113,15 @@ module Standard : sig
 end
 
 module Index : sig
-  type offset =
-    { gen_line : int
-    ; gen_column : int
+  type section =
+    { offset : Offset.t
+    ; map : Standard.t
     }
 
-  type nonrec t =
+  type t =
     { version : int
     ; file : string option
-    ; sections : (offset * [ `Map of Standard.t ]) list
+    ; sections : section list
     }
 end
 

compiler/tests-compiler/build_path_prefix_map.ml

@@ -37,7 +37,11 @@ let%expect_test _ =
       |> function
       | Some (Standard (sm : Js_of_ocaml_compiler.Source_map.Standard.t)) ->
           print_section sm
-      | Some (Index i) -> List.iter i.sections ~f:(fun (_, `Map sm) -> print_section sm)
+      | Some (Index i) ->
+          List.iter
+            i.sections
+            ~f:(fun { Js_of_ocaml_compiler.Source_map.Index.offset = _; map } ->
+              print_section map)
       | None -> failwith "no sourcemap generated!");
   [%expect
     {|