Commit 6f237fb6 authored by Katharina Brandl's avatar Katharina Brandl
Browse files

finished concrete interpreter

parent 191f1f3d
Pipeline #128439 passed with stages
in 75 minutes and 26 seconds
......@@ -19,5 +19,5 @@ extra-deps:
- git: https://github.com/svenkeidel/husk-scheme/
commit: ca59598b11065eb29a45af7ffca27fc42a49abe5
- git: https://gitlab.rlp.net/plmz/external/haskell-wasm.git
commit: 9e764fb16d7a1f44ce031f491b176096b9a799f4
commit: 91c54c4440977805ef20494278db185545df541a
- knob-0.1.1
......@@ -20,6 +20,7 @@ dependencies:
- primitive
- list-singleton
- prettyprinter
- ieee754
library:
ghc-options: -Wall
......
......@@ -27,6 +27,12 @@ int32 = Value . Wasm.VI32
int64 :: Word64 -> Value
int64 = Value . Wasm.VI64
float32 :: Float -> Value
float32 = Value . Wasm.VF32
float64 :: Double -> Value
float64 = Value . Wasm.VF64
--data DynamicGlobalState = DynamicGlobalState {
-- tableInstances :: Vector TableInst,
-- memInstances :: Vector MemInst
......
......@@ -10,6 +10,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module ConcreteInterpreter where
import Data hiding (I32Eqz)
......@@ -38,23 +39,29 @@ import Data.Concrete.Error
import qualified Data.Function as Function
import Data.Text.Lazy (Text)
import qualified Data.Vector as Vec
import Data.Int
import Data.Word
import Data.Bits
import Language.Wasm.FloatUtils
import Language.Wasm.Interpreter (ModuleInstance)
import Language.Wasm.Interpreter (asInt32,asInt64,asWord32,asWord64,nearest,
floatFloor, doubleFloor, floatCeil, doubleCeil,
floatTrunc, doubleTrunc, zeroAwareMin, zeroAwareMax)
import qualified Language.Wasm.Interpreter as Wasm
import Language.Wasm.Structure hiding (exports, Const, Instruction, Function,Expression,Memory,Table)
import Language.Wasm.Validate (ValidModule)
trap :: IsException (Exc v) v c => c String x
trap = throw <<< exception <<^ Trap
import Numeric.IEEE (copySign)
instance (IsException (Exc Value) Value (ValueT Value c), ArrowChoice c) => IsVal Value (ValueT Value c) where
--trap :: IsException (Exc v) v c => c String x
--trap = throw <<< exception <<^ Trap
instance (ArrowChoice c) => IsVal Value (ValueT Value c) where
type JoinVal y (ValueT Value c) = ()
i32const = proc w32 -> returnA -< int32 w32
i64const = proc w64 -> returnA -< int64 w64
f32const = proc f -> returnA -< float32 f
f64const = proc d -> returnA -< float64 d
iUnOp = proc (bs,op,Value v0) -> case (bs,op,v0) of
(BS32, IClz, Wasm.VI32 v) -> returnA -< int32 $ fromIntegral $ countLeadingZeros v
......@@ -64,25 +71,25 @@ instance (IsException (Exc Value) Value (ValueT Value c), ArrowChoice c) => IsVa
(BS64, ICtz, Wasm.VI64 v) -> returnA -< int64 $ fromIntegral $ countTrailingZeros v
(BS64, IPopcnt, Wasm.VI64 v) -> returnA -< int64 $ fromIntegral $ popCount v
_ -> returnA -< error "iUnOp: cannot apply operator to arguements"
iBinOp _eCont = proc (bs,op,Value v1,Value v2) -> case (bs,op,v1,v2) of
iBinOp eCont = proc (bs,op,x@(Value v1),y@(Value v2)) -> case (bs,op,v1,v2) of
(BS32, IAdd, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< int32 $ val1 + val2
(BS32, ISub, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< int32 $ val1 - val2
(BS32, IMul, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< int32 $ val1 * val2
(BS32, IDivU, Wasm.VI32 val1, Wasm.VI32 val2) ->
if val2 == 0
then trap -< "divide by 0"
then eCont -< (op,x,y)
else returnA -< int32 $ val1 `quot` val2
(BS32, IDivS, Wasm.VI32 val1, Wasm.VI32 val2) ->
if val2 == 0 || (val1 == 0x80000000 && val2 == 0xFFFFFFFF)
then trap -< "divide by 0"
then eCont -< (op,x,y)
else returnA -< int32 $ asWord32 (asInt32 val1 `quot` asInt32 val2)
(BS32, IRemU, Wasm.VI32 val1, Wasm.VI32 val2) ->
if val2 == 0
then trap -< "divide by 0"
then eCont -< (op,x,y)
else returnA -< int32 $ val1 `rem` val2
(BS32, IRemS, Wasm.VI32 val1, Wasm.VI32 val2) ->
if val2 == 0
then trap -< "divide by 0"
then eCont -< (op,x,y)
else returnA -< int32 $ asWord32 (asInt32 val1 `rem` asInt32 val2)
(BS32, IAnd, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< int32 $ val1 .&. val2
(BS32, IOr, Wasm.VI32 val1, Wasm.VI32 val2) -> returnA -< int32 $ val1 .|. val2
......@@ -98,19 +105,19 @@ instance (IsException (Exc Value) Value (ValueT Value c), ArrowChoice c) => IsVa
(BS64, IMul, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< int64 $ val1 * val2
(BS64, IDivU, Wasm.VI64 val1, Wasm.VI64 val2) ->
if val2 == 0
then trap -< "divide by 0"
then eCont -< (op,x,y)
else returnA -< int64 $ val1 `quot` val2
(BS64, IDivS, Wasm.VI64 val1, Wasm.VI64 val2) ->
if val2 == 0 || (val1 == 0x8000000000000000 && val2 == 0xFFFFFFFFFFFFFFFF)
then trap -< "divide by 0"
then eCont -< (op,x,y)
else returnA -< int64 $ asWord64 (asInt64 val1 `quot` asInt64 val2)
(BS64, IRemU, Wasm.VI64 val1, Wasm.VI64 val2) ->
if val2 == 0
then trap -< "divide by 0"
then eCont -< (op,x,y)
else returnA -< int64 $ val1 `rem` val2
(BS64, IRemS, Wasm.VI64 val1, Wasm.VI64 val2) ->
if val2 == 0
then trap -< "divide by 0"
then eCont -< (op,x,y)
else returnA -< int64 $ asWord64 (asInt64 val1 `rem` asInt64 val2)
(BS64, IAnd, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< int64 $ val1 .&. val2
(BS64, IOr, Wasm.VI64 val1, Wasm.VI64 val2) -> returnA -< int64 $ val1 .|. val2
......@@ -165,87 +172,134 @@ instance (IsException (Exc Value) Value (ValueT Value c), ArrowChoice c) => IsVa
(Value (Wasm.VF64 _), F64) -> f -< x
_ -> g -< x
f32const = error "TODO: implement f32const"
f64const = error "TODO: implement f64const"
fUnOp = error "TODO: implement fUnOp"
fBinOp = error "TODO: implement fBinOp"
fRelOp = error "TODO: implement fRelOp"
i32WrapI64 = error "TODO: implement i32WrapI64"
iTruncFU = error "TODO: implement iTruncFU"
iTruncFS = error "TODO: implement iTruncFS"
i64ExtendSI32 = error "TODO: implement i64ExtendSI32"
i64ExtendUI32 = error "TODO: implement i64ExtendUI32"
fConvertIU = error "TODO: implement fConvertIU"
fConvertIS = error "TODO: implement fConvertIS"
f32DemoteF64 = error "TODO: implement f32DemoteF64"
f64PromoteF32 = error "TODO: implement f64PromoteF32"
iReinterpretF = error "TODO: implement iReinterpretF"
fReinterpretI = error "TODO: implement IReinterpretI"
listLookup = error "TODO: implement listLookup"
fUnOp = proc (bs,op,Value v) -> case (bs,op,v) of
(BS32, FAbs, Wasm.VF32 val) -> returnA -< float32 $ abs val
(BS32, FNeg, Wasm.VF32 val) -> returnA -< float32 $ negate val
(BS32, FCeil, Wasm.VF32 val) -> returnA -< float32 $ floatCeil val
(BS32, FFloor, Wasm.VF32 val) -> returnA -< float32 $ floatFloor val
(BS32, FTrunc, Wasm.VF32 val) -> returnA -< float32 $ floatTrunc val
(BS32, FNearest, Wasm.VF32 val) -> returnA -< float32 $ nearest val
(BS32, FSqrt, Wasm.VF32 val) -> returnA -< float32 $ sqrt val
(BS64, FAbs, Wasm.VF64 val) -> returnA -< float64 $ abs val
(BS64, FNeg, Wasm.VF64 val) -> returnA -< float64 $ negate val
(BS64, FCeil, Wasm.VF64 val) -> returnA -< float64 $ doubleCeil val
(BS64, FFloor, Wasm.VF64 val) -> returnA -< float64 $ doubleFloor val
(BS64, FTrunc, Wasm.VF64 val) -> returnA -< float64 $ doubleTrunc val
(BS64, FNearest, Wasm.VF64 val) -> returnA -< float64 $ nearest val
(BS64, FSqrt, Wasm.VF64 val) -> returnA -< float64 $ sqrt val
_ -> returnA -< error "fUnOp: cannot apply operator to arguements"
fBinOp = proc (bs,op,Value v1,Value v2) -> case (bs,op,v1,v2) of
(BS32, FAdd, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< float32 $ val1 + val2
(BS32, FSub, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< float32 $ val1 - val2
(BS32, FMul, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< float32 $ val1 * val2
(BS32, FDiv, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< float32 $ val1 / val2
(BS32, FMin, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< float32 $ zeroAwareMin val1 val2
(BS32, FMax, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< float32 $ zeroAwareMax val1 val2
(BS32, FCopySign, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< float32 $ copySign val1 val2
(BS64, FAdd, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< float64 $ val1 + val2
(BS64, FSub, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< float64 $ val1 - val2
(BS64, FMul, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< float64 $ val1 * val2
(BS64, FDiv, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< float64 $ val1 / val2
(BS64, FMin, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< float64 $ zeroAwareMin val1 val2
(BS64, FMax, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< float64 $ zeroAwareMax val1 val2
(BS64, FCopySign, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< float64 $ copySign val1 val2
_ -> returnA -< error "fBinOp: cannot apply binary operator to given arguments."
fRelOp = proc (bs,op,Value v1,Value v2) -> case (bs,op,v1,v2) of
(BS32, FEq, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< int32 $ if val1 == val2 then 1 else 0
(BS32, FNe, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< int32 $ if val1 /= val2 then 1 else 0
(BS32, FLt, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< int32 $ if val1 < val2 then 1 else 0
(BS32, FGt, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< int32 $ if val1 > val2 then 1 else 0
(BS32, FLe, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< int32 $ if val1 <= val2 then 1 else 0
(BS32, FGe, Wasm.VF32 val1, Wasm.VF32 val2) -> returnA -< int32 $ if val1 >= val2 then 1 else 0
(BS64, FEq, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< int32 $ if val1 == val2 then 1 else 0
(BS64, FNe, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< int32 $ if val1 /= val2 then 1 else 0
(BS64, FLt, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< int32 $ if val1 < val2 then 1 else 0
(BS64, FGt, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< int32 $ if val1 > val2 then 1 else 0
(BS64, FLe, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< int32 $ if val1 <= val2 then 1 else 0
(BS64, FGe, Wasm.VF64 val1, Wasm.VF64 val2) -> returnA -< int32 $ if val1 >= val2 then 1 else 0
_ -> returnA -< error "fRelOp: cannot apply binary operator to given arguments."
i32WrapI64 = proc (Value v) -> case v of
(Wasm.VI64 val) -> returnA -< int32 $ fromIntegral $ val .&. 0xFFFFFFFF
_ -> returnA -< error "i32WrapI64: cannot apply operator to given argument."
iTruncFU eCont = proc (bs1,bs2,Value v) -> case (bs1,bs2,v) of
(BS32, BS32, Wasm.VF32 val) ->
if isNaN val || isInfinite val || val >= 2^32 || val <= -1
then eCont -< (bs1,bs2,Value v)
else returnA -< int32 $ truncate val
(BS32, BS64, Wasm.VF64 val) ->
if isNaN val || isInfinite val || val >= 2^32 || val <= -1
then eCont -< (bs1,bs2,Value v)
else returnA -< int32 $ truncate val
(BS64, BS32, Wasm.VF32 val) ->
if isNaN val || isInfinite val || val >= 2^64 || val <= -1
then eCont -< (bs1,bs2,Value v)
else returnA -< int64 $ truncate val
(BS64, BS64, Wasm.VF64 val) ->
if isNaN val || isInfinite val || val >= 2^64 || val <= -1
then eCont -< (bs1,bs2,Value v)
else returnA -< int64 $ truncate val
_ -> returnA -< error "iTruncFU: cannot apply operator to given argument."
iTruncFS eCont = proc (bs1,bs2,Value v) -> case (bs1,bs2,v) of
(BS32, BS32, Wasm.VF32 val) ->
if isNaN val || isInfinite val || val >= 2^31 || val < -2^31
then eCont -< (bs1,bs2,Value v)
else returnA -< int32 $ truncate val
(BS32, BS64, Wasm.VF64 val) ->
if isNaN val || isInfinite val || val >= 2^31 || val < -2^31
then eCont -< (bs1,bs2,Value v)
else returnA -< int32 $ truncate val
(BS64, BS32, Wasm.VF32 val) ->
if isNaN val || isInfinite val || val >= 2^63 || val < -2^63
then eCont -< (bs1,bs2,Value v)
else returnA -< int64 $ truncate val
(BS64, BS64, Wasm.VF64 val) ->
if isNaN val || isInfinite val || val >= 2^63 || val < -2^63
then eCont -< (bs1,bs2,Value v)
else returnA -< int64 $ truncate val
_ -> returnA -< error "iTruncFS: cannot apply operator to given argument."
i64ExtendSI32 = proc (Value v) -> case v of
(Wasm.VI32 val) -> returnA -< int64 $ asWord64 $ fromIntegral $ asInt32 val
_ -> returnA -< error "i64ExtendSI32: cannot apply operator to given argument."
i64ExtendUI32 = proc (Value v) -> case v of
(Wasm.VI32 val) -> returnA -< int64 $ fromIntegral val
_ -> returnA -< error "i64ExtendUI32: cannot apply operator to given argument."
fConvertIU = proc (bs1,bs2,Value v) -> case (bs1,bs2,v) of
(BS32, BS32, Wasm.VI32 val) -> returnA -< float32 $ realToFrac val
(BS32, BS64, Wasm.VI64 val) -> returnA -< float32 $ realToFrac val
(BS64, BS32, Wasm.VI32 val) -> returnA -< float64 $ realToFrac val
(BS64, BS64, Wasm.VI64 val) -> returnA -< float64 $ realToFrac val
_ -> returnA -< error "fConvertIU: cannot apply operator to given argument."
fConvertIS = proc (bs1,bs2,Value v) -> case (bs1,bs2,v) of
(BS32, BS32, Wasm.VI32 val) -> returnA -< float32 $ realToFrac $ asInt32 val
(BS32, BS64, Wasm.VI64 val) -> returnA -< float32 $ realToFrac $ asInt64 val
(BS64, BS32, Wasm.VI32 val) -> returnA -< float64 $ realToFrac $ asInt32 val
(BS64, BS64, Wasm.VI64 val) -> returnA -< float64 $ realToFrac $ asInt64 val
_ -> returnA -< error "fConvertIS: cannot apply operator to given argument."
f32DemoteF64 = proc (Value v) -> case v of
(Wasm.VF64 val) -> returnA -< float32 $ realToFrac val
_ -> returnA -< error "f32DemoteF64: cannot apply operator to given argument."
f64PromoteF32 = proc (Value v) -> case v of
(Wasm.VF32 val) -> returnA -< float64 $ realToFrac val
_ -> returnA -< error "f64PromoteF32: cannot apply operator to given argument."
iReinterpretF = proc (bs,Value v) -> case (bs,v) of
(BS32, Wasm.VF32 val) -> returnA -< int32 $ floatToWord val
(BS64, Wasm.VF64 val) -> returnA -< int64 $ doubleToWord val
_ -> returnA -< error "iReinterpretF: cannot apply operator to given argument."
fReinterpretI = proc (bs,Value v) -> case (bs,v) of
(BS32, Wasm.VI32 val) -> returnA -< float32 $ wordToFloat val
(BS64, Wasm.VI64 val) -> returnA -< float64 $ wordToDouble val
_ -> returnA -< error "fReinterpretI: cannot apply operator to given argument."
listLookup sCont eCont = proc (Value v,xs,x) -> case v of
(Wasm.VI32 val) -> if (fromIntegral val) < length xs
then sCont -< xs !! (fromIntegral val)
else eCont -< x
_ -> returnA -< error "listLookup: cannot apply operator to given arguments."
instance (ArrowExcept (Exc Value) c) => IsException (Exc Value) Value (ValueT Value c) where
type JoinExc y (ValueT Value c) = ()
exception = arr id
handleException = id
addVal :: Wasm.Value -> Wasm.Value -> Wasm.Value
addVal (Wasm.VI32 v1) (Wasm.VI32 v2) = Wasm.VI32 $ v1 + v2
addVal _ _ = error "addVal: cannot add values. Unexpected types"
--evalNumericInst :: (Instruction Natural) -> [Value] -> Error (Exc Value) Value
--evalNumericInst inst stack =
-- snd $ Trans.run
-- (Generic.evalNumericInst ::
-- ValueT Value
-- (ExceptT (Exc Value)
-- (StackT Value
-- (->))) (Instruction Natural) Value) (AbsList stack,inst)
--
--
----type TransStack = FrameT FrameData Value (StackT Value (->))
----
--evalVariableInst :: (Instruction Natural) -> [Value] -> FrameData -> Vector Value
-- -> GlobalState Value -> ([Value], (Vector Value, (GlobalState Value, ())))
--evalVariableInst inst stack fd locals store =
-- unabs $ Trans.run
-- (Generic.evalVariableInst ::
-- GlobalStateT Value
-- (FrameT FrameData Value
-- (StackT Value
-- (->))) (Instruction Natural) ()) (AbsList stack, (locals, (fd,(store, inst))))
-- where unabs (AbsList x,y) = (x,y)
--
--
--evalParametricInst :: (Instruction Natural) -> [Value] -> ([Value], ())
--evalParametricInst inst stack =
-- unabs $ Trans.run
-- (Generic.evalParametricInst ::
-- ValueT Value
-- (StackT Value
-- (->)) (Instruction Natural) ()) (AbsList stack,inst)
-- where unabs (AbsList x,y) = (x,y)
--
--eval :: [Instruction Natural] -> [Value] -> Generic.LabelArities -> Vector Value -> FrameData ->
-- GlobalState Value -> Int ->
-- ([Value], -- stack
-- Error (Generic.Exc Value)
-- (Vector Value, -- state of FrameT
-- (GlobalState Value, -- state of GlobalStateT
-- ())))
--eval inst stack r locals fd wasmStore currentMem =
-- let ?fixpointAlgorithm = Function.fix in
-- Trans.run
-- (Generic.eval ::
-- ValueT Value
-- (GlobalStateT Value
-- (FrameT FrameData Value
-- (ReaderT Generic.LabelArities
-- (ExceptT (Generic.Exc Value)
-- (StackT Value
-- (->)))))) [Instruction Natural] ()) (stack,(r,(locals,(fd,(wasmStore,(currentMem,inst))))))
type Result = (Error
[Char]
(JoinVector Value,
......@@ -287,54 +341,3 @@ instantiateConcrete :: ValidModule -> IO (Either String (ModuleInstance, StaticG
instantiateConcrete valMod = instantiate valMod Value toMem TableInst
where
toMem size lst = MemInst size (Vec.fromList lst)
-- res <- Wasm.instantiate emptyStore emptyImports valMod
-- case res of
-- Right (modInst, store) -> do
-- wasmStore <- storeToGlobalState store
-- return $ Right $ (modInst, wasmStore)
-- Left e -> return $ Left e
--
-- where
-- storeToGlobalState (Wasm.Store funcI tableI memI globalI) = do
-- let funcs = generate $ Vec.mapM convertFuncInst funcI
-- mems <- Vec.mapM convertMem memI
-- globs <- Vec.mapM convertGlobals globalI
-- return $ GlobalState funcs --(Vec.map convertFuncs funcI)
-- (Vec.map TableInst tableI)
-- mems
-- globs
--
-- convertMem (Wasm.MemoryInstance (Limit _ n) mem) = do
-- memStore <- readIORef mem
-- size <- ByteArray.getSizeofMutableByteArray memStore
-- list <- sequence $ map (\x -> ByteArray.readByteArray memStore x) [0 .. (size-1)]
-- let sizeConverted = fmap fromIntegral n
-- return $ MemInst sizeConverted $ Vec.fromList list
--
-- convertGlobals (Wasm.GIConst _ v) = return $ GlobInst Const (Value v)
-- convertGlobals (Wasm.GIMut _ v) = do
-- val <- readIORef v
-- return $ GlobInst Mutable (Value val)
-- Conversion functions copied from https://github.com/SPY/haskell-wasm/blob/master/src/Language/Wasm/Interpreter.hs
asInt32 :: Word32 -> Int32
asInt32 w =
if w < 0x80000000
then fromIntegral w
else -1 * fromIntegral (0xFFFFFFFF - w + 1)
asInt64 :: Word64 -> Int64
asInt64 w =
if w < 0x8000000000000000
then fromIntegral w
else -1 * fromIntegral (0xFFFFFFFFFFFFFFFF - w + 1)
asWord32 :: Int32 -> Word32
asWord32 i
| i >= 0 = fromIntegral i
| otherwise = 0xFFFFFFFF - fromIntegral (abs i) + 1
asWord64 :: Int64 -> Word64
asWord64 i
| i >= 0 = fromIntegral i
| otherwise = 0xFFFFFFFFFFFFFFFF - fromIntegral (abs i) + 1
......@@ -135,8 +135,8 @@ class Show v => IsVal v c | c -> v where
fBinOp :: c (BitSize, FBinOp, v, v) v
fRelOp :: c (BitSize, FRelOp, v, v) v
i32WrapI64 :: c v v
iTruncFU :: c (BitSize, BitSize, v) (Maybe v)
iTruncFS :: c (BitSize, BitSize, v) (Maybe v)
iTruncFU :: c (BitSize, BitSize, v) v -> c (BitSize, BitSize, v) v
iTruncFS :: c (BitSize, BitSize, v) v -> c (BitSize, BitSize, v) v
i64ExtendSI32 :: c v v
i64ExtendUI32 :: c v v
fConvertIU :: c (BitSize, BitSize, v) v
......@@ -600,16 +600,14 @@ evalNumericInst = proc i -> case i of
i32WrapI64 -< v
ITruncFU bs1 bs2 _ -> do
v <- pop -< ()
res <- iTruncFU -< (bs1, bs2, v)
case res of
Just v' -> returnA -< v'
Nothing -> throw <<< exception -< Trap $ printf "Truncation operator from %s to %s failed on %s" (show bs1) (show bs2) (show v)
iTruncFU
(proc (bs1,bs2,v) -> throw <<< exception -< Trap $ printf "Truncation operator from %s to %s failed on %s" (show bs1) (show bs2) (show v))
-< (bs1,bs2,v)
ITruncFS bs1 bs2 _ -> do
v <- pop -< ()
res <- iTruncFS -< (bs1, bs2, v)
case res of
Just v' -> returnA -< v'
Nothing -> throw <<< exception -< Trap $ printf "Truncation operator from %s to %s failed on %s" (show bs1) (show bs2) (show v)
iTruncFS
(proc (bs1,bs2,v) -> throw <<< exception -< Trap $ printf "Truncation operator from %s to %s failed on %s" (show bs1) (show bs2) (show v))
-< (bs1,bs2,v)
I64ExtendSI32 _ -> do
v <- pop -< ()
i64ExtendSI32 -< v
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment