{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}

module Language.Wasm.Interpreter (
    Value(..),
    Store,
    ModuleInstance(..),
    ExternalValue(..),
    ExportInstance(..),
    GlobalInstance(..),
    Imports,
    HostItem(..),
    instantiate,
    invoke,
    invokeExport,
    getGlobalValueByName,
    emptyStore,
    emptyImports,
    makeHostModule,
    makeMutGlobal,
    makeConstGlobal
) where

import qualified Data.Map as Map
import qualified Data.Text.Lazy as TL
import qualified Data.ByteString.Lazy as LBS
import Data.Maybe (fromMaybe, isNothing)

import Data.Vector (Vector, (!), (!?), (//))
import qualified Data.Vector as Vector
import qualified Data.Primitive.ByteArray as ByteArray
import qualified Data.Primitive.Types as Primitive
import qualified Control.Monad.Primitive as Primitive
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Word (Word8, Word16, Word32, Word64)
import Data.Int (Int32, Int64)
import Numeric.Natural (Natural)
import qualified Control.Monad as Monad
import Data.Bits (
        Bits,
        (.|.),
        (.&.),
        xor,
        shiftL,
        shiftR,
        rotateL,
        rotateR,
        popCount,
        countLeadingZeros,
        countTrailingZeros
    )
import Numeric.IEEE (IEEE, copySign, minNum, maxNum, identicalIEEE)
import Control.Monad.Except (ExceptT, runExceptT, throwError)
import qualified Control.Monad.State as State
import Control.Monad.IO.Class (liftIO)

import Language.Wasm.Structure as Struct
import Language.Wasm.Validate as Valid
import Language.Wasm.FloatUtils (
        wordToFloat,
        floatToWord,
        wordToDouble,
        doubleToWord
    )

data Value =
    VI32 Word32
    | VI64 Word64
    | VF32 Float
    | VF64 Double
    deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)

asInt32 :: Word32 -> Int32
asInt32 :: Word32 -> Int32
asInt32 Word32
w =
    if Word32
w Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
0x80000000
    then Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
    else -Int32
1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
0xFFFFFFFF Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)

asInt64 :: Word64 -> Int64
asInt64 :: Word64 -> Int64
asInt64 Word64
w =
    if Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
0x8000000000000000
    then Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w
    else -Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
0xFFFFFFFFFFFFFFFF Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)

asWord32 :: Int32 -> Word32
asWord32 :: Int32 -> Word32
asWord32 Int32
i
    | Int32
i Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
0 = Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i
    | Bool
otherwise = Word32
0xFFFFFFFF Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int32
forall a. Num a => a -> a
abs Int32
i)) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1

asWord64 :: Int64 -> Word64
asWord64 :: Int64 -> Word64
asWord64 Int64
i
    | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    | Bool
otherwise = Word64
0xFFFFFFFFFFFFFFFF Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64
forall a. Num a => a -> a
abs Int64
i)) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1

nearest :: (IEEE a) => a -> a
nearest :: a -> a
nearest a
f
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
f = a
f
    | a
f a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
f a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0.5 = a -> a -> a
forall a. IEEE a => a -> a -> a
copySign a
0 a
f
    | a
f a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
&& a
f a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= -a
0.5 = -a
0
    | Bool
otherwise =
        let i :: Integer
i = a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor a
f :: Integer in
        let fi :: a
fi = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i in
        let r :: a
r = a -> a
forall a. Num a => a -> a
abs a
f a -> a -> a
forall a. Num a => a -> a -> a
- a -> a
forall a. Num a => a -> a
abs a
fi in
        (a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a. IEEE a => a -> a -> a
copySign a
f (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ (
            if a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0.5
            then (
                case (Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
i, a
f a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0) of
                    (Bool
True, Bool
_) -> a
fi
                    (Bool
_, Bool
True) -> a
fi a -> a -> a
forall a. Num a => a -> a -> a
- a
1.0
                    (Bool
_, Bool
False) -> a
fi a -> a -> a
forall a. Num a => a -> a -> a
+ a
1.0
            )
            else Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round a
f :: Integer)
        )

zeroAwareMin :: IEEE a => a -> a -> a
zeroAwareMin :: a -> a -> a
zeroAwareMin a
a a
b
    | a -> a -> Bool
forall a. IEEE a => a -> a -> Bool
identicalIEEE a
a a
0 Bool -> Bool -> Bool
&& a -> a -> Bool
forall a. IEEE a => a -> a -> Bool
identicalIEEE a
b (-a
0) = a
b
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
a = a
a
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
b = a
b
    | Bool
otherwise = a -> a -> a
forall a. RealFloat a => a -> a -> a
minNum a
a a
b

zeroAwareMax :: IEEE a => a -> a -> a
zeroAwareMax :: a -> a -> a
zeroAwareMax a
a a
b
    | a -> a -> Bool
forall a. IEEE a => a -> a -> Bool
identicalIEEE a
a (-a
0) Bool -> Bool -> Bool
&& a -> a -> Bool
forall a. IEEE a => a -> a -> Bool
identicalIEEE a
b a
0 = a
b
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
a = a
a
    | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
b = a
b
    | Bool
otherwise = a -> a -> a
forall a. RealFloat a => a -> a -> a
maxNum a
a a
b

floatFloor :: Float -> Float
floatFloor :: Float -> Float
floatFloor Float
a
    | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
a = Float
a
    | Bool
otherwise = Float -> Float -> Float
forall a. IEEE a => a -> a -> a
copySign (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
a :: Integer)) Float
a

doubleFloor :: Double -> Double
doubleFloor :: Double -> Double
doubleFloor Double
a
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
a = Double
a
    | Bool
otherwise = Double -> Double -> Double
forall a. IEEE a => a -> a -> a
copySign (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
a :: Integer)) Double
a

floatCeil :: Float -> Float
floatCeil :: Float -> Float
floatCeil Float
a
    | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
a = Float
a
    | Bool
otherwise = Float -> Float -> Float
forall a. IEEE a => a -> a -> a
copySign (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
a :: Integer)) Float
a

doubleCeil :: Double -> Double
doubleCeil :: Double -> Double
doubleCeil Double
a
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
a = Double
a
    | Bool
otherwise = Double -> Double -> Double
forall a. IEEE a => a -> a -> a
copySign (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
a :: Integer)) Double
a

floatTrunc :: Float -> Float
floatTrunc :: Float -> Float
floatTrunc Float
a
    | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
a = Float
a
    | Bool
otherwise = Float -> Float -> Float
forall a. IEEE a => a -> a -> a
copySign (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
a :: Integer)) Float
a

doubleTrunc :: Double -> Double
doubleTrunc :: Double -> Double
doubleTrunc Double
a
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
a = Double
a
    | Bool
otherwise = Double -> Double -> Double
forall a. IEEE a => a -> a -> a
copySign (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
a :: Integer)) Double
a

data Label = Label ResultType deriving (Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show, Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq)

type Address = Int

data TableInstance = TableInstance {
    TableInstance -> Limit
lim :: Limit,
    TableInstance -> Vector (Maybe Int)
elements :: Vector (Maybe Address)
}

type MemoryStore = ByteArray.MutableByteArray (Primitive.PrimState IO)

data MemoryInstance = MemoryInstance {
    MemoryInstance -> Limit
lim :: Limit,
    MemoryInstance -> IORef MemoryStore
memory :: IORef MemoryStore
}

data GlobalInstance = GIConst ValueType Value | GIMut ValueType (IORef Value)

makeMutGlobal :: Value -> IO GlobalInstance
makeMutGlobal :: Value -> IO GlobalInstance
makeMutGlobal Value
val = ValueType -> IORef Value -> GlobalInstance
GIMut (Value -> ValueType
getValueType Value
val) (IORef Value -> GlobalInstance)
-> IO (IORef Value) -> IO GlobalInstance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> IO (IORef Value)
forall a. a -> IO (IORef a)
newIORef Value
val

makeConstGlobal :: Value -> GlobalInstance
makeConstGlobal :: Value -> GlobalInstance
makeConstGlobal Value
val = ValueType -> Value -> GlobalInstance
GIConst (Value -> ValueType
getValueType Value
val) Value
val

getValueType :: Value -> ValueType
getValueType :: Value -> ValueType
getValueType (VI32 Word32
_) = ValueType
I32
getValueType (VI64 Word64
_) = ValueType
I64
getValueType (VF32 Float
_) = ValueType
F32
getValueType (VF64 Double
_) = ValueType
F64

data ExportInstance = ExportInstance TL.Text ExternalValue deriving (ExportInstance -> ExportInstance -> Bool
(ExportInstance -> ExportInstance -> Bool)
-> (ExportInstance -> ExportInstance -> Bool) -> Eq ExportInstance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportInstance -> ExportInstance -> Bool
$c/= :: ExportInstance -> ExportInstance -> Bool
== :: ExportInstance -> ExportInstance -> Bool
$c== :: ExportInstance -> ExportInstance -> Bool
Eq, Int -> ExportInstance -> ShowS
[ExportInstance] -> ShowS
ExportInstance -> String
(Int -> ExportInstance -> ShowS)
-> (ExportInstance -> String)
-> ([ExportInstance] -> ShowS)
-> Show ExportInstance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportInstance] -> ShowS
$cshowList :: [ExportInstance] -> ShowS
show :: ExportInstance -> String
$cshow :: ExportInstance -> String
showsPrec :: Int -> ExportInstance -> ShowS
$cshowsPrec :: Int -> ExportInstance -> ShowS
Show)

data ExternalValue =
    ExternFunction Address
    | ExternTable Address
    | ExternMemory Address
    | ExternGlobal Address
    deriving (ExternalValue -> ExternalValue -> Bool
(ExternalValue -> ExternalValue -> Bool)
-> (ExternalValue -> ExternalValue -> Bool) -> Eq ExternalValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalValue -> ExternalValue -> Bool
$c/= :: ExternalValue -> ExternalValue -> Bool
== :: ExternalValue -> ExternalValue -> Bool
$c== :: ExternalValue -> ExternalValue -> Bool
Eq, Int -> ExternalValue -> ShowS
[ExternalValue] -> ShowS
ExternalValue -> String
(Int -> ExternalValue -> ShowS)
-> (ExternalValue -> String)
-> ([ExternalValue] -> ShowS)
-> Show ExternalValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternalValue] -> ShowS
$cshowList :: [ExternalValue] -> ShowS
show :: ExternalValue -> String
$cshow :: ExternalValue -> String
showsPrec :: Int -> ExternalValue -> ShowS
$cshowsPrec :: Int -> ExternalValue -> ShowS
Show)

data FunctionInstance =
    FunctionInstance {
        FunctionInstance -> FuncType
funcType :: FuncType,
        FunctionInstance -> ModuleInstance
moduleInstance :: ModuleInstance,
        FunctionInstance -> Function
code :: Function
    }
    | HostInstance {
        funcType :: FuncType,
        FunctionInstance -> HostFunction
hostCode :: HostFunction
    }

data Store = Store {
    Store -> Vector FunctionInstance
funcInstances :: Vector FunctionInstance,
    Store -> Vector TableInstance
tableInstances :: Vector TableInstance,
    Store -> Vector MemoryInstance
memInstances :: Vector MemoryInstance,
    Store -> Vector GlobalInstance
globalInstances :: Vector GlobalInstance
}

emptyStore :: Store
emptyStore :: Store
emptyStore = Store :: Vector FunctionInstance
-> Vector TableInstance
-> Vector MemoryInstance
-> Vector GlobalInstance
-> Store
Store {
    $sel:funcInstances:Store :: Vector FunctionInstance
funcInstances = Vector FunctionInstance
forall a. Vector a
Vector.empty,
    $sel:tableInstances:Store :: Vector TableInstance
tableInstances = Vector TableInstance
forall a. Vector a
Vector.empty,
    $sel:memInstances:Store :: Vector MemoryInstance
memInstances = Vector MemoryInstance
forall a. Vector a
Vector.empty,
    $sel:globalInstances:Store :: Vector GlobalInstance
globalInstances = Vector GlobalInstance
forall a. Vector a
Vector.empty
}

type HostFunction = [Value] -> IO [Value]

data HostItem
    = HostFunction FuncType HostFunction
    | HostGlobal GlobalInstance
    | HostMemory Limit
    | HostTable Limit

makeHostModule :: Store -> [(TL.Text, HostItem)] -> IO (Store, ModuleInstance)
makeHostModule :: Store -> [(Text, HostItem)] -> IO (Store, ModuleInstance)
makeHostModule Store
st [(Text, HostItem)]
items = do
    (Store
st, ModuleInstance
emptyModInstance)
        (Store, ModuleInstance)
-> ((Store, ModuleInstance) -> (Store, ModuleInstance))
-> (Store, ModuleInstance)
forall a c. a -> (a -> c) -> c
|> (Store, ModuleInstance) -> (Store, ModuleInstance)
makeHostFunctions
        (Store, ModuleInstance)
-> ((Store, ModuleInstance) -> (Store, ModuleInstance))
-> (Store, ModuleInstance)
forall a c. a -> (a -> c) -> c
|> (Store, ModuleInstance) -> (Store, ModuleInstance)
makeHostGlobals
        (Store, ModuleInstance)
-> ((Store, ModuleInstance) -> IO (Store, ModuleInstance))
-> IO (Store, ModuleInstance)
forall a c. a -> (a -> c) -> c
|> (Store, ModuleInstance) -> IO (Store, ModuleInstance)
makeHostMems
        IO (Store, ModuleInstance)
-> ((Store, ModuleInstance) -> IO (Store, ModuleInstance))
-> IO (Store, ModuleInstance)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Store, ModuleInstance) -> IO (Store, ModuleInstance)
makeHostTables
    where
        |> :: a -> (a -> c) -> c
(|>) = ((a -> c) -> a -> c) -> a -> (a -> c) -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> c) -> a -> c
forall a b. (a -> b) -> a -> b
($)

        makeHostFunctions :: (Store, ModuleInstance) -> (Store, ModuleInstance)
        makeHostFunctions :: (Store, ModuleInstance) -> (Store, ModuleInstance)
makeHostFunctions (Store
st, ModuleInstance
inst) =
            let funcLen :: Int
funcLen = Vector FunctionInstance -> Int
forall a. Vector a -> Int
Vector.length (Vector FunctionInstance -> Int) -> Vector FunctionInstance -> Int
forall a b. (a -> b) -> a -> b
$ Store -> Vector FunctionInstance
funcInstances Store
st in
            let ([Text]
names, [FuncType]
types, [FunctionInstance]
instances) = [(Text, FuncType, FunctionInstance)]
-> ([Text], [FuncType], [FunctionInstance])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(Text
name, FuncType
t, FuncType -> HostFunction -> FunctionInstance
HostInstance FuncType
t HostFunction
c) | (Text
name, (HostFunction FuncType
t HostFunction
c)) <- [(Text, HostItem)]
items] in
            let exps :: Vector ExportInstance
exps = [ExportInstance] -> Vector ExportInstance
forall a. [a] -> Vector a
Vector.fromList ([ExportInstance] -> Vector ExportInstance)
-> [ExportInstance] -> Vector ExportInstance
forall a b. (a -> b) -> a -> b
$ (Text -> Int -> ExportInstance)
-> [Text] -> [Int] -> [ExportInstance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
name Int
i -> Text -> ExternalValue -> ExportInstance
ExportInstance Text
name (Int -> ExternalValue
ExternFunction Int
i)) [Text]
names [Int
funcLen..] in
            let inst' :: ModuleInstance
inst' = ModuleInstance
inst {
                    $sel:funcTypes:ModuleInstance :: Vector FuncType
funcTypes = [FuncType] -> Vector FuncType
forall a. [a] -> Vector a
Vector.fromList [FuncType]
types,
                    $sel:funcaddrs:ModuleInstance :: Vector Int
funcaddrs = [Int] -> Vector Int
forall a. [a] -> Vector a
Vector.fromList [Int
funcLen..Int
funcLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [FunctionInstance] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FunctionInstance]
instances Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1],
                    $sel:exports:ModuleInstance :: Vector ExportInstance
exports = ModuleInstance -> Vector ExportInstance
Language.Wasm.Interpreter.exports ModuleInstance
inst Vector ExportInstance
-> Vector ExportInstance -> Vector ExportInstance
forall a. Semigroup a => a -> a -> a
<> Vector ExportInstance
exps
                }
            in
            let st' :: Store
st' = Store
st { $sel:funcInstances:Store :: Vector FunctionInstance
funcInstances = Store -> Vector FunctionInstance
funcInstances Store
st Vector FunctionInstance
-> Vector FunctionInstance -> Vector FunctionInstance
forall a. Semigroup a => a -> a -> a
<> [FunctionInstance] -> Vector FunctionInstance
forall a. [a] -> Vector a
Vector.fromList [FunctionInstance]
instances } in
            (Store
st', ModuleInstance
inst')
        
        makeHostGlobals :: (Store, ModuleInstance) -> (Store, ModuleInstance)
        makeHostGlobals :: (Store, ModuleInstance) -> (Store, ModuleInstance)
makeHostGlobals (Store
st, ModuleInstance
inst) =
            let globLen :: Int
globLen = Vector GlobalInstance -> Int
forall a. Vector a -> Int
Vector.length (Vector GlobalInstance -> Int) -> Vector GlobalInstance -> Int
forall a b. (a -> b) -> a -> b
$ Store -> Vector GlobalInstance
globalInstances Store
st in
            let ([Text]
names, [GlobalInstance]
instances) = [(Text, GlobalInstance)] -> ([Text], [GlobalInstance])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Text
name, GlobalInstance
g) | (Text
name, (HostGlobal GlobalInstance
g)) <- [(Text, HostItem)]
items] in
            let exps :: Vector ExportInstance
exps = [ExportInstance] -> Vector ExportInstance
forall a. [a] -> Vector a
Vector.fromList ([ExportInstance] -> Vector ExportInstance)
-> [ExportInstance] -> Vector ExportInstance
forall a b. (a -> b) -> a -> b
$ (Text -> Int -> ExportInstance)
-> [Text] -> [Int] -> [ExportInstance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
name Int
i -> Text -> ExternalValue -> ExportInstance
ExportInstance Text
name (Int -> ExternalValue
ExternGlobal Int
i)) [Text]
names [Int
globLen..] in
            let inst' :: ModuleInstance
inst' = ModuleInstance
inst {
                    $sel:globaladdrs:ModuleInstance :: Vector Int
globaladdrs = [Int] -> Vector Int
forall a. [a] -> Vector a
Vector.fromList [Int
globLen..Int
globLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [GlobalInstance] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GlobalInstance]
instances Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1],
                    $sel:exports:ModuleInstance :: Vector ExportInstance
exports = ModuleInstance -> Vector ExportInstance
Language.Wasm.Interpreter.exports ModuleInstance
inst Vector ExportInstance
-> Vector ExportInstance -> Vector ExportInstance
forall a. Semigroup a => a -> a -> a
<> Vector ExportInstance
exps
                }
            in
            let st' :: Store
st' = Store
st { $sel:globalInstances:Store :: Vector GlobalInstance
globalInstances = Store -> Vector GlobalInstance
globalInstances Store
st Vector GlobalInstance
-> Vector GlobalInstance -> Vector GlobalInstance
forall a. Semigroup a => a -> a -> a
<> [GlobalInstance] -> Vector GlobalInstance
forall a. [a] -> Vector a
Vector.fromList [GlobalInstance]
instances } in
            (Store
st', ModuleInstance
inst')
            
        makeHostMems :: (Store, ModuleInstance) -> IO (Store, ModuleInstance)
        makeHostMems :: (Store, ModuleInstance) -> IO (Store, ModuleInstance)
makeHostMems (Store
st, ModuleInstance
inst) = do
            let memLen :: Int
memLen = Vector MemoryInstance -> Int
forall a. Vector a -> Int
Vector.length (Vector MemoryInstance -> Int) -> Vector MemoryInstance -> Int
forall a b. (a -> b) -> a -> b
$ Store -> Vector MemoryInstance
memInstances Store
st
            let ([Text]
names, [Memory]
limits) = [(Text, Memory)] -> ([Text], [Memory])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Text
name, Limit -> Memory
Memory Limit
lim) | (Text
name, (HostMemory Limit
lim)) <- [(Text, HostItem)]
items]
            Vector MemoryInstance
instances <- [Memory] -> IO (Vector MemoryInstance)
allocMems [Memory]
limits
            let exps :: Vector ExportInstance
exps = [ExportInstance] -> Vector ExportInstance
forall a. [a] -> Vector a
Vector.fromList ([ExportInstance] -> Vector ExportInstance)
-> [ExportInstance] -> Vector ExportInstance
forall a b. (a -> b) -> a -> b
$ (Text -> Int -> ExportInstance)
-> [Text] -> [Int] -> [ExportInstance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
name Int
i -> Text -> ExternalValue -> ExportInstance
ExportInstance Text
name (Int -> ExternalValue
ExternMemory Int
i)) [Text]
names [Int
memLen..]
            let inst' :: ModuleInstance
inst' = ModuleInstance
inst {
                    $sel:memaddrs:ModuleInstance :: Vector Int
memaddrs = [Int] -> Vector Int
forall a. [a] -> Vector a
Vector.fromList [Int
memLen..Int
memLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector MemoryInstance -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector MemoryInstance
instances Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1],
                    $sel:exports:ModuleInstance :: Vector ExportInstance
exports = ModuleInstance -> Vector ExportInstance
Language.Wasm.Interpreter.exports ModuleInstance
inst Vector ExportInstance
-> Vector ExportInstance -> Vector ExportInstance
forall a. Semigroup a => a -> a -> a
<> Vector ExportInstance
exps
                }
            let st' :: Store
st' = Store
st { $sel:memInstances:Store :: Vector MemoryInstance
memInstances = Store -> Vector MemoryInstance
memInstances Store
st Vector MemoryInstance
-> Vector MemoryInstance -> Vector MemoryInstance
forall a. Semigroup a => a -> a -> a
<> Vector MemoryInstance
instances }
            (Store, ModuleInstance) -> IO (Store, ModuleInstance)
forall (m :: * -> *) a. Monad m => a -> m a
return (Store
st', ModuleInstance
inst')
            
        makeHostTables :: (Store, ModuleInstance) -> IO (Store, ModuleInstance)
        makeHostTables :: (Store, ModuleInstance) -> IO (Store, ModuleInstance)
makeHostTables (Store
st, ModuleInstance
inst) = do
            let tableLen :: Int
tableLen = Vector TableInstance -> Int
forall a. Vector a -> Int
Vector.length (Vector TableInstance -> Int) -> Vector TableInstance -> Int
forall a b. (a -> b) -> a -> b
$ Store -> Vector TableInstance
tableInstances Store
st
            let ([Text]
names, [Table]
tables) = [(Text, Table)] -> ([Text], [Table])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Text
name, TableType -> Table
Table (Limit -> ElemType -> TableType
TableType Limit
lim ElemType
FuncRef)) | (Text
name, (HostTable Limit
lim)) <- [(Text, HostItem)]
items]
            let instances :: Vector TableInstance
instances = [Table] -> Vector TableInstance
allocTables [Table]
tables
            let exps :: Vector ExportInstance
exps = [ExportInstance] -> Vector ExportInstance
forall a. [a] -> Vector a
Vector.fromList ([ExportInstance] -> Vector ExportInstance)
-> [ExportInstance] -> Vector ExportInstance
forall a b. (a -> b) -> a -> b
$ (Text -> Int -> ExportInstance)
-> [Text] -> [Int] -> [ExportInstance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
name Int
i -> Text -> ExternalValue -> ExportInstance
ExportInstance Text
name (Int -> ExternalValue
ExternTable Int
i)) [Text]
names [Int
tableLen..]
            let inst' :: ModuleInstance
inst' = ModuleInstance
inst {
                    $sel:tableaddrs:ModuleInstance :: Vector Int
tableaddrs = [Int] -> Vector Int
forall a. [a] -> Vector a
Vector.fromList [Int
tableLen..Int
tableLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector TableInstance -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector TableInstance
instances Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1],
                    $sel:exports:ModuleInstance :: Vector ExportInstance
exports = ModuleInstance -> Vector ExportInstance
Language.Wasm.Interpreter.exports ModuleInstance
inst Vector ExportInstance
-> Vector ExportInstance -> Vector ExportInstance
forall a. Semigroup a => a -> a -> a
<> Vector ExportInstance
exps
                }
            let st' :: Store
st' = Store
st { $sel:tableInstances:Store :: Vector TableInstance
tableInstances = Store -> Vector TableInstance
tableInstances Store
st Vector TableInstance
-> Vector TableInstance -> Vector TableInstance
forall a. Semigroup a => a -> a -> a
<> Vector TableInstance
instances }
            (Store, ModuleInstance) -> IO (Store, ModuleInstance)
forall (m :: * -> *) a. Monad m => a -> m a
return (Store
st', ModuleInstance
inst')

data ModuleInstance = ModuleInstance {
    ModuleInstance -> Vector FuncType
funcTypes :: Vector FuncType,
    ModuleInstance -> Vector Int
funcaddrs :: Vector Address,
    ModuleInstance -> Vector Int
tableaddrs :: Vector Address,
    ModuleInstance -> Vector Int
memaddrs :: Vector Address,
    ModuleInstance -> Vector Int
globaladdrs :: Vector Address,
    ModuleInstance -> Vector ExportInstance
exports :: Vector ExportInstance
} deriving (ModuleInstance -> ModuleInstance -> Bool
(ModuleInstance -> ModuleInstance -> Bool)
-> (ModuleInstance -> ModuleInstance -> Bool) -> Eq ModuleInstance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleInstance -> ModuleInstance -> Bool
$c/= :: ModuleInstance -> ModuleInstance -> Bool
== :: ModuleInstance -> ModuleInstance -> Bool
$c== :: ModuleInstance -> ModuleInstance -> Bool
Eq, Int -> ModuleInstance -> ShowS
[ModuleInstance] -> ShowS
ModuleInstance -> String
(Int -> ModuleInstance -> ShowS)
-> (ModuleInstance -> String)
-> ([ModuleInstance] -> ShowS)
-> Show ModuleInstance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleInstance] -> ShowS
$cshowList :: [ModuleInstance] -> ShowS
show :: ModuleInstance -> String
$cshow :: ModuleInstance -> String
showsPrec :: Int -> ModuleInstance -> ShowS
$cshowsPrec :: Int -> ModuleInstance -> ShowS
Show)

emptyModInstance :: ModuleInstance
emptyModInstance :: ModuleInstance
emptyModInstance = ModuleInstance :: Vector FuncType
-> Vector Int
-> Vector Int
-> Vector Int
-> Vector Int
-> Vector ExportInstance
-> ModuleInstance
ModuleInstance {
    $sel:funcTypes:ModuleInstance :: Vector FuncType
funcTypes = Vector FuncType
forall a. Vector a
Vector.empty,
    $sel:funcaddrs:ModuleInstance :: Vector Int
funcaddrs = Vector Int
forall a. Vector a
Vector.empty,
    $sel:tableaddrs:ModuleInstance :: Vector Int
tableaddrs = Vector Int
forall a. Vector a
Vector.empty,
    $sel:memaddrs:ModuleInstance :: Vector Int
memaddrs = Vector Int
forall a. Vector a
Vector.empty,
    $sel:globaladdrs:ModuleInstance :: Vector Int
globaladdrs = Vector Int
forall a. Vector a
Vector.empty,
    $sel:exports:ModuleInstance :: Vector ExportInstance
exports = Vector ExportInstance
forall a. Vector a
Vector.empty
}

calcInstance :: Store -> Imports -> Module -> Initialize ModuleInstance
calcInstance :: Store -> Imports -> Module -> Initialize ModuleInstance
calcInstance (Store Vector FunctionInstance
fs Vector TableInstance
ts Vector MemoryInstance
ms Vector GlobalInstance
gs) Imports
imps Module {[Function]
$sel:functions:Module :: Module -> [Function]
functions :: [Function]
functions, [FuncType]
$sel:types:Module :: Module -> [FuncType]
types :: [FuncType]
types, [Table]
$sel:tables:Module :: Module -> [Table]
tables :: [Table]
tables, [Memory]
$sel:mems:Module :: Module -> [Memory]
mems :: [Memory]
mems, [Global]
$sel:globals:Module :: Module -> [Global]
globals :: [Global]
globals, [Export]
$sel:exports:Module :: Module -> [Export]
exports :: [Export]
exports, [Import]
$sel:imports:Module :: Module -> [Import]
imports :: [Import]
imports} = do
    let funLen :: Int
funLen = Vector FunctionInstance -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector FunctionInstance
fs
    let tableLen :: Int
tableLen = Vector TableInstance -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector TableInstance
ts
    let memLen :: Int
memLen = Vector MemoryInstance -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector MemoryInstance
ms
    let globalLen :: Int
globalLen = Vector GlobalInstance -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector GlobalInstance
gs
    [ExternalValue]
funImps <- (Import -> ExceptT String (StateT Store IO) ExternalValue)
-> [Import] -> ExceptT String (StateT Store IO) [ExternalValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Import -> ExceptT String (StateT Store IO) ExternalValue
checkImportType ([Import] -> ExceptT String (StateT Store IO) [ExternalValue])
-> [Import] -> ExceptT String (StateT Store IO) [ExternalValue]
forall a b. (a -> b) -> a -> b
$ (Import -> Bool) -> [Import] -> [Import]
forall a. (a -> Bool) -> [a] -> [a]
filter Import -> Bool
isFuncImport [Import]
imports
    [ExternalValue]
tableImps <- (Import -> ExceptT String (StateT Store IO) ExternalValue)
-> [Import] -> ExceptT String (StateT Store IO) [ExternalValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Import -> ExceptT String (StateT Store IO) ExternalValue
checkImportType ([Import] -> ExceptT String (StateT Store IO) [ExternalValue])
-> [Import] -> ExceptT String (StateT Store IO) [ExternalValue]
forall a b. (a -> b) -> a -> b
$ (Import -> Bool) -> [Import] -> [Import]
forall a. (a -> Bool) -> [a] -> [a]
filter Import -> Bool
isTableImport [Import]
imports
    [ExternalValue]
memImps <- (Import -> ExceptT String (StateT Store IO) ExternalValue)
-> [Import] -> ExceptT String (StateT Store IO) [ExternalValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Import -> ExceptT String (StateT Store IO) ExternalValue
checkImportType ([Import] -> ExceptT String (StateT Store IO) [ExternalValue])
-> [Import] -> ExceptT String (StateT Store IO) [ExternalValue]
forall a b. (a -> b) -> a -> b
$ (Import -> Bool) -> [Import] -> [Import]
forall a. (a -> Bool) -> [a] -> [a]
filter Import -> Bool
isMemImport [Import]
imports
    [ExternalValue]
globalImps <- (Import -> ExceptT String (StateT Store IO) ExternalValue)
-> [Import] -> ExceptT String (StateT Store IO) [ExternalValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Import -> ExceptT String (StateT Store IO) ExternalValue
checkImportType ([Import] -> ExceptT String (StateT Store IO) [ExternalValue])
-> [Import] -> ExceptT String (StateT Store IO) [ExternalValue]
forall a b. (a -> b) -> a -> b
$ (Import -> Bool) -> [Import] -> [Import]
forall a. (a -> Bool) -> [a] -> [a]
filter Import -> Bool
isGlobalImport [Import]
imports
    let funs :: Vector Int
funs = [Int] -> Vector Int
forall a. [a] -> Vector a
Vector.fromList ([Int] -> Vector Int) -> [Int] -> Vector Int
forall a b. (a -> b) -> a -> b
$ (ExternalValue -> Int) -> [ExternalValue] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExternFunction Int
i) -> Int
i) [ExternalValue]
funImps [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
funLen..Int
funLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Function] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Function]
functions Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    let tbls :: Vector Int
tbls = [Int] -> Vector Int
forall a. [a] -> Vector a
Vector.fromList ([Int] -> Vector Int) -> [Int] -> Vector Int
forall a b. (a -> b) -> a -> b
$ (ExternalValue -> Int) -> [ExternalValue] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExternTable Int
i) -> Int
i) [ExternalValue]
tableImps [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
tableLen..Int
tableLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Table] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Table]
tables Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    let memories :: Vector Int
memories = [Int] -> Vector Int
forall a. [a] -> Vector a
Vector.fromList ([Int] -> Vector Int) -> [Int] -> Vector Int
forall a b. (a -> b) -> a -> b
$ (ExternalValue -> Int) -> [ExternalValue] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExternMemory Int
i) -> Int
i) [ExternalValue]
memImps [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
memLen..Int
memLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Memory] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Memory]
mems Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    let globs :: Vector Int
globs = [Int] -> Vector Int
forall a. [a] -> Vector a
Vector.fromList ([Int] -> Vector Int) -> [Int] -> Vector Int
forall a b. (a -> b) -> a -> b
$ (ExternalValue -> Int) -> [ExternalValue] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExternGlobal Int
i) -> Int
i) [ExternalValue]
globalImps [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
globalLen..Int
globalLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Global] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Global]
globals Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    let
        refExport :: Export -> ExportInstance
refExport (Export Text
name (ExportFunc FuncIndex
idx)) =
            Text -> ExternalValue -> ExportInstance
ExportInstance Text
name (ExternalValue -> ExportInstance)
-> ExternalValue -> ExportInstance
forall a b. (a -> b) -> a -> b
$ Int -> ExternalValue
ExternFunction (Int -> ExternalValue) -> Int -> ExternalValue
forall a b. (a -> b) -> a -> b
$ Vector Int
funs Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
idx
        refExport (Export Text
name (ExportTable FuncIndex
idx)) =
            Text -> ExternalValue -> ExportInstance
ExportInstance Text
name (ExternalValue -> ExportInstance)
-> ExternalValue -> ExportInstance
forall a b. (a -> b) -> a -> b
$ Int -> ExternalValue
ExternTable (Int -> ExternalValue) -> Int -> ExternalValue
forall a b. (a -> b) -> a -> b
$ Vector Int
tbls Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
idx
        refExport (Export Text
name (ExportMemory FuncIndex
idx)) =
            Text -> ExternalValue -> ExportInstance
ExportInstance Text
name (ExternalValue -> ExportInstance)
-> ExternalValue -> ExportInstance
forall a b. (a -> b) -> a -> b
$ Int -> ExternalValue
ExternMemory (Int -> ExternalValue) -> Int -> ExternalValue
forall a b. (a -> b) -> a -> b
$ Vector Int
memories Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
idx
        refExport (Export Text
name (ExportGlobal FuncIndex
idx)) =
            Text -> ExternalValue -> ExportInstance
ExportInstance Text
name (ExternalValue -> ExportInstance)
-> ExternalValue -> ExportInstance
forall a b. (a -> b) -> a -> b
$ Int -> ExternalValue
ExternGlobal (Int -> ExternalValue) -> Int -> ExternalValue
forall a b. (a -> b) -> a -> b
$ Vector Int
globs Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
idx
    ModuleInstance -> Initialize ModuleInstance
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleInstance -> Initialize ModuleInstance)
-> ModuleInstance -> Initialize ModuleInstance
forall a b. (a -> b) -> a -> b
$ ModuleInstance :: Vector FuncType
-> Vector Int
-> Vector Int
-> Vector Int
-> Vector Int
-> Vector ExportInstance
-> ModuleInstance
ModuleInstance {
        $sel:funcTypes:ModuleInstance :: Vector FuncType
funcTypes = [FuncType] -> Vector FuncType
forall a. [a] -> Vector a
Vector.fromList [FuncType]
types,
        $sel:funcaddrs:ModuleInstance :: Vector Int
funcaddrs = Vector Int
funs,
        $sel:tableaddrs:ModuleInstance :: Vector Int
tableaddrs = Vector Int
tbls,
        $sel:memaddrs:ModuleInstance :: Vector Int
memaddrs = Vector Int
memories,
        $sel:globaladdrs:ModuleInstance :: Vector Int
globaladdrs = Vector Int
globs,
        $sel:exports:ModuleInstance :: Vector ExportInstance
exports = [ExportInstance] -> Vector ExportInstance
forall a. [a] -> Vector a
Vector.fromList ([ExportInstance] -> Vector ExportInstance)
-> [ExportInstance] -> Vector ExportInstance
forall a b. (a -> b) -> a -> b
$ (Export -> ExportInstance) -> [Export] -> [ExportInstance]
forall a b. (a -> b) -> [a] -> [b]
map Export -> ExportInstance
refExport [Export]
exports
    }
    where
        getImpIdx :: Import -> Initialize ExternalValue
        getImpIdx :: Import -> ExceptT String (StateT Store IO) ExternalValue
getImpIdx (Import Text
m Text
n ImportDesc
_) =
            case (Text, Text) -> Imports -> Maybe ExternalValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text
m, Text
n) Imports
imps of
                Just ExternalValue
idx -> ExternalValue -> ExceptT String (StateT Store IO) ExternalValue
forall (m :: * -> *) a. Monad m => a -> m a
return ExternalValue
idx
                Maybe ExternalValue
Nothing -> String -> ExceptT String (StateT Store IO) ExternalValue
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String (StateT Store IO) ExternalValue)
-> String -> ExceptT String (StateT Store IO) ExternalValue
forall a b. (a -> b) -> a -> b
$ String
"Cannot find import from module " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
n

        checkImportType :: Import -> Initialize ExternalValue
        checkImportType :: Import -> ExceptT String (StateT Store IO) ExternalValue
checkImportType imp :: Import
imp@(Import Text
_ Text
_ (ImportFunc FuncIndex
typeIdx)) = do
            ExternalValue
idx <- Import -> ExceptT String (StateT Store IO) ExternalValue
getImpIdx Import
imp
            Int
funcAddr <- case ExternalValue
idx of
                ExternFunction Int
funcAddr -> Int -> ExceptT String (StateT Store IO) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
funcAddr
                ExternalValue
other -> String -> ExceptT String (StateT Store IO) Int
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"incompatible import type"
            let expectedType :: FuncType
expectedType = [FuncType]
types [FuncType] -> Int -> FuncType
forall a. [a] -> Int -> a
!! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
typeIdx
            let actualType :: FuncType
actualType = FunctionInstance -> FuncType
Language.Wasm.Interpreter.funcType (FunctionInstance -> FuncType) -> FunctionInstance -> FuncType
forall a b. (a -> b) -> a -> b
$ Vector FunctionInstance
fs Vector FunctionInstance -> Int -> FunctionInstance
forall a. Vector a -> Int -> a
! Int
funcAddr
            if FuncType
expectedType FuncType -> FuncType -> Bool
forall a. Eq a => a -> a -> Bool
== FuncType
actualType
            then ExternalValue -> ExceptT String (StateT Store IO) ExternalValue
forall (m :: * -> *) a. Monad m => a -> m a
return ExternalValue
idx
            else String -> ExceptT String (StateT Store IO) ExternalValue
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"incompatible import type"
        checkImportType imp :: Import
imp@(Import Text
_ Text
_ (ImportGlobal GlobalType
globalType)) = do
            let err :: ExceptT String (StateT Store IO) a
err = String -> ExceptT String (StateT Store IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"incompatible import type"
            ExternalValue
idx <- Import -> ExceptT String (StateT Store IO) ExternalValue
getImpIdx Import
imp
            Int
globalAddr <- case ExternalValue
idx of
                ExternGlobal Int
globalAddr -> Int -> ExceptT String (StateT Store IO) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
globalAddr
                ExternalValue
_ -> ExceptT String (StateT Store IO) Int
forall a. ExceptT String (StateT Store IO) a
err
            let globalInst :: GlobalInstance
globalInst = Vector GlobalInstance
gs Vector GlobalInstance -> Int -> GlobalInstance
forall a. Vector a -> Int -> a
! Int
globalAddr
            let typesMatch :: Bool
typesMatch = case (GlobalType
globalType, GlobalInstance
globalInst) of
                    (Const ValueType
vt, GIConst ValueType
vt' Value
_) -> ValueType
vt ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
vt'
                    (Mut ValueType
vt, GIMut ValueType
vt' IORef Value
_) -> ValueType
vt ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
vt'
                    (GlobalType, GlobalInstance)
_ -> Bool
False
            if Bool
typesMatch then ExternalValue -> ExceptT String (StateT Store IO) ExternalValue
forall (m :: * -> *) a. Monad m => a -> m a
return ExternalValue
idx else ExceptT String (StateT Store IO) ExternalValue
forall a. ExceptT String (StateT Store IO) a
err
        checkImportType imp :: Import
imp@(Import Text
_ Text
_ (ImportMemory Limit
limit)) = do
            ExternalValue
idx <- Import -> ExceptT String (StateT Store IO) ExternalValue
getImpIdx Import
imp
            Int
memAddr <- case ExternalValue
idx of
                ExternMemory Int
memAddr -> Int -> ExceptT String (StateT Store IO) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
memAddr
                ExternalValue
_ -> String -> ExceptT String (StateT Store IO) Int
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"incompatible import type"
            let MemoryInstance { Limit
lim :: Limit
$sel:lim:MemoryInstance :: MemoryInstance -> Limit
lim } = Vector MemoryInstance
ms Vector MemoryInstance -> Int -> MemoryInstance
forall a. Vector a -> Int -> a
! Int
memAddr
            if Limit -> Limit -> Bool
limitMatch Limit
lim Limit
limit
            then ExternalValue -> ExceptT String (StateT Store IO) ExternalValue
forall (m :: * -> *) a. Monad m => a -> m a
return ExternalValue
idx
            else String -> ExceptT String (StateT Store IO) ExternalValue
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"incompatible import type"
        checkImportType imp :: Import
imp@(Import Text
_ Text
_ (ImportTable (TableType Limit
limit ElemType
_))) = do
            ExternalValue
idx <- Import -> ExceptT String (StateT Store IO) ExternalValue
getImpIdx Import
imp
            Int
tableAddr <- case ExternalValue
idx of
                ExternTable Int
tableAddr -> Int -> ExceptT String (StateT Store IO) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
tableAddr
                ExternalValue
_ -> String -> ExceptT String (StateT Store IO) Int
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"incompatible import type"
            let TableInstance { Limit
lim :: Limit
$sel:lim:TableInstance :: TableInstance -> Limit
lim } = Vector TableInstance
ts Vector TableInstance -> Int -> TableInstance
forall a. Vector a -> Int -> a
! Int
tableAddr
            if Limit -> Limit -> Bool
limitMatch Limit
lim Limit
limit
            then ExternalValue -> ExceptT String (StateT Store IO) ExternalValue
forall (m :: * -> *) a. Monad m => a -> m a
return ExternalValue
idx
            else String -> ExceptT String (StateT Store IO) ExternalValue
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"incompatible import type"
    
        limitMatch :: Limit -> Limit -> Bool
        limitMatch :: Limit -> Limit -> Bool
limitMatch (Limit FuncIndex
n1 Maybe FuncIndex
m1) (Limit FuncIndex
n2 Maybe FuncIndex
m2) = FuncIndex
n1 FuncIndex -> FuncIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= FuncIndex
n2 Bool -> Bool -> Bool
&& (Maybe FuncIndex -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FuncIndex
m2 Bool -> Bool -> Bool
|| Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (FuncIndex -> FuncIndex -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (FuncIndex -> FuncIndex -> Bool)
-> Maybe FuncIndex -> Maybe (FuncIndex -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FuncIndex
m1 Maybe (FuncIndex -> Bool) -> Maybe FuncIndex -> Maybe Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe FuncIndex
m2))

type Imports = Map.Map (TL.Text, TL.Text) ExternalValue

emptyImports :: Imports
emptyImports :: Imports
emptyImports = Imports
forall k a. Map k a
Map.empty

allocFunctions :: ModuleInstance -> [Function] -> Vector FunctionInstance
allocFunctions :: ModuleInstance -> [Function] -> Vector FunctionInstance
allocFunctions inst :: ModuleInstance
inst@ModuleInstance {Vector FuncType
funcTypes :: Vector FuncType
$sel:funcTypes:ModuleInstance :: ModuleInstance -> Vector FuncType
funcTypes} [Function]
funs =
    let mkFuncInst :: Function -> FunctionInstance
mkFuncInst f :: Function
f@Function {FuncIndex
$sel:funcType:Function :: Function -> FuncIndex
funcType :: FuncIndex
funcType} = FuncType -> ModuleInstance -> Function -> FunctionInstance
FunctionInstance (Vector FuncType
funcTypes Vector FuncType -> Int -> FuncType
forall a. Vector a -> Int -> a
! (FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
funcType)) ModuleInstance
inst Function
f in
    [FunctionInstance] -> Vector FunctionInstance
forall a. [a] -> Vector a
Vector.fromList ([FunctionInstance] -> Vector FunctionInstance)
-> [FunctionInstance] -> Vector FunctionInstance
forall a b. (a -> b) -> a -> b
$ (Function -> FunctionInstance) -> [Function] -> [FunctionInstance]
forall a b. (a -> b) -> [a] -> [b]
map Function -> FunctionInstance
mkFuncInst [Function]
funs

getGlobalValue :: ModuleInstance -> Store -> Natural -> IO Value
getGlobalValue :: ModuleInstance -> Store -> FuncIndex -> IO Value
getGlobalValue ModuleInstance
inst Store
store FuncIndex
idx =
    let addr :: Int
addr = case ModuleInstance -> Vector Int
globaladdrs ModuleInstance
inst Vector Int -> Int -> Maybe Int
forall a. Vector a -> Int -> Maybe a
!? FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
idx of
            Just Int
a -> Int
a
            Maybe Int
Nothing -> String -> Int
forall a. HasCallStack => String -> a
error String
"Global index is out of range. It can happen if initializer refs non-import global."
    in
    case Store -> Vector GlobalInstance
globalInstances Store
store Vector GlobalInstance -> Int -> GlobalInstance
forall a. Vector a -> Int -> a
! Int
addr of
        GIConst ValueType
_ Value
v -> Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
        GIMut ValueType
_ IORef Value
ref -> IORef Value -> IO Value
forall a. IORef a -> IO a
readIORef IORef Value
ref

-- due the validation there can be only these instructions
evalConstExpr :: ModuleInstance -> Store -> Expression -> IO Value
evalConstExpr :: ModuleInstance -> Store -> Expression -> IO Value
evalConstExpr ModuleInstance
_ Store
_ [I32Const Word32
v] = Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ Word32 -> Value
VI32 Word32
v
evalConstExpr ModuleInstance
_ Store
_ [I64Const Word64
v] = Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ Word64 -> Value
VI64 Word64
v
evalConstExpr ModuleInstance
_ Store
_ [F32Const Float
v] = Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ Float -> Value
VF32 Float
v
evalConstExpr ModuleInstance
_ Store
_ [F64Const Double
v] = Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF64 Double
v
evalConstExpr ModuleInstance
inst Store
store [GetGlobal FuncIndex
i] = ModuleInstance -> Store -> FuncIndex -> IO Value
getGlobalValue ModuleInstance
inst Store
store FuncIndex
i
evalConstExpr ModuleInstance
_ Store
_ Expression
instrs = String -> IO Value
forall a. HasCallStack => String -> a
error (String -> IO Value) -> String -> IO Value
forall a b. (a -> b) -> a -> b
$ String
"Global initializer contains unsupported instructions: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expression -> String
forall a. Show a => a -> String
show Expression
instrs

allocAndInitGlobals :: ModuleInstance -> Store -> [Global] -> IO (Vector GlobalInstance)
allocAndInitGlobals :: ModuleInstance -> Store -> [Global] -> IO (Vector GlobalInstance)
allocAndInitGlobals ModuleInstance
inst Store
store [Global]
globs = [GlobalInstance] -> Vector GlobalInstance
forall a. [a] -> Vector a
Vector.fromList ([GlobalInstance] -> Vector GlobalInstance)
-> IO [GlobalInstance] -> IO (Vector GlobalInstance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Global -> IO GlobalInstance) -> [Global] -> IO [GlobalInstance]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Global -> IO GlobalInstance
allocGlob [Global]
globs
    where
        runIniter :: Expression -> IO Value
        -- the spec says get global can ref only imported globals
        -- only they are in store for this moment
        runIniter :: Expression -> IO Value
runIniter = ModuleInstance -> Store -> Expression -> IO Value
evalConstExpr ModuleInstance
inst Store
store

        allocGlob :: Global -> IO GlobalInstance
        allocGlob :: Global -> IO GlobalInstance
allocGlob (Global (Const ValueType
vt) Expression
initer) = ValueType -> Value -> GlobalInstance
GIConst ValueType
vt (Value -> GlobalInstance) -> IO Value -> IO GlobalInstance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> IO Value
runIniter Expression
initer
        allocGlob (Global (Mut ValueType
vt) Expression
initer) = do
            Value
val <- Expression -> IO Value
runIniter Expression
initer
            ValueType -> IORef Value -> GlobalInstance
GIMut ValueType
vt (IORef Value -> GlobalInstance)
-> IO (IORef Value) -> IO GlobalInstance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> IO (IORef Value)
forall a. a -> IO (IORef a)
newIORef Value
val

allocTables :: [Table] -> Vector TableInstance
allocTables :: [Table] -> Vector TableInstance
allocTables [Table]
tables = [TableInstance] -> Vector TableInstance
forall a. [a] -> Vector a
Vector.fromList ([TableInstance] -> Vector TableInstance)
-> [TableInstance] -> Vector TableInstance
forall a b. (a -> b) -> a -> b
$ (Table -> TableInstance) -> [Table] -> [TableInstance]
forall a b. (a -> b) -> [a] -> [b]
map Table -> TableInstance
allocTable [Table]
tables
    where
        allocTable :: Table -> TableInstance
        allocTable :: Table -> TableInstance
allocTable (Table (TableType lim :: Limit
lim@(Limit FuncIndex
from Maybe FuncIndex
to) ElemType
_)) =
            TableInstance :: Limit -> Vector (Maybe Int) -> TableInstance
TableInstance {
                Limit
lim :: Limit
$sel:lim:TableInstance :: Limit
lim,
                $sel:elements:TableInstance :: Vector (Maybe Int)
elements = [Maybe Int] -> Vector (Maybe Int)
forall a. [a] -> Vector a
Vector.fromList ([Maybe Int] -> Vector (Maybe Int))
-> [Maybe Int] -> Vector (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> [Maybe Int]
forall a. Int -> a -> [a]
replicate (FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
from) Maybe Int
forall a. Maybe a
Nothing
            }

defaultBudget :: Natural
defaultBudget :: FuncIndex
defaultBudget = FuncIndex
300

pageSize :: Int
pageSize :: Int
pageSize = Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

allocMems :: [Memory] -> IO (Vector MemoryInstance)
allocMems :: [Memory] -> IO (Vector MemoryInstance)
allocMems [Memory]
mems = [MemoryInstance] -> Vector MemoryInstance
forall a. [a] -> Vector a
Vector.fromList ([MemoryInstance] -> Vector MemoryInstance)
-> IO [MemoryInstance] -> IO (Vector MemoryInstance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Memory -> IO MemoryInstance) -> [Memory] -> IO [MemoryInstance]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Memory -> IO MemoryInstance
allocMem [Memory]
mems
    where
        allocMem :: Memory -> IO MemoryInstance
        allocMem :: Memory -> IO MemoryInstance
allocMem (Memory lim :: Limit
lim@(Limit FuncIndex
from Maybe FuncIndex
to)) = do
            let size :: Int
size = FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
from Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pageSize
            MutableByteArray RealWorld
mem <- Int -> IO MemoryStore
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
ByteArray.newByteArray Int
size
            MemoryStore -> Int -> Int -> Word64 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
ByteArray.setByteArray @Word64 MutableByteArray RealWorld
MemoryStore
mem Int
0 (Int
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) Word64
0
            IORef (MutableByteArray RealWorld)
memory <- MutableByteArray RealWorld
-> IO (IORef (MutableByteArray RealWorld))
forall a. a -> IO (IORef a)
newIORef MutableByteArray RealWorld
mem
            MemoryInstance -> IO MemoryInstance
forall (m :: * -> *) a. Monad m => a -> m a
return MemoryInstance :: Limit -> IORef MemoryStore -> MemoryInstance
MemoryInstance {
                Limit
lim :: Limit
$sel:lim:MemoryInstance :: Limit
lim,
                IORef (MutableByteArray RealWorld)
IORef MemoryStore
memory :: IORef (MutableByteArray RealWorld)
$sel:memory:MemoryInstance :: IORef MemoryStore
memory
            }

type Initialize = ExceptT String (State.StateT Store IO)

initialize :: ModuleInstance -> Module -> Initialize ()
initialize :: ModuleInstance -> Module -> Initialize ()
initialize ModuleInstance
inst Module {[ElemSegment]
$sel:elems:Module :: Module -> [ElemSegment]
elems :: [ElemSegment]
elems, [DataSegment]
$sel:datas:Module :: Module -> [DataSegment]
datas :: [DataSegment]
datas, Maybe StartFunction
$sel:start:Module :: Module -> Maybe StartFunction
start :: Maybe StartFunction
start} = do
    [(Int, MutableByteArray RealWorld, ByteString)]
checkedMems <- (DataSegment
 -> ExceptT
      String
      (StateT Store IO)
      (Int, MutableByteArray RealWorld, ByteString))
-> [DataSegment]
-> ExceptT
     String
     (StateT Store IO)
     [(Int, MutableByteArray RealWorld, ByteString)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM DataSegment
-> ExceptT
     String
     (StateT Store IO)
     (Int, MutableByteArray RealWorld, ByteString)
DataSegment -> Initialize (Int, MemoryStore, ByteString)
checkData [DataSegment]
datas
    [(Int, Int, [Int])]
checkedTables <- (ElemSegment -> ExceptT String (StateT Store IO) (Int, Int, [Int]))
-> [ElemSegment]
-> ExceptT String (StateT Store IO) [(Int, Int, [Int])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ElemSegment -> ExceptT String (StateT Store IO) (Int, Int, [Int])
checkElem [ElemSegment]
elems
    ((Int, MutableByteArray RealWorld, ByteString) -> Initialize ())
-> [(Int, MutableByteArray RealWorld, ByteString)] -> Initialize ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, MutableByteArray RealWorld, ByteString) -> Initialize ()
(Int, MemoryStore, ByteString) -> Initialize ()
initData [(Int, MutableByteArray RealWorld, ByteString)]
checkedMems
    ((Int, Int, [Int]) -> Initialize ())
-> [(Int, Int, [Int])] -> Initialize ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, Int, [Int]) -> Initialize ()
initElem [(Int, Int, [Int])]
checkedTables
    Store
st <- ExceptT String (StateT Store IO) Store
forall s (m :: * -> *). MonadState s m => m s
State.get
    case Maybe StartFunction
start of
        Just (StartFunction FuncIndex
idx) -> do
            let funInst :: FunctionInstance
funInst = Store -> Vector FunctionInstance
funcInstances Store
st Vector FunctionInstance -> Int -> FunctionInstance
forall a. Vector a -> Int -> a
! (ModuleInstance -> Vector Int
funcaddrs ModuleInstance
inst Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
idx)
            Maybe [Value]
mainRes <- IO (Maybe [Value])
-> ExceptT String (StateT Store IO) (Maybe [Value])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Value])
 -> ExceptT String (StateT Store IO) (Maybe [Value]))
-> IO (Maybe [Value])
-> ExceptT String (StateT Store IO) (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ FuncIndex
-> Store -> FunctionInstance -> [Value] -> IO (Maybe [Value])
eval FuncIndex
defaultBudget Store
st FunctionInstance
funInst []
            case Maybe [Value]
mainRes of
                Just [] -> () -> Initialize ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Maybe [Value]
_ -> String -> Initialize ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Start function terminated with trap"
        Maybe StartFunction
Nothing -> () -> Initialize ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
        checkElem :: ElemSegment -> Initialize (Address, Int, [Address])
        checkElem :: ElemSegment -> ExceptT String (StateT Store IO) (Int, Int, [Int])
checkElem ElemSegment {FuncIndex
$sel:tableIndex:ElemSegment :: ElemSegment -> FuncIndex
tableIndex :: FuncIndex
tableIndex, Expression
$sel:offset:ElemSegment :: ElemSegment -> Expression
offset :: Expression
offset, [FuncIndex]
$sel:funcIndexes:ElemSegment :: ElemSegment -> [FuncIndex]
funcIndexes :: [FuncIndex]
funcIndexes} = do
            Store
st <- ExceptT String (StateT Store IO) Store
forall s (m :: * -> *). MonadState s m => m s
State.get
            VI32 Word32
val <- IO Value -> ExceptT String (StateT Store IO) Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> ExceptT String (StateT Store IO) Value)
-> IO Value -> ExceptT String (StateT Store IO) Value
forall a b. (a -> b) -> a -> b
$ ModuleInstance -> Store -> Expression -> IO Value
evalConstExpr ModuleInstance
inst Store
st Expression
offset
            let from :: Int
from = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
val
            let funcs :: [Int]
funcs = (FuncIndex -> Int) -> [FuncIndex] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((ModuleInstance -> Vector Int
funcaddrs ModuleInstance
inst Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
!) (Int -> Int) -> (FuncIndex -> Int) -> FuncIndex -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [FuncIndex]
funcIndexes
            let idx :: Int
idx = ModuleInstance -> Vector Int
tableaddrs ModuleInstance
inst Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
tableIndex
            let last :: Int
last = Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
funcs
            let TableInstance Limit
lim Vector (Maybe Int)
elems = Store -> Vector TableInstance
tableInstances Store
st Vector TableInstance -> Int -> TableInstance
forall a. Vector a -> Int -> a
! Int
idx
            let len :: Int
len = Vector (Maybe Int) -> Int
forall a. Vector a -> Int
Vector.length Vector (Maybe Int)
elems
            Bool -> Initialize () -> Initialize ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Int
last Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len) (Initialize () -> Initialize ()) -> Initialize () -> Initialize ()
forall a b. (a -> b) -> a -> b
$ String -> Initialize ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"elements segment does not fit"
            (Int, Int, [Int])
-> ExceptT String (StateT Store IO) (Int, Int, [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
idx, Int
from, [Int]
funcs)

        initElem :: (Address, Int, [Address]) -> Initialize ()
        initElem :: (Int, Int, [Int]) -> Initialize ()
initElem (Int
idx, Int
from, [Int]
funcs) = (Store -> Store) -> Initialize ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((Store -> Store) -> Initialize ())
-> (Store -> Store) -> Initialize ()
forall a b. (a -> b) -> a -> b
$ \Store
st ->
            let TableInstance Limit
lim Vector (Maybe Int)
elems = Store -> Vector TableInstance
tableInstances Store
st Vector TableInstance -> Int -> TableInstance
forall a. Vector a -> Int -> a
! Int
idx in
            let table :: TableInstance
table = Limit -> Vector (Maybe Int) -> TableInstance
TableInstance Limit
lim (Vector (Maybe Int)
elems Vector (Maybe Int) -> [(Int, Maybe Int)] -> Vector (Maybe Int)
forall a. Vector a -> [(Int, a)] -> Vector a
// [Int] -> [Maybe Int] -> [(Int, Maybe Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
from..] ((Int -> Maybe Int) -> [Int] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Maybe Int
forall a. a -> Maybe a
Just [Int]
funcs)) in
            Store
st { $sel:tableInstances:Store :: Vector TableInstance
tableInstances = Store -> Vector TableInstance
tableInstances Store
st Vector TableInstance
-> [(Int, TableInstance)] -> Vector TableInstance
forall a. Vector a -> [(Int, a)] -> Vector a
Vector.// [(Int
idx, TableInstance
table)] }

        checkData :: DataSegment -> Initialize (Int, MemoryStore, LBS.ByteString)
        checkData :: DataSegment -> Initialize (Int, MemoryStore, ByteString)
checkData DataSegment {FuncIndex
$sel:memIndex:DataSegment :: DataSegment -> FuncIndex
memIndex :: FuncIndex
memIndex, Expression
$sel:offset:DataSegment :: DataSegment -> Expression
offset :: Expression
offset, ByteString
$sel:chunk:DataSegment :: DataSegment -> ByteString
chunk :: ByteString
chunk} = do
            Store
st <- ExceptT String (StateT Store IO) Store
forall s (m :: * -> *). MonadState s m => m s
State.get
            VI32 Word32
val <- IO Value -> ExceptT String (StateT Store IO) Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> ExceptT String (StateT Store IO) Value)
-> IO Value -> ExceptT String (StateT Store IO) Value
forall a b. (a -> b) -> a -> b
$ ModuleInstance -> Store -> Expression -> IO Value
evalConstExpr ModuleInstance
inst Store
st Expression
offset
            let from :: Int
from = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
val
            let idx :: Int
idx = ModuleInstance -> Vector Int
memaddrs ModuleInstance
inst Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
memIndex
            let last :: Int
last = Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LBS.length ByteString
chunk)
            let MemoryInstance Limit
_ IORef MemoryStore
memory = Store -> Vector MemoryInstance
memInstances Store
st Vector MemoryInstance -> Int -> MemoryInstance
forall a. Vector a -> Int -> a
! Int
idx
            MutableByteArray RealWorld
mem <- IO (MutableByteArray RealWorld)
-> ExceptT String (StateT Store IO) (MutableByteArray RealWorld)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutableByteArray RealWorld)
 -> ExceptT String (StateT Store IO) (MutableByteArray RealWorld))
-> IO (MutableByteArray RealWorld)
-> ExceptT String (StateT Store IO) (MutableByteArray RealWorld)
forall a b. (a -> b) -> a -> b
$ IORef (MutableByteArray RealWorld)
-> IO (MutableByteArray RealWorld)
forall a. IORef a -> IO a
readIORef IORef (MutableByteArray RealWorld)
IORef MemoryStore
memory
            Int
len <- MutableByteArray (PrimState (ExceptT String (StateT Store IO)))
-> ExceptT String (StateT Store IO) Int
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m Int
ByteArray.getSizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState (ExceptT String (StateT Store IO)))
mem
            Bool -> Initialize () -> Initialize ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Int
last Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len) (Initialize () -> Initialize ()) -> Initialize () -> Initialize ()
forall a b. (a -> b) -> a -> b
$ String -> Initialize ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"data segment does not fit"
            (Int, MutableByteArray RealWorld, ByteString)
-> ExceptT
     String
     (StateT Store IO)
     (Int, MutableByteArray RealWorld, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
from, MutableByteArray RealWorld
mem, ByteString
chunk)
        
        initData :: (Int, MemoryStore, LBS.ByteString) -> Initialize ()
        initData :: (Int, MemoryStore, ByteString) -> Initialize ()
initData (Int
from, MemoryStore
mem, ByteString
chunk) =
            ((Int, Word8) -> Initialize ()) -> [(Int, Word8)] -> Initialize ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
i,Word8
b) -> MutableByteArray (PrimState (ExceptT String (StateT Store IO)))
-> Int -> Word8 -> Initialize ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
ByteArray.writeByteArray MemoryStore
MutableByteArray (PrimState (ExceptT String (StateT Store IO)))
mem Int
i Word8
b) ([(Int, Word8)] -> Initialize ())
-> [(Int, Word8)] -> Initialize ()
forall a b. (a -> b) -> a -> b
$ [Int] -> [Word8] -> [(Int, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
from..] ([Word8] -> [(Int, Word8)]) -> [Word8] -> [(Int, Word8)]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
LBS.unpack ByteString
chunk

instantiate :: Store -> Imports -> Valid.ValidModule -> IO (Either String ModuleInstance, Store)
instantiate :: Store
-> Imports
-> ValidModule
-> IO (Either String ModuleInstance, Store)
instantiate Store
st Imports
imps ValidModule
mod = (StateT Store IO (Either String ModuleInstance)
 -> Store -> IO (Either String ModuleInstance, Store))
-> Store
-> StateT Store IO (Either String ModuleInstance)
-> IO (Either String ModuleInstance, Store)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Store IO (Either String ModuleInstance)
-> Store -> IO (Either String ModuleInstance, Store)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.runStateT Store
st (StateT Store IO (Either String ModuleInstance)
 -> IO (Either String ModuleInstance, Store))
-> StateT Store IO (Either String ModuleInstance)
-> IO (Either String ModuleInstance, Store)
forall a b. (a -> b) -> a -> b
$ Initialize ModuleInstance
-> StateT Store IO (Either String ModuleInstance)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Initialize ModuleInstance
 -> StateT Store IO (Either String ModuleInstance))
-> Initialize ModuleInstance
-> StateT Store IO (Either String ModuleInstance)
forall a b. (a -> b) -> a -> b
$ do
    let m :: Module
m = ValidModule -> Module
Valid.getModule ValidModule
mod
    ModuleInstance
inst <- Store -> Imports -> Module -> Initialize ModuleInstance
calcInstance Store
st Imports
imps Module
m
    let functions :: Vector FunctionInstance
functions = Store -> Vector FunctionInstance
funcInstances Store
st Vector FunctionInstance
-> Vector FunctionInstance -> Vector FunctionInstance
forall a. Semigroup a => a -> a -> a
<> (ModuleInstance -> [Function] -> Vector FunctionInstance
allocFunctions ModuleInstance
inst ([Function] -> Vector FunctionInstance)
-> [Function] -> Vector FunctionInstance
forall a b. (a -> b) -> a -> b
$ Module -> [Function]
Struct.functions Module
m)
    Vector GlobalInstance
globals <- IO (Vector GlobalInstance)
-> ExceptT String (StateT Store IO) (Vector GlobalInstance)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Vector GlobalInstance)
 -> ExceptT String (StateT Store IO) (Vector GlobalInstance))
-> IO (Vector GlobalInstance)
-> ExceptT String (StateT Store IO) (Vector GlobalInstance)
forall a b. (a -> b) -> a -> b
$ (Store -> Vector GlobalInstance
globalInstances Store
st Vector GlobalInstance
-> Vector GlobalInstance -> Vector GlobalInstance
forall a. Semigroup a => a -> a -> a
<>) (Vector GlobalInstance -> Vector GlobalInstance)
-> IO (Vector GlobalInstance) -> IO (Vector GlobalInstance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModuleInstance -> Store -> [Global] -> IO (Vector GlobalInstance)
allocAndInitGlobals ModuleInstance
inst Store
st ([Global] -> IO (Vector GlobalInstance))
-> [Global] -> IO (Vector GlobalInstance)
forall a b. (a -> b) -> a -> b
$ Module -> [Global]
Struct.globals Module
m)
    let tables :: Vector TableInstance
tables = Store -> Vector TableInstance
tableInstances Store
st Vector TableInstance
-> Vector TableInstance -> Vector TableInstance
forall a. Semigroup a => a -> a -> a
<> ([Table] -> Vector TableInstance
allocTables ([Table] -> Vector TableInstance)
-> [Table] -> Vector TableInstance
forall a b. (a -> b) -> a -> b
$ Module -> [Table]
Struct.tables Module
m)
    Vector MemoryInstance
mems <- IO (Vector MemoryInstance)
-> ExceptT String (StateT Store IO) (Vector MemoryInstance)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Vector MemoryInstance)
 -> ExceptT String (StateT Store IO) (Vector MemoryInstance))
-> IO (Vector MemoryInstance)
-> ExceptT String (StateT Store IO) (Vector MemoryInstance)
forall a b. (a -> b) -> a -> b
$ (Store -> Vector MemoryInstance
memInstances Store
st Vector MemoryInstance
-> Vector MemoryInstance -> Vector MemoryInstance
forall a. Semigroup a => a -> a -> a
<>) (Vector MemoryInstance -> Vector MemoryInstance)
-> IO (Vector MemoryInstance) -> IO (Vector MemoryInstance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Memory] -> IO (Vector MemoryInstance)
allocMems ([Memory] -> IO (Vector MemoryInstance))
-> [Memory] -> IO (Vector MemoryInstance)
forall a b. (a -> b) -> a -> b
$ Module -> [Memory]
Struct.mems Module
m)
    Store -> Initialize ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put (Store -> Initialize ()) -> Store -> Initialize ()
forall a b. (a -> b) -> a -> b
$ Store
st {
        $sel:funcInstances:Store :: Vector FunctionInstance
funcInstances = Vector FunctionInstance
functions,
        $sel:tableInstances:Store :: Vector TableInstance
tableInstances = Vector TableInstance
tables,
        $sel:memInstances:Store :: Vector MemoryInstance
memInstances = Vector MemoryInstance
mems,
        $sel:globalInstances:Store :: Vector GlobalInstance
globalInstances = Vector GlobalInstance
globals
    }
    ModuleInstance -> Module -> Initialize ()
initialize ModuleInstance
inst Module
m
    ModuleInstance -> Initialize ModuleInstance
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleInstance
inst

type Stack = [Value]

data EvalCtx = EvalCtx {
    EvalCtx -> Vector Value
locals :: Vector Value,
    EvalCtx -> [Label]
labels :: [Label],
    EvalCtx -> [Value]
stack :: Stack
} deriving (Int -> EvalCtx -> ShowS
[EvalCtx] -> ShowS
EvalCtx -> String
(Int -> EvalCtx -> ShowS)
-> (EvalCtx -> String) -> ([EvalCtx] -> ShowS) -> Show EvalCtx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalCtx] -> ShowS
$cshowList :: [EvalCtx] -> ShowS
show :: EvalCtx -> String
$cshow :: EvalCtx -> String
showsPrec :: Int -> EvalCtx -> ShowS
$cshowsPrec :: Int -> EvalCtx -> ShowS
Show, EvalCtx -> EvalCtx -> Bool
(EvalCtx -> EvalCtx -> Bool)
-> (EvalCtx -> EvalCtx -> Bool) -> Eq EvalCtx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvalCtx -> EvalCtx -> Bool
$c/= :: EvalCtx -> EvalCtx -> Bool
== :: EvalCtx -> EvalCtx -> Bool
$c== :: EvalCtx -> EvalCtx -> Bool
Eq)

data EvalResult =
    Done EvalCtx
    | Break Int [Value] EvalCtx
    | Trap
    | ReturnFn [Value]
    deriving (Int -> EvalResult -> ShowS
[EvalResult] -> ShowS
EvalResult -> String
(Int -> EvalResult -> ShowS)
-> (EvalResult -> String)
-> ([EvalResult] -> ShowS)
-> Show EvalResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalResult] -> ShowS
$cshowList :: [EvalResult] -> ShowS
show :: EvalResult -> String
$cshow :: EvalResult -> String
showsPrec :: Int -> EvalResult -> ShowS
$cshowsPrec :: Int -> EvalResult -> ShowS
Show, EvalResult -> EvalResult -> Bool
(EvalResult -> EvalResult -> Bool)
-> (EvalResult -> EvalResult -> Bool) -> Eq EvalResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvalResult -> EvalResult -> Bool
$c/= :: EvalResult -> EvalResult -> Bool
== :: EvalResult -> EvalResult -> Bool
$c== :: EvalResult -> EvalResult -> Bool
Eq)

eval :: Natural -> Store -> FunctionInstance -> [Value] -> IO (Maybe [Value])
eval :: FuncIndex
-> Store -> FunctionInstance -> [Value] -> IO (Maybe [Value])
eval FuncIndex
0 Store
_ FunctionInstance
_ [Value]
_ = Maybe [Value] -> IO (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Value]
forall a. Maybe a
Nothing
eval FuncIndex
budget Store
store FunctionInstance { FuncType
funcType :: FuncType
$sel:funcType:FunctionInstance :: FunctionInstance -> FuncType
funcType, ModuleInstance
moduleInstance :: ModuleInstance
$sel:moduleInstance:FunctionInstance :: FunctionInstance -> ModuleInstance
moduleInstance, $sel:code:FunctionInstance :: FunctionInstance -> Function
code = Function { LocalsType
$sel:localTypes:Function :: Function -> LocalsType
localTypes :: LocalsType
localTypes, Expression
$sel:body:Function :: Function -> Expression
body :: Expression
body} } [Value]
args = do
    case [Maybe Value] -> Maybe [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe Value] -> Maybe [Value]) -> [Maybe Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ (ValueType -> Value -> Maybe Value)
-> LocalsType -> [Value] -> [Maybe Value]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ValueType -> Value -> Maybe Value
checkValType (FuncType -> LocalsType
params FuncType
funcType) [Value]
args of
        Just [Value]
checkedArgs -> do
            let initialContext :: EvalCtx
initialContext = EvalCtx :: Vector Value -> [Label] -> [Value] -> EvalCtx
EvalCtx {
                    $sel:locals:EvalCtx :: Vector Value
locals = [Value] -> Vector Value
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Vector Value) -> [Value] -> Vector Value
forall a b. (a -> b) -> a -> b
$ [Value]
checkedArgs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ (ValueType -> Value) -> LocalsType -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ValueType -> Value
initLocal LocalsType
localTypes,
                    $sel:labels:EvalCtx :: [Label]
labels = [LocalsType -> Label
Label (LocalsType -> Label) -> LocalsType -> Label
forall a b. (a -> b) -> a -> b
$ FuncType -> LocalsType
results FuncType
funcType],
                    $sel:stack:EvalCtx :: [Value]
stack = []
                }
            EvalResult
res <- EvalCtx -> Expression -> IO EvalResult
go EvalCtx
initialContext Expression
body
            case EvalResult
res of
                Done EvalCtx
ctx -> Maybe [Value] -> IO (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Value] -> IO (Maybe [Value]))
-> Maybe [Value] -> IO (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just ([Value] -> Maybe [Value]) -> [Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ [Value] -> [Value]
forall a. [a] -> [a]
reverse ([Value] -> [Value]) -> [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ EvalCtx -> [Value]
stack EvalCtx
ctx
                ReturnFn [Value]
r -> Maybe [Value] -> IO (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Value] -> IO (Maybe [Value]))
-> Maybe [Value] -> IO (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value]
r
                Break Int
0 [Value]
r EvalCtx
_ -> Maybe [Value] -> IO (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Value] -> IO (Maybe [Value]))
-> Maybe [Value] -> IO (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just ([Value] -> Maybe [Value]) -> [Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ [Value] -> [Value]
forall a. [a] -> [a]
reverse [Value]
r
                Break Int
_ [Value]
_ EvalCtx
_ -> String -> IO (Maybe [Value])
forall a. HasCallStack => String -> a
error String
"Break is out of range"
                EvalResult
Trap -> Maybe [Value] -> IO (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Value]
forall a. Maybe a
Nothing
        Maybe [Value]
Nothing -> Maybe [Value] -> IO (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Value]
forall a. Maybe a
Nothing
    where
        checkValType :: ValueType -> Value -> Maybe Value
        checkValType :: ValueType -> Value -> Maybe Value
checkValType ValueType
I32 (VI32 Word32
v) = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Word32 -> Value
VI32 Word32
v
        checkValType ValueType
I64 (VI64 Word64
v) = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Word64 -> Value
VI64 Word64
v
        checkValType ValueType
F32 (VF32 Float
v) = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Float -> Value
VF32 Float
v
        checkValType ValueType
F64 (VF64 Double
v) = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF64 Double
v
        checkValType ValueType
_   Value
_        = Maybe Value
forall a. Maybe a
Nothing

        initLocal :: ValueType -> Value
        initLocal :: ValueType -> Value
initLocal ValueType
I32 = Word32 -> Value
VI32 Word32
0
        initLocal ValueType
I64 = Word64 -> Value
VI64 Word64
0
        initLocal ValueType
F32 = Float -> Value
VF32 Float
0
        initLocal ValueType
F64 = Double -> Value
VF64 Double
0

        go :: EvalCtx -> Expression -> IO EvalResult
        go :: EvalCtx -> Expression -> IO EvalResult
go EvalCtx
ctx [] = EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx
        go EvalCtx
ctx (Instruction FuncIndex
instr:Expression
rest) = do
            EvalResult
res <- EvalCtx -> Instruction FuncIndex -> IO EvalResult
step EvalCtx
ctx Instruction FuncIndex
instr
            case EvalResult
res of
                Done EvalCtx
ctx' -> EvalCtx -> Expression -> IO EvalResult
go EvalCtx
ctx' Expression
rest
                EvalResult
command -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
command
        
        makeLoadInstr :: (Primitive.Prim i, Bits i, Integral i) => EvalCtx -> Natural -> Int -> ([Value] -> i -> EvalResult) -> IO EvalResult
        makeLoadInstr :: EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } FuncIndex
offset Int
byteWidth [Value] -> i -> EvalResult
cont = do
            let MemoryInstance { $sel:memory:MemoryInstance :: MemoryInstance -> IORef MemoryStore
memory = IORef MemoryStore
memoryRef } = Store -> Vector MemoryInstance
memInstances Store
store Vector MemoryInstance -> Int -> MemoryInstance
forall a. Vector a -> Int -> a
! (ModuleInstance -> Vector Int
memaddrs ModuleInstance
moduleInstance Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! Int
0)
            MutableByteArray RealWorld
memory <- IORef (MutableByteArray RealWorld)
-> IO (MutableByteArray RealWorld)
forall a. IORef a -> IO a
readIORef IORef (MutableByteArray RealWorld)
IORef MemoryStore
memoryRef
            let addr :: Int
addr = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
offset
            let readByte :: Int -> IO i
readByte Int
idx = do
                    Word8
byte <- MemoryStore -> Int -> IO Word8
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
ByteArray.readByteArray @Word8 MutableByteArray RealWorld
MemoryStore
memory (Int -> IO Word8) -> Int -> IO Word8
forall a b. (a -> b) -> a -> b
$ Int
addr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
idx
                    i -> IO i
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> IO i) -> i -> IO i
forall a b. (a -> b) -> a -> b
$ Word8 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte i -> Int -> i
forall a. Bits a => a -> Int -> a
`shiftL` (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
            Int
len <- MemoryStore -> IO Int
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m Int
ByteArray.getSizeofMutableByteArray MutableByteArray RealWorld
MemoryStore
memory
            let isAligned :: Bool
isAligned = Int
addr Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
byteWidth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            if Int
addr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
byteWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else (
                    if Bool
isAligned
                    then [Value] -> i -> EvalResult
cont [Value]
rest (i -> EvalResult) -> IO i -> IO EvalResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemoryStore -> Int -> IO i
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
ByteArray.readByteArray MutableByteArray RealWorld
MemoryStore
memory (Int
addr Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
byteWidth)
                    else [Value] -> i -> EvalResult
cont [Value]
rest (i -> EvalResult) -> ([i] -> i) -> [i] -> EvalResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [i] -> i
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([i] -> EvalResult) -> IO [i] -> IO EvalResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO i) -> [Int] -> IO [i]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO i
readByte [Int
0..Int
byteWidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
                )
        makeLoadInstr EvalCtx
_ FuncIndex
_ Int
_ [Value] -> i -> EvalResult
_ = String -> IO EvalResult
forall a. HasCallStack => String -> a
error String
"Incorrect value on top of stack for memory instruction"

        makeStoreInstr :: (Primitive.Prim i, Bits i, Integral i) => EvalCtx -> Natural -> Int -> i -> IO EvalResult
        makeStoreInstr :: EvalCtx -> FuncIndex -> Int -> i -> IO EvalResult
makeStoreInstr ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
va:[Value]
rest) } FuncIndex
offset Int
byteWidth i
v = do
            let MemoryInstance { $sel:memory:MemoryInstance :: MemoryInstance -> IORef MemoryStore
memory = IORef MemoryStore
memoryRef } = Store -> Vector MemoryInstance
memInstances Store
store Vector MemoryInstance -> Int -> MemoryInstance
forall a. Vector a -> Int -> a
! (ModuleInstance -> Vector Int
memaddrs ModuleInstance
moduleInstance Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! Int
0)
            MutableByteArray RealWorld
memory <- IORef (MutableByteArray RealWorld)
-> IO (MutableByteArray RealWorld)
forall a. IORef a -> IO a
readIORef IORef (MutableByteArray RealWorld)
IORef MemoryStore
memoryRef
            let addr :: Int
addr = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ FuncIndex -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
offset
            let writeByte :: Int -> IO ()
writeByte Int
idx = do
                    let byte :: Word8
byte = i -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (i -> Word8) -> i -> Word8
forall a b. (a -> b) -> a -> b
$ i
v i -> Int -> i
forall a. Bits a => a -> Int -> a
`shiftR` (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) i -> i -> i
forall a. Bits a => a -> a -> a
.&. i
0xFF
                    MemoryStore -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
ByteArray.writeByteArray @Word8 MutableByteArray RealWorld
MemoryStore
memory (Int
addr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
idx) Word8
byte
            Int
len <- MemoryStore -> IO Int
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m Int
ByteArray.getSizeofMutableByteArray MutableByteArray RealWorld
MemoryStore
memory
            let isAligned :: Bool
isAligned = Int
addr Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
byteWidth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            let write :: IO ()
write = if Bool
isAligned
                then MemoryStore -> Int -> i -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
ByteArray.writeByteArray MutableByteArray RealWorld
MemoryStore
memory (Int
addr Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
byteWidth) i
v
                else (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> IO ()
writeByte [Int
0..Int
byteWidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] :: IO ()
            if Int
addr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
byteWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else IO ()
write IO () -> IO EvalResult -> IO EvalResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest })
        makeStoreInstr EvalCtx
_ FuncIndex
_ Int
_ i
_ = String -> IO EvalResult
forall a. HasCallStack => String -> a
error String
"Incorrect value on top of stack for memory instruction"

        step :: EvalCtx -> Instruction Natural -> IO EvalResult
        step :: EvalCtx -> Instruction FuncIndex -> IO EvalResult
step EvalCtx
_ Instruction FuncIndex
Unreachable = EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
        step EvalCtx
ctx Instruction FuncIndex
Nop = EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx
        step EvalCtx
ctx (Block BlockType
blockType Expression
expr) = do
            let FuncType LocalsType
paramType LocalsType
resType = case BlockType
blockType of
                    Inline Maybe ValueType
Nothing -> LocalsType -> LocalsType -> FuncType
FuncType [] []
                    Inline (Just ValueType
valType) -> LocalsType -> LocalsType -> FuncType
FuncType [] [ValueType
valType]
                    TypeIndex FuncIndex
typeIdx -> ModuleInstance -> Vector FuncType
funcTypes ModuleInstance
moduleInstance Vector FuncType -> Int -> FuncType
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
typeIdx
            EvalResult
res <- EvalCtx -> Expression -> IO EvalResult
go EvalCtx
ctx { $sel:labels:EvalCtx :: [Label]
labels = LocalsType -> Label
Label LocalsType
resType Label -> [Label] -> [Label]
forall a. a -> [a] -> [a]
: EvalCtx -> [Label]
labels EvalCtx
ctx } Expression
expr
            case EvalResult
res of
                Break Int
0 [Value]
r EvalCtx{ $sel:locals:EvalCtx :: EvalCtx -> Vector Value
locals = Vector Value
ls } -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:locals:EvalCtx :: Vector Value
locals = Vector Value
ls, $sel:stack:EvalCtx :: [Value]
stack = [Value]
r [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
drop (LocalsType -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LocalsType
paramType) ([Value] -> [Value]) -> [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ EvalCtx -> [Value]
stack EvalCtx
ctx) }
                Break Int
n [Value]
r EvalCtx
ctx' -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ Int -> [Value] -> EvalCtx -> EvalResult
Break (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Value]
r EvalCtx
ctx'
                Done ctx' :: EvalCtx
ctx'@EvalCtx{ $sel:labels:EvalCtx :: EvalCtx -> [Label]
labels = (Label
_:[Label]
rest) } -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx' { $sel:labels:EvalCtx :: [Label]
labels = [Label]
rest }
                EvalResult
command -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
command
        step EvalCtx
ctx loop :: Instruction FuncIndex
loop@(Loop BlockType
blockType Expression
expr) = do
            let resType :: LocalsType
resType = case BlockType
blockType of
                    Inline Maybe ValueType
Nothing -> []
                    Inline (Just ValueType
valType) -> [ValueType
valType]
                    TypeIndex FuncIndex
typeIdx -> FuncType -> LocalsType
results (FuncType -> LocalsType) -> FuncType -> LocalsType
forall a b. (a -> b) -> a -> b
$ ModuleInstance -> Vector FuncType
funcTypes ModuleInstance
moduleInstance Vector FuncType -> Int -> FuncType
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
typeIdx
            EvalResult
res <- EvalCtx -> Expression -> IO EvalResult
go EvalCtx
ctx { $sel:labels:EvalCtx :: [Label]
labels = LocalsType -> Label
Label LocalsType
resType Label -> [Label] -> [Label]
forall a. a -> [a] -> [a]
: EvalCtx -> [Label]
labels EvalCtx
ctx } Expression
expr
            case EvalResult
res of
                Break Int
0 [Value]
r EvalCtx{ $sel:locals:EvalCtx :: EvalCtx -> Vector Value
locals = Vector Value
ls, $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = [Value]
st } -> EvalCtx -> Instruction FuncIndex -> IO EvalResult
step EvalCtx
ctx { $sel:locals:EvalCtx :: Vector Value
locals = Vector Value
ls, $sel:stack:EvalCtx :: [Value]
stack = [Value]
st } Instruction FuncIndex
loop
                Break Int
n [Value]
r EvalCtx
ctx' -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ Int -> [Value] -> EvalCtx -> EvalResult
Break (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Value]
r EvalCtx
ctx'
                Done ctx' :: EvalCtx
ctx'@EvalCtx{ $sel:labels:EvalCtx :: EvalCtx -> [Label]
labels = (Label
_:[Label]
rest) } -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx' { $sel:labels:EvalCtx :: [Label]
labels = [Label]
rest }
                EvalResult
command -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
command
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v): [Value]
rest } (If BlockType
blockType Expression
true Expression
false) = do
            let FuncType LocalsType
paramType LocalsType
resType = case BlockType
blockType of
                    Inline Maybe ValueType
Nothing -> LocalsType -> LocalsType -> FuncType
FuncType [] []
                    Inline (Just ValueType
valType) -> LocalsType -> LocalsType -> FuncType
FuncType [] [ValueType
valType]
                    TypeIndex FuncIndex
typeIdx -> ModuleInstance -> Vector FuncType
funcTypes ModuleInstance
moduleInstance Vector FuncType -> Int -> FuncType
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
typeIdx
            let expr :: Expression
expr = if Word32
v Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 then Expression
true else Expression
false
            EvalResult
res <- EvalCtx -> Expression -> IO EvalResult
go EvalCtx
ctx { $sel:labels:EvalCtx :: [Label]
labels = LocalsType -> Label
Label LocalsType
resType Label -> [Label] -> [Label]
forall a. a -> [a] -> [a]
: EvalCtx -> [Label]
labels EvalCtx
ctx, $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } Expression
expr
            case EvalResult
res of
                Break Int
0 [Value]
r EvalCtx{ $sel:locals:EvalCtx :: EvalCtx -> Vector Value
locals = Vector Value
ls } -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:locals:EvalCtx :: Vector Value
locals = Vector Value
ls, $sel:stack:EvalCtx :: [Value]
stack = [Value]
r [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
drop (LocalsType -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LocalsType
paramType) [Value]
rest) }
                Break Int
n [Value]
r EvalCtx
ctx' -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ Int -> [Value] -> EvalCtx -> EvalResult
Break (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Value]
r EvalCtx
ctx'
                Done ctx' :: EvalCtx
ctx'@EvalCtx{ $sel:labels:EvalCtx :: EvalCtx -> [Label]
labels = (Label
_:[Label]
rest) } -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx' { $sel:labels:EvalCtx :: [Label]
labels = [Label]
rest }
                EvalResult
command -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
command
        step ctx :: EvalCtx
ctx@EvalCtx{ [Value]
stack :: [Value]
$sel:stack:EvalCtx :: EvalCtx -> [Value]
stack, [Label]
labels :: [Label]
$sel:labels:EvalCtx :: EvalCtx -> [Label]
labels } (Br FuncIndex
label) = do
            let idx :: Int
idx = FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
label
            let Label LocalsType
resType = [Label]
labels [Label] -> Int -> Label
forall a. [a] -> Int -> a
!! Int
idx
            case [Maybe Value] -> Maybe [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe Value] -> Maybe [Value]) -> [Maybe Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ (ValueType -> Value -> Maybe Value)
-> LocalsType -> [Value] -> [Maybe Value]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ValueType -> Value -> Maybe Value
checkValType (LocalsType -> LocalsType
forall a. [a] -> [a]
reverse LocalsType
resType) ([Value] -> [Maybe Value]) -> [Value] -> [Maybe Value]
forall a b. (a -> b) -> a -> b
$ Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
take (LocalsType -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LocalsType
resType) [Value]
stack of
                Just [Value]
result -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ Int -> [Value] -> EvalCtx -> EvalResult
Break Int
idx [Value]
result EvalCtx
ctx
                Maybe [Value]
Nothing -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v): [Value]
rest } (BrIf FuncIndex
label) =
            if Word32
v Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest }
            else EvalCtx -> Instruction FuncIndex -> IO EvalResult
step EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } (FuncIndex -> Instruction FuncIndex
forall index. index -> Instruction index
Br FuncIndex
label)
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v): [Value]
rest } (BrTable [FuncIndex]
labels FuncIndex
label) =
            let idx :: Int
idx = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v in
            let lbl :: FuncIndex
lbl = FuncIndex -> FuncIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FuncIndex -> FuncIndex) -> FuncIndex -> FuncIndex
forall a b. (a -> b) -> a -> b
$ if Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [FuncIndex] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FuncIndex]
labels then [FuncIndex]
labels [FuncIndex] -> Int -> FuncIndex
forall a. [a] -> Int -> a
!! Int
idx else FuncIndex
label in
            EvalCtx -> Instruction FuncIndex -> IO EvalResult
step EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } (FuncIndex -> Instruction FuncIndex
forall index. index -> Instruction index
Br FuncIndex
lbl)
        step EvalCtx{ [Value]
stack :: [Value]
$sel:stack:EvalCtx :: EvalCtx -> [Value]
stack } Instruction FuncIndex
Return =
            let resType :: LocalsType
resType = FuncType -> LocalsType
results FuncType
funcType in
            case [Maybe Value] -> Maybe [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe Value] -> Maybe [Value]) -> [Maybe Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ (ValueType -> Value -> Maybe Value)
-> LocalsType -> [Value] -> [Maybe Value]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ValueType -> Value -> Maybe Value
checkValType (LocalsType -> LocalsType
forall a. [a] -> [a]
reverse LocalsType
resType) ([Value] -> [Maybe Value]) -> [Value] -> [Maybe Value]
forall a b. (a -> b) -> a -> b
$ Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
take (LocalsType -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LocalsType
resType) [Value]
stack of
                Just [Value]
result -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ [Value] -> EvalResult
ReturnFn ([Value] -> EvalResult) -> [Value] -> EvalResult
forall a b. (a -> b) -> a -> b
$ [Value] -> [Value]
forall a. [a] -> [a]
reverse [Value]
result
                Maybe [Value]
Nothing -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
        step EvalCtx
ctx (Call FuncIndex
fun) = do
            let funInst :: FunctionInstance
funInst = Store -> Vector FunctionInstance
funcInstances Store
store Vector FunctionInstance -> Int -> FunctionInstance
forall a. Vector a -> Int -> a
! (ModuleInstance -> Vector Int
funcaddrs ModuleInstance
moduleInstance Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
fun)
            let ft :: FuncType
ft = FunctionInstance -> FuncType
Language.Wasm.Interpreter.funcType FunctionInstance
funInst 
            let args :: LocalsType
args = FuncType -> LocalsType
params FuncType
ft
            case [Maybe Value] -> Maybe [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe Value] -> Maybe [Value]) -> [Maybe Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ (ValueType -> Value -> Maybe Value)
-> LocalsType -> [Value] -> [Maybe Value]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ValueType -> Value -> Maybe Value
checkValType LocalsType
args ([Value] -> [Maybe Value]) -> [Value] -> [Maybe Value]
forall a b. (a -> b) -> a -> b
$ [Value] -> [Value]
forall a. [a] -> [a]
reverse ([Value] -> [Value]) -> [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
take (LocalsType -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LocalsType
args) ([Value] -> [Value]) -> [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ EvalCtx -> [Value]
stack EvalCtx
ctx of
                Just [Value]
params -> do
                    Maybe [Value]
res <- FuncIndex
-> Store -> FunctionInstance -> [Value] -> IO (Maybe [Value])
eval (FuncIndex
budget FuncIndex -> FuncIndex -> FuncIndex
forall a. Num a => a -> a -> a
- FuncIndex
1) Store
store FunctionInstance
funInst [Value]
params
                    case Maybe [Value]
res of
                        Just [Value]
res -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value] -> [Value]
forall a. [a] -> [a]
reverse [Value]
res [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
drop (LocalsType -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LocalsType
args) ([Value] -> [Value]) -> [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ EvalCtx -> [Value]
stack EvalCtx
ctx) }
                        Maybe [Value]
Nothing -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
                Maybe [Value]
Nothing -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v): [Value]
rest } (CallIndirect FuncIndex
typeIdx) = do
            let funcType :: FuncType
funcType = ModuleInstance -> Vector FuncType
funcTypes ModuleInstance
moduleInstance Vector FuncType -> Int -> FuncType
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
typeIdx
            let TableInstance { Vector (Maybe Int)
elements :: Vector (Maybe Int)
$sel:elements:TableInstance :: TableInstance -> Vector (Maybe Int)
elements } = Store -> Vector TableInstance
tableInstances Store
store Vector TableInstance -> Int -> TableInstance
forall a. Vector a -> Int -> a
! (ModuleInstance -> Vector Int
tableaddrs ModuleInstance
moduleInstance Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! Int
0)
            let checks :: Maybe (FunctionInstance, [Value])
checks = do
                    Int
addr <- Maybe (Maybe Int) -> Maybe Int
forall (m :: * -> *) a. Monad m => m (m a) -> m a
Monad.join (Maybe (Maybe Int) -> Maybe Int) -> Maybe (Maybe Int) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Vector (Maybe Int)
elements Vector (Maybe Int) -> Int -> Maybe (Maybe Int)
forall a. Vector a -> Int -> Maybe a
!? Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v
                    let funcInst :: FunctionInstance
funcInst = Store -> Vector FunctionInstance
funcInstances Store
store Vector FunctionInstance -> Int -> FunctionInstance
forall a. Vector a -> Int -> a
! Int
addr
                    let targetType :: FuncType
targetType = FunctionInstance -> FuncType
Language.Wasm.Interpreter.funcType FunctionInstance
funcInst
                    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ FuncType
targetType FuncType -> FuncType -> Bool
forall a. Eq a => a -> a -> Bool
== FuncType
funcType
                    let args :: LocalsType
args = FuncType -> LocalsType
params FuncType
targetType
                    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ LocalsType -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LocalsType
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
rest
                    [Value]
params <- [Maybe Value] -> Maybe [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe Value] -> Maybe [Value]) -> [Maybe Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ (ValueType -> Value -> Maybe Value)
-> LocalsType -> [Value] -> [Maybe Value]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ValueType -> Value -> Maybe Value
checkValType LocalsType
args ([Value] -> [Maybe Value]) -> [Value] -> [Maybe Value]
forall a b. (a -> b) -> a -> b
$ [Value] -> [Value]
forall a. [a] -> [a]
reverse ([Value] -> [Value]) -> [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
take (LocalsType -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LocalsType
args) [Value]
rest
                    (FunctionInstance, [Value]) -> Maybe (FunctionInstance, [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (FunctionInstance
funcInst, [Value]
params)
            case Maybe (FunctionInstance, [Value])
checks of
                Just (FunctionInstance
funcInst, [Value]
params) -> do
                    Maybe [Value]
res <- FuncIndex
-> Store -> FunctionInstance -> [Value] -> IO (Maybe [Value])
eval (FuncIndex
budget FuncIndex -> FuncIndex -> FuncIndex
forall a. Num a => a -> a -> a
- FuncIndex
1) Store
store FunctionInstance
funcInst [Value]
params
                    case Maybe [Value]
res of
                        Just [Value]
res -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value] -> [Value]
forall a. [a] -> [a]
reverse [Value]
res [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
drop ([Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
params) [Value]
rest) }
                        Maybe [Value]
Nothing -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
                Maybe (FunctionInstance, [Value])
Nothing -> EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (Value
_:[Value]
rest) } Instruction FuncIndex
Drop = EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
test:Value
val2:Value
val1:[Value]
rest) } Instruction FuncIndex
Select =
            if Word32
test Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Value
val2 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Value
val1 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step EvalCtx
ctx (GetLocal FuncIndex
i) = EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = (EvalCtx -> Vector Value
locals EvalCtx
ctx Vector Value -> Int -> Value
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
i) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: EvalCtx -> [Value]
stack EvalCtx
ctx }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (Value
v:[Value]
rest) } (SetLocal FuncIndex
i) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest, $sel:locals:EvalCtx :: Vector Value
locals = EvalCtx -> Vector Value
locals EvalCtx
ctx Vector Value -> [(Int, Value)] -> Vector Value
forall a. Vector a -> [(Int, a)] -> Vector a
// [(FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
i, Value
v)] }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:locals:EvalCtx :: EvalCtx -> Vector Value
locals = Vector Value
ls, $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (Value
v:[Value]
rest) } (TeeLocal FuncIndex
i) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx {
                $sel:stack:EvalCtx :: [Value]
stack = Value
v Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest,
                $sel:locals:EvalCtx :: Vector Value
locals = EvalCtx -> Vector Value
locals EvalCtx
ctx Vector Value -> [(Int, Value)] -> Vector Value
forall a. Vector a -> [(Int, a)] -> Vector a
// [(FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
i, Value
v)]
            }
        step EvalCtx
ctx (GetGlobal FuncIndex
i) = do
            let globalInst :: GlobalInstance
globalInst = Store -> Vector GlobalInstance
globalInstances Store
store Vector GlobalInstance -> Int -> GlobalInstance
forall a. Vector a -> Int -> a
! (ModuleInstance -> Vector Int
globaladdrs ModuleInstance
moduleInstance Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
i)
            Value
val <- case GlobalInstance
globalInst of
                GIConst ValueType
_ Value
v -> Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
                GIMut ValueType
_ IORef Value
ref -> IORef Value -> IO Value
forall a. IORef a -> IO a
readIORef IORef Value
ref
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Value
val Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: EvalCtx -> [Value]
stack EvalCtx
ctx }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (Value
v:[Value]
rest) } (SetGlobal FuncIndex
i) = do
            let globalInst :: GlobalInstance
globalInst = Store -> Vector GlobalInstance
globalInstances Store
store Vector GlobalInstance -> Int -> GlobalInstance
forall a. Vector a -> Int -> a
! (ModuleInstance -> Vector Int
globaladdrs ModuleInstance
moduleInstance Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FuncIndex
i)
            case GlobalInstance
globalInst of
                GIConst ValueType
_ Value
v -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"Attempt of mutation of constant global"
                GIMut ValueType
_ IORef Value
ref -> IORef Value -> Value -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Value
ref Value
v
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest }
        step EvalCtx
ctx (I32Load MemArg { FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset :: FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word32 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr EvalCtx
ctx FuncIndex
offset Int
4 (([Value] -> Word32 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word32 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word32
val -> EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
val Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (I64Load MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word64 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr EvalCtx
ctx FuncIndex
offset Int
8 (([Value] -> Word64 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word64 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word64
val -> EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
val Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (F32Load MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word32 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr EvalCtx
ctx FuncIndex
offset Int
4 (([Value] -> Word32 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word32 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word32
val -> EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Word32 -> Float
wordToFloat Word32
val) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (F64Load MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word64 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr EvalCtx
ctx FuncIndex
offset Int
8 (([Value] -> Word64 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word64 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word64
val -> EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Word64 -> Double
wordToDouble Word64
val) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (I32Load8U MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word8 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr @Word8 EvalCtx
ctx FuncIndex
offset Int
1 (([Value] -> Word8 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word8 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word8
val -> EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
val) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (I32Load8S MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word8 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr EvalCtx
ctx FuncIndex
offset Int
1 (([Value] -> Word8 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word8 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word8
byte ->
                let val :: Word32
val = Int32 -> Word32
asWord32 (Int32 -> Word32) -> Int32 -> Word32
forall a b. (a -> b) -> a -> b
$ if (Word8
byte :: Word8) Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
128 then -Int32
1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
0xFF Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
byte Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1) else Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte in
                EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
val Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (I32Load16U MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) = do
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word16 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr @Word16 EvalCtx
ctx FuncIndex
offset Int
2 (([Value] -> Word16 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word16 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word16
val -> EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
val) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (I32Load16S MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word16 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr EvalCtx
ctx FuncIndex
offset Int
2 (([Value] -> Word16 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word16 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word16
val ->
                let signed :: Word32
signed = Int32 -> Word32
asWord32 (Int32 -> Word32) -> Int32 -> Word32
forall a b. (a -> b) -> a -> b
$ if (Word16
val :: Word16) Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
2 Word16 -> Integer -> Word16
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
15 then -Int32
1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Word16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
0xFFFF Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
val Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1) else Word16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
val in
                EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
signed Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (I64Load8U MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word8 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr @Word8 EvalCtx
ctx FuncIndex
offset Int
1 (([Value] -> Word8 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word8 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word8
val -> EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
val) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (I64Load8S MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word8 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr EvalCtx
ctx FuncIndex
offset Int
1 (([Value] -> Word8 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word8 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word8
byte ->
                let val :: Word64
val = Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ if (Word8
byte :: Word8) Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
128 then -Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
0xFF Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
byte Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1) else Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte in
                EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
val Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (I64Load16U MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word16 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr @Word16 EvalCtx
ctx FuncIndex
offset Int
2 (([Value] -> Word16 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word16 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word16
val -> EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
val) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (I64Load16S MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word16 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr EvalCtx
ctx FuncIndex
offset Int
2 (([Value] -> Word16 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word16 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word16
val ->
                let signed :: Word64
signed = Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ if (Word16
val :: Word16) Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
2 Word16 -> Integer -> Word16
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
15 then -Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
0xFFFF Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
val Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1) else Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
val in
                EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
signed Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (I64Load32U MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word32 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr @Word32 EvalCtx
ctx FuncIndex
offset Int
4 (([Value] -> Word32 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word32 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word32
val -> EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
val) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step EvalCtx
ctx (I64Load32S MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> Word32 -> EvalResult)
-> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx
-> FuncIndex
-> Int
-> ([Value] -> i -> EvalResult)
-> IO EvalResult
makeLoadInstr EvalCtx
ctx FuncIndex
offset Int
4 (([Value] -> Word32 -> EvalResult) -> IO EvalResult)
-> ([Value] -> Word32 -> EvalResult) -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ (\[Value]
rest Word32
val ->
                let signed :: Word64
signed = Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int64) -> Int32 -> Int64
forall a b. (a -> b) -> a -> b
$ Word32 -> Int32
asInt32 Word32
val in
                EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
signed Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest })
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (I32Store MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx -> FuncIndex -> Int -> Word32 -> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx -> FuncIndex -> Int -> i -> IO EvalResult
makeStoreInstr EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } FuncIndex
offset Int
4 Word32
v
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (I64Store MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx -> FuncIndex -> Int -> Word64 -> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx -> FuncIndex -> Int -> i -> IO EvalResult
makeStoreInstr EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } FuncIndex
offset Int
8 Word64
v
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
f:[Value]
rest) } (F32Store MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx -> FuncIndex -> Int -> Word32 -> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx -> FuncIndex -> Int -> i -> IO EvalResult
makeStoreInstr EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } FuncIndex
offset Int
4 (Word32 -> IO EvalResult) -> Word32 -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ Float -> Word32
floatToWord Float
f
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
f:[Value]
rest) } (F64Store MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx -> FuncIndex -> Int -> Word64 -> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx -> FuncIndex -> Int -> i -> IO EvalResult
makeStoreInstr EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } FuncIndex
offset Int
8 (Word64 -> IO EvalResult) -> Word64 -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ Double -> Word64
doubleToWord Double
f
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (I32Store8 MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx -> FuncIndex -> Int -> Word8 -> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx -> FuncIndex -> Int -> i -> IO EvalResult
makeStoreInstr @Word8 EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } FuncIndex
offset Int
1 (Word8 -> IO EvalResult) -> Word8 -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (I32Store16 MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx -> FuncIndex -> Int -> Word16 -> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx -> FuncIndex -> Int -> i -> IO EvalResult
makeStoreInstr @Word16 EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } FuncIndex
offset Int
2 (Word16 -> IO EvalResult) -> Word16 -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (I64Store8 MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx -> FuncIndex -> Int -> Word8 -> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx -> FuncIndex -> Int -> i -> IO EvalResult
makeStoreInstr @Word8 EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } FuncIndex
offset Int
1 (Word8 -> IO EvalResult) -> Word8 -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (I64Store16 MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx -> FuncIndex -> Int -> Word16 -> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx -> FuncIndex -> Int -> i -> IO EvalResult
makeStoreInstr @Word16 EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } FuncIndex
offset Int
2 (Word16 -> IO EvalResult) -> Word16 -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (I64Store32 MemArg { FuncIndex
offset :: FuncIndex
$sel:offset:MemArg :: MemArg -> FuncIndex
offset }) =
            EvalCtx -> FuncIndex -> Int -> Word32 -> IO EvalResult
forall i.
(Prim i, Bits i, Integral i) =>
EvalCtx -> FuncIndex -> Int -> i -> IO EvalResult
makeStoreInstr @Word32 EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = [Value]
rest } FuncIndex
offset Int
4 (Word32 -> IO EvalResult) -> Word32 -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = [Value]
st } Instruction FuncIndex
CurrentMemory = do
            let MemoryInstance { $sel:memory:MemoryInstance :: MemoryInstance -> IORef MemoryStore
memory = IORef MemoryStore
memoryRef } = Store -> Vector MemoryInstance
memInstances Store
store Vector MemoryInstance -> Int -> MemoryInstance
forall a. Vector a -> Int -> a
! (ModuleInstance -> Vector Int
memaddrs ModuleInstance
moduleInstance Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! Int
0)
            MutableByteArray RealWorld
memory <- IORef (MutableByteArray RealWorld)
-> IO (MutableByteArray RealWorld)
forall a. IORef a -> IO a
readIORef IORef (MutableByteArray RealWorld)
IORef MemoryStore
memoryRef
            Int
size <- ((Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
pageSize) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Int -> Int) -> IO Int -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemoryStore -> IO Int
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m Int
ByteArray.getSizeofMutableByteArray MutableByteArray RealWorld
MemoryStore
memory
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
st }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
n:[Value]
rest) } Instruction FuncIndex
GrowMemory = do
            let MemoryInstance { $sel:lim:MemoryInstance :: MemoryInstance -> Limit
lim = limit :: Limit
limit@(Limit FuncIndex
_ Maybe FuncIndex
maxLen), $sel:memory:MemoryInstance :: MemoryInstance -> IORef MemoryStore
memory = IORef MemoryStore
memoryRef } = Store -> Vector MemoryInstance
memInstances Store
store Vector MemoryInstance -> Int -> MemoryInstance
forall a. Vector a -> Int -> a
! (ModuleInstance -> Vector Int
memaddrs ModuleInstance
moduleInstance Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! Int
0)
            MutableByteArray RealWorld
memory <- IORef (MutableByteArray RealWorld)
-> IO (MutableByteArray RealWorld)
forall a. IORef a -> IO a
readIORef IORef (MutableByteArray RealWorld)
IORef MemoryStore
memoryRef
            Int
size <- (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
pageSize) (Int -> Int) -> IO Int -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemoryStore -> IO Int
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m Int
ByteArray.getSizeofMutableByteArray MutableByteArray RealWorld
MemoryStore
memory
            let growTo :: Int
growTo = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n
            let w64PageSize :: Int
w64PageSize = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
pageSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
            Int
result <- (
                    if Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True ((Int
growTo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=) (Int -> Bool) -> (FuncIndex -> Int) -> FuncIndex -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncIndex -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FuncIndex -> Bool) -> Maybe FuncIndex -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FuncIndex
maxLen) Bool -> Bool -> Bool
&& Int
growTo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFF
                    then (
                        if Word32
n Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
size else do
                            MutableByteArray RealWorld
mem' <- MemoryStore -> Int -> IO MemoryStore
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> m (MutableByteArray (PrimState m))
ByteArray.resizeMutableByteArray MutableByteArray RealWorld
MemoryStore
memory (Int -> IO MemoryStore) -> Int -> IO MemoryStore
forall a b. (a -> b) -> a -> b
$ Int
growTo Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pageSize
                            MemoryStore -> Int -> Int -> Word64 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
ByteArray.setByteArray @Word64 MutableByteArray RealWorld
MemoryStore
mem' (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w64PageSize) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w64PageSize) Word64
0
                            IORef (MutableByteArray RealWorld)
-> MutableByteArray RealWorld -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (MutableByteArray RealWorld)
IORef MemoryStore
memoryRef MutableByteArray RealWorld
mem'
                            Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
size
                    )
                    else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ -Int
1
                )
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int32 -> Word32
asWord32 (Int32 -> Word32) -> Int32 -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
result) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step EvalCtx
ctx (I32Const Word32
v) = EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
v Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: EvalCtx -> [Value]
stack EvalCtx
ctx }
        step EvalCtx
ctx (I64Const Word64
v) = EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
v Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: EvalCtx -> [Value]
stack EvalCtx
ctx }
        step EvalCtx
ctx (F32Const Float
v) = EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 Float
v Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: EvalCtx -> [Value]
stack EvalCtx
ctx }
        step EvalCtx
ctx (F64Const Double
v) = EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 Double
v Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: EvalCtx -> [Value]
stack EvalCtx
ctx }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IAdd) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
ISub) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IMul) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IDivU) =
            if Word32
v2 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`quot` Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IDivS) =
            if Word32
v2 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 Bool -> Bool -> Bool
|| (Word32
v1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x80000000 Bool -> Bool -> Bool
&& Word32
v2 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xFFFFFFFF)
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int32 -> Word32
asWord32 (Int32 -> Word32) -> Int32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> Int32
asInt32 Word32
v1 Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
`quot` Word32 -> Int32
asInt32 Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IRemU) =
            if Word32
v2 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`rem` Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IRemS) =
            if Word32
v2 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int32 -> Word32
asWord32 (Int32 -> Word32) -> Int32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> Int32
asInt32 Word32
v1 Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
`rem` Word32 -> Int32
asInt32 Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IAnd) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IOr) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IXor) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IShl) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
32)) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IShrU) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
32)) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IShrS) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int32 -> Word32
asWord32 (Int32 -> Word32) -> Int32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> Int32
asInt32 Word32
v1 Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftR` (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
32)) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IRotl) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateL` Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IBinOp BitSize
BS32 IBinOp
IRotr) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word32
v1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`rotateR` Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IRelOp BitSize
BS32 IRelOp
IEq) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word32
v1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IRelOp BitSize
BS32 IRelOp
INe) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word32
v1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IRelOp BitSize
BS32 IRelOp
ILtU) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word32
v1 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IRelOp BitSize
BS32 IRelOp
ILtS) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word32 -> Int32
asInt32 Word32
v1 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32 -> Int32
asInt32 Word32
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IRelOp BitSize
BS32 IRelOp
IGtU) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word32
v1 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IRelOp BitSize
BS32 IRelOp
IGtS) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word32 -> Int32
asInt32 Word32
v1 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32 -> Int32
asInt32 Word32
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IRelOp BitSize
BS32 IRelOp
ILeU) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word32
v1 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IRelOp BitSize
BS32 IRelOp
ILeS) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word32 -> Int32
asInt32 Word32
v1 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> Int32
asInt32 Word32
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IRelOp BitSize
BS32 IRelOp
IGeU) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word32
v1 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v2:VI32 Word32
v1:[Value]
rest) } (IRelOp BitSize
BS32 IRelOp
IGeS) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word32 -> Int32
asInt32 Word32
v1 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> Int32
asInt32 Word32
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } Instruction FuncIndex
I32Eqz =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word32
v Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (IUnOp BitSize
BS32 IUnOp
IClz) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word32
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (IUnOp BitSize
BS32 IUnOp
ICtz) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word32
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (IUnOp BitSize
BS32 IUnOp
IPopcnt) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a. Bits a => a -> Int
popCount Word32
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (IUnOp BitSize
BS32 IUnOp
IExtend8S) =
            let byte :: Word32
byte = Word32
v Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF in
            let r :: Word32
r = if Word32
byte Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
0x80 then Int32 -> Word32
asWord32 (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
byte Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
0x100) else Word32
byte in
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
r Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (IUnOp BitSize
BS32 IUnOp
IExtend16S) =
            let half :: Word32
half = Word32
v Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFFFF in
            let r :: Word32
r = if Word32
half Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
0x8000 then Int32 -> Word32
asWord32 (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
half Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
0x10000) else Word32
half in
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
r Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (IUnOp BitSize
BS32 IUnOp
IExtend32S) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
v Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IAdd) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
ISub) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IMul) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IDivU) =
            if Word64
v2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IDivS) =
            if Word64
v2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
|| (Word64
v1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0x8000000000000000 Bool -> Bool -> Bool
&& Word64
v2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0xFFFFFFFFFFFFFFFF)
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
asInt64 Word64
v1 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Word64 -> Int64
asInt64 Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IRemU) =
            if Word64
v2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`rem` Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IRemS) =
            if Word64
v2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
asInt64 Word64
v1 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`rem` Word64 -> Int64
asInt64 Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IAnd) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IOr) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IXor) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IShl) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
v2 Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`rem` Word64
64))) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IShrU) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
v2 Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`rem` Word64
64))) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IShrS) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
asInt64 Word64
v1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
v2 Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`rem` Word64
64))) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IRotl) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateL` Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IBinOp BitSize
BS64 IBinOp
IRotr) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word64
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`rotateR` Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IRelOp BitSize
BS64 IRelOp
IEq) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word64
v1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IRelOp BitSize
BS64 IRelOp
INe) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word64
v1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IRelOp BitSize
BS64 IRelOp
ILtU) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word64
v1 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IRelOp BitSize
BS64 IRelOp
ILtS) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word64 -> Int64
asInt64 Word64
v1 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64 -> Int64
asInt64 Word64
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IRelOp BitSize
BS64 IRelOp
IGtU) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word64
v1 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IRelOp BitSize
BS64 IRelOp
IGtS) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word64 -> Int64
asInt64 Word64
v1 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64 -> Int64
asInt64 Word64
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IRelOp BitSize
BS64 IRelOp
ILeU) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word64
v1 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IRelOp BitSize
BS64 IRelOp
ILeS) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word64 -> Int64
asInt64 Word64
v1 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Int64
asInt64 Word64
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IRelOp BitSize
BS64 IRelOp
IGeU) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word64
v1 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v2:VI64 Word64
v1:[Value]
rest) } (IRelOp BitSize
BS64 IRelOp
IGeS) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word64 -> Int64
asInt64 Word64
v1 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64 -> Int64
asInt64 Word64
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } Instruction FuncIndex
I64Eqz =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Word64
v Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (IUnOp BitSize
BS64 IUnOp
IClz) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word64
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (IUnOp BitSize
BS64 IUnOp
ICtz) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word64
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (IUnOp BitSize
BS64 IUnOp
IPopcnt) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a. Bits a => a -> Int
popCount Word64
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (IUnOp BitSize
BS64 IUnOp
IExtend8S) =
            let byte :: Word64
byte = Word64
v Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFF in
            let r :: Word64
r = if Word64
byte Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
0x80 then Int64 -> Word64
asWord64 (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
byte Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
0x100) else Word64
byte in
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
r Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (IUnOp BitSize
BS64 IUnOp
IExtend16S) =
            let quart :: Word64
quart = Word64
v Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFFFF in
            let r :: Word64
r = if Word64
quart Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
0x8000 then Int64 -> Word64
asWord64 (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
quart Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
0x10000) else Word64
quart in
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
r Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (IUnOp BitSize
BS64 IUnOp
IExtend32S) =
            let half :: Word64
half = Word64
v Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFFFFFFFF in
            let r :: Word64
r = if Word64
half Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
0x80000000 then Int64 -> Word64
asWord64 (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
half Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
0x100000000) else Word64
half in
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
r Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (FUnOp BitSize
BS32 FUnOp
FAbs) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float -> Float
forall a. Num a => a -> a
abs Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (FUnOp BitSize
BS32 FUnOp
FNeg) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float -> Float
forall a. Num a => a -> a
negate Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (FUnOp BitSize
BS32 FUnOp
FCeil) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float -> Float
floatCeil Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (FUnOp BitSize
BS32 FUnOp
FFloor) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float -> Float
floatFloor Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (FUnOp BitSize
BS32 FUnOp
FTrunc) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float -> Float
floatTrunc Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (FUnOp BitSize
BS32 FUnOp
FNearest) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float -> Float
forall a. IEEE a => a -> a
nearest Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (FUnOp BitSize
BS32 FUnOp
FSqrt) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float -> Float
forall a. Floating a => a -> a
sqrt Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (FUnOp BitSize
BS64 FUnOp
FAbs) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double -> Double
forall a. Num a => a -> a
abs Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (FUnOp BitSize
BS64 FUnOp
FNeg) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double -> Double
forall a. Num a => a -> a
negate Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (FUnOp BitSize
BS64 FUnOp
FCeil) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double -> Double
doubleCeil Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (FUnOp BitSize
BS64 FUnOp
FFloor) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double -> Double
doubleFloor Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (FUnOp BitSize
BS64 FUnOp
FTrunc) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double -> Double
doubleTrunc Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (FUnOp BitSize
BS64 FUnOp
FNearest) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double -> Double
forall a. IEEE a => a -> a
nearest Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (FUnOp BitSize
BS64 FUnOp
FSqrt) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double -> Double
forall a. Floating a => a -> a
sqrt Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FBinOp BitSize
BS32 FBinOp
FAdd) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float
v1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FBinOp BitSize
BS32 FBinOp
FSub) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float
v1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FBinOp BitSize
BS32 FBinOp
FMul) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float
v1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FBinOp BitSize
BS32 FBinOp
FDiv) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float
v1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FBinOp BitSize
BS32 FBinOp
FMin) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float -> Float -> Float
forall a. IEEE a => a -> a -> a
zeroAwareMin Float
v1 Float
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FBinOp BitSize
BS32 FBinOp
FMax) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float -> Float -> Float
forall a. IEEE a => a -> a -> a
zeroAwareMax Float
v1 Float
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FBinOp BitSize
BS32 FBinOp
FCopySign) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Float -> Float -> Float
forall a. IEEE a => a -> a -> a
copySign Float
v1 Float
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FBinOp BitSize
BS64 FBinOp
FAdd) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double
v1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FBinOp BitSize
BS64 FBinOp
FSub) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double
v1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FBinOp BitSize
BS64 FBinOp
FMul) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double
v1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FBinOp BitSize
BS64 FBinOp
FDiv) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double
v1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FBinOp BitSize
BS64 FBinOp
FMin) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double -> Double -> Double
forall a. IEEE a => a -> a -> a
zeroAwareMin Double
v1 Double
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FBinOp BitSize
BS64 FBinOp
FMax) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double -> Double -> Double
forall a. IEEE a => a -> a -> a
zeroAwareMax Double
v1 Double
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FBinOp BitSize
BS64 FBinOp
FCopySign) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Double -> Double -> Double
forall a. IEEE a => a -> a -> a
copySign Double
v1 Double
v2) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FRelOp BitSize
BS32 FRelOp
FEq) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Float
v1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FRelOp BitSize
BS32 FRelOp
FNe) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Float
v1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
/= Float
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FRelOp BitSize
BS32 FRelOp
FLt) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Float
v1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FRelOp BitSize
BS32 FRelOp
FGt) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Float
v1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FRelOp BitSize
BS32 FRelOp
FLe) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Float
v1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v2:VF32 Float
v1:[Value]
rest) } (FRelOp BitSize
BS32 FRelOp
FGe) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Float
v1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FRelOp BitSize
BS64 FRelOp
FEq) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Double
v1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FRelOp BitSize
BS64 FRelOp
FNe) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Double
v1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FRelOp BitSize
BS64 FRelOp
FLt) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Double
v1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FRelOp BitSize
BS64 FRelOp
FGt) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Double
v1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FRelOp BitSize
BS64 FRelOp
FLe) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Double
v1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v2:VF64 Double
v1:[Value]
rest) } (FRelOp BitSize
BS64 FRelOp
FGe) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (if Double
v1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
v2 then Word32
1 else Word32
0) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } Instruction FuncIndex
I32WrapI64 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFFFFFFFF) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncFU BitSize
BS32 BitSize
BS32) =
            if Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
v Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
v Bool -> Bool -> Bool
|| Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
32 Bool -> Bool -> Bool
|| Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= -Float
1
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Float -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncFU BitSize
BS32 BitSize
BS64) =
            if Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
v Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
v Bool -> Bool -> Bool
|| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
32 Bool -> Bool -> Bool
|| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= -Double
1
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Double -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncFU BitSize
BS64 BitSize
BS32) =
            if Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
v Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
v Bool -> Bool -> Bool
|| Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
64 Bool -> Bool -> Bool
|| Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= -Float
1
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Float -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncFU BitSize
BS64 BitSize
BS64) =
            if Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
v Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
v Bool -> Bool -> Bool
|| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
64 Bool -> Bool -> Bool
|| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= -Double
1
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Double -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncFS BitSize
BS32 BitSize
BS32) =
            if Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
v Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
v Bool -> Bool -> Bool
|| Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
31 Bool -> Bool -> Bool
|| Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< -Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
31 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int32 -> Word32
asWord32 (Int32 -> Word32) -> Int32 -> Word32
forall a b. (a -> b) -> a -> b
$ Float -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncFS BitSize
BS32 BitSize
BS64) =
            if Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
v Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
v Bool -> Bool -> Bool
|| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
31 Bool -> Bool -> Bool
|| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= -Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
31 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int32 -> Word32
asWord32 (Int32 -> Word32) -> Int32 -> Word32
forall a b. (a -> b) -> a -> b
$ Double -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncFS BitSize
BS64 BitSize
BS32) =
            if Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
v Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
v Bool -> Bool -> Bool
|| Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
63 Bool -> Bool -> Bool
|| Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< -Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
63 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Float -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncFS BitSize
BS64 BitSize
BS64) =
            if Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
v Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
v Bool -> Bool -> Bool
|| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
63 Bool -> Bool -> Bool
|| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< -Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
63 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1
            then EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResult
Trap
            else EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }

        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFS BitSize
BS32 BitSize
BS32) | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
v =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
0 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFS BitSize
BS32 BitSize
BS64) | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
v =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
0 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFS BitSize
BS64 BitSize
BS32) | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
v =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
0 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFS BitSize
BS64 BitSize
BS64) | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
v =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
0 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFU BitSize
BS32 BitSize
BS32) | Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= -Float
1 Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
v =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
0 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFU BitSize
BS32 BitSize
BS64) | Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= -Double
1 Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
v =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
0 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFU BitSize
BS64 BitSize
BS32) | Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= -Float
1 Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
v =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
0 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFU BitSize
BS64 BitSize
BS64) | Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= -Double
1 Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
v =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
0 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }

        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFS BitSize
BS32 BitSize
BS32) | Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
31 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
0x7fffffff Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFS BitSize
BS32 BitSize
BS64) | Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
31 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
0x7fffffff Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFS BitSize
BS64 BitSize
BS32) | Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
63 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
0x7fffffffffffffff Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFS BitSize
BS64 BitSize
BS64) | Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
63 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
0x7fffffffffffffff Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFU BitSize
BS32 BitSize
BS32) | Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
32 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
0xffffffff Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFU BitSize
BS32 BitSize
BS64) | Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
32 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
0xffffffff Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFU BitSize
BS64 BitSize
BS32) | Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
64 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
0xffffffffffffffff Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFU BitSize
BS64 BitSize
BS64) | Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
64 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
0xffffffffffffffff Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFS BitSize
BS32 BitSize
BS32) | Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= -Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
31 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
0x80000000 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFS BitSize
BS32 BitSize
BS64) | Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= -Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
31 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 Word32
0x80000000 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFS BitSize
BS64 BitSize
BS32) | Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= -Float
2Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
63 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
0x8000000000000000 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFS BitSize
BS64 BitSize
BS64) | Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= -Double
2Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
63 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 Word64
0x8000000000000000 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }

        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFU BitSize
BS32 BitSize
BS32) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Float -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFU BitSize
BS32 BitSize
BS64) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Double -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFU BitSize
BS64 BitSize
BS32) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Float -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFU BitSize
BS64 BitSize
BS64) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Double -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFS BitSize
BS32 BitSize
BS32) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int32 -> Word32
asWord32 (Int32 -> Word32) -> Int32 -> Word32
forall a b. (a -> b) -> a -> b
$ Float -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFS BitSize
BS32 BitSize
BS64) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Int32 -> Word32
asWord32 (Int32 -> Word32) -> Int32 -> Word32
forall a b. (a -> b) -> a -> b
$ Double -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (ITruncSatFS BitSize
BS64 BitSize
BS32) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Float -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (ITruncSatFS BitSize
BS64 BitSize
BS64) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } Instruction FuncIndex
I64ExtendUI32 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } Instruction FuncIndex
I64ExtendSI32 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Int64 -> Word64
asWord64 (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int64) -> Int32 -> Int64
forall a b. (a -> b) -> a -> b
$ Word32 -> Int32
asInt32 Word32
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (FConvertIU BitSize
BS32 BitSize
BS32) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Word32 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word32
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (FConvertIU BitSize
BS32 BitSize
BS64) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Word64 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (FConvertIU BitSize
BS64 BitSize
BS32) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Word32 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word32
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (FConvertIU BitSize
BS64 BitSize
BS64) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (FConvertIS BitSize
BS32 BitSize
BS32) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Int32 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int32 -> Float) -> Int32 -> Float
forall a b. (a -> b) -> a -> b
$ Word32 -> Int32
asInt32 Word32
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (FConvertIS BitSize
BS32 BitSize
BS64) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Int64 -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int64 -> Float) -> Int64 -> Float
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
asInt64 Word64
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (FConvertIS BitSize
BS64 BitSize
BS32) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Int32 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int32 -> Double) -> Int32 -> Double
forall a b. (a -> b) -> a -> b
$ Word32 -> Int32
asInt32 Word32
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (FConvertIS BitSize
BS64 BitSize
BS64) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Int64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int64 -> Double) -> Int64 -> Double
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
asInt64 Word64
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } Instruction FuncIndex
F32DemoteF64 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } Instruction FuncIndex
F64PromoteF32 =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF32 Float
v:[Value]
rest) } (IReinterpretF BitSize
BS32) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word32 -> Value
VI32 (Float -> Word32
floatToWord Float
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VF64 Double
v:[Value]
rest) } (IReinterpretF BitSize
BS64) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Word64 -> Value
VI64 (Double -> Word64
doubleToWord Double
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI32 Word32
v:[Value]
rest) } (FReinterpretI BitSize
BS32) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Float -> Value
VF32 (Word32 -> Float
wordToFloat Word32
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step ctx :: EvalCtx
ctx@EvalCtx{ $sel:stack:EvalCtx :: EvalCtx -> [Value]
stack = (VI64 Word64
v:[Value]
rest) } (FReinterpretI BitSize
BS64) =
            EvalResult -> IO EvalResult
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResult -> IO EvalResult) -> EvalResult -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ EvalCtx -> EvalResult
Done EvalCtx
ctx { $sel:stack:EvalCtx :: [Value]
stack = Double -> Value
VF64 (Word64 -> Double
wordToDouble Word64
v) Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest }
        step EvalCtx{ [Value]
stack :: [Value]
$sel:stack:EvalCtx :: EvalCtx -> [Value]
stack } Instruction FuncIndex
instr = String -> IO EvalResult
forall a. HasCallStack => String -> a
error (String -> IO EvalResult) -> String -> IO EvalResult
forall a b. (a -> b) -> a -> b
$ String
"Error during evaluation of instruction: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Instruction FuncIndex -> String
forall a. Show a => a -> String
show Instruction FuncIndex
instr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Stack " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Value] -> String
forall a. Show a => a -> String
show [Value]
stack
eval FuncIndex
_ Store
_ HostInstance { FuncType
funcType :: FuncType
$sel:funcType:FunctionInstance :: FunctionInstance -> FuncType
funcType, HostFunction
hostCode :: HostFunction
$sel:hostCode:FunctionInstance :: FunctionInstance -> HostFunction
hostCode } [Value]
args = [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just ([Value] -> Maybe [Value]) -> IO [Value] -> IO (Maybe [Value])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostFunction
hostCode [Value]
args

invoke :: Store -> Address -> [Value] -> IO (Maybe [Value])
invoke :: Store -> Int -> [Value] -> IO (Maybe [Value])
invoke Store
st Int
funcIdx = FuncIndex
-> Store -> FunctionInstance -> [Value] -> IO (Maybe [Value])
eval FuncIndex
defaultBudget Store
st (FunctionInstance -> [Value] -> IO (Maybe [Value]))
-> FunctionInstance -> [Value] -> IO (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ Store -> Vector FunctionInstance
funcInstances Store
st Vector FunctionInstance -> Int -> FunctionInstance
forall a. Vector a -> Int -> a
! Int
funcIdx

invokeExport :: Store -> ModuleInstance -> TL.Text -> [Value] -> IO (Maybe [Value])
invokeExport :: Store -> ModuleInstance -> Text -> [Value] -> IO (Maybe [Value])
invokeExport Store
st ModuleInstance { Vector ExportInstance
exports :: Vector ExportInstance
$sel:exports:ModuleInstance :: ModuleInstance -> Vector ExportInstance
exports } Text
name [Value]
args =
    case (ExportInstance -> Bool)
-> Vector ExportInstance -> Maybe ExportInstance
forall a. (a -> Bool) -> Vector a -> Maybe a
Vector.find (\(ExportInstance Text
n ExternalValue
_) -> Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) Vector ExportInstance
exports of
        Just (ExportInstance Text
_ (ExternFunction Int
addr)) -> Store -> Int -> [Value] -> IO (Maybe [Value])
invoke Store
st Int
addr [Value]
args
        Maybe ExportInstance
_ -> String -> IO (Maybe [Value])
forall a. HasCallStack => String -> a
error (String -> IO (Maybe [Value])) -> String -> IO (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ String
"Function with name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" was not found in module's exports"

getGlobalValueByName :: Store -> ModuleInstance -> TL.Text -> IO Value
getGlobalValueByName :: Store -> ModuleInstance -> Text -> IO Value
getGlobalValueByName Store
store ModuleInstance { Vector ExportInstance
exports :: Vector ExportInstance
$sel:exports:ModuleInstance :: ModuleInstance -> Vector ExportInstance
exports } Text
name =
    case (ExportInstance -> Bool)
-> Vector ExportInstance -> Maybe ExportInstance
forall a. (a -> Bool) -> Vector a -> Maybe a
Vector.find (\(ExportInstance Text
n ExternalValue
_) -> Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) Vector ExportInstance
exports of
        Just (ExportInstance Text
_ (ExternGlobal Int
addr)) ->
            let globalInst :: GlobalInstance
globalInst = Store -> Vector GlobalInstance
globalInstances Store
store Vector GlobalInstance -> Int -> GlobalInstance
forall a. Vector a -> Int -> a
! Int
addr in
            case GlobalInstance
globalInst of
                GIConst ValueType
_ Value
v -> Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
                GIMut ValueType
_ IORef Value
ref -> IORef Value -> IO Value
forall a. IORef a -> IO a
readIORef IORef Value
ref
        Maybe ExportInstance
_ -> String -> IO Value
forall a. HasCallStack => String -> a
error (String -> IO Value) -> String -> IO Value
forall a b. (a -> b) -> a -> b
$ String
"Function with name " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" was not found in module's exports"