[interpreter] Refactor element type in passive segments (#71)

* Refactor type in passive segments

* Make tests more specific

Author: rossberg

interpreter/binary/decode.ml

@@ -5,12 +5,12 @@ type stream =
   name : string;
   bytes : string;
   pos : int ref;
-  has_data_count : bool ref;
+  need_data_count : bool ref;
 }
 
 exception EOS
 
-let stream name bs = {name; bytes = bs; pos = ref 0; has_data_count = ref false}
+let stream name bs = {name; bytes = bs; pos = ref 0; need_data_count = ref false}
 
 let len s = String.length s.bytes
 let pos s = !(s.pos)
@@ -202,18 +202,15 @@ let memop s =
   let offset = vu32 s in
   Int32.to_int align, offset
 
-let check_data_count s =
-  require !(s.has_data_count) s (pos s - 1) "data count section required"
-
 let misc_instr s =
   let pos = pos s in
   match op s with
   | 0x08 ->
-    check_data_count s;
     let x = at var s in
     zero_flag s;
+    s.need_data_count := true;
     memory_init x
-  | 0x09 -> check_data_count s; data_drop (at var s)
+  | 0x09 -> s.need_data_count := true; data_drop (at var s)
   | 0x0a -> zero_flag s; zero_flag s; memory_copy
   | 0x0b -> zero_flag s; memory_fill
   | 0x0c ->
@@ -625,16 +622,17 @@ let segment active passive s =
     let init = active s in
     Active {index; offset; init}
   | 1l ->
-    let init = passive s in
-    Passive init
+    let etype, data = passive s in
+    Passive {etype; data}
   | 2l ->
     let index = at var s in
     let offset = const s in
     let init = active s in
     Active {index; offset; init}
   | _ -> error s (pos s - 1) "invalid segment kind"
 
-let active_elem s = Func (at var s)
+let active_elem s =
+  Func (at var s)
 
 let passive_elem s =
   match u8 s with
@@ -646,7 +644,7 @@ let passive_elem s =
   | _ -> error s (pos s - 1) "invalid elem"
 
 let active_elem_segment s =
-  FuncRefType, vec (at active_elem) s
+  vec (at active_elem) s
 
 let passive_elem_segment s =
   let etype = elem_type s in
@@ -663,19 +661,19 @@ let elem_section s =
 (* Data section *)
 
 let memory_segment s =
-  segment string string s
+  segment string (fun s -> (), string s) s
 
 let data_section s =
   section `DataSection (vec (at memory_segment)) [] s
 
 
 (* DataCount section *)
 
+let data_count s =
+  Some (vu32 s)
+
 let data_count_section s =
-  let contents s =
-    s.has_data_count := true;
-    opt vu32 true s
-  in section `DataCountSection contents None s
+  section `DataCountSection data_count None s
 
 
 (* Custom section *)
@@ -722,18 +720,19 @@ let module_ s =
   iterate custom_section s;
   let func_bodies = code_section s in
   iterate custom_section s;
-  let data = data_section s in
+  let datas = data_section s in
   iterate custom_section s;
   require (pos s = len s) s (len s) "junk after last section";
   require (List.length func_types = List.length func_bodies)
     s (len s) "function and code section have inconsistent lengths";
-  require
-    (data_count = None || data_count = Some (Int32.of_int (List.length data)))
+  require (data_count = None || data_count = Some (Lib.List32.length datas))
     s (len s) "data count and data section have inconsistent lengths";
+  require (not !(s.need_data_count) || data_count <> None)
+    s (len s) "data count section required";
   let funcs =
     List.map2 Source.(fun t f -> {f.it with ftype = t} @@ f.at)
       func_types func_bodies
-  in {types; tables; memories; globals; funcs; imports; exports; elems; data; start}
+  in {types; tables; memories; globals; funcs; imports; exports; elems; datas; start}
 
 
 let decode name bs = at module_ (stream name bs)

interpreter/binary/encode.ml

@@ -485,10 +485,9 @@ let encode m =
         else begin
           u8 0x02; var index
         end;
-        const offset;
-        active init
-      | Passive init ->
-        u8 0x01; passive init
+        const offset; active init
+      | Passive {etype; data} ->
+        u8 0x01; passive etype data
 
     let active_elem el =
       match el.it with
@@ -501,24 +500,23 @@ let encode m =
       | Func x -> u8 0xd2; var x; end_ ()
 
     let table_segment seg =
-      let active (_,init) = vec active_elem init in
-      let passive (etype,init) = elem_type etype; vec passive_elem init in
+      let active init = vec active_elem init in
+      let passive etype data = elem_type etype; vec passive_elem data in
       segment active passive seg
 
     let elem_section elems =
       section 9 (vec table_segment) elems (elems <> [])
 
     (* Data section *)
     let memory_segment seg =
-      segment string string seg
+      segment string (fun _ s -> string s) seg
 
-    let data_section data =
-      section 11 (vec memory_segment) data (data <> [])
+    let data_section datas =
+      section 11 (vec memory_segment) datas (datas <> [])
 
-    (* DataCount section *)
-
-    let data_count_section data =
-      section 12 len (List.length data) (data <> [])
+    (* Data count section *)
+    let data_count_section datas =
+      section 12 len (List.length datas) true
 
     (* Module *)
 
@@ -534,8 +532,8 @@ let encode m =
       export_section m.it.exports;
       start_section m.it.start;
       elem_section m.it.elems;
-      data_count_section m.it.data;
+      data_count_section m.it.datas;
       code_section m.it.funcs;
-      data_section m.it.data
+      data_section m.it.datas
   end
   in E.module_ m; to_string s

interpreter/exec/eval.ml

@@ -82,11 +82,11 @@ let func (inst : module_inst) x = lookup "function" inst.funcs x
 let table (inst : module_inst) x = lookup "table" inst.tables x
 let memory (inst : module_inst) x = lookup "memory" inst.memories x
 let global (inst : module_inst) x = lookup "global" inst.globals x
-let elems (inst : module_inst) x = lookup "elems" inst.elems x
-let data (inst : module_inst) x = lookup "data" inst.data x
+let elem (inst : module_inst) x = lookup "element segment" inst.elems x
+let data (inst : module_inst) x = lookup "data segment" inst.datas x
 let local (frame : frame) x = lookup "local" frame.locals x
 
-let elem inst x i at =
+let any_elem inst x i at =
   match Table.load (table inst x) i with
   | Table.Uninitialized ->
     Trap.error at ("uninitialized element " ^ Int32.to_string i)
@@ -95,7 +95,7 @@ let elem inst x i at =
     Trap.error at ("undefined element " ^ Int32.to_string i)
 
 let func_elem inst x i at =
-  match elem inst x i at with
+  match any_elem inst x i at with
   | FuncElem f -> f
   | _ -> Crash.error at ("type mismatch for element " ^ Int32.to_string i)
 
@@ -263,13 +263,8 @@ let rec step (c : config) : config =
           let src = I64_convert.extend_i32_u s in
           (try Memory.init mem bs dst src n; vs', []
           with exn -> vs', [Trapping (memory_error e.at exn) @@ e.at])
-        | None -> vs', [Trapping "data segment dropped" @@ e.at])
-
-      | DataDrop x, vs ->
-        let seg = data frame.inst x in
-        (match !seg with
-        | Some _ -> seg := None; vs, []
-        | None -> vs, [Trapping "data segment dropped" @@ e.at])
+        | None -> vs', [Trapping "data segment dropped" @@ e.at]
+        )
 
       | MemoryCopy, I32 n :: I32 s :: I32 d :: vs' ->
         let mem = memory frame.inst (0l @@ e.at) in
@@ -286,23 +281,32 @@ let rec step (c : config) : config =
 
       | TableInit x, I32 n :: I32 s :: I32 d :: vs' ->
         let tab = table frame.inst (0l @@ e.at) in
-        (match !(elems frame.inst x) with
+        (match !(elem frame.inst x) with
         | Some es ->
           (try Table.init tab es d s n; vs', []
           with exn -> vs', [Trapping (table_error e.at exn) @@ e.at])
-        | None -> vs', [Trapping "elements segment dropped" @@ e.at])
-
-      | ElemDrop x, vs ->
-        let seg = elems frame.inst x in
-        (match !seg with
-        | Some _ -> seg := None; vs, []
-        | None -> vs, [Trapping "elements segment dropped" @@ e.at])
+        | None -> vs', [Trapping "element segment dropped" @@ e.at]
+        )
 
       | TableCopy, I32 n :: I32 s :: I32 d :: vs' ->
         let tab = table frame.inst (0l @@ e.at) in
         (try Table.copy tab d s n; vs', []
         with exn -> vs', [Trapping (table_error e.at exn) @@ e.at])
 
+      | DataDrop x, vs ->
+        let seg = data frame.inst x in
+        (match !seg with
+        | Some _ -> seg := None; vs, []
+        | None -> vs, [Trapping "data segment dropped" @@ e.at]
+        )
+
+      | ElemDrop x, vs ->
+        let seg = elem frame.inst x in
+        (match !seg with
+        | Some _ -> seg := None; vs, []
+        | None -> vs, [Trapping "element segment dropped" @@ e.at]
+        )
+
       | _ ->
         let s1 = string_of_values (List.rev vs) in
         let s2 = string_of_value_types (List.map type_of (List.rev vs)) in
@@ -435,22 +439,22 @@ let create_export (inst : module_inst) (ex : export) : export_inst =
     | GlobalExport x -> ExternGlobal (global inst x)
   in name, ext
 
-let elems_list inst init =
+let elem_list inst init =
   let to_elem el =
     match el.it with
     | Null -> Table.Uninitialized
     | Func x -> FuncElem (func inst x)
   in List.map to_elem init
 
-let create_elems (inst : module_inst) (seg : table_segment) : elems_inst =
+let create_elem (inst : module_inst) (seg : table_segment) : elem_inst =
   match seg.it with
   | Active _ -> ref None
-  | Passive (_,init) -> ref (Some (elems_list inst init))
+  | Passive {data; _} -> ref (Some (elem_list inst data))
 
 let create_data (inst : module_inst) (seg : memory_segment) : data_inst =
   match seg.it with
   | Active _ -> ref None
-  | Passive init -> ref (Some init)
+  | Passive {data; _} -> ref (Some data)
 
 
 let init_func (inst : module_inst) (func : func_inst) =
@@ -460,14 +464,14 @@ let init_func (inst : module_inst) (func : func_inst) =
 
 let init_table (inst : module_inst) (seg : table_segment) =
   match seg.it with
-  | Active {index; offset = const; init = (_,init)} ->
+  | Active {index; offset = const; init} ->
     let tab = table inst index in
     let offset = i32 (eval_const inst const) const.at in
-    let elems = elems_list inst init in
+    let elems = elem_list inst init in
     let len = Int32.of_int (List.length elems) in
     (try Table.init tab elems offset 0l len
     with Table.Bounds -> Link.error seg.at "elements segment does not fit table")
-  | Passive init -> ()
+  | Passive _ -> ()
 
 let init_memory (inst : module_inst) (seg : memory_segment) =
   match seg.it with
@@ -478,7 +482,7 @@ let init_memory (inst : module_inst) (seg : memory_segment) =
     let len = Int32.of_int (String.length init) in
     (try Memory.init mem init offset 0L len
     with Memory.Bounds -> Link.error seg.at "data segment does not fit memory")
-  | Passive init -> ()
+  | Passive _ -> ()
 
 
 let add_import (m : module_) (ext : extern) (im : import) (inst : module_inst)
@@ -494,7 +498,7 @@ let add_import (m : module_) (ext : extern) (im : import) (inst : module_inst)
 let init (m : module_) (exts : extern list) : module_inst =
   let
     { imports; tables; memories; globals; funcs; types;
-      exports; elems; data; start
+      exports; elems; datas; start
     } = m.it
   in
   if List.length exts <> List.length imports then
@@ -509,18 +513,18 @@ let init (m : module_) (exts : extern list) : module_inst =
       funcs = inst0.funcs @ fs;
       tables = inst0.tables @ List.map (create_table inst0) tables;
       memories = inst0.memories @ List.map (create_memory inst0) memories;
-      globals = inst0.globals @ List.map (create_global inst0) globals
+      globals = inst0.globals @ List.map (create_global inst0) globals;
     }
   in
   let inst =
     { inst1 with
       exports = List.map (create_export inst1) exports;
-      elems = List.map (create_elems inst1) elems;
-      data = List.map (create_data inst1) data
+      elems = List.map (create_elem inst1) elems;
+      datas = List.map (create_data inst1) datas;
     }
   in
   List.iter (init_func inst) fs;
   List.iter (init_table inst) elems;
-  List.iter (init_memory inst) data;
+  List.iter (init_memory inst) datas;
   Lib.Option.app (fun x -> ignore (invoke (func inst x) [])) start;
   inst

interpreter/runtime/instance.ml

@@ -8,16 +8,16 @@ type module_inst =
   memories : memory_inst list;
   globals : global_inst list;
   exports : export_inst list;
-  elems : elems_inst list;
-  data : data_inst list;
+  elems : elem_inst list;
+  datas : data_inst list;
 }
 
 and func_inst = module_inst ref Func.t
 and table_inst = Table.t
 and memory_inst = Memory.t
 and global_inst = Global.t
 and export_inst = Ast.name * extern
-and elems_inst = Table.elem list option ref
+and elem_inst = Table.elem list option ref
 and data_inst = string option ref
 
 and extern =
@@ -33,7 +33,7 @@ type Table.elem += FuncElem of func_inst
 
 let empty_module_inst =
   { types = []; funcs = []; tables = []; memories = []; globals = [];
-    exports = []; elems = []; data = [] }
+    exports = []; elems = []; datas = [] }
 
 let extern_type_of = function
   | ExternFunc func -> ExternFuncType (Func.type_of func)