Split out exceptions

Author: rossberg

interpreter/exec/eval.ml

@@ -308,7 +308,7 @@ let rec step (c : config) : config =
       | ThrowRef, Ref (NullRef _) :: vs ->
         vs, [Trapping "null exception reference" @@ e.at]
 
-      | ThrowRef, Ref (ExnRef (t, args)) :: vs ->
+      | ThrowRef, Ref (Exn.(ExnRef (Exn (t, args)))) :: vs ->
         vs, [Throwing (t, args) @@ e.at]
 
       | TryTable (bt, cs, es'), vs ->
@@ -1055,15 +1055,15 @@ let rec step (c : config) : config =
 
     | Handler (n, {it = CatchRef (x1, x2); _} :: cs, (vs', {it = Throwing (a, vs0); at} :: es')), vs ->
       if a == tag c.frame.inst x1 then
-        Ref (ExnRef (a, vs0)) :: vs0 @ vs, [Plain (Br x2) @@ e.at]
+        Ref Exn.(ExnRef (Exn (a, vs0))) :: vs0 @ vs, [Plain (Br x2) @@ e.at]
       else
         vs, [Handler (n, cs, (vs', {it = Throwing (a, vs0); at} :: es')) @@ e.at]
 
     | Handler (n, {it = CatchAll x; _} :: cs, (vs', {it = Throwing (a, vs0); at} :: es')), vs ->
       vs, [Plain (Br x) @@ e.at]
 
     | Handler (n, {it = CatchAllRef x; _} :: cs, (vs', {it = Throwing (a, vs0); at} :: es')), vs ->
-      Ref (ExnRef (a, vs0)) :: vs, [Plain (Br x) @@ e.at]
+      Ref Exn.(ExnRef (Exn (a, vs0))) :: vs, [Plain (Br x) @@ e.at]
 
     | Handler (n, [], (vs', {it = Throwing (a, vs0); at} :: es')), vs ->
       vs, [Throwing (a, vs0) @@ at]

interpreter/runtime/exn.ml

@@ -0,0 +1,38 @@
+open Types
+open Value
+
+type exn_ = Exn of Tag.t * value list
+
+type ref_ += ExnRef of exn_
+
+let alloc_exn tag vs =
+  let TagT dt = Tag.type_of tag in
+  assert Free.((def_type dt).types = Set.empty);
+  let FuncT (ts1, ts2) = as_func_str_type (expand_def_type dt) in
+  assert (List.length vs = List.length ts1);
+  assert (ts2 = []);
+  Exn (tag, vs)
+
+let type_of_exn (Exn (tag, _)) =
+  let TagT dt = Tag.type_of tag in
+  dt
+
+let () =
+  let eq_ref' = !Value.eq_ref' in
+  Value.eq_ref' := fun r1 r2 ->
+    match r1, r2 with
+    | ExnRef _, ExnRef _ -> failwith "eq_ref"
+    | _, _ -> eq_ref' r1 r2
+
+let () =
+  let type_of_ref' = !Value.type_of_ref' in
+  Value.type_of_ref' := function
+    | ExnRef e -> DefHT (type_of_exn e)
+    | r -> type_of_ref' r
+
+let () =
+  let string_of_ref' = !Value.string_of_ref' in
+  Value.string_of_ref' := function
+    | ExnRef (Exn (_tag, vs)) ->
+      "(tag " ^ String.concat " " (List.map string_of_value vs) ^ ")"
+    | r -> string_of_ref' r

interpreter/runtime/exn.mli

@@ -0,0 +1,10 @@
+open Types
+open Value
+
+type exn_ = Exn of Tag.t * value list
+
+type ref_ += ExnRef of exn_
+
+val alloc_exn : Tag.t -> value list -> exn_
+
+val type_of_exn : exn_ -> def_type

interpreter/runtime/instance.ml

@@ -54,13 +54,6 @@ let () =
     | FuncRef _ -> "func"
     | r -> string_of_ref' r
 
-let () =
-  let eq_ref' = !Value.eq_ref' in
-  Value.eq_ref' := fun r1 r2 ->
-    match r1, r2 with
-    | FuncRef f1, FuncRef f2 -> f1 == f2
-    | _, _ -> eq_ref' r1 r2
-
 
 (* Projections *)
 

interpreter/runtime/tag.mli

@@ -1,6 +1,6 @@
 open Types
 
-type tag = {ty : tag_type}
+type tag
 type t = tag
 
 val alloc : tag_type -> tag

interpreter/runtime/value.ml

@@ -18,7 +18,6 @@ type value = Num of num | Vec of vec | Ref of ref_
 type t = value
 
 type ref_ += NullRef of heap_type
-type ref_ += ExnRef of Tag.t * value list
 
 
 (* Injection & projection *)
@@ -109,7 +108,6 @@ let type_of_vec = type_of_vecop
 let type_of_ref' = ref (function _ -> assert false)
 let type_of_ref = function
   | NullRef t -> (Null, Match.bot_of_heap_type [] t)
-  | ExnRef _ -> (NoNull, ExnHT)
   | r -> (NoNull, !type_of_ref' r)
 
 let type_of_value = function
@@ -304,7 +302,6 @@ let hex_string_of_vec = function
 let string_of_ref' = ref (function _ -> "ref")
 let string_of_ref = function
   | NullRef _ -> "null"
-  | ExnRef _ -> "exn"
   | r -> !string_of_ref' r
 
 let string_of_value = function

interpreter/script/run.ml

@@ -401,7 +401,7 @@ let assert_ref_pat r p =
   | RefTypePat Types.StructHT, Aggr.StructRef _
   | RefTypePat Types.ArrayHT, Aggr.ArrayRef _ -> true
   | RefTypePat Types.FuncHT, Instance.FuncRef _
-  | RefTypePat Types.ExnHT, Value.ExnRef _
+  | RefTypePat Types.ExnHT, Exn.ExnRef _
   | RefTypePat Types.ExternHT, _ -> true
   | NullPat, Value.NullRef _ -> true
   | _ -> false

interpreter/syntax/free.mli

@@ -26,6 +26,7 @@ val func_type : Types.func_type -> t
 val global_type : Types.global_type -> t
 val table_type : Types.table_type -> t
 val memory_type : Types.memory_type -> t
+val tag_type : Types.tag_type -> t
 val extern_type : Types.extern_type -> t
 
 val str_type : Types.str_type -> t