Commit 4fcf2961 authored by Katharina Brandl's avatar Katharina Brandl
Browse files

added logging + bugfixing

parent f2179c7b
Pipeline #100264 passed with stages
in 72 minutes and 46 seconds
......@@ -12,6 +12,7 @@ import Control.Arrow.Trans
import Control.Arrow.Transformer.Kleisli
import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Writer
import Data.Profunctor.Unsafe
......@@ -70,3 +71,9 @@ instance (Profunctor c, Arrow c, ArrowStack v c) => ArrowStack v (StateT st c) w
ifEmpty a1 a2 = lift (ifEmpty (unlift a1) (unlift a2))
localFreshStack a = lift (localFreshStack (unlift a))
instance (Arrow c, Profunctor c, Monoid w, ArrowStack v c) => ArrowStack v (WriterT w c) where
push = lift' push
pop = lift' pop
peek = lift' peek
ifEmpty a1 a2 = lift (ifEmpty (unlift a1) (unlift a1))
localFreshStack a = lift (localFreshStack (unlift a))
......@@ -4,7 +4,7 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Control.Arrow.Transformer.Concrete.Failure(FailureT,runFailureT) where
module Control.Arrow.Transformer.Concrete.Failure(FailureT (..),runFailureT) where
import Prelude hiding (id,(.),lookup,read,fail)
......
......@@ -18,6 +18,7 @@ import Control.Arrow.State
import Control.Arrow.Trans
import Control.Arrow.Transformer.State
import Control.Arrow.Utils
import Control.Arrow.Writer
import Data.Profunctor
import Data.Coerce
......@@ -26,7 +27,7 @@ import Data.Coerce
-- | Arrow transformer that adds a stack to a computation.
newtype StackT v c x y = StackT (StateT [v] c x y)
deriving (Profunctor,Category,Arrow,ArrowChoice,ArrowTrans,ArrowLift,ArrowRun,
ArrowConst r, ArrowReader r, ArrowFail e, ArrowExcept e, ArrowState [v])
ArrowConst r, ArrowReader r, ArrowFail e, ArrowExcept e, ArrowWriter w)
-- | Execute a computation and only return the result value and store.
runStackT :: StackT v c x y -> c ([v], x) ([v], y)
......
......@@ -38,6 +38,7 @@ import Control.Arrow.Reader
import Control.Arrow.State
import Control.Arrow.LetRec
import Control.Arrow.Fix.Context
import Control.Arrow.Writer
import Data.Profunctor.Unsafe
import Data.Coerce
......@@ -45,7 +46,7 @@ import Data.Coerce
newtype ValueT val c x y = ValueT { runValueT :: c x y }
deriving (Profunctor,Category,Arrow,ArrowChoice, ArrowConst r,
ArrowFrame frame, ArrowEnv var val', ArrowLetRec var val', ArrowStore addr val',
ArrowExcept exc,ArrowFail e,
ArrowExcept exc,ArrowFail e, ArrowWriter w,
ArrowReader r, ArrowState s, ArrowCont, ArrowCallSite ctx, ArrowStack st)
instance (ArrowApply c, Profunctor c) => ArrowApply (ValueT val c) where
......
......@@ -17,6 +17,8 @@ dependencies:
- wasm
- vector
- bytestring
- primitive
- list-singleton
library:
ghc-options: -Wall
......
......@@ -12,26 +12,15 @@
module ConcreteInterpreter where
import GenericInterpreter hiding (eval,evalNumericInst,evalVariableInstr,evalParametricInst,invokeExported)
import GenericInterpreter hiding (eval,evalNumericInst,evalParametricInst,invokeExported,store)
import qualified GenericInterpreter as Generic
--import Stack
import Control.Arrow
import Control.Arrow.Const
import Control.Arrow.Except
import Control.Arrow.Fail
import Control.Arrow.Fix
import Control.Arrow.Frame
import Control.Arrow.Reader
import Control.Arrow.Stack
import Control.Arrow.State
import Control.Arrow.Store
import qualified Control.Arrow.Trans as Trans
import Control.Arrow.WasmStore
import Control.Arrow.Transformer.Kleisli
import Control.Arrow.Transformer.DebuggableStack
import Control.Arrow.Transformer.Logger
import Control.Arrow.Transformer.Stack
import Control.Arrow.Trans
import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.Value
......@@ -39,29 +28,24 @@ 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.State
import Control.Category
import Data.Concrete.Error
import qualified Data.Function as Function
import Data.Monoidal (shuffle1)
import Data.Profunctor
import Data.IORef
import qualified Data.Primitive.ByteArray as ByteArray
import Data.Text.Lazy (Text)
import Data.Vector (Vector, (!), (//))
import Data.Vector (Vector)
import qualified Data.Vector as Vec
import Data.Word
import Language.Wasm.Interpreter (ModuleInstance,emptyStore,emptyImports)
import qualified Language.Wasm.Interpreter as Wasm
import Language.Wasm.Structure hiding (exports)
import Language.Wasm.Structure hiding (exports, Const)
import Language.Wasm.Validate (ValidModule)
import Numeric.Natural (Natural)
import System.IO.Unsafe (unsafePerformIO)
-- memory instance: vec(byte) + optional max size
-- bytes are modeled as Word8
-- addresses are modeled as Word32
......@@ -107,24 +91,32 @@ import System.IO.Unsafe (unsafePerformIO)
--
--
toVal32 :: Word32 -> Value
toVal32 = Value . Wasm.VI32
toVal64 :: Word64 -> Value
toVal64 = Value . Wasm.VI64
instance (ArrowChoice c) => IsVal Value (ValueT Value c) where
i32const = proc w32 -> returnA -< Value $ Wasm.VI32 w32
i64const = proc w64 -> returnA -< Value $ Wasm.VI64 w64
iBinOp = proc (bs,op,Value v1,Value v2) ->
case bs of
BS32 -> do
case op of
IAdd -> returnA -< Just $ Value $ addVal v1 v2
case (bs,op,v1,v2) of
(BS32, IAdd, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< Just $ toVal32 $ val1 + val2
(BS32, IMul, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< Just $ toVal32 $ val1 * val2
(BS32, ISub, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< Just $ toVal32 $ val1 - val2
(BS64, IAdd, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< Just $ toVal64 $ val1 + val2
(BS64, IMul, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< Just $ toVal64 $ val1 * val2
(BS64, ISub, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< Just $ toVal64 $ val1 - val2
iRelOp = proc (bs,op,Value v1, Value v2) ->
case bs of
BS32 -> do
case op of
IEq -> returnA -< Value $ if v1 == v2 then (Wasm.VI32 1) else (Wasm.VI32 0)
BS64 -> do
case op of
IEq -> returnA -< Value $ if v1 == v2 then (Wasm.VI32 1) else (Wasm.VI32 0)
case (bs,op,v1,v2) of
(BS32, IEq, Wasm.VI32 val1, Wasm.VI32 val2) ->
returnA -< toVal32 $ if val1 == val2 then 1 else 0
-- (BS64, ILtU, Wasm.VI64 val1, Wasm.VI64 val2) ->
-- returnA -< toVal64 $ if val1 < val2 then 1 else 0
(BS64, IEq, Wasm.VI64 val1, Wasm.VI64 val2) ->
returnA -< toVal32 $ if val1 == val2 then 1 else 0
i32ifNeqz f g = proc (v, x) -> do
......@@ -177,24 +169,24 @@ evalParametricInst inst stack =
(->)) (Instruction Natural) ()) (stack,inst)
eval :: [Instruction Natural] -> [Value] -> Generic.LabelArities -> 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.LabelArities
(ExceptT (Generic.Exc Value)
(StackT Value
(->)))))) [Instruction Natural] ()) (stack,(r,(locals,(fd,(wasmStore,(currentMem,inst))))))
--eval :: [Instruction Natural] -> [Value] -> Generic.LabelArities -> 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.LabelArities
-- (ExceptT (Generic.Exc Value)
-- (StackT Value
-- (->)))))) [Instruction Natural] ()) (stack,(r,(locals,(fd,(wasmStore,(currentMem,inst))))))
......@@ -202,38 +194,54 @@ invokeExported :: WasmStore Value
-> ModuleInstance
-> Text
-> [Value]
-> Error
-> ([String], Error
[Char]
(Vector Value,
(WasmStore Value, Error (Exc Value) ([Value], [Value])))
(WasmStore Value, Error (Exc Value) ([Value], [Value]))))
invokeExported store modInst funcName args =
let ?fixpointAlgorithm = Function.fix in
Trans.run
(Generic.invokeExported ::
ValueT Value
(ReaderT Generic.LabelArities
(StackT Value
(DebuggableStackT Value
(ExceptT (Generic.Exc Value)
(WasmStoreT Value
(FrameT FrameData Value
(FailureT String
(->))))))) (Text, [Value]) [Value]) (Vec.empty,((0,modInst),(store,(0,([],(Generic.LabelArities [],(funcName,args)))))))
(LoggerT String
(->)))))))) (Text, [Value]) [Value]) ([],(Vec.empty,((0,modInst),(store,(0,([],(Generic.LabelArities [],(funcName,args))))))))
instantiate :: ValidModule -> IO (Either String (ModuleInstance, WasmStore Value))
instantiate valMod = do
res <- Wasm.instantiate emptyStore emptyImports valMod
case res of
Right (modInst, store) -> return $ Right $ (modInst, storeToWasmStore store)
Right (modInst, store) -> do
wasmStore <- storeToWasmStore store
return $ Right $ (modInst, wasmStore)
Left e -> return $ Left e
where
storeToWasmStore (Wasm.Store funcI tableI memI globalI) =
WasmStore (Vec.map convertFuncs funcI)
(Vec.map TableInst tableI)
(Vec.map convertMem memI)
(convertGlobals globalI)
storeToWasmStore (Wasm.Store funcI tableI memI globalI) = do
mems <- Vec.mapM convertMem memI
globs <- Vec.mapM convertGlobals globalI
return $ WasmStore (Vec.map convertFuncs funcI)
(Vec.map TableInst tableI)
mems
globs
convertFuncs (Wasm.FunctionInstance t m c) = FuncInst t m c
convertFuncs (Wasm.HostInstance t _) = HostInst t
convertMem (Wasm.MemoryInstance _ _) = MemInst Vec.empty -- TODO
convertGlobals _ = Vec.empty -- TODO
convertMem (Wasm.MemoryInstance (Limit _ n) mem) = do
memStore <- readIORef mem
size <- ByteArray.getSizeofMutableByteArray memStore
list <- sequence $ map (\x -> ByteArray.readByteArray memStore x) [0 .. (size-1)]
let sizeConverted = fmap fromIntegral n
return $ MemInst sizeConverted $ Vec.fromList list
convertGlobals (Wasm.GIConst _ v) = return $ GlobInst Const (Value v)
convertGlobals (Wasm.GIMut _ v) = do
val <- readIORef v
return $ GlobInst Mutable (Value val)
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Control.Arrow.DebuggableStack where
import Control.Arrow
import Control.Arrow.Stack (ArrowStack)
import Control.Arrow.Trans
import Control.Arrow.Transformer.Kleisli
import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Value
import Control.Arrow.Transformer.Writer
import Data.Profunctor.Unsafe
import Numeric.Natural (Natural)
class ArrowStack v c => ArrowDebuggableStack v c | c -> v where
getStack :: c () [v]
---------------- instances -------------------------
instance (Profunctor c, Arrow c, Monad f, ArrowDebuggableStack v c) => ArrowDebuggableStack v (KleisliT f c) where
getStack = lift' getStack
instance (Profunctor c, Arrow c, ArrowDebuggableStack v c) => ArrowDebuggableStack v (ReaderT r c) where
getStack = lift' getStack
instance (Profunctor c, Arrow c, ArrowDebuggableStack v c) => ArrowDebuggableStack v (StateT st c) where
getStack = lift' getStack
deriving instance (ArrowDebuggableStack v c) => ArrowDebuggableStack v (ValueT val c)
instance (Monoid w, Profunctor c, Arrow c, ArrowDebuggableStack v c) => ArrowDebuggableStack v (WriterT w c) where
getStack = lift' getStack
......@@ -28,6 +28,7 @@ import Control.Arrow.Transformer.Kleisli
import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.Stack
import Control.Arrow.Transformer.Value
import Control.Arrow.Transformer.Writer
import Data.Monoidal (shuffle1)
import Data.Profunctor
......@@ -78,3 +79,8 @@ instance (Monad f, Profunctor c, Arrow c, ArrowFrame fd v c) => ArrowFrame fd v
frameLookup = lift' frameLookup
frameUpdate = lift' frameUpdate
deriving instance (Profunctor c, Arrow c, ArrowFrame fd v c) => ArrowFrame fd v (StackT s c)
instance (Profunctor c, Arrow c, ArrowFrame fd v c, Monoid w) => ArrowFrame fd v (WriterT w c) where
inNewFrame a = lift (inNewFrame (unlift a))
frameData = lift' frameData
frameLookup = lift' frameLookup
frameUpdate = lift' frameUpdate
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Arrow.Logger where
import Prelude hiding (log)
import Control.Arrow
import Control.Arrow.Trans
import Control.Arrow.Transformer.Concrete.Except
import Control.Arrow.Transformer.Concrete.Frame
import Control.Arrow.Transformer.Kleisli
import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.Stack
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Value
import Control.Arrow.Transformer.Concrete.Failure
import Data.Profunctor
class ArrowLogger v c | c -> v where
log :: c v ()
deriving instance (ArrowLogger v c) => ArrowLogger v (ValueT val c)
deriving instance (Arrow c, Profunctor c, ArrowLogger v c) => ArrowLogger v (FailureT e c)
instance (Monad f, Arrow c, Profunctor c, ArrowLogger v c) => ArrowLogger v (KleisliT f c) where
log = lift' log
deriving instance (Arrow c, Profunctor c, ArrowLogger v c) => ArrowLogger v (FrameT fd val c)
instance (Arrow c, Profunctor c, ArrowLogger v c) => ArrowLogger v (ReaderT r c) where
log = lift' log
instance (Arrow c, Profunctor c, ArrowLogger v c) => ArrowLogger v (StateT s c) where
log = lift' log
deriving instance (Arrow c, Profunctor c, ArrowLogger v c) => ArrowLogger v (ExceptT e c)
deriving instance (Arrow c, Profunctor c, ArrowLogger v c) => ArrowLogger v (StackT s c)
......@@ -11,7 +11,7 @@ import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.Stack
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Value
import Control.Arrow.Transformer.Writer
class ArrowMemAddress base off addr c where
memaddr :: c (base, off) addr
......@@ -25,3 +25,5 @@ instance (ArrowMemAddress base off addr c) => ArrowMemAddress base off addr (Sta
-- TODO
instance (ArrowMemAddress base off addr c) => ArrowMemAddress base off addr (ReaderT r c) where
-- TODO
instance (ArrowMemAddress base off addr c) => ArrowMemAddress base off addr (WriterT w c) where
-- TODO
......@@ -14,6 +14,7 @@ import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.Stack
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Value
import Control.Arrow.Transformer.Writer
import Data.Profunctor
......@@ -31,3 +32,5 @@ instance (ArrowMemSizable sz c) => ArrowMemSizable sz (StateT s c) where
-- TODO
instance (ArrowMemSizable sz c) => ArrowMemSizable sz (ReaderT r c) where
-- TODO
instance (ArrowMemSizable sz c) => ArrowMemSizable sz (WriterT r c) where
-- TODO
......@@ -12,6 +12,7 @@ import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.Stack
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Value
import Control.Arrow.Transformer.Writer
class ArrowMemory addr bytes c | c -> addr, c -> bytes where
memread :: c (bytes, x) y -> c x y -> c (addr, Int, x) y
......@@ -26,3 +27,5 @@ instance (ArrowMemory addr bytes c) => ArrowMemory addr bytes (StateT s c) where
-- TODO
instance (ArrowMemory addr bytes c) => ArrowMemory addr bytes (ReaderT r c) where
-- TODO
instance (ArrowMemory addr bytes c) => ArrowMemory addr bytes (WriterT r c) where
-- TODO
......@@ -12,6 +12,7 @@ import Control.Arrow.Transformer.Reader
import Control.Arrow.Transformer.Stack
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Value
import Control.Arrow.Transformer.Writer
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
......@@ -26,3 +27,5 @@ instance (ArrowSerialize val dat valTy datDecTy datEncTy c) => ArrowSerialize va
-- TODO
instance (ArrowSerialize val dat valTy datDecTy datEncTy c) => ArrowSerialize val dat valTy datDecTy datEncTy (ReaderT r c) where
-- TODO
instance (ArrowSerialize val dat valTy datDecTy datEncTy c) => ArrowSerialize val dat valTy datDecTy datEncTy (WriterT w c) where
-- TODO
......@@ -10,6 +10,7 @@ module Control.Arrow.Transformer.Concrete.WasmStore where
import Control.Arrow
import Control.Arrow.Const
import Control.Arrow.Logger
import Control.Arrow.Except
import Control.Arrow.Fail
import Control.Arrow.Fix
......@@ -36,21 +37,22 @@ import Data.Vector (Vector, (!), (//))
import qualified Data.Vector as Vec
import Data.Word
import Language.Wasm.Interpreter (ModuleInstance,emptyStore,emptyImports)
import Language.Wasm.Interpreter (ModuleInstance)
import qualified Language.Wasm.Interpreter as Wasm
import Language.Wasm.Structure hiding (exports)
import Language.Wasm.Structure hiding (exports, Const)
import Numeric.Natural (Natural)
import GenericInterpreter (LoadType,StoreType)
newtype Value = Value Wasm.Value deriving (Show, Eq)
data Mut = Const | Mutable deriving (Show, Eq)
data WasmStore v = WasmStore {
funcInstances :: Vector FuncInst,
tableInstances :: Vector TableInst,
memInstances :: Vector MemInst,
globalInstances :: Vector v
globalInstances :: Vector (GlobInst v)
} deriving (Show, Eq)
emptyWasmStore :: WasmStore v
......@@ -73,12 +75,13 @@ data FuncInst =
} deriving (Show,Eq)
newtype TableInst = TableInst Wasm.TableInstance deriving (Show,Eq)
newtype MemInst = MemInst (Vector Word8) 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)
deriving (Profunctor, Category, Arrow, ArrowChoice, ArrowLift,
ArrowFail e, ArrowExcept e, ArrowConst r, ArrowStore var' val', ArrowRun, ArrowFrame fd val,
ArrowStack st)--, ArrowState (WasmStore v))
ArrowStack st, ArrowLogger l)--, ArrowState (WasmStore v))
instance (ArrowReader r c) => ArrowReader r (WasmStoreT v c) where
ask = lift' ask
......@@ -88,17 +91,21 @@ 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' (lift' arr))
lift' a = WasmStoreT (lift' (lift' a))
instance (ArrowChoice c, Profunctor c) => ArrowWasmStore v (WasmStoreT v c) where
readGlobal =
WasmStoreT $ proc i -> do
WasmStore{globalInstances=vec} <- get -< ()
returnA -< vec ! i
let (GlobInst _ val) = vec ! i
returnA -< val
writeGlobal =
WasmStoreT $ proc (i,v) -> do
store@WasmStore{globalInstances=vec} <- get -< ()
put -< store{globalInstances=vec // [(i, v)]}
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
......@@ -115,7 +122,7 @@ instance (ArrowChoice c, Profunctor c) => ArrowMemory Word32 (Vector Word8) (Was
memread (WasmStoreT sCont) (WasmStoreT eCont) = WasmStoreT $ proc (addr, size, x) -> do
WasmStore{memInstances=mems} <- get -< ()
currMem <- ask -< ()
let MemInst vec = mems ! currMem
let MemInst _ vec = mems ! currMem
let addrI = fromIntegral addr
case (addrI+size <= length vec) of
True -> do
......@@ -125,13 +132,13 @@ instance (ArrowChoice c, Profunctor c) => ArrowMemory Word32 (Vector Word8) (Was
memstore (WasmStoreT sCont) (WasmStoreT eCont) = WasmStoreT $ proc (addr, content, x) -> do
store@WasmStore{memInstances=mems} <- get -< ()
currMem <- ask -< ()
let MemInst vec = mems ! currMem
let MemInst s 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)]})
put -< (store{memInstances=mems // [(currMem,MemInst s $ Vec.update_ vec ind content)]})
sCont -< x
False -> eCont -< x
......
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
module Control.Arrow.Transformer.DebuggableStack where
import Control.Category
import Control.Arrow
import Control.Arrow.Const
import Control.Arrow.DebuggableStack
import Control.Arrow.Except
import Control.Arrow.Fail
import Control.Arrow.Fix
import Control.Arrow.Frame
import Control.Arrow.Logger
import Control.Arrow.MemAddress
import Control.Arrow.Memory
import Control.Arrow.MemSizable
import Control.Arrow.Reader
import Control.Arrow.Stack
import Control.Arrow.State
import Control.Arrow.Trans
import Control.Arrow.Serialize
import Control.Arrow.Transformer.Stack
import Control.Arrow.WasmStore
import Control.Arrow.Writer