Abstract script runner over engine

Author: rossberg

interpreter/exec/eval.ml

@@ -9,16 +9,15 @@ open Instance
 (* Errors *)
 
 module Link = Error.Make ()
-module Exception = Error.Make ()
 module Trap = Error.Make ()
 module Crash = Error.Make ()
 module Exhaustion = Error.Make ()
 
 exception Link = Link.Error
-exception Exception = Exception.Error
 exception Trap = Trap.Error
 exception Crash = Crash.Error (* failure that cannot happen in valid code *)
 exception Exhaustion = Exhaustion.Error
+exception Exception of region * Exn.t
 
 let table_error at = function
   | Table.Bounds -> "out of bounds table access"
@@ -1146,8 +1145,7 @@ let rec eval (c : config) : value stack =
     Trap.error at msg
 
   | vs, {it = Throwing (a, args); at} :: _ ->
-    let msg = "uncaught exception with args (" ^ string_of_values args ^ ")" in
-    Exception.error at msg
+    raise (Exception (at, Exn.Exn (a, args)))
 
   | vs, es ->
     eval (step c)
@@ -1183,7 +1181,7 @@ let init_type (inst : moduleinst) (type_ : type_) : moduleinst =
   let x = Lib.List32.length inst.types in
   {inst with types = inst.types @ roll_deftypes x rt}
 
-let init_import (inst : moduleinst) (ex : extern) (im : import) : moduleinst =
+let init_import (inst : moduleinst) (ex : externinst) (im : import) : moduleinst =
   let Import (module_name, item_name, xt) = im.it in
   let xt = subst_externtype (subst_of inst) xt in
   let xt' = externtype_of inst.types ex in
@@ -1305,7 +1303,7 @@ let init_list f xs (inst : moduleinst) : moduleinst =
 let init_list2 f xs ys (inst : moduleinst) : moduleinst =
   List.fold_left2 f inst xs ys
 
-let init (m : module_) (exts : extern list) : moduleinst =
+let init (m : module_) (exts : externinst list) : moduleinst =
   if List.length exts <> List.length m.it.imports then
     Link.error m.at "wrong number of imports provided for initialisation";
   let inst =

interpreter/exec/eval.mli

@@ -3,9 +3,9 @@ open Instance
 
 exception Link of Source.region * string
 exception Trap of Source.region * string
-exception Exception of Source.region * string
 exception Crash of Source.region * string
 exception Exhaustion of Source.region * string
+exception Exception of Source.region * Exn.t
 
-val init : Ast.module_ -> extern list -> moduleinst (* raises Link, Trap *)
-val invoke : funcinst -> value list -> value list (* raises Trap *)
+val init : Ast.module_ -> externinst list -> moduleinst (* raises Link, Trap, Exception *)
+val invoke : funcinst -> value list -> value list (* raises Trap, Exception *)

interpreter/host/env.ml

@@ -43,7 +43,7 @@ let exit vs =
 let lookup name et =
   match Utf8.encode name, et with
   | "abort", ExternFuncT ut ->
-    ExternFunc (Func.alloc_host (deftype_of_typeuse ut) abort)
+    Some (ExternFunc (Func.alloc_host (deftype_of_typeuse ut) abort))
   | "exit", ExternFuncT ut ->
-    ExternFunc (Func.alloc_host (deftype_of_typeuse ut) exit)
-  | _ -> raise Not_found
+    Some (ExternFunc (Func.alloc_host (deftype_of_typeuse ut) exit))
+  | _ -> None

interpreter/host/spectest.ml

@@ -17,23 +17,23 @@ let global (GlobalT (_, t) as gt) =
     | VecT V128T -> Vec (V128 (V128.I32x4.of_lanes [666l; 666l; 666l; 666l]))
     | RefT (_, t) -> Ref (NullRef t)
     | BotT -> assert false
-  in ExternGlobal (Global.alloc gt v)
+  in Some (ExternGlobal (Global.alloc gt v))
 
 let table =
   let tt = TableT (I32AT, {min = 10L; max = Some 20L}, (Null, FuncHT)) in
-  ExternTable (Table.alloc tt (NullRef FuncHT))
+  Some (ExternTable (Table.alloc tt (NullRef FuncHT)))
 
 let table64 =
   let tt = TableT (I64AT, {min = 10L; max = Some 20L}, (Null, FuncHT)) in
-  ExternTable (Table.alloc tt (NullRef FuncHT))
+  Some (ExternTable (Table.alloc tt (NullRef FuncHT)))
 
 let memory =
   let mt = MemoryT (I32AT, {min = 1L; max = Some 2L}) in
-  ExternMemory (Memory.alloc mt)
+  Some (ExternMemory (Memory.alloc mt))
 
 let func f ts1 ts2 =
   let dt = DefT (RecT [SubT (Final, [], FuncT (ts1, ts2))], 0l) in
-  ExternFunc (Func.alloc_host dt (f ts1 ts2))
+  Some (ExternFunc (Func.alloc_host dt (f ts1 ts2)))
 
 let print_value v =
   Printf.printf "%s : %s\n"
@@ -61,4 +61,4 @@ let lookup name t =
   | "table", _ -> table
   | "table64", _ -> table64
   | "memory", _ -> memory
-  | _ -> raise Not_found
+  | _ -> None

interpreter/main/main.ml

@@ -8,8 +8,8 @@ let all_handlers = [
 ]
 
 let configure custom_handlers =
-  Import.register (Utf8.decode "spectest") Spectest.lookup;
-  Import.register (Utf8.decode "env") Env.lookup;
+  Run.register_virtual (Utf8.decode "spectest") Spectest.lookup;
+  Run.register_virtual (Utf8.decode "env") Env.lookup;
   List.iter Custom.register custom_handlers
 
 let banner () =

interpreter/runtime/exn.ml

@@ -1,7 +1,8 @@
 open Types
 open Value
 
-type exn_ = Exn of Tag.t * value list
+type t = exn_
+and exn_ = Exn of Tag.t * value list
 
 type ref_ += ExnRef of exn_
 

interpreter/runtime/exn.mli

@@ -1,7 +1,8 @@
 open Types
 open Value
 
-type exn_ = Exn of Tag.t * value list
+type t = exn_
+and exn_ = Exn of Tag.t * value list
 
 type ref_ += ExnRef of exn_
 

interpreter/runtime/instance.ml

@@ -21,9 +21,9 @@ and tableinst = Table.t
 and funcinst = moduleinst Lib.Promise.t Func.t
 and datainst = Data.t
 and eleminst = Elem.t
-and exportinst = Ast.name * extern
+and exportinst = Ast.name * externinst
 
-and extern =
+and externinst =
   | ExternTag of taginst
   | ExternGlobal of globalinst
   | ExternMemory of memoryinst

interpreter/script/engine.ml

@@ -0,0 +1,56 @@
+type module_ = Ast.module_
+type value = Value.value
+type ref_ = Value.ref_
+
+module type Engine =
+sig
+  type moduleinst
+  type taginst
+  type globalinst
+  type memoryinst
+  type tableinst
+  type funcinst
+
+  type externinst =
+    | ExternTag of taginst
+    | ExternGlobal of globalinst
+    | ExternMemory of memoryinst
+    | ExternTable of tableinst
+    | ExternFunc of funcinst
+
+  type error = Source.region * string
+  type 'a return =
+    | Return of 'a
+    | Exn of Source.region * taginst * value list
+    | Trap of error
+    | Exhaustion of error
+
+  val validate : module_ -> (Types.moduletype, error) result
+  val validate_with_custom :
+    module_ * Custom.section list -> (Types.moduletype, error) result
+  val instantiate :
+    module_ -> externinst list -> (moduleinst return, error) result
+
+  val module_export : moduleinst -> Ast.name -> externinst option
+
+  val tag_type : taginst -> Types.tagtype
+
+  val global_type : globalinst -> Types.globaltype
+  val global_get : globalinst -> value
+  val global_set : globalinst -> value -> unit
+
+  val memory_type : memoryinst -> Types.memorytype
+  val memory_size : memoryinst -> int64
+  val memory_grow : memoryinst -> int64 -> unit option
+  val memory_load_byte : memoryinst -> int64 -> int option
+  val memory_store_byte : memoryinst -> int64 -> int -> unit option
+
+  val table_type : tableinst -> Types.tabletype
+  val table_size : tableinst -> int64
+  val table_grow : tableinst -> int64 -> ref_ -> unit option
+  val table_get : tableinst -> int64 -> ref_ option
+  val table_set : tableinst -> int64 -> ref_ -> unit option
+
+  val func_type : funcinst -> Types.deftype
+  val func_call : funcinst -> value list -> value list return
+end