Add import section to modules

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)
   ( <type>.switch <expr> <case>* <expr> )
   ( call <var> <expr>* )
+  ( call_import <var> <expr>* )
   ( call_indirect <var> <expr> <expr>* )
   ( return <expr>? )
   ( get_local <var> )
@@ -194,7 +196,8 @@ param:  ( param <type>* ) | ( param <name> <type> )
 result: ( result <type> )
 local:  ( local <type>* ) | ( local <name> <type> )
 
-module: ( module <func>* <global>* <export>* <table>* <memory>? <data>* )
+module: ( module <func>* <global>* <import>* <export>* <table>* <memory>? <data>* )
+import: ( import <name>? "<module_name>" "<func_name>" (param <type>* ) (result <type>)* )
 export: ( export "<char>*" <var> )
 global: ( global <type>* ) | ( global <name> <type> )
 table:  ( table <var>* )
@@ -227,8 +230,8 @@ script: <cmd>*
 cmd:
   <module>                                       ;; define, validate, and initialize module
   ( invoke <name> <expr>* )                      ;; invoke export and print result
-  ( asserteq (invoke <name> <expr>* ) <expr> )   ;; assert expected results of invocation
-  ( assertinvalid <module> <failure> )           ;; assert invalid module with given failure string
+  ( assert_eq (invoke <name> <expr>* ) <expr> )  ;; assert expected results of invocation
+  ( assert_invalid <module> <failure> )          ;; assert invalid module with given failure string
 ```
 
 Invocation is only possible after a module has been defined.

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

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

ml-proto/src/host/builtins.mli

@@ -0,0 +1 @@
+val match_imports : Ast.import list -> Eval.import list

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 }
 

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,14 +92,15 @@ 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}
 %}
 
 %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} }

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...";

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,13 +128,23 @@ 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
 and modul' =
 {
   memory : memory option;
   funcs : func list;
+  imports : import list;
   exports : export list;
   tables : table list;
   globals : value_type list

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,14 +27,15 @@ type context =
 }
 
 let c0 =
-  {funcs = []; globals = []; tables = [];
+  {funcs = []; imports = []; globals = []; tables = [];
    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 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;

ml-proto/src/spec/eval.ml

@@ -13,13 +13,15 @@ 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
 
 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 []

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 *)

ml-proto/test/expected-output/imports.wasm.log

@@ -0,0 +1,3 @@
+13 : i32
+14 : i32
+42. : f32

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))