From 54c3cfd69784ad618be8f759368545deb36b7db9 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <ilya.rezvov@revjet.com>
Date: Mon, 19 Apr 2021 17:17:25 -0700
Subject: [PATCH] all tests are green

---
 src/Language/Wasm/Lexer.x  | 7 ++++++-
 src/Language/Wasm/Parser.y | 5 +++--
 tests/Test.hs              | 2 +-
 3 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/src/Language/Wasm/Lexer.x b/src/Language/Wasm/Lexer.x
index 3f09b30..3df148b 100644
--- a/src/Language/Wasm/Lexer.x
+++ b/src/Language/Wasm/Lexer.x
@@ -7,7 +7,8 @@ module Language.Wasm.Lexer (
     AlexPosn(..),
     scanner,
     asFloat,
-    asDouble
+    asDouble,
+    doubleFromInteger
 ) where
 
 import qualified Data.ByteString.Lazy as LBS
@@ -20,6 +21,7 @@ import Data.Word (Word8, Word64)
 import Data.List (isPrefixOf)
 import Text.Read (readEither)
 import Data.Bits
+import Numeric (showHex)
 
 }
 
@@ -267,6 +269,9 @@ asDouble (NanRep (NanHex isPos payload)) =
     then return $ (if isPos then id else negate) $ makeNaN payload
     else Left "constant out of range"
 
+doubleFromInteger :: Integer -> Either String Double
+doubleFromInteger int = asDouble . HexRep . ((if int < 0 then "-0x" else "0x") ++) . flip showHex "" $ abs int
+
 startBlockComment :: AlexAction Lexeme
 startBlockComment _inp _len = do
     depth <- getLexerCommentDepth
diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y
index 2e7aa31..c0f239a 100644
--- a/src/Language/Wasm/Parser.y
+++ b/src/Language/Wasm/Parser.y
@@ -94,7 +94,8 @@ import Language.Wasm.Lexer (
         Lexeme(..),
         AlexPosn(..),
         asFloat,
-        asDouble
+        asDouble,
+        doubleFromInteger
     )
 
 }
@@ -401,7 +402,7 @@ float64 :: { Double }
     : int {%
         let maxInt = round (maxFinite :: Double) in
         if $1 <= maxInt && $1 >= -maxInt
-        then return $ fromIntegral $1
+        then doubleFromInteger $1
         else Left "constant out of range"
     }
     | f64 {% asDouble $1 }
diff --git a/tests/Test.hs b/tests/Test.hs
index 26cd597..7cccffe 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -17,7 +17,7 @@ import qualified Data.List as List
 main :: IO ()
 main = do
   files <- filter (List.isSuffixOf ".wast") <$> Directory.listDirectory "tests/spec"
-  -- let files = ["conversions.wast"]
+  -- let files = ["const.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do