add actions interpretatiion

src/Language/Wasm/Interpreter.hs

@@ -15,6 +15,7 @@ module Language.Wasm.Interpreter (
     instantiate,
     invoke,
     invokeExport,
+    getGlobalValueByName,
     emptyStore,
     emptyImports,
     makeHostModule,
@@ -1044,3 +1045,13 @@ invokeExport st ModuleInstance { exports } name args =
     case Vector.find (\(ExportInstance n _) -> n == name) exports of
         Just (ExportInstance _ (ExternFunction addr)) -> invoke st addr args
         _ -> error $ "Function with name " ++ show name ++ " was not found in module's exports"
+
+getGlobalValueByName :: Store -> ModuleInstance -> TL.Text -> IO Value
+getGlobalValueByName store ModuleInstance { exports } name =
+    case Vector.find (\(ExportInstance n _) -> n == name) exports of
+        Just (ExportInstance _ (ExternGlobal addr)) ->
+            let globalInst = globalInstances store ! addr in
+            case globalInst of
+                GIConst v -> return v
+                GIMut ref -> readIORef ref
+        _ -> error $ "Function with name " ++ show name ++ " was not found in module's exports"

src/Language/Wasm/Parser.y

@@ -1030,11 +1030,11 @@ module1 :: { ModuleDef }
     | modulefield1 list(modulefield) { RawModDef Nothing (desugarize $ $1 ++ concat $2) }
 
 action1 :: { Action }
-    : 'invoke' opt(ident) string list(foldedinstr) ')' { Invoke $2 $3 $4 }
+    : 'invoke' opt(ident) string list(foldedinstr) ')' { Invoke $2 $3 (map (map constInstructionToValue) $4) }
     | 'get' opt(ident) string ')' { Get $2 $3 }
 
 assertion1 :: { Assertion }
-    : 'assert_return' '(' action1 list(foldedinstr) ')' { AssertReturn $3 $4 }
+    : 'assert_return' '(' action1 list(foldedinstr) ')' { AssertReturn $3 (map (map constInstructionToValue) $4) }
     | 'assert_return_canonical_nan' '(' action1 ')' { AssertReturnCanonicalNaN $3 }
     | 'assert_return_arithmetic_nan' '(' action1 ')' { AssertReturnArithmeticNaN $3 }
     | 'assert_trap' '(' assertion_trap string ')' { AssertTrap $3 $4 }
@@ -1383,14 +1383,14 @@ data Command
     deriving (Show, Eq)
 
 data Action
-    = Invoke (Maybe Ident) TL.Text [Expression]
+    = Invoke (Maybe Ident) TL.Text [[S.Instruction]]
     | Get (Maybe Ident) TL.Text
     deriving (Show, Eq)
 
 type FailureString = TL.Text
 
 data Assertion
-    = AssertReturn Action [Expression]
+    = AssertReturn Action [[S.Instruction]]
     | AssertReturnCanonicalNaN Action
     | AssertReturnArithmeticNaN Action
     | AssertTrap (Either Action ModuleDef) FailureString
@@ -1415,6 +1415,13 @@ data FunCtx = FunCtx {
     ctxParams :: [ParamType]
 } deriving (Eq, Show)
 
+constInstructionToValue :: Instruction -> S.Instruction
+constInstructionToValue (PlainInstr (I32Const v)) = S.I32Const $ integerToWord32 v
+constInstructionToValue (PlainInstr (F32Const v)) = S.F32Const v
+constInstructionToValue (PlainInstr (I64Const v)) = S.I64Const $ integerToWord64 v
+constInstructionToValue (PlainInstr (F64Const v)) = S.F64Const v
+constInstructionToValue _ = error "Only const instructions supported as arguments for actions"
+
 desugarize :: [ModuleField] -> S.Module
 desugarize fields =
     let mod = Module {

src/Language/Wasm/Script.hs

@@ -61,7 +61,7 @@ runScript onAssertFail script = do
         ]
     go script $ emptyState { store = st, moduleRegistery = Map.singleton "spectest" inst }
     where
-        hostPrint paramTypes = Interpreter.HostFunction (Struct.FuncType paramTypes []) (\args -> print args >> return [])
+        hostPrint paramTypes = Interpreter.HostFunction (Struct.FuncType paramTypes []) (const $ return [])
         hostGlobals = do
             globI32 <- Interpreter.makeMutGlobal $ Interpreter.VI32 666
             globF32 <- Interpreter.makeMutGlobal $ Interpreter.VF32 666
@@ -102,6 +102,23 @@ runScript onAssertFail script = do
         getModule st (Just (Ident i)) = Map.lookup i (modules st)
         getModule st Nothing = lastModule st
 
+        asArg :: [Struct.Instruction] -> Interpreter.Value
+        asArg [Struct.I32Const v] = Interpreter.VI32 v
+        asArg [Struct.F32Const v] = Interpreter.VF32 v
+        asArg [Struct.I64Const v] = Interpreter.VI64 v
+        asArg [Struct.F64Const v] = Interpreter.VF64 v
+        asArg _                   = error "Only const instructions supported as arguments for actions"
+
+        runAction :: ScriptState -> Action -> IO [Interpreter.Value]
+        runAction st (Invoke ident name args) = do
+            case getModule st ident of
+                Just m -> Interpreter.invokeExport (store st) m name $ map asArg args
+                Nothing -> error $ "Cannot invoke function on module with identifier '" ++ show ident  ++ "'. No such module"
+        runAction st (Get ident name) = do
+            case getModule st ident of
+                Just m -> Interpreter.getGlobalValueByName (store st) m name >>= return . (: [])
+                Nothing -> error $ "Cannot invoke function on module with identifier '" ++ show ident  ++ "'. No such module"
+
         runCommand :: ScriptState -> Command -> IO ScriptState
         runCommand st (ModuleDef (RawModDef ident m)) = addModule ident m st
         runCommand st (ModuleDef (TextModDef ident textRep)) =
@@ -111,4 +128,5 @@ runScript onAssertFail script = do
             let Right m = Binary.decodeModuleLazy binaryRep in
             addModule ident m st
         runCommand st (Register name i) = return $ addToRegistery name i st
+        runCommand st (Action action) = runAction st action >> return st
         runCommand st _ = return st