From d64854aac17d1b8305e1c9cf6bd75c470fbebfb6 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <ilya.rezvov@revjet.com>
Date: Wed, 11 Apr 2018 15:24:27 -0700
Subject: [PATCH] clean up labels on exit from blocks and return correct type
 for i64 unary operations

---
 src/Language/Wasm/Interpreter.hs | 11 +++++++----
 tests/Test.hs                    |  2 +-
 2 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 6c5a3ec..7f0cc9b 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -570,12 +570,14 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
             case res of
                 Break 0 r EvalCtx{ locals = ls } -> return $ Done ctx { locals = ls, stack = r ++ stack ctx }
                 Break n r ctx' -> return $ Break (n - 1) r ctx'
+                Done ctx'@EvalCtx{ labels = (_:rest) } -> return $ Done ctx' { labels = rest }
                 command -> return command
         step ctx loop@(Loop resType expr) = do
             res <- go ctx { labels = Label resType : labels ctx } expr
             case res of
                 Break 0 r EvalCtx{ locals = ls } -> step ctx { locals = ls, stack = r ++ stack ctx } loop
                 Break n r ctx' -> return $ Break (n - 1) r ctx'
+                Done ctx'@EvalCtx{ labels = (_:rest) } -> return $ Done ctx' { labels = rest }
                 command -> return command
         step ctx@EvalCtx{ stack = (VI32 v): rest } (If resType true false) = do
             let expr = if v /= 0 then true else false
@@ -583,6 +585,7 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
             case res of
                 Break 0 r EvalCtx{ locals = ls } -> return $ Done ctx { locals = ls, stack = r ++ rest }
                 Break n r ctx' -> return $ Break (n - 1) r ctx'
+                Done ctx'@EvalCtx{ labels = (_:rest) } -> return $ Done ctx' { labels = rest }
                 command -> return command
         step ctx@EvalCtx{ stack, labels } (Br label) = do
             let idx = fromIntegral label
@@ -952,11 +955,11 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
         step ctx@EvalCtx{ stack = (VI64 v:rest) } I64Eqz =
             return $ Done ctx { stack = VI32 (if v == 0 then 1 else 0) : rest }
         step ctx@EvalCtx{ stack = (VI64 v:rest) } (IUnOp BS64 IClz) =
-            return $ Done ctx { stack = VI32 (fromIntegral $ countLeadingZeros v) : rest }
+            return $ Done ctx { stack = VI64 (fromIntegral $ countLeadingZeros v) : rest }
         step ctx@EvalCtx{ stack = (VI64 v:rest) } (IUnOp BS64 ICtz) =
-            return $ Done ctx { stack = VI32 (fromIntegral $ countTrailingZeros v) : rest }
+            return $ Done ctx { stack = VI64 (fromIntegral $ countTrailingZeros v) : rest }
         step ctx@EvalCtx{ stack = (VI64 v:rest) } (IUnOp BS64 IPopcnt) =
-            return $ Done ctx { stack = VI32 (fromIntegral $ popCount v) : rest }
+            return $ Done ctx { stack = VI64 (fromIntegral $ popCount v) : rest }
         step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FAbs) =
             return $ Done ctx { stack = VF32 (abs v) : rest }
         step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FNeg) =
@@ -1087,7 +1090,7 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
             return $ Done ctx { stack = VF32 (wordToFloat v) : rest }
         step ctx@EvalCtx{ stack = (VI64 v:rest) } (FReinterpretI BS64) =
             return $ Done ctx { stack = VF64 (wordToDouble v) : rest }
-        step _   instr = error $ "Error during evaluation of instruction: " ++ show instr
+        step EvalCtx{ stack } instr = error $ "Error during evaluation of instruction: " ++ show instr ++ ". Stack " ++ show stack
 eval _ HostInstance { funcType, hostCode } args = hostCode args
 
 invoke :: Store -> Address -> [Value] -> IO [Value]
diff --git a/tests/Test.hs b/tests/Test.hs
index a76a714..4451cf3 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 = ["if.wast"]
+  -- let files = ["labels.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     content <- LBS.readFile $ "tests/samples/" ++ file
     let Right script = Parser.parseScript <$> Lexer.scanner content