From 4a49566dd6d92f3e47cf2640ab0c5f28f6e349ae Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Mon, 12 Oct 2015 17:19:51 +0200 Subject: [PATCH 1/2] Coerce result of void functions to None --- ml-proto/host/parser.mly | 26 +++++-- ml-proto/host/script.ml | 144 +++++++++++++++++------------------ ml-proto/host/script.mli | 8 +- ml-proto/spec/eval.ml | 9 ++- ml-proto/test/functions.wast | 7 ++ 5 files changed, 106 insertions(+), 88 deletions(-) create mode 100644 ml-proto/test/functions.wast diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index cb10da7fa2..557942ddd2 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -345,20 +345,32 @@ module_ : cmd : | module_ { Define $1 @@ at () } + | LPAR INVOKE TEXT const_list RPAR { Invoke ($3, $4) @@ at () } | LPAR ASSERTINVALID module_ TEXT RPAR { AssertInvalid ($3, $4) @@ at () } - | LPAR INVOKE TEXT expr_list RPAR { Invoke ($3, $4 (c0 ())) @@ at () } - | LPAR ASSERTRETURN LPAR INVOKE TEXT expr_list RPAR expr RPAR - { AssertReturn ($5, $6 (c0 ()), $8 (c0 ())) @@ at () } - | LPAR ASSERTRETURNNAN LPAR INVOKE TEXT expr_list RPAR RPAR - { AssertReturnNaN ($5, $6 (c0 ())) @@ at () } - | LPAR ASSERTTRAP LPAR INVOKE TEXT expr_list RPAR TEXT RPAR - { AssertTrap ($5, $6 (c0 ()), $8) @@ at () } + | LPAR ASSERTRETURN LPAR INVOKE TEXT const_list RPAR const_opt RPAR + { AssertReturn ($5, $6, $8) @@ at () } + | LPAR ASSERTRETURNNAN LPAR INVOKE TEXT const_list RPAR RPAR + { AssertReturnNaN ($5, $6) @@ at () } + | LPAR ASSERTTRAP LPAR INVOKE TEXT const_list RPAR TEXT RPAR + { AssertTrap ($5, $6, $8) @@ at () } ; cmd_list : | /* empty */ { [] } | cmd cmd_list { $1 :: $2 } ; +const : + | LPAR CONST literal RPAR { literal $3 $2 } +; +const_opt : + | /* empty */ { None } + | const { Some $1 } +; +const_list : + | /* empty */ { [] } + | const const_list { $1 :: $2 } +; + script : | cmd_list EOF { $1 } ; diff --git a/ml-proto/host/script.ml b/ml-proto/host/script.ml index 53804fcfe9..63d15af837 100644 --- a/ml-proto/host/script.ml +++ b/ml-proto/host/script.ml @@ -4,16 +4,17 @@ open Source + (* Script representation *) type command = command' phrase and command' = | Define of Ast.module_ + | Invoke of string * Ast.literal list | AssertInvalid of Ast.module_ * string - | Invoke of string * Ast.expr list - | AssertReturn of string * Ast.expr list * Ast.expr - | AssertReturnNaN of string * Ast.expr list - | AssertTrap of string * Ast.expr list * string + | AssertReturn of string * Ast.literal list * Ast.literal option + | AssertReturnNaN of string * Ast.literal list + | AssertTrap of string * Ast.literal list * string type script = command list @@ -24,13 +25,6 @@ let trace name = if !Flags.trace then print_endline ("-- " ^ name) let current_module : Eval.instance option ref = ref None -let eval_args es at = - let evs = List.map Eval.host_eval es in - let reject_none = function - | Some v -> v - | None -> Error.error at "unexpected () value" in - List.map reject_none evs - let get_module at = match !current_module with | Some m -> m | None -> Error.error at "no module defined to invoke" @@ -71,89 +65,91 @@ let run_command cmd = let host_params = {Eval.page_size = Params.page_size} in current_module := Some (Eval.init m imports host_params) - | AssertInvalid (m, re) -> - trace "Checking invalid..."; - assert_error (fun () -> Check.check_module m) "invalid module" re cmd.at - | Invoke (name, es) -> trace "Invoking..."; let m = get_module cmd.at in - let vs = eval_args es cmd.at in - let v = Eval.invoke m name vs in + let v = Eval.invoke m name (List.map it es) in if v <> None then Print.print_value v - | AssertReturn (name, arg_es, expect_e) -> + | AssertInvalid (m, re) -> + trace "Asserting invalid..."; + assert_error (fun () -> Check.check_module m) "invalid module" re cmd.at + + | AssertReturn (name, es, expect_e) -> let open Values in - trace "AssertReturn invoking..."; + trace "Asserting return..."; let m = get_module cmd.at in - let arg_vs = eval_args arg_es cmd.at in - let got_v = Eval.invoke m name arg_vs in - let expect_v = Eval.host_eval expect_e in + let got_v = Eval.invoke m name (List.map it es) in + let expect_v = Lib.Option.map it expect_e in (match got_v, expect_v with - | Some Int32 got_i32, Some Int32 expect_i32 -> - if got_i32 <> expect_i32 then begin - show_result_expect got_v expect_v; - Error.error cmd.at "assert_return i32 operands are not equal" - end - | Some Int64 got_i64, Some Int64 expect_i64 -> - if got_i64 <> expect_i64 then begin - show_result_expect got_v expect_v; - Error.error cmd.at "assert_return i64 operands are not equal" - end - | Some Float32 got_f32, Some Float32 expect_f32 -> - if (F32.to_bits got_f32) <> (F32.to_bits expect_f32) then begin - show_result_expect got_v expect_v; - Error.error cmd.at - "assert_return f32 operands have different bit patterns" - end - | Some Float64 got_f64, Some Float64 expect_f64 -> - if (F64.to_bits got_f64) <> (F64.to_bits expect_f64) then begin - show_result_expect got_v expect_v; - Error.error cmd.at - "assert_return f64 operands have different bit patterns" - end - | _, _ -> begin - show_result_expect got_v expect_v; - Error.error cmd.at "assert_return operands must be the same type" - end) - - | AssertReturnNaN (name, arg_es) -> + | None, None -> () + | Some (Int32 got_i32), Some (Int32 expect_i32) -> + if got_i32 <> expect_i32 then begin + show_result_expect got_v expect_v; + Error.error cmd.at "assert_return i32 operands are not equal" + end + | Some (Int64 got_i64), Some (Int64 expect_i64) -> + if got_i64 <> expect_i64 then begin + show_result_expect got_v expect_v; + Error.error cmd.at "assert_return i64 operands are not equal" + end + | Some (Float32 got_f32), Some (Float32 expect_f32) -> + if (F32.to_bits got_f32) <> (F32.to_bits expect_f32) then begin + show_result_expect got_v expect_v; + Error.error cmd.at + "assert_return f32 operands have different bit patterns" + end + | Some (Float64 got_f64), Some (Float64 expect_f64) -> + if (F64.to_bits got_f64) <> (F64.to_bits expect_f64) then begin + show_result_expect got_v expect_v; + Error.error cmd.at + "assert_return f64 operands have different bit patterns" + end + | _, _ -> + begin + show_result_expect got_v expect_v; + Error.error cmd.at "assert_return operands must be the same type" + end + ) + + | AssertReturnNaN (name, es) -> let open Values in - trace "AssertReturnNaN invoking..."; + trace "Asserting return..."; let m = get_module cmd.at in - let arg_vs = eval_args arg_es cmd.at in - let got_v = Eval.invoke m name arg_vs in + let got_v = Eval.invoke m name (List.map it es) in (match got_v with - | Some Float32 got_f32 -> - if (F32.eq got_f32 got_f32) then begin - show_result got_v; - Error.error cmd.at "assert_return_nan f32 operand is not a NaN" - end - | Some Float64 got_f64 -> - if (F64.eq got_f64 got_f64) then begin - show_result got_v; - Error.error cmd.at "assert_return_nan f64 operand is not a NaN" - end - | _ -> begin - show_result got_v; - Error.error cmd.at "assert_return_nan operand must be f32 or f64" - end) + | Some (Float32 got_f32) -> + if (F32.eq got_f32 got_f32) then begin + show_result got_v; + Error.error cmd.at "assert_return_nan f32 operand is not a NaN" + end + | Some (Float64 got_f64) -> + if (F64.eq got_f64 got_f64) then begin + show_result got_v; + Error.error cmd.at "assert_return_nan f64 operand is not a NaN" + end + | _ -> + begin + show_result got_v; + Error.error cmd.at "assert_return_nan operand must be f32 or f64" + end + ) | AssertTrap (name, es, re) -> - trace "AssertTrap invoking..."; + trace "Asserting trap..."; let m = get_module cmd.at in - let vs = eval_args es cmd.at in - assert_error (fun () -> Eval.invoke m name vs) "trap" re cmd.at + assert_error (fun () -> Eval.invoke m name (List.map it es)) + "trap" re cmd.at let dry_command cmd = match cmd.it with | Define m -> Check.check_module m; if !Flags.print_sig then Print.print_module_sig m - | AssertInvalid _ -> () - | Invoke _ -> () - | AssertReturn _ -> () - | AssertReturnNaN _ -> () + | Invoke _ + | AssertInvalid _ + | AssertReturn _ + | AssertReturnNaN _ | AssertTrap _ -> () let run script = diff --git a/ml-proto/host/script.mli b/ml-proto/host/script.mli index 63ff0b2a70..25f45ddc01 100644 --- a/ml-proto/host/script.mli +++ b/ml-proto/host/script.mli @@ -5,11 +5,11 @@ type command = command' Source.phrase and command' = | Define of Ast.module_ + | Invoke of string * Ast.literal list | AssertInvalid of Ast.module_ * string - | Invoke of string * Ast.expr list - | AssertReturn of string * Ast.expr list * Ast.expr - | AssertReturnNaN of string * Ast.expr list - | AssertTrap of string * Ast.expr list * string + | AssertReturn of string * Ast.literal list * Ast.literal option + | AssertReturnNaN of string * Ast.literal list + | AssertTrap of string * Ast.literal list * string type script = command list diff --git a/ml-proto/spec/eval.ml b/ml-proto/spec/eval.ml index ea69ba152e..2a2c5761ae 100644 --- a/ml-proto/spec/eval.ml +++ b/ml-proto/spec/eval.ml @@ -265,12 +265,15 @@ and eval_case c vo stage case = | `Seek, false | `Done _, _ -> stage -and eval_func (m : instance) (f : func) (evs : value list) = - let args = List.map ref evs in +and eval_func (m : instance) f vs = + let args = List.map ref vs in let vars = List.map (fun t -> ref (default_value t.it)) f.it.locals in let locals = args @ vars in let c = {module_ = m; locals; labels = []} in - eval_expr c f.it.body + coerce f.it.result (eval_expr c f.it.body) + +and coerce et vo = + if et = None then None else vo (* Modules *) diff --git a/ml-proto/test/functions.wast b/ml-proto/test/functions.wast new file mode 100644 index 0000000000..3d4f35a3fd --- /dev/null +++ b/ml-proto/test/functions.wast @@ -0,0 +1,7 @@ +(module + (func $return-none (i32.const 1)) + (export "return-none" $return-none) +) + +(assert_return (invoke "return-none")) + From d051eeb38c85a0692bdfe013fe20dde1f782a579 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Mon, 12 Oct 2015 17:22:18 +0200 Subject: [PATCH 2/2] Remove host_eval --- ml-proto/spec/eval.ml | 7 ------- ml-proto/spec/eval.mli | 2 -- 2 files changed, 9 deletions(-) diff --git a/ml-proto/spec/eval.ml b/ml-proto/spec/eval.ml index 2a2c5761ae..c9b62bc338 100644 --- a/ml-proto/spec/eval.ml +++ b/ml-proto/spec/eval.ml @@ -302,10 +302,3 @@ let invoke m name vs = eval_func m f vs with Stack_overflow -> callstack_exhaustion no_region -(* This function is not part of the spec. *) -let host_eval e = - let f = {params = []; result = None; locals = []; body = e} @@ no_region in - let exports = ExportMap.singleton "eval" f in - let host = {page_size = 1L} in - let m = {imports = []; exports; tables = []; funcs = [f]; memory = None; host} in - eval_func m f [] diff --git a/ml-proto/spec/eval.mli b/ml-proto/spec/eval.mli index 2442bfe13f..deeb5f016a 100644 --- a/ml-proto/spec/eval.mli +++ b/ml-proto/spec/eval.mli @@ -11,5 +11,3 @@ val init : Ast.module_ -> import list -> host_params -> instance val invoke : instance -> string -> value list -> value option (* raise Error.Error *) -(* This function is not part of the spec. *) -val host_eval : Ast.expr -> value option (* raise Error.Error *)