pass tests in elem.wat test suit

src/Language/Wasm/Interpreter.hs

@@ -216,7 +216,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
 
@@ -499,8 +508,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) =
+        allocElem (ElemSegment t mode refs) =
-            ElemInstance t
+            ElemInstance mode t
                 <$> (Vector.fromList <$> mapM (evalConstExpr inst st) refs)
                 <*> newIORef False -- is dropped
 
@@ -551,7 +560,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
 
@@ -893,12 +902,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) ->

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"]

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
@@ -596,6 +598,11 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } =
                         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 } =
     let ctx = ctxFromModule [] [] [] m in