{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Data.LLVM.BitCode.IR.Constants where
import qualified Data.LLVM.BitCode.Assert as Assert
import Data.LLVM.BitCode.Bitstream
import Data.LLVM.BitCode.Match
import Data.LLVM.BitCode.Parse
import Data.LLVM.BitCode.Record
import Text.LLVM.AST
import qualified Codec.Binary.UTF8.String as UTF8 (decode)
import Control.Monad (mplus,mzero,foldM,(<=<), when)
import Control.Monad.ST (runST,ST)
import Data.Array.ST (newArray,readArray,MArray,STUArray)
import Data.Bits (shiftL,shiftR,testBit, Bits)
import Data.LLVM.BitCode.BitString ( pattern Bits' )
import qualified Data.LLVM.BitCode.BitString as BitS
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Word (Word16, Word32,Word64)
#if __GLASGOW_HASKELL__ >= 704
import Data.Array.Unsafe (castSTUArray)
#else
import Data.Array.ST (castSTUArray)
#endif
import Prelude
binopGeneric :: forall a.
(ArithOp -> Typed PValue -> PValue -> a)
-> (BitOp -> Typed PValue -> PValue -> a)
-> Match Field (Maybe Int -> Typed PValue -> PValue -> a)
binopGeneric :: forall a.
(ArithOp -> Typed PValue -> PValue -> a)
-> (BitOp -> Typed PValue -> PValue -> a)
-> Match Field (Maybe Int -> Typed PValue -> PValue -> a)
binopGeneric ArithOp -> Typed PValue -> PValue -> a
aop BitOp -> Typed PValue -> PValue -> a
bop = Match Int (Maybe Int -> Typed PValue -> PValue -> a)
choose Match Int (Maybe Int -> Typed PValue -> PValue -> a)
-> (Field -> Maybe Int)
-> Field
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
where
constant :: (Typed a -> t -> t)
-> (Typed a -> t -> t) -> m (p -> Typed a -> t -> t)
constant Typed a -> t -> t
k Typed a -> t -> t
kf = (p -> Typed a -> t -> t) -> m (p -> Typed a -> t -> t)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((p -> Typed a -> t -> t) -> m (p -> Typed a -> t -> t))
-> (p -> Typed a -> t -> t) -> m (p -> Typed a -> t -> t)
forall a b. (a -> b) -> a -> b
$ \p
_mb Typed a
x t
y ->
case Typed a -> Type
forall a. Typed a -> Type
typedType Typed a
x of
PrimType (FloatType FloatType
_) -> Typed a -> t -> t
kf Typed a
x t
y
Type
_ -> Typed a -> t -> t
k Typed a
x t
y
nuw :: a -> Bool
nuw a
x = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
x Int
0
nsw :: a -> Bool
nsw a
x = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
x Int
1
wrapFlags :: (t -> Typed a -> t -> t)
-> (Bool -> Bool -> t) -> t -> m (Maybe a -> Typed a -> t -> t)
wrapFlags t -> Typed a -> t -> t
i Bool -> Bool -> t
k t
kf = (Maybe a -> Typed a -> t -> t) -> m (Maybe a -> Typed a -> t -> t)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe a -> Typed a -> t -> t)
-> m (Maybe a -> Typed a -> t -> t))
-> (Maybe a -> Typed a -> t -> t)
-> m (Maybe a -> Typed a -> t -> t)
forall a b. (a -> b) -> a -> b
$ \ Maybe a
mb Typed a
x t
y ->
case Typed a -> Type
forall a. Typed a -> Type
typedType Typed a
x of
PrimType (FloatType FloatType
_) -> t -> Typed a -> t -> t
i t
kf Typed a
x t
y
Type
_ ->
case Maybe a
mb of
Maybe a
Nothing -> t -> Typed a -> t -> t
i (Bool -> Bool -> t
k Bool
False Bool
False) Typed a
x t
y
Just a
w -> t -> Typed a -> t -> t
i (Bool -> Bool -> t
k (a -> Bool
forall {a}. Bits a => a -> Bool
nuw a
w) (a -> Bool
forall {a}. Bits a => a -> Bool
nsw a
w)) Typed a
x t
y
exact :: a -> Bool
exact a
x = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
x Int
0
exactFlag :: (t -> Typed a -> t -> t)
-> (Bool -> t) -> t -> m (Maybe a -> Typed a -> t -> t)
exactFlag t -> Typed a -> t -> t
i Bool -> t
k t
kf = (Maybe a -> Typed a -> t -> t) -> m (Maybe a -> Typed a -> t -> t)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe a -> Typed a -> t -> t)
-> m (Maybe a -> Typed a -> t -> t))
-> (Maybe a -> Typed a -> t -> t)
-> m (Maybe a -> Typed a -> t -> t)
forall a b. (a -> b) -> a -> b
$ \ Maybe a
mb Typed a
x t
y ->
case Typed a -> Type
forall a. Typed a -> Type
typedType Typed a
x of
PrimType (FloatType FloatType
_) -> t -> Typed a -> t -> t
i t
kf Typed a
x t
y
Type
_ ->
case Maybe a
mb of
Maybe a
Nothing -> t -> Typed a -> t -> t
i (Bool -> t
k Bool
False) Typed a
x t
y
Just a
w -> t -> Typed a -> t -> t
i (Bool -> t
k (a -> Bool
forall {a}. Bits a => a -> Bool
exact a
w)) Typed a
x t
y
choose :: Match Int (Maybe Int -> Typed PValue -> PValue -> a)
choose :: Match Int (Maybe Int -> Typed PValue -> PValue -> a)
choose Int
0 = (ArithOp -> Typed PValue -> PValue -> a)
-> (Bool -> Bool -> ArithOp)
-> ArithOp
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {a} {t} {t}.
(Monad m, Bits a) =>
(t -> Typed a -> t -> t)
-> (Bool -> Bool -> t) -> t -> m (Maybe a -> Typed a -> t -> t)
wrapFlags ArithOp -> Typed PValue -> PValue -> a
aop Bool -> Bool -> ArithOp
Add ArithOp
FAdd
choose Int
1 = (ArithOp -> Typed PValue -> PValue -> a)
-> (Bool -> Bool -> ArithOp)
-> ArithOp
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {a} {t} {t}.
(Monad m, Bits a) =>
(t -> Typed a -> t -> t)
-> (Bool -> Bool -> t) -> t -> m (Maybe a -> Typed a -> t -> t)
wrapFlags ArithOp -> Typed PValue -> PValue -> a
aop Bool -> Bool -> ArithOp
Sub ArithOp
FSub
choose Int
2 = (ArithOp -> Typed PValue -> PValue -> a)
-> (Bool -> Bool -> ArithOp)
-> ArithOp
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {a} {t} {t}.
(Monad m, Bits a) =>
(t -> Typed a -> t -> t)
-> (Bool -> Bool -> t) -> t -> m (Maybe a -> Typed a -> t -> t)
wrapFlags ArithOp -> Typed PValue -> PValue -> a
aop Bool -> Bool -> ArithOp
Mul ArithOp
FMul
choose Int
3 = (ArithOp -> Typed PValue -> PValue -> a)
-> (Bool -> ArithOp)
-> ArithOp
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {a} {t} {t}.
(Monad m, Bits a) =>
(t -> Typed a -> t -> t)
-> (Bool -> t) -> t -> m (Maybe a -> Typed a -> t -> t)
exactFlag ArithOp -> Typed PValue -> PValue -> a
aop Bool -> ArithOp
UDiv ArithOp
FDiv
choose Int
4 = (ArithOp -> Typed PValue -> PValue -> a)
-> (Bool -> ArithOp)
-> ArithOp
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {a} {t} {t}.
(Monad m, Bits a) =>
(t -> Typed a -> t -> t)
-> (Bool -> t) -> t -> m (Maybe a -> Typed a -> t -> t)
exactFlag ArithOp -> Typed PValue -> PValue -> a
aop Bool -> ArithOp
SDiv ArithOp
FDiv
choose Int
5 = (Typed PValue -> PValue -> a)
-> (Typed PValue -> PValue -> a)
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {t} {p}.
Monad m =>
(Typed a -> t -> t)
-> (Typed a -> t -> t) -> m (p -> Typed a -> t -> t)
constant (ArithOp -> Typed PValue -> PValue -> a
aop ArithOp
URem) (ArithOp -> Typed PValue -> PValue -> a
aop ArithOp
FRem)
choose Int
6 = (Typed PValue -> PValue -> a)
-> (Typed PValue -> PValue -> a)
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {t} {p}.
Monad m =>
(Typed a -> t -> t)
-> (Typed a -> t -> t) -> m (p -> Typed a -> t -> t)
constant (ArithOp -> Typed PValue -> PValue -> a
aop ArithOp
SRem) (ArithOp -> Typed PValue -> PValue -> a
aop ArithOp
FRem)
choose Int
7 = (BitOp -> Typed PValue -> PValue -> a)
-> (Bool -> Bool -> BitOp)
-> BitOp
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {a} {t} {t}.
(Monad m, Bits a) =>
(t -> Typed a -> t -> t)
-> (Bool -> Bool -> t) -> t -> m (Maybe a -> Typed a -> t -> t)
wrapFlags BitOp -> Typed PValue -> PValue -> a
bop Bool -> Bool -> BitOp
Shl ([Char] -> BitOp
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid shl on floating point")
choose Int
8 = (BitOp -> Typed PValue -> PValue -> a)
-> (Bool -> BitOp)
-> BitOp
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {a} {t} {t}.
(Monad m, Bits a) =>
(t -> Typed a -> t -> t)
-> (Bool -> t) -> t -> m (Maybe a -> Typed a -> t -> t)
exactFlag BitOp -> Typed PValue -> PValue -> a
bop Bool -> BitOp
Lshr ([Char] -> BitOp
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid lshr on floating point")
choose Int
9 = (BitOp -> Typed PValue -> PValue -> a)
-> (Bool -> BitOp)
-> BitOp
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {a} {t} {t}.
(Monad m, Bits a) =>
(t -> Typed a -> t -> t)
-> (Bool -> t) -> t -> m (Maybe a -> Typed a -> t -> t)
exactFlag BitOp -> Typed PValue -> PValue -> a
bop Bool -> BitOp
Ashr ([Char] -> BitOp
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid ashr on floating point")
choose Int
10 = (Typed PValue -> PValue -> a)
-> (Typed PValue -> PValue -> a)
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {t} {p}.
Monad m =>
(Typed a -> t -> t)
-> (Typed a -> t -> t) -> m (p -> Typed a -> t -> t)
constant (BitOp -> Typed PValue -> PValue -> a
bop BitOp
And) ([Char] -> Typed PValue -> PValue -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid and on floating point")
choose Int
11 = (Typed PValue -> PValue -> a)
-> (Typed PValue -> PValue -> a)
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {t} {p}.
Monad m =>
(Typed a -> t -> t)
-> (Typed a -> t -> t) -> m (p -> Typed a -> t -> t)
constant (BitOp -> Typed PValue -> PValue -> a
bop BitOp
Or) ([Char] -> Typed PValue -> PValue -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid or on floating point")
choose Int
12 = (Typed PValue -> PValue -> a)
-> (Typed PValue -> PValue -> a)
-> Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall {m :: * -> *} {a} {t} {t} {p}.
Monad m =>
(Typed a -> t -> t)
-> (Typed a -> t -> t) -> m (p -> Typed a -> t -> t)
constant (BitOp -> Typed PValue -> PValue -> a
bop BitOp
Xor) ([Char] -> Typed PValue -> PValue -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid xor on floating point")
choose Int
_ = Maybe (Maybe Int -> Typed PValue -> PValue -> a)
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
binop :: Match Field (Maybe Int -> Typed PValue -> PValue -> PInstr)
binop :: Match Field (Maybe Int -> Typed PValue -> PValue -> PInstr)
binop = (ArithOp -> Typed PValue -> PValue -> PInstr)
-> (BitOp -> Typed PValue -> PValue -> PInstr)
-> Match Field (Maybe Int -> Typed PValue -> PValue -> PInstr)
forall a.
(ArithOp -> Typed PValue -> PValue -> a)
-> (BitOp -> Typed PValue -> PValue -> a)
-> Match Field (Maybe Int -> Typed PValue -> PValue -> a)
binopGeneric ArithOp -> Typed PValue -> PValue -> PInstr
forall lab.
ArithOp -> Typed (Value' lab) -> Value' lab -> Instr' lab
Arith BitOp -> Typed PValue -> PValue -> PInstr
forall lab. BitOp -> Typed (Value' lab) -> Value' lab -> Instr' lab
Bit
binopCE :: Match Field (Maybe Int -> Typed PValue -> PValue -> PValue)
binopCE :: Match Field (Maybe Int -> Typed PValue -> PValue -> PValue)
binopCE = (ArithOp -> Typed PValue -> PValue -> PValue)
-> (BitOp -> Typed PValue -> PValue -> PValue)
-> Match Field (Maybe Int -> Typed PValue -> PValue -> PValue)
forall a.
(ArithOp -> Typed PValue -> PValue -> a)
-> (BitOp -> Typed PValue -> PValue -> a)
-> Match Field (Maybe Int -> Typed PValue -> PValue -> a)
binopGeneric ArithOp -> Typed PValue -> PValue -> PValue
forall {lab}.
ArithOp -> Typed (Value' lab) -> Value' lab -> Value' lab
aop BitOp -> Typed PValue -> PValue -> PValue
forall {lab}.
BitOp -> Typed (Value' lab) -> Value' lab -> Value' lab
bop
where
aop :: ArithOp -> Typed (Value' lab) -> Value' lab -> Value' lab
aop ArithOp
op Typed (Value' lab)
tv Value' lab
v = ConstExpr' lab -> Value' lab
forall lab. ConstExpr' lab -> Value' lab
ValConstExpr (ArithOp -> Typed (Value' lab) -> Value' lab -> ConstExpr' lab
forall lab.
ArithOp -> Typed (Value' lab) -> Value' lab -> ConstExpr' lab
ConstArith ArithOp
op Typed (Value' lab)
tv Value' lab
v)
bop :: BitOp -> Typed (Value' lab) -> Value' lab -> Value' lab
bop BitOp
op Typed (Value' lab)
tv Value' lab
v = ConstExpr' lab -> Value' lab
forall lab. ConstExpr' lab -> Value' lab
ValConstExpr (BitOp -> Typed (Value' lab) -> Value' lab -> ConstExpr' lab
forall lab.
BitOp -> Typed (Value' lab) -> Value' lab -> ConstExpr' lab
ConstBit BitOp
op Typed (Value' lab)
tv Value' lab
v)
fcmpOp :: Match Field FCmpOp
fcmpOp :: Match Field FCmpOp
fcmpOp = Match Int FCmpOp
choose Match Int FCmpOp -> (Field -> Maybe Int) -> Match Field FCmpOp
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
where
choose :: Match Int FCmpOp
choose :: Match Int FCmpOp
choose Int
0 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Ffalse
choose Int
1 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Foeq
choose Int
2 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Fogt
choose Int
3 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Foge
choose Int
4 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Folt
choose Int
5 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Fole
choose Int
6 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Fone
choose Int
7 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Ford
choose Int
8 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Funo
choose Int
9 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Fueq
choose Int
10 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Fugt
choose Int
11 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Fuge
choose Int
12 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Fult
choose Int
13 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Fule
choose Int
14 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Fune
choose Int
15 = FCmpOp -> Maybe FCmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return FCmpOp
Ftrue
choose Int
_ = Maybe FCmpOp
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
icmpOp :: Match Field ICmpOp
icmpOp :: Match Field ICmpOp
icmpOp = Match Int ICmpOp
choose Match Int ICmpOp -> (Field -> Maybe Int) -> Match Field ICmpOp
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
where
choose :: Match Int ICmpOp
choose :: Match Int ICmpOp
choose Int
32 = ICmpOp -> Maybe ICmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ICmpOp
Ieq
choose Int
33 = ICmpOp -> Maybe ICmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ICmpOp
Ine
choose Int
34 = ICmpOp -> Maybe ICmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ICmpOp
Iugt
choose Int
35 = ICmpOp -> Maybe ICmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ICmpOp
Iuge
choose Int
36 = ICmpOp -> Maybe ICmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ICmpOp
Iult
choose Int
37 = ICmpOp -> Maybe ICmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ICmpOp
Iule
choose Int
38 = ICmpOp -> Maybe ICmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ICmpOp
Isgt
choose Int
39 = ICmpOp -> Maybe ICmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ICmpOp
Isge
choose Int
40 = ICmpOp -> Maybe ICmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ICmpOp
Islt
choose Int
41 = ICmpOp -> Maybe ICmpOp
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ICmpOp
Isle
choose Int
_ = Maybe ICmpOp
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
unopGeneric :: forall a.
(UnaryArithOp -> Typed PValue -> a)
-> Match Field (Typed PValue -> a)
unopGeneric :: forall a.
(UnaryArithOp -> Typed PValue -> a)
-> Match Field (Typed PValue -> a)
unopGeneric UnaryArithOp -> Typed PValue -> a
uaop = Match Int (Typed PValue -> a)
choose Match Int (Typed PValue -> a)
-> (Field -> Maybe Int) -> Field -> Maybe (Typed PValue -> a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
where
choose :: Match Int (Typed PValue -> a)
choose :: Match Int (Typed PValue -> a)
choose Int
0 = (Typed PValue -> a) -> Maybe (Typed PValue -> a)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnaryArithOp -> Typed PValue -> a
uaop UnaryArithOp
FNeg)
choose Int
_ = Maybe (Typed PValue -> a)
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
unop :: Match Field (Typed PValue -> PInstr)
unop :: Match Field (Typed PValue -> PInstr)
unop = (UnaryArithOp -> Typed PValue -> PInstr)
-> Match Field (Typed PValue -> PInstr)
forall a.
(UnaryArithOp -> Typed PValue -> a)
-> Match Field (Typed PValue -> a)
unopGeneric UnaryArithOp -> Typed PValue -> PInstr
forall lab. UnaryArithOp -> Typed (Value' lab) -> Instr' lab
UnaryArith
unopCE :: Match Field (Typed PValue -> PValue)
unopCE :: Match Field (Typed PValue -> PValue)
unopCE = (UnaryArithOp -> Typed PValue -> PValue)
-> Match Field (Typed PValue -> PValue)
forall a.
(UnaryArithOp -> Typed PValue -> a)
-> Match Field (Typed PValue -> a)
unopGeneric UnaryArithOp -> Typed PValue -> PValue
forall {lab}. UnaryArithOp -> Typed (Value' lab) -> Value' lab
uaop
where
uaop :: UnaryArithOp -> Typed (Value' lab) -> Value' lab
uaop UnaryArithOp
op Typed (Value' lab)
tv = ConstExpr' lab -> Value' lab
forall lab. ConstExpr' lab -> Value' lab
ValConstExpr (UnaryArithOp -> Typed (Value' lab) -> ConstExpr' lab
forall lab. UnaryArithOp -> Typed (Value' lab) -> ConstExpr' lab
ConstUnaryArith UnaryArithOp
op Typed (Value' lab)
tv)
castOpGeneric :: forall c. (ConvOp -> Maybe c) -> Match Field c
castOpGeneric :: forall c. (ConvOp -> Maybe c) -> Match Field c
castOpGeneric ConvOp -> Maybe c
op = Match Int c
choose Match Int c -> (Field -> Maybe Int) -> Field -> Maybe c
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
where
choose :: Match Int c
choose :: Match Int c
choose Int
0 = ConvOp -> Maybe c
op ConvOp
Trunc
choose Int
1 = ConvOp -> Maybe c
op ConvOp
ZExt
choose Int
2 = ConvOp -> Maybe c
op ConvOp
SExt
choose Int
3 = ConvOp -> Maybe c
op ConvOp
FpToUi
choose Int
4 = ConvOp -> Maybe c
op ConvOp
FpToSi
choose Int
5 = ConvOp -> Maybe c
op ConvOp
UiToFp
choose Int
6 = ConvOp -> Maybe c
op ConvOp
SiToFp
choose Int
7 = ConvOp -> Maybe c
op ConvOp
FpTrunc
choose Int
8 = ConvOp -> Maybe c
op ConvOp
FpExt
choose Int
9 = ConvOp -> Maybe c
op ConvOp
PtrToInt
choose Int
10 = ConvOp -> Maybe c
op ConvOp
IntToPtr
choose Int
11 = ConvOp -> Maybe c
op ConvOp
BitCast
choose Int
_ = Maybe c
forall a. Maybe a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
castOp :: Match Field (Typed PValue -> Type -> PInstr)
castOp :: Match Field (Typed PValue -> Type -> PInstr)
castOp = (ConvOp -> Maybe (Typed PValue -> Type -> PInstr))
-> Match Field (Typed PValue -> Type -> PInstr)
forall c. (ConvOp -> Maybe c) -> Match Field c
castOpGeneric ((Typed PValue -> Type -> PInstr)
-> Maybe (Typed PValue -> Type -> PInstr)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Typed PValue -> Type -> PInstr)
-> Maybe (Typed PValue -> Type -> PInstr))
-> (ConvOp -> Typed PValue -> Type -> PInstr)
-> ConvOp
-> Maybe (Typed PValue -> Type -> PInstr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvOp -> Typed PValue -> Type -> PInstr
forall lab. ConvOp -> Typed (Value' lab) -> Type -> Instr' lab
Conv)
castOpCE :: Match Field (Typed PValue -> Type -> PValue)
castOpCE :: Match Field (Typed PValue -> Type -> PValue)
castOpCE = (ConvOp -> Maybe (Typed PValue -> Type -> PValue))
-> Match Field (Typed PValue -> Type -> PValue)
forall c. (ConvOp -> Maybe c) -> Match Field c
castOpGeneric ConvOp -> Maybe (Typed PValue -> Type -> PValue)
forall {m :: * -> *} {lab}.
Monad m =>
ConvOp -> m (Typed (Value' lab) -> Type -> Value' lab)
op
where
op :: ConvOp -> m (Typed (Value' lab) -> Type -> Value' lab)
op ConvOp
c = (Typed (Value' lab) -> Type -> Value' lab)
-> m (Typed (Value' lab) -> Type -> Value' lab)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (\ Typed (Value' lab)
tv Type
t -> ConstExpr' lab -> Value' lab
forall lab. ConstExpr' lab -> Value' lab
ValConstExpr (ConvOp -> Typed (Value' lab) -> Type -> ConstExpr' lab
forall lab. ConvOp -> Typed (Value' lab) -> Type -> ConstExpr' lab
ConstConv ConvOp
c Typed (Value' lab)
tv Type
t))
type ConstantTable = Map.Map Int (Typed Value)
cstGep :: Match Entry Record
cstGep :: Match Entry Record
cstGep = Int -> Match Record Record
hasRecordCode Int
12 Match Record Record -> Match Entry Record -> Match Entry Record
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Match Entry Record
fromEntry
cstInboundsGep :: Match Entry Record
cstInboundsGep :: Match Entry Record
cstInboundsGep = Int -> Match Record Record
hasRecordCode Int
20 Match Record Record -> Match Entry Record -> Match Entry Record
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Match Entry Record
fromEntry
setCurType :: Int -> Parse Type
setCurType :: Int -> Parse Type
setCurType = Int -> Parse Type
getType'
parseConstantsBlock :: [Entry] -> Parse ()
parseConstantsBlock :: [Entry] -> Parse ()
parseConstantsBlock [Entry]
es = (ValueTable -> Parse [Typed PValue]) -> Parse ()
fixValueTable_ ((ValueTable -> Parse [Typed PValue]) -> Parse ())
-> (ValueTable -> Parse [Typed PValue]) -> Parse ()
forall a b. (a -> b) -> a -> b
$ \ ValueTable
vs' -> do
let curTy :: Parse a
curTy = [Char] -> Parse a
forall a. [Char] -> Parse a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"no current type id set"
(Parse Type
_,[Typed PValue]
vs) <- ((Parse Type, [Typed PValue])
-> Entry -> Parse (Parse Type, [Typed PValue]))
-> (Parse Type, [Typed PValue])
-> [Entry]
-> Parse (Parse Type, [Typed PValue])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (ValueTable
-> (Parse Type, [Typed PValue])
-> Entry
-> Parse (Parse Type, [Typed PValue])
parseConstantEntry ValueTable
vs') (Parse Type
forall {a}. Parse a
curTy,[]) [Entry]
es
[Typed PValue] -> Parse [Typed PValue]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return [Typed PValue]
vs
parseConstantEntry :: ValueTable -> (Parse Type,[Typed PValue]) -> Entry
-> Parse (Parse Type, [Typed PValue])
parseConstantEntry :: ValueTable
-> (Parse Type, [Typed PValue])
-> Entry
-> Parse (Parse Type, [Typed PValue])
parseConstantEntry ValueTable
t (Parse Type
getTy,[Typed PValue]
cs) (Match Entry Record
fromEntry -> Just Record
r) =
[Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CONSTANTS_BLOCK" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ case Record -> Int
recordCode Record
r of
Int
1 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_SETTYPE" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Int
i <- LookupField Int
forall {a}. LookupField a
field Int
0 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parse Type
setCurType Int
i, [Typed PValue]
cs)
Int
2 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_NULL" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- Parse Type
getTy
PValue
val <- Type -> Parse PValue
resolveNull Type
ty
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty PValue
valTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
3 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_UNDEF" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- Parse Type
getTy
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty PValue
forall lab. Value' lab
ValUndefTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
4 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_INTEGER" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type
ty <- Parse Type
getTy
Word64
n <- LookupField Word64
forall {a}. LookupField a
field Int
0 Match Field Word64
signedWord64
let val :: Value' lab
val = Value' lab -> Maybe (Value' lab) -> Value' lab
forall a. a -> Maybe a -> a
fromMaybe (Integer -> Value' lab
forall lab. Integer -> Value' lab
ValInteger (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
n)) (Maybe (Value' lab) -> Value' lab)
-> Maybe (Value' lab) -> Value' lab
forall a b. (a -> b) -> a -> b
$ do
Integer Word32
0 <- Type -> Maybe PrimType
forall (m :: * -> *). MonadPlus m => Type -> m PrimType
elimPrimType Type
ty
Value' lab -> Maybe (Value' lab)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value' lab
forall lab. Bool -> Value' lab
ValBool (Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0))
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty PValue
forall lab. Value' lab
valTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
5 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_WIDE_INTEGER" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- Parse Type
getTy
Integer
n <- Record -> Int -> Parse Integer
parseWideInteger Record
r Int
0
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty (Integer -> PValue
forall lab. Integer -> Value' lab
ValInteger Integer
n)Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
6 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_FLOAT" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- Parse Type
getTy
FloatType
ft <- (PrimType -> Parse FloatType
forall (m :: * -> *). MonadPlus m => PrimType -> m FloatType
elimFloatType (PrimType -> Parse FloatType) -> Parse PrimType -> Parse FloatType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> Parse PrimType
forall (m :: * -> *). MonadPlus m => Type -> m PrimType
elimPrimType Type
ty)
Parse FloatType -> Parse FloatType -> Parse FloatType
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [Char] -> Parse FloatType
forall a. [Char] -> Parse a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expecting a float type"
let build :: (Num a, Bits a) => (a -> PValue) -> Parse (Parse Type, [Typed PValue])
build :: forall a.
(Num a, Bits a) =>
(a -> PValue) -> Parse (Parse Type, [Typed PValue])
build a -> PValue
k = do
PValue
a <- Record -> LookupField PValue
forall a. Record -> LookupField a
parseField Record
r Int
0 ((a -> PValue) -> Maybe a -> Maybe PValue
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> PValue
k (Maybe a -> Maybe PValue)
-> (Field -> Maybe a) -> Field -> Maybe PValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Maybe a
forall a. (Num a, Bits a) => Match Field a
numeric)
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, (Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty (PValue -> Typed PValue) -> PValue -> Typed PValue
forall a b. (a -> b) -> a -> b
$! PValue
a)Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
case FloatType
ft of
FloatType
Float -> (Word32 -> PValue) -> Parse (Parse Type, [Typed PValue])
forall a.
(Num a, Bits a) =>
(a -> PValue) -> Parse (Parse Type, [Typed PValue])
build (Float -> PValue
forall lab. Float -> Value' lab
ValFloat (Float -> PValue) -> (Word32 -> Float) -> Word32 -> PValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Float
castFloat)
FloatType
Double -> (Word64 -> PValue) -> Parse (Parse Type, [Typed PValue])
forall a.
(Num a, Bits a) =>
(a -> PValue) -> Parse (Parse Type, [Typed PValue])
build (Double -> PValue
forall lab. Double -> Value' lab
ValDouble (Double -> PValue) -> (Word64 -> Double) -> Word64 -> PValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
castDouble)
FloatType
X86_fp80 -> Type
-> Record
-> [Typed PValue]
-> Parse Type
-> Parse (Parse Type, [Typed PValue])
fp80build Type
ty Record
r [Typed PValue]
cs Parse Type
getTy
FloatType
_ -> [Char] -> Parse (Parse Type, [Typed PValue])
forall a. HasCallStack => [Char] -> a
error ([Char] -> Parse (Parse Type, [Typed PValue]))
-> [Char] -> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ [Char]
"parseConstantEntry: Unsupported type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FloatType -> [Char]
forall a. Show a => a -> [Char]
show FloatType
ft
Int
7 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_AGGREGATE" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- Parse Type
getTy
[Int]
elems <- Record -> LookupField [Int]
forall a. Record -> LookupField a
parseField Record
r Int
0 ((Field -> Maybe Int) -> Match Field [Int]
forall a. Match Field a -> Match Field [a]
fieldArray Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric)
Parse [Int] -> Parse [Int] -> Parse [Int]
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Record -> Int -> (Field -> Maybe Int) -> Parse [Int]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
0 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
[[Char]]
cxt <- Parse [[Char]]
getContext
let vals :: [Typed PValue]
vals = [HasCallStack => [[Char]] -> Int -> ValueTable -> Typed PValue
[[Char]] -> Int -> ValueTable -> Typed PValue
forwardRef [[Char]]
cxt Int
ix ValueTable
t | Int
ix <- [Int]
elems ]
case Type
ty of
Struct [Type]
_fs ->
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty ([Typed PValue] -> PValue
forall lab. [Typed (Value' lab)] -> Value' lab
ValStruct [Typed PValue]
vals)Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
PackedStruct [Type]
_fs ->
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty ([Typed PValue] -> PValue
forall lab. [Typed (Value' lab)] -> Value' lab
ValPackedStruct [Typed PValue]
vals)Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Array Word64
_n Type
fty ->
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty (Type -> [PValue] -> PValue
forall lab. Type -> [Value' lab] -> Value' lab
ValArray Type
fty ((Typed PValue -> PValue) -> [Typed PValue] -> [PValue]
forall a b. (a -> b) -> [a] -> [b]
map Typed PValue -> PValue
forall a. Typed a -> a
typedValue [Typed PValue]
vals))Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Vector Word64
_n Type
ety -> do
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty (Type -> [PValue] -> PValue
forall lab. Type -> [Value' lab] -> Value' lab
ValVector Type
ety ((Typed PValue -> PValue) -> [Typed PValue] -> [PValue]
forall a b. (a -> b) -> [a] -> [b]
map Typed PValue -> PValue
forall a. Typed a -> a
typedValue [Typed PValue]
vals))Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Type
_ -> (Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty PValue
forall lab. Value' lab
ValUndefTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
8 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_STRING" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type
ty <- Parse Type
getTy
[Word8]
values <- LookupField [Word8]
forall {a}. LookupField a
field Int
0 (Match Field Word8 -> Match Field [Word8]
forall a. Match Field a -> Match Field [a]
fieldArray Match Field Word8
char)
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty ([Word8] -> PValue
forall lab. [Word8] -> Value' lab
ValString [Word8]
values)Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
9 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CSTRING" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- Parse Type
getTy
[Word8]
values <- Record -> LookupField [Word8]
forall a. Record -> LookupField a
parseField Record
r Int
0 (Match Field Word8 -> Match Field [Word8]
forall a. Match Field a -> Match Field [a]
fieldArray (Match Field Word8
fieldChar6 Match Field Word8 -> Match Field Word8 -> Match Field Word8
forall a b. Match a b -> Match a b -> Match a b
||| Match Field Word8
char))
Parse [Word8] -> Parse [Word8] -> Parse [Word8]
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Record -> Int -> Match Field Word8 -> Parse [Word8]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
0 (Match Field Word8
fieldChar6 Match Field Word8 -> Match Field Word8 -> Match Field Word8
forall a b. Match a b -> Match a b -> Match a b
||| Match Field Word8
char)
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty ([Word8] -> PValue
forall lab. [Word8] -> Value' lab
ValString ([Word8]
values [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8
0]))Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
10 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_BINOP" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type
ty <- Parse Type
getTy
Maybe Int -> Typed PValue -> PValue -> PValue
mkInstr <- LookupField (Maybe Int -> Typed PValue -> PValue -> PValue)
forall {a}. LookupField a
field Int
0 Match Field (Maybe Int -> Typed PValue -> PValue -> PValue)
binopCE
Int
lopval <- LookupField Int
forall {a}. LookupField a
field Int
1 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
ropval <- LookupField Int
forall {a}. LookupField a
field Int
2 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
[[Char]]
cxt <- Parse [[Char]]
getContext
let lv :: Typed PValue
lv = HasCallStack => [[Char]] -> Int -> ValueTable -> Typed PValue
[[Char]] -> Int -> ValueTable -> Typed PValue
forwardRef [[Char]]
cxt Int
lopval ValueTable
t
rv :: Typed PValue
rv = HasCallStack => [[Char]] -> Int -> ValueTable -> Typed PValue
[[Char]] -> Int -> ValueTable -> Typed PValue
forwardRef [[Char]]
cxt Int
ropval ValueTable
t
let mbWord :: Maybe Int
mbWord = Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric (Field -> Maybe Int) -> Maybe Field -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Match Record Field
fieldAt Int
3 Record
r
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty (Maybe Int -> Typed PValue -> PValue -> PValue
mkInstr Maybe Int
mbWord Typed PValue
lv (Typed PValue -> PValue
forall a. Typed a -> a
typedValue Typed PValue
rv)) Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
: [Typed PValue]
cs)
Int
11 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_CAST" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type
ty <- Parse Type
getTy
Typed PValue -> Type -> PValue
cast' <- LookupField (Typed PValue -> Type -> PValue)
forall {a}. LookupField a
field Int
0 Match Field (Typed PValue -> Type -> PValue)
castOpCE
Int
opval <- LookupField Int
forall {a}. LookupField a
field Int
2 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
[[Char]]
cxt <- Parse [[Char]]
getContext
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy,Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty (Typed PValue -> Type -> PValue
cast' (HasCallStack => [[Char]] -> Int -> ValueTable -> Typed PValue
[[Char]] -> Int -> ValueTable -> Typed PValue
forwardRef [[Char]]
cxt Int
opval ValueTable
t) Type
ty)Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
12 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_GEP" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- Parse Type
getTy
PValue
v <- CeGepCode -> ValueTable -> Record -> Parse PValue
parseCeGep CeGepCode
CeGepCode12 ValueTable
t Record
r
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy,Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty PValue
vTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
13 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_SELECT" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type
ty <- Parse Type
getTy
Int
ix1 <- LookupField Int
forall {a}. LookupField a
field Int
0 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
ix2 <- LookupField Int
forall {a}. LookupField a
field Int
1 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
ix3 <- LookupField Int
forall {a}. LookupField a
field Int
2 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
[[Char]]
cxt <- Parse [[Char]]
getContext
let ref :: Int -> Typed PValue
ref Int
ix = HasCallStack => [[Char]] -> Int -> ValueTable -> Typed PValue
[[Char]] -> Int -> ValueTable -> Typed PValue
forwardRef [[Char]]
cxt Int
ix ValueTable
t
ce :: ConstExpr' Int
ce = Typed PValue -> Typed PValue -> Typed PValue -> ConstExpr' Int
forall lab.
Typed (Value' lab)
-> Typed (Value' lab) -> Typed (Value' lab) -> ConstExpr' lab
ConstSelect (Int -> Typed PValue
ref Int
ix1) (Int -> Typed PValue
ref Int
ix2) (Int -> Typed PValue
ref Int
ix3)
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty (ConstExpr' Int -> PValue
forall lab. ConstExpr' lab -> Value' lab
ValConstExpr ConstExpr' Int
ce)Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
14 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_EXTRACTELT" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Parse (Parse Type, [Typed PValue])
forall {a}. Parse a
notImplemented
Int
15 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_INSERTELT" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Parse (Parse Type, [Typed PValue])
forall {a}. Parse a
notImplemented
Int
16 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_SHUFFLEVEC" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Parse (Parse Type, [Typed PValue])
forall {a}. Parse a
notImplemented
Int
17 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_CMP" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type
opty <- Int -> Parse Type
getType (Int -> Parse Type) -> Parse Int -> Parse Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
ix0 <- LookupField Int
forall {a}. LookupField a
field Int
1 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
ix1 <- LookupField Int
forall {a}. LookupField a
field Int
2 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
[[Char]]
cxt <- Parse [[Char]]
getContext
let op0 :: Typed PValue
op0 = HasCallStack => [[Char]] -> Int -> ValueTable -> Typed PValue
[[Char]] -> Int -> ValueTable -> Typed PValue
forwardRef [[Char]]
cxt Int
ix0 ValueTable
t
let op1 :: Typed PValue
op1 = HasCallStack => [[Char]] -> Int -> ValueTable -> Typed PValue
[[Char]] -> Int -> ValueTable -> Typed PValue
forwardRef [[Char]]
cxt Int
ix1 ValueTable
t
let isFloat :: Type -> Bool
isFloat = (PrimType -> Bool) -> Type -> Bool
isPrimTypeOf PrimType -> Bool
isFloatingPoint
ConstExpr' Int
cst <- if Type -> Bool
isFloat Type
opty Bool -> Bool -> Bool
|| (Type -> Bool) -> Type -> Bool
isVectorOf Type -> Bool
isFloat Type
opty
then do FCmpOp
op <- LookupField FCmpOp
forall {a}. LookupField a
field Int
3 Match Field FCmpOp
fcmpOp
ConstExpr' Int -> Parse (ConstExpr' Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (FCmpOp -> Typed PValue -> Typed PValue -> ConstExpr' Int
forall lab.
FCmpOp
-> Typed (Value' lab) -> Typed (Value' lab) -> ConstExpr' lab
ConstFCmp FCmpOp
op Typed PValue
op0 Typed PValue
op1)
else do ICmpOp
op <- LookupField ICmpOp
forall {a}. LookupField a
field Int
3 Match Field ICmpOp
icmpOp
ConstExpr' Int -> Parse (ConstExpr' Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (ICmpOp -> Typed PValue -> Typed PValue -> ConstExpr' Int
forall lab.
ICmpOp
-> Typed (Value' lab) -> Typed (Value' lab) -> ConstExpr' lab
ConstICmp ICmpOp
op Typed PValue
op0 Typed PValue
op1)
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType (Word32 -> PrimType
Integer Word32
1)) (ConstExpr' Int -> PValue
forall lab. ConstExpr' lab -> Value' lab
ValConstExpr ConstExpr' Int
cst)Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
18 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_INLINEASM_OLD" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Typed PValue
tv <- InlineAsmCode -> Parse Type -> Record -> Parse (Typed PValue)
parseInlineAsm InlineAsmCode
InlineAsmCode18 Parse Type
getTy Record
r
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Typed PValue
tvTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
19 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_SHUFFLEVEC_EX" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Parse (Parse Type, [Typed PValue])
forall {a}. Parse a
notImplemented
Int
20 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_INBOUNDS_GEP" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- Parse Type
getTy
PValue
v <- CeGepCode -> ValueTable -> Record -> Parse PValue
parseCeGep CeGepCode
CeGepCode20 ValueTable
t Record
r
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy,Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty PValue
vTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
21 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_BLOCKADDRESS" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3) (Parse () -> Parse ()) -> Parse () -> Parse ()
forall a b. (a -> b) -> a -> b
$
[Char] -> Parse ()
forall a. [Char] -> Parse a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid BLOCKADDRESS record (length < 3)"
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type
ty <- Parse Type
getTy
[[Char]]
ctx <- Parse [[Char]]
getContext
Int
valref <- LookupField Int
forall {a}. LookupField a
field Int
1 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
bid <- LookupField Int
forall {a}. LookupField a
field Int
2 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
let ce :: ConstExpr' Int
ce = Typed PValue -> Int -> ConstExpr' Int
forall lab. Typed (Value' lab) -> lab -> ConstExpr' lab
ConstBlockAddr (HasCallStack => [[Char]] -> Int -> ValueTable -> Typed PValue
[[Char]] -> Int -> ValueTable -> Typed PValue
forwardRef [[Char]]
ctx Int
valref ValueTable
t) Int
bid
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty (ConstExpr' Int -> PValue
forall lab. ConstExpr' lab -> Value' lab
ValConstExpr ConstExpr' Int
ce) Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
: [Typed PValue]
cs)
Int
22 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_DATA" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- Parse Type
getTy
PrimType
elemTy <- (Type -> Parse PrimType
forall (m :: * -> *). MonadPlus m => Type -> m PrimType
elimPrimType (Type -> Parse PrimType) -> Parse Type -> Parse PrimType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> Parse Type
forall (m :: * -> *). MonadPlus m => Type -> m Type
elimSequentialType Type
ty)
Parse PrimType -> Parse PrimType -> Parse PrimType
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [Char] -> Parse PrimType
forall a. [Char] -> Parse a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid container type for CST_CODE_DATA"
let build :: (a -> PValue) -> Parse (Parse Type, [Typed PValue])
build a -> PValue
mk = do
[a]
ns <- Record -> Int -> Match Field a -> Parse [a]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
0 Match Field a
forall a. (Num a, Bits a) => Match Field a
numeric
let elems :: [PValue]
elems = (a -> PValue) -> [a] -> [PValue]
forall a b. (a -> b) -> [a] -> [b]
map a -> PValue
mk [a]
ns
val :: PValue
val | Type -> Bool
isArray Type
ty = Type -> [PValue] -> PValue
forall lab. Type -> [Value' lab] -> Value' lab
ValArray (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
elemTy) [PValue]
elems
| Bool
otherwise = Type -> [PValue] -> PValue
forall lab. Type -> [Value' lab] -> Value' lab
ValVector (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
elemTy) [PValue]
elems
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty PValue
val Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
: [Typed PValue]
cs)
case PrimType
elemTy of
Integer Word32
8 -> (Integer -> PValue) -> Parse (Parse Type, [Typed PValue])
forall a.
(Num a, Bits a) =>
(a -> PValue) -> Parse (Parse Type, [Typed PValue])
build Integer -> PValue
forall lab. Integer -> Value' lab
ValInteger
Integer Word32
16 -> (Integer -> PValue) -> Parse (Parse Type, [Typed PValue])
forall a.
(Num a, Bits a) =>
(a -> PValue) -> Parse (Parse Type, [Typed PValue])
build Integer -> PValue
forall lab. Integer -> Value' lab
ValInteger
Integer Word32
32 -> (Integer -> PValue) -> Parse (Parse Type, [Typed PValue])
forall a.
(Num a, Bits a) =>
(a -> PValue) -> Parse (Parse Type, [Typed PValue])
build Integer -> PValue
forall lab. Integer -> Value' lab
ValInteger
Integer Word32
64 -> (Integer -> PValue) -> Parse (Parse Type, [Typed PValue])
forall a.
(Num a, Bits a) =>
(a -> PValue) -> Parse (Parse Type, [Typed PValue])
build Integer -> PValue
forall lab. Integer -> Value' lab
ValInteger
FloatType FloatType
Float -> (Word32 -> PValue) -> Parse (Parse Type, [Typed PValue])
forall a.
(Num a, Bits a) =>
(a -> PValue) -> Parse (Parse Type, [Typed PValue])
build (Float -> PValue
forall lab. Float -> Value' lab
ValFloat (Float -> PValue) -> (Word32 -> Float) -> Word32 -> PValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Float
castFloat)
FloatType FloatType
Double -> (Word64 -> PValue) -> Parse (Parse Type, [Typed PValue])
forall a.
(Num a, Bits a) =>
(a -> PValue) -> Parse (Parse Type, [Typed PValue])
build (Double -> PValue
forall lab. Double -> Value' lab
ValDouble (Double -> PValue) -> (Word64 -> Double) -> Word64 -> PValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
castDouble)
PrimType
x -> [Char] -> PrimType -> Parse (Parse Type, [Typed PValue])
forall (m :: * -> *) a b.
(MonadFail m, Show a) =>
[Char] -> a -> m b
Assert.unknownEntity [Char]
"element type" PrimType
x
Int
23 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_INLINEASM_OLD2" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Typed PValue
tv <- InlineAsmCode -> Parse Type -> Record -> Parse (Typed PValue)
parseInlineAsm InlineAsmCode
InlineAsmCode23 Parse Type
getTy Record
r
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Typed PValue
tvTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
24 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_GEP_WITH_INRANGE_INDEX" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- Parse Type
getTy
PValue
v <- CeGepCode -> ValueTable -> Record -> Parse PValue
parseCeGep CeGepCode
CeGepCode24 ValueTable
t Record
r
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy,Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty PValue
vTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
25 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_CE_UNOP" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type
ty <- Parse Type
getTy
Typed PValue -> PValue
mkInstr <- LookupField (Typed PValue -> PValue)
forall {a}. LookupField a
field Int
0 Match Field (Typed PValue -> PValue)
unopCE
Int
opval <- LookupField Int
forall {a}. LookupField a
field Int
1 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
[[Char]]
cxt <- Parse [[Char]]
getContext
let v :: Typed PValue
v = HasCallStack => [[Char]] -> Int -> ValueTable -> Typed PValue
[[Char]] -> Int -> ValueTable -> Typed PValue
forwardRef [[Char]]
cxt Int
opval ValueTable
t
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty (Typed PValue -> PValue
mkInstr Typed PValue
v) Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
: [Typed PValue]
cs)
Int
26 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_POISON" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Type
ty <- Parse Type
getTy
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty PValue
forall lab. Value' lab
ValPoison Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
: [Typed PValue]
cs)
Int
27 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_DSO_LOCAL_EQUIVALENT" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Parse (Parse Type, [Typed PValue])
forall {a}. Parse a
notImplemented
Int
28 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_INLINEASM_OLD3" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Typed PValue
tv <- InlineAsmCode -> Parse Type -> Record -> Parse (Typed PValue)
parseInlineAsm InlineAsmCode
InlineAsmCode28 Parse Type
getTy Record
r
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Typed PValue
tvTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
29 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_NO_CFI_VALUE" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Parse (Parse Type, [Typed PValue])
forall {a}. Parse a
notImplemented
Int
30 -> [Char]
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a -> Parse a
label [Char]
"CST_CODE_INLINEASM" (Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue]))
-> Parse (Parse Type, [Typed PValue])
-> Parse (Parse Type, [Typed PValue])
forall a b. (a -> b) -> a -> b
$ do
Typed PValue
tv <- InlineAsmCode -> Parse Type -> Record -> Parse (Typed PValue)
parseInlineAsm InlineAsmCode
InlineAsmCode30 Parse Type
getTy Record
r
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Typed PValue
tvTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)
Int
code -> [Char] -> Int -> Parse (Parse Type, [Typed PValue])
forall (m :: * -> *) a b.
(MonadFail m, Show a) =>
[Char] -> a -> m b
Assert.unknownEntity [Char]
"constant record code" Int
code
parseConstantEntry ValueTable
_ (Parse Type, [Typed PValue])
st (Match Entry DefineAbbrev
abbrevDef -> Just DefineAbbrev
_) =
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type, [Typed PValue])
st
parseConstantEntry ValueTable
_ (Parse Type, [Typed PValue])
_ Entry
e =
[Char] -> Parse (Parse Type, [Typed PValue])
forall a. [Char] -> Parse a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"constant block: unexpected: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Entry -> [Char]
forall a. Show a => a -> [Char]
show Entry
e)
data CeGepCode
= CeGepCode12
| CeGepCode20
| CeGepCode24
deriving CeGepCode -> CeGepCode -> Bool
(CeGepCode -> CeGepCode -> Bool)
-> (CeGepCode -> CeGepCode -> Bool) -> Eq CeGepCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CeGepCode -> CeGepCode -> Bool
== :: CeGepCode -> CeGepCode -> Bool
$c/= :: CeGepCode -> CeGepCode -> Bool
/= :: CeGepCode -> CeGepCode -> Bool
Eq
parseCeGep :: CeGepCode -> ValueTable -> Record -> Parse PValue
parseCeGep :: CeGepCode -> ValueTable -> Record -> Parse PValue
parseCeGep CeGepCode
code ValueTable
t Record
r = do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
(Maybe Type
mbBaseTy, Int
ix0) <-
if CeGepCode
code CeGepCode -> CeGepCode -> Bool
forall a. Eq a => a -> a -> Bool
== CeGepCode
CeGepCode24 Bool -> Bool -> Bool
|| Int -> Bool
forall a. Integral a => a -> Bool
odd ([Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r))
then do Type
baseTy <- Int -> Parse Type
getType (Int -> Parse Type) -> Parse Int -> Parse Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Maybe Type, Int) -> Parse (Maybe Type, Int)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
baseTy, Int
1)
else (Maybe Type, Int) -> Parse (Maybe Type, Int)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Type
forall a. Maybe a
Nothing, Int
0)
(Bool
isInbounds, Maybe Word64
mInrangeIdx, Int
ix1) <-
case CeGepCode
code of
CeGepCode
CeGepCode12 -> (Bool, Maybe Word64, Int) -> Parse (Bool, Maybe Word64, Int)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, Maybe Word64
forall a. Maybe a
Nothing, Int
ix0)
CeGepCode
CeGepCode20 -> (Bool, Maybe Word64, Int) -> Parse (Bool, Maybe Word64, Int)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, Maybe Word64
forall a. Maybe a
Nothing, Int
ix0)
CeGepCode
CeGepCode24 -> do
(Word64
flags :: Word64) <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
ix0 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
let inbounds :: Bool
inbounds = Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
flags Int
0
inrangeIdx :: Word64
inrangeIdx = Word64
flags Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
(Bool, Maybe Word64, Int) -> Parse (Bool, Maybe Word64, Int)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
inbounds, Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
inrangeIdx, Int
ix0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
let loop :: Int -> Parse [Typed PValue]
loop Int
n = do
Type
ty <- Int -> Parse Type
getType (Int -> Parse Type) -> Parse Int -> Parse Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
n Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
elt <- LookupField Int
forall {a}. LookupField a
field (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
[Typed PValue]
rest <- Int -> Parse [Typed PValue]
loop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Parse [Typed PValue]
-> Parse [Typed PValue] -> Parse [Typed PValue]
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [Typed PValue] -> Parse [Typed PValue]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return []
[[Char]]
cxt <- Parse [[Char]]
getContext
[Typed PValue] -> Parse [Typed PValue]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty (Typed PValue -> PValue
forall a. Typed a -> a
typedValue (HasCallStack => [[Char]] -> Int -> ValueTable -> Typed PValue
[[Char]] -> Int -> ValueTable -> Typed PValue
forwardRef [[Char]]
cxt Int
elt ValueTable
t)) Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
: [Typed PValue]
rest)
[Typed PValue]
args <- Int -> Parse [Typed PValue]
loop Int
ix1
(Typed PValue
ptr, [Typed PValue]
args') <-
case [Typed PValue]
args of
[] -> [Char] -> Parse (Typed PValue, [Typed PValue])
forall a. [Char] -> Parse a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid constant GEP with no operands"
(Typed PValue
base:[Typed PValue]
args') -> (Typed PValue, [Typed PValue])
-> Parse (Typed PValue, [Typed PValue])
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Typed PValue
base, [Typed PValue]
args')
Type
baseTy <-
case Maybe Type
mbBaseTy of
Just Type
baseTy -> Type -> Parse Type
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
baseTy
Maybe Type
Nothing -> [Char] -> Type -> Parse Type
forall (m :: * -> *).
(MonadFail m, MonadPlus m) =>
[Char] -> Type -> m Type
Assert.elimPtrTo [Char]
"constant GEP not headed by pointer" (Typed PValue -> Type
forall a. Typed a -> Type
typedType Typed PValue
ptr)
PValue -> Parse PValue
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PValue -> Parse PValue) -> PValue -> Parse PValue
forall a b. (a -> b) -> a -> b
$! ConstExpr' Int -> PValue
forall lab. ConstExpr' lab -> Value' lab
ValConstExpr (Bool
-> Maybe Word64
-> Type
-> Typed PValue
-> [Typed PValue]
-> ConstExpr' Int
forall lab.
Bool
-> Maybe Word64
-> Type
-> Typed (Value' lab)
-> [Typed (Value' lab)]
-> ConstExpr' lab
ConstGEP Bool
isInbounds Maybe Word64
mInrangeIdx Type
baseTy Typed PValue
ptr [Typed PValue]
args')
parseWideInteger :: Record -> Int -> Parse Integer
parseWideInteger :: Record -> Int -> Parse Integer
parseWideInteger Record
r Int
idx = do
[Word64]
limbs <- Record -> Int -> Int -> Match Field Word64 -> Parse [Word64]
forall a. Record -> Int -> Int -> Match Field a -> Parse [a]
parseSlice Record
r Int
idx ([Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
idx) Match Field Word64
signedWord64
Integer -> Parse Integer
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Word64 -> Integer -> Integer) -> Integer -> [Word64] -> Integer
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Word64
l Integer
acc -> Integer
acc Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
64 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
l)) Integer
0 [Word64]
limbs)
resolveNull :: Type -> Parse PValue
resolveNull :: Type -> Parse PValue
resolveNull Type
ty = case Type -> NullResult Int
forall lab. Type -> NullResult lab
typeNull Type
ty of
HasNull PValue
nv -> PValue -> Parse PValue
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PValue
nv
ResolveNull Ident
i -> Type -> Parse PValue
resolveNull (Type -> Parse PValue) -> Parse Type -> Parse PValue
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Parse Type
getType' (Int -> Parse Type) -> Parse Int -> Parse Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ident -> Parse Int
getTypeId Ident
i
data InlineAsmCode
= InlineAsmCode18
| InlineAsmCode23
| InlineAsmCode28
| InlineAsmCode30
parseInlineAsm :: InlineAsmCode -> Parse Type -> Record -> Parse (Typed PValue)
parseInlineAsm :: InlineAsmCode -> Parse Type -> Record -> Parse (Typed PValue)
parseInlineAsm InlineAsmCode
code Parse Type
getTy Record
r = do
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
let parseTy :: Parse (Type, Int)
parseTy = do Type
ty <- Int -> Parse Type
getType (Int -> Parse Type) -> Parse Int -> Parse Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
(Type, Int) -> Parse (Type, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Type
forall ident. Type' ident -> Type' ident
PtrTo Type
ty, Int
1)
let useCurTy :: Parse (Type, Int)
useCurTy = do Type
ty <- Parse Type
getTy
(Type, Int) -> Parse (Type, Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
ty, Int
0)
(Type
ty, Int
ix) <- case InlineAsmCode
code of
InlineAsmCode
InlineAsmCode18 -> Parse (Type, Int)
useCurTy
InlineAsmCode
InlineAsmCode23 -> Parse (Type, Int)
useCurTy
InlineAsmCode
InlineAsmCode28 -> Parse (Type, Int)
useCurTy
InlineAsmCode
InlineAsmCode30 -> Parse (Type, Int)
parseTy
Word32
mask <- LookupField Word32
forall {a}. LookupField a
field Int
ix Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
let test :: Int -> Bool
test = Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Word32
mask :: Word32)
hasSideEffects :: Bool
hasSideEffects = Int -> Bool
test Int
0
isAlignStack :: Bool
isAlignStack = Int -> Bool
test Int
1
_asmDialect :: Bool
_asmDialect = Int -> Bool
test Int
2
_canThrow :: Bool
_canThrow = Int -> Bool
test Int
3
Int
asmStrSize <- LookupField Int
forall {a}. LookupField a
field (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
Record -> Int -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> Int -> m ()
Assert.recordSizeGreater Record
r (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
asmStrSize)
Int
constStrSize <- LookupField Int
forall {a}. LookupField a
field (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
asmStrSize) Field -> Maybe Int
forall a. (Num a, Bits a) => Match Field a
numeric
Record -> Int -> Parse ()
forall (m :: * -> *). MonadFail m => Record -> Int -> m ()
Assert.recordSizeGreater Record
r (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
asmStrSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
constStrSize)
[Char]
asmStr <- ([Word8] -> [Char]) -> Parse [Word8] -> Parse [Char]
forall a b. (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> [Char]
UTF8.decode (Parse [Word8] -> Parse [Char]) -> Parse [Word8] -> Parse [Char]
forall a b. (a -> b) -> a -> b
$ Record -> Int -> Int -> Match Field Word8 -> Parse [Word8]
forall a. Record -> Int -> Int -> Match Field a -> Parse [a]
parseSlice Record
r (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
asmStrSize Match Field Word8
char
[Char]
constStr <- ([Word8] -> [Char]) -> Parse [Word8] -> Parse [Char]
forall a b. (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> [Char]
UTF8.decode (Parse [Word8] -> Parse [Char]) -> Parse [Word8] -> Parse [Char]
forall a b. (a -> b) -> a -> b
$ Record -> Int -> Int -> Match Field Word8 -> Parse [Word8]
forall a. Record -> Int -> Int -> Match Field a -> Parse [a]
parseSlice Record
r (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
asmStrSize) Int
constStrSize Match Field Word8
char
let val :: Value' lab
val = Bool -> Bool -> [Char] -> [Char] -> Value' lab
forall lab. Bool -> Bool -> [Char] -> [Char] -> Value' lab
ValAsm Bool
hasSideEffects Bool
isAlignStack [Char]
asmStr [Char]
constStr
Typed PValue -> Parse (Typed PValue)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty PValue
forall lab. Value' lab
val)
castFloat :: Word32 -> Float
castFloat :: Word32 -> Float
castFloat Word32
w = (forall s. ST s Float) -> Float
forall a. (forall s. ST s a) -> a
runST (Word32 -> ST s Float
forall s a b.
(MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) =>
a -> ST s b
cast Word32
w)
castDouble :: Word64 -> Double
castDouble :: Word64 -> Double
castDouble Word64
w = (forall s. ST s Double) -> Double
forall a. (forall s. ST s a) -> a
runST (Word64 -> ST s Double
forall s a b.
(MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) =>
a -> ST s b
cast Word64
w)
cast :: (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s))
=> a -> ST s b
cast :: forall s a b.
(MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) =>
a -> ST s b
cast a
x = do
STUArray s Int a
arr <- (Int, Int) -> a -> ST s (STUArray s Int a)
forall i. Ix i => (i, i) -> a -> ST s (STUArray s i a)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0 :: Int, Int
0) a
x
STUArray s Int b
res <- STUArray s Int a -> ST s (STUArray s Int b)
forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
castSTUArray STUArray s Int a
arr
STUArray s Int b -> Int -> ST s b
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int b
res Int
0
fp80build :: Type -> Record -> [Typed PValue] -> Parse Type
-> Parse (Parse Type, [Typed PValue])
fp80build :: Type
-> Record
-> [Typed PValue]
-> Parse Type
-> Parse (Parse Type, [Typed PValue])
fp80build Type
ty Record
r [Typed PValue]
cs Parse Type
getTy =
do BitString
v1 <- Record -> LookupField BitString
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field BitString
fieldLiteral
BitString
v2 <- Record -> LookupField BitString
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field BitString
fieldLiteral
let
v64_0 :: BitString
v64_0 = NumBits -> BitString -> BitString
BitS.take (Int -> NumBits
Bits' Int
64)
(BitString -> BitString) -> BitString -> BitString
forall a b. (a -> b) -> a -> b
$ NumBits -> BitString -> BitString
BitS.take (Int -> NumBits
Bits' Int
16) BitString
v2 BitString -> BitString -> BitString
`BitS.joinBitString` BitString
v1
v64_1 :: BitString
v64_1 = NumBits -> BitString -> BitString
BitS.drop (Int -> NumBits
Bits' Int
48) BitString
v2
fullexp :: Word16
fullexp :: Word16
fullexp = BitString -> Word16
forall a. (Num a, Bits a) => BitString -> a
BitS.fromBitString (BitString -> Word16) -> BitString -> Word16
forall a b. (a -> b) -> a -> b
$ NumBits -> BitString -> BitString
BitS.take (Int -> NumBits
Bits' Int
16) BitString
v64_1
significnd :: Word64
significnd :: Word64
significnd = BitString -> Word64
forall a. (Num a, Bits a) => BitString -> a
BitS.fromBitString (BitString -> Word64) -> BitString -> Word64
forall a b. (a -> b) -> a -> b
$ BitString
v64_0
fp80Val :: FP80Value
fp80Val = Word16 -> Word64 -> FP80Value
FP80_LongDouble Word16
fullexp Word64
significnd
(Parse Type, [Typed PValue]) -> Parse (Parse Type, [Typed PValue])
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parse Type
getTy, Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed Type
ty (FP80Value -> PValue
forall lab. FP80Value -> Value' lab
ValFP80 FP80Value
fp80Val)Typed PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
cs)