Add NoContHT

WebAssembly · Oct 19, 2023 · 4eb38ce · 4eb38ce
1 parent c81ef89
commit 4eb38ce
Show file tree

Hide file tree

Showing 6 changed files with 15 additions and 9 deletions.
diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml
@@ -190,6 +190,7 @@ let heap_type s =
       | -0x15 -> StructHT
       | -0x16 -> ArrayHT
       | -0x17 -> ContHT
+      | -0x18 -> NoContHT
       | _ -> error s pos "malformed heap type"
     )
   ] s
@@ -208,6 +209,7 @@ let ref_type s =
   | -0x15 -> (Null, StructHT)
   | -0x16 -> (Null, ArrayHT)
   | -0x17 -> (Null, ContHT)
+  | -0x18 -> (Null, NoContHT)
   | -0x1c -> (NoNull, heap_type s)
   | -0x1d -> (Null, heap_type s)
   | _ -> error s pos "malformed reference type"

diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml
@@ -126,6 +126,7 @@ struct
     | ExternHT -> s7 (-0x11)
     | NoExternHT -> s7 (-0x0e)
     | ContHT -> s7 (-0x17)
+    | NoContHT -> s7 (-0x18)
     | VarHT x -> var_type s33 x
     | DefHT _ | BotHT -> assert false
 
@@ -145,6 +146,7 @@ struct
     | (Null, ExternHT) -> s7 (-0x11)
     | (Null, NoExternHT) -> s7 (-0x0e)
     | (Null, ContHT) -> s7 (-0x17)
+    | (Null, NoContHT) -> s7 (-0x18)
     | (Null, t) -> s7 (-0x1d); heap_type t
     | (NoNull, t) -> s7 (-0x1c); heap_type t
 

diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml
@@ -81,7 +81,7 @@ let heap_type = function
   | I31HT | StructHT | ArrayHT -> empty
   | FuncHT | NoFuncHT -> empty
   | ExternHT | NoExternHT -> empty
-  | ContHT -> empty
+  | ContHT | NoContHT -> empty
   | VarHT x -> var_type x
   | DefHT _ct -> empty  (* assume closed *)
   | BotHT -> empty

diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml
@@ -18,7 +18,7 @@ type heap_type =
   | AnyHT | NoneHT | EqHT | I31HT | StructHT | ArrayHT
   | FuncHT | NoFuncHT
   | ExternHT | NoExternHT
-  | ContHT
+  | ContHT | NoContHT
   | VarHT of var
   | DefHT of def_type
   | BotHT
@@ -151,6 +151,7 @@ let subst_heap_type s = function
   | ExternHT -> ExternHT
   | NoExternHT -> NoExternHT
   | ContHT -> ContHT
+  | NoContHT -> NoContHT
   | VarHT x -> s x
   | DefHT dt -> DefHT dt  (* assume closed *)
   | BotHT -> BotHT
@@ -360,6 +361,7 @@ let rec string_of_heap_type = function
   | ExternHT -> "extern"
   | NoExternHT -> "noextern"
   | ContHT -> "cont"
+  | NoContHT -> "nocont"
   | VarHT x -> string_of_var x
   | DefHT dt -> "(" ^ string_of_def_type dt ^ ")"
   | BotHT -> "something"

diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml
@@ -22,7 +22,7 @@ and top_of_heap_type c = function
   | AnyHT | NoneHT | EqHT | StructHT | ArrayHT | I31HT -> AnyHT
   | FuncHT | NoFuncHT -> FuncHT
   | ExternHT | NoExternHT -> ExternHT
-  | ContHT -> ContHT
+  | ContHT | NoContHT -> ContHT
   | DefHT dt -> top_of_str_type c (expand_def_type dt)
   | VarHT (StatX x) -> top_of_str_type c (expand_def_type (lookup c x))
   | VarHT (RecX _) | BotHT -> assert false
@@ -34,7 +34,7 @@ and bot_of_heap_type c = function
   | AnyHT | NoneHT | EqHT | StructHT | ArrayHT | I31HT -> NoneHT
   | FuncHT | NoFuncHT -> NoFuncHT
   | ExternHT | NoExternHT -> NoExternHT
-  | ContHT -> ContHT
+  | ContHT | NoContHT -> NoContHT
   | DefHT dt -> bot_of_str_type c (expand_def_type dt)
   | VarHT (StatX x) -> bot_of_str_type c (expand_def_type (lookup c x))
   | VarHT (RecX _) | BotHT -> assert false
@@ -75,7 +75,7 @@ let rec match_heap_type c t1 t2 =
   | NoneHT, t -> match_heap_type c t AnyHT
   | NoFuncHT, t -> match_heap_type c t FuncHT
   | NoExternHT, t -> match_heap_type c t ExternHT
-  | ContHT, t -> match_heap_type c t ContHT
+  | NoContHT, t -> match_heap_type c t ContHT
   | VarHT (StatX x1), _ -> match_heap_type c (DefHT (lookup c x1)) t2
   | _, VarHT (StatX x2) -> match_heap_type c t1 (DefHT (lookup c x2))
   | DefHT dt1, DefHT dt2 -> match_def_type c dt1 dt2

diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml
@@ -98,13 +98,13 @@ let refer_func (c : context) x = refer "function" c.refs.Free.funcs x
 
 let cont_type_of_heap_type (c : context) (ht : heap_type) at : cont_type =
   match ht with
-  | DefHT dt -> as_cont_str_type (expand_def_type dt)
+  | DefHT dt -> assert false
   | VarHT (StatX x) -> cont_type c (x @@ at)
   | _ -> assert false
 
 let func_type_of_heap_type (c : context) (ht : heap_type) at : func_type =
   match ht with
-  | DefHT dt -> as_func_str_type (expand_def_type dt)
+  | DefHT dt -> assert false
   | VarHT (StatX x) -> func_type c (x @@ at)
   | _ -> assert false
 
@@ -140,7 +140,7 @@ let check_heap_type (c : context) (t : heap_type) at =
   | AnyHT | NoneHT | EqHT | I31HT | StructHT | ArrayHT
   | FuncHT | NoFuncHT
   | ExternHT | NoExternHT
-  | ContHT -> ()
+  | ContHT | NoContHT -> ()
   | VarHT (StatX x) -> let _dt = type_ c (x @@ at) in ()
   | VarHT (RecX _) | DefHT _ -> assert false
   | BotHT -> ()
@@ -424,7 +424,7 @@ let check_resume_table (c : context) ts2 (xys : (idx * idx) list) at =
   List.iter (fun (x1, x2) ->
     let FuncT (ts3, ts4) = func_type_of_tag_type c (tag c x1) x1.at in
     let (_, ts') = label c x2 in
-    match Lib.List.last_opt ts'  with
+    match Lib.List.last_opt ts' with
     | Some (RefT (nul', ht)) ->
       let ct = cont_type_of_heap_type c ht x2.at in
       let ft' = func_type_of_cont_type c ct x2.at in