Implement has_feature.

ml-proto/host/lexer.mll

@@ -240,6 +240,7 @@ rule token = parse
   | "page_size" { PAGE_SIZE }
   | "memory_size" { MEMORY_SIZE }
   | "grow_memory" { GROW_MEMORY }
+  | "has_feature" { HAS_FEATURE }
 
   | "type" { TYPE }
   | "func" { FUNC }

ml-proto/host/params.ml

@@ -1 +1,7 @@
 let page_size = 4096L
+
+let has_feature = fun str -> match str with
+  (* We always support this feature :-). *)
+  | "wasm" -> true
+  (* If we don't recognize a feature name, we don't support the feature. *)
+  | _ -> false

ml-proto/host/parser.mly

@@ -136,7 +136,7 @@ let implicit_decl c t at =
 %token CONST UNARY BINARY COMPARE CONVERT
 %token FUNC TYPE PARAM RESULT LOCAL
 %token MODULE MEMORY SEGMENT IMPORT EXPORT TABLE
-%token PAGE_SIZE MEMORY_SIZE GROW_MEMORY
+%token PAGE_SIZE MEMORY_SIZE GROW_MEMORY HAS_FEATURE
 %token ASSERT_INVALID ASSERT_RETURN ASSERT_RETURN_NAN ASSERT_TRAP INVOKE
 %token EOF
 
@@ -246,6 +246,7 @@ expr1 :
   | PAGE_SIZE { fun c -> host (PageSize, []) }
   | MEMORY_SIZE { fun c -> host (MemorySize, []) }
   | GROW_MEMORY expr { fun c -> host (GrowMemory, [$2 c]) }
+  | HAS_FEATURE TEXT { fun c -> host (HasFeature $2, []) }
 ;
 expr_opt :
   | /* empty */ { fun c -> None }

ml-proto/host/script.ml

@@ -62,7 +62,10 @@ let run_command cmd =
     end;
     trace "Initializing...";
     let imports = Builtins.match_imports m in
-    let host_params = {Eval.page_size = Params.page_size} in
+    let host_params = {
+      Eval.page_size = Params.page_size;
+      Eval.has_feature = Params.has_feature
+    } in
     current_module := Some (Eval.init m imports host_params)
 
   | Invoke (name, es) ->

ml-proto/spec/ast.ml

@@ -66,9 +66,10 @@ type memop = {ty : value_type; align : int option}
 type extop = {memop : memop; sz : Memory.mem_size; ext : Memory.extension}
 type wrapop = {memop : memop; sz : Memory.mem_size}
 type hostop =
-  | PageSize           (* inquire host-defined page size *)
-  | MemorySize         (* inquire current size of linear memory *)
-  | GrowMemory         (* grow linear memory *)
+  | PageSize             (* inquire host-defined page size *)
+  | MemorySize           (* inquire current size of linear memory *)
+  | GrowMemory           (* grow linear memory *)
+  | HasFeature of string (* test for feature availability *)
 
 
 (* Expressions *)

ml-proto/spec/check.ml

@@ -90,10 +90,17 @@ let type_cvt at = function
     | DemoteFloat64 -> error at "invalid conversion"
     ), Float64Type
 
+type type_hostop_type = {
+  hostop_ins : value_type list;
+  hostop_out : expr_type;
+  hostop_hasmem : bool
+}
+
 let type_hostop = function
-  | PageSize -> {ins = []; out = Some Int32Type}
-  | MemorySize -> {ins = []; out = Some Int32Type}
-  | GrowMemory -> {ins = [Int32Type]; out = None}
+  | PageSize -> {hostop_ins = []; hostop_out = Some Int32Type; hostop_hasmem = true}
+  | MemorySize -> {hostop_ins = []; hostop_out = Some Int32Type; hostop_hasmem = true}
+  | GrowMemory -> {hostop_ins = [Int32Type]; hostop_out = None; hostop_hasmem = true}
+  | HasFeature str -> {hostop_ins = []; hostop_out = Some Int32Type; hostop_hasmem = false}
 
 
 (* Type Analysis *)
@@ -207,10 +214,11 @@ let rec check_expr c et e =
     check_type (Some t) et e.at
 
   | Host (hostop, es) ->
-    check_has_memory c e.at;
-    let {ins; out} = type_hostop hostop in
-    check_exprs c ins es;
-    check_type out et e.at
+    let {hostop_ins; hostop_out; hostop_hasmem} = type_hostop hostop in
+    if hostop_hasmem then
+      check_has_memory c e.at;
+    check_exprs c hostop_ins es;
+    check_type hostop_out et e.at
 
 and check_exprs c ts es =
   let ets = List.map (fun x -> Some x) ts in

ml-proto/spec/eval.ml

@@ -14,7 +14,10 @@ let error = Error.error
 
 type value = Values.value
 type import = value list -> value option
-type host_params = {page_size : Memory.size}
+type host_params = {
+  page_size : Memory.size;
+  has_feature : string -> bool
+}
 
 module ExportMap = Map.Make(String)
 type export_map = func ExportMap.t
@@ -247,7 +250,7 @@ let rec eval_expr (c : config) (e : expr) =
 
   | Host (hostop, es) ->
     let vs = List.map (eval_expr c) es in
-    let mem = some_memory c e.at in
+    let mem = c.instance.memory in
     eval_hostop c.instance.host mem hostop vs e.at
 
 and eval_expr_opt c = function
@@ -277,17 +280,20 @@ and coerce et vo =
 
 (* Host operators *)
 
-and eval_hostop host mem hostop vs at =
+and eval_hostop host mem_opt hostop vs at =
   match hostop, vs with
   | PageSize, [] ->
+    let mem = some mem_opt at in
     assert (I64.lt_u host.page_size (Int64.of_int32 Int32.max_int));
     Some (Int32 (Int64.to_int32 host.page_size))
 
   | MemorySize, [] ->
+    let mem = some mem_opt at in
     assert (I64.lt_u (Memory.size mem) (Int64.of_int32 Int32.max_int));
     Some (Int32 (Int64.to_int32 (Memory.size mem)))
 
   | GrowMemory, [v] ->
+    let mem = some mem_opt at in
     let delta = mem_size v at in
     if I64.rem_u delta host.page_size <> 0L then
       error at "runtime: grow_memory operand not multiple of page_size";
@@ -298,6 +304,9 @@ and eval_hostop host mem hostop vs at =
     Memory.grow mem delta;
     None;
 
+  | HasFeature str, [] ->
+    Some (Int32 (if (host.has_feature str) then 1l else 0l))
+
   | _, _ ->
     error at "runtime: invalid invocation of host operator"
 
@@ -327,4 +336,3 @@ let invoke instance name vs =
     assert (List.length vs = List.length (func_type instance f).ins);
     eval_func instance f vs
   with Stack_overflow -> callstack_exhaustion no_region
-

ml-proto/spec/eval.mli

@@ -5,7 +5,10 @@
 type instance
 type value = Values.value
 type import = value list -> value option
-type host_params = {page_size : Memory.size}
+type host_params = {
+  page_size : Memory.size;
+  has_feature : string -> bool
+}
 
 val init : Ast.module_ -> import list -> host_params -> instance
 val invoke : instance -> string -> value list -> value option

ml-proto/spec/sugar.ml

@@ -88,7 +88,6 @@ let convert (cvt, e) =
 let host (hostop, es) =
   Host (hostop, es)
 
-
 let case (c, br) =
   match br with
   | Some (es, fallthru) -> {value = c; expr = expr_seq es; fallthru}

ml-proto/test/has_feature.wast

@@ -0,0 +1,12 @@
+(module
+  (func $has_wasm (result i32)
+    (has_feature "wasm"))
+  (export "has_wasm" $has_wasm)
+
+  (func $has_simd128 (result i32)
+    (has_feature "simd128"))
+  (export "has_simd128" $has_simd128)
+)
+
+(assert_return (invoke "has_wasm") (i32.const 1))
+(assert_return (invoke "has_simd128") (i32.const 0))