From b2a0d2c86e08eb4cf183bad7bac43717be78b0b7 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <ilya.rezvov@revjet.com>
Date: Thu, 12 Apr 2018 14:17:01 -0700
Subject: [PATCH] pass return_nan tests

---
 src/Language/Wasm/Interpreter.hs | 46 +++++++++++++++++++++-----------
 src/Language/Wasm/Script.hs      | 16 +++++++++++
 2 files changed, 46 insertions(+), 16 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 84c2efc..8a6f9e5 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -57,8 +57,7 @@ import Language.Wasm.FloatUtils (
         wordToFloat,
         floatToWord,
         wordToDouble,
-        doubleToWord,
-        makeNaN
+        doubleToWord
     )
 
 data Value =
@@ -92,6 +91,7 @@ asWord64 i
 
 nearest :: (IEEE a) => a -> a
 nearest f
+    | isNaN f = f
     | f >= 0 && f <= 0.5 = copySign 0 f
     | f < 0 && f >= -0.5 = -0
     | otherwise =
@@ -110,34 +110,48 @@ nearest f
         )
 
 zeroAwareMin :: IEEE a => a -> a -> a
-zeroAwareMin a b =
-    if identicalIEEE a 0 && identicalIEEE b (-0)
-    then b
-    else minNum a b
+zeroAwareMin a b
+    | identicalIEEE a 0 && identicalIEEE b (-0) = b
+    | isNaN a = a
+    | isNaN b = b
+    | otherwise = minNum a b
 
 zeroAwareMax :: IEEE a => a -> a -> a
-zeroAwareMax a b =
-    if identicalIEEE a (-0) && identicalIEEE b 0
-    then b
-    else maxNum a b
+zeroAwareMax a b
+    | identicalIEEE a (-0) && identicalIEEE b 0 = b
+    | isNaN a = a
+    | isNaN b = b
+    | otherwise = maxNum a b
 
 floatFloor :: Float -> Float
-floatFloor a = copySign (fromIntegral (floor a :: Integer)) a
+floatFloor a
+    | isNaN a = a
+    | otherwise = copySign (fromIntegral (floor a :: Integer)) a
 
 doubleFloor :: Double -> Double
-doubleFloor a = copySign (fromIntegral (floor a :: Integer)) a
+doubleFloor a
+    | isNaN a = a
+    | otherwise = copySign (fromIntegral (floor a :: Integer)) a
 
 floatCeil :: Float -> Float
-floatCeil a = copySign (fromIntegral (ceiling a :: Integer)) a
+floatCeil a
+    | isNaN a = a
+    | otherwise = copySign (fromIntegral (ceiling a :: Integer)) a
 
 doubleCeil :: Double -> Double
-doubleCeil a = copySign (fromIntegral (ceiling a :: Integer)) a
+doubleCeil a
+    | isNaN a = a
+    | otherwise = copySign (fromIntegral (ceiling a :: Integer)) a
 
 floatTrunc :: Float -> Float
-floatTrunc a = copySign (fromIntegral (truncate a :: Integer)) a
+floatTrunc a
+    | isNaN a = a
+    | otherwise = copySign (fromIntegral (truncate a :: Integer)) a
 
 doubleTrunc :: Double -> Double
-doubleTrunc a = copySign (fromIntegral (truncate a :: Integer)) a
+doubleTrunc a
+    | isNaN a = a
+    | otherwise = copySign (fromIntegral (truncate a :: Integer)) a
 
 data Label = Label ResultType deriving (Show, Eq)
 
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index f16660d..facd4c9 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -126,12 +126,28 @@ runScript onAssertFail script = do
         isValueEqual (Interpreter.VF64 v1) (Interpreter.VF64 v2) = identicalIEEE v1 v2
         isValueEqual _ _ = False
 
+        isNaNReturned :: ScriptState -> Action -> Assertion -> IO ()
+        isNaNReturned st action assert = do
+            result <- runAction st action
+            case result of
+                [Interpreter.VF32 v] ->
+                    if isNaN v
+                    then return ()
+                    else onAssertFail ("Expected NaN, but action returned " ++ show v) assert
+                [Interpreter.VF64 v] ->
+                    if isNaN v
+                    then return ()
+                    else onAssertFail ("Expected NaN, but action returned " ++ show v) assert
+                _ -> onAssertFail ("Expected NaN, but action returned " ++ show result) assert
+
         runAssert :: ScriptState -> Assertion -> IO ()
         runAssert st assert@(AssertReturn action expected) = do
             result <- runAction st action
             if length result == length expected && (all id $ zipWith isValueEqual result (map asArg expected))
             then return ()
             else onAssertFail ("Expected " ++ show (map asArg expected) ++ ", but action returned " ++ show result) assert
+        runAssert st assert@(AssertReturnCanonicalNaN action) = isNaNReturned st action assert
+        runAssert st assert@(AssertReturnArithmeticNaN action) = isNaNReturned st action assert
         runAssert _ _ = return ()
 
         runCommand :: ScriptState -> Command -> IO ScriptState