From 745505a10d984c7a7522565d7329d9c148b841c9 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Wed, 26 Aug 2015 10:31:11 +0200 Subject: [PATCH 1/3] Implement accurate float32 semantics --- ml-proto/src/arithmetic.ml | 16 ++++++------ ml-proto/src/parser.mly | 3 ++- ml-proto/src/values.ml | 5 ++++ ml-proto/test/float32.wasm | 52 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 67 insertions(+), 9 deletions(-) create mode 100644 ml-proto/test/float32.wasm diff --git a/ml-proto/src/arithmetic.ml b/ml-proto/src/arithmetic.ml index 0d66fa2f59..fa70b2095b 100644 --- a/ml-proto/src/arithmetic.ml +++ b/ml-proto/src/arithmetic.ml @@ -80,7 +80,7 @@ struct let of_big_int_u = of_big_int_u_for size Big_int.int64_of_big_int end -module IntOp (IntOpSyntax : module type of Ast.IntOp ()) (Int : INT) = +module IntOp (IntOpSyntax : module type of Ast.IntOp()) (Int : INT) = struct open IntOpSyntax open Big_int @@ -133,13 +133,14 @@ struct | ToInt32U -> fun i -> Int32 (Int32X.of_big_int_u (Int.to_big_int_u i)) | ToInt64S -> fun i -> Int64 (Int.to_int64 i) | ToInt64U -> fun i -> Int64 (Int64X.of_big_int_u (Int.to_big_int_u i)) - | ToFloat32S -> fun i -> Float32 (Int.to_float i) - | ToFloat32U -> fun i -> Float32 (float_of_big_int (Int.to_big_int_u i)) + | ToFloat32S -> fun i -> Float32 (float32 (Int.to_float i)) + | ToFloat32U -> fun i -> + Float32 (float32 (float_of_big_int (Int.to_big_int_u i))) | ToFloat64S -> fun i -> Float64 (Int.to_float i) | ToFloat64U -> fun i -> Float64 (float_of_big_int (Int.to_big_int_u i)) | ToFloatCast -> fun i -> if Int.size = 32 - then Float32 (Int.float_of_bits i) + then Float32 (float32 (Int.float_of_bits i)) else Float64 (Int.float_of_bits i) in fun v -> f (Int.of_value 1 v) end @@ -160,7 +161,7 @@ end module Float32X = struct let size = 32 - let to_value z = Float32 z + let to_value z = Float32 (float32 z) let of_value n = function Float32 z -> z | v -> raise (TypeError (n, v, Float32Type)) end @@ -173,8 +174,7 @@ struct function Float64 z -> z | v -> raise (TypeError (n, v, Float64Type)) end -module FloatOp (FloatOpSyntax : module type of Ast.FloatOp ()) - (Float : FLOAT) = +module FloatOp (FloatOpSyntax : module type of Ast.FloatOp()) (Float : FLOAT) = struct open FloatOpSyntax @@ -227,7 +227,7 @@ struct if x < limit then Int64.of_float x else Int64.add (Int64.of_float (x -. limit +. 1.0)) Int64.max_int in Int64 i - | ToFloat32 -> fun x -> Float32 x + | ToFloat32 -> fun x -> Float32 (float32 x) | ToFloat64 -> fun x -> Float64 x | ToIntCast -> fun x -> if Float.size = 32 diff --git a/ml-proto/src/parser.mly b/ml-proto/src/parser.mly index 2b6e5f5db4..0f2773a3df 100644 --- a/ml-proto/src/parser.mly +++ b/ml-proto/src/parser.mly @@ -36,7 +36,8 @@ let literal at s t = match t with | Types.Int32Type -> Values.Int32 (Int32.of_string s) @@ at | Types.Int64Type -> Values.Int64 (Int64.of_string s) @@ at - | Types.Float32Type -> Values.Float32 (float_of_string s) @@ at + | Types.Float32Type -> + Values.Float32 (Values.float32 (float_of_string s)) @@ at | Types.Float64Type -> Values.Float64 (float_of_string s) @@ at with _ -> Error.error at "constant out of range" diff --git a/ml-proto/src/values.ml b/ml-proto/src/values.ml index f9f53f2239..81a425a205 100644 --- a/ml-proto/src/values.ml +++ b/ml-proto/src/values.ml @@ -38,3 +38,8 @@ let string_of_value = function let string_of_values = function | [v] -> string_of_value v | vs -> "(" ^ String.concat " " (List.map string_of_value vs) ^ ")" + + +(* Float32 truncation *) + +let float32 x = Int32.float_of_bits (Int32.bits_of_float x) diff --git a/ml-proto/test/float32.wasm b/ml-proto/test/float32.wasm new file mode 100644 index 0000000000..bacf4e165e --- /dev/null +++ b/ml-proto/test/float32.wasm @@ -0,0 +1,52 @@ +(module + (func $eq_float32 (param $x f32) (param $y f32) (result i32) + (eq.f32 (getlocal $x) (getlocal $y)) + ) + + (func $eq_float64 (param $x f64) (param $y f64) (result i32) + (eq.f64 (getlocal $x) (getlocal $y)) + ) + + (func $div_float32 (param $x f32) (param $y f32) (result f32) + (div.f32 (getlocal $x) (getlocal $y)) + ) + + (func $div_float64 (param $x f64) (param $y f64) (result f64) + (div.f64 (getlocal $x) (getlocal $y)) + ) + + (export "eq_float32" $eq_float32) + (export "eq_float64" $eq_float64) + (export "div_float32" $div_float32) + (export "div_float64" $div_float64) +) + +(asserteq + (invoke "eq_float32" (const.f32 1.123456789012345) (const.f32 1.123456789)) + (const.i32 1) +) + +(asserteq + (invoke "eq_float64" (const.f64 1.123456789012345) (const.f64 1.123456789)) + (const.i32 0) +) + +(asserteq + (invoke "eq_float32" (const.f32 1e40) (const.f32 1e50)) + (const.i32 1) +) + +(asserteq + (invoke "eq_float64" (const.f64 1e40) (const.f64 1e50)) + (const.i32 0) +) + +(asserteq + (invoke "div_float32" (const.f32 1.123456789012345) (const.f32 100)) + (const.f32 0.011234568432) +) + +(asserteq + (invoke "div_float64" (const.f64 1.123456789012345) (const.f64 100)) + (const.f64 0.01123456789012345) +) From e774a19a876361c7334477e8028f52802d5d6c21 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Wed, 26 Aug 2015 17:29:02 +0200 Subject: [PATCH 2/3] Remove float mod operator --- ml-proto/src/arithmetic.ml | 1 - ml-proto/src/ast.ml | 2 +- ml-proto/src/lexer.mll | 1 - 3 files changed, 1 insertion(+), 3 deletions(-) diff --git a/ml-proto/src/arithmetic.ml b/ml-proto/src/arithmetic.ml index fa70b2095b..f9218b56ad 100644 --- a/ml-proto/src/arithmetic.ml +++ b/ml-proto/src/arithmetic.ml @@ -194,7 +194,6 @@ struct | Sub -> (-.) | Mul -> ( *.) | Div -> (/.) - | Mod -> mod_float | CopySign -> copysign in fun v1 v2 -> Float.to_value (f (Float.of_value 1 v1) (Float.of_value 2 v2)) diff --git a/ml-proto/src/ast.ml b/ml-proto/src/ast.ml index 04839eea60..1a35392928 100644 --- a/ml-proto/src/ast.ml +++ b/ml-proto/src/ast.ml @@ -44,7 +44,7 @@ end module FloatOp () = struct type unop = Neg | Abs | Ceil | Floor | Trunc | Round - type binop = Add | Sub | Mul | Div | Mod | CopySign + type binop = Add | Sub | Mul | Div | CopySign type relop = Eq | Neq | Lt | Le | Gt | Ge type cvt = ToInt32S | ToInt32U | ToInt64S | ToInt64U | ToIntCast | ToFloat32 | ToFloat64 diff --git a/ml-proto/src/lexer.mll b/ml-proto/src/lexer.mll index accdf425be..91a094e887 100644 --- a/ml-proto/src/lexer.mll +++ b/ml-proto/src/lexer.mll @@ -189,7 +189,6 @@ rule token = parse | "sub."(fxx as t) { BINARY (floatop t F32.Sub F64.Sub) } | "mul."(fxx as t) { BINARY (floatop t F32.Mul F64.Mul) } | "div."(fxx as t) { BINARY (floatop t F32.Div F64.Div) } - | "mod."(fxx as t) { BINARY (floatop t F32.Mod F64.Mod) } | "copysign."(fxx as t) { BINARY (floatop t F32.CopySign F64.CopySign) } | "eq."(ixx as t) { COMPARE (intop t I32.Eq I64.Eq) } From 56f8f564699873614088264e6bf8e578e45d953c Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Wed, 26 Aug 2015 19:58:13 +0200 Subject: [PATCH 3/3] Don't rely on rounding for literals --- ml-proto/src/lexer.mll | 2 +- ml-proto/test/float32.wasm | 26 +++++++++++++++++++------- 2 files changed, 20 insertions(+), 8 deletions(-) diff --git a/ml-proto/src/lexer.mll b/ml-proto/src/lexer.mll index 91a094e887..8db7dcbf50 100644 --- a/ml-proto/src/lexer.mll +++ b/ml-proto/src/lexer.mll @@ -104,7 +104,7 @@ let character = [^'"''\\''\n'] | '\\'escape | '\\'hexdigit hexdigit let num = ('+' | '-')? digit+ let int = num -let float = (num '.' digit+) | num ('e' | 'E') num +let float = (num '.' digit+) | num ('.' digit+)? ('e' | 'E') num let text = '"' character* '"' let name = '$' (letter | digit | '_' | tick | symbol)+ diff --git a/ml-proto/test/float32.wasm b/ml-proto/test/float32.wasm index bacf4e165e..fe25540383 100644 --- a/ml-proto/test/float32.wasm +++ b/ml-proto/test/float32.wasm @@ -22,31 +22,43 @@ ) (asserteq - (invoke "eq_float32" (const.f32 1.123456789012345) (const.f32 1.123456789)) + (invoke "eq_float32" + (add.f32 (const.f32 1.1234567890) (const.f32 1.2345e-10)) + (const.f32 1.123456789) + ) (const.i32 1) ) (asserteq - (invoke "eq_float64" (const.f64 1.123456789012345) (const.f64 1.123456789)) + (invoke "eq_float64" + (add.f64 (const.f64 1.1234567890) (const.f64 1.2345e-10)) + (const.f64 1.123456789) + ) (const.i32 0) ) (asserteq - (invoke "eq_float32" (const.f32 1e40) (const.f32 1e50)) + (invoke "eq_float32" + (mul.f32 (const.f32 1e20) (const.f32 1e20)) + (mul.f32 (const.f32 1e25) (const.f32 1e25)) + ) (const.i32 1) ) (asserteq - (invoke "eq_float64" (const.f64 1e40) (const.f64 1e50)) + (invoke "eq_float64" + (mul.f64 (const.f64 1e20) (const.f64 1e20)) + (mul.f64 (const.f64 1e25) (const.f64 1e25)) + ) (const.i32 0) ) (asserteq - (invoke "div_float32" (const.f32 1.123456789012345) (const.f32 100)) + (invoke "div_float32" (const.f32 1.123456789) (const.f32 100)) (const.f32 0.011234568432) ) (asserteq - (invoke "div_float64" (const.f64 1.123456789012345) (const.f64 100)) - (const.f64 0.01123456789012345) + (invoke "div_float64" (const.f64 1.123456789) (const.f64 100)) + (const.f64 0.01123456789) )