all tests are green

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

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 }

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