From f6cae32148d58c288b1ff11c59e4946f8d8427d0 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <ilya.rezvov@revjet.com>
Date: Tue, 10 Apr 2018 15:04:18 -0700
Subject: [PATCH] fix float numbers parsing

---
 src/Language/Wasm/Interpreter.hs | 6 +++---
 src/Language/Wasm/Lexer.x        | 8 ++++----
 src/Language/Wasm/Script.hs      | 2 +-
 tests/Test.hs                    | 2 +-
 4 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 64fd4e5..bcb68bf 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -809,11 +809,11 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
         step ctx (F32Const v) = return $ Done ctx { stack = VF32 v : stack ctx }
         step ctx (F64Const v) = return $ Done ctx { stack = VF64 v : stack ctx }
         step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IAdd) =
-            return $ Done ctx { stack = VI32 (v1 + v2) : rest }
+            return $ Done ctx { stack = VI32 (asWord32 $ asInt32 v1 + asInt32 v2) : rest }
         step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 ISub) =
-            return $ Done ctx { stack = VI32 (v1 - v2) : rest }
+            return $ Done ctx { stack = VI32 (asWord32 $ asInt32 v1 - asInt32 v2) : rest }
         step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IMul) =
-            return $ Done ctx { stack = VI32 (v1 * v2) : rest }
+            return $ Done ctx { stack = VI32 (asWord32 $ asInt32 v1 * asInt32 v2) : rest }
         step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IDivU) =
             return $ Done ctx { stack = VI32 (v1 `div` v2) : rest }
         step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IDivS) =
diff --git a/src/Language/Wasm/Lexer.x b/src/Language/Wasm/Lexer.x
index 6e2b203..311509f 100644
--- a/src/Language/Wasm/Lexer.x
+++ b/src/Language/Wasm/Lexer.x
@@ -141,7 +141,7 @@ parseHexFloat :: AlexAction Lexeme
 parseHexFloat = token $ \(pos, _, s, _) len ->
     let (sign, slen) = parseSign s in
     let ('0' : 'x' : str) = filter (/= '_') $ takeChars (len - slen) $ LBS.drop slen s in
-    Lexeme pos $ TFloatLit $ readHexFloat str
+    Lexeme pos $ TFloatLit $ sign $ readHexFloat str
 
 startBlockComment :: AlexAction Lexeme
 startBlockComment _inp _len = do
@@ -340,14 +340,14 @@ readHexFloat str =
         readHexExp :: String -> Double
         readHexExp [] = 1
         readHexExp ('+' : rest) = readHexExp rest
-        readHexExp ('-' : rest) = negate $ readHexExp rest
-        readHexExp expStr = 2 * read expStr
+        readHexExp ('-' : rest) = 1 / readHexExp rest
+        readHexExp expStr = 2 ^ read expStr
 
         readHexFrac :: String -> Double
         readHexFrac [] = 0
         readHexFrac val =
             let len = length val in
-            sum $ zipWith (\i c -> readHexFromChar c / (16 ^ len - i)) [1..] val
+            sum $ zipWith (\i c -> readHexFromChar c / (16 ^ i)) [1..] val
 
 scanner :: LBS.ByteString -> Either String [Lexeme]
 scanner str = runAlex str loop
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index f2e7639..51f2dd5 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -60,7 +60,7 @@ runScript onAssertFail script = do
         ]
     go script $ emptyState { store = st, moduleRegistery = Map.singleton "spectest" inst }
     where
-        hostPrint paramTypes = Interpreter.HostFunction (Struct.FuncType paramTypes []) (const $ return [])
+        hostPrint paramTypes = Interpreter.HostFunction (Struct.FuncType paramTypes []) (\args -> print args >> return [])
         hostGlobals = do
             globI32 <- Interpreter.makeMutGlobal $ Interpreter.VI32 666
             globF32 <- Interpreter.makeMutGlobal $ Interpreter.VF32 666
diff --git a/tests/Test.hs b/tests/Test.hs
index 0a50cdf..b151d24 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -34,7 +34,7 @@ compile file = do
 main :: IO ()
 main = do
   files <- Directory.listDirectory "tests/samples"
-  -- let files = ["call.wast"]
+  -- let files = ["float_misc.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     content <- LBS.readFile $ "tests/samples/" ++ file
     let Right script = Parser.parseScript <$> Lexer.scanner content