move some validation out of rewrite

src/ast/binary.ml

@@ -27,7 +27,7 @@ type global =
 type data_mode =
   | Data_passive
   (* TODO: Data_active binary+const expr*)
-  | Data_active of int option * binary expr
+  | Data_active of int * binary expr
 
 type data =
   { id : string option

src/ast/binary_encoder.ml

@@ -604,16 +604,15 @@ let write_data buf ({ init; mode; _ } : data) =
   | Data_passive ->
     write_u32_of_int buf 1;
     write_string buf init
-  | Data_active (Some 0, expr) ->
+  | Data_active (0, expr) ->
     write_u32_of_int buf 0;
     write_expr buf expr ~end_op_code:None;
     write_string buf init
-  | Data_active (Some i, expr) ->
+  | Data_active (i, expr) ->
     write_u32_of_int buf 2;
     write_u32_of_int buf i;
     write_expr buf expr ~end_op_code:None;
     write_string buf init
-  | Data_active (None, _) -> assert false
 
 let encode_section buf id encode_func data =
   let section_buf = Buffer.create 16 in

src/ast/binary_to_text.ml

@@ -114,9 +114,8 @@ let convert_data_mode (m : Binary.data_mode) : Text.data_mode =
   match m with
   | Data_passive -> Data_passive
   | Data_active (i, e) ->
-    let i = Option.map (fun i -> Raw i) i in
     let e = convert_expr e in
-    Data_active (i, e)
+    Data_active (Some (Raw i), e)
 
 let convert_data (e : Binary.data) : Text.data =
   let { Binary.id; init; mode } : Binary.data = e in

src/ast/binary_types.ml

@@ -21,10 +21,10 @@ let convert_heap_type tbl = function
     Ok t
   | Def_ht (Text i) -> begin
     match tbl with
-    | None -> Error `Unknown_type
+    | None -> Error (`Unknown_type (Text i))
     | Some tbl -> begin
       match Hashtbl.find_opt tbl i with
-      | None -> Error `Unknown_type
+      | None -> Error (`Unknown_type (Text i))
       | Some i -> ok @@ Def_ht (Raw i)
     end
   end

src/bin/owi.ml

@@ -314,17 +314,20 @@ let exit_code =
       | `Unbound_name _id -> 38
       | `Undeclared_function_reference -> 39
       | `Unexpected_token _token -> 40
-      | `Unknown_function _id -> 41
-      | `Unknown_global -> 42
-      | `Unknown_import _ -> 43
-      | `Unknown_label -> 44
-      | `Unknown_local _id -> 45
-      | `Unknown_memory _id -> 46
-      | `Unknown_module _id -> 47
-      | `Unknown_operator -> 48
-      | `Unknown_type -> 49
-      | `Unsupported_file_extension _ext -> 50
-      | `Failed_with_but_expected (_got, _expected) -> 51
+      | `Unknown_data _id -> 41
+      | `Unknown_elem _id -> 42
+      | `Unknown_func _id -> 43
+      | `Unknown_global _id -> 44
+      | `Unknown_import _ -> 45
+      | `Unknown_label _id -> 46
+      | `Unknown_local _id -> 47
+      | `Unknown_memory _id -> 48
+      | `Unknown_module _id -> 49
+      | `Unknown_operator -> 50
+      | `Unknown_table _id -> 51
+      | `Unknown_type _id -> 52
+      | `Unsupported_file_extension _ext -> 53
+      | `Failed_with_but_expected (_got, _expected) -> 54
     end
   end
   | Error e -> (

src/link/link.ml

@@ -271,7 +271,7 @@ let active_elem_expr ~offset ~length ~table ~elem =
   ]
 
 let active_data_expr ~offset ~length ~mem ~data =
-  if mem <> 0 then Error (`Unknown_memory mem)
+  if mem <> 0 then Error (`Unknown_memory (Raw mem))
   else
     Ok
       [ I32_const offset
@@ -293,8 +293,7 @@ let define_data env data =
       let env = Link_env.Build.add_data id data' env in
       let* init =
         match data.mode with
-        | Data_active (None, _) -> assert false
-        | Data_active (Some mem, offset) ->
+        | Data_active (mem, offset) ->
           let* offset = Eval_const.expr env offset in
           let length = Int32.of_int @@ String.length data.init in
           let* offset = get_i32 offset in

src/link/link_env.ml

@@ -122,7 +122,7 @@ module Build = struct
 
   let get_global (env : t) id =
     match IMap.find_opt id env.globals with
-    | None -> Error `Unknown_global
+    | None -> Error (`Unknown_global (Raw id))
     | Some v -> Ok v
 
   let get_const_global (env : t) id =
@@ -133,7 +133,7 @@ module Build = struct
 
   let get_func (env : t) id =
     match IMap.find_opt id env.functions with
-    | None -> Error (`Unknown_function id)
+    | None -> Error (`Unknown_func (Raw id))
     | Some v -> Ok v
 end
 

src/parser/binary_parser.ml

@@ -892,24 +892,20 @@ let read_code types input =
 let read_data_active types input =
   let* Raw index, input = read_indice input in
   let+ offset, input = read_const types input in
-  (Data_active (Some index, offset), input)
+  (Data_active (index, offset), input)
 
 let read_data_active_zero types input =
   let+ offset, input = read_const types input in
-  (Data_active (Some 0, offset), input)
+  (Data_active (0, offset), input)
 
-let read_data types memories input =
+let read_data types input =
   let* i, input = read_U32 input in
   let id = None in
   match i with
   | 0 ->
     let* mode, input = read_data_active_zero types input in
-    let* init, input = read_bytes ~msg:"read_data 0" input in
+    let+ init, input = read_bytes ~msg:"read_data 0" input in
     let init = string_of_char_list init in
-    (* TODO: this should be removed once we do proper validation of binary modules *)
-    let+ () =
-      if List.is_empty memories then Error (`Unknown_memory 0) else Ok ()
-    in
     ({ id; init; mode }, input)
   | 1 ->
     let mode = Data_passive in
@@ -1052,7 +1048,7 @@ let sections_iterate (input : Input.t) =
   (* Data *)
   let+ data_section, input =
     section_parse input ~expected_id:'\x0B' []
-      (vector_no_id (read_data type_section memory_section))
+      (vector_no_id (read_data type_section))
   in
 
   let* () =

src/text_to_binary/assigned.ml

@@ -118,15 +118,14 @@ let name kind ~get_name values =
   let+ named = list_fold_left assign_one String_map.empty values in
   { Named.values; named }
 
-let check_type_id (types : binary str_type Named.t) (check : Grouped.type_check)
-    =
-  let id, func_type = check in
+let check_type_id (types : binary str_type Named.t)
+  ((id, func_type) : Grouped.type_check) =
   let id =
     match id with Raw i -> i | Text name -> String_map.find name types.named
   in
   (* TODO more efficient version of that *)
   match Indexed.get_at id types.values with
-  | None -> Error `Unknown_type
+  | None -> Error (`Unknown_type (Raw id))
   | Some (Def_func_t func_type') ->
     let* func_type = Binary_types.convert_func_type None func_type in
     if not (equal_func_types func_type func_type') then

src/text_to_binary/grouped.ml

@@ -115,19 +115,13 @@ let declare_func_type type_f (fields : t) =
     in
     { fields with function_type = typ :: fields.function_type; type_checks }
 
-let check_limit { min; max } =
-  match max with
-  | None -> Ok ()
-  | Some max ->
-    if min > max then Error `Size_minimum_greater_than_maximum else Ok ()
-
 let of_symbolic (modul : Text.modul) : t Result.t =
   Log.debug0 "grouping     ...@\n";
   let add ((fields : t), curr) field : (t * curr) Result.t =
     match field with
     | Text.MType typ ->
       let typ = typ @ fields.typ in
-      ok @@ ({ fields with typ }, curr)
+      Ok ({ fields with typ }, curr)
     | MGlobal global -> ok @@ add_global (Local global) fields curr
     | MImport ({ desc = Import_global (a, (mut, val_type)); _ } as import) ->
       let+ val_type = Binary_types.convert_val_type None val_type in
@@ -139,10 +133,8 @@ let of_symbolic (modul : Text.modul) : t Result.t =
       let exports =
         { fields.exports with global = { name; id } :: fields.exports.global }
       in
-      ok ({ fields with exports }, curr)
+      Ok ({ fields with exports }, curr)
     | MTable table ->
-      let _, (limits, _) = table in
-      let* () = check_limit limits in
       let id, table_type = table in
       let+ table_type = Binary_types.convert_table_type None table_type in
       let table = (id, table_type) in
@@ -156,18 +148,8 @@ let of_symbolic (modul : Text.modul) : t Result.t =
       let exports =
         { fields.exports with table = { name; id } :: fields.exports.table }
       in
-      ok ({ fields with exports }, curr)
-    | MMem ((_, limits) as mem) ->
-      let* () =
-        if limits.min > 65536 then Error `Memory_size_too_large else Ok ()
-      in
-      let* () =
-        match limits.max with
-        | Some max when max > 65536 -> Error `Memory_size_too_large
-        | Some _ | None -> Ok ()
-      in
-      let* () = check_limit limits in
-      ok @@ add_mem (Local mem) fields curr
+      Ok ({ fields with exports }, curr)
+    | MMem mem -> ok @@ add_mem (Local mem) fields curr
     | MImport ({ desc = Import_mem (id, limits); _ } as import) ->
       let imported = imp import (id, limits) in
       ok @@ add_mem (Imported imported) fields curr