-- | A representation of LLVM constants
module LLVM.AST.Constant where

import LLVM.Prelude

import Data.Bits ((.|.), (.&.), complement, testBit, shiftL)

import LLVM.AST.Type
import LLVM.AST.Name
import LLVM.AST.FloatingPointPredicate (FloatingPointPredicate)
import LLVM.AST.IntegerPredicate (IntegerPredicate)
import LLVM.AST.AddrSpace ( AddrSpace(..) )
import qualified LLVM.AST.Float as F

{- |
<http://llvm.org/docs/LangRef.html#constants>

N.B. - <http://llvm.org/docs/LangRef.html#constant-expressions>

Although constant expressions and instructions have many similarites, there are important
differences - so they're represented using different types in this AST. At the cost of making it
harder to move an code back and forth between being constant and not, this approach embeds more of
the rules of what IR is legal into the Haskell types.
-}
data Constant
    = Int { Constant -> Word32
integerBits :: Word32, Constant -> Integer
integerValue :: Integer }
    | Float { Constant -> SomeFloat
floatValue :: F.SomeFloat }
    | Null { Constant -> Type
constantType :: Type }
    | AggregateZero { constantType :: Type }
    | Struct { Constant -> Maybe Name
structName :: Maybe Name, Constant -> Bool
isPacked :: Bool, Constant -> [Constant]
memberValues :: [ Constant ] }
    | Array { Constant -> Type
memberType :: Type, memberValues :: [ Constant ] }
    | Vector { memberValues :: [ Constant ] }
    | Undef { constantType :: Type }
    | BlockAddress { Constant -> Name
blockAddressFunction :: Name, Constant -> Name
blockAddressBlock :: Name }
    | GlobalReference Type Name
    | TokenNone
    | Add {
        Constant -> Bool
nsw :: Bool,
        Constant -> Bool
nuw :: Bool,
        Constant -> Constant
operand0 :: Constant,
        Constant -> Constant
operand1 :: Constant
      }
    | FAdd {
        operand0 :: Constant,
        operand1 :: Constant
      }
    | Sub {
        nsw :: Bool,
        nuw :: Bool,
        operand0 :: Constant,
        operand1 :: Constant
      }
    | FSub {
        operand0 :: Constant,
        operand1 :: Constant
      }
    | Mul {
        nsw :: Bool,
        nuw :: Bool,
        operand0 :: Constant,
        operand1 :: Constant
      }
    | FMul {
        operand0 :: Constant,
        operand1 :: Constant
      }
    | UDiv {
        Constant -> Bool
exact :: Bool,
        operand0 :: Constant,
        operand1 :: Constant
      }
    | SDiv {
        exact :: Bool,
        operand0 :: Constant,
        operand1 :: Constant
      }
    | FDiv {
        operand0 :: Constant,
        operand1 :: Constant
      }
    | URem {
        operand0 :: Constant,
        operand1 :: Constant
      }
    | SRem {
        operand0 :: Constant,
        operand1 :: Constant
      }
    | FRem {
        operand0 :: Constant,
        operand1 :: Constant
      }
    | Shl {
        nsw :: Bool,
        nuw :: Bool,
        operand0 :: Constant,
        operand1 :: Constant
      }
    | LShr {
        exact :: Bool,
        operand0 :: Constant,
        operand1 :: Constant
      }
    | AShr {
        exact :: Bool,
        operand0 :: Constant,
        operand1 :: Constant
      }
    | And {
        operand0 :: Constant,
        operand1 :: Constant
      }
    | Or {
        operand0 :: Constant,
        operand1 :: Constant
      }
    | Xor {
        operand0 :: Constant,
        operand1 :: Constant
      }
    | GetElementPtr {
        Constant -> Bool
inBounds :: Bool,
        Constant -> Constant
address :: Constant,
        Constant -> [Constant]
indices :: [Constant]
      }
    | Trunc {
        operand0 :: Constant,
        Constant -> Type
type' :: Type
      }
    | ZExt {
        operand0 :: Constant,
        type' :: Type
      }
    | SExt {
        operand0 :: Constant,
        type' :: Type
      }
    | FPToUI {
        operand0 :: Constant,
        type' :: Type
      }
    | FPToSI {
        operand0 :: Constant,
        type' :: Type
      }
    | UIToFP {
        operand0 :: Constant,
        type' :: Type
      }
    | SIToFP {
        operand0 :: Constant,
        type' :: Type
      }
    | FPTrunc {
        operand0 :: Constant,
        type' :: Type
      }
    | FPExt {
        operand0 :: Constant,
        type' :: Type
      }
    | PtrToInt {
        operand0 :: Constant,
        type' :: Type
      }
    | IntToPtr {
        operand0 :: Constant,
        type' :: Type
      }
    | BitCast {
        operand0 :: Constant,
        type' :: Type
      }
    | AddrSpaceCast {
        operand0 :: Constant,
        type' :: Type
      }
    | ICmp {
        Constant -> IntegerPredicate
iPredicate :: IntegerPredicate,
        operand0 :: Constant,
        operand1 :: Constant
      }
    | FCmp {
        Constant -> FloatingPointPredicate
fpPredicate :: FloatingPointPredicate,
        operand0 :: Constant,
        operand1 :: Constant
      }
    | Select {
        Constant -> Constant
condition' :: Constant,
        Constant -> Constant
trueValue :: Constant,
        Constant -> Constant
falseValue :: Constant
      }
    | ExtractElement {
        Constant -> Constant
vector :: Constant,
        Constant -> Constant
index :: Constant
      }
    | InsertElement {
        vector :: Constant,
        Constant -> Constant
element :: Constant,
        index :: Constant
      }
    | ShuffleVector {
        operand0 :: Constant,
        operand1 :: Constant,
        Constant -> Constant
mask :: Constant
      }
    | ExtractValue {
        Constant -> Constant
aggregate :: Constant,
        Constant -> [Word32]
indices' :: [Word32]
      }
    | InsertValue {
        aggregate :: Constant,
        element :: Constant,
        indices' :: [Word32]
      }
    deriving (Constant -> Constant -> Bool
(Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool) -> Eq Constant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Constant -> Constant -> Bool
== :: Constant -> Constant -> Bool
$c/= :: Constant -> Constant -> Bool
/= :: Constant -> Constant -> Bool
Eq, Eq Constant
Eq Constant
-> (Constant -> Constant -> Ordering)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool)
-> (Constant -> Constant -> Constant)
-> (Constant -> Constant -> Constant)
-> Ord Constant
Constant -> Constant -> Bool
Constant -> Constant -> Ordering
Constant -> Constant -> Constant
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Constant -> Constant -> Ordering
compare :: Constant -> Constant -> Ordering
$c< :: Constant -> Constant -> Bool
< :: Constant -> Constant -> Bool
$c<= :: Constant -> Constant -> Bool
<= :: Constant -> Constant -> Bool
$c> :: Constant -> Constant -> Bool
> :: Constant -> Constant -> Bool
$c>= :: Constant -> Constant -> Bool
>= :: Constant -> Constant -> Bool
$cmax :: Constant -> Constant -> Constant
max :: Constant -> Constant -> Constant
$cmin :: Constant -> Constant -> Constant
min :: Constant -> Constant -> Constant
Ord, ReadPrec [Constant]
ReadPrec Constant
Int -> ReadS Constant
ReadS [Constant]
(Int -> ReadS Constant)
-> ReadS [Constant]
-> ReadPrec Constant
-> ReadPrec [Constant]
-> Read Constant
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Constant
readsPrec :: Int -> ReadS Constant
$creadList :: ReadS [Constant]
readList :: ReadS [Constant]
$creadPrec :: ReadPrec Constant
readPrec :: ReadPrec Constant
$creadListPrec :: ReadPrec [Constant]
readListPrec :: ReadPrec [Constant]
Read, Int -> Constant -> ShowS
[Constant] -> ShowS
Constant -> String
(Int -> Constant -> ShowS)
-> (Constant -> String) -> ([Constant] -> ShowS) -> Show Constant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Constant -> ShowS
showsPrec :: Int -> Constant -> ShowS
$cshow :: Constant -> String
show :: Constant -> String
$cshowList :: [Constant] -> ShowS
showList :: [Constant] -> ShowS
Show, Typeable, Typeable Constant
Typeable Constant
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Constant -> c Constant)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Constant)
-> (Constant -> Constr)
-> (Constant -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Constant))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Constant))
-> ((forall b. Data b => b -> b) -> Constant -> Constant)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Constant -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Constant -> r)
-> (forall u. (forall d. Data d => d -> u) -> Constant -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Constant -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Constant -> m Constant)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Constant -> m Constant)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Constant -> m Constant)
-> Data Constant
Constant -> Constr
Constant -> DataType
(forall b. Data b => b -> b) -> Constant -> Constant
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Constant -> u
forall u. (forall d. Data d => d -> u) -> Constant -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constant -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constant -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Constant -> m Constant
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constant -> m Constant
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Constant
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constant -> c Constant
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Constant)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Constant)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constant -> c Constant
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constant -> c Constant
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Constant
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Constant
$ctoConstr :: Constant -> Constr
toConstr :: Constant -> Constr
$cdataTypeOf :: Constant -> DataType
dataTypeOf :: Constant -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Constant)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Constant)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Constant)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Constant)
$cgmapT :: (forall b. Data b => b -> b) -> Constant -> Constant
gmapT :: (forall b. Data b => b -> b) -> Constant -> Constant
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constant -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constant -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constant -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constant -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Constant -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Constant -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Constant -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Constant -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Constant -> m Constant
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Constant -> m Constant
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constant -> m Constant
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constant -> m Constant
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constant -> m Constant
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constant -> m Constant
Data, (forall x. Constant -> Rep Constant x)
-> (forall x. Rep Constant x -> Constant) -> Generic Constant
forall x. Rep Constant x -> Constant
forall x. Constant -> Rep Constant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Constant -> Rep Constant x
from :: forall x. Constant -> Rep Constant x
$cto :: forall x. Rep Constant x -> Constant
to :: forall x. Rep Constant x -> Constant
Generic)


-- | Since LLVM types don't include signedness, there's ambiguity in interpreting
-- an constant as an Integer. The LLVM assembly printer prints integers as signed, but
-- cheats for 1-bit integers and prints them as 'true' or 'false'. That way it circuments the
-- otherwise awkward fact that a twos complement 1-bit number only has the values -1 and 0.
signedIntegerValue :: Constant -> Integer
signedIntegerValue :: Constant -> Integer
signedIntegerValue (Int Word32
nBits' Integer
bits) =
  let nBits :: Int
nBits = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nBits'
  in
    if Integer
bits Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` (Int
nBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) then Integer
bits Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. (-Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
nBits) else Integer
bits
signedIntegerValue Constant
_ = String -> Integer
forall a. HasCallStack => String -> a
error String
"signedIntegerValue is only defined for Int"

-- | This library's conversion from LLVM C++ objects will always produce integer constants
-- as unsigned, so this function in many cases is not necessary. However, nothing's to keep
-- stop direct construction of an 'Int' with a negative 'integerValue'. There's nothing in principle
-- wrong with such a value - it has perfectly good low order bits like any integer, and will be used
-- as such, likely producing the intended result if lowered to C++. If, however one wishes to interpret
-- an 'Int' of unknown provenance as unsigned, then this function will serve.
unsignedIntegerValue :: Constant -> Integer
unsignedIntegerValue :: Constant -> Integer
unsignedIntegerValue (Int Word32
nBits Integer
bits) =
  Integer
bits Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Integer -> Integer
forall a. Bits a => a -> a
complement (-Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nBits)))
unsignedIntegerValue Constant
_ = String -> Integer
forall a. HasCallStack => String -> a
error String
"unsignedIntegerValue is only defined for Int"

-- platform independant sizeof: a gep to the end of a nullptr and some bitcasting.
sizeof :: Word32 -> Type -> Constant
sizeof :: Word32 -> Type -> Constant
sizeof Word32
szBits Type
t = Constant -> Type -> Constant
PtrToInt Constant
szPtr (Word32 -> Type
IntegerType Word32
szBits)
  where
     ptrType :: Type
ptrType = Type -> AddrSpace -> Type
PointerType Type
t (Word32 -> AddrSpace
AddrSpace Word32
0)
     nullPtr :: Constant
nullPtr = Constant -> Type -> Constant
IntToPtr (Word32 -> Integer -> Constant
Int Word32
szBits Integer
0) Type
ptrType
     szPtr :: Constant
szPtr   = Bool -> Constant -> [Constant] -> Constant
GetElementPtr Bool
True Constant
nullPtr [Word32 -> Integer -> Constant
Int Word32
szBits Integer
1]