From 40da5d5ccda31320f1ec575eba3208de1073a221 Mon Sep 17 00:00:00 2001 From: rossberg-chromium Date: Fri, 26 Aug 2016 16:07:15 +0200 Subject: [PATCH 01/16] WIP --- ml-proto/host/arrange.ml | 78 ++++++--- ml-proto/host/encode.ml | 61 ++++--- ml-proto/host/flags.ml | 1 + ml-proto/host/import.ml | 19 +- ml-proto/host/import.mli | 5 +- ml-proto/host/import/env.ml | 12 +- ml-proto/host/import/spectest.ml | 9 +- ml-proto/host/lexer.mll | 1 - ml-proto/host/main.ml | 1 + ml-proto/host/parser.mly | 226 ++++++++++++++---------- ml-proto/host/print.ml | 49 ++++-- ml-proto/host/script.ml | 26 +-- ml-proto/spec/ast.ml | 6 +- ml-proto/spec/check.ml | 110 ++++++------ ml-proto/spec/decode.ml | 70 +++++--- ml-proto/spec/desugar.ml | 8 +- ml-proto/spec/eval.ml | 227 ++++++++++++------------ ml-proto/spec/eval.mli | 7 +- ml-proto/spec/kernel.ml | 23 ++- ml-proto/spec/types.ml | 6 + ml-proto/spec/values.ml | 1 - ml-proto/test/float_memory.wast | 114 ++++-------- ml-proto/test/float_misc.wast | 88 ++++------ ml-proto/test/forward.wast | 7 +- ml-proto/test/func_ptrs.wast | 15 +- ml-proto/test/i32.wast | 88 ++++------ ml-proto/test/i64.wast | 88 ++++------ ml-proto/test/imports.wast | 24 +-- ml-proto/test/int_exprs.wast | 162 ++++++----------- ml-proto/test/int_literals.wast | 68 +++----- ml-proto/test/labels.wast | 60 ++----- ml-proto/test/left-to-right.wast | 251 +++++++++++---------------- ml-proto/test/memory.wast | 58 ++----- ml-proto/test/memory_redundancy.wast | 12 +- ml-proto/test/memory_trap.wast | 9 +- ml-proto/test/names.wast | 67 +++---- ml-proto/test/nan-propagation.wast | 101 ++++------- ml-proto/test/resizing.wast | 21 +-- ml-proto/test/return.wast | 15 -- ml-proto/test/select.wast | 19 +- ml-proto/test/start.wast | 19 +- ml-proto/test/switch.wast | 13 +- ml-proto/test/traps.wast | 61 +++---- ml-proto/test/typecheck.wast | 1 - ml-proto/test/unreachable.wast | 15 -- 45 files changed, 1013 insertions(+), 1309 deletions(-) diff --git a/ml-proto/host/arrange.ml b/ml-proto/host/arrange.ml index 1bd9c00ce0..de696f0dbb 100644 --- a/ml-proto/host/arrange.ml +++ b/ml-proto/host/arrange.ml @@ -218,7 +218,6 @@ let rec expr e = ) | Select (e1, e2, e3) -> "select", [expr e1; expr e2; expr e3] | Call (x, es) -> "call " ^ var x, list expr es - | CallImport (x, es) -> "call_import " ^ var x, list expr es | CallIndirect (x, e, es) -> "call_indirect " ^ var x, list expr (e::es) | GetLocal x -> "get_local " ^ var x, [] | SetLocal (x, e) -> "set_local " ^ var x, [expr e] @@ -247,9 +246,9 @@ and block e = (* Functions *) -let func i f = +let func off i f = let {ftype; locals; body} = f.it in - Node ("func $" ^ string_of_int i, + Node ("func $" ^ string_of_int (off + i), [Node ("type " ^ var ftype, [])] @ decls "local" locals @ block body @@ -266,17 +265,19 @@ let limits int lim = let {min; max} = lim.it in String.concat " " (int min :: opt int max) -let table tab = +let table off i tab = + (* TODO: print index *) let {tlimits = lim; etype} = tab.it in Node ("table " ^ limits int32 lim, [atom elem_type etype]) -let memory mem = +let memory off i mem = + (* TODO: print index *) let {mlimits = lim} = mem.it in Node ("memory " ^ limits int32 lim, []) let segment head dat seg = - let {offset; init} = seg.it in - Node (head, expr offset :: dat init) + let {index; offset; init} = seg.it in + Node (head, atom var index :: expr offset :: dat init) let elems seg = segment "elem" (list (atom var)) seg @@ -290,33 +291,68 @@ let data seg = let typedef i t = Node ("type $" ^ string_of_int i, [struct_type t]) +let import_kind k = + match k.it with + | FuncImport x -> + Node ("func", [Node ("type", [atom var x])]) + | TableImport (lim, t) -> + Node ("table " ^ limits int32 lim, [atom elem_type t]) + | MemoryImport lim -> + Node ("memory " ^ limits int32 lim, []) + | GlobalImport t -> + Node ("global", [atom value_type t]) + let import i im = - let {itype; module_name; func_name} = im.it in - let ty = Node ("type " ^ var itype, []) in + let {module_name; item_name; ikind} = im.it in Node ("import $" ^ string_of_int i, - [atom string module_name; atom string func_name; ty] + [atom string module_name; atom string item_name; import_kind ikind] ) -let global g = - let {gtype; value} = g.it in - Node ("global", [atom value_type gtype; expr value]) +let export_kind k = + match k.it with + | FuncExport -> "func" + | TableExport -> "table" + | MemoryExport -> "memory" + | GlobalExport -> "global" let export ex = - let {name; kind} = ex.it in - let desc = match kind with `Func x -> var x | `Memory -> "memory" in - Node ("export", [atom string name; Atom desc]) + let {name; ekind; item} = ex.it in + Node ("export", [atom string name; Node (export_kind ekind, [atom var item])]) + +let global off i g = + (* TODO: print index *) + let {gtype; value} = g.it in + Node ("global $" ^ string_of_int (off + i), + [atom value_type gtype; expr value] + ) (* Modules *) +let is_func_import im = + match im.it.ikind.it with FuncImport _ -> true | _ -> false +let is_table_import im = + match im.it.ikind.it with TableImport _ -> true | _ -> false +let is_memory_import im = + match im.it.ikind.it with MemoryImport _ -> true | _ -> false +let is_global_import im = + match im.it.ikind.it with GlobalImport _ -> true | _ -> false + let module_ m = + let func_imports = List.filter is_func_import m.it.imports in + let table_imports = List.filter is_table_import m.it.imports in + let memory_imports = List.filter is_memory_import m.it.imports in + let global_imports = List.filter is_global_import m.it.imports in Node ("module", listi typedef m.it.types @ - listi import m.it.imports @ - opt table m.it.table @ - opt memory m.it.memory @ - list global m.it.globals @ - listi func m.it.funcs @ + listi import table_imports @ + listi import memory_imports @ + listi import global_imports @ + listi import func_imports @ + listi (table (List.length table_imports)) m.it.tables @ + listi (memory (List.length memory_imports)) m.it.memories @ + listi (global (List.length global_imports)) m.it.globals @ + listi (func (List.length func_imports)) m.it.funcs @ list export m.it.exports @ opt start m.it.start @ list elems m.it.elems @ diff --git a/ml-proto/host/encode.ml b/ml-proto/host/encode.ml index a2c4213310..59cd8bd941 100644 --- a/ml-proto/host/encode.ml +++ b/ml-proto/host/encode.ml @@ -63,14 +63,15 @@ let encode m = let vec f xs = vu (List.length xs); list f xs let vec1 f xo = bool (xo <> None); opt f xo - let gap () = let p = pos s in u32 0l; p + let gap () = let p = pos s in u32 0l; u8 0; p let patch_gap p n = assert (n <= 0x0fff_ffff); (* Strings cannot excess 2G anyway *) let lsb i = Char.chr (i land 0xff) in patch s p (lsb (n lor 0x80)); patch s (p + 1) (lsb ((n lsr 7) lor 0x80)); patch s (p + 2) (lsb ((n lsr 14) lor 0x80)); - patch s (p + 3) (lsb (n lsr 21)) + patch s (p + 3) (lsb ((n lsr 21) lor 0x80)); + patch s (p + 4) (lsb (n lsr 28)) (* Types *) @@ -135,7 +136,6 @@ let encode m = | Ast.Call (x, es) -> nary es 0x16; var x | Ast.Call_indirect (x, e, es) -> expr e; nary es 0x17; var x - | Ast.Call_import (x, es) -> nary es 0x18; var x | I32_load8_s (o, a, e) -> unary e 0x20; memop o a | I32_load8_u (o, a, e) -> unary e 0x21; memop o a @@ -311,14 +311,25 @@ let encode m = patch_gap g (pos s - p) end + let limits vu lim = + let {min; max} = lim.it in + bool (max <> None); vu min; opt vu max + (* Type section *) let type_section ts = section "type" (vec func_type) ts (ts <> []) (* Import section *) + let import_kind k = + match k.it with + | FuncImport x -> u8 0x00; var x + | TableImport (lim, t) -> u8 0x01; elem_type t; limits vu32 lim + | MemoryImport lim -> u8 0x02; limits vu32 lim + | GlobalImport t -> u8 0x03; value_type t (* TODO: mutability *) + let import imp = - let {itype; module_name; func_name} = imp.it in - var itype; string module_name; string func_name + let {module_name; item_name; ikind} = imp.it in + string module_name; string item_name; import_kind ikind let import_section imps = section "import" (vec import) imps (imps <> []) @@ -330,45 +341,43 @@ let encode m = section "function" (vec func) fs (fs <> []) (* Table section *) - let limits vu lim = - let {min; max} = lim.it in - bool (max <> None); vu min; opt vu max - let table tab = let {etype; tlimits} = tab.it in elem_type etype; limits vu32 tlimits - let table_section tabo = - section "table" (opt table) tabo (tabo <> None) + let table_section tabs = + section "table" (vec table) tabs (tabs <> []) (* Memory section *) let memory mem = let {mlimits} = mem.it in limits vu32 mlimits - let memory_section memo = - section "memory" (opt memory) memo (memo <> None) + let memory_section mems = + section "memory" (vec memory) mems (mems <> []) (* Global section *) let global g = - let {gtype = t; value = e} = g.it in - value_type t; expr e; op 0x0f + let {gtype; value} = g.it in + value_type gtype; expr value; op 0x0f let global_section gs = section "global" (vec global) gs (gs <> []) (* Export section *) + let export_kind k = + match k.it with + | FuncExport -> u8 0 + | TableExport -> u8 1 + | MemoryExport -> u8 2 + | GlobalExport -> u8 3 + let export exp = - let {Kernel.name; kind} = exp.it in - (match kind with - | `Func x -> var x - | `Memory -> () (*TODO: pending resolution*) - ); string name + let {name; ekind; item} = exp.it in + string name; export_kind ekind; var item let export_section exps = - (*TODO: pending resolution*) - let exps = List.filter (fun exp -> exp.it.kind <> `Memory) exps in section "export" (vec export) exps (exps <> []) (* Start section *) @@ -397,8 +406,8 @@ let encode m = (* Element section *) let segment dat seg = - let {offset; init} = seg.it in - const offset; dat init + let {index; offset; init} = seg.it in + var index; const offset; dat init let table_segment seg = segment (vec var) seg @@ -421,8 +430,8 @@ let encode m = type_section m.it.types; import_section m.it.imports; func_section m.it.funcs; - table_section m.it.table; - memory_section m.it.memory; + table_section m.it.tables; + memory_section m.it.memories; global_section m.it.globals; export_section m.it.exports; start_section m.it.start; diff --git a/ml-proto/host/flags.ml b/ml-proto/host/flags.ml index 913e909199..13348dab67 100644 --- a/ml-proto/host/flags.ml +++ b/ml-proto/host/flags.ml @@ -3,6 +3,7 @@ let version = "0.2" let interactive = ref false let trace = ref false +let unchecked = ref false let print_sig = ref false let dry = ref false let width = ref 80 diff --git a/ml-proto/host/import.ml b/ml-proto/host/import.ml index ebd0969816..98c738ac30 100644 --- a/ml-proto/host/import.ml +++ b/ml-proto/host/import.ml @@ -11,11 +11,18 @@ let registry = ref Registry.empty let register name lookup = registry := Registry.add name lookup !registry -let lookup m i = - let {module_name; func_name; itype} = i.it in - let ty = List.nth m.it.types itype.it in - try Registry.find module_name !registry func_name ty with Not_found -> - Unknown.error i.at - ("no function \"" ^ module_name ^ "." ^ func_name ^ "\" of requested type") +let external_type_of_import_kind m ikind = + match ikind.it with + | FuncImport x -> ExternalFuncType (List.nth m.it.types x.it) + | TableImport (_, t) -> ExternalTableType t + | MemoryImport _ -> ExternalMemoryType + | GlobalImport t -> ExternalGlobalType t + +let lookup (m : module_) (imp : import) : Instance.extern = + let {module_name; item_name; ikind} = imp.it in + let ty = external_type_of_import_kind m ikind in + try Registry.find module_name !registry item_name ty with Not_found -> + Unknown.error imp.at + ("no item \"" ^ module_name ^ "." ^ item_name ^ "\" of requested kind") let link m = List.map (lookup m) m.it.imports diff --git a/ml-proto/host/import.mli b/ml-proto/host/import.mli index a882eda6d6..3eb201212b 100644 --- a/ml-proto/host/import.mli +++ b/ml-proto/host/import.mli @@ -1,4 +1,5 @@ exception Unknown of Source.region * string -val link : Kernel.module_ -> Eval.import list (* raises Unknown *) -val register: string -> (string -> Types.func_type -> Values.func) -> unit +val link : Kernel.module_ -> Instance.extern list (* raises Unknown *) + +val register : string -> (string -> Types.external_type -> Instance.extern) -> unit diff --git a/ml-proto/host/import/env.ml b/ml-proto/host/import/env.ml index d25b510675..b1b91d19af 100644 --- a/ml-proto/host/import/env.ml +++ b/ml-proto/host/import/env.ml @@ -38,8 +38,12 @@ let exit vs = exit (int (single vs)) -let lookup name ty = - match name, ty.ins, ty.out with - | "abort", [], None -> abort - | "exit", [Int32Type], None -> exit +open Instance + +let lookup name t = + match name, t with + | "abort", ExternalFuncType ({ins = []; out = None} as ft) -> + ExternalFunc (HostFunc (ft, abort)) + | "exit", ExternalFuncType ({ins = [Int32Type]; out = None} as ft) -> + ExternalFunc (HostFunc (ft, exit)) | _ -> raise Not_found diff --git a/ml-proto/host/import/spectest.ml b/ml-proto/host/import/spectest.ml index 6b03ba8c6a..6e6a1e7604 100644 --- a/ml-proto/host/import/spectest.ml +++ b/ml-proto/host/import/spectest.ml @@ -10,7 +10,10 @@ let print vs = None -let lookup name ty = - match name, ty.ins, ty.out with - | "print", _, None -> print +open Instance + +let lookup name t = + match name, t with + | "print", ExternalFuncType ({ins = _; out = None} as ft) -> + ExternalFunc (HostFunc (ft, print)) | _ -> raise Not_found diff --git a/ml-proto/host/lexer.mll b/ml-proto/host/lexer.mll index 131a2bceb2..5ef07e6342 100644 --- a/ml-proto/host/lexer.mll +++ b/ml-proto/host/lexer.mll @@ -155,7 +155,6 @@ rule token = parse | "else" { ELSE } | "select" { SELECT } | "call" { CALL } - | "call_import" { CALL_IMPORT } | "call_indirect" { CALL_INDIRECT } | "get_local" { GET_LOCAL } diff --git a/ml-proto/host/main.ml b/ml-proto/host/main.ml index 89056ad2fa..f71199bab4 100644 --- a/ml-proto/host/main.ml +++ b/ml-proto/host/main.ml @@ -25,6 +25,7 @@ let argspec = Arg.align "-w", Arg.Int (fun n -> Flags.width := n), " configure output width (default is 80)"; "-s", Arg.Set Flags.print_sig, " show module signatures"; + "-u", Arg.Set Flags.unchecked, " unchecked, do not perform validation"; "-d", Arg.Set Flags.dry, " dry, do not run program"; "-t", Arg.Set Flags.trace, " trace execution"; "-v", Arg.Unit banner, " show version" diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index e6e0ebf1e1..8acd75877d 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -63,12 +63,12 @@ type types = {mutable tmap : int VarMap.t; mutable tlist : Types.func_type list} let empty_types () = {tmap = VarMap.empty; tlist = []} type context = - {types : types; funcs : space; imports : space; + {types : types; tables : space; memories : space; funcs : space; locals : space; globals : space; labels : int VarMap.t} let empty_context () = - {types = empty_types (); funcs = empty (); imports = empty (); - locals = empty (); globals = empty (); labels = VarMap.empty} + {types = empty_types (); tables = empty (); memories = empty (); + funcs = empty (); locals = empty (); globals = empty (); labels = VarMap.empty} let enter_func c = assert (VarMap.is_empty c.labels); @@ -83,9 +83,10 @@ let lookup category space x = with Not_found -> error x.at ("unknown " ^ category ^ " " ^ x.it) let func c x = lookup "function" c.funcs x -let import c x = lookup "import" c.imports x let local c x = lookup "local" c.locals x let global c x = lookup "global" c.globals x +let table c x = lookup "table" c.tables x +let memory c x = lookup "memory" c.memories x let label c x = try VarMap.find x.it c.labels with Not_found -> error x.at ("unknown label " ^ x.it) @@ -103,9 +104,10 @@ let bind category space x = space.count <- space.count + 1 let bind_func c x = bind "function" c.funcs x -let bind_import c x = bind "import" c.imports x let bind_local c x = bind "local" c.locals x let bind_global c x = bind "global" c.globals x +let bind_table c x = bind "table" c.tables x +let bind_memory c x = bind "memory" c.memories x let bind_label c x = {c with labels = VarMap.add x.it 0 (VarMap.map ((+) 1) c.labels)} @@ -115,15 +117,16 @@ let anon_type c ty = let anon space n = space.count <- space.count + n let anon_func c = anon c.funcs 1 -let anon_import c = anon c.imports 1 let anon_locals c ts = anon c.locals (List.length ts) let anon_global c = anon c.globals 1 +let anon_table c = anon c.tables 1 +let anon_memory c = anon c.memories 1 let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels} let empty_type = {ins = []; out = None} -let explicit_decl c name t at = - let x = name c type_ in +let explicit_sig c var t at = + let x = var c type_ in if x.it < List.length c.types.tlist && t <> empty_type && @@ -132,7 +135,7 @@ let explicit_decl c name t at = error at "signature mismatch"; x -let implicit_decl c t at = +let inline_type c t at = match Lib.List.index_of t c.types.tlist with | None -> let i = List.length c.types.tlist in anon_type c t; i @@ at | Some i -> i @@ at @@ -141,7 +144,7 @@ let implicit_decl c t at = %token NAT INT FLOAT TEXT VAR VALUE_TYPE ANYFUNC LPAR RPAR %token NOP DROP BLOCK IF THEN ELSE SELECT LOOP BR BR_IF BR_TABLE -%token CALL CALL_IMPORT CALL_INDIRECT RETURN +%token CALL CALL_INDIRECT RETURN %token GET_LOCAL SET_LOCAL TEE_LOCAL GET_GLOBAL SET_GLOBAL %token LOAD STORE OFFSET ALIGN %token CONST UNARY BINARY COMPARE CONVERT @@ -208,6 +211,10 @@ func_type : { {ins = []; out = Some $3} } ; +type_use : + | LPAR TYPE var RPAR { $3 } +; + /* Expressions */ @@ -228,6 +235,7 @@ var_list : bind_var : | VAR { $1 @@ at () } ; +/* TODO: refactor repetition into bind_var_opt */ labeling : | /* empty */ %prec LOW { fun c -> anon_label c } @@ -277,7 +285,6 @@ expr1 : { fun c -> let c1 = $5 c in let c2 = $10 c in If ($2 c, $6 c1, $11 c2) } | SELECT expr expr expr { fun c -> Select ($2 c, $3 c, $4 c) } | CALL var expr_list { fun c -> Call ($2 c func, $3 c) } - | CALL_IMPORT var expr_list { fun c -> Call_import ($2 c import, $3 c) } | CALL_INDIRECT var expr expr_list { fun c -> Call_indirect ($2 c type_, $3 c, $4 c) } | GET_LOCAL var { fun c -> Get_local ($2 c local) } @@ -335,82 +342,141 @@ func_body : fun c -> bind_local c $3; let f = (snd $6) c in {f with locals = $4 :: f.locals} } ; -type_use : - | LPAR TYPE var RPAR { $3 } -; func : - | LPAR FUNC export_opt type_use func_fields RPAR + | LPAR FUNC export_name_opt type_use func_fields RPAR { let at = at () in - fun c -> anon_func c; let t = explicit_decl c $4 (fst $5) at in - let exs = $3 c in - fun () -> {(snd $5 (enter_func c)) with ftype = t} @@ at, exs } - | LPAR FUNC export_opt bind_var type_use func_fields RPAR /* Sugar */ + fun c -> anon_func c; let t = explicit_sig c $4 (fst $5) at in + let exs = $3 FuncExport c in + fun () -> {(snd $5 (enter_func c)) with ftype = t} @@ at, exs } + | LPAR FUNC export_name_opt bind_var type_use func_fields RPAR /* Sugar */ { let at = at () in - fun c -> bind_func c $4; let t = explicit_decl c $5 (fst $6) at in - let exs = $3 c in - fun () -> {(snd $6 (enter_func c)) with ftype = t} @@ at, exs } - | LPAR FUNC export_opt func_fields RPAR /* Sugar */ + fun c -> bind_func c $4; let t = explicit_sig c $5 (fst $6) at in + let exs = $3 FuncExport c in + fun () -> {(snd $6 (enter_func c)) with ftype = t} @@ at, exs } + | LPAR FUNC export_name_opt func_fields RPAR /* Sugar */ { let at = at () in - fun c -> anon_func c; let t = implicit_decl c (fst $4) at in - let exs = $3 c in - fun () -> {(snd $4 (enter_func c)) with ftype = t} @@ at, exs } - | LPAR FUNC export_opt bind_var func_fields RPAR /* Sugar */ + fun c -> anon_func c; let t = inline_type c (fst $4) at in + let exs = $3 FuncExport c in + fun () -> {(snd $4 (enter_func c)) with ftype = t} @@ at, exs } + | LPAR FUNC export_name_opt bind_var func_fields RPAR /* Sugar */ { let at = at () in - fun c -> bind_func c $4; let t = implicit_decl c (fst $5) at in - let exs = $3 c in - fun () -> {(snd $5 (enter_func c)) with ftype = t} @@ at, exs } -; -export_opt : - | /* empty */ { fun c -> [] } - | TEXT - { let at = at () in - fun c -> [{name = $1; kind = `Func (c.funcs.count - 1 @@ at)} @@ at] } + fun c -> bind_func c $4; let t = inline_type c (fst $5) at in + let exs = $3 FuncExport c in + fun () -> {(snd $5 (enter_func c)) with ftype = t} @@ at, exs } ; /* Tables & Memories */ -elem : - | LPAR ELEM expr var_list RPAR - { let at = at () in - fun c -> {offset = $3 c; init = $4 c func} @@ at } -; - -table_limits : +limits : | NAT { {min = int32 $1 (ati 1); max = None} @@ at () } | NAT NAT { {min = int32 $1 (ati 1); max = Some (int32 $2 (ati 2))} @@ at () } ; -table : - | LPAR TABLE table_limits elem_type RPAR - { let at = at () in fun c -> {tlimits = $3; etype = $4} @@ at, [] } + +elem : + | LPAR ELEM var expr var_list RPAR + { let at = at () in + fun c -> {index = $3 c table; offset = $4 c; init = $5 c func} @@ at } + | LPAR ELEM expr var_list RPAR /* Sugar */ + { let at = at () in + fun c -> {index = 0 @@ at; offset = $3 c; init = $4 c func} @@ at } +; + +table : /* TODO: allow export_opt */ + | LPAR TABLE limits elem_type RPAR + { let at = at () in + fun c -> anon_table c; {tlimits = $3; etype = $4} @@ at, [] } + | LPAR TABLE bind_var limits elem_type RPAR /* Sugar */ + { let at = at () in + fun c -> bind_table c $3; {tlimits = $4; etype = $5} @@ at, [] } | LPAR TABLE elem_type LPAR ELEM var_list RPAR RPAR /* Sugar */ { let at = at () in - fun c -> let init = $6 c func in + fun c -> anon_table c; let init = $6 c func in let size = Int32.of_int (List.length init) in {tlimits = {min = size; max = Some size} @@ at; etype = $3} @@ at, - [{offset = I32_const (0l @@ at) @@ at; init} @@ at] } + [{index = c.tables.count - 1 @@ at; offset = I32_const (0l @@ at) @@ at; init} @@ at] } + | LPAR TABLE bind_var elem_type LPAR ELEM var_list RPAR RPAR /* Sugar */ + { let at = at () in + fun c -> bind_table c $3; let init = $7 c func in + let size = Int32.of_int (List.length init) in + {tlimits = {min = size; max = Some size} @@ at; etype = $4} @@ at, + [{index = c.tables.count - 1 @@ at; offset = I32_const (0l @@ at) @@ at; init} @@ at] } ; data : - | LPAR DATA expr text_list RPAR - { fun c -> {offset = $3 c; init = $4} @@ at () } + | LPAR DATA var expr text_list RPAR + { let at = at () in + fun c -> {index = $3 c memory; offset = $4 c; init = $5} @@ at } + | LPAR DATA expr text_list RPAR /* Sugar */ + { let at = at () in + fun c -> {index = 0 @@ at; offset = $3 c; init = $4} @@ at } ; -memory_limits : - | NAT { {min = int32 $1 (ati 1); max = None} @@ at () } - | NAT NAT - { {min = int32 $1 (ati 1); max = Some (int32 $2 (ati 2))} @@ at () } -; -memory : - | LPAR MEMORY memory_limits RPAR - { fun c -> {mlimits = $3} @@ at (), [] } +memory : /* TODO: allow export_opt */ + | LPAR MEMORY limits RPAR + { fun c -> anon_memory c; {mlimits = $3} @@ at (), [] } + | LPAR MEMORY bind_var limits RPAR /* Sugar */ + { fun c -> bind_memory c $3; {mlimits = $4} @@ at (), [] } | LPAR MEMORY LPAR DATA text_list RPAR RPAR /* Sugar */ { let at = at () in - fun c -> + fun c -> anon_memory c; let size = Int32.(div (add (of_int (String.length $5)) 65535l) 65536l) in {mlimits = {min = size; max = Some size} @@ at} @@ at, - [{offset = I32_const (0l @@ at) @@ at; init = $5} @@ at] } + [{index = c.memories.count - 1 @@ at; offset = I32_const (0l @@ at) @@ at; init = $5} @@ at] } + | LPAR MEMORY bind_var LPAR DATA text_list RPAR RPAR /* Sugar */ + { let at = at () in + fun c -> bind_memory c $3; + let size = Int32.(div (add (of_int (String.length $6)) 65535l) 65536l) in + {mlimits = {min = size; max = Some size} @@ at} @@ at, + [{index = c.memories.count - 1 @@ at; offset = I32_const (0l @@ at) @@ at; init = $6} @@ at] } +; + + +/* Imports & Exports */ + +import_kind : + | LPAR FUNC type_use RPAR + { fun c -> bind_func, anon_func, FuncImport ($3 c type_) } + | LPAR FUNC func_type RPAR /* Sugar */ + { let at3 = ati 3 in + fun c -> bind_func, anon_func, FuncImport (inline_type c $3 at3) } + | LPAR TABLE limits elem_type RPAR + { fun c -> bind_table, anon_table, TableImport ($3, $4) } + | LPAR MEMORY limits RPAR + { fun c -> bind_memory, anon_memory, MemoryImport $3 } + | LPAR GLOBAL VALUE_TYPE RPAR + { fun c -> bind_global, anon_global, GlobalImport $3 } +; +import : + | LPAR IMPORT TEXT TEXT import_kind RPAR + { let at = at () and at5 = ati 5 in + fun c -> let _, anon, k = $5 c in + anon c; {module_name = $3; item_name = $4; ikind = k @@ at5} @@ at } + | LPAR IMPORT bind_var TEXT TEXT import_kind RPAR /* Sugar */ + { let at = at () and at6 = ati 6 in + fun c -> let bind, _, k = $6 c in + bind c $3; {module_name = $4; item_name = $5; ikind = k @@ at6} @@ at } +; + +export_kind : + | LPAR FUNC var RPAR { fun c -> FuncExport, $3 c func } + | LPAR TABLE var RPAR { fun c -> TableExport, $3 c table } + | LPAR MEMORY var RPAR { fun c -> MemoryExport, $3 c memory } + | LPAR GLOBAL var RPAR { fun c -> GlobalExport, $3 c global } +; +export : + | LPAR EXPORT TEXT export_kind RPAR + { let at = at () and at4 = ati 4 in + fun c -> let k, x = $4 c in + {name = $3; ekind = k @@ at4; item = x} @@ at } +; + +export_name_opt : + | /* empty */ { fun k c -> [] } + | TEXT + { let at = at () in + fun k c -> [{name = $1; ekind = k @@ at; item = c.funcs.count - 1 @@ at} @@ at] } ; @@ -423,32 +489,6 @@ type_def : { fun c -> bind_type c $3 $6 } ; -import : - | LPAR IMPORT TEXT TEXT type_use RPAR - { let at = at () in - fun c -> anon_import c; let itype = explicit_decl c $5 empty_type at in - {itype; module_name = $3; func_name = $4} @@ at } - | LPAR IMPORT bind_var TEXT TEXT type_use RPAR /* Sugar */ - { let at = at () in - fun c -> bind_import c $3; let itype = explicit_decl c $6 empty_type at in - {itype; module_name = $4; func_name = $5} @@ at } - | LPAR IMPORT TEXT TEXT func_type RPAR /* Sugar */ - { let at = at () in - fun c -> anon_import c; let itype = implicit_decl c $5 at in - {itype; module_name = $3; func_name = $4} @@ at } - | LPAR IMPORT bind_var TEXT TEXT func_type RPAR /* Sugar */ - { let at = at () in - fun c -> bind_import c $3; let itype = implicit_decl c $6 at in - {itype; module_name = $4; func_name = $5} @@ at } -; - -export : - | LPAR EXPORT TEXT var RPAR - { let at = at () in fun c -> {name = $3; kind = `Func ($4 c func)} @@ at } - | LPAR EXPORT TEXT MEMORY RPAR - { let at = at () in fun c -> {name = $3; kind = `Memory} @@ at } -; - global : | LPAR GLOBAL VALUE_TYPE expr RPAR { let at = at () in @@ -463,14 +503,14 @@ start : { fun c -> $3 c func } ; -module_fields : +module_fields : /* TODO: enforce imports before else */ | /* empty */ { fun c -> { types = c.types.tlist; globals = []; - table = None; - memory = None; + tables = []; + memories = []; funcs = []; elems = []; data = []; @@ -485,14 +525,10 @@ module_fields : {m with globals = g () :: m.globals} } | table module_fields { fun c -> let m = $2 c in let tab, elems = $1 c in - match m.table with - | Some _ -> error tab.at "multiple table sections" - | None -> {m with table = Some tab; elems = elems @ m.elems} } + {m with tables = tab :: m.tables; elems = elems @ m.elems} } | memory module_fields { fun c -> let m = $2 c in let mem, data = $1 c in - match m.memory with - | Some _ -> error mem.at "multiple memory sections" - | None -> {m with memory = Some mem; data = data @ m.data} } + {m with memories = mem :: m.memories; data = data @ m.data} } | func module_fields { fun c -> let f = $1 c in let m = $2 c in let func, exs = f () in {m with funcs = func :: m.funcs; exports = exs @ m.exports} } diff --git a/ml-proto/host/print.ml b/ml-proto/host/print.ml index 5450fcba43..0b253f6795 100644 --- a/ml-proto/host/print.ml +++ b/ml-proto/host/print.ml @@ -7,27 +7,28 @@ open Printf open Types -let func_type m f = - List.nth m.it.types f.it.ftype.it - -let string_of_table_type = function - | None -> "()" - | Some t -> "(" ^ string_of_func_type t ^ ")*" - +let print_no_sig prefix i = + printf "%s %d\n" prefix i let print_var_sig prefix i t = - printf "%s %d : %s\n" prefix i (string_of_value_type t.it) + printf "%s %d : %s\n" prefix i (string_of_value_type t) + +let print_elem_sig prefix i t = + printf "%s %d : %s\n" prefix i (string_of_elem_type t) -let print_func_sig m prefix i f = - printf "%s %d : %s\n" prefix i (string_of_func_type (func_type m f)) +let print_func_sig m prefix i x = + let t = List.nth m.it.types x.it in + printf "%s %d : %s\n" prefix i (string_of_func_type t) let print_export m i ex = - let {name; kind} = ex.it in - let ascription = - match kind with - | `Func x -> string_of_func_type (func_type m (List.nth m.it.funcs x.it)) - | `Memory -> "memory" - in printf "export \"%s\" : %s\n" name ascription + let {name; ekind; item} = ex.it in + let kind = + match ekind.it with + | FuncExport -> "func" + | TableExport -> "table" + | MemoryExport -> "memory" + | GlobalExport -> "global" + in printf "export \"%s\" = %s %d\n" name kind item.it let print_start start = Lib.Option.app (fun x -> printf "start = func %d\n" x.it) start @@ -36,12 +37,24 @@ let print_start start = (* Ast *) let print_func m i f = - print_func_sig m "func" i f + print_func_sig m "func" i f.it.ftype + +let print_global m i glob = + print_var_sig "global" i glob.it.gtype + +let print_table m i tab = + print_elem_sig "table" i tab.it.etype + +let print_memory m i mem = + print_no_sig "memory" i let print_module m = (* TODO: more complete print function *) - let {funcs; start; exports; table; _} = m.it in + let {funcs; globals; tables; memories; start; exports; _} = m.it in List.iteri (print_func m) funcs; + List.iteri (print_global m) globals; + List.iteri (print_table m) tables; + List.iteri (print_memory m) memories; List.iteri (print_export m) exports; print_start start; flush_all () diff --git a/ml-proto/host/script.ml b/ml-proto/host/script.ml index 81712f8a1e..2b3af67cd6 100644 --- a/ml-proto/host/script.ml +++ b/ml-proto/host/script.ml @@ -37,7 +37,7 @@ exception IO = IO.Error let trace name = if !Flags.trace then print_endline ("-- " ^ name) let current_module : Ast.module_ option ref = ref None -let current_instance : Eval.instance option ref = ref None +let current_instance : Instance.instance option ref = ref None let get_module at = match !current_module with | Some m -> m @@ -63,11 +63,13 @@ let run_cmd cmd = | Define def -> let m = run_def def in let m' = Desugar.desugar m in - trace "Checking..."; - Check.check_module m'; - if !Flags.print_sig then begin - trace "Signature:"; - Print.print_module_sig m' + if not !Flags.unchecked then begin + trace "Checking..."; + Check.check_module m'; + if !Flags.print_sig then begin + trace "Signature:"; + Print.print_module_sig m' + end end; current_module := Some m; trace "Initializing..."; @@ -163,11 +165,13 @@ let dry_cmd cmd = | Define def -> let m = dry_def def in let m' = Desugar.desugar m in - trace "Checking..."; - Check.check_module m'; - if !Flags.print_sig then begin - trace "Signature:"; - Print.print_module_sig m' + if not !Flags.unchecked then begin + trace "Checking..."; + Check.check_module m'; + if !Flags.print_sig then begin + trace "Signature:"; + Print.print_module_sig m' + end end; current_module := Some m | Input file -> diff --git a/ml-proto/spec/ast.ml b/ml-proto/spec/ast.ml index a66bd65230..b82509f758 100644 --- a/ml-proto/spec/ast.ml +++ b/ml-proto/spec/ast.ml @@ -23,7 +23,6 @@ and expr' = | If of expr * expr list * expr list | Select of expr * expr * expr | Call of var * expr list - | Call_import of var * expr list | Call_indirect of var * expr * expr list (* Variables *) @@ -219,6 +218,7 @@ and func' = type 'data segment = 'data segment' Source.phrase and 'data segment' = { + index : var; offset : expr; init : 'data; } @@ -228,8 +228,8 @@ and module' = { types : Types.func_type list; globals : global list; - table : Kernel.table option; - memory : Kernel.memory option; + tables : Kernel.table list; + memories : Kernel.memory list; funcs : func list; start : var option; elems : var list segment list; diff --git a/ml-proto/spec/check.ml b/ml-proto/spec/check.ml index 03a4ba155e..0a7d979f31 100644 --- a/ml-proto/spec/check.ml +++ b/ml-proto/spec/check.ml @@ -21,33 +21,30 @@ type context = module_ : module_; types : func_type list; funcs : func_type list; - imports : func_type list; locals : value_type list; globals : value_type list; return : expr_type; labels : expr_type_future list; - table : Table.size option; - memory : Memory.size option; + tables : Table.size list; + memories : Memory.size list; } +let empty_context m = + { module_ = m; types = []; funcs = []; tables = []; memories = []; + globals = []; locals = []; return = None; labels = [] } + let lookup category list x = try List.nth list x.it with Failure _ -> error x.at ("unknown " ^ category ^ " " ^ string_of_int x.it) -let type_ types x = lookup "function type" types x +let type_ c x = lookup "type" c.types x let func c x = lookup "function" c.funcs x let import c x = lookup "import" c.imports x let local c x = lookup "local" c.locals x let global c x = lookup "global" c.globals x let label c x = lookup "label" c.labels x - -let lookup_size category opt at = - match opt with - | Some n -> n - | None -> error at ("no " ^ category ^ " defined") - -let table c at = lookup_size "table" c.table at -let memory c at = lookup_size "memory" c.memory at +let table c x = lookup "table" c.tables x +let memory c x = lookup "memory" c.memories x (* Type Unification *) @@ -185,14 +182,9 @@ let rec check_expr c et e = check_exprs c ins es e.at; check_type out et e.at - | CallImport (x, es) -> - let {ins; out} = import c x in - check_exprs c ins es e.at; - check_type out et e.at - | CallIndirect (x, e1, es) -> - let {ins; out} = type_ c.types x in - ignore (table c e.at); + let {ins; out} = type_ c x in + ignore (table c (0 @@ e.at)); check_expr c (some Int32Type) e1; check_exprs c ins es e.at; check_type out et e.at @@ -261,7 +253,7 @@ let rec check_expr c et e = | Host (hostop, es) -> let {ins; out}, has_mem = type_hostop hostop in - if has_mem then ignore (memory c e.at); + if has_mem then ignore (memory c (0 @@ e.at)); check_exprs c ins es e.at; check_type out et e.at @@ -280,13 +272,13 @@ and check_literal c et l = check_type (Some (type_value l.it)) et l.at and check_load c et memop e1 at = - ignore (memory c at); + ignore (memory c (0 @@ at)); check_memop memop at; check_expr c (some Int32Type) e1; check_type (Some memop.ty) et at and check_store c et memop e1 e2 at = - ignore (memory c at); + ignore (memory c (0 @@ at)); check_memop memop at; check_expr c (some Int32Type) e1; check_expr c (some memop.ty) e2; @@ -325,7 +317,7 @@ let check_const c et e = let check_func c f = let {ftype; locals; body} = f.it in - let s = type_ c.types ftype in + let s = type_ c ftype in let c' = {c with locals = s.ins @ locals; return = s.out} in check_expr c' (known s.out) body @@ -361,26 +353,27 @@ let check_memory (c : context) (mem : memory) = check_memory_limits lim let check_table_segment c prev_end seg = - let {offset; init} = seg.it in + let {index; offset; init} = seg.it in check_const c Int32Type offset; let start = Values.int32_of_value (Eval.const c.module_ offset) in let len = Int32.of_int (List.length init) in let end_ = Int32.add start len in + let limit = table c index in require (I32.le_u prev_end start) seg.at "table segment not disjoint and ordered"; - require (I32.le_u end_ (table c seg.at)) seg.at + require (I32.le_u end_ limit) seg.at "table segment does not fit memory"; ignore (List.map (func c) init); end_ let check_memory_segment c prev_end seg = - let {offset; init} = seg.it in + let {index; offset; init} = seg.it in check_const c Int32Type offset; let start = Int64.of_int32 (Values.int32_of_value (Eval.const c.module_ offset)) in let len = Int64.of_int (String.length init) in let end_ = Int64.add start len in - let limit = Int64.mul (Int64.of_int32 (memory c seg.at)) Memory.page_size in + let limit = Int64.mul (Int64.of_int32 (memory c index)) Memory.page_size in require (I64.le_u prev_end start) seg.at "data segment not disjoint and ordered"; require (I64.le_u end_ limit) seg.at @@ -390,9 +383,10 @@ let check_memory_segment c prev_end seg = (* Modules *) -let check_global c g = - let {gtype; value} = g.it in - check_const c gtype value +let check_global c glob = + let {gtype; value} = glob.it in + check_const c gtype value; + {c with globals = c.globals @ [gtype]} let check_start c start = Lib.Option.app (fun x -> @@ -403,42 +397,52 @@ let check_start c start = "start function must not return anything"; ) start +let check_import im c = + let {module_name = _; item_name = _; ikind} = im.it in + match ikind.it with + | FuncImport x -> + {c with funcs = type_ c x :: c.funcs} + | TableImport (lim, t) -> + check_table_limits lim; + {c with tables = lim.it.min :: c.tables} + | MemoryImport lim -> + check_memory_limits lim; + {c with memories = lim.it.min :: c.memories} + | GlobalImport t -> + {c with globals = t :: c.globals} + module NameSet = Set.Make(String) let check_export c set ex = - let {name; kind} = ex.it in - (match kind with - | `Func x -> ignore (func c x) - | `Memory -> ignore (memory c ex.at) + let {name; ekind; item} = ex.it in + (match ekind.it with + | FuncExport -> ignore (func c item) + | TableExport -> ignore (table c item) + | MemoryExport -> ignore (memory c item) + | GlobalExport -> ignore (global c item) ); require (not (NameSet.mem name set)) ex.at "duplicate export name"; NameSet.add name set let check_module m = let - {types; table; memory; globals; funcs; start; elems; data; - imports; exports} = m.it in - let c = - { - module_ = m; - types; - funcs = List.map (fun f -> type_ types f.it.ftype) funcs; - imports = List.map (fun i -> type_ types i.it.itype) imports; - globals = []; - locals = []; - return = None; - labels = []; - table = Lib.Option.map (fun tab -> tab.it.tlimits.it.min) table; - memory = Lib.Option.map (fun mem -> mem.it.mlimits.it.min) memory; + {types; imports; tables; memories; globals; funcs; start; elems; data; + exports} = m.it in + let c = List.fold_right check_import imports {(empty_context m) with types} in + let c' = + { (List.fold_left check_global c globals) with + funcs = c.funcs @ List.map (fun f -> type_ c f.it.ftype) funcs; + tables = c.tables @ List.map (fun tab -> tab.it.tlimits.it.min) tables; + memories = c.memories @ List.map (fun mem -> mem.it.mlimits.it.min) memories; } in - List.iter (check_global c) globals; - let c' = {c with globals = List.map (fun g -> g.it.gtype) globals} in + require (List.length c'.tables <= 1) m.at "at most one table allowed"; + require (List.length c'.memories <= 1) m.at "at most one memory allowed"; List.iter (check_func c') funcs; - Lib.Option.app (check_table c') table; - Lib.Option.app (check_memory c') memory; - ignore (List.fold_left (check_export c') NameSet.empty exports); + List.iter (check_table c') tables; + List.iter (check_memory c') memories; ignore (List.fold_left (check_table_segment c') 0l elems); ignore (List.fold_left (check_memory_segment c') 0L data); + ignore (List.fold_left (check_export c') NameSet.empty exports); check_start c' start diff --git a/ml-proto/spec/decode.ml b/ml-proto/spec/decode.ml index c7938f0131..3d023fcf95 100644 --- a/ml-proto/spec/decode.ml +++ b/ml-proto/spec/decode.ml @@ -114,7 +114,7 @@ let vec1 f s = let b = bool s in opt f b s open Types let value_type s = - match get s with + match u8 s with | 0x01 -> Int32Type | 0x02 -> Int64Type | 0x03 -> Float32Type @@ -122,7 +122,7 @@ let value_type s = | _ -> error s (pos s - 1) "invalid value type" let elem_type s = - match get s with + match u8 s with | 0x20 -> AnyFuncType | _ -> error s (pos s - 1) "invalid element type" @@ -245,11 +245,6 @@ let rec expr stack s = let x = at var s in let es1, es' = args (n + 1) es s pos in Call_indirect (x, List.hd es1, List.tl es1), es' - | 0x18, es -> - let n = arity s in - let x = at var s in - let es1, es' = args n es s pos in - Call_import (x, es1), es' | 0x19, e :: es -> let x = at var s in @@ -490,11 +485,34 @@ let type_section s = (* Import section *) +let limits vu s = + let has_max = bool s in + let min = vu s in + let max = opt vu has_max s in + {min; max} + +let import_kind s = + match u8 s with + | 0x00 -> + let x = at var s in + FuncImport x + | 0x01 -> + let t = elem_type s in + let lim = at (limits vu32) s in + TableImport (lim, t) + | 0x02 -> + let lim = at (limits vu32) s in + MemoryImport lim + | 0x03 -> + let t = value_type s in + GlobalImport t (* TODO: mutability *) + | _ -> error s (pos s - 1) "invalid import kind" + let import s = - let itype = at var s in let module_name = string s in - let func_name = string s in - {itype; module_name; func_name} + let item_name = string s in + let ikind = at import_kind s in + {module_name; item_name; ikind} let import_section s = section `ImportSection (vec (at import)) [] s @@ -508,19 +526,13 @@ let func_section s = (* Table section *) -let limits vu s = - let has_max = bool s in - let min = vu s in - let max = opt vu has_max s in - {min; max} - let table s = let t = elem_type s in let lim = at (limits vu32) s in {etype = t; tlimits = lim} let table_section s = - section `TableSection (opt (at table) true) None s + section `TableSection (vec (at table)) [] s (* Memory section *) @@ -530,7 +542,7 @@ let memory s = {mlimits = lim} let memory_section s = - section `MemorySection (opt (at memory) true) None s + section `MemorySection (vec (at memory)) [] s (* Global section *) @@ -549,10 +561,19 @@ let global_section s = (* Export section *) +let export_kind s = + match u8 s with + | 0x00 -> FuncExport + | 0x01 -> TableExport + | 0x02 -> MemoryExport + | 0x03 -> GlobalExport + | _ -> error s (pos s - 1) "invalid export kind" + let export s = - let x = at var s in let name = string s in - {name; kind = `Func x} (*TODO: pending resolution*) + let ekind = at export_kind s in + let item = at var s in + {name; ekind; item} let export_section s = section `ExportSection (vec (at export)) [] s @@ -584,9 +605,10 @@ let code_section s = (* Element section *) let segment dat s = + let index = at var s in let offset = const s in let init = dat s in - {offset; init} + {index; offset; init} let table_segment s = segment (vec (at var)) s @@ -626,9 +648,9 @@ let module_ s = iterate unknown_section s; let func_types = func_section s in iterate unknown_section s; - let table = table_section s in + let tables = table_section s in iterate unknown_section s; - let memory = memory_section s in + let memories = memory_section s in iterate unknown_section s; let globals = global_section s in iterate unknown_section s; @@ -650,7 +672,7 @@ let module_ s = let funcs = List.map2 Source.(fun t f -> {f.it with ftype = t} @@ f.at) func_types func_bodies - in {types; table; memory; globals; funcs; imports; exports; elems; data; start} + in {types; tables; memories; globals; funcs; imports; exports; elems; data; start} let decode name bs = at module_ (stream name bs) diff --git a/ml-proto/spec/desugar.ml b/ml-proto/spec/desugar.ml index 6f5e514be3..d7b88195f9 100644 --- a/ml-proto/spec/desugar.ml +++ b/ml-proto/spec/desugar.ml @@ -27,7 +27,6 @@ and relabel' f n = function | Select (e1, e2, e3) -> Select (relabel f n e1, relabel f n e2, relabel f n e3) | Call (x, es) -> Call (x, List.map (relabel f n) es) - | CallImport (x, es) -> CallImport (x, List.map (relabel f n) es) | CallIndirect (x, e, es) -> CallIndirect (x, relabel f n e, List.map (relabel f n) es) | GetLocal x -> GetLocal x @@ -79,7 +78,6 @@ and expr' at = function | Ast.Select (e1, e2, e3) -> Select (expr e1, expr e2, expr e3) | Ast.Call (x, es) -> Call (x, List.map expr es) - | Ast.Call_import (x, es) -> CallImport (x, List.map expr es) | Ast.Call_indirect (x, e, es) -> CallIndirect (x, expr e, List.map expr es) | Ast.Get_local x -> GetLocal x @@ -309,15 +307,15 @@ and func' = function let rec segment seg = segment' seg.it @@ seg.at and segment' = function - | {Ast.offset = e; init} -> {offset = expr e; init} + | {index; Ast.offset = e; init} -> {index; offset = expr e; init} let rec module_ m = module' m.it @@ m.at and module' = function - | {Ast.funcs = fs; start; globals = gs; memory; types; imports; exports; table; elems; data} -> + | {Ast.funcs = fs; start; globals = gs; memories; types; imports; exports; tables; elems; data} -> let globals = List.map global gs in let elems = List.map segment elems in let funcs = List.map func fs in let data = List.map segment data in - {funcs; start; globals; memory; types; imports; exports; table; elems; data} + {funcs; start; globals; memories; types; imports; exports; tables; elems; data} let desugar = module_ diff --git a/ml-proto/spec/eval.ml b/ml-proto/spec/eval.ml index 280e15ecd8..370ee04acf 100644 --- a/ml-proto/spec/eval.ml +++ b/ml-proto/spec/eval.ml @@ -1,28 +1,10 @@ open Values open Types open Kernel +open Instance open Source -(* Module Instances *) - -type value = Values.value -type import = value list -> value option - -module ExportMap = Map.Make(String) -type export_map = func ExportMap.t - -type instance = -{ - module_ : module_; - imports : import list; - exports : export_map; - table : Table.t option; - memory : Memory.t option; - globals : value ref list; -} - - (* Errors *) module Trap = Error.Make () @@ -66,32 +48,36 @@ type config = labels : label list } +let empty_config inst = {instance = inst; locals = []; labels = []} + let lookup category list x = try List.nth list x.it with Failure _ -> Crash.error x.at ("undefined " ^ category ^ " " ^ string_of_int x.it) let type_ c x = lookup "type" c.instance.module_.it.types x -let func c x = lookup "function" c.instance.module_.it.funcs x -let import c x = lookup "import" c.instance.imports x +let func c x = lookup "function" c.instance.funcs x +let table c x = lookup "table" c.instance.tables x +let memory c x = lookup "memory" c.instance.memories x let global c x = lookup "global" c.instance.globals x let local c x = lookup "local" c.locals x let label c x = lookup "label" c.labels x -let export m name = - try ExportMap.find name.it m.exports with Not_found -> +let export inst name = + try ExportMap.find name.it inst.exports with Not_found -> Crash.error name.at ("undefined export \"" ^ name.it ^ "\"") -let elem c i t at = - match c.instance.table with - | None -> Crash.error at "no table" - | Some tab -> - match Table.load tab i t with +let elem c x i t at = + match Table.load (table c x) i t with | Some j -> j | None -> Trap.error at ("undefined element " ^ Int32.to_string i) | exception Table.Bounds -> Trap.error at ("undefined element " ^ Int32.to_string i) +let func_type_of = function + | AstFunc (inst, f) -> lookup "type" (!inst).module_.it.types f.it.ftype + | HostFunc (t, _) -> t + module MakeLabel () = struct exception Label of value option @@ -119,11 +105,6 @@ let int64 v at = let address32 v at = Int64.logand (Int64.of_int32 (int32 v at)) 0xffffffffL -let memory c at = - match c.instance.memory with - | Some m -> m - | _ -> Trap.error at "memory operation with no memory" - (* Evaluation *) @@ -188,19 +169,15 @@ let rec eval_expr (c : config) (e : expr) : value option = | Call (x, es) -> let vs = List.map (fun vo -> some (eval_expr c vo) vo.at) es in - eval_func c.instance (func c x) vs - - | CallImport (x, es) -> - let vs = List.map (fun ev -> some (eval_expr c ev) ev.at) es in - (try (import c x) vs with Crash (_, msg) -> Crash.error e.at msg) + eval_func (func c x) vs e.at | CallIndirect (x, e1, es) -> let i = int32 (eval_expr c e1) e1.at in let vs = List.map (fun vo -> some (eval_expr c vo) vo.at) es in - let f = func c (elem c i AnyFuncType e1.at @@ e1.at) in - if type_ c x <> type_ c f.it.ftype then + let f = func c (elem c (0 @@ e.at) i AnyFuncType e1.at @@ e1.at) in + if type_ c x <> func_type_of f then Trap.error e1.at "indirect call signature mismatch"; - eval_func c.instance f vs + eval_func f vs e.at | GetLocal x -> Some !(local c x) @@ -224,13 +201,13 @@ let rec eval_expr (c : config) (e : expr) : value option = None | Load ({ty; offset; align = _}, e1) -> - let mem = memory c e.at in + let mem = memory c (0 @@ e.at) in let v1 = address32 (eval_expr c e1) e1.at in (try Some (Memory.load mem v1 offset ty) with exn -> memory_error e.at exn) | Store ({ty = _; offset; align = _}, e1, e2) -> - let mem = memory c e.at in + let mem = memory c (0 @@ e.at) in let v1 = address32 (eval_expr c e1) e1.at in let v2 = some (eval_expr c e2) e2.at in (try Memory.store mem v1 offset v2 @@ -238,13 +215,13 @@ let rec eval_expr (c : config) (e : expr) : value option = None | LoadExtend ({memop = {ty; offset; align = _}; sz; ext}, e1) -> - let mem = memory c e.at in + let mem = memory c (0 @@ e.at) in let v1 = address32 (eval_expr c e1) e1.at in (try Some (Memory.load_extend mem v1 offset sz ext ty) with exn -> memory_error e.at exn) | StoreWrap ({memop = {ty; offset; align = _}; sz}, e1, e2) -> - let mem = memory c e.at in + let mem = memory c (0 @@ e.at) in let v1 = address32 (eval_expr c e1) e1.at in let v2 = some (eval_expr c e2) e2.at in (try Memory.store_wrap mem v1 offset sz v2 @@ -289,15 +266,18 @@ and eval_expr_opt c = function | Some e -> eval_expr c e | None -> None -and eval_func instance f vs = - let args = List.map ref vs in - let vars = List.map (fun t -> ref (default_value t)) f.it.locals in - let locals = args @ vars in - let c = {instance; locals; labels = []} in - let ft = type_ c f.it.ftype in - if List.length vs <> List.length ft.ins then - Crash.error f.at "function called with wrong number of arguments"; - eval_expr c f.it.body +and eval_func func vs at = + if List.length vs <> List.length (func_type_of func).ins then + Crash.error at "function called with wrong number of arguments"; + match func with + | AstFunc (inst, f) -> + let args = List.map ref vs in + let vars = List.map (fun t -> ref (default_value t)) f.it.locals in + let locals = args @ vars in + eval_expr {(empty_config !inst) with locals} f.it.body + + | HostFunc (_, f) -> + try f vs with Crash (_, msg) -> Crash.error at msg (* Host operators *) @@ -305,12 +285,12 @@ and eval_func instance f vs = and eval_hostop c hostop vs at = match hostop, vs with | CurrentMemory, [] -> - let mem = memory c at in + let mem = memory c (0 @@ at) in let size = Memory.size mem in Some (Int32 size) | GrowMemory, [v] -> - let mem = memory c at in + let mem = memory c (0 @@ at) in let delta = int32 v at in let old_size = Memory.size mem in let result = @@ -324,62 +304,91 @@ and eval_hostop c hostop vs at = (* Modules *) -let const m e = - (* TODO: allow referring to earlier glboals *) - let inst = - { module_ = m; imports = []; exports = ExportMap.empty; - table = None; memory = None; globals = [] } - in some (eval_expr {instance = inst; locals = []; labels = []} e) e.at - -let offset m seg = - int32 (Some (const m seg.it.offset)) seg.it.offset.at - -let init_table m elems table = - let {tlimits = lim; _} = table.it in - let tab = Table.create lim.it.min lim.it.max in - let entries xs = List.map (fun x -> Some x.it) xs in - List.iter - (fun seg -> Table.blit tab (offset m seg) (entries seg.it.init)) - elems; - tab - -let init_memory m data memory = - let {mlimits = lim} = memory.it in - let mem = Memory.create lim.it.min lim.it.max in - List.iter - (fun seg -> Memory.blit mem (Int64.of_int32 (offset m seg)) seg.it.init) - data; - mem - -let init_global inst ref global = - let {value = e; _} = global.it in - let c = {instance = inst; locals = []; labels = []} in - ref := some (eval_expr c e) e.at +let create_func m f = + AstFunc (ref (instance m), f) + +let create_table tab = + let {tlimits = lim; _} = tab.it in + Table.create lim.it.min lim.it.max + +let create_memory mem = + let {mlimits = lim} = mem.it in + Memory.create lim.it.min lim.it.max + +let create_global glob = + let {gtype = t; _} = glob.it in + ref (default_value t) + +let init_func c f = + match f with + | AstFunc (inst, _) -> inst := c.instance + | _ -> assert false -let add_export funcs ex = - let {name; kind} = ex.it in - match kind with - | `Func x -> ExportMap.add name (List.nth funcs x.it) - | `Memory -> fun x -> x +let init_table c seg = + let {index; offset = e; init} = seg.it in + let tab = table c index in + let offset = int32 (eval_expr c e) e.at in + Table.blit tab offset (List.map (fun x -> Some x.it) init) -let init m imports = - assert (List.length imports = List.length m.it.Kernel.imports); - let {table; memory; globals; funcs; exports; elems; data; start; _} = m.it in +let init_memory c seg = + let {index; offset = e; init} = seg.it in + let mem = memory c index in + let offset = Int64.of_int32 (int32 (eval_expr c e) e.at) in + Memory.blit mem offset init + +let init_global c ref glob = + let {value = e; _} = glob.it in + ref := some (eval_expr c e) e.at + +let add_import (ext : extern) (imp : import) (inst : instance) : instance = + match ext, imp.it.ikind.it with + | ExternalFunc f, FuncImport x -> {inst with funcs = f :: inst.funcs} + | ExternalTable t, TableImport _ -> {inst with tables = t :: inst.tables} + | ExternalMemory m, MemoryImport _ -> {inst with memories = m :: inst.memories} + | ExternalGlobal g, GlobalImport _ -> {inst with globals = g :: inst.globals} + | _ -> assert false (* TODO: better exception? *) + +let add_export c ex map = + let {name; ekind; item} = ex.it in + let ext = + match ekind.it with + | FuncExport -> ExternalFunc (func c item) + | TableExport -> ExternalTable (table c item) + | MemoryExport -> ExternalMemory (memory c item) + | GlobalExport -> ExternalGlobal (global c item) + in ExportMap.add name ext map + +let init m externals = + let + { imports; tables; memories; globals; funcs; + exports; elems; data; start } = m.it + in + assert (List.length externals = List.length imports); (* TODO: better exception? *) + let fs = List.map (create_func m) funcs in let inst = - { module_ = m; - imports; - exports = List.fold_right (add_export funcs) exports ExportMap.empty; - table = Lib.Option.map (init_table m elems) table; - memory = Lib.Option.map (init_memory m data) memory; - globals = List.map (fun g -> ref (default_value g.it.gtype)) globals; - } + List.fold_right2 add_import externals imports + { (instance m) with + funcs = fs; + tables = List.map create_table tables; + memories = List.map create_memory memories; + globals = List.map create_global globals; + } in - List.iter2 (init_global inst) inst.globals globals; - Lib.Option.app - (fun x -> ignore (eval_func inst (lookup "function" funcs x) [])) start; - inst + let c = empty_config inst in + List.iter (init_func c) fs; + List.iter (init_table c) elems; + List.iter (init_memory c) data; + List.iter2 (init_global c) inst.globals globals; + Lib.Option.app (fun x -> ignore (eval_func (func c x) [] x.at)) start; + {inst with exports = List.fold_right (add_export c) exports inst.exports} let invoke inst name vs = - try - eval_func inst (export inst (name @@ no_region)) vs - with Stack_overflow -> Trap.error Source.no_region "call stack exhausted" + match export inst (name @@ no_region) with + | ExternalFunc f -> + (try eval_func f vs no_region + with Stack_overflow -> Trap.error no_region "call stack exhausted") + | _ -> + Crash.error no_region ("export \"" ^ name ^ "\" is not a function") + +let const m e = + some (eval_expr (empty_config (instance m)) e) e.at diff --git a/ml-proto/spec/eval.mli b/ml-proto/spec/eval.mli index 703a242170..c46d0f1fdd 100644 --- a/ml-proto/spec/eval.mli +++ b/ml-proto/spec/eval.mli @@ -1,11 +1,10 @@ -type instance -type value = Values.value -type import = value list -> value option +open Values +open Instance exception Trap of Source.region * string exception Crash of Source.region * string -val init : Kernel.module_ -> import list -> instance +val init : Kernel.module_ -> extern list -> instance val invoke : instance -> string -> value list -> value option (* raises Trap, Crash *) val const : Kernel.module_ -> Kernel.expr -> value diff --git a/ml-proto/spec/kernel.ml b/ml-proto/spec/kernel.ml index d89b12debf..eec4f921e9 100644 --- a/ml-proto/spec/kernel.ml +++ b/ml-proto/spec/kernel.ml @@ -83,7 +83,6 @@ and expr' = | If of expr * expr * expr (* conditional *) | Select of expr * expr * expr (* branchless conditional *) | Call of var * expr list (* call function *) - | CallImport of var * expr list (* call imported function *) | CallIndirect of var * expr * expr list (* call function through table *) | GetLocal of var (* read local variable *) | SetLocal of var * expr (* write local variable *) @@ -146,6 +145,7 @@ and memory' = type 'data segment = 'data segment' Source.phrase and 'data segment' = { + index : var; offset : expr; init : 'data; } @@ -156,19 +156,30 @@ type memory_segment = string segment (* Modules *) +type export_kind = export_kind' Source.phrase +and export_kind' = FuncExport | TableExport | MemoryExport | GlobalExport + type export = export' Source.phrase and export' = { name : string; - kind : [`Func of var | `Memory] + ekind : export_kind; + item : var; } +type import_kind = import_kind' Source.phrase +and import_kind' = + | FuncImport of var + | TableImport of Table.size limits * elem_type + | MemoryImport of Memory.size limits + | GlobalImport of value_type (* TODO: mutability *) + type import = import' Source.phrase and import' = { - itype : var; module_name : string; - func_name : string; + item_name : string; + ikind : import_kind; } type module_ = module_' Source.phrase @@ -176,8 +187,8 @@ and module_' = { types : Types.func_type list; globals : global list; - table : table option; - memory : memory option; + tables : table list; + memories : memory list; funcs : func list; start : var option; elems : table_segment list; diff --git a/ml-proto/spec/types.ml b/ml-proto/spec/types.ml index 9fb869fc4a..bf89ea0e65 100644 --- a/ml-proto/spec/types.ml +++ b/ml-proto/spec/types.ml @@ -5,6 +5,12 @@ type elem_type = AnyFuncType type expr_type = value_type option type func_type = {ins : value_type list; out : expr_type} +type external_type = + | ExternalFuncType of func_type + | ExternalTableType of elem_type + | ExternalMemoryType + | ExternalGlobalType of value_type (* TODO: mutability *) + (* Attributes *) diff --git a/ml-proto/spec/values.ml b/ml-proto/spec/values.ml index 28f6870633..aa6440670b 100644 --- a/ml-proto/spec/values.ml +++ b/ml-proto/spec/values.ml @@ -7,7 +7,6 @@ type ('i32, 'i64, 'f32, 'f64) op = Int32 of 'i32 | Int64 of 'i64 | Float32 of 'f32 | Float64 of 'f64 type value = (I32.t, I64.t, F32.t, F64.t) op -type func = value list -> value option (* Typing *) diff --git a/ml-proto/test/float_memory.wast b/ml-proto/test/float_memory.wast index 6a4f014152..9a8ae53b94 100644 --- a/ml-proto/test/float_memory.wast +++ b/ml-proto/test/float_memory.wast @@ -5,20 +5,11 @@ (module (memory (data "\00\00\a0\7f")) - (func $f32.load (result f32) (f32.load (i32.const 0))) - (export "f32.load" $f32.load) - - (func $i32.load (result i32) (i32.load (i32.const 0))) - (export "i32.load" $i32.load) - - (func $f32.store (f32.store (i32.const 0) (f32.const nan:0x200000))) - (export "f32.store" $f32.store) - - (func $i32.store (i32.store (i32.const 0) (i32.const 0x7fa00000))) - (export "i32.store" $i32.store) - - (func $reset (i32.store (i32.const 0) (i32.const 0))) - (export "reset" $reset) + (func "f32.load" (result f32) (f32.load (i32.const 0))) + (func "i32.load" (result i32) (i32.load (i32.const 0))) + (func "f32.store" (f32.store (i32.const 0) (f32.const nan:0x200000))) + (func "i32.store" (i32.store (i32.const 0) (i32.const 0x7fa00000))) + (func "reset" (i32.store (i32.const 0) (i32.const 0))) ) (assert_return (invoke "i32.load") (i32.const 0x7fa00000)) @@ -39,20 +30,11 @@ (module (memory (data "\00\00\00\00\00\00\f4\7f")) - (func $f64.load (result f64) (f64.load (i32.const 0))) - (export "f64.load" $f64.load) - - (func $i64.load (result i64) (i64.load (i32.const 0))) - (export "i64.load" $i64.load) - - (func $f64.store (f64.store (i32.const 0) (f64.const nan:0x4000000000000))) - (export "f64.store" $f64.store) - - (func $i64.store (i64.store (i32.const 0) (i64.const 0x7ff4000000000000))) - (export "i64.store" $i64.store) - - (func $reset (i64.store (i32.const 0) (i64.const 0))) - (export "reset" $reset) + (func "f64.load" (result f64) (f64.load (i32.const 0))) + (func "i64.load" (result i64) (i64.load (i32.const 0))) + (func "f64.store" (f64.store (i32.const 0) (f64.const nan:0x4000000000000))) + (func "i64.store" (i64.store (i32.const 0) (i64.const 0x7ff4000000000000))) + (func "reset" (i64.store (i32.const 0) (i64.const 0))) ) (assert_return (invoke "i64.load") (i64.const 0x7ff4000000000000)) @@ -75,20 +57,11 @@ (module (memory (data "\00\00\00\a0\7f")) - (func $f32.load (result f32) (f32.load (i32.const 1))) - (export "f32.load" $f32.load) - - (func $i32.load (result i32) (i32.load (i32.const 1))) - (export "i32.load" $i32.load) - - (func $f32.store (f32.store (i32.const 1) (f32.const nan:0x200000))) - (export "f32.store" $f32.store) - - (func $i32.store (i32.store (i32.const 1) (i32.const 0x7fa00000))) - (export "i32.store" $i32.store) - - (func $reset (i32.store (i32.const 1) (i32.const 0))) - (export "reset" $reset) + (func "f32.load" (result f32) (f32.load (i32.const 1))) + (func "i32.load" (result i32) (i32.load (i32.const 1))) + (func "f32.store" (f32.store (i32.const 1) (f32.const nan:0x200000))) + (func "i32.store" (i32.store (i32.const 1) (i32.const 0x7fa00000))) + (func "reset" (i32.store (i32.const 1) (i32.const 0))) ) (assert_return (invoke "i32.load") (i32.const 0x7fa00000)) @@ -109,20 +82,11 @@ (module (memory (data "\00\00\00\00\00\00\00\f4\7f")) - (func $f64.load (result f64) (f64.load (i32.const 1))) - (export "f64.load" $f64.load) - - (func $i64.load (result i64) (i64.load (i32.const 1))) - (export "i64.load" $i64.load) - - (func $f64.store (f64.store (i32.const 1) (f64.const nan:0x4000000000000))) - (export "f64.store" $f64.store) - - (func $i64.store (i64.store (i32.const 1) (i64.const 0x7ff4000000000000))) - (export "i64.store" $i64.store) - - (func $reset (i64.store (i32.const 1) (i64.const 0))) - (export "reset" $reset) + (func "f64.load" (result f64) (f64.load (i32.const 1))) + (func "i64.load" (result i64) (i64.load (i32.const 1))) + (func "f64.store" (f64.store (i32.const 1) (f64.const nan:0x4000000000000))) + (func "i64.store" (i64.store (i32.const 1) (i64.const 0x7ff4000000000000))) + (func "reset" (i64.store (i32.const 1) (i64.const 0))) ) (assert_return (invoke "i64.load") (i64.const 0x7ff4000000000000)) @@ -145,20 +109,11 @@ (module (memory (data "\01\00\d0\7f")) - (func $f32.load (result f32) (f32.load (i32.const 0))) - (export "f32.load" $f32.load) - - (func $i32.load (result i32) (i32.load (i32.const 0))) - (export "i32.load" $i32.load) - - (func $f32.store (f32.store (i32.const 0) (f32.const nan:0x500001))) - (export "f32.store" $f32.store) - - (func $i32.store (i32.store (i32.const 0) (i32.const 0x7fd00001))) - (export "i32.store" $i32.store) - - (func $reset (i32.store (i32.const 0) (i32.const 0))) - (export "reset" $reset) + (func "f32.load" (result f32) (f32.load (i32.const 0))) + (func "i32.load" (result i32) (i32.load (i32.const 0))) + (func "f32.store" (f32.store (i32.const 0) (f32.const nan:0x500001))) + (func "i32.store" (i32.store (i32.const 0) (i32.const 0x7fd00001))) + (func "reset" (i32.store (i32.const 0) (i32.const 0))) ) (assert_return (invoke "i32.load") (i32.const 0x7fd00001)) @@ -179,20 +134,11 @@ (module (memory (data "\01\00\00\00\00\00\fc\7f")) - (func $f64.load (result f64) (f64.load (i32.const 0))) - (export "f64.load" $f64.load) - - (func $i64.load (result i64) (i64.load (i32.const 0))) - (export "i64.load" $i64.load) - - (func $f64.store (f64.store (i32.const 0) (f64.const nan:0xc000000000001))) - (export "f64.store" $f64.store) - - (func $i64.store (i64.store (i32.const 0) (i64.const 0x7ffc000000000001))) - (export "i64.store" $i64.store) - - (func $reset (i64.store (i32.const 0) (i64.const 0))) - (export "reset" $reset) + (func "f64.load" (result f64) (f64.load (i32.const 0))) + (func "i64.load" (result i64) (i64.load (i32.const 0))) + (func "f64.store" (f64.store (i32.const 0) (f64.const nan:0xc000000000001))) + (func "i64.store" (i64.store (i32.const 0) (i64.const 0x7ffc000000000001))) + (func "reset" (i64.store (i32.const 0) (i64.const 0))) ) (assert_return (invoke "i64.load") (i64.const 0x7ffc000000000001)) diff --git a/ml-proto/test/float_misc.wast b/ml-proto/test/float_misc.wast index b01fb37f4d..c3a110e0b4 100644 --- a/ml-proto/test/float_misc.wast +++ b/ml-proto/test/float_misc.wast @@ -15,65 +15,35 @@ ;; interesting cases. (module - (func $f32.add (param $x f32) (param $y f32) (result f32) (f32.add (get_local $x) (get_local $y))) - (func $f32.sub (param $x f32) (param $y f32) (result f32) (f32.sub (get_local $x) (get_local $y))) - (func $f32.mul (param $x f32) (param $y f32) (result f32) (f32.mul (get_local $x) (get_local $y))) - (func $f32.div (param $x f32) (param $y f32) (result f32) (f32.div (get_local $x) (get_local $y))) - (func $f32.sqrt (param $x f32) (result f32) (f32.sqrt (get_local $x))) - (func $f32.abs (param $x f32) (result f32) (f32.abs (get_local $x))) - (func $f32.neg (param $x f32) (result f32) (f32.neg (get_local $x))) - (func $f32.copysign (param $x f32) (param $y f32) (result f32) (f32.copysign (get_local $x) (get_local $y))) - (func $f32.ceil (param $x f32) (result f32) (f32.ceil (get_local $x))) - (func $f32.floor (param $x f32) (result f32) (f32.floor (get_local $x))) - (func $f32.trunc (param $x f32) (result f32) (f32.trunc (get_local $x))) - (func $f32.nearest (param $x f32) (result f32) (f32.nearest (get_local $x))) - (func $f32.min (param $x f32) (param $y f32) (result f32) (f32.min (get_local $x) (get_local $y))) - (func $f32.max (param $x f32) (param $y f32) (result f32) (f32.max (get_local $x) (get_local $y))) - - (func $f64.add (param $x f64) (param $y f64) (result f64) (f64.add (get_local $x) (get_local $y))) - (func $f64.sub (param $x f64) (param $y f64) (result f64) (f64.sub (get_local $x) (get_local $y))) - (func $f64.mul (param $x f64) (param $y f64) (result f64) (f64.mul (get_local $x) (get_local $y))) - (func $f64.div (param $x f64) (param $y f64) (result f64) (f64.div (get_local $x) (get_local $y))) - (func $f64.sqrt (param $x f64) (result f64) (f64.sqrt (get_local $x))) - (func $f64.abs (param $x f64) (result f64) (f64.abs (get_local $x))) - (func $f64.neg (param $x f64) (result f64) (f64.neg (get_local $x))) - (func $f64.copysign (param $x f64) (param $y f64) (result f64) (f64.copysign (get_local $x) (get_local $y))) - (func $f64.ceil (param $x f64) (result f64) (f64.ceil (get_local $x))) - (func $f64.floor (param $x f64) (result f64) (f64.floor (get_local $x))) - (func $f64.trunc (param $x f64) (result f64) (f64.trunc (get_local $x))) - (func $f64.nearest (param $x f64) (result f64) (f64.nearest (get_local $x))) - (func $f64.min (param $x f64) (param $y f64) (result f64) (f64.min (get_local $x) (get_local $y))) - (func $f64.max (param $x f64) (param $y f64) (result f64) (f64.max (get_local $x) (get_local $y))) - - (export "f32.add" $f32.add) - (export "f32.sub" $f32.sub) - (export "f32.mul" $f32.mul) - (export "f32.div" $f32.div) - (export "f32.sqrt" $f32.sqrt) - (export "f32.abs" $f32.abs) - (export "f32.neg" $f32.neg) - (export "f32.copysign" $f32.copysign) - (export "f32.ceil" $f32.ceil) - (export "f32.floor" $f32.floor) - (export "f32.trunc" $f32.trunc) - (export "f32.nearest" $f32.nearest) - (export "f32.min" $f32.min) - (export "f32.max" $f32.max) - - (export "f64.add" $f64.add) - (export "f64.sub" $f64.sub) - (export "f64.mul" $f64.mul) - (export "f64.div" $f64.div) - (export "f64.sqrt" $f64.sqrt) - (export "f64.abs" $f64.abs) - (export "f64.neg" $f64.neg) - (export "f64.copysign" $f64.copysign) - (export "f64.ceil" $f64.ceil) - (export "f64.floor" $f64.floor) - (export "f64.trunc" $f64.trunc) - (export "f64.nearest" $f64.nearest) - (export "f64.min" $f64.min) - (export "f64.max" $f64.max) + (func "f32.add" (param $x f32) (param $y f32) (result f32) (f32.add (get_local $x) (get_local $y))) + (func "f32.sub" (param $x f32) (param $y f32) (result f32) (f32.sub (get_local $x) (get_local $y))) + (func "f32.mul" (param $x f32) (param $y f32) (result f32) (f32.mul (get_local $x) (get_local $y))) + (func "f32.div" (param $x f32) (param $y f32) (result f32) (f32.div (get_local $x) (get_local $y))) + (func "f32.sqrt" (param $x f32) (result f32) (f32.sqrt (get_local $x))) + (func "f32.abs" (param $x f32) (result f32) (f32.abs (get_local $x))) + (func "f32.neg" (param $x f32) (result f32) (f32.neg (get_local $x))) + (func "f32.copysign" (param $x f32) (param $y f32) (result f32) (f32.copysign (get_local $x) (get_local $y))) + (func "f32.ceil" (param $x f32) (result f32) (f32.ceil (get_local $x))) + (func "f32.floor" (param $x f32) (result f32) (f32.floor (get_local $x))) + (func "f32.trunc" (param $x f32) (result f32) (f32.trunc (get_local $x))) + (func "f32.nearest" (param $x f32) (result f32) (f32.nearest (get_local $x))) + (func "f32.min" (param $x f32) (param $y f32) (result f32) (f32.min (get_local $x) (get_local $y))) + (func "f32.max" (param $x f32) (param $y f32) (result f32) (f32.max (get_local $x) (get_local $y))) + + (func "f64.add" (param $x f64) (param $y f64) (result f64) (f64.add (get_local $x) (get_local $y))) + (func "f64.sub" (param $x f64) (param $y f64) (result f64) (f64.sub (get_local $x) (get_local $y))) + (func "f64.mul" (param $x f64) (param $y f64) (result f64) (f64.mul (get_local $x) (get_local $y))) + (func "f64.div" (param $x f64) (param $y f64) (result f64) (f64.div (get_local $x) (get_local $y))) + (func "f64.sqrt" (param $x f64) (result f64) (f64.sqrt (get_local $x))) + (func "f64.abs" (param $x f64) (result f64) (f64.abs (get_local $x))) + (func "f64.neg" (param $x f64) (result f64) (f64.neg (get_local $x))) + (func "f64.copysign" (param $x f64) (param $y f64) (result f64) (f64.copysign (get_local $x) (get_local $y))) + (func "f64.ceil" (param $x f64) (result f64) (f64.ceil (get_local $x))) + (func "f64.floor" (param $x f64) (result f64) (f64.floor (get_local $x))) + (func "f64.trunc" (param $x f64) (result f64) (f64.trunc (get_local $x))) + (func "f64.nearest" (param $x f64) (result f64) (f64.nearest (get_local $x))) + (func "f64.min" (param $x f64) (param $y f64) (result f64) (f64.min (get_local $x) (get_local $y))) + (func "f64.max" (param $x f64) (param $y f64) (result f64) (f64.max (get_local $x) (get_local $y))) ) ;; Miscellaneous values. diff --git a/ml-proto/test/forward.wast b/ml-proto/test/forward.wast index d5ba73b72b..5713f46603 100644 --- a/ml-proto/test/forward.wast +++ b/ml-proto/test/forward.wast @@ -1,15 +1,12 @@ (module - (export "even" $even) - (export "odd" $odd) - - (func $even (param $n i32) (result i32) + (func "even" $even (param $n i32) (result i32) (if (i32.eq (get_local $n) (i32.const 0)) (i32.const 1) (call $odd (i32.sub (get_local $n) (i32.const 1))) ) ) - (func $odd (param $n i32) (result i32) + (func "odd" $odd (param $n i32) (result i32) (if (i32.eq (get_local $n) (i32.const 0)) (i32.const 0) (call $even (i32.sub (get_local $n) (i32.const 1))) diff --git a/ml-proto/test/func_ptrs.wast b/ml-proto/test/func_ptrs.wast index 841c74ecbf..9ba02adf04 100644 --- a/ml-proto/test/func_ptrs.wast +++ b/ml-proto/test/func_ptrs.wast @@ -7,6 +7,8 @@ (type $T (func (param i32) (result i32))) ;; 5: i32 -> i32 (type $U (func (param i32))) ;; 6: i32 -> void + (import $print "spectest" "print" (func (type 6))) + (func (type 0)) (func (type $S)) @@ -19,16 +21,15 @@ (i32.sub (get_local 0) (i32.const 2)) ) - (import $print "spectest" "print" (type 6)) - (func "four" (type $U) (call_import $print (get_local 0))) + (func "four" (type $U) (call $print (get_local 0))) ) (assert_return (invoke "one") (i32.const 13)) (assert_return (invoke "two" (i32.const 13)) (i32.const 14)) (assert_return (invoke "three" (i32.const 13)) (i32.const 11)) (invoke "four" (i32.const 83)) -(assert_invalid (module (elem (i32.const 0))) "no table defined") -(assert_invalid (module (elem (i32.const 0) 0) (func)) "no table defined") +(assert_invalid (module (elem (i32.const 0))) "unknown table") +(assert_invalid (module (elem (i32.const 0) 0) (func)) "unknown table") (assert_invalid (module (table 1 anyfunc) (elem (i64.const 0))) @@ -43,8 +44,8 @@ "constant expression required" ) -(assert_invalid (module (func (type 42))) "unknown function type 42") -(assert_invalid (module (import "spectest" "print" (type 43))) "unknown function type 43") +(assert_invalid (module (func (type 42))) "unknown type") +(assert_invalid (module (import "spectest" "print" (func (type 43)))) "unknown type") (module (type $T (func (param) (result i32))) @@ -92,8 +93,6 @@ (type $T (func (result i32))) (table anyfunc (elem 0 1)) - (import $print_i32 "spectest" "print" (param i32)) - (func $t1 (type $T) (i32.const 1)) (func $t2 (type $T) (i32.const 2)) diff --git a/ml-proto/test/i32.wast b/ml-proto/test/i32.wast index f77dff24de..9b57ae5a39 100644 --- a/ml-proto/test/i32.wast +++ b/ml-proto/test/i32.wast @@ -1,65 +1,35 @@ ;; i32 operations (module - (func $add (param $x i32) (param $y i32) (result i32) (i32.add (get_local $x) (get_local $y))) - (func $sub (param $x i32) (param $y i32) (result i32) (i32.sub (get_local $x) (get_local $y))) - (func $mul (param $x i32) (param $y i32) (result i32) (i32.mul (get_local $x) (get_local $y))) - (func $div_s (param $x i32) (param $y i32) (result i32) (i32.div_s (get_local $x) (get_local $y))) - (func $div_u (param $x i32) (param $y i32) (result i32) (i32.div_u (get_local $x) (get_local $y))) - (func $rem_s (param $x i32) (param $y i32) (result i32) (i32.rem_s (get_local $x) (get_local $y))) - (func $rem_u (param $x i32) (param $y i32) (result i32) (i32.rem_u (get_local $x) (get_local $y))) - (func $and (param $x i32) (param $y i32) (result i32) (i32.and (get_local $x) (get_local $y))) - (func $or (param $x i32) (param $y i32) (result i32) (i32.or (get_local $x) (get_local $y))) - (func $xor (param $x i32) (param $y i32) (result i32) (i32.xor (get_local $x) (get_local $y))) - (func $shl (param $x i32) (param $y i32) (result i32) (i32.shl (get_local $x) (get_local $y))) - (func $shr_s (param $x i32) (param $y i32) (result i32) (i32.shr_s (get_local $x) (get_local $y))) - (func $shr_u (param $x i32) (param $y i32) (result i32) (i32.shr_u (get_local $x) (get_local $y))) - (func $rotl (param $x i32) (param $y i32) (result i32) (i32.rotl (get_local $x) (get_local $y))) - (func $rotr (param $x i32) (param $y i32) (result i32) (i32.rotr (get_local $x) (get_local $y))) - (func $clz (param $x i32) (result i32) (i32.clz (get_local $x))) - (func $ctz (param $x i32) (result i32) (i32.ctz (get_local $x))) - (func $popcnt (param $x i32) (result i32) (i32.popcnt (get_local $x))) - (func $eqz (param $x i32) (result i32) (i32.eqz (get_local $x))) - (func $eq (param $x i32) (param $y i32) (result i32) (i32.eq (get_local $x) (get_local $y))) - (func $ne (param $x i32) (param $y i32) (result i32) (i32.ne (get_local $x) (get_local $y))) - (func $lt_s (param $x i32) (param $y i32) (result i32) (i32.lt_s (get_local $x) (get_local $y))) - (func $lt_u (param $x i32) (param $y i32) (result i32) (i32.lt_u (get_local $x) (get_local $y))) - (func $le_s (param $x i32) (param $y i32) (result i32) (i32.le_s (get_local $x) (get_local $y))) - (func $le_u (param $x i32) (param $y i32) (result i32) (i32.le_u (get_local $x) (get_local $y))) - (func $gt_s (param $x i32) (param $y i32) (result i32) (i32.gt_s (get_local $x) (get_local $y))) - (func $gt_u (param $x i32) (param $y i32) (result i32) (i32.gt_u (get_local $x) (get_local $y))) - (func $ge_s (param $x i32) (param $y i32) (result i32) (i32.ge_s (get_local $x) (get_local $y))) - (func $ge_u (param $x i32) (param $y i32) (result i32) (i32.ge_u (get_local $x) (get_local $y))) - - (export "add" $add) - (export "sub" $sub) - (export "mul" $mul) - (export "div_s" $div_s) - (export "div_u" $div_u) - (export "rem_s" $rem_s) - (export "rem_u" $rem_u) - (export "and" $and) - (export "or" $or) - (export "xor" $xor) - (export "shl" $shl) - (export "shr_s" $shr_s) - (export "shr_u" $shr_u) - (export "rotl" $rotl) - (export "rotr" $rotr) - (export "clz" $clz) - (export "ctz" $ctz) - (export "popcnt" $popcnt) - (export "eqz" $eqz) - (export "eq" $eq) - (export "ne" $ne) - (export "lt_s" $lt_s) - (export "lt_u" $lt_u) - (export "le_s" $le_s) - (export "le_u" $le_u) - (export "gt_s" $gt_s) - (export "gt_u" $gt_u) - (export "ge_s" $ge_s) - (export "ge_u" $ge_u) + (func "add" (param $x i32) (param $y i32) (result i32) (i32.add (get_local $x) (get_local $y))) + (func "sub" (param $x i32) (param $y i32) (result i32) (i32.sub (get_local $x) (get_local $y))) + (func "mul" (param $x i32) (param $y i32) (result i32) (i32.mul (get_local $x) (get_local $y))) + (func "div_s" (param $x i32) (param $y i32) (result i32) (i32.div_s (get_local $x) (get_local $y))) + (func "div_u" (param $x i32) (param $y i32) (result i32) (i32.div_u (get_local $x) (get_local $y))) + (func "rem_s" (param $x i32) (param $y i32) (result i32) (i32.rem_s (get_local $x) (get_local $y))) + (func "rem_u" (param $x i32) (param $y i32) (result i32) (i32.rem_u (get_local $x) (get_local $y))) + (func "and" (param $x i32) (param $y i32) (result i32) (i32.and (get_local $x) (get_local $y))) + (func "or" (param $x i32) (param $y i32) (result i32) (i32.or (get_local $x) (get_local $y))) + (func "xor" (param $x i32) (param $y i32) (result i32) (i32.xor (get_local $x) (get_local $y))) + (func "shl" (param $x i32) (param $y i32) (result i32) (i32.shl (get_local $x) (get_local $y))) + (func "shr_s" (param $x i32) (param $y i32) (result i32) (i32.shr_s (get_local $x) (get_local $y))) + (func "shr_u" (param $x i32) (param $y i32) (result i32) (i32.shr_u (get_local $x) (get_local $y))) + (func "rotl" (param $x i32) (param $y i32) (result i32) (i32.rotl (get_local $x) (get_local $y))) + (func "rotr" (param $x i32) (param $y i32) (result i32) (i32.rotr (get_local $x) (get_local $y))) + (func "clz" (param $x i32) (result i32) (i32.clz (get_local $x))) + (func "ctz" (param $x i32) (result i32) (i32.ctz (get_local $x))) + (func "popcnt" (param $x i32) (result i32) (i32.popcnt (get_local $x))) + (func "eqz" (param $x i32) (result i32) (i32.eqz (get_local $x))) + (func "eq" (param $x i32) (param $y i32) (result i32) (i32.eq (get_local $x) (get_local $y))) + (func "ne" (param $x i32) (param $y i32) (result i32) (i32.ne (get_local $x) (get_local $y))) + (func "lt_s" (param $x i32) (param $y i32) (result i32) (i32.lt_s (get_local $x) (get_local $y))) + (func "lt_u" (param $x i32) (param $y i32) (result i32) (i32.lt_u (get_local $x) (get_local $y))) + (func "le_s" (param $x i32) (param $y i32) (result i32) (i32.le_s (get_local $x) (get_local $y))) + (func "le_u" (param $x i32) (param $y i32) (result i32) (i32.le_u (get_local $x) (get_local $y))) + (func "gt_s" (param $x i32) (param $y i32) (result i32) (i32.gt_s (get_local $x) (get_local $y))) + (func "gt_u" (param $x i32) (param $y i32) (result i32) (i32.gt_u (get_local $x) (get_local $y))) + (func "ge_s" (param $x i32) (param $y i32) (result i32) (i32.ge_s (get_local $x) (get_local $y))) + (func "ge_u" (param $x i32) (param $y i32) (result i32) (i32.ge_u (get_local $x) (get_local $y))) ) (assert_return (invoke "add" (i32.const 1) (i32.const 1)) (i32.const 2)) diff --git a/ml-proto/test/i64.wast b/ml-proto/test/i64.wast index f8b9621839..d843d35c15 100644 --- a/ml-proto/test/i64.wast +++ b/ml-proto/test/i64.wast @@ -1,65 +1,35 @@ ;; i64 operations (module - (func $add (param $x i64) (param $y i64) (result i64) (i64.add (get_local $x) (get_local $y))) - (func $sub (param $x i64) (param $y i64) (result i64) (i64.sub (get_local $x) (get_local $y))) - (func $mul (param $x i64) (param $y i64) (result i64) (i64.mul (get_local $x) (get_local $y))) - (func $div_s (param $x i64) (param $y i64) (result i64) (i64.div_s (get_local $x) (get_local $y))) - (func $div_u (param $x i64) (param $y i64) (result i64) (i64.div_u (get_local $x) (get_local $y))) - (func $rem_s (param $x i64) (param $y i64) (result i64) (i64.rem_s (get_local $x) (get_local $y))) - (func $rem_u (param $x i64) (param $y i64) (result i64) (i64.rem_u (get_local $x) (get_local $y))) - (func $and (param $x i64) (param $y i64) (result i64) (i64.and (get_local $x) (get_local $y))) - (func $or (param $x i64) (param $y i64) (result i64) (i64.or (get_local $x) (get_local $y))) - (func $xor (param $x i64) (param $y i64) (result i64) (i64.xor (get_local $x) (get_local $y))) - (func $shl (param $x i64) (param $y i64) (result i64) (i64.shl (get_local $x) (get_local $y))) - (func $shr_s (param $x i64) (param $y i64) (result i64) (i64.shr_s (get_local $x) (get_local $y))) - (func $shr_u (param $x i64) (param $y i64) (result i64) (i64.shr_u (get_local $x) (get_local $y))) - (func $rotl (param $x i64) (param $y i64) (result i64) (i64.rotl (get_local $x) (get_local $y))) - (func $rotr (param $x i64) (param $y i64) (result i64) (i64.rotr (get_local $x) (get_local $y))) - (func $clz (param $x i64) (result i64) (i64.clz (get_local $x))) - (func $ctz (param $x i64) (result i64) (i64.ctz (get_local $x))) - (func $popcnt (param $x i64) (result i64) (i64.popcnt (get_local $x))) - (func $eqz (param $x i64) (result i32) (i64.eqz (get_local $x))) - (func $eq (param $x i64) (param $y i64) (result i32) (i64.eq (get_local $x) (get_local $y))) - (func $ne (param $x i64) (param $y i64) (result i32) (i64.ne (get_local $x) (get_local $y))) - (func $lt_s (param $x i64) (param $y i64) (result i32) (i64.lt_s (get_local $x) (get_local $y))) - (func $lt_u (param $x i64) (param $y i64) (result i32) (i64.lt_u (get_local $x) (get_local $y))) - (func $le_s (param $x i64) (param $y i64) (result i32) (i64.le_s (get_local $x) (get_local $y))) - (func $le_u (param $x i64) (param $y i64) (result i32) (i64.le_u (get_local $x) (get_local $y))) - (func $gt_s (param $x i64) (param $y i64) (result i32) (i64.gt_s (get_local $x) (get_local $y))) - (func $gt_u (param $x i64) (param $y i64) (result i32) (i64.gt_u (get_local $x) (get_local $y))) - (func $ge_s (param $x i64) (param $y i64) (result i32) (i64.ge_s (get_local $x) (get_local $y))) - (func $ge_u (param $x i64) (param $y i64) (result i32) (i64.ge_u (get_local $x) (get_local $y))) - - (export "add" $add) - (export "sub" $sub) - (export "mul" $mul) - (export "div_s" $div_s) - (export "div_u" $div_u) - (export "rem_s" $rem_s) - (export "rem_u" $rem_u) - (export "and" $and) - (export "or" $or) - (export "xor" $xor) - (export "shl" $shl) - (export "shr_s" $shr_s) - (export "shr_u" $shr_u) - (export "rotl" $rotl) - (export "rotr" $rotr) - (export "clz" $clz) - (export "ctz" $ctz) - (export "popcnt" $popcnt) - (export "eqz" $eqz) - (export "eq" $eq) - (export "ne" $ne) - (export "lt_s" $lt_s) - (export "lt_u" $lt_u) - (export "le_s" $le_s) - (export "le_u" $le_u) - (export "gt_s" $gt_s) - (export "gt_u" $gt_u) - (export "ge_s" $ge_s) - (export "ge_u" $ge_u) + (func "add" (param $x i64) (param $y i64) (result i64) (i64.add (get_local $x) (get_local $y))) + (func "sub" (param $x i64) (param $y i64) (result i64) (i64.sub (get_local $x) (get_local $y))) + (func "mul" (param $x i64) (param $y i64) (result i64) (i64.mul (get_local $x) (get_local $y))) + (func "div_s" (param $x i64) (param $y i64) (result i64) (i64.div_s (get_local $x) (get_local $y))) + (func "div_u" (param $x i64) (param $y i64) (result i64) (i64.div_u (get_local $x) (get_local $y))) + (func "rem_s" (param $x i64) (param $y i64) (result i64) (i64.rem_s (get_local $x) (get_local $y))) + (func "rem_u" (param $x i64) (param $y i64) (result i64) (i64.rem_u (get_local $x) (get_local $y))) + (func "and" (param $x i64) (param $y i64) (result i64) (i64.and (get_local $x) (get_local $y))) + (func "or" (param $x i64) (param $y i64) (result i64) (i64.or (get_local $x) (get_local $y))) + (func "xor" (param $x i64) (param $y i64) (result i64) (i64.xor (get_local $x) (get_local $y))) + (func "shl" (param $x i64) (param $y i64) (result i64) (i64.shl (get_local $x) (get_local $y))) + (func "shr_s" (param $x i64) (param $y i64) (result i64) (i64.shr_s (get_local $x) (get_local $y))) + (func "shr_u" (param $x i64) (param $y i64) (result i64) (i64.shr_u (get_local $x) (get_local $y))) + (func "rotl" (param $x i64) (param $y i64) (result i64) (i64.rotl (get_local $x) (get_local $y))) + (func "rotr" (param $x i64) (param $y i64) (result i64) (i64.rotr (get_local $x) (get_local $y))) + (func "clz" (param $x i64) (result i64) (i64.clz (get_local $x))) + (func "ctz" (param $x i64) (result i64) (i64.ctz (get_local $x))) + (func "popcnt" (param $x i64) (result i64) (i64.popcnt (get_local $x))) + (func "eqz" (param $x i64) (result i32) (i64.eqz (get_local $x))) + (func "eq" (param $x i64) (param $y i64) (result i32) (i64.eq (get_local $x) (get_local $y))) + (func "ne" (param $x i64) (param $y i64) (result i32) (i64.ne (get_local $x) (get_local $y))) + (func "lt_s" (param $x i64) (param $y i64) (result i32) (i64.lt_s (get_local $x) (get_local $y))) + (func "lt_u" (param $x i64) (param $y i64) (result i32) (i64.lt_u (get_local $x) (get_local $y))) + (func "le_s" (param $x i64) (param $y i64) (result i32) (i64.le_s (get_local $x) (get_local $y))) + (func "le_u" (param $x i64) (param $y i64) (result i32) (i64.le_u (get_local $x) (get_local $y))) + (func "gt_s" (param $x i64) (param $y i64) (result i32) (i64.gt_s (get_local $x) (get_local $y))) + (func "gt_u" (param $x i64) (param $y i64) (result i32) (i64.gt_u (get_local $x) (get_local $y))) + (func "ge_s" (param $x i64) (param $y i64) (result i32) (i64.ge_s (get_local $x) (get_local $y))) + (func "ge_u" (param $x i64) (param $y i64) (result i32) (i64.ge_u (get_local $x) (get_local $y))) ) (assert_return (invoke "add" (i64.const 1) (i64.const 1)) (i64.const 2)) diff --git a/ml-proto/test/imports.wast b/ml-proto/test/imports.wast index daea04831b..3acc2454cb 100644 --- a/ml-proto/test/imports.wast +++ b/ml-proto/test/imports.wast @@ -1,24 +1,24 @@ (module - (import $print_i32 "spectest" "print" (param i32)) - (import $print_i64 "spectest" "print" (param i64)) - (import $print_i32_f32 "spectest" "print" (param i32 f32)) - (import $print_i64_f64 "spectest" "print" (param i64 f64)) - (func $print32 (param $i i32) - (call_import $print_i32_f32 + (import $print_i32 "spectest" "print" (func (param i32))) + (import $print_i64 "spectest" "print" (func (param i64))) + (import $print_i32_f32 "spectest" "print" (func (param i32 f32))) + (import $print_i64_f64 "spectest" "print" (func (param i64 f64))) + + (func "print32" (param $i i32) + (call $print_i32_f32 (i32.add (get_local $i) (i32.const 1)) (f32.const 42) ) - (call_import $print_i32 (get_local $i)) + (call $print_i32 (get_local $i)) ) - (func $print64 (param $i i64) - (call_import $print_i64_f64 + + (func "print64" (param $i i64) + (call $print_i64_f64 (i64.add (get_local $i) (i64.const 1)) (f64.const 53) ) - (call_import $print_i64 (get_local $i)) + (call $print_i64 (get_local $i)) ) - (export "print32" $print32) - (export "print64" $print64) ) (assert_return (invoke "print32" (i32.const 13))) diff --git a/ml-proto/test/int_exprs.wast b/ml-proto/test/int_exprs.wast index ac05baf984..bce6146e1f 100644 --- a/ml-proto/test/int_exprs.wast +++ b/ml-proto/test/int_exprs.wast @@ -4,19 +4,15 @@ ;; Test that x+1>n is not folded to x (module - (func $i32.no_fold_shl_shr_s (param $x i32) (result i32) + (func "i32.no_fold_shl_shr_s" (param $x i32) (result i32) (i32.shr_s (i32.shl (get_local $x) (i32.const 1)) (i32.const 1))) - (export "i32.no_fold_shl_shr_s" $i32.no_fold_shl_shr_s) - (func $i32.no_fold_shl_shr_u (param $x i32) (result i32) + (func "i32.no_fold_shl_shr_u" (param $x i32) (result i32) (i32.shr_u (i32.shl (get_local $x) (i32.const 1)) (i32.const 1))) - (export "i32.no_fold_shl_shr_u" $i32.no_fold_shl_shr_u) - (func $i64.no_fold_shl_shr_s (param $x i64) (result i64) + (func "i64.no_fold_shl_shr_s" (param $x i64) (result i64) (i64.shr_s (i64.shl (get_local $x) (i64.const 1)) (i64.const 1))) - (export "i64.no_fold_shl_shr_s" $i64.no_fold_shl_shr_s) - (func $i64.no_fold_shl_shr_u (param $x i64) (result i64) + (func "i64.no_fold_shl_shr_u" (param $x i64) (result i64) (i64.shr_u (i64.shl (get_local $x) (i64.const 1)) (i64.const 1))) - (export "i64.no_fold_shl_shr_u" $i64.no_fold_shl_shr_u) ) (assert_return (invoke "i32.no_fold_shl_shr_s" (i32.const 0x80000000)) (i32.const 0)) @@ -71,19 +61,15 @@ ;; Test that x>>n<