From b7933df8c32083c7ffc35f4311fb4e042d1af5cd Mon Sep 17 00:00:00 2001 From: Ilya Rezvov Date: Mon, 9 Apr 2018 14:36:14 -0700 Subject: [PATCH] add actions interpretatiion --- src/Language/Wasm/Interpreter.hs | 11 +++++++++++ src/Language/Wasm/Parser.y | 15 +++++++++++---- src/Language/Wasm/Script.hs | 20 +++++++++++++++++++- 3 files changed, 41 insertions(+), 5 deletions(-) diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs index 6f7f3c5..df15322 100644 --- a/src/Language/Wasm/Interpreter.hs +++ b/src/Language/Wasm/Interpreter.hs @@ -15,6 +15,7 @@ module Language.Wasm.Interpreter ( instantiate, invoke, invokeExport, + getGlobalValueByName, emptyStore, emptyImports, makeHostModule, @@ -1043,4 +1044,14 @@ invokeExport :: Store -> ModuleInstance -> TL.Text -> [Value] -> IO [Value] 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" \ No newline at end of file diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index e8d6002..fe01931 100644 --- a/src/Language/Wasm/Parser.y +++ b/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 { diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs index 62d9e32..e1caa7e 100644 --- a/src/Language/Wasm/Script.hs +++ b/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