Merge pull request #122 from ocaml-wasm/source-map-merge

Source maps: avoid some code duplication

compiler/bin-wasm_of_ocaml/compile.ml

@@ -240,7 +240,7 @@ let add_source_map sourcemap_don't_inline_content z opt_source_map_file =
       Zip.add_file z ~name:"source_map.map" ~file;
       if not sourcemap_don't_inline_content
       then
-        let sm = Wa_source_map.load file in
+        let sm = Source_map.of_file file in
         Wa_source_map.iter_sources sm (fun i j file ->
             if Sys.file_exists file && not (Sys.is_directory file)
             then

compiler/lib/source_map.ml

@@ -71,6 +71,8 @@ module Mappings = struct
 
   let empty = Uninterpreted ""
 
+  let is_empty (Uninterpreted s) = String.equal s ""
+
   let of_string_unsafe : string -> t = fun s -> Uninterpreted s
 
   let to_string : t -> string = fun (Uninterpreted s) -> s
@@ -289,8 +291,8 @@ let rewrite_path path =
 
 let invalid () = invalid_arg "Source_map.of_json"
 
-let string_of_stringlit (`Stringlit s) =
-  match Yojson.Safe.from_string s with
+let string_of_stringlit ?tmp_buf (`Stringlit s) =
+  match Yojson.Safe.from_string ?buf:tmp_buf s with
   | `String s -> s
   | _ -> invalid ()
 
@@ -507,11 +509,13 @@ module Standard = struct
                            t.sources))) )
          ])
 
-  let of_json (json : Yojson.Raw.t) =
+  let of_json ?tmp_buf (json : Yojson.Raw.t) =
     match json with
     | `Assoc (("version", `Intlit version) :: rest)
       when version_is_valid (int_of_string version) ->
-        let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in
+        let string name json =
+          Option.map ~f:(fun s -> string_of_stringlit ?tmp_buf s) (stringlit name json)
+        in
         let file = string "file" rest in
         let sourceroot = string "sourceRoot" rest in
         let names =
@@ -641,7 +645,7 @@ module Index = struct
     | _ -> invalid_arg errmsg
     | exception Not_found -> invalid_arg errmsg
 
-  let section_of_json : Yojson.Raw.t -> section = function
+  let section_of_json ?tmp_buf : Yojson.Raw.t -> section = function
     | `Assoc json ->
         let offset =
           match List.assoc "offset" json with
@@ -671,22 +675,22 @@ module Index = struct
               "Source_map.Index.of_json: URLs in index maps are not currently supported"
         | exception Not_found -> ());
         let map =
-          try Standard.of_json (List.assoc "map" json) with
+          try Standard.of_json ?tmp_buf (List.assoc "map" json) with
           | Not_found -> invalid_arg "Source_map.Index.of_json: field 'map' absent"
           | Invalid_argument _ ->
               invalid_arg "Source_map.Index.of_json: invalid sub-map object"
         in
         { offset; map }
     | _ -> invalid_arg "Source_map.Index.of_json: section of unexpected type"
 
-  let of_json = function
+  let of_json ?tmp_buf = function
     | `Assoc (("version", `Intlit version) :: fields)
       when version_is_valid (int_of_string version) -> (
         let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in
         let file = string "file" fields in
         match List.assoc "sections" fields with
         | `List sections ->
-            let sections = List.map ~f:section_of_json sections in
+            let sections = List.map ~f:(section_of_json ?tmp_buf) sections in
             { version = int_of_string version; file; sections }
         | _ -> invalid_arg "Source_map.Index.of_json: `sections` is not an array"
         | exception Not_found ->
@@ -721,16 +725,16 @@ type t =
   | Standard of Standard.t
   | Index of Index.t
 
-let of_json = function
+let of_json ?tmp_buf = function
   | `Assoc fields as json -> (
       match List.assoc "sections" fields with
-      | _ -> Index (Index.of_json json)
-      | exception Not_found -> Standard (Standard.of_json json))
+      | _ -> Index (Index.of_json ?tmp_buf json)
+      | exception Not_found -> Standard (Standard.of_json ?tmp_buf json))
   | _ -> invalid_arg "Source_map.of_json: map is not an object"
 
-let of_string s = of_json (Yojson.Raw.from_string s)
+let of_string ?tmp_buf s = of_json ?tmp_buf (Yojson.Raw.from_string ?buf:tmp_buf s)
 
-let of_file f = of_json (Yojson.Raw.from_file f)
+let of_file ?tmp_buf f = of_json ?tmp_buf (Yojson.Raw.from_file ?buf:tmp_buf f)
 
 let to_string = function
   | Standard m -> Standard.to_string m

compiler/lib/source_map.mli

@@ -21,6 +21,8 @@ module Source_content : sig
   type t
 
   val create : string -> t
+
+  val of_stringlit : [ `Stringlit of string ] -> t
 end
 
 type map =
@@ -60,6 +62,9 @@ module Mappings : sig
   val empty : t
   (** The empty mapping. *)
 
+  val is_empty : t -> bool
+  (** Test whether the mapping is empty. *)
+
   val of_string_unsafe : string -> t
   (** [of_string_unsafe] does not perform any
       validation of its argument, unlike {!val:decode}. It is guaranteed that
@@ -134,9 +139,9 @@ val to_string : t -> string
 
 val to_file : t -> string -> unit
 
-val of_string : string -> t
+val of_string : ?tmp_buf:Buffer.t -> string -> t
 
-val of_file : string -> t
+val of_file : ?tmp_buf:Buffer.t -> string -> t
 
 val invariant : t -> unit
 

compiler/lib/vlq64.ml

@@ -22,7 +22,7 @@ open! Stdlib
 let alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
 
 let code_rev =
-  let a = Array.make 255 (-1) in
+  let a = Array.make 256 (-1) in
   for i = 0 to String.length alphabet - 1 do
     a.(Char.code alphabet.[i]) <- i
   done;
@@ -99,3 +99,21 @@ let decode_l s ~pos ~len =
       aux i (d :: acc) len
   in
   aux pos [] len
+
+type input =
+  { string : string
+  ; mutable pos : int
+  ; len : int
+  }
+
+let rec decode' src s pos offset i =
+  let digit = Array.unsafe_get code_rev (Char.code s.[pos]) in
+  if digit = -1 then invalid_arg "Vql64.decode'";
+  let i = i + ((digit land vlq_base_mask) lsl offset) in
+  if digit >= vlq_continuation_bit
+  then decode' src s (pos + 1) (offset + vlq_base_shift) i
+  else (
+    src.pos <- pos + 1;
+    i)
+
+let decode src = fromVLQSigned (decode' src src.string src.pos 0 0)

compiler/lib/vlq64.mli

@@ -19,6 +19,16 @@
 
 val in_alphabet : char -> bool
 
+type input =
+  { string : string
+  ; mutable pos : int
+  ; len : int
+  }
+
+val encode : Buffer.t -> int -> unit
+
 val encode_l : Buffer.t -> int list -> unit
 
+val decode : input -> int
+
 val decode_l : string -> pos:int -> len:int -> int list

compiler/lib/wasm/wa_link.ml

@@ -575,7 +575,7 @@ let source_name i j file =
 let extract_source_map ~dir ~name z =
   if Zip.has_entry z ~name:"source_map.map"
   then (
-    let sm = Wa_source_map.parse (Zip.read_entry z ~name:"source_map.map") in
+    let sm = Source_map.of_string (Zip.read_entry z ~name:"source_map.map") in
     let sm =
       let rewrite_path path =
         if Filename.is_relative path
@@ -590,7 +590,7 @@ let extract_source_map ~dir ~name z =
           if Zip.has_entry z ~name then Some (Zip.read_entry z ~name) else None)
     in
     let map_name = name ^ ".wasm.map" in
-    Wa_source_map.write (Filename.concat dir map_name) sm;
+    Source_map.to_file sm (Filename.concat dir map_name);
     Wasm_binary.append_source_map_section
       ~file:(Filename.concat dir (name ^ ".wasm"))
       ~url:map_name)
@@ -860,7 +860,7 @@ let rec get_source_map_files files src_index =
   if Zip.has_entry z ~name:"source_map.map"
   then
     let data = Zip.read_entry z ~name:"source_map.map" in
-    let sm = Wa_source_map.parse data in
+    let sm = Source_map.of_string data in
     if not (Wa_source_map.is_empty sm)
     then (
       let l = ref [] in
@@ -879,7 +879,7 @@ let add_source_map files z opt_source_map_file =
   Option.iter
     ~f:(fun file ->
       Zip.add_file z ~name:"source_map.map" ~file;
-      let sm = Wa_source_map.load file in
+      let sm = Source_map.of_file file in
       let files = Array.of_list files in
       let src_index = ref 0 in
       let st = ref None in