fix float numbers parsing

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) =

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

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

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