Implement import/export of tables, memories, globals

ml-proto/README.md

@@ -123,10 +123,10 @@ cvtop: trunc_s | trunc_u | extend_s | extend_u | ...
 expr:
   ( nop )
   ( block <name>? <expr>* )
-  ( loop <name1>? <name2>? <expr>* )          ;; = (block <name1>? (loop <name2>? (block <expr>*)))
+  ( loop <name>? <name>? <expr>* )          ;; = (block <name>? (loop <name>? (block <expr>*)))
   ( select <expr> <expr> <expr> )
   ( if <expr> ( then <name>? <expr>* ) ( else <name>? <expr>* )? )
-  ( if <expr1> <expr2> <expr3>? )             ;; = (if <expr1> (then <expr2>) (else <expr3>?))
+  ( if <expr> <expr> <expr>? )             ;; = (if <expr> (then <expr>) (else <expr>?))
   ( br <var> <expr>? )
   ( br_if <var> <expr>? <expr> )
   ( br_table <var> <var> <expr>? <expr> )
@@ -147,24 +147,49 @@ expr:
   ( current_memory )
   ( grow_memory <expr> )
 
-func:   ( func <name>? <sig> <local>* <expr>* )
-        ( func <string> <name>? <sig> <local>* <expr>* )  ;; = (export <string> <N>) (func <name>? <sig> <local>* <expr>*)
-sig:    ( type <var> ) | <param>* <result>?
-param:  ( param <type>* ) | ( param <name> <type> )
-result: ( result <type> )
-local:  ( local <type>* ) | ( local <name> <type> )
-
-module:  ( module <typedef>* <func>* <import>* <export>* <table>? <memory>? <elem>* <data>* <start>? ) | (module <string>+)
-typedef: ( type <name>? ( func <param>* <result>? ) )
-import:  ( import <name>? <string> <string> <sig> )
-export:  ( export <string> <var> ) | ( export <string> memory)
-start:   ( start <var> )
-table:   ( table <nat> <nat>? <elem_type> )
-         ( table <elem_type> ( elem <var>* ) )  ;; = (table <size> <size> <elem_type>) (elem (i32.const 0) <var>*)
+func:    ( func <name>? <func_sig> <local>* <expr>* )
+         ( func <name>? ( export <string> ) <func_sig> <local>* <expr>* )   ;; = (export <string> (func <N>) (func <name>? <func_sig> <local>* <expr>*)
+         ( func <name>? ( import <string> <string> ) <func_sig>)            ;; = (import <name>? <string> <string> (func <func_sig>))
+param:   ( param <type>* ) | ( param <name> <type> )
+result:  ( result <type> )
+local:   ( local <type>* ) | ( local <name> <type> )
+
+func_sig:   ( type <var> ) | <param>* <result>?
+global_sig: <type>
+table_sig:  <nat> <nat>? <elem_type>
+memory_sig: <nat> <nat>?
+
+global:  ( global <name>? <global_sig> )
+         ( global <name>? ( export <string> ) <global_sig> )                ;; = (export <string> (global <N>)) (global <name>? <global_sig>)
+         ( global <name>? ( import <string> <string> ) <global_sig> )       ;; = (import <name>? <string> <string> (global <global_sig>))
+table:   ( table <name>? <table_sig> )
+         ( table <name>? ( export <string> ) <table_sig> )                  ;; = (export <string> (table <N>)) (table <name>? <table_sig>)
+         ( table <name>? ( import <string> <string> ) <table_sig> )         ;; = (import <name>? <string> <string> (table <table_sig>))
+         ( table <name>? ( export <string> )? <elem_type> ( elem <var>* ) ) ;; = (table <name>? ( export <string> )? <size> <size> <elem_type>) (elem (i32.const 0) <var>*)
 elem:    ( elem <expr> <var>* )
-memory:  ( memory <nat> <nat>? )
-         ( memory ( data <string>* ) )          ;; = (memory <size> <size>) (data (i32.const 0) <string>*)
+memory:  ( memory <name>? <memory_sig> )
+         ( memory <name>? ( export <string> ) <memory_sig> )                ;; = (export <string> (memory <N>)) (memory <name>? <memory_sig>)
+         ( memory <name>? ( import <string> <string> ) <memory_sig> )       ;; = (import <name>? <string> <string> (memory <memory_sig>))
+         ( memory <name>? ( export <string> )? ( data <string>* )           ;; = (memory <name>? ( export <string> )? <size> <size>) (data (i32.const 0) <string>*)
 data:    ( data <expr> <string>* )
+
+start:   ( start <var> )
+
+typedef: ( type <name>? ( func <funcsig> ) )
+
+import:  ( import <string> <string> <imkind> )
+imkind:  ( func <name>? <func_sig> )
+         ( global <name>? <global_sig> )
+         ( table <name>? <table_sig> )
+         ( memory <name>? <memory_sig> )
+export:  ( export <string> <exkind> )
+exkind:  ( func <var> )
+         ( global <var> )
+         ( table <var> )
+         ( memory <var> )
+
+module:  ( module <typedef>* <func>* <import>* <export>* <table>? <memory>? <elem>* <data>* <start>? )
+         ( module <string>+ )
 ```
 
 Here, productions marked with respective comments are abbreviation forms for equivalent expansions (see the explanation of the kernel AST below).

ml-proto/host/arrange.ml

@@ -53,6 +53,9 @@ let func_type {ins; out} =
 
 let struct_type = func_type
 
+let limits int {min; max} =
+  String.concat " " (int min :: opt int max)
+
 
 (* Operators *)
 
@@ -218,7 +221,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 +249,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
@@ -262,21 +264,19 @@ let table xs = tab "table" (atom var) xs
 
 (* Tables & memories *)
 
-let limits int lim =
-  let {min; max} = lim.it in
-  String.concat " " (int min :: opt int max)
-
-let table tab =
-  let {tlimits = lim; etype} = tab.it in
-  Node ("table " ^ limits int32 lim, [atom elem_type etype])
+let table off i tab =
+  let {ttype = TableType (lim, t)} = tab.it in
+  Node ("table $" ^ string_of_int (off + i) ^ " " ^ limits int32 lim,
+    [atom elem_type t]
+  )
 
-let memory mem =
-  let {mlimits = lim} = mem.it in
-  Node ("memory " ^ limits int32 lim, [])
+let memory off i mem =
+  let {mtype = MemoryType lim} = mem.it in
+  Node ("memory $" ^ string_of_int (off + i) ^ " " ^ 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 +290,67 @@ let data seg =
 let typedef i t =
   Node ("type $" ^ string_of_int i, [struct_type t])
 
+let import_kind i k =
+  match k.it with
+  | FuncImport x ->
+    Node ("func $" ^ string_of_int i, [Node ("type", [atom var x])])
+  | TableImport t -> table 0 i ({ttype = t} @@ k.at)
+  | MemoryImport t -> memory 0 i ({mtype = t} @@ k.at)
+  | GlobalImport t ->
+    Node ("global $" ^ string_of_int i, [atom value_type t])
+
 let import i im =
-  let {itype; module_name; func_name} = im.it in
-  let ty = Node ("type " ^ var itype, []) in
-  Node ("import $" ^ string_of_int i,
-    [atom string module_name; atom string func_name; ty]
+  let {module_name; item_name; ikind} = im.it in
+  Node ("import",
+    [atom string module_name; atom string item_name; import_kind i 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 =
+  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 @

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 *)
 
@@ -90,6 +91,15 @@ let encode m =
     let func_type = function
       | {ins; out} -> u8 0x40; vec value_type ins; expr_type out
 
+    let limits vu {min; max} =
+      bool (max <> None); vu min; opt vu max
+
+    let table_type = function
+      | TableType (lim, t) -> elem_type t; limits vu32 lim
+
+    let memory_type = function
+      | MemoryType lim -> limits vu32 lim
+
     (* Expressions *)
 
     open Source
@@ -135,7 +145,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
@@ -316,9 +325,16 @@ let encode m =
       section "type" (vec func_type) ts (ts <> [])
 
     (* Import section *)
+    let import_kind k =
+      match k.it with
+      | FuncImport x -> u8 0x00; var x
+      | TableImport t -> u8 0x01; table_type t
+      | MemoryImport t -> u8 0x02; memory_type t
+      | GlobalImport t -> u8 0x03; value_type t
+
     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 +346,42 @@ 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 {ttype} = tab.it in
+      table_type ttype
 
-    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 {mtype} = mem.it in
+      memory_type mtype
 
-    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 +410,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 +434,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;

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 t -> ExternalMemoryType t
+  | 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
+      ("unknown import \"" ^ module_name ^ "." ^ item_name ^ "\"")
 
 let link m = List.map (lookup m) m.it.imports