From 0b44ee13b8021dae0498975a878f008dc152b882 Mon Sep 17 00:00:00 2001
From: Ilya Rezvov <rezvov.ilya@gmail.com>
Date: Thu, 2 Jun 2022 20:54:15 -0600
Subject: [PATCH] pass tests in elem.wat test suit

---
 src/Language/Wasm/Interpreter.hs | 28 ++++++++++++++++++++++------
 src/Language/Wasm/Script.hs      |  1 +
 src/Language/Wasm/Validate.hs    | 13 ++++++++++---
 3 files changed, 33 insertions(+), 9 deletions(-)

diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs
index 01ff9b4..1143808 100644
--- a/src/Language/Wasm/Interpreter.hs
+++ b/src/Language/Wasm/Interpreter.hs
@@ -220,7 +220,16 @@ data FunctionInstance =
         hostCode :: HostFunction
     }
 
-data ElemInstance = ElemInstance ElemType (Vector Value) (IORef Bool)
+data ElemInstance = ElemInstance {
+        eiMode :: ElemMode,
+        eiType :: ElemType,
+        eiItems :: Vector Value,
+        isDropped :: IORef Bool
+    }
+
+isDeclarative :: ElemMode -> Bool 
+isDeclarative Declarative = True
+isDeclarative _           = False
 
 data DataInstance = DataInstance
 
@@ -503,8 +512,8 @@ allocElems :: ModuleInstance -> Store -> [ElemSegment] -> IO (Vector ElemInstanc
 allocElems inst st = fmap Vector.fromList . mapM allocElem
     where
         allocElem :: ElemSegment -> IO ElemInstance
-        allocElem (ElemSegment t _mode refs) =
-            ElemInstance t
+        allocElem (ElemSegment t mode refs) =
+            ElemInstance mode t
                 <$> (Vector.fromList <$> mapM (evalConstExpr inst st) refs)
                 <*> newIORef False -- is dropped
 
@@ -555,7 +564,7 @@ initialize inst Module {elems, datas, start} = do
         initElem (tableIdx, elemIdx, from, funcs) = do
             Store {tableInstances, elemInstances} <- State.get
             let elems = items $ tableInstances ! tableIdx
-            let ElemInstance _ _ isDropped = elemInstances ! elemIdx
+            let ElemInstance {isDropped} = elemInstances ! elemIdx
             liftIO $ writeIORef isDropped True
             Monad.forM_ (zip [from..] funcs) $ uncurry $ MVector.unsafeWrite elems
 
@@ -897,12 +906,19 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
             let tableAddr = tableaddrs moduleInstance ! fromIntegral tableIdx
             let TableInstance { items } = tableInstances store ! tableAddr
             let elemAddr = elemaddrs moduleInstance ! fromIntegral elemIdx
-            let ElemInstance _ refs dropFlag = elemInstances store ! elemAddr
+            let ElemInstance {
+                    eiItems = refs,
+                    eiMode = mode,
+                    isDropped = dropFlag
+                } = elemInstances store ! elemAddr
             let src = fromIntegral s
             let dst = fromIntegral d
             let len = fromIntegral n
             isDropped <- readIORef dropFlag
-            if src + len > Vector.length refs || dst + len > MVector.length items || isDropped
+            if src + len > Vector.length refs
+                || dst + len > MVector.length items
+                || isDropped
+                || isDeclarative mode
             then return Trap
             else do
                 Vector.iforM_ (Vector.slice src len refs) $ \idx (RF fn) ->
diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs
index ddb659c..a4ce926 100644
--- a/src/Language/Wasm/Script.hs
+++ b/src/Language/Wasm/Script.hs
@@ -173,6 +173,7 @@ runScript onAssertFail script = do
 
         getFailureString :: Validate.ValidationError -> [TL.Text]
         getFailureString (Validate.TypeMismatch _ _) = ["type mismatch"]
+        getFailureString (Validate.RefTypeMismatch _ _) = ["type mismatch"]
         getFailureString Validate.ResultTypeDoesntMatch = ["type mismatch"]
         getFailureString Validate.MoreThanOneMemory = ["multiple memories"]
         getFailureString Validate.MoreThanOneTable = ["multiple tables"]
diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs
index cfbadd7..6ef2824 100644
--- a/src/Language/Wasm/Validate.hs
+++ b/src/Language/Wasm/Validate.hs
@@ -15,7 +15,7 @@ import Language.Wasm.Structure
 import qualified Data.Set as Set
 import Data.List (foldl')
 import qualified Data.Text.Lazy as TL
-import Data.Maybe (fromMaybe, maybeToList, catMaybes)
+import Data.Maybe (fromMaybe, catMaybes)
 import Numeric.Natural (Natural)
 import Prelude hiding ((<>))
 
@@ -269,7 +269,7 @@ getInstrType RefIsNull = do
 getInstrType (RefFunc funIdx) = do
     Ctx { funcs } <- ask
     if fromIntegral funIdx < length funcs
-    then return $ empty ==> Val I32
+    then return $ empty ==> Val Func
     else throwError FunctionIndexOutOfRange
 getInstrType (GetLocal local) = do
     Ctx { locals }  <- ask
@@ -583,8 +583,10 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
         isElemValid :: Ctx -> ElemSegment -> ValidationResult
         isElemValid ctx (ElemSegment elemType mode elements) = do
             forM_ elements $ \elem -> runChecker ctx $ do
-                getExpressionType elem
+                arr <- getExpressionType elem
                 isConstExpression elem
+                unless (isValidRef elemType arr)
+                    $ throwError $ RefTypeMismatch elemType elemType
             case mode of
                 Active tableIdx offset -> runChecker ctx $ do
                     isConstExpression offset
@@ -595,6 +597,11 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
                     when (tableIdx >= fromIntegral (length tableImports + length tables)) $ do
                         throwError $ TableIndexOutOfRange tableIdx
                 _ -> return ()
+        
+        isValidRef :: ElemType -> Arrow -> Bool
+        isValidRef FuncRef arr | arr == (empty ==> Func) = True
+        isValidRef ExternRef arr | arr == (empty ==> Extern) = True
+        isValidRef _ _ = False
 
 datasShouldBeValid :: Validator
 datasShouldBeValid m@Module { datas, mems, imports } =