[interpreter] Flatten segment AST (WebAssembly#58)

interpreter/binary/decode.ml

@@ -611,20 +611,17 @@ let segment dat s =
   | 0l ->
     let index = Source.(0l @@ Source.no_region) in
     let offset = const s in
-    let sdesc = Active {index; offset} in
     let init = dat s in
-    {sdesc; init}
+    Active {index; offset; init}
   | 1l ->
-    let sdesc = Passive in
     let init = dat s in
-    {sdesc; init}
+    Passive init
   | 2l ->
     let index = at var s in
     let offset = const s in
-    let sdesc = Active {index; offset} in
     let init = dat s in
-    {sdesc; init}
-  | _ -> error s (pos s - 1) "invalid segment flags"
+    Active {index; offset; init}
+  | _ -> error s (pos s - 1) "invalid segment kind"
 
 let table_segment s =
   segment (vec (at var)) s

interpreter/binary/encode.ml

@@ -478,18 +478,17 @@ let encode m =
 
     (* Element section *)
     let segment dat seg =
-      let {sdesc; init} = seg.it in
-      match sdesc with
-      | Active {index; offset} ->
+      match seg.it with
+      | Active {index; offset; init} ->
         if index.it = 0l then
           u8 0x00
         else begin
           u8 0x02; var index
         end;
         const offset;
         dat init
-      | Passive ->
-          u8 0x01; dat init
+      | Passive init ->
+        u8 0x01; dat init
 
     let table_segment seg =
       segment (vec var) seg

interpreter/exec/eval.ml

@@ -388,9 +388,8 @@ let init_func (inst : module_inst) (func : func_inst) =
   | _ -> assert false
 
 let init_table (inst : module_inst) (seg : table_segment) =
-  let {sdesc; init} = seg.it in
-  match sdesc with
-  | Active {index; offset = const} ->
+  match seg.it with
+  | Active {index; offset = const; init} ->
     let tab = table inst index in
     let offset = i32 (eval_const inst const) const.at in
     let end_ = Int32.(add offset (of_int (List.length init))) in
@@ -399,12 +398,11 @@ let init_table (inst : module_inst) (seg : table_segment) =
       Link.error seg.at "elements segment does not fit table";
     fun () ->
       Table.blit tab offset (List.map (fun x -> FuncElem (func inst x)) init)
-  | Passive -> fun () -> ()
+  | Passive init -> fun () -> ()
 
 let init_memory (inst : module_inst) (seg : memory_segment) =
-  let {sdesc; init} = seg.it in
-  match sdesc with
-  | Active {index; offset = const} ->
+  match seg.it with
+  | Active {index; offset = const; init} ->
     let mem = memory inst index in
     let offset' = i32 (eval_const inst const) const.at in
     let offset = I64_convert.extend_u_i32 offset' in
@@ -413,7 +411,7 @@ let init_memory (inst : module_inst) (seg : memory_segment) =
     if I64.lt_u bound end_ || I64.lt_u end_ offset then
       Link.error seg.at "data segment does not fit memory";
     fun () -> Memory.store_bytes mem offset init
-  | Passive -> fun () -> ()
+  | Passive init -> fun () -> ()
 
 
 let add_import (m : module_) (ext : extern) (im : import) (inst : module_inst)

interpreter/syntax/ast.ml

@@ -110,10 +110,6 @@ and instr' =
 
 type const = instr list Source.phrase
 
-type segment_desc =
-  | Active of {index : var; offset : const}
-  | Passive
-
 type global = global' Source.phrase
 and global' =
 {
@@ -146,10 +142,8 @@ and memory' =
 
 type 'data segment = 'data segment' Source.phrase
 and 'data segment' =
-{
-  sdesc : segment_desc;
-  init : 'data;
-}
+  | Active of {index : var; offset : const; init : 'data}
+  | Passive of 'data
 
 type table_segment = var list segment
 type memory_segment = string segment

interpreter/syntax/operators.ml

@@ -201,11 +201,10 @@ let f64_reinterpret_i64 = Convert (F64 F64Op.ReinterpretInt)
 
 let memory_size = MemorySize
 let memory_grow = MemoryGrow
-
 let memory_init x = MemoryInit x
-let data_drop x = DataDrop x
 let memory_copy = MemoryCopy
 let memory_fill = MemoryFill
 let table_init x = TableInit x
-let elem_drop x = ElemDrop x
 let table_copy = TableCopy
+let data_drop x = DataDrop x
+let elem_drop x = ElemDrop x

interpreter/syntax/types.ml

@@ -10,12 +10,12 @@ type mutability = Immutable | Mutable
 type table_type = TableType of Int32.t limits * elem_type
 type memory_type = MemoryType of Int32.t limits
 type global_type = GlobalType of value_type * mutability
+type segment_type = SegmentType
 type extern_type =
   | ExternFuncType of func_type
   | ExternTableType of table_type
   | ExternMemoryType of memory_type
   | ExternGlobalType of global_type
-type segment_type = Seg
 
 
 (* Attributes *)

interpreter/text/arrange.ml

@@ -297,11 +297,10 @@ let memory off i mem =
   Node ("memory $" ^ nat (off + i) ^ " " ^ limits nat32 lim, [])
 
 let segment head dat seg =
-  let {sdesc; init} = seg.it in
-  match sdesc with
-  | Active {index; offset} ->
+  match seg.it with
+  | Active {index; offset; init} ->
     Node (head, atom var index :: Node ("offset", const offset) :: dat init)
-  | Passive -> Node (head, dat init)
+  | Passive init -> Node (head, dat init)
 
 let elems seg =
   segment "elem" (list (atom var)) seg

interpreter/text/parser.mly

@@ -87,8 +87,8 @@ let local (c : context) x = lookup "local" c.locals x
 let global (c : context) x = lookup "global" c.globals x
 let table (c : context) x = lookup "table" c.tables x
 let memory (c : context) x = lookup "memory" c.memories x
-let data (c : context) x = lookup "data segment" c.data x
 let elem (c : context) x = lookup "elem segment" c.elems x
+let data (c : context) x = lookup "data segment" c.data x
 let label (c : context) x =
   try VarMap.find x.it c.labels
   with Not_found -> error x.at ("unknown label " ^ x.it)
@@ -116,8 +116,8 @@ let bind_local (c : context) x = bind "local" c.locals x
 let bind_global (c : context) x = bind "global" c.globals x
 let bind_table (c : context) x = bind "table" c.tables x
 let bind_memory (c : context) x = bind "memory" c.memories x
-let bind_data (c : context) x = bind "data segment" c.data x
 let bind_elem (c : context) x = bind "elem segment" c.elems x
+let bind_data (c : context) x = bind "data segment" c.data x
 let bind_label (c : context) x =
   {c with labels = VarMap.add x.it 0l (VarMap.map (Int32.add 1l) c.labels)}
 
@@ -137,8 +137,8 @@ let anon_locals (c : context) ts =
 let anon_global (c : context) = anon "global" c.globals 1l
 let anon_table (c : context) = anon "table" c.tables 1l
 let anon_memory (c : context) = anon "memory" c.memories 1l
-let anon_data (c : context) = anon "data segment" c.data 1l
 let anon_elem (c : context) = anon "elem segment" c.elems 1l
+let anon_data (c : context) = anon "data segment" c.data 1l
 let anon_label (c : context) =
   {c with labels = VarMap.map (Int32.add 1l) c.labels}
 
@@ -571,23 +571,23 @@ offset :
 elem :
   | LPAR ELEM bind_var_opt PASSIVE var_list RPAR
     { let at = at () in
-      fun c -> ignore ($3 c anon_elem bind_elem @@ at);
-      fun () -> {sdesc = Passive; init = $5 c func} @@ at }
+      fun c -> ignore ($3 c anon_elem bind_elem);
+      fun () -> Passive ($5 c func) @@ at }
   | LPAR ELEM bind_var var offset var_list RPAR
     { let at = at () in
-      fun c -> ignore ((bind_elem c $3) @@ at);
-      fun () -> {sdesc = Active {index = $4 c table; offset = $5 c};
-                 init = $6 c func} @@ at }
+      fun c -> ignore (bind_elem c $3);
+      fun () ->
+      Active {index = $4 c table; offset = $5 c; init = $6 c func} @@ at }
   | LPAR ELEM var offset var_list RPAR
     { let at = at () in
-      fun c -> ignore (anon_elem c @@ at);
-      fun () -> {sdesc = Active {index = $3 c table; offset = $4 c};
-                 init = $5 c func} @@ at }
-  | LPAR ELEM offset var_list RPAR /* Sugar */
+      fun c -> ignore (anon_elem c);
+      fun () ->
+      Active {index = $3 c table; offset = $4 c; init = $5 c func} @@ at }
+  | LPAR ELEM offset var_list RPAR  /* Sugar */
     { let at = at () in
-      fun c -> ignore (anon_elem c @@ at);
-      fun () -> {sdesc = Active {index = 0l @@ at; offset = $3 c};
-                 init = $4 c func} @@ at }
+      fun c -> ignore (anon_elem c);
+      fun () ->
+      Active {index = 0l @@ at; offset = $3 c; init = $4 c func} @@ at }
 
 table :
   | LPAR TABLE bind_var_opt table_fields RPAR
@@ -608,33 +608,29 @@ table_fields :
       tabs, elems, ims, $1 (TableExport x) c :: exs }
   | elem_type LPAR ELEM var_list RPAR  /* Sugar */
     { fun c x at ->
+      let offset = [i32_const (0l @@ at) @@ at] @@ at in
       let init = $4 c func in let size = Int32.of_int (List.length init) in
-      let sdesc =
-        Active {index = x; offset = [i32_const (0l @@ at) @@ at] @@ at} in
       [{ttype = TableType ({min = size; max = Some size}, $1)} @@ at],
-      [{sdesc; init} @@ at],
+      [Active {index = x; offset; init} @@ at],
       [], [] }
 
 data :
   | LPAR DATA bind_var_opt PASSIVE string_list RPAR
     { let at = at () in
-      fun c -> ignore ($3 c anon_data bind_data @@ at);
-      fun () -> {sdesc = Passive; init = $5} @@ at }
+      fun c -> ignore ($3 c anon_data bind_data);
+      fun () -> Passive $5 @@ at }
  | LPAR DATA bind_var var offset string_list RPAR
    { let at = at () in
-     fun c -> ignore ((bind_data c $3) @@ at);
-     fun () -> {sdesc = Active {index = $4 c memory;
-                offset = $5 c}; init = $6} @@ at }
+     fun c -> ignore (bind_data c $3);
+     fun () -> Active {index = $4 c memory; offset = $5 c; init = $6} @@ at }
  | LPAR DATA var offset string_list RPAR
    { let at = at () in
-     fun c -> ignore (anon_data c @@ at);
-     fun () -> {sdesc = Active {index = $3 c memory;
-                offset = $4 c}; init = $5} @@ at }
- | LPAR DATA offset string_list RPAR /* Sugar */
+     fun c -> ignore (anon_data c);
+     fun () -> Active {index = $3 c memory; offset = $4 c; init = $5} @@ at }
+ | LPAR DATA offset string_list RPAR  /* Sugar */
    { let at = at () in
-     fun c -> ignore (anon_data c @@ at);
-     fun () -> {sdesc = Active {index = 0l @@ at;
-                offset = $3 c}; init = $4} @@ at }
+     fun c -> ignore (anon_data c);
+     fun () -> Active {index = 0l @@ at; offset = $3 c; init = $4} @@ at }
 
 memory :
   | LPAR MEMORY bind_var_opt memory_fields RPAR
@@ -655,11 +651,10 @@ memory_fields :
       mems, data, ims, $1 (MemoryExport x) c :: exs }
   | LPAR DATA string_list RPAR  /* Sugar */
     { fun c x at ->
+      let offset = [i32_const (0l @@ at) @@ at] @@ at in
       let size = Int32.(div (add (of_int (String.length $3)) 65535l) 65536l) in
-      let sdesc =
-        Active {index = x; offset = [i32_const (0l @@ at) @@ at] @@ at} in
       [{mtype = MemoryType {min = size; max = Some size}} @@ at],
-      [{sdesc; init = $3} @@ at],
+      [Active {index = x; offset; init = $3} @@ at],
       [], [] }
 
 global :

interpreter/valid/valid.ml

@@ -428,21 +428,20 @@ let check_memory (c : context) (mem : memory) =
   check_memory_type mtype mem.at
 
 let check_elem (c : context) (seg : table_segment) =
-  let {sdesc; init} = seg.it in
-  ignore (List.map (func c) init);
-  match sdesc with
-  | Active {index; offset} ->
+  match seg.it with
+  | Active {index; offset; init} ->
+    ignore (table c index);
     check_const c offset I32Type;
-    ignore (table c index)
-  | Passive -> ()
+    ignore (List.map (func c) init)
+  | Passive init ->
+    ignore (List.map (func c) init)
 
 let check_data (c : context) (seg : memory_segment) =
-  let {sdesc; init} = seg.it in
-  match sdesc with
-  | Active {index; offset} ->
-    check_const c offset I32Type;
-    ignore (memory c index)
-  | Passive -> ()
+  match seg.it with
+  | Active {index; offset; init} ->
+    ignore (memory c index);
+    check_const c offset I32Type
+  | Passive init -> ()
 
 let check_global (c : context) (glob : global) =
   let {gtype; value} = glob.it in
@@ -506,8 +505,8 @@ let check_module (m : module_) =
       funcs = c0.funcs @ List.map (fun f -> type_ c0 f.it.ftype) funcs;
       tables = c0.tables @ List.map (fun tab -> tab.it.ttype) tables;
       memories = c0.memories @ List.map (fun mem -> mem.it.mtype) memories;
-      elems = List.map (fun elem -> Seg) elems;
-      data = List.map (fun data -> Seg) data;
+      elems = List.map (fun elem -> SegmentType) elems;
+      data = List.map (fun data -> SegmentType) data;
     }
   in
   let c =