WIP

compiler/bin-js_of_ocaml/compile.ml

@@ -56,6 +56,7 @@ let output_gen ~standalone ~custom_header ~build_info ~source_map output_file f
     match source_map, sm with
     | No_sourcemap, _ | _, None -> ()
     | ((Inline | File _) as output), Some sm ->
+        if Debug.find "invariant" () then Source_map.invariant sm;
         let urlData =
           match output with
           | No_sourcemap -> assert false

compiler/lib/source_map.ml

@@ -256,16 +256,29 @@ module Mappings = struct
                   ; ori_col = !ori_col
                   ; ori_name = !ori_name
                   }
-            | _ -> invalid_arg "Source_map.mapping_of_string"
+            | _ -> invalid_arg "Source_map.Mappings.decode_exn"
           in
           let acc = v :: acc in
           if last = stop then last + 1, acc else read_tokens line (last + 1) stop acc
     in
     (* The binary format encodes lines starting at zero, but
        [ori_line] and [gen_line] are 1 based. *)
     readline 1 0 []
+
+  let invariant ~names:_ ~sources:_ (Uninterpreted str) =
+    (* We can't check much without decoding (which is expensive) *)
+    (* Just do very simple checks *)
+    if not
+         (String.for_all str ~f:(function
+             | ';' | ',' -> true
+             | x -> Vlq64.in_alphabet x))
+    then invalid_arg "Mappings.invariant"
 end
 
+let version_is_valid = function
+  | 3 -> true
+  | _ -> false
+
 let rewrite_path path =
   if Filename.is_relative path
   then path
@@ -463,7 +476,8 @@ module Standard = struct
 
   let of_json (json : Yojson.Raw.t) =
     match json with
-    | `Assoc (("version", `Intlit version) :: rest) when int_of_string version = 3 ->
+    | `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 file = string "file" rest in
         let sourceroot = string "sourceRoot" rest in
@@ -491,7 +505,7 @@ module Standard = struct
           | None -> Mappings.empty
           | Some s -> Mappings.of_string_unsafe s
         in
-        { version = int_of_float (float_of_string version)
+        { version = int_of_string version
         ; file
         ; sourceroot
         ; names
@@ -504,8 +518,21 @@ module Standard = struct
   let to_string m = Yojson.Raw.to_string (json m)
 
   let to_file m file = Yojson.Raw.to_file file (json m)
+
+  let invariant
+      { version; file = _; sourceroot = _; names; sources_content; sources; mappings } =
+    if not (version_is_valid version)
+    then invalid_arg "Source_map.Standard.invariant: invalid version";
+    match sources_content with
+    | None -> ()
+    | Some x ->
+        if not (List.length sources = List.length x)
+        then
+          invalid_arg
+            "Source_map.Standard.invariant: sources and sourcesContent must have the \
+             same size";
+        Mappings.invariant ~names ~sources mappings
 end
-(* IO *)
 
 module Index = struct
   type section =
@@ -564,52 +591,70 @@ module Index = struct
                   "line"
                   fields
                   ~errmsg:
-                    "Source_map_io.Index.of_json: field 'line' absent or invalid from \
+                    "Source_map.Index.of_json: field 'line' absent or invalid from \
                      section"
               in
               let gen_column =
                 intlit
                   "column"
                   fields
                   ~errmsg:
-                    "Source_map_io.Index.of_json: field 'column' absent or invalid from \
+                    "Source_map.Index.of_json: field 'column' absent or invalid from \
                      section"
               in
               { Offset.gen_line; gen_column }
-          | _ ->
-              invalid_arg "Source_map_io.Index.of_json: 'offset' field of unexpected type"
+          | _ -> invalid_arg "Source_map.Index.of_json: 'offset' field of unexpected type"
         in
         (match List.assoc "url" json with
         | _ ->
             invalid_arg
-              "Source_map_io.Index.of_json: URLs in index maps are not currently \
-               supported"
+              "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
-          | Not_found -> invalid_arg "Source_map_io.Index.of_json: field 'map' absent"
+          | Not_found -> invalid_arg "Source_map.Index.of_json: field 'map' absent"
           | Invalid_argument _ ->
-              invalid_arg "Source_map_io.Index.of_json: invalid sub-map object"
+              invalid_arg "Source_map.Index.of_json: invalid sub-map object"
         in
         { offset; map }
-    | _ -> invalid_arg "Source_map_io.Index.of_json: section of unexpected type"
+    | _ -> invalid_arg "Source_map.Index.of_json: section of unexpected type"
 
   let of_json = function
-    | `Assoc fields -> (
+    | `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
-            { version = 3; file; sections }
-        | _ -> invalid_arg "Source_map_io.Index.of_json: `sections` is not an array"
+            { version = int_of_string version; file; sections }
+        | _ -> invalid_arg "Source_map.Index.of_json: `sections` is not an array"
         | exception Not_found ->
-            invalid_arg "Source_map_io.Index.of_json: no `sections` field")
-    | _ -> invalid_arg "Source_map_io.of_json: map is not an object"
+            invalid_arg "Source_map.Index.of_json: no `sections` field")
+    | _ -> invalid_arg "Source_map.Index.of_json"
 
   let to_string m = Yojson.Raw.to_string (json m)
 
   let to_file m file = Yojson.Raw.to_file file (json m)
+
+  let invariant { version; file = _; sections } =
+    if not (version_is_valid version)
+    then invalid_arg "Source_map.Index.invariant: invalid version";
+    let _ : int =
+      List.fold_left
+        sections
+        ~init:(-1)
+        ~f:(fun acc { offset = { gen_line; gen_column }; map } ->
+          if gen_line < 0 || gen_column < 0
+          then invalid_arg "Source_map.Index.invariant: invalid offset";
+          if acc >= gen_line
+          then
+            invalid_arg
+              "Source_map.Index.invariant: overlapping or unordered map in sections";
+          Standard.invariant map;
+          gen_line + Mappings.number_of_lines map.mappings)
+    in
+    ()
 end
 
 type t =
@@ -621,7 +666,7 @@ let of_json = function
       match List.assoc "sections" fields with
       | _ -> Index (Index.of_json json)
       | exception Not_found -> Standard (Standard.of_json json))
-  | _ -> invalid_arg "Source_map_io.of_json: map is not an object"
+  | _ -> invalid_arg "Source_map.of_json: map is not an object"
 
 let of_string s = of_json (Yojson.Raw.from_string s)
 
@@ -636,6 +681,10 @@ let to_file x f =
   | Standard m -> Standard.to_file m f
   | Index i -> Index.to_file i f
 
+let invariant = function
+  | Standard m -> Standard.invariant m
+  | Index i -> Index.invariant i
+
 type info =
   { mappings : Mappings.decoded
   ; sources : string list

compiler/lib/source_map.mli

@@ -137,6 +137,8 @@ val of_string : string -> t
 
 val of_file : string -> t
 
+val invariant : t -> unit
+
 type info =
   { mappings : Mappings.decoded
   ; sources : string list

compiler/lib/vlq64.ml

@@ -19,15 +19,17 @@
 
 open! Stdlib
 
-let code = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
+let alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
 
 let code_rev =
   let a = Array.make 255 (-1) in
-  for i = 0 to String.length code - 1 do
-    a.(Char.code code.[i]) <- i
+  for i = 0 to String.length alphabet - 1 do
+    a.(Char.code alphabet.[i]) <- i
   done;
   a
 
+let in_alphabet x = code_rev.(Char.code x) <> -1
+
 let vlq_base_shift = 5
 
 (* binary: 100000 *)
@@ -56,7 +58,7 @@ let fromVLQSigned v =
 (* assert (fromVLQSigned 3 = -1); *)
 (* assert (fromVLQSigned 5 = -2);; *)
 
-let add_char buf x = Buffer.add_char buf code.[x]
+let add_char buf x = Buffer.add_char buf alphabet.[x]
 
 let rec encode' buf x =
   let digit = x land vlq_base_mask in

compiler/lib/vlq64.mli

@@ -17,6 +17,8 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
+val in_alphabet : char -> bool
+
 val encode_l : Buffer.t -> int list -> unit
 
 val decode_l : string -> pos:int -> len:int -> int list