Fix compilation errors after merge.

This commit fixes the errors introduced by the merge of
function-references/main into this tree.

Author: dhil

interpreter/binary/decode.ml

@@ -144,15 +144,8 @@ let sized f s =
 
 open Types
 
-let var s = vu32 s
 let zero s = expect 0x00 s "zero byte expected"
 
-let var_type s =
-  let pos = pos s in
-  match vs33 s with
-  | i when i >= 0l -> SynVar i
-  | _ -> error s pos "malformed type index"
-
 let num_type s =
   match s7 s with
   | -0x01 -> I32T
@@ -208,12 +201,12 @@ let func_type s =
   FuncT (ts1, ts2)
 
 let cont_type s =
-  ContType (var_type s)
+  ContT (Stat (var_type s))
 
 let def_type s =
   match s7 s with
   | -0x20 -> DefFuncT (func_type s)
-  | -0x21 -> ContDefType (cont_type s)
+  | -0x21 -> DefContT (cont_type s)
   | _ -> error s (pos s - 1) "malformed definition type"
 
 
@@ -234,8 +227,8 @@ let memory_type s =
 
 let tag_type s =
   zero s;
-  let x = var_type s in
-  TagType x
+  let x = Stat (var_type s) in
+  TagT x
 
 let mutability s =
   match byte s with
@@ -329,7 +322,7 @@ let rec instr s =
     let ct = catch_list s in
     let ca =
       if peek s = Some 0x19 then begin
-        ignore (u8 s);
+        ignore (byte s);
         Some (instr_block s)
       end else
         None
@@ -372,13 +365,11 @@ let rec instr s =
   | 0x14 -> call_ref (at var s)
   | 0x15 -> return_call_ref (at var s)
 
-  | 0x16 as b -> illegal s pos b
+  | (0x16 | 0x17) as b -> illegal s pos b
 
   | 0x18 -> error s pos "misplaced DELEGATE opcode"
   | 0x19 -> error s pos "misplaced CATCH_ALL opcode"
 
-  | 0x17 | 0x19 as b -> illegal s pos b
-
   | 0x1a -> drop
   | 0x1b -> select None
   | 0x1c -> select (Some (vec val_type s))
@@ -900,7 +891,7 @@ and instr_block' s es =
     instr_block' s (Source.(e' @@ region s pos pos) :: es)
 and catch_list s =
   if peek s = Some 0x07 then begin
-    ignore (u8 s);
+    ignore (byte s);
     let tag = at var s in
     let instrs = instr_block s in
     (tag, instrs) :: catch_list s
@@ -1244,7 +1235,7 @@ let module_ s =
     s (len s) "data count section required";
   let funcs =
     List.map2 (fun t f -> {f.it with ftype = t} @@ f.at) func_types func_bodies
-  in {types; tables; memories; globals; funcs; imports; exports; elems; datas; start}
+  in {types; tables; memories; tags; globals; funcs; imports; exports; elems; datas; start}
 
 
 let decode name bs = at module_ (stream name bs)

interpreter/binary/encode.ml

@@ -130,11 +130,11 @@ struct
     | FuncT (ts1, ts2) -> vec val_type ts1; vec val_type ts2
 
   let cont_type = function
-    | ContType x -> var_type x
+    | ContT x -> var_type x
 
   let def_type = function
     | DefFuncT ft -> s7 (-0x20); func_type ft
-    | ContDefType ct -> vs7 (-0x21); cont_type ct
+    | DefContT ct -> s7 (-0x21); cont_type ct (* TODO(dhil): I think the GC proposal claims opcode -0x21 for one of the struct/array types. *)
 
   let limits vu {min; max} =
     bool (max <> None); vu min; opt vu max
@@ -152,8 +152,8 @@ struct
   let global_type = function
     | GlobalT (mut, t) -> val_type t; mutability mut
 
-  let tag_type (TagType x) =
-    vu32 0x00l; var_type x
+  let tag_type (TagT x) =
+    u32 0x00l; var_type x
 
   (* Instructions *)
 

interpreter/exec/eval.ml

@@ -64,9 +64,8 @@ and admin_instr' =
   | Plain of instr'
   | Refer of ref_
   | Invoke of func_inst
-  | Label of int * instr list * code
-  | Frame of int * frame * code
-  | Local of int32 * value list * code
+  | Label of int32 * instr list * code
+  | Frame of int32 * frame * code
   | Handle of (tag_inst * idx) list option * code
   | Trapping of string
   | Throwing of tag_inst * value stack
@@ -88,7 +87,7 @@ type ref_ += ContRef of cont option ref
 let () =
   let type_of_ref' = !Value.type_of_ref' in
   Value.type_of_ref' := function
-    | ContRef _ -> BotHeapType  (* TODO *)
+    | ContRef _ -> BotHT  (* TODO *)
     | r -> type_of_ref' r
 
 let () =
@@ -199,22 +198,22 @@ let rec step (c : config) : config =
     match e.it, vs with
     | Plain e', vs ->
       (match e', vs with
-      | Unreachable, vs ->
+       | Unreachable, vs ->
         vs, [Trapping "unreachable executed" @@ e.at]
 
       | Nop, vs ->
         vs, []
 
       | Block (bt, es'), vs ->
         let InstrT (ts1, ts2, _xs) = block_type c.frame.inst bt e.at in
-        let n1 = List.length ts1 in
-        let n2 = List.length ts2 in
+        let n1 = Lib.List32.length ts1 in
+        let n2 = Lib.List32.length ts2 in
         let args, vs' = take n1 vs e.at, drop n1 vs e.at in
         vs', [Label (n2, [], (args, List.map plain es')) @@ e.at]
 
       | Loop (bt, es'), vs ->
         let InstrT (ts1, ts2, _xs) = block_type c.frame.inst bt e.at in
-        let n1 = List.length ts1 in
+        let n1 = Lib.List32.length ts1 in
         let args, vs' = take n1 vs e.at, drop n1 vs e.at in
         vs', [Label (n1, [e' @@ e.at], (args, List.map plain es')) @@ e.at]
 
@@ -227,23 +226,23 @@ let rec step (c : config) : config =
       | Throw x, vs ->
         let tagt = tag c.frame.inst x in
         let TagT x' = Tag.type_of tagt in
-        let FuncT (ts, _) = as_func_def_type (def_of (as_sem_var x')) in
+        let FuncT (ts, _) = as_func_def_type (def_of (as_dyn_var x')) in
         let vs0, vs' = split (Lib.List32.length ts) vs e.at in
         vs', [Throwing (tagt, vs0) @@ e.at]
 
       | Rethrow x, vs ->
         vs, [Rethrowing (x.it, fun e -> e) @@ e.at]
 
       | TryCatch (bt, es', cts, ca), vs ->
-        let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in
+        let InstrT (ts1, ts2, _xs) = block_type c.frame.inst bt e.at in
         let n1 = Lib.List32.length ts1 in
         let n2 = Lib.List32.length ts2 in
         let args, vs' = take n1 vs e.at, drop n1 vs e.at in
         let cts' = List.map (fun (x, es'') -> ((tag c.frame.inst x), es'')) cts in
         vs', [Label (n2, [], ([], [Catch (n2, cts', ca, (args, List.map plain es')) @@ e.at])) @@ e.at]
 
       | TryDelegate (bt, es', x), vs ->
-        let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in
+        let InstrT (ts1, ts2, _xs) = block_type c.frame.inst bt e.at in
         let n1 = Lib.List32.length ts1 in
         let n2 = Lib.List32.length ts2 in
         let args, vs' = take n1 vs e.at, drop n1 vs e.at in
@@ -315,7 +314,7 @@ let rec step (c : config) : config =
         vs, [Trapping "null function reference" @@ e.at]
 
       | ContNew x, Ref (FuncRef f) :: vs ->
-        let FuncType (ts, _) = Func.type_of f in
+        let FuncT (ts, _) = Func.type_of f in
         let ctxt code = compose code ([], [Invoke f @@ e.at]) in
         Ref (ContRef (ref (Some (Lib.List32.length ts, ctxt)))) :: vs, []
 
@@ -326,8 +325,8 @@ let rec step (c : config) : config =
         vs, [Trapping "continuation already consumed" @@ e.at]
 
       | ContBind x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs ->
-        let ContType z = cont_type c.frame.inst x in
-        let FuncType (ts', _) = as_func_def_type (def_of (as_sem_var z)) in
+        let ContT z = cont_type c.frame.inst x in
+        let FuncT (ts', _) = as_func_def_type (def_of (as_dyn_var z)) in
         let args, vs' =
           try split (Int32.sub n (Lib.List32.length ts')) vs e.at
           with Failure _ -> Crash.error e.at "type mismatch at continuation bind"
@@ -339,7 +338,7 @@ let rec step (c : config) : config =
       | Suspend x, vs ->
         let tagt = tag c.frame.inst x in
         let TagT x' = Tag.type_of tagt in
-        let FuncT (ts, _) = as_func_def_type (def_of (as_sem_var x')) in
+        let FuncT (ts, _) = as_func_def_type (def_of (as_dyn_var x')) in
         let args, vs' = split (Lib.List32.length ts) vs e.at in
         vs', [Suspending (tagt, args, fun code -> code) @@ e.at]
 
@@ -364,14 +363,14 @@ let rec step (c : config) : config =
       | ResumeThrow x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs ->
         let tagt = tag c.frame.inst x in
         let TagT x' = Tag.type_of tagt in
-        let FuncType (ts, _) = as_func_def_type (def_of (as_sem_var x')) in
+        let FuncT (ts, _) = as_func_def_type (def_of (as_dyn_var x')) in
         let args, vs' = split (Lib.List32.length ts) vs e.at in
         let vs1', es1' = ctxt (args, [Plain (Throw x) @@ e.at]) in
         cont := None;
         vs1' @ vs', es1'
 
       | Barrier (bt, es'), vs ->
-        let FuncType (ts1, _) = block_type c.frame.inst bt e.at in
+        let InstrT (ts1, _, _xs) = block_type c.frame.inst bt e.at in
         let args, vs' = split (Lib.List32.length ts1) vs e.at in
         vs', [
           Handle (None,
@@ -821,6 +820,12 @@ let rec step (c : config) : config =
     | Frame (n, frame', (vs', [])), vs ->
       vs' @ vs, []
 
+    | Frame (n, frame', (vs', {it = Trapping msg; at} :: es')), vs ->
+      vs, [Trapping msg @@ at]
+
+    | Frame (n, frame', (vs', {it = Throwing (a, vs0); at} :: es')), vs ->
+      vs, [Throwing (a, vs0) @@ at]
+
     | Frame (n, frame', (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs ->
       let ctxt' code = [], [Frame (n, frame', compose (ctxt code) (vs', es')) @@ e.at] in
       vs, [Suspending (tagt, vs1, ctxt') @@ at]
@@ -830,7 +835,7 @@ let rec step (c : config) : config =
 
     | Frame (n, frame', (vs', {it = ReturningInvoke (vs0, f); at} :: es')), vs ->
       let FuncT (ts1, _ts2) = Func.type_of f in
-      take (List.length ts1) vs0 e.at @ vs, [Invoke f @@ at]
+      take (Lib.List32.length ts1) vs0 e.at @ vs, [Invoke f @@ at]
 
     | Frame (n, frame', code'), vs ->
       let c' = step {frame = frame'; code = code'; budget = c.budget - 1} in
@@ -895,10 +900,10 @@ let rec step (c : config) : config =
 
     | Invoke f, vs ->
       let FuncT (ts1, ts2) = Func.type_of f in
-      let n1, n2 = List.length ts1, List.length ts2 in
+      let n1, n2 = Lib.List32.length ts1, Lib.List32.length ts2 in
       let args, vs' = split n1 vs e.at in
       (match f with
-      | Func.AstFunc (_, inst', func) ->
+       | Func.AstFunc (_, inst', func) ->
         let {locals; body; _} = func.it in
         let m = Lib.Promise.value inst' in
         let ts = List.map (fun loc -> Types.dyn_val_type m.types loc.it.ltype) locals in
@@ -921,7 +926,7 @@ let rec step (c : config) : config =
     | Handle (Some hs, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs
       when List.mem_assq tagt hs ->
       let TagT x' = Tag.type_of tagt in
-      let FuncT (_, ts) = as_func_def_type (def_of (as_sem_var x')) in
+      let FuncT (_, ts) = as_func_def_type (def_of (as_dyn_var x')) in
       let ctxt' code = compose (ctxt code) (vs', es') in
       [Ref (ContRef (ref (Some (Lib.List32.length ts, ctxt'))))] @ vs1 @ vs,
       [Plain (Br (List.assq tagt hs)) @@ e.at]
@@ -1025,7 +1030,7 @@ let create_global (inst : module_inst) (glob : global) : global_inst =
 
 let create_tag (inst : module_inst) (tag : tag) : tag_inst =
   let {tagtype} = tag.it in
-  Tag.alloc (Types.sem_tag_type inst.types tagtype)
+  Tag.alloc (Types.dyn_tag_type inst.types tagtype)
 
 let create_export (inst : module_inst) (ex : export) : export_inst =
   let {name; edesc} = ex.it in

interpreter/host/spectest.ml

@@ -26,11 +26,11 @@ let memory = Memory.alloc (MemoryT {min = 1l; max = Some 2l})
 let func f ft = Func.alloc_host (Types.alloc (DefFuncT ft)) (f ft)
 
 let tag =
-  let p = Types.alloc (FuncDefType (FuncType ([NumType I32Type], [NumType I32Type]))) in
-  Tag.alloc (TagType (SemVar p))
+  let p = Types.alloc (DefFuncT (FuncT ([NumT I32T], [NumT I32T]))) in
+  Tag.alloc (TagT (Dyn p))
 let except =
-  let p = Types.alloc (FuncDefType (FuncType ([NumType I32Type], []))) in
-  Tag.alloc (TagType (SemVar p))
+  let p = Types.alloc (DefFuncT (FuncT ([NumT I32T], []))) in
+  Tag.alloc (TagT (Dyn p))
 
 let print_value v =
   Printf.printf "%s : %s\n"

interpreter/runtime/instance.ml

@@ -66,7 +66,7 @@ let extern_type_of c = function
   | ExternTable tab -> ExternTableT (Table.type_of tab)
   | ExternMemory mem -> ExternMemoryT (Memory.type_of mem)
   | ExternGlobal glob -> ExternGlobalT (Global.type_of glob)
-  | ExternTag tag -> ExternTagType (Tag.type_of tag)
+  | ExternTag tag -> ExternTagT (Tag.type_of tag)
 
 let export inst name =
   try Some (List.assoc name inst.exports) with Not_found -> None

interpreter/script/js.ml

@@ -288,6 +288,7 @@ let null_heap_type_of = function
   | Types.DefHT (Dyn a) ->
     match Types.def_of a with
     | Types.DefFuncT _ -> FuncHT
+    | Types.DefContT _ -> assert false
 
 let value v =
   match v.it with

interpreter/syntax/free.ml

@@ -90,11 +90,11 @@ let val_type = function
   | BotT -> empty
 
 let func_type (FuncT (ins, out)) = list val_type ins ++ list val_type out
-let cont_type (ContType x) = var_type x
+let cont_type (ContT x) = var_type x
 let global_type (GlobalT (_mut, t)) = val_type t
 let table_type (TableT (_lim, t)) = ref_type t
 let memory_type (MemoryT (_lim)) = empty
-let tag_type (TagType x) = var_type x
+let tag_type (TagT x) = var_type x
 
 let def_type = function
   | DefFuncT ft -> func_type ft