diff --git a/ml-proto/README.md b/ml-proto/README.md index 4841d572de..b36091b904 100644 --- a/ml-proto/README.md +++ b/ml-proto/README.md @@ -120,6 +120,7 @@ type expr = | Break of int * expr option (* break to n-th surrounding label | Switch of expr * arm list * expr (* switch, latter expr is default | 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 | Return of expr option (* return 0 to many value | GetParam of var (* read parameter @@ -171,6 +172,7 @@ expr: ( break ) ;; = (break 0) ( .switch * ) ( call * ) + ( call_import * ) ( call_indirect * ) ( return ? ) ( get_local ) @@ -194,7 +196,8 @@ param: ( param * ) | ( param ) result: ( result ) local: ( local * ) | ( local ) -module: ( module * * * * ? * ) +module: ( module * * * *
* ? * ) +import: ( import ? "" "" (param * ) (result )* ) export: ( export "*" ) global: ( global * ) | ( global ) table: ( table * ) @@ -227,8 +230,8 @@ script: * cmd: ;; define, validate, and initialize module ( invoke * ) ;; invoke export and print result - ( asserteq (invoke * ) ) ;; assert expected results of invocation - ( assertinvalid ) ;; assert invalid module with given failure string + ( assert_eq (invoke * ) ) ;; assert expected results of invocation + ( assert_invalid ) ;; assert invalid module with given failure string ``` Invocation is only possible after a module has been defined. diff --git a/ml-proto/src/Makefile b/ml-proto/src/Makefile index 2b8ec820ee..a1837d6b6d 100644 --- a/ml-proto/src/Makefile +++ b/ml-proto/src/Makefile @@ -7,7 +7,8 @@ INCLUDES = -I host -I given -I spec MODULES = \ host/flags given/lib given/source spec/error \ spec/types spec/values spec/memory spec/ast \ - spec/check spec/arithmetic spec/eval host/print host/script \ + spec/check spec/arithmetic spec/eval \ + host/print host/builtins host/script \ host/lexer host/parser \ host/main NOMLI = host/flags spec/types spec/values spec/ast host/main diff --git a/ml-proto/src/host/builtins.ml b/ml-proto/src/host/builtins.ml new file mode 100644 index 0000000000..fa599e7987 --- /dev/null +++ b/ml-proto/src/host/builtins.ml @@ -0,0 +1,20 @@ +open Source + +let print vs = + List.iter Print.print_value (List.map (fun v -> Some v) vs); + None + +let match_import i = + let {Ast.module_name; func_name; func_params; func_result} = i.it in + if module_name <> "stdio" then + Error.error i.at ("no builtin module \"" ^ module_name ^ "\""); + match func_name with + | "print" -> + if func_result <> None then + Error.error i.at "stdio.print has no result"; + print + | _ -> + Error.error i.at ("no stdio." ^ func_name ^ "\"") + +let match_imports (is : Ast.import list) = + List.map match_import is diff --git a/ml-proto/src/host/builtins.mli b/ml-proto/src/host/builtins.mli new file mode 100644 index 0000000000..90815b9170 --- /dev/null +++ b/ml-proto/src/host/builtins.mli @@ -0,0 +1 @@ +val match_imports : Ast.import list -> Eval.import list diff --git a/ml-proto/src/host/lexer.mll b/ml-proto/src/host/lexer.mll index cd0954de1a..84bce60106 100644 --- a/ml-proto/src/host/lexer.mll +++ b/ml-proto/src/host/lexer.mll @@ -129,6 +129,7 @@ rule token = parse | "case" { CASE } | "fallthrough" { FALLTHROUGH } | "call" { CALL } + | "call_import" { CALLIMPORT } | "call_indirect" { CALLINDIRECT } | "return" { RETURN } diff --git a/ml-proto/src/host/parser.mly b/ml-proto/src/host/parser.mly index 64e0466611..897bf4dddf 100644 --- a/ml-proto/src/host/parser.mly +++ b/ml-proto/src/host/parser.mly @@ -48,12 +48,14 @@ module VarMap = Map.Make(String) type space = {mutable map : int VarMap.t; mutable count : int} type context = - {funcs : space; globals : space; locals : space; labels : int VarMap.t} + {funcs : space; imports : space; globals : space; locals : space; + labels : int VarMap.t} let empty () = {map = VarMap.empty; count = 0} let c0 () = - {funcs = empty (); globals = empty (); - locals = empty (); labels = VarMap.empty} + {funcs = empty (); imports = empty (); + globals = empty (); locals = empty (); + labels = VarMap.empty} let enter_func c = assert (VarMap.is_empty c.labels); @@ -64,6 +66,7 @@ let lookup category space x = with Not_found -> Error.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 global c x = lookup "global" c.globals x let local c x = lookup "local" c.locals x let table c x = lookup "table" (empty ()) x @@ -78,6 +81,7 @@ 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_global c x = bind "global" c.globals x let bind_local c x = bind "local" c.locals x let bind_label c x = @@ -88,6 +92,7 @@ let bind_label c x = 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_globals c ts = anon c.globals (List.length ts) let anon_locals c ts = anon c.locals (List.length ts) let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels} @@ -95,7 +100,7 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels} %token INT FLOAT TEXT VAR TYPE LPAR RPAR %token NOP BLOCK IF LOOP LABEL BREAK SWITCH CASE FALLTHROUGH -%token CALL CALLINDIRECT RETURN +%token CALL CALLIMPORT CALLINDIRECT RETURN %token GETLOCAL SETLOCAL LOADGLOBAL STOREGLOBAL LOAD STORE %token CONST UNARY BINARY COMPARE CONVERT %token FUNC PARAM RESULT LOCAL MODULE MEMORY SEGMENT GLOBAL IMPORT EXPORT TABLE @@ -171,6 +176,7 @@ oper : fun c -> let x, y = $3 c in Switch ($1 @@ at1, $2 c, List.map (fun a -> a $1) x, y) } | CALL var expr_list { fun c -> Call ($2 c func, $3 c) } + | CALLIMPORT var expr_list { fun c -> CallImport ($2 c import, $3 c) } | CALLINDIRECT var expr expr_list { fun c -> CallIndirect ($2 c table, $3 c, $4 c) } | RETURN expr_opt { fun c -> Return ($2 c) } @@ -277,6 +283,24 @@ memory : @@ at() } ; +func_params : + | LPAR PARAM value_type_list RPAR { $3 } +; +func_result : + | /* empty */ { None } + | LPAR RESULT value_type RPAR { Some $3 } +; +import : + | LPAR IMPORT bind_var TEXT TEXT func_params func_result RPAR + { let at = at() in fun c -> bind_import c $3; + {module_name = $4; func_name = $5; func_params = $6; func_result = $7 } + @@ at } + | LPAR IMPORT TEXT TEXT func_params func_result RPAR /* Sugar */ + { let at = at() in fun c -> anon_import c; + {module_name = $3; func_name = $4; func_params = $5; func_result = $6 } + @@ at } +; + export : | LPAR EXPORT TEXT var RPAR { let at = at() in fun c -> {name = $3; func = $4 c func} @@ at } @@ -285,10 +309,14 @@ export : module_fields : | /* empty */ { fun c -> - {memory = None; funcs = []; exports = []; globals = []; tables = []} } + {imports = []; exports = []; globals = []; tables = []; funcs = []; + memory = None} } | func module_fields { fun c -> let f = $1 c in let m = $2 c in {m with funcs = f () :: m.funcs} } + | import module_fields + { fun c -> let i = $1 c in let m = $2 c in + {m with imports = i :: m.imports} } | export module_fields { fun c -> let m = $2 c in {m with exports = $1 c :: m.exports} } diff --git a/ml-proto/src/host/script.ml b/ml-proto/src/host/script.ml index c068d2fe7c..238c7251eb 100644 --- a/ml-proto/src/host/script.ml +++ b/ml-proto/src/host/script.ml @@ -39,7 +39,8 @@ let run_command cmd = Print.print_module_sig m end; trace "Initializing..."; - current_module := Some (Eval.init m) + let imports = Builtins.match_imports m.it.Ast.imports in + current_module := Some (Eval.init m imports) | AssertInvalid (m, re) -> trace "Checking invalid..."; diff --git a/ml-proto/src/spec/ast.ml b/ml-proto/src/spec/ast.ml index 69c1f7b3fc..75b9a38f79 100644 --- a/ml-proto/src/spec/ast.ml +++ b/ml-proto/src/spec/ast.ml @@ -81,6 +81,7 @@ and expr' = | Break of var * expr option | Switch of value_type * expr * arm list * expr | Call of var * expr list + | CallImport of var * expr list | CallIndirect of var * expr * expr list | Return of expr option | GetLocal of var @@ -127,6 +128,15 @@ and func' = type export = export' Source.phrase and export' = {name : string; func : var} +type import = import' Source.phrase +and import' = +{ + module_name : string; + func_name : string; + func_params : value_type list; + func_result : expr_type; +} + type table = var list Source.phrase type modul = modul' Source.phrase @@ -134,6 +144,7 @@ and modul' = { memory : memory option; funcs : func list; + imports : import list; exports : export list; tables : table list; globals : value_type list diff --git a/ml-proto/src/spec/check.ml b/ml-proto/src/spec/check.ml index 756afe1793..6c416b1934 100644 --- a/ml-proto/src/spec/check.ml +++ b/ml-proto/src/spec/check.ml @@ -18,6 +18,7 @@ let require b at s = if not b then error at s type context = { funcs : func_type list; + imports : func_type list; globals : value_type list; tables : func_type list; locals : value_type list; @@ -26,7 +27,7 @@ type context = } let c0 = - {funcs = []; globals = []; tables = []; + {funcs = []; imports = []; globals = []; tables = []; locals = []; return = None; labels = []} let lookup category list x = @@ -34,6 +35,7 @@ let lookup category list x = error x.at ("unknown " ^ category ^ " " ^ string_of_int 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 @@ -108,6 +110,10 @@ let type_func f = let {params; result; _} = f.it in {ins = List.map it params; out = Lib.Option.map it result} +let type_import f = + let {func_params; func_result; _} = f.it in + {ins = List.map it func_params; out = Lib.Option.map it func_result} + (* Type Analysis *) @@ -161,6 +167,11 @@ let rec check_expr c et e = check_exprs c ins es; check_type out et e.at + | CallImport (x, es) -> + let {ins; out} = import c x in + check_exprs c ins es; + check_type out et e.at + | CallIndirect (x, e1, es) -> let {ins; out} = table c x in check_expr c (Some Int32Type) e1; @@ -303,9 +314,10 @@ let check_memory memory = ignore (List.fold_left (check_segment memory.it.initial) 0 memory.it.segments) let check_module m = - let {funcs; exports; tables; globals; memory} = m.it in + let {imports; exports; globals; tables; funcs; memory} = m.it in Lib.Option.app check_memory memory; let c = {c0 with funcs = List.map type_func funcs; + imports = List.map type_import imports; globals = List.map it globals} in let c' = List.fold_left check_table c tables in List.iter (check_func c') funcs; diff --git a/ml-proto/src/spec/eval.ml b/ml-proto/src/spec/eval.ml index 32394ac3ad..c0037cff53 100644 --- a/ml-proto/src/spec/eval.ml +++ b/ml-proto/src/spec/eval.ml @@ -13,6 +13,7 @@ let error = Error.error type value = Values.value type func = Ast.func +type import = value list -> value option module ExportMap = Map.Make(String) type export_map = func ExportMap.t @@ -20,6 +21,7 @@ type export_map = func ExportMap.t type instance = { funcs : func list; + imports : import list; exports : export_map; tables : func list list; globals : value ref list; @@ -44,6 +46,7 @@ let lookup category list x = error x.at ("runtime: undefined " ^ category ^ " " ^ string_of_int x.it) let func c x = lookup "function" c.modul.funcs x +let import c x = lookup "import" c.modul.imports x let global c x = lookup "global" c.modul.globals x let table c x y = lookup "entry" (lookup "table" c.modul.tables x) y let local c x = lookup "local" c.locals x @@ -132,6 +135,10 @@ let rec eval_expr (c : config) (e : expr) = let vs = List.map (fun vo -> some (eval_expr c vo) vo.at) es in eval_func c.modul (func c x) vs + | CallImport (x, es) -> + let vs = List.map (fun ev -> some (eval_expr c ev) ev.at) es in + (import c x) vs + | 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 @@ -227,8 +234,9 @@ and eval_func (m : instance) (f : func) (evs : value list) = (* Modules *) -let init m = - let {Ast.funcs; exports; tables; globals; memory} = m.it in +let init m imports = + assert (List.length imports = List.length m.it.Ast.imports); + let {Ast.exports; globals; tables; funcs; memory; _} = m.it in let mem = match memory with | None -> Memory.create 0 @@ -242,7 +250,7 @@ let init m = let exports = List.fold_right export exports ExportMap.empty in let tables = List.map (fun tab -> List.map func tab.it) tables in let globals = List.map eval_decl globals in - {funcs; exports; tables; globals; memory = mem} + {funcs; imports; exports; tables; globals; memory = mem} let invoke m name vs = let f = export m (name @@ no_region) in @@ -252,5 +260,5 @@ let eval e = let f = {params = []; result = None; locals = []; body = e} @@ no_region in let memory = Memory.create 0 in let exports = ExportMap.singleton "eval" f in - let m = {funcs = [f]; exports; tables = []; globals = []; memory} in + let m = {imports = []; exports; globals = []; tables = []; funcs = [f]; memory} in eval_func m f [] diff --git a/ml-proto/src/spec/eval.mli b/ml-proto/src/spec/eval.mli index 145343b888..dc855592b2 100644 --- a/ml-proto/src/spec/eval.mli +++ b/ml-proto/src/spec/eval.mli @@ -4,8 +4,9 @@ type instance type value = Values.value +type import = value list -> value option -val init : Ast.modul -> instance +val init : Ast.modul -> import list -> instance val invoke : instance -> string -> value list -> value option (* raise Error.Error *) val eval : Ast.expr -> value option (* raise Error.Error *) diff --git a/ml-proto/test/expected-output/imports.wasm.log b/ml-proto/test/expected-output/imports.wasm.log new file mode 100644 index 0000000000..a7eaf5d94d --- /dev/null +++ b/ml-proto/test/expected-output/imports.wasm.log @@ -0,0 +1,3 @@ +13 : i32 +14 : i32 +42. : f32 diff --git a/ml-proto/test/imports.wasm b/ml-proto/test/imports.wasm new file mode 100644 index 0000000000..e086314e4a --- /dev/null +++ b/ml-proto/test/imports.wasm @@ -0,0 +1,14 @@ +(module + (import $print_i32 "stdio" "print" (param i32)) + (import $print_i32_f32 "stdio" "print" (param i32 f32)) + (func $print (param $i i32) + (call_import $print_i32 (get_local $i)) + (call_import $print_i32_f32 + (i32.add (get_local $i) (i32.const 1)) + (f32.const 42) + ) + ) + (export "print" $print) +) + +(invoke "print" (i32.const 13))