check if target and local type of call_indirect are the same

src/Language/Wasm/Interpreter.hs

@@ -588,7 +588,8 @@ data EvalResult =
 
 eval :: Store -> FunctionInstance -> [Value] -> IO (Maybe [Value])
 eval store FunctionInstance { funcType, moduleInstance, code = Function { localTypes, body} } args = do
-    let checkedArgs = zipWith checkValType (params funcType) args
+    case sequence $ zipWith checkValType (params funcType) args of
+        Just checkedArgs -> do
             let initialContext = EvalCtx {
                     locals = Vector.fromList $ checkedArgs ++ map initLocal localTypes,
                     labels = [Label $ results funcType],
@@ -601,13 +602,14 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
                 Break 0 r _ -> return $ Just $ reverse r
                 Break _ _ _ -> error "Break is out of range"
                 Trap -> return Nothing
+        Nothing -> return Nothing
     where
-        checkValType :: ValueType -> Value -> Value
+        checkValType :: ValueType -> Value -> Maybe Value
-        checkValType I32 (VI32 v) = VI32 v
+        checkValType I32 (VI32 v) = Just $ VI32 v
-        checkValType I64 (VI64 v) = VI64 v
+        checkValType I64 (VI64 v) = Just $ VI64 v
-        checkValType F32 (VF32 v) = VF32 v
+        checkValType F32 (VF32 v) = Just $ VF32 v
-        checkValType F64 (VF64 v) = VF64 v
+        checkValType F64 (VF64 v) = Just $ VF64 v
-        checkValType _   _        = error "Value types do not match provided value"
+        checkValType _   _        = Nothing
 
         initLocal :: ValueType -> Value
         initLocal I32 = VI32 0
@@ -652,7 +654,9 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
         step ctx@EvalCtx{ stack, labels } (Br label) = do
             let idx = fromIntegral label
             let Label resType = labels !! idx
-            return $ Break idx (zipWith checkValType resType $ take (length resType) stack) ctx
+            case sequence $ zipWith checkValType resType $ take (length resType) stack of
+                Just result -> return $ Break idx result ctx
+                Nothing -> return Trap
         step ctx@EvalCtx{ stack = (VI32 v): rest } (BrIf label) =
             if v == 0
             then return $ Done ctx { stack = rest }
@@ -663,15 +667,20 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
             step ctx { stack = rest } (Br lbl)
         step EvalCtx{ stack } Return =
             let resType = results funcType in
-            return $ ReturnFn $ reverse $ zipWith checkValType resType $ take (length resType) stack
+            case sequence $ zipWith checkValType resType $ take (length resType) stack of
+                Just result -> return $ ReturnFn $ reverse result
+                Nothing -> return Trap
         step ctx (Call fun) = do
             let funInst = funcInstances store ! (funcaddrs moduleInstance ! fromIntegral fun)
             let ft = Language.Wasm.Interpreter.funcType funInst 
             let args = params ft
-            res <- eval store funInst (zipWith checkValType args $ reverse $ take (length args) $ stack ctx)
+            case sequence $ zipWith checkValType args $ reverse $ take (length args) $ stack ctx of
+                Just params -> do
+                    res <- eval store funInst params
                     case res of
                         Just res -> return $ Done ctx { stack = reverse res ++ (drop (length args) $ stack ctx) }
                         Nothing -> return Trap
+                Nothing -> return Trap
         step ctx@EvalCtx{ stack = (VI32 v): rest } (CallIndirect typeIdx) = do
             let funcType = funcTypes moduleInstance ! fromIntegral typeIdx
             let TableInstance { elements } = tableInstances store ! (tableaddrs moduleInstance ! 0)
@@ -679,14 +688,20 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
             case funcAddr of
                 Just (Just addr) -> do
                     let funInst = funcInstances store ! addr
-                    let args = params $ Language.Wasm.Interpreter.funcType funInst
+                    let targetType = Language.Wasm.Interpreter.funcType funInst
+                    if targetType == funcType
+                    then do
+                        let args = params targetType
                         if length args > length rest
                         then return Trap
-                    else do
+                        else case sequence $ zipWith checkValType args $ reverse $ take (length args) rest of
-                        res <- eval store funInst (zipWith checkValType args $ reverse $ take (length args) rest)
+                            Just params -> do
+                                res <- eval store funInst params
                                 case res of
                                     Just res -> return $ Done ctx { stack = reverse res ++ (drop (length args) rest) }
                                     Nothing -> return Trap
+                            Nothing -> return Trap
+                    else return Trap
                 _ -> return Trap
         step ctx@EvalCtx{ stack = (_:rest) } Drop = return $ Done ctx { stack = rest }
         step ctx@EvalCtx{ stack = (VI32 test:val2:val1:rest) } Select =