From 1e03671b9b4c87d6782daec5d52bf5c8f1000b65 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 7 Feb 2019 17:29:07 +0100 Subject: [PATCH] [interpreter] Flatten segment AST (#58) --- interpreter/binary/decode.ml | 11 +++--- interpreter/binary/encode.ml | 9 +++-- interpreter/exec/eval.ml | 14 ++++---- interpreter/syntax/ast.ml | 10 ++---- interpreter/syntax/operators.ml | 5 ++- interpreter/syntax/types.ml | 2 +- interpreter/text/arrange.ml | 7 ++-- interpreter/text/parser.mly | 61 +++++++++++++++------------------ interpreter/valid/valid.ml | 27 +++++++-------- 9 files changed, 63 insertions(+), 83 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 631f7d14be..6e8a2fd3bb 100644 --- a/interpreter/binary/decode.ml +++ b/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 diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 0dd29afe4c..a24b48e345 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -478,9 +478,8 @@ 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 @@ -488,8 +487,8 @@ let encode m = end; const offset; dat init - | Passive -> - u8 0x01; dat init + | Passive init -> + u8 0x01; dat init let table_segment seg = segment (vec var) seg diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index a4646983aa..4c93ea734c 100644 --- a/interpreter/exec/eval.ml +++ b/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) diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 501e5e36aa..cad9b34638 100644 --- a/interpreter/syntax/ast.ml +++ b/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 diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index 590e80cb24..8cec587ef4 100644 --- a/interpreter/syntax/operators.ml +++ b/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 diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index 7bea4aa699..6e5f1d6ac9 100644 --- a/interpreter/syntax/types.ml +++ b/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 *) diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index dd19840d13..5d508acbc2 100644 --- a/interpreter/text/arrange.ml +++ b/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 diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 2041a811ad..342513e4d5 100644 --- a/interpreter/text/parser.mly +++ b/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 : diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 0f3a00b9b9..b6f30d08de 100644 --- a/interpreter/valid/valid.ml +++ b/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 =