Commit baacf36a authored by Katharina Brandl's avatar Katharina Brandl
Browse files

invokeExported and eval in concrete interpreter

parent 25f709be
{-# LANGUAGE Arrows #-}
--{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
......@@ -6,12 +7,13 @@
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module ConcreteInterpreter where
import Frame
import GenericInterpreter hiding (eval,evalNumericInst,evalVariableInstr,evalParametricInst)
import GenericInterpreter hiding (eval,evalNumericInst,evalVariableInstr,evalParametricInst,invokeExported)
import qualified GenericInterpreter as Generic
--import Stack
......@@ -19,6 +21,8 @@ import Control.Arrow
import Control.Arrow.Const
import Control.Arrow.Except
import Control.Arrow.Fail
import Control.Arrow.Fix
import Control.Arrow.Reader
import Control.Arrow.Stack
import Control.Arrow.State
import Control.Arrow.Store
......@@ -26,8 +30,10 @@ import qualified Control.Arrow.Trans as Trans
import Control.Arrow.Transformer.Kleisli
import Control.Arrow.Transformer.Stack
import Control.Arrow.Trans
import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.Value
import Control.Arrow.Transformer.Concrete.Failure
import Control.Arrow.Transformer.Concrete.Except
import Control.Arrow.Transformer.State
......@@ -37,8 +43,10 @@ import Data.Concrete.Error
import qualified Data.Function as Function
import Data.Profunctor
import Data.Text.Lazy (Text)
import Data.Vector (Vector, (!), (//))
import qualified Data.Vector as Vec
import Data.Word
import Language.Wasm.Interpreter hiding (Value)
import qualified Language.Wasm.Interpreter as Wasm
......@@ -46,14 +54,59 @@ import Language.Wasm.Structure hiding (exports)
import Numeric.Natural (Natural)
data WasmStore v c = WasmStore {
funcInstances :: Vector (FuncInst v c),
-- memory instance: vec(byte) + optional max size
-- bytes are modeled as Word8
-- addresses are modeled as Word32
--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)
--
--instance ArrowTrans (WasmMemoryT) where
-- -- lift' :: c x y -> WasmStoreT v c x y
-- lift' arr = WasmMemoryT (lift' arr)
--
--
--instance (ArrowChoice c, Profunctor c) => ArrowMemory Word32 (Vector Word8) (WasmMemoryT c) where
-- memread sCont eCont = proc (addr, size, x) -> do
-- vec <- get -< ()
-- let addrI = fromIntegral addr
-- case (addrI+size <= length vec) of
-- True -> do
-- let content = Vec.slice addrI size vec
-- sCont -< (content,x)
-- False -> eCont -< x
-- memstore sCont eCont = proc (addr, content, x) -> do
-- vec <- get -< ()
-- let addrI = fromIntegral addr
-- let size = length content
-- case (addrI+size <= length vec) of
-- True -> do
-- let ind = Vec.enumFromN addrI size
-- put -< (Vec.update_ vec ind content)
-- sCont -< x
-- False -> eCont -< x
--
--instance (Arrow c, Profunctor c) => ArrowMemAddress Value Natural Word32 (WasmMemoryT c) where
-- memaddr = proc (Value (VI32 base), off) -> returnA -< (base+ (fromIntegral off))
--
--instance ArrowSerialize Value (Vector Word8) ValueType LoadType StoreType (WasmMemoryT c) where
--
--instance ArrowMemSizable Value (WasmMemoryT c) where
--
--instance ArrowFix (Underlying (WasmMemoryT c) x y) => ArrowFix (WasmMemoryT c x y) where
-- type Fix (WasmMemoryT c x y) = Fix (Underlying (WasmMemoryT c) x y)
--
--
data WasmStore v = WasmStore {
funcInstances :: Vector (FuncInst v),
tableInstances :: Vector TableInst,
memInstances :: Vector MemInst,
globalInstances :: Vector v
} deriving (Show)
emptyWasmStore :: WasmStore v c
emptyWasmStore :: WasmStore v
emptyWasmStore = WasmStore {
funcInstances = Vec.empty,
tableInstances = Vec.empty,
......@@ -61,49 +114,90 @@ emptyWasmStore = WasmStore {
globalInstances = Vec.empty
}
data FuncInst v c =
data FuncInst v =
FuncInst {
funcType :: FuncType,
moduleInstance :: ModuleInstance,
code :: Function
}
| HostInst {
funcType :: FuncType,
hostCode :: HostFunction v c
funcType :: FuncType
--hostCode :: HostFunction v c
} deriving (Show)
data TableInst = TableInst deriving (Show)
data MemInst = MemInst deriving (Show)
newtype MemInst = MemInst (Vector Word8) deriving (Show)
newtype WasmStoreT v c x y = WasmStoreT (StateT (WasmStore v c) c x y)
newtype WasmStoreT v c x y = WasmStoreT (ReaderT Int (StateT (WasmStore 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, ArrowState (WasmStore v c))
ArrowStack st)--, ArrowState (WasmStore v))
instance (ArrowReader r c) => ArrowReader r (WasmStoreT v c) where
--instance ArrowState (WasmStore v cHost) (WasmStoreT v cHost c) where
-- get = lift' get
-- put = lift' put
instance (ArrowState s c) => ArrowState s (WasmStoreT v c) where
instance ArrowTrans (WasmStoreT v) where
-- lift' :: c x y -> WasmStoreT v c x y
lift' arr = WasmStoreT (lift' arr)
lift' arr = WasmStoreT (lift' (lift' arr))
instance (ArrowChoice c, Profunctor c) => ArrowWasmStore v (WasmStoreT v c) where
readGlobal =
proc i -> do
WasmStoreT $ proc i -> do
WasmStore{globalInstances=vec} <- get -< ()
returnA -< vec ! i
writeGlobal =
proc (i,v) -> do
WasmStoreT $ proc (i,v) -> do
store@WasmStore{globalInstances=vec} <- get -< ()
put -< store{globalInstances=vec // [(i, v)]}
readFunction funcCont hostCont = proc (i,x) -> do
WasmStore{funcInstances = fs} <- get -< ()
case fs ! i of
FuncInst fTy modInst code -> funcCont -< ((fTy,modInst,code),x)
HostInst fTy code -> returnA -< error "" --hostCont -< ((fTy,code),x)
-- 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 -< ()
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
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 -< ()
currMem <- ask -< ()
let MemInst vec = mems ! currMem
let addrI = fromIntegral addr
case (addrI+size <= length vec) of
True -> do
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 -< ()
currMem <- ask -< ()
let MemInst vec = mems ! currMem
let addrI = fromIntegral addr
let size = length content
case (addrI+size <= length vec) of
True -> do
let ind = Vec.enumFromN addrI size
put -< (store{memInstances=mems // [(currMem,MemInst $ Vec.update_ vec ind content)]})
sCont -< x
False -> eCont -< x
instance (Arrow c, Profunctor c) => ArrowMemAddress Value Natural Word32 (WasmStoreT v c) where
memaddr = proc (Value (VI32 base), off) -> returnA -< (base+ (fromIntegral off))
instance ArrowSerialize Value (Vector Word8) ValueType LoadType StoreType (WasmStoreT v c) where
instance ArrowMemSizable Value (WasmStoreT 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)
newtype Value = Value Wasm.Value deriving (Show, Eq)
......@@ -136,17 +230,17 @@ evalNumericInst inst stack =
(->))) (Instruction Natural) Value) (stack,inst)
type TransStack = FrameT FrameData Value (StackT Value (->))
--type TransStack = FrameT FrameData Value (StackT Value (->))
--
evalVariableInst :: (Instruction Natural) -> [Value] -> FrameData -> Vector Value
-> WasmStore Value TransStack -> ([Value], (Vector Value, (WasmStore Value TransStack, ())))
evalVariableInst inst stack fd locals store =
-> WasmStore Value -> Int -> ([Value], (Vector Value, (WasmStore Value, ())))
evalVariableInst inst stack fd locals store currentMem =
Trans.run
(Generic.evalVariableInst ::
WasmStoreT Value
(FrameT FrameData Value
(StackT Value
(->))) (Instruction Natural) ()) (stack, (locals, (fd,(store, inst))))
(->))) (Instruction Natural) ()) (stack, (locals, (fd,(store, (currentMem,inst)))))
evalParametricInst :: (Instruction Natural) -> [Value] -> ([Value], ())
......@@ -157,12 +251,45 @@ evalParametricInst inst stack =
(StackT Value
(->)) (Instruction Natural) ()) (stack,inst)
--eval inst =
-- let ?fixpointAlgorithm = Function.fix in
-- Trans.run
-- (Generic.eval ::
-- ValueT Value
-- (ExceptT _ --(Generic.Exc Value)
-- (StackT Value
-- (FrameT FrameData Value
-- (->)))) [Instruction Natural] ()) inst
eval :: [Instruction Natural] -> [Value] -> Generic.Read -> Vector Value -> FrameData ->
WasmStore Value -> Int ->
([Value], -- stack
Error (Generic.Exc Value)
(Vector Value, -- state of FrameT
(WasmStore Value, -- state of WasmStoreT
())))
eval inst stack r locals fd wasmStore currentMem =
let ?fixpointAlgorithm = Function.fix in
Trans.run
(Generic.eval ::
ValueT Value
(WasmStoreT Value
(FrameT FrameData Value
(ReaderT Generic.Read
(ExceptT (Generic.Exc Value)
(StackT Value
(->)))))) [Instruction Natural] ()) (stack,(r,(locals,(fd,(wasmStore,(currentMem,inst))))))
invokeExported :: WasmStore Value
-> ModuleInstance
-> Text
-> [Value]
-> Error
[Char]
([Value],
Error (Exc Value) (Vector Value, (WasmStore Value, [Value])))
invokeExported store modInst funcName args =
let ?fixpointAlgorithm = Function.fix in
Trans.run
(Generic.invokeExported ::
ValueT Value
(WasmStoreT Value
(FrameT FrameData Value
(ReaderT Generic.Read
(ExceptT (Generic.Exc Value)
(StackT Value
(FailureT String
(->))))))) (Text, [Value]) [Value]) ([],(Generic.Read [],(Vec.empty,((0,modInst),(store,(0,(funcName,args)))))))
......@@ -24,6 +24,7 @@ import Control.Arrow.Trans
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.Value
import Data.Profunctor
import Data.Coerce
......@@ -56,12 +57,21 @@ instance (Profunctor c, Arrow c, ArrowFrame fd v c) => ArrowFrame fd v (StateT v
frameLookup = lift' frameLookup
frameUpdate = lift' frameUpdate
instance (Profunctor c, Arrow c, ArrowFrame fd v c) => ArrowFrame fd v (ReaderT r c) where
frameData = lift' frameData
frameLookup = lift' frameLookup
frameUpdate = lift' frameUpdate
-- | Arrow transformer that adds a frame to a computation.
newtype FrameT fd v c x y = FrameT (ReaderT fd (StateT (Vector v) c) x y)
deriving (Profunctor,Category,Arrow,ArrowChoice,ArrowLift,--ArrowTrans,
ArrowFail e,ArrowExcept e,ArrowConst r,
ArrowStore var' val', ArrowRun, ArrowStack s)
instance (ArrowReader r c) => ArrowReader r (FrameT fd v c) where
-- ask :: (FrameT fd v c) () r
ask = FrameT (ReaderT $ proc (fd, ()) -> ask -< ())
instance (ArrowChoice c, Profunctor c) => ArrowFrame fd v (FrameT fd v c) where
inNewFrame (FrameT (ReaderT f)) =
FrameT $ ReaderT $ proc (_,(fd, vs, x)) -> do
......@@ -75,6 +85,8 @@ instance (ArrowChoice c, Profunctor c) => ArrowFrame fd v (FrameT fd v c) where
vec <- get -< ()
put -< vec // [(fromIntegral n, v)]
deriving instance (ArrowFrame fd v c) => ArrowFrame fd v (ValueT v2 c)
instance ArrowFix (Underlying (FrameT fd v c) x y) => ArrowFix (FrameT fd v c x y) where
type Fix (FrameT fd v c x y) = Fix (Underlying (FrameT fd v c) x y)--FrameT fd v (Fix c (fd,(Vector v,x)) (Vector v,y))
......@@ -6,6 +6,7 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
-- | A generic interpreter for WebAssembly.
......@@ -28,6 +29,7 @@ import Control.Arrow.Trans
import qualified Control.Arrow.Utils as Arr
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Value
import Control.Category
......@@ -70,7 +72,9 @@ class ArrowWasmStore v c | c -> v where
writeGlobal :: c (Int, v) ()
-- | Reads a function. Cannot fail due to validation.
readFunction :: c ((FuncType, ModuleInstance, Function), x) y -> c ((FuncType, HostFunction v c), x) y -> c (Int, x) y
--readFunction :: c ((FuncType, ModuleInstance, Function), x) y -> c ((FuncType, HostFunction v c), x) y -> c (Int, x) y
readFunction :: c ((FuncType, ModuleInstance, Function), x) y -> c (Int, x) y
-- | readTable f g h (ta,ix,x)
-- | Lookup `ix` in table `ta` to retrieve the function address `fa`.
......@@ -82,29 +86,39 @@ 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 (ArrowWasmStore v c) => ArrowWasmStore v (StateT s c) where
type ArrowWasmMemory addr bytes v c =
( ArrowMemory addr bytes c,
ArrowMemAddress v Natural addr c,
ArrowSerialize v bytes ValueType LoadType StoreType c,
ArrowMemSizable v c,
Show addr, Show bytes)
ArrowMemSizable v c)
--Show addr)--, Show bytes)
class ArrowSerialize val dat valTy datDecTy datEncTy c | c -> datDecTy, c -> datEncTy where
decode :: c (val, x) y -> c x y -> c (dat, datdecTy, valTy, x) y
encode :: c (dat, x) y -> c x y -> c (val, valTy, datEncTy, x) y
deriving instance (ArrowSerialize val dat valTy datDecTy datEncTy c) => ArrowSerialize val dat valTy datDecTy datEncTy (ValueT val2 c)
class ArrowMemory addr bytes c | c -> addr, c -> bytes where
memread :: c (bytes, x) y -> c x y -> c (addr, Int, x) y
memstore :: c x y -> c x y -> c (addr, bytes, x) y
deriving instance (ArrowMemory addr bytes c) => ArrowMemory addr bytes (ValueT val2 c)
class ArrowMemAddress base off addr c where
memaddr :: c (base, off) addr
deriving instance (ArrowMemAddress base off addr c) => ArrowMemAddress base off addr (ValueT val2 c)
class ArrowMemSizable sz c where
memsize :: c () sz
memgrow :: c (sz,x) y -> c x y -> c (sz,x) y
deriving instance (ArrowMemSizable sz c) => ArrowMemSizable sz (ValueT val2 c)
data LoadType = L_I32 | L_I64 | L_F32 | L_F64 | L_I8S | L_I8U | L_I16S | L_I16U | L_I32S | L_I32U
deriving Show
data StoreType = S_I32 | S_I64 | S_F32 | S_F64 | S_I8 | S_I16
......@@ -145,7 +159,7 @@ class Show v => IsVal v c | c -> v where
invokeExported ::
( ArrowChoice c, ArrowFrame FrameData v c, ArrowWasmStore v c,
ArrowStack v c, ArrowExcept (Exc v) c, ArrowReader Read c,
ArrowWasmMemory addr bytes v c, HostFunctionSupport addr bytes v c,
ArrowWasmMemory addr bytes v c, --HostFunctionSupport addr bytes v c,
IsVal v c, Show v,
Exc.Join () c,
Fail.Join [v] c,
......@@ -164,7 +178,7 @@ invokeExported = proc (funcName, args) -> do
invokeExternal ::
( ArrowChoice c, ArrowFrame FrameData v c, ArrowWasmStore v c,
ArrowStack v c, ArrowExcept (Exc v) c, ArrowReader Read c,
ArrowWasmMemory addr bytes v c, HostFunctionSupport addr bytes v c,
ArrowWasmMemory addr bytes v c, --HostFunctionSupport addr bytes v c,
IsVal v c, Show v,
Exc.Join () c,
Fail.Join () c,
......@@ -177,8 +191,8 @@ invokeExternal = proc (funcAddr, args) ->
readFunction
(proc (func@(FuncType paramTys resultTys, _, _), args) ->
withCheckedType (withRootFrame (invoke eval)) -< (paramTys, args, (resultTys, args, func)))
(proc (func@(FuncType paramTys resultTys, _), args) ->
withCheckedType (withRootFrame invokeHost) -< (paramTys, args, (resultTys, args, func)))
--(proc (func@(FuncType paramTys resultTys, _), args) ->
-- withCheckedType (withRootFrame invokeHost) -< (paramTys, args, (resultTys, args, func)))
-< (funcAddr, args)
where
withRootFrame f = proc (resultTys, args, x) -> do
......@@ -207,7 +221,7 @@ invokeExternal = proc (funcAddr, args) ->
eval ::
( ArrowChoice c, ArrowFrame FrameData v c, ArrowWasmStore v c,
ArrowStack v c, ArrowExcept (Exc v) c, ArrowReader Read c,
ArrowWasmMemory addr bytes v c, HostFunctionSupport addr bytes v c,
ArrowWasmMemory addr bytes v c, --HostFunctionSupport addr bytes v c,
IsVal v c, Show v,
Exc.Join () c,
ArrowFix (c [Instruction Natural] ()),
......@@ -241,7 +255,7 @@ evalControlInst ::
ArrowReader Read c, -- return arity of nested labels
ArrowFrame FrameData v c, -- frame data and local variables
ArrowWasmStore v c,
HostFunctionSupport addr bytes v c,
--HostFunctionSupport addr bytes v c,
Exc.Join () c)
=> c [Instruction Natural] () -> c (Instruction Natural) ()
evalControlInst eval' = proc i -> case i of
......@@ -272,7 +286,7 @@ evalControlInst eval' = proc i -> case i of
Call ix -> do
(_, modInst) <- frameData -< ()
let funcAddr = funcaddrs modInst ! fromIntegral ix
readFunction (invoke eval' <<^ fst) (invokeHost <<^ fst) -< (funcAddr, ())
readFunction (invoke eval' <<^ fst) -< (funcAddr, ()) --(invokeHost <<^ fst) -< (funcAddr, ())
CallIndirect ix -> do
(_, modInst) <- frameData -< ()
let tableAddr = tableaddrs modInst ! 0
......@@ -285,15 +299,15 @@ evalControlInst eval' = proc i -> case i of
invokeChecked ::
( ArrowChoice c, ArrowWasmStore v c, ArrowStack v c, ArrowReader Read c,
IsVal v c, ArrowFrame FrameData v c, ArrowExcept (Exc v) c, Exc.Join () c,
HostFunctionSupport addr bytes v c)
IsVal v c, ArrowFrame FrameData v c, ArrowExcept (Exc v) c, Exc.Join () c)
--HostFunctionSupport addr bytes v c)
=> c [Instruction Natural] () -> c (Int, FuncType) ()
invokeChecked eval' = proc (addr, ftExpect) ->
readFunction
(proc (f@(ftActual, _, _), ftExpect) ->
withCheckedType (invoke eval') -< (ftActual, ftExpect, f))
(proc (f@(ftActual, _), ftExpect) ->
withCheckedType invokeHost -< (ftActual, ftExpect, f))
--(proc (f@(ftActual, _), ftExpect) ->
-- withCheckedType invokeHost -< (ftActual, ftExpect, f))
-< (addr, ftExpect)
where
withCheckedType f = proc (ftActual, ftExpect, x) ->
......@@ -429,7 +443,7 @@ load byteSize loadType valType = proc off -> do
(push <<^ fst)
(error "decode failure")
-< (bytes, loadType, valType, ()))
(proc addr -> throw -< Trap $ printf "Memory access out of bounds: Cannot read %d bytes at address %s in current memory" byteSize (show addr))
(proc addr -> throw -< Trap $ printf "Memory access out of bounds: Cannot read %d bytes at address %s in current memory" byteSize "")--(show addr))
-< (addr, byteSize, addr)
store ::
......@@ -445,7 +459,7 @@ store storeType valType = proc off -> do
addr <- memaddr -< (base, off)
memstore
(arr $ const ())
(proc (addr,bytes) -> throw -< Trap $ printf "Memory access out of bounds: Cannot write %s at address %s in current memory" (show bytes) (show addr))
(proc (addr,bytes) -> throw -< Trap $ printf "Memory access out of bounds: Cannot write %s at address %s in current memory" "" "") --(show bytes) (show addr))
-< (addr, bytes, (addr, bytes)))
(error "encode failure")
-< (v, valType, storeType, off)
......
......@@ -30,19 +30,19 @@ spec = do
let inst = GetLocal 1
let fd = (0, Wasm.emptyModInstance)
let store = emptyWasmStore
(fst $ evalVariableInst inst [] fd (fromList $ map (Value . Wasm.VI32) [5,8,7]) store) `shouldBe`
(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 (Value . Wasm.VI32) [3,4,5]}
let fd = (0, Wasm.emptyModInstance{globaladdrs = fromList [0,1,2]})
(fst $ evalVariableInst inst [] fd empty store) `shouldBe` [Value $ Wasm.VI32 4]
(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 (Value . Wasm.VI32) [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) `shouldBe`
(globalInstances $ fst $ snd $ snd $ evalVariableInst inst stack fd empty store 0) `shouldBe`
(fromList $ map (Value . Wasm.VI32) [3,6,5])
it "evalParametricInst" $ do
......
module ParsingSpec where
import qualified Data.ByteString.Lazy as LBS
import Data.Text.Lazy (pack)
import Language.Wasm
import Language.Wasm.Structure
import Language.Wasm.Interpreter
import Test.Hspec
......@@ -17,3 +20,11 @@ spec = do
content <- LBS.readFile path
let Right parsed = parse content
(length $ functions parsed) `shouldBe` 7
it "run haskell wasm interpreter" $ do
content <- LBS.readFile path
let Right m = parse content
let Right validMod = validate m
Right (modInst, store) <- instantiate emptyStore emptyImports validMod
Just result <- invokeExport store modInst (pack "fac-rec") [VI64 2]
result `shouldBe` [VI64 2]
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