{-# LANGUAGE RecordWildCards #-}
module LLVM.AST.Typed (
Typed(..),
getElementType,
getElementPtrType,
extractValueType,
) where
import LLVM.Prelude
import LLVM.AST
import LLVM.AST.Global
import LLVM.AST.Type
import qualified LLVM.AST.Constant as C
import qualified LLVM.AST.Float as F
class Typed a where
typeOf :: a -> Type
instance Typed Operand where
typeOf :: Operand -> Type
typeOf (LocalReference t :: Type
t _) = Type
t
typeOf (ConstantOperand c :: Constant
c) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
c
typeOf _ = Type
MetadataType
instance Typed CallableOperand where
typeOf :: CallableOperand -> Type
typeOf (Right op :: Operand
op) = Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
op
typeOf (Left _) = [Char] -> Type
forall a. HasCallStack => [Char] -> a
error "typeOf inline assembler is not defined. (Malformed AST)"
instance Typed C.Constant where
typeOf :: Constant -> Type
typeOf (C.Int bits :: Word32
bits _) = Word32 -> Type
IntegerType Word32
bits
typeOf (C.Float t :: SomeFloat
t) = SomeFloat -> Type
forall a. Typed a => a -> Type
typeOf SomeFloat
t
typeOf (C.Null t :: Type
t) = Type
t
typeOf (C.AggregateZero t :: Type
t) = Type
t
typeOf (C.Struct {..}) = Bool -> [Type] -> Type
StructureType Bool
isPacked ((Constant -> Type) -> [Constant] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Constant -> Type
forall a. Typed a => a -> Type
typeOf [Constant]
memberValues)
typeOf (C.Array {..}) = Word64 -> Type -> Type
ArrayType (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [Constant] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Constant]
memberValues) Type
memberType
typeOf (C.Vector {..}) = Word32 -> Type -> Type
VectorType (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Constant] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Constant]
memberValues) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
case [Constant]
memberValues of
[] -> [Char] -> Type
forall a. HasCallStack => [Char] -> a
error "Vectors of size zero are not allowed. (Malformed AST)"
(x :: Constant
x:_) -> Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
x
typeOf (C.Undef t :: Type
t) = Type
t
typeOf (C.BlockAddress {..}) = Type -> Type
ptr Type
i8
typeOf (C.GlobalReference t :: Type
t _) = Type
t
typeOf (C.Add {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.FAdd {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.FDiv {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.FRem {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.Sub {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.FSub {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.Mul {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.FMul {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.UDiv {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.SDiv {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.URem {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.SRem {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.Shl {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.LShr {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.AShr {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.And {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.Or {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.Xor {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0
typeOf (C.GetElementPtr {..}) = Type -> [Constant] -> Type
getElementPtrType (Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
address) [Constant]
indices
typeOf (C.Trunc {..}) = Type
type'
typeOf (C.ZExt {..}) = Type
type'
typeOf (C.SExt {..}) = Type
type'
typeOf (C.FPToUI {..}) = Type
type'
typeOf (C.FPToSI {..}) = Type
type'
typeOf (C.UIToFP {..}) = Type
type'
typeOf (C.SIToFP {..}) = Type
type'
typeOf (C.FPTrunc {..}) = Type
type'
typeOf (C.FPExt {..}) = Type
type'
typeOf (C.PtrToInt {..}) = Type
type'
typeOf (C.IntToPtr {..}) = Type
type'
typeOf (C.BitCast {..}) = Type
type'
typeOf (C.ICmp {..}) = case (Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0) of
(VectorType n :: Word32
n _) -> Word32 -> Type -> Type
VectorType Word32
n Type
i1
_ -> Type
i1
typeOf (C.FCmp {..}) = case (Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0) of
(VectorType n :: Word32
n _) -> Word32 -> Type -> Type
VectorType Word32
n Type
i1
_ -> Type
i1
typeOf (C.Select {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
trueValue
typeOf (C.ExtractElement {..}) = case Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
vector of
(VectorType _ t :: Type
t) -> Type
t
_ -> [Char] -> Type
forall a. HasCallStack => [Char] -> a
error "The first operand of an extractelement instruction is a value of vector type. (Malformed AST)"
typeOf (C.InsertElement {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
vector
typeOf (C.ShuffleVector {..}) = case (Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
operand0, Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
mask) of
(VectorType _ t :: Type
t, VectorType m :: Word32
m _) -> Word32 -> Type -> Type
VectorType Word32
m Type
t
_ -> [Char] -> Type
forall a. HasCallStack => [Char] -> a
error "The first operand of an shufflevector instruction is a value of vector type. (Malformed AST)"
typeOf (C.ExtractValue {..}) = [Word32] -> Type -> Type
extractValueType [Word32]
indices' (Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
aggregate)
typeOf (C.InsertValue {..}) = Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
aggregate
typeOf (Constant
C.TokenNone) = Type
TokenType
typeOf (C.AddrSpaceCast {..}) = Type
type'
getElementPtrType :: Type -> [C.Constant] -> Type
getElementPtrType :: Type -> [Constant] -> Type
getElementPtrType ty :: Type
ty [] = Type -> Type
ptr Type
ty
getElementPtrType (PointerType ty :: Type
ty _) (_:is :: [Constant]
is) = Type -> [Constant] -> Type
getElementPtrType Type
ty [Constant]
is
getElementPtrType (StructureType _ elTys :: [Type]
elTys) (C.Int 32 val :: Integer
val:is :: [Constant]
is) =
Type -> [Constant] -> Type
getElementPtrType ([Type]
elTys [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
val) [Constant]
is
getElementPtrType (VectorType _ elTy :: Type
elTy) (_:is :: [Constant]
is) = Type -> [Constant] -> Type
getElementPtrType Type
elTy [Constant]
is
getElementPtrType (ArrayType _ elTy :: Type
elTy) (_:is :: [Constant]
is) = Type -> [Constant] -> Type
getElementPtrType Type
elTy [Constant]
is
getElementPtrType _ _ = [Char] -> Type
forall a. HasCallStack => [Char] -> a
error "Expecting aggregate type. (Malformed AST)"
getElementType :: Type -> Type
getElementType :: Type -> Type
getElementType (PointerType t :: Type
t _) = Type
t
getElementType _ = [Char] -> Type
forall a. HasCallStack => [Char] -> a
error ([Char] -> Type) -> [Char] -> Type
forall a b. (a -> b) -> a -> b
$ "Expecting pointer type. (Malformed AST)"
extractValueType :: [Word32] -> Type -> Type
[] ty :: Type
ty = Type
ty
extractValueType (i :: Word32
i : is :: [Word32]
is) (ArrayType numEls :: Word64
numEls elTy :: Type
elTy)
| Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
numEls = [Word32] -> Type -> Type
extractValueType [Word32]
is Type
elTy
| Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
numEls = [Char] -> Type
forall a. HasCallStack => [Char] -> a
error "Expecting valid index into array type. (Malformed AST)"
extractValueType (i :: Word32
i : is :: [Word32]
is) (StructureType _ elTys :: [Type]
elTys)
| Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
elTys = [Word32] -> Type -> Type
extractValueType [Word32]
is ([Type]
elTys [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i)
| Bool
otherwise = [Char] -> Type
forall a. HasCallStack => [Char] -> a
error "Expecting valid index into structure type. (Malformed AST)"
extractValueType _ _ = [Char] -> Type
forall a. HasCallStack => [Char] -> a
error "Expecting vector type. (Malformed AST)"
instance Typed F.SomeFloat where
typeOf :: SomeFloat -> Type
typeOf (F.Half _) = FloatingPointType -> Type
FloatingPointType FloatingPointType
HalfFP
typeOf (F.Single _) = FloatingPointType -> Type
FloatingPointType FloatingPointType
FloatFP
typeOf (F.Double _) = FloatingPointType -> Type
FloatingPointType FloatingPointType
DoubleFP
typeOf (F.Quadruple _ _) = FloatingPointType -> Type
FloatingPointType FloatingPointType
FP128FP
typeOf (F.X86_FP80 _ _) = FloatingPointType -> Type
FloatingPointType FloatingPointType
X86_FP80FP
typeOf (F.PPC_FP128 _ _) = FloatingPointType -> Type
FloatingPointType FloatingPointType
PPC_FP128FP
instance Typed Global where
typeOf :: Global -> Type
typeOf (GlobalVariable {..}) = Type
type'
typeOf (GlobalAlias {..}) = Type
type'
typeOf (Function {..}) = let (params :: [Parameter]
params, isVarArg :: Bool
isVarArg) = ([Parameter], Bool)
parameters
in Type -> [Type] -> Bool -> Type
FunctionType Type
returnType ((Parameter -> Type) -> [Parameter] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Parameter -> Type
forall a. Typed a => a -> Type
typeOf [Parameter]
params) Bool
isVarArg
instance Typed Parameter where
typeOf :: Parameter -> Type
typeOf (Parameter t :: Type
t _ _) = Type
t