Source map: repeat mappings over new lines

Firefox assumes that a mapping stops at the end of a line, which is
inconvenient. When this happens, we repeat the mapping on the next line.

Author: vouillon

compiler/lib/js_output.ml

@@ -2104,21 +2104,38 @@ let program ?(accept_unnamed_var = false) ?(source_map = false) f p =
     | true ->
         let sources = hashtbl_to_list files in
         let names = hashtbl_to_list names in
+        let relocate pos m =
+          let gen_line = pos.PP.p_line + 1 in
+          let gen_col = pos.PP.p_col in
+          match m with
+          | Source_map.Gen { gen_col = _; gen_line = _ } ->
+              Source_map.Gen { gen_col; gen_line }
+          | Source_map.Gen_Ori m -> Source_map.Gen_Ori { m with gen_line; gen_col }
+          | Source_map.Gen_Ori_Name m ->
+              Source_map.Gen_Ori_Name { m with gen_line; gen_col }
+        in
+        let rec build_mappings pos mapping prev_mappings =
+          match mapping with
+          | [] -> prev_mappings
+          | (pos', m) :: rem ->
+              (* Firefox assumes that a mapping stops at the end of a
+                 line, which is inconvenient. When this happens, we
+                 repeat the mapping on the next line. *)
+              if pos'.PP.p_line = pos.PP.p_line
+                 || (pos'.p_line = pos.p_line - 1 && pos.p_col = 0)
+              then build_mappings pos' rem (relocate pos' m :: prev_mappings)
+              else if pos.p_col > 0
+              then
+                let pos = { pos with p_col = 0 } in
+                build_mappings pos mapping (relocate pos m :: prev_mappings)
+              else
+                let pos = { pos with p_line = pos.p_line - 1 } in
+                build_mappings pos mapping (relocate pos m :: prev_mappings)
+        in
         let mappings =
-          List.rev_map !temp_mappings ~f:(fun (pos, m) ->
-              let gen_line = pos.PP.p_line + 1 in
-              let gen_col = pos.PP.p_col in
-              match m with
-              | Source_map.Gen { gen_col = _; gen_line = _ } ->
-                  Source_map.Gen { gen_col; gen_line }
-              | Source_map.Gen_Ori
-                  { gen_line = _; gen_col = _; ori_source; ori_line; ori_col } ->
-                  Source_map.Gen_Ori { gen_line; gen_col; ori_source; ori_line; ori_col }
-              | Source_map.Gen_Ori_Name
-                  { gen_line = _; gen_col = _; ori_source; ori_line; ori_col; ori_name }
-                ->
-                  Source_map.Gen_Ori_Name
-                    { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name })
+          match !temp_mappings with
+          | [] -> []
+          | (pos, m) :: rem -> build_mappings pos rem [ relocate pos m ]
         in
         { Source_map.sources; names; mappings }
   in

compiler/tests-compiler/sourcemap.ml

@@ -85,10 +85,12 @@ let%expect_test _ =
        13: //# sourceMappingURL=test.map
       /builtin/blackbox.ml:1:0 -> 5:7
       /builtin/blackbox.ml:1:0 -> 5:17
+      /builtin/blackbox.ml:1:0 -> 6:0
       /dune-root/test.ml:1:4 -> 6:12
       /dune-root/test.ml:1:7 -> 6:15
       /dune-root/test.ml:1:11 -> 6:18
       /dune-root/test.ml:1:12 -> 6:28
+      /dune-root/test.ml:1:12 -> 7:0
       /dune-root/test.ml:1:12 -> 7:7
       /builtin/blackbox.ml:1:0 -> 7:14
     |}]

compiler/tests-sourcemap/dump.reference

@@ -3,4 +3,5 @@ sourcemap for test.bc.js
 /my/sourceRoot#b.ml:1:6 -> 14:   function f(<>x){return x - 1 | 0; }
 /my/sourceRoot#b.ml:1:10 -> 17:   function f(x){<>return x - 1 | 0; }
 /my/sourceRoot#b.ml:1:15 -> 35:   function f(x){return x - 1 | 0; <>}
+/my/sourceRoot#b.ml:1:15 -> 0:<>   var Testlib_B = [0, f];
 /my/sourceRoot#b.ml:1:15 -> 7:   var <>Testlib_B = [0, f];