From a5ffe38a1c8d86554c9134afd3a137ced45e76e0 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Mon, 21 Aug 2023 19:28:54 -0600
Subject: [PATCH] more green test

---
 src/Language/Wasm/Interpreter.hs | 4 ++--
 src/Language/Wasm/Validate.hs    | 8 +++++++-
 tests/Test.hs                    | 2 +-
 3 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index b369ad3..b9e7a16 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -948,7 +948,7 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             let dest = fromIntegral d
             let len = fromIntegral n
             dropped <- readIORef isDropped
-            if dropped || src + len > LBS.length bytes || dest + len > size
+            if (dropped && len > 0) || src + len > LBS.length bytes || dest + len > size
             then return Trap
             else do
                 mapM_ (uncurry $ ByteArray.writeByteArray memory) $ zip [fromIntegral d..] $
@@ -974,7 +974,7 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             isDropped <- readIORef dropFlag
             if src + len > Vector.length refs
                 || dst + len > MVector.length els
-                || isDropped
+                || (isDropped && len > 0)
                 || isDeclarative mode
             then return Trap
             else do
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index f871b5f..207f1a1 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -550,9 +550,15 @@ getExpressionTypeWithInput inp = fmap (inp `Arrow`) . foldM go inp
             if isRef v
             then throwError $ TypeMismatch (empty ==> empty) (empty ==> empty)
             else matchStack stack (subst args) (subst res)
+        matchStack (Var:stack) (NonRefVar:args) res =
+            let subst = replace NonRefVar NonRefVar in
+            matchStack stack (subst args) (subst res)
+        matchStack (NonRefVar:stack) (Var:args) res =
+            let subst = replace Var NonRefVar in
+            matchStack stack (subst args) (subst res)
         matchStack stack [] res = return $ res ++ stack
         matchStack [] args res = throwError $ TypeMismatch ((reverse args) `Arrow` res) ([] `Arrow` [])
-        matchStack _ _ _ = error "inconsistent checker state"
+        matchStack st args res = error $ "inconsistent checker state: " ++ show (st, args, res)
 
 getExpressionType :: Expression -> Checker Arrow
 getExpressionType = getExpressionTypeWithInput []
diff --git a/tests/Test.hs b/tests/Test.hs
index a074f67..14cf2cc 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -19,7 +19,7 @@ main = do
   files <-
     filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
       <$> Directory.listDirectory "tests/spec"
-  -- let files = ["imports.wast"]
+  -- let files = ["unreached-valid.wast"]
   scriptTestCases <- (`mapM` files) $ \file -> do
     test <- LBS.readFile ("tests/spec/" ++ file)
     return $ testCase file $ do