Commit 28e80883 authored by Katharina Brandl's avatar Katharina Brandl
Browse files

renamed WasmStore to GlobalState

parent 4fcf2961
Pipeline #100698 passed with stages
in 74 minutes and 7 seconds
......@@ -27,7 +27,7 @@ import Control.Arrow.Transformer.Value
import Control.Arrow.Transformer.Concrete.Failure
import Control.Arrow.Transformer.Concrete.Frame
import Control.Arrow.Transformer.Concrete.Except
import Control.Arrow.Transformer.Concrete.WasmStore
import Control.Arrow.Transformer.Concrete.GlobalState
import Data.Concrete.Error
......@@ -52,10 +52,10 @@ import Numeric.Natural (Natural)
--newtype WasmMemoryT c x y = WasmMemoryT (StateT (Vector Word8) c x y)
-- deriving (Profunctor, Category, Arrow, ArrowChoice, ArrowLift,
-- ArrowFail e, ArrowExcept e, ArrowConst r, ArrowStore var' val', ArrowRun, ArrowFrame fd val,
-- ArrowStack st, ArrowState (Vector Word8), ArrowReader r, ArrowWasmStore v2)
-- ArrowStack st, ArrowState (Vector Word8), ArrowReader r, ArrowGlobalState v2)
--
--instance ArrowTrans (WasmMemoryT) where
-- -- lift' :: c x y -> WasmStoreT v c x y
-- -- lift' :: c x y -> GlobalStateT v c x y
-- lift' arr = WasmMemoryT (lift' arr)
--
--
......@@ -150,11 +150,11 @@ evalNumericInst inst stack =
--type TransStack = FrameT FrameData Value (StackT Value (->))
--
evalVariableInst :: (Instruction Natural) -> [Value] -> FrameData -> Vector Value
-> WasmStore Value -> Int -> ([Value], (Vector Value, (WasmStore Value, ())))
-> GlobalState Value -> Int -> ([Value], (Vector Value, (GlobalState Value, ())))
evalVariableInst inst stack fd locals store currentMem =
Trans.run
(Generic.evalVariableInst ::
WasmStoreT Value
GlobalStateT Value
(FrameT FrameData Value
(StackT Value
(->))) (Instruction Natural) ()) (stack, (locals, (fd,(store, (currentMem,inst)))))
......@@ -170,18 +170,18 @@ evalParametricInst inst stack =
--eval :: [Instruction Natural] -> [Value] -> Generic.LabelArities -> Vector Value -> FrameData ->
-- WasmStore Value -> Int ->
-- GlobalState Value -> Int ->
-- ([Value], -- stack
-- Error (Generic.Exc Value)
-- (Vector Value, -- state of FrameT
-- (WasmStore Value, -- state of WasmStoreT
-- (GlobalState Value, -- state of GlobalStateT
-- ())))
--eval inst stack r locals fd wasmStore currentMem =
-- let ?fixpointAlgorithm = Function.fix in
-- Trans.run
-- (Generic.eval ::
-- ValueT Value
-- (WasmStoreT Value
-- (GlobalStateT Value
-- (FrameT FrameData Value
-- (ReaderT Generic.LabelArities
-- (ExceptT (Generic.Exc Value)
......@@ -190,14 +190,14 @@ evalParametricInst inst stack =
invokeExported :: WasmStore Value
invokeExported :: GlobalState Value
-> ModuleInstance
-> Text
-> [Value]
-> ([String], Error
[Char]
(Vector Value,
(WasmStore Value, Error (Exc Value) ([Value], [Value]))))
(GlobalState Value, Error (Exc Value) ([Value], [Value]))))
invokeExported store modInst funcName args =
let ?fixpointAlgorithm = Function.fix in
Trans.run
......@@ -206,27 +206,27 @@ invokeExported store modInst funcName args =
(ReaderT Generic.LabelArities
(DebuggableStackT Value
(ExceptT (Generic.Exc Value)
(WasmStoreT Value
(GlobalStateT Value
(FrameT FrameData Value
(FailureT String
(LoggerT String
(->)))))))) (Text, [Value]) [Value]) ([],(Vec.empty,((0,modInst),(store,(0,([],(Generic.LabelArities [],(funcName,args))))))))
instantiate :: ValidModule -> IO (Either String (ModuleInstance, WasmStore Value))
instantiate :: ValidModule -> IO (Either String (ModuleInstance, GlobalState Value))
instantiate valMod = do
res <- Wasm.instantiate emptyStore emptyImports valMod
case res of
Right (modInst, store) -> do
wasmStore <- storeToWasmStore store
wasmStore <- storeToGlobalState store
return $ Right $ (modInst, wasmStore)
Left e -> return $ Left e
where
storeToWasmStore (Wasm.Store funcI tableI memI globalI) = do
storeToGlobalState (Wasm.Store funcI tableI memI globalI) = do
mems <- Vec.mapM convertMem memI
globs <- Vec.mapM convertGlobals globalI
return $ WasmStore (Vec.map convertFuncs funcI)
return $ GlobalState (Vec.map convertFuncs funcI)
(Vec.map TableInst tableI)
mems
globs
......
......@@ -5,7 +5,7 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Arrow.WasmStore where
module Control.Arrow.GlobalState where
import Control.Arrow
import Control.Arrow.Trans
......@@ -26,7 +26,7 @@ import Language.Wasm.Interpreter (ModuleInstance(..))
class ArrowWasmStore v c | c -> v where
class ArrowGlobalState v c | c -> v where
-- | Reads a global variable. Cannot fail due to validation.
readGlobal :: c Int v
-- | Writes a global variable. Cannot fail due to validation.
......@@ -47,8 +47,8 @@ class ArrowWasmStore v c | c -> v where
-- | Executes a function relative to a memory instance. The memory instance exists due to validation.
withMemoryInstance :: c x y -> c (Int,x) y
deriving instance (ArrowWasmStore v c) => ArrowWasmStore v (ValueT v2 c)
instance (Profunctor c, Arrow c, ArrowWasmStore v c) => ArrowWasmStore v (StateT s c) where
deriving instance (ArrowGlobalState v c) => ArrowGlobalState v (ValueT v2 c)
instance (Profunctor c, Arrow c, ArrowGlobalState v c) => ArrowGlobalState v (StateT s c) where
readGlobal = lift' readGlobal
writeGlobal = lift' writeGlobal
-- readFunction :: (StateT s c) (f, x) y -> (StateT s c) (Int, x) y
......@@ -97,13 +97,13 @@ instance (Profunctor c, Arrow c, ArrowWasmStore v c) => ArrowWasmStore v (StateT
-- y <- func ((proc (f,(s2,x)) -> arr -< (s2, (f,x))) >>^ snd) -< (i,(s,x))
-- returnA -< (s,y)
deriving instance (Arrow c, Profunctor c, ArrowWasmStore v c) => ArrowWasmStore v (ExceptT e c)
deriving instance (Arrow c, Profunctor c, ArrowWasmStore v c) => ArrowWasmStore v (StackT s c)
instance (Monad f, Arrow c, Profunctor c, ArrowWasmStore v c) => ArrowWasmStore v (KleisliT f c) where
deriving instance (Arrow c, Profunctor c, ArrowGlobalState v c) => ArrowGlobalState v (ExceptT e c)
deriving instance (Arrow c, Profunctor c, ArrowGlobalState v c) => ArrowGlobalState v (StackT s c)
instance (Monad f, Arrow c, Profunctor c, ArrowGlobalState v c) => ArrowGlobalState v (KleisliT f c) where
readGlobal = lift' readGlobal
writeGlobal = lift' writeGlobal
readFunction a = lift (readFunction (unlift a))
instance (Arrow c, Profunctor c, ArrowWasmStore v c) => ArrowWasmStore v (ReaderT r c) where
instance (Arrow c, Profunctor c, ArrowGlobalState v c) => ArrowGlobalState v (ReaderT r c) where
readGlobal = lift' readGlobal
writeGlobal = lift' writeGlobal
-- unlift arr :: c (r, (f,x)) y
......@@ -114,7 +114,7 @@ instance (Arrow c, Profunctor c, ArrowWasmStore v c) => ArrowWasmStore v (Reader
where transform f = proc (r, (i,x)) ->
readFunction (proc (f,(r,x)) -> f -< (r, (f,x))) -< (i,(r,x))
instance (Arrow c, Profunctor c, Monoid w, ArrowWasmStore v c) => ArrowWasmStore v (WriterT w c) where
instance (Arrow c, Profunctor c, Monoid w, ArrowGlobalState v c) => ArrowGlobalState v (WriterT w c) where
readGlobal = lift' readGlobal
writeGlobal = lift' writeGlobal
readFunction a = lift (readFunction (unlift a))
......@@ -6,7 +6,7 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Arrow.Transformer.Concrete.WasmStore where
module Control.Arrow.Transformer.Concrete.GlobalState where
import Control.Arrow
import Control.Arrow.Const
......@@ -24,7 +24,7 @@ import Control.Arrow.Stack
import Control.Arrow.State
import Control.Arrow.Store
import Control.Arrow.Trans
import Control.Arrow.WasmStore
import Control.Arrow.GlobalState
import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.State
......@@ -48,15 +48,15 @@ import GenericInterpreter (LoadType,StoreType)
newtype Value = Value Wasm.Value deriving (Show, Eq)
data Mut = Const | Mutable deriving (Show, Eq)
data WasmStore v = WasmStore {
data GlobalState v = GlobalState {
funcInstances :: Vector FuncInst,
tableInstances :: Vector TableInst,
memInstances :: Vector MemInst,
globalInstances :: Vector (GlobInst v)
} deriving (Show, Eq)
emptyWasmStore :: WasmStore v
emptyWasmStore = WasmStore {
emptyGlobalState :: GlobalState v
emptyGlobalState = GlobalState {
funcInstances = Vec.empty,
tableInstances = Vec.empty,
memInstances = Vec.empty,
......@@ -78,49 +78,49 @@ newtype TableInst = TableInst Wasm.TableInstance deriving (Show,Eq)
data MemInst = MemInst (Maybe Word32) (Vector Word8) deriving (Show,Eq)
data GlobInst v = GlobInst Mut v deriving (Show, Eq)
newtype WasmStoreT v c x y = WasmStoreT (ReaderT Int (StateT (WasmStore v) c) x y)
newtype GlobalStateT v c x y = GlobalStateT (ReaderT Int (StateT (GlobalState v) c) x y)
deriving (Profunctor, Category, Arrow, ArrowChoice, ArrowLift,
ArrowFail e, ArrowExcept e, ArrowConst r, ArrowStore var' val', ArrowRun, ArrowFrame fd val,
ArrowStack st, ArrowLogger l)--, ArrowState (WasmStore v))
ArrowStack st, ArrowLogger l)--, ArrowState (GlobalState v))
instance (ArrowReader r c) => ArrowReader r (WasmStoreT v c) where
instance (ArrowReader r c) => ArrowReader r (GlobalStateT v c) where
ask = lift' ask
local a = lift $ lmap shuffle1 (local (unlift a))
instance (ArrowState s c) => ArrowState s (WasmStoreT v c) where
instance (ArrowState s c) => ArrowState s (GlobalStateT v c) where
instance ArrowTrans (WasmStoreT v) where
-- lift' :: c x y -> WasmStoreT v c x y
lift' a = WasmStoreT (lift' (lift' a))
instance ArrowTrans (GlobalStateT v) where
-- lift' :: c x y -> GlobalStateT v c x y
lift' a = GlobalStateT (lift' (lift' a))
instance (ArrowChoice c, Profunctor c) => ArrowWasmStore v (WasmStoreT v c) where
instance (ArrowChoice c, Profunctor c) => ArrowGlobalState v (GlobalStateT v c) where
readGlobal =
WasmStoreT $ proc i -> do
WasmStore{globalInstances=vec} <- get -< ()
GlobalStateT $ proc i -> do
GlobalState{globalInstances=vec} <- get -< ()
let (GlobInst _ val) = vec ! i
returnA -< val
writeGlobal =
WasmStoreT $ proc (i,v) -> do
store@WasmStore{globalInstances=vec} <- get -< ()
GlobalStateT $ proc (i,v) -> do
store@GlobalState{globalInstances=vec} <- get -< ()
let (GlobInst m _) = vec ! i
if m == Const
then returnA -< error $ "writing to constant global " ++ (show i)
else put -< store{globalInstances=vec // [(i, GlobInst m v)]}
-- funcCont :: ReaderT Int (StateT (WasmStore v) c) ((FuncType, ModuleInstance, Function),x) y
-- we need ReaderT Int (StateT (WasmStore v) c) (Int, x) y
readFunction (WasmStoreT funcCont) =
WasmStoreT $ proc (i,x) -> do
WasmStore{funcInstances = fs} <- get -< ()
-- funcCont :: ReaderT Int (StateT (GlobalState v) c) ((FuncType, ModuleInstance, Function),x) y
-- we need ReaderT Int (StateT (GlobalState v) c) (Int, x) y
readFunction (GlobalStateT funcCont) =
GlobalStateT $ proc (i,x) -> do
GlobalState{funcInstances = fs} <- get -< ()
case fs ! i of
FuncInst fTy modInst code -> funcCont -< ((fTy,modInst,code),x)
_ -> returnA -< error "not yet implemented" --hostCont -< ((fTy,code),x)
withMemoryInstance (WasmStoreT f) = WasmStoreT $ local f
withMemoryInstance (GlobalStateT f) = GlobalStateT $ local f
instance (ArrowChoice c, Profunctor c) => ArrowMemory Word32 (Vector Word8) (WasmStoreT v c) where
memread (WasmStoreT sCont) (WasmStoreT eCont) = WasmStoreT $ proc (addr, size, x) -> do
WasmStore{memInstances=mems} <- get -< ()
instance (ArrowChoice c, Profunctor c) => ArrowMemory Word32 (Vector Word8) (GlobalStateT v c) where
memread (GlobalStateT sCont) (GlobalStateT eCont) = GlobalStateT $ proc (addr, size, x) -> do
GlobalState{memInstances=mems} <- get -< ()
currMem <- ask -< ()
let MemInst _ vec = mems ! currMem
let addrI = fromIntegral addr
......@@ -129,8 +129,8 @@ instance (ArrowChoice c, Profunctor c) => ArrowMemory Word32 (Vector Word8) (Was
let content = Vec.slice addrI size vec
sCont -< (content,x)
False -> eCont -< x
memstore (WasmStoreT sCont) (WasmStoreT eCont) = WasmStoreT $ proc (addr, content, x) -> do
store@WasmStore{memInstances=mems} <- get -< ()
memstore (GlobalStateT sCont) (GlobalStateT eCont) = GlobalStateT $ proc (addr, content, x) -> do
store@GlobalState{memInstances=mems} <- get -< ()
currMem <- ask -< ()
let MemInst s vec = mems ! currMem
let addrI = fromIntegral addr
......@@ -142,18 +142,18 @@ instance (ArrowChoice c, Profunctor c) => ArrowMemory Word32 (Vector Word8) (Was
sCont -< x
False -> eCont -< x
instance (Arrow c, Profunctor c) => ArrowMemAddress Value Natural Word32 (WasmStoreT v c) where
instance (Arrow c, Profunctor c) => ArrowMemAddress Value Natural Word32 (GlobalStateT v c) where
memaddr = proc (Value (Wasm.VI32 base), off) -> returnA -< (base+ (fromIntegral off))
instance ArrowSerialize v (Vector Word8) ValueType LoadType StoreType (WasmStoreT v c) where
instance ArrowSerialize v (Vector Word8) ValueType LoadType StoreType (GlobalStateT v c) where
instance ArrowMemSizable v (WasmStoreT v c) where
instance ArrowMemSizable v (GlobalStateT v c) where
instance ArrowFix (Underlying (WasmStoreT v c) x y) => ArrowFix (WasmStoreT v c x y) where
type Fix (WasmStoreT v c x y) = Fix (Underlying (WasmStoreT v c) x y)
instance ArrowFix (Underlying (GlobalStateT v c) x y) => ArrowFix (GlobalStateT v c x y) where
type Fix (GlobalStateT v c x y) = Fix (Underlying (GlobalStateT v c) x y)
deriving instance Show Wasm.TableInstance
deriving instance Eq Wasm.TableInstance
......@@ -24,7 +24,7 @@ import Control.Arrow.State
import Control.Arrow.Trans
import Control.Arrow.Serialize
import Control.Arrow.Transformer.Stack
import Control.Arrow.WasmStore
import Control.Arrow.GlobalState
import Control.Arrow.Writer
import Data.Profunctor
......@@ -33,7 +33,7 @@ import Data.Profunctor
newtype DebuggableStackT v c x y = DebuggableStackT (StackT v c x y)
deriving (Profunctor,Category,Arrow,ArrowChoice,ArrowTrans,ArrowLift,ArrowRun,
ArrowConst r, ArrowReader r, ArrowFail e, ArrowExcept e, ArrowStack v,
ArrowWasmStore v1 , ArrowFrame fd v1, ArrowMemory addr bytes,
ArrowGlobalState v1 , ArrowFrame fd v1, ArrowMemory addr bytes,
ArrowMemAddress v1 n addr, ArrowSerialize v1 bytes valTy loadTy storeTy,
ArrowMemSizable v1, ArrowWriter w, ArrowLogger l)
......
......@@ -24,7 +24,7 @@ import Control.Arrow.Stack
import Control.Arrow.Trans
import Control.Arrow.Serialize
import Control.Arrow.Transformer.Stack
import Control.Arrow.WasmStore
import Control.Arrow.GlobalState
import Control.Arrow.Writer
import Data.Profunctor
......@@ -32,7 +32,7 @@ import Data.Profunctor
newtype LoggerT v c x y = LoggerT (StackT v c x y)
deriving (Profunctor, Category, Arrow, ArrowChoice, ArrowTrans, ArrowLift, ArrowRun,
ArrowConst r, ArrowReader r, ArrowFail e, ArrowExcept e,
ArrowWasmStore v1, ArrowFrame fd v1, ArrowMemory addr bytes,
ArrowGlobalState v1, ArrowFrame fd v1, ArrowMemory addr bytes,
ArrowMemAddress v1 n addr, ArrowSerialize v1 bytes valTy loadTy storeTy,
ArrowMemSizable v1, ArrowWriter w)
......
......@@ -30,7 +30,7 @@ import Control.Arrow.Reader
import Control.Arrow.Serialize
import Control.Arrow.Stack
import qualified Control.Arrow.Utils as Arr
import Control.Arrow.WasmStore
import Control.Arrow.GlobalState
import Data.Profunctor
import Data.Text.Lazy (Text)
......@@ -53,7 +53,7 @@ newtype LabelArities = LabelArities {labels :: [Natural]}
type FrameData = (Natural, ModuleInstance)
---- constraints to support (and call) host functions
--type HostFunctionSupport addr bytes v c = (ArrowApply c, ArrowWasmStore v c, ArrowWasmMemory addr bytes v c)
--type HostFunctionSupport addr bytes v c = (ArrowApply c, ArrowGlobalState v c, ArrowWasmMemory addr bytes v c)
---- a host function is a function from a list of values (parameters) to a list of values (return values)
--newtype HostFunction v c = HostFunction (
-- forall addr bytes. HostFunctionSupport addr bytes v c => (c [v] [v]) )
......@@ -117,11 +117,11 @@ class Show v => IsVal v c | c -> v where
-- entry point to the generic interpreter
-- the module instance comes from ArrowFrame
-- ArrowWasmStore and ArrowWasmMemory are properly initialized
-- ArrowGlobalState and ArrowWasmMemory are properly initialized
-- argument Text: name of the function to execute
-- argument [v]: arguments going to be passed to the function
invokeExported ::
( ArrowChoice c, ArrowFrame FrameData v c, ArrowWasmStore v c,
( ArrowChoice c, ArrowFrame FrameData v c, ArrowGlobalState v c,
ArrowStack v c,
ArrowDebuggableStack v c,
ArrowExcept (Exc v) c, ArrowReader LabelArities c,
......@@ -145,7 +145,7 @@ invokeExported = proc (funcName, args) -> do
_ -> fail -< printf "Function with name %s was not found in module's exports" (show funcName)
invokeExternal ::
( ArrowChoice c, ArrowFrame FrameData v c, ArrowWasmStore v c,
( ArrowChoice c, ArrowFrame FrameData v c, ArrowGlobalState v c,
ArrowStack v c,
ArrowDebuggableStack v c,
ArrowExcept (Exc v) c, ArrowReader LabelArities c,
......@@ -195,7 +195,7 @@ invokeExternal = proc (funcAddr, args) ->
eval ::
( ArrowChoice c, ArrowFrame FrameData v c, ArrowWasmStore v c,
( ArrowChoice c, ArrowFrame FrameData v c, ArrowGlobalState v c,
ArrowStack v c,
ArrowDebuggableStack v c,
ArrowExcept (Exc v) c, ArrowReader LabelArities c,
......@@ -250,7 +250,7 @@ evalControlInst ::
ArrowExcept (Exc v) c,
ArrowReader LabelArities c, -- return arity of nested labels
ArrowFrame FrameData v c, -- frame data and local variables
ArrowWasmStore v c,
ArrowGlobalState v c,
ArrowLogger String c,
--HostFunctionSupport addr bytes v c,
Exc.Join () c)
......@@ -305,7 +305,7 @@ evalControlInst eval' = proc i -> case i of
-< (tableAddr, fromIntegral ix, ftExpect)
invokeChecked ::
( ArrowChoice c, ArrowWasmStore v c, ArrowStack v c, ArrowReader LabelArities c,
( ArrowChoice c, ArrowGlobalState v c, ArrowStack v c, ArrowReader LabelArities c,
IsVal v c, ArrowFrame FrameData v c, ArrowExcept (Exc v) c, Exc.Join () c,
ArrowDebuggableStack v c, ArrowLogger String c)
--HostFunctionSupport addr bytes v c)
......@@ -435,7 +435,7 @@ evalParametricInst = proc i -> case i of
evalMemoryInst ::
( ArrowChoice c,
ArrowWasmMemory addr bytes v c,
ArrowWasmStore v c, ArrowFrame FrameData v c, ArrowStack v c, IsVal v c, ArrowExcept (Exc v) c)
ArrowGlobalState v c, ArrowFrame FrameData v c, ArrowStack v c, IsVal v c, ArrowExcept (Exc v) c)
=> c (Instruction Natural) ()
evalMemoryInst = withCurrentMemory $ proc i -> case i of
I32Load (MemArg off _) -> load 4 L_I32 I32 -< off
......@@ -469,7 +469,7 @@ evalMemoryInst = withCurrentMemory $ proc i -> case i of
(proc _ -> push <<< i32const -< 0xFFFFFFFF) -- 0xFFFFFFFF ~= -1
-< (n, ())
withCurrentMemory :: (ArrowChoice c, ArrowWasmStore v c, ArrowFrame FrameData v c) => c x y -> c x y
withCurrentMemory :: (ArrowChoice c, ArrowGlobalState v c, ArrowFrame FrameData v c) => c x y -> c x y
withCurrentMemory f = proc x -> do
(_,modInst) <- frameData -< ()
let memAddr = memaddrs modInst ! 0
......@@ -478,7 +478,7 @@ withCurrentMemory f = proc x -> do
load ::
( ArrowChoice c,
ArrowWasmMemory addr bytes v c,
ArrowWasmStore v c, ArrowFrame FrameData v c, ArrowStack v c, IsVal v c, ArrowExcept (Exc v) c)
ArrowGlobalState v c, ArrowFrame FrameData v c, ArrowStack v c, IsVal v c, ArrowExcept (Exc v) c)
=> Int -> LoadType -> ValueType -> c Natural ()
load byteSize loadType valType = proc off -> do
base <- pop -< ()
......@@ -495,7 +495,7 @@ load byteSize loadType valType = proc off -> do
store ::
( ArrowChoice c,
ArrowWasmMemory addr bytes v c,
ArrowWasmStore v c, ArrowFrame FrameData v c, ArrowStack v c, IsVal v c, ArrowExcept (Exc v) c)
ArrowGlobalState v c, ArrowFrame FrameData v c, ArrowStack v c, IsVal v c, ArrowExcept (Exc v) c)
=> StoreType -> ValueType -> c Natural ()
store storeType valType = proc off -> do
v <- pop -< ()
......@@ -511,7 +511,7 @@ store storeType valType = proc off -> do
-< (v, valType, storeType, off)
evalVariableInst ::
( ArrowChoice c, ArrowFrame FrameData v c, ArrowWasmStore v c,
( ArrowChoice c, ArrowFrame FrameData v c, ArrowGlobalState v c,
ArrowStack v c)
=> c (Instruction Natural) ()
evalVariableInst = proc i -> case i of
......
......@@ -3,7 +3,7 @@ module ConcreteSpec where
import ConcreteInterpreter
import GenericInterpreter(Exc(..))
import Control.Arrow.Transformer.Concrete.WasmStore
import Control.Arrow.Transformer.Concrete.GlobalState
import qualified Data.ByteString.Lazy as LBS
import Data.Concrete.Error
......@@ -37,17 +37,17 @@ spec = do
it "evalVariableInst GetLocal" $ do
let inst = GetLocal 1
let fd = (0, Wasm.emptyModInstance)
let store = emptyWasmStore
let store = emptyGlobalState
(fst $ evalVariableInst inst [] fd (fromList $ map (Value . Wasm.VI32) [5,8,7]) store 0) `shouldBe`
[Value $ Wasm.VI32 8]
it "evalVariableInst GetGlobal" $ do
let inst = GetGlobal 1
let store = emptyWasmStore{globalInstances = fromList $ map (\x -> GlobInst Mutable (Value $ Wasm.VI32 x)) [3,4,5]}
let store = emptyGlobalState{globalInstances = fromList $ map (\x -> GlobInst Mutable (Value $ Wasm.VI32 x)) [3,4,5]}
let fd = (0, Wasm.emptyModInstance{globaladdrs = fromList [0,1,2]})
(fst $ evalVariableInst inst [] fd empty store 0) `shouldBe` [Value $ Wasm.VI32 4]
it "evalVariabelInst SetGlobal" $ do
let inst = SetGlobal 1
let store = emptyWasmStore{globalInstances = fromList $ map (\x -> GlobInst Mutable (Value $ Wasm.VI32 x)) [3,4,5]}
let store = emptyGlobalState{globalInstances = fromList $ map (\x -> GlobInst Mutable (Value $ Wasm.VI32 x)) [3,4,5]}
let fd = (0, Wasm.emptyModInstance{globaladdrs = fromList [0,1,2]})
let stack = [Value $ Wasm.VI32 6]
(globalInstances $ fst $ snd $ snd $ evalVariableInst inst stack fd empty store 0) `shouldBe`
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment