Implement tables & multiple memories

ml-proto/README.md

@@ -105,6 +105,7 @@ name: (<letter> | <digit> | _ | . | + | - | * | / | \ | ^ | ~ | = | < | > | ! |
 string: "(<char> | \n | \t | \\ | \' | \" | \<hex><hex>)*"
 
 type: i32 | i64 | f32 | f64
+elem_type: anyfunc
 
 unop:  ctz | clz | popcnt | ...
 binop: add | sub | mul | ...
@@ -148,14 +149,17 @@ param:  ( param <type>* ) | ( param <name> <type> )
 result: ( result <type> )
 local:  ( local <type>* ) | ( local <name> <type> )
 
-module:  ( module <typedef>* <func>* <import>* <export>* <table>* <memory>? <start>? ) | (module <string>+)
+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 <var>* )
-memory:  ( memory <int> <int>? <segment>* )
-segment: ( segment <int> <string>+ )
+table:   ( table <nat> <nat>? <elem_type> )
+         ( table <elem_type> ( elem <var>* ) )  ;; = (table <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>*)
+data:    ( data <expr> <string>* )
 ```
 
 Here, productions marked with respective comments are abbreviation forms for equivalent expansions (see the explanation of the kernel AST below).
@@ -165,6 +169,7 @@ Any form of naming via `<name>` and `<var>` (including expression labels) is mer
 A module of the form `(module <string>+)` is given in binary form and will be decoded from the (concatenation of the) strings.
 
 The segment strings in the memory field are used to initialize the consecutive memory at the given offset.
+The `<size>` in the expansion of the two short-hand forms for `table` and `memory` is the minimal size that can hold the segment: the number of `<var>`s for tables, and the accumulative length of the strings rounded up to page size for memories.
 
 Comments can be written in one of two ways:
 

ml-proto/given/source.ml

@@ -10,7 +10,7 @@ let no_region = {left = no_pos; right = no_pos}
 
 let string_of_pos pos =
   if pos.line = -1 then
-    string_of_int pos.column
+    Printf.sprintf "0x%x" pos.column
   else
     string_of_int pos.line ^ "." ^ string_of_int (pos.column + 1)
 

ml-proto/host/arrange.ml

@@ -35,11 +35,17 @@ let opt f xo = list f (list_of_opt xo)
 let tab head f xs = if xs = [] then [] else [Node (head, list f xs)]
 let atom f x = Atom (f x)
 
+let break_string s =
+  let ss = Lib.String.breakup s (!Flags.width / 2) in
+  list (atom string) ss
+
 
 (* Types *)
 
 let value_type t = string_of_value_type t
 
+let elem_type t = string_of_elem_type t
+
 let decls kind ts = tab kind (atom value_type) ts
 
 let func_type {ins; out} =
@@ -254,16 +260,29 @@ let start x = Node ("start " ^ var x, [])
 let table xs = tab "table" (atom var) xs
 
 
-(* Memory *)
+(* Tables & memories *)
 
-let segment seg =
-  let {Memory.addr; data} = seg.it in
-  let ss = Lib.String.breakup data (!Flags.width / 2) in
-  Node ("segment " ^ int64 addr, list (atom string) ss)
+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 memory mem =
-  let {min; max; segments} = mem.it in
-  Node ("memory " ^ int64 min ^ " " ^ int64 max, list segment segments)
+  let {mlimits = lim} = mem.it in
+  Node ("memory " ^ limits int64 lim, [])
+
+let segment head dat seg =
+  let {offset; init} = seg.it in
+  Node (head, expr offset :: dat init)
+
+let elems seg =
+  segment "elem" (list (atom var)) seg
+
+let data seg =
+  segment "data" break_string seg
 
 
 (* Modules *)
@@ -279,8 +298,8 @@ let import i im =
   )
 
 let global g =
-  let {gtype; init} = g.it in
-  Node ("global", [atom value_type gtype; expr init])
+  let {gtype; value} = g.it in
+  Node ("global", [atom value_type gtype; expr value])
 
 let export ex =
   let {name; kind} = ex.it in
@@ -294,11 +313,13 @@ let module_ m =
   Node ("module",
     listi typedef m.it.types @
     listi import m.it.imports @
-    listi func m.it.funcs @
-    table m.it.table @
+    opt table m.it.table @
     opt memory m.it.memory @
     list global m.it.globals @
+    listi func m.it.funcs @
     list export m.it.exports @
-    opt start m.it.start
+    opt start m.it.start @
+    list elems m.it.elems @
+    list data m.it.data
   )
 

ml-proto/host/encode.ml

@@ -82,6 +82,9 @@ let encode m =
       | Float32Type -> u8 0x03
       | Float64Type -> u8 0x04
 
+    let elem_type = function
+      | AnyFuncType -> u8 0x20
+
     let expr_type t = vec1 value_type t
 
     let func_type = function
@@ -295,6 +298,8 @@ let encode m =
     and nary es o = list expr es; op o; arity es
     and nary1 eo o = opt expr eo; op o; arity1 eo
 
+    let const e = expr e; op 0x0f
+
     (* Sections *)
 
     let section id f x needed =
@@ -325,20 +330,29 @@ let encode m =
       section "function" (vec func) fs (fs <> [])
 
     (* Table section *)
-    let table_section tab =
-      section "table" (vec var) tab (tab <> [])
+    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)
 
     (* Memory section *)
     let memory mem =
-      let {min; max; _} = mem.it in
-      vu64 min; vu64 max; bool true (*TODO: pending change*)
+      let {mlimits} = mem.it in
+      limits vu64 mlimits
 
     let memory_section memo =
       section "memory" (opt memory) memo (memo <> None)
 
     (* Global section *)
     let global g =
-      let {gtype = t; init = e} = g.it in
+      let {gtype = t; value = e} = g.it in
       value_type t; expr e; op 0x0f
 
     let global_section gs =
@@ -381,14 +395,23 @@ let encode m =
     let code_section fs =
       section "code" (vec code) fs (fs <> [])
 
+    (* Element section *)
+    let segment dat seg =
+      let {offset; init} = seg.it in
+      const offset; dat init
+
+    let table_segment seg =
+      segment (vec var) seg
+
+    let elem_section elems =
+      section "element" (vec table_segment) elems (elems <> [])
+
     (* Data section *)
-    let segment seg =
-      let {Memory.addr; data} = seg.it in
-      vu64 addr; string data
+    let memory_segment seg =
+      segment string seg
 
-    let data_section segs =
-      section "data" (opt (vec segment))
-        segs (segs <> None && segs <> Some [])
+    let data_section data =
+      section "data" (vec memory_segment) data (data <> [])
 
     (* Module *)
 
@@ -404,6 +427,7 @@ let encode m =
       export_section m.it.exports;
       start_section m.it.start;
       code_section m.it.funcs;
-      data_section (Lib.Option.map (fun mem -> mem.it.segments) m.it.memory)
+      elem_section m.it.elems;
+      data_section m.it.data
   end
   in E.module_ m; to_string s

ml-proto/host/lexer.mll

@@ -139,6 +139,7 @@ rule token = parse
         (fun s -> let n = F64.of_string s.it in
           F64_const (n @@ s.at), Values.Float64 n))
     }
+  | "anyfunc" { ANYFUNC }
 
   | "nop" { NOP }
   | "unreachable" { UNREACHABLE }
@@ -364,11 +365,12 @@ rule token = parse
   | "local" { LOCAL }
   | "global" { GLOBAL }
   | "module" { MODULE }
+  | "table" { TABLE }
   | "memory" { MEMORY }
-  | "segment" { SEGMENT }
+  | "elem" { ELEM }
+  | "data" { DATA }
   | "import" { IMPORT }
   | "export" { EXPORT }
-  | "table" { TABLE }
 
   | "assert_invalid" { ASSERT_INVALID }
   | "assert_return" { ASSERT_RETURN }