{-# LANGUAGE FlexibleContexts #-}

module LLVM.IRBuilder.Instruction where

import Prelude hiding (and, or, pred)

import Control.Monad.State (gets)
import qualified Data.Map.Lazy as Map
import Data.Word
import Data.Char (ord)

import LLVM.AST hiding (args, dests)
import LLVM.AST.Type as AST
import LLVM.AST.Typed
import LLVM.AST.ParameterAttribute
import qualified LLVM.AST as AST
import qualified LLVM.AST.CallingConvention as CC
import qualified LLVM.AST.Constant as C
import qualified LLVM.AST.IntegerPredicate as IP
import qualified LLVM.AST.FloatingPointPredicate as FP

import LLVM.AST.Global
import LLVM.AST.Linkage

import LLVM.IRBuilder.Monad
import LLVM.IRBuilder.Module

-- | See <https://llvm.org/docs/LangRef.html#fadd-instruction reference>.
fadd :: MonadIRBuilder m => Operand -> Operand -> m Operand
fadd :: Operand -> Operand -> m Operand
fadd a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ FastMathFlags
-> Operand -> Operand -> InstructionMetadata -> Instruction
FAdd FastMathFlags
noFastMathFlags Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#fmul-instruction reference>.
fmul :: MonadIRBuilder m => Operand -> Operand -> m Operand
fmul :: Operand -> Operand -> m Operand
fmul a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ FastMathFlags
-> Operand -> Operand -> InstructionMetadata -> Instruction
FMul FastMathFlags
noFastMathFlags Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#fsub-instruction reference>.
fsub :: MonadIRBuilder m => Operand -> Operand -> m Operand
fsub :: Operand -> Operand -> m Operand
fsub a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ FastMathFlags
-> Operand -> Operand -> InstructionMetadata -> Instruction
FSub FastMathFlags
noFastMathFlags Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#fdiv-instruction reference>.
fdiv :: MonadIRBuilder m => Operand -> Operand -> m Operand
fdiv :: Operand -> Operand -> m Operand
fdiv a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ FastMathFlags
-> Operand -> Operand -> InstructionMetadata -> Instruction
FDiv FastMathFlags
noFastMathFlags Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#frem-instruction reference>.
frem :: MonadIRBuilder m => Operand -> Operand -> m Operand
frem :: Operand -> Operand -> m Operand
frem a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ FastMathFlags
-> Operand -> Operand -> InstructionMetadata -> Instruction
FRem FastMathFlags
noFastMathFlags Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#add-instruction reference>.
add :: MonadIRBuilder m => Operand -> Operand -> m Operand
add :: Operand -> Operand -> m Operand
add a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool -> Operand -> Operand -> InstructionMetadata -> Instruction
Add Bool
False Bool
False Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#mul-instruction reference>.
mul :: MonadIRBuilder m => Operand -> Operand -> m Operand
mul :: Operand -> Operand -> m Operand
mul a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool -> Operand -> Operand -> InstructionMetadata -> Instruction
Mul Bool
False Bool
False Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#sub-instruction reference>.
sub :: MonadIRBuilder m => Operand -> Operand -> m Operand
sub :: Operand -> Operand -> m Operand
sub a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool -> Operand -> Operand -> InstructionMetadata -> Instruction
Sub Bool
False Bool
False Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#udiv-instruction reference>.
udiv :: MonadIRBuilder m => Operand -> Operand -> m Operand
udiv :: Operand -> Operand -> m Operand
udiv a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Bool -> Operand -> Operand -> InstructionMetadata -> Instruction
UDiv Bool
False Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#sdiv-instruction reference>.
sdiv :: MonadIRBuilder m => Operand -> Operand -> m Operand
sdiv :: Operand -> Operand -> m Operand
sdiv a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Bool -> Operand -> Operand -> InstructionMetadata -> Instruction
SDiv Bool
False Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#urem-instruction reference>.
urem :: MonadIRBuilder m => Operand -> Operand -> m Operand
urem :: Operand -> Operand -> m Operand
urem a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> InstructionMetadata -> Instruction
URem Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#srem-instruction reference>.
srem :: MonadIRBuilder m => Operand -> Operand -> m Operand
srem :: Operand -> Operand -> m Operand
srem a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> InstructionMetadata -> Instruction
SRem Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#shl-instruction reference>.
shl :: MonadIRBuilder m => Operand -> Operand -> m Operand
shl :: Operand -> Operand -> m Operand
shl a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool -> Operand -> Operand -> InstructionMetadata -> Instruction
Shl Bool
False Bool
False Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#lshl-instruction reference>.
lshr :: MonadIRBuilder m => Operand -> Operand -> m Operand
lshr :: Operand -> Operand -> m Operand
lshr a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Bool -> Operand -> Operand -> InstructionMetadata -> Instruction
LShr Bool
True Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#ashl-instruction reference>.
ashr :: MonadIRBuilder m => Operand -> Operand -> m Operand
ashr :: Operand -> Operand -> m Operand
ashr a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Bool -> Operand -> Operand -> InstructionMetadata -> Instruction
AShr Bool
True Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#and-instruction reference>.
and :: MonadIRBuilder m => Operand -> Operand -> m Operand
and :: Operand -> Operand -> m Operand
and a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> InstructionMetadata -> Instruction
And Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#or-instruction reference>.
or :: MonadIRBuilder m => Operand -> Operand -> m Operand
or :: Operand -> Operand -> m Operand
or a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> InstructionMetadata -> Instruction
Or Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#xor-instruction reference>.
xor :: MonadIRBuilder m => Operand -> Operand -> m Operand
xor :: Operand -> Operand -> m Operand
xor a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> InstructionMetadata -> Instruction
Xor Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#alloca-instruction reference>.
alloca :: MonadIRBuilder m => Type -> Maybe Operand -> Word32 -> m Operand
alloca :: Type -> Maybe Operand -> Word32 -> m Operand
alloca ty :: Type
ty count :: Maybe Operand
count align :: Word32
align = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Type -> Type
ptr Type
ty) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Type
-> Maybe Operand -> Word32 -> InstructionMetadata -> Instruction
Alloca Type
ty Maybe Operand
count Word32
align []

-- | See <https://llvm.org/docs/LangRef.html#load-instruction reference>.
load :: MonadIRBuilder m => Operand -> Word32 -> m Operand
load :: Operand -> Word32 -> m Operand
load a :: Operand
a align :: Word32
align = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
retty (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Bool
-> Operand
-> Maybe Atomicity
-> Word32
-> InstructionMetadata
-> Instruction
Load Bool
False Operand
a Maybe Atomicity
forall a. Maybe a
Nothing Word32
align []
  where
    retty :: Type
retty = case Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a of
      PointerType ty :: Type
ty _ -> Type
ty
      _ -> [Char] -> Type
forall a. HasCallStack => [Char] -> a
error "Cannot load non-pointer (Malformed AST)."

-- | See <https://llvm.org/docs/LangRef.html#store-instruction reference>.
store :: MonadIRBuilder m => Operand -> Word32 -> Operand -> m ()
store :: Operand -> Word32 -> Operand -> m ()
store addr :: Operand
addr align :: Word32
align val :: Operand
val = Instruction -> m ()
forall (m :: * -> *). MonadIRBuilder m => Instruction -> m ()
emitInstrVoid (Instruction -> m ()) -> Instruction -> m ()
forall a b. (a -> b) -> a -> b
$ Bool
-> Operand
-> Operand
-> Maybe Atomicity
-> Word32
-> InstructionMetadata
-> Instruction
Store Bool
False Operand
addr Operand
val Maybe Atomicity
forall a. Maybe a
Nothing Word32
align []

-- | Emit the @getelementptr@ instruction.
-- See <https://llvm.org/docs/LangRef.html#getelementptr-instruction reference>.
gep :: (MonadIRBuilder m, MonadModuleBuilder m) => Operand -> [Operand] -> m Operand
gep :: Operand -> [Operand] -> m Operand
gep addr :: Operand
addr is :: [Operand]
is = do
  Type
ty <- Type -> [Operand] -> m Type
forall (m :: * -> *).
MonadModuleBuilder m =>
Type -> [Operand] -> m Type
gepType (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
addr) [Operand]
is
  Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
ty (Bool -> Operand -> [Operand] -> InstructionMetadata -> Instruction
GetElementPtr Bool
False Operand
addr [Operand]
is [])
  where
    -- TODO: Perhaps use the function from llvm-hs-pretty (https://github.com/llvm-hs/llvm-hs-pretty/blob/master/src/LLVM/Typed.hs)
    gepType :: MonadModuleBuilder m => Type -> [Operand] -> m Type
    gepType :: Type -> [Operand] -> m Type
gepType ty :: Type
ty [] = Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Type
ptr Type
ty)
    gepType (PointerType ty :: Type
ty _) (_:is' :: [Operand]
is') = Type -> [Operand] -> m Type
forall (m :: * -> *).
MonadModuleBuilder m =>
Type -> [Operand] -> m Type
gepType Type
ty [Operand]
is'
    gepType (StructureType _ elTys :: [Type]
elTys) (ConstantOperand (C.Int 32 val :: Integer
val):is' :: [Operand]
is') =
      Type -> [Operand] -> m Type
forall (m :: * -> *).
MonadModuleBuilder m =>
Type -> [Operand] -> m Type
gepType ([Type]
elTys [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
val) [Operand]
is'
    gepType (StructureType _ _) (i :: Operand
i:_) = [Char] -> m Type
forall a. HasCallStack => [Char] -> a
error ([Char] -> m Type) -> [Char] -> m Type
forall a b. (a -> b) -> a -> b
$ "gep: Indices into structures should be 32-bit constants. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Operand -> [Char]
forall a. Show a => a -> [Char]
show Operand
i
    gepType (VectorType _ elTy :: Type
elTy) (_:is' :: [Operand]
is') = Type -> [Operand] -> m Type
forall (m :: * -> *).
MonadModuleBuilder m =>
Type -> [Operand] -> m Type
gepType Type
elTy [Operand]
is'
    gepType (ArrayType _ elTy :: Type
elTy) (_:is' :: [Operand]
is') = Type -> [Operand] -> m Type
forall (m :: * -> *).
MonadModuleBuilder m =>
Type -> [Operand] -> m Type
gepType Type
elTy [Operand]
is'
    gepType (NamedTypeReference nm :: Name
nm) is' :: [Operand]
is' = do
      Maybe Type
mayTy <- State ModuleBuilderState (Maybe Type) -> m (Maybe Type)
forall (m :: * -> *) a.
MonadModuleBuilder m =>
State ModuleBuilderState a -> m a
liftModuleState ((ModuleBuilderState -> Maybe Type)
-> State ModuleBuilderState (Maybe Type)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Name -> Map Name Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
nm (Map Name Type -> Maybe Type)
-> (ModuleBuilderState -> Map Name Type)
-> ModuleBuilderState
-> Maybe Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleBuilderState -> Map Name Type
builderTypeDefs))
      case Maybe Type
mayTy of
        Nothing -> [Char] -> m Type
forall a. HasCallStack => [Char] -> a
error ([Char] -> m Type) -> [Char] -> m Type
forall a b. (a -> b) -> a -> b
$ "gep: Couldn’t resolve typedef for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Name -> [Char]
forall a. Show a => a -> [Char]
show Name
nm
        Just ty :: Type
ty -> Type -> [Operand] -> m Type
forall (m :: * -> *).
MonadModuleBuilder m =>
Type -> [Operand] -> m Type
gepType Type
ty [Operand]
is'
    gepType t :: Type
t (_:_) = [Char] -> m Type
forall a. HasCallStack => [Char] -> a
error ([Char] -> m Type) -> [Char] -> m Type
forall a b. (a -> b) -> a -> b
$ "gep: Can't index into a " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Type -> [Char]
forall a. Show a => a -> [Char]
show Type
t

-- | Emit the @trunc ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#trunc-to-instruction reference>.
trunc :: MonadIRBuilder m => Operand -> Type -> m Operand
trunc :: Operand -> Type -> m Operand
trunc a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
Trunc Operand
a Type
to []

-- | Emit the @fptrunc ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#fptrunc-to-instruction reference>.
fptrunc :: MonadIRBuilder m => Operand -> Type -> m Operand
fptrunc :: Operand -> Type -> m Operand
fptrunc a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
FPTrunc Operand
a Type
to []

-- | Emit the @zext ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#zext-to-instruction reference>.
zext :: MonadIRBuilder m => Operand -> Type -> m Operand
zext :: Operand -> Type -> m Operand
zext a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
ZExt Operand
a Type
to []

-- | Emit the @sext ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#sext-to-instruction reference>.
sext :: MonadIRBuilder m => Operand -> Type -> m Operand
sext :: Operand -> Type -> m Operand
sext a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
SExt Operand
a Type
to []

-- | Emit the @fptoui ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#fptoui-to-instruction reference>.
fptoui :: MonadIRBuilder m => Operand -> Type -> m Operand
fptoui :: Operand -> Type -> m Operand
fptoui a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
FPToUI Operand
a Type
to []

-- | Emit the @fptosi ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#fptosi-to-instruction reference>.
fptosi :: MonadIRBuilder m => Operand -> Type -> m Operand
fptosi :: Operand -> Type -> m Operand
fptosi a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
FPToSI Operand
a Type
to []

-- | Emit the @fpext ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#fpext-to-instruction reference>.
fpext :: MonadIRBuilder m => Operand -> Type -> m Operand
fpext :: Operand -> Type -> m Operand
fpext a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
FPExt Operand
a Type
to []

-- | Emit the @uitofp ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#uitofp-to-instruction reference>.
uitofp :: MonadIRBuilder m => Operand -> Type -> m Operand
uitofp :: Operand -> Type -> m Operand
uitofp a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
UIToFP Operand
a Type
to []

-- | Emit the @sitofp ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#sitofp-to-instruction reference>.
sitofp :: MonadIRBuilder m => Operand -> Type -> m Operand
sitofp :: Operand -> Type -> m Operand
sitofp a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
SIToFP Operand
a Type
to []

-- | Emit the @ptrtoint ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#ptrtoint-to-instruction reference>.
ptrtoint :: MonadIRBuilder m => Operand -> Type -> m Operand
ptrtoint :: Operand -> Type -> m Operand
ptrtoint a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
PtrToInt Operand
a Type
to []

-- | Emit the @inttoptr ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#inttoptr-to-instruction reference>.
inttoptr :: MonadIRBuilder m => Operand -> Type -> m Operand
inttoptr :: Operand -> Type -> m Operand
inttoptr a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
IntToPtr Operand
a Type
to []

-- | Emit the @bitcast ... to@ instruction.
-- See <https://llvm.org/docs/LangRef.html#bitcast-to-instruction reference>.
bitcast :: MonadIRBuilder m => Operand -> Type -> m Operand
bitcast :: Operand -> Type -> m Operand
bitcast a :: Operand
a to :: Type
to = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
to (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Type -> InstructionMetadata -> Instruction
BitCast Operand
a Type
to []

-- | See <https://llvm.org/docs/LangRef.html#extractelement-instruction reference>.
extractElement :: MonadIRBuilder m => Operand -> Operand -> m Operand
extractElement :: Operand -> Operand -> m Operand
extractElement v :: Operand
v i :: Operand
i = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
elemTyp (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> InstructionMetadata -> Instruction
ExtractElement Operand
v Operand
i []
  where elemTyp :: Type
elemTyp =
          case Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
v of
            VectorType _ typ :: Type
typ -> Type
typ
            _ -> [Char] -> Type
forall a. HasCallStack => [Char] -> a
error "extractElement: Expected a vector type (malformed AST)."

-- | See <https://llvm.org/docs/LangRef.html#insertelement-instruction reference>.
insertElement :: MonadIRBuilder m => Operand -> Operand -> Operand -> m Operand
insertElement :: Operand -> Operand -> Operand -> m Operand
insertElement v :: Operand
v e :: Operand
e i :: Operand
i = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
v) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> InstructionMetadata -> Instruction
InsertElement Operand
v Operand
e Operand
i []

-- | See <https://llvm.org/docs/LangRef.html#shufflevector-instruction reference>.
shuffleVector :: MonadIRBuilder m => Operand -> Operand -> C.Constant -> m Operand
shuffleVector :: Operand -> Operand -> Constant -> m Operand
shuffleVector a :: Operand
a b :: Operand
b m :: Constant
m = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
retType (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand
-> Operand -> Constant -> InstructionMetadata -> Instruction
ShuffleVector Operand
a Operand
b Constant
m []
  where retType :: Type
retType =
          case (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a, Constant -> Type
forall a. Typed a => a -> Type
typeOf Constant
m) of
            (VectorType _ elemTyp :: Type
elemTyp, VectorType maskLength :: Word32
maskLength _) -> Word32 -> Type -> Type
VectorType Word32
maskLength Type
elemTyp
            _ -> [Char] -> Type
forall a. HasCallStack => [Char] -> a
error "shuffleVector: Expected two vectors and a vector mask"


-- | See <https://llvm.org/docs/LangRef.html#extractvalue-instruction reference>.
extractValue :: MonadIRBuilder m => Operand -> [Word32] -> m Operand
extractValue :: Operand -> [Word32] -> m Operand
extractValue a :: Operand
a i :: [Word32]
i = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr ([Word32] -> Type -> Type
extractValueType [Word32]
i (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a)) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> [Word32] -> InstructionMetadata -> Instruction
ExtractValue Operand
a [Word32]
i []

-- | See <https://llvm.org/docs/LangRef.html#insertvalue-instruction reference>.
insertValue :: MonadIRBuilder m => Operand -> Operand -> [Word32] -> m Operand
insertValue :: Operand -> Operand -> [Word32] -> m Operand
insertValue a :: Operand
a e :: Operand
e i :: [Word32]
i = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
a) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand
-> Operand -> [Word32] -> InstructionMetadata -> Instruction
InsertValue Operand
a Operand
e [Word32]
i []

-- | See <https://llvm.org/docs/LangRef.html#icmp-instruction reference>.
icmp :: MonadIRBuilder m => IP.IntegerPredicate -> Operand -> Operand -> m Operand
icmp :: IntegerPredicate -> Operand -> Operand -> m Operand
icmp pred :: IntegerPredicate
pred a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
i1 (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ IntegerPredicate
-> Operand -> Operand -> InstructionMetadata -> Instruction
ICmp IntegerPredicate
pred Operand
a Operand
b []

-- | See <https://llvm.org/docs/LangRef.html#fcmp-instruction reference>.
fcmp :: MonadIRBuilder m => FP.FloatingPointPredicate -> Operand -> Operand -> m Operand
fcmp :: FloatingPointPredicate -> Operand -> Operand -> m Operand
fcmp pred :: FloatingPointPredicate
pred a :: Operand
a b :: Operand
b = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
i1 (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ FloatingPointPredicate
-> Operand -> Operand -> InstructionMetadata -> Instruction
FCmp FloatingPointPredicate
pred Operand
a Operand
b []

-- | Unconditional branch.
-- Emit a @br label <dest>@ instruction
-- See <https://llvm.org/docs/LangRef.html#br-instruction reference>.
br :: MonadIRBuilder m => Name -> m ()
br :: Name -> m ()
br val :: Name
val = Terminator -> m ()
forall (m :: * -> *). MonadIRBuilder m => Terminator -> m ()
emitTerm (Name -> InstructionMetadata -> Terminator
Br Name
val [])

-- | See <https://llvm.org/docs/LangRef.html#phi-instruction reference>.
phi :: MonadIRBuilder m => [(Operand, Name)] -> m Operand
phi :: [(Operand, Name)] -> m Operand
phi [] = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
AST.void (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Type -> [(Operand, Name)] -> InstructionMetadata -> Instruction
Phi Type
AST.void [] []
phi incoming :: [(Operand, Name)]
incoming@(i :: (Operand, Name)
i:_) = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
ty (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Type -> [(Operand, Name)] -> InstructionMetadata -> Instruction
Phi Type
ty [(Operand, Name)]
incoming []
  where
    ty :: Type
ty = Operand -> Type
forall a. Typed a => a -> Type
typeOf ((Operand, Name) -> Operand
forall a b. (a, b) -> a
fst (Operand, Name)
i) -- result type

-- | Emit a @ret void@ instruction.
-- See <https://llvm.org/docs/LangRef.html#ret-instruction reference>.
retVoid :: MonadIRBuilder m => m ()
retVoid :: m ()
retVoid = Terminator -> m ()
forall (m :: * -> *). MonadIRBuilder m => Terminator -> m ()
emitTerm (Maybe Operand -> InstructionMetadata -> Terminator
Ret Maybe Operand
forall a. Maybe a
Nothing [])

-- | See <https://llvm.org/docs/LangRef.html#call-instruction reference>.
call :: MonadIRBuilder m => Operand -> [(Operand, [ParameterAttribute])] -> m Operand
call :: Operand -> [(Operand, [ParameterAttribute])] -> m Operand
call fun :: Operand
fun args :: [(Operand, [ParameterAttribute])]
args = do
  let instr :: Instruction
instr = Call :: Maybe TailCallKind
-> CallingConvention
-> [ParameterAttribute]
-> CallableOperand
-> [(Operand, [ParameterAttribute])]
-> [Either GroupID FunctionAttribute]
-> InstructionMetadata
-> Instruction
Call {
    tailCallKind :: Maybe TailCallKind
AST.tailCallKind = Maybe TailCallKind
forall a. Maybe a
Nothing
  , callingConvention :: CallingConvention
AST.callingConvention = CallingConvention
CC.C
  , returnAttributes :: [ParameterAttribute]
AST.returnAttributes = []
  , function :: CallableOperand
AST.function = Operand -> CallableOperand
forall a b. b -> Either a b
Right Operand
fun
  , arguments :: [(Operand, [ParameterAttribute])]
AST.arguments = [(Operand, [ParameterAttribute])]
args
  , functionAttributes :: [Either GroupID FunctionAttribute]
AST.functionAttributes = []
  , metadata :: InstructionMetadata
AST.metadata = []
  }
  case Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
fun of
      FunctionType r :: Type
r _ _ -> case Type
r of
        VoidType -> Instruction -> m ()
forall (m :: * -> *). MonadIRBuilder m => Instruction -> m ()
emitInstrVoid Instruction
instr m () -> m Operand -> m Operand
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Operand -> m Operand
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant -> Operand
ConstantOperand (Type -> Constant
C.Undef Type
void)))
        _        -> Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
r Instruction
instr
      PointerType (FunctionType r :: Type
r _ _) _ -> case Type
r of
        VoidType -> Instruction -> m ()
forall (m :: * -> *). MonadIRBuilder m => Instruction -> m ()
emitInstrVoid Instruction
instr m () -> m Operand -> m Operand
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Operand -> m Operand
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant -> Operand
ConstantOperand (Type -> Constant
C.Undef Type
void)))
        _        -> Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr Type
r Instruction
instr
      _ -> [Char] -> m Operand
forall a. HasCallStack => [Char] -> a
error "Cannot call non-function (Malformed AST)."

-- | See <https://llvm.org/docs/LangRef.html#ret-instruction reference>.
ret :: MonadIRBuilder m => Operand -> m ()
ret :: Operand -> m ()
ret val :: Operand
val = Terminator -> m ()
forall (m :: * -> *). MonadIRBuilder m => Terminator -> m ()
emitTerm (Maybe Operand -> InstructionMetadata -> Terminator
Ret (Operand -> Maybe Operand
forall a. a -> Maybe a
Just Operand
val) [])

-- | See <https://llvm.org/docs/LangRef.html#switch-instruction reference>.
switch :: MonadIRBuilder m => Operand -> Name -> [(C.Constant, Name)] -> m ()
switch :: Operand -> Name -> [(Constant, Name)] -> m ()
switch val :: Operand
val def :: Name
def dests :: [(Constant, Name)]
dests = Terminator -> m ()
forall (m :: * -> *). MonadIRBuilder m => Terminator -> m ()
emitTerm (Terminator -> m ()) -> Terminator -> m ()
forall a b. (a -> b) -> a -> b
$ Operand
-> Name -> [(Constant, Name)] -> InstructionMetadata -> Terminator
Switch Operand
val Name
def [(Constant, Name)]
dests []

-- | See <https://llvm.org/docs/LangRef.html#select-instruction reference>.
select :: MonadIRBuilder m => Operand -> Operand -> Operand -> m Operand
select :: Operand -> Operand -> Operand -> m Operand
select cond :: Operand
cond t :: Operand
t f :: Operand
f = Type -> Instruction -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Instruction -> m Operand
emitInstr (Operand -> Type
forall a. Typed a => a -> Type
typeOf Operand
t) (Instruction -> m Operand) -> Instruction -> m Operand
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> InstructionMetadata -> Instruction
Select Operand
cond Operand
t Operand
f []

-- | Conditional branch (see 'br' for unconditional instructions).
-- See <https://llvm.org/docs/LangRef.html#br-instruction reference>.
condBr :: MonadIRBuilder m => Operand -> Name -> Name -> m ()
condBr :: Operand -> Name -> Name -> m ()
condBr cond :: Operand
cond tdest :: Name
tdest fdest :: Name
fdest = Terminator -> m ()
forall (m :: * -> *). MonadIRBuilder m => Terminator -> m ()
emitTerm (Terminator -> m ()) -> Terminator -> m ()
forall a b. (a -> b) -> a -> b
$ Operand -> Name -> Name -> InstructionMetadata -> Terminator
CondBr Operand
cond Name
tdest Name
fdest []

-- | See <https://llvm.org/docs/LangRef.html#unreachable-instruction reference>.
unreachable :: MonadIRBuilder m => m ()
unreachable :: m ()
unreachable = Terminator -> m ()
forall (m :: * -> *). MonadIRBuilder m => Terminator -> m ()
emitTerm (Terminator -> m ()) -> Terminator -> m ()
forall a b. (a -> b) -> a -> b
$ InstructionMetadata -> Terminator
Unreachable []

-- | Creates a series of instructions to generate a pointer to a string
-- constant. Useful for making format strings to pass to @printf@, for example
globalStringPtr
  :: (MonadModuleBuilder m)
  => String       -- ^ The string to generate
  -> Name         -- ^ Variable name of the pointer
  -> m C.Constant
globalStringPtr :: [Char] -> Name -> m Constant
globalStringPtr str :: [Char]
str nm :: Name
nm = do
  let asciiVals :: [Integer]
asciiVals = (Char -> Integer) -> [Char] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> (Char -> Int) -> Char -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) [Char]
str
      llvmVals :: [Constant]
llvmVals  = (Integer -> Constant) -> [Integer] -> [Constant]
forall a b. (a -> b) -> [a] -> [b]
map (Word32 -> Integer -> Constant
C.Int 8) ([Integer]
asciiVals [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ [0]) -- append null terminator
      char :: Type
char      = Word32 -> Type
IntegerType 8
      charStar :: Type
charStar  = Type -> Type
ptr Type
char
      charArray :: Constant
charArray = Type -> [Constant] -> Constant
C.Array Type
char [Constant]
llvmVals
      ty :: Type
ty        = Constant -> Type
forall a. Typed a => a -> Type
LLVM.AST.Typed.typeOf Constant
charArray
  Definition -> m ()
forall (m :: * -> *). MonadModuleBuilder m => Definition -> m ()
emitDefn (Definition -> m ()) -> Definition -> m ()
forall a b. (a -> b) -> a -> b
$ Global -> Definition
GlobalDefinition Global
globalVariableDefaults
    { name :: Name
name                  = Name
nm
    , type' :: Type
LLVM.AST.Global.type' = Type
ty
    , linkage :: Linkage
linkage               = Linkage
External
    , isConstant :: Bool
isConstant            = Bool
True
    , initializer :: Maybe Constant
initializer           = Constant -> Maybe Constant
forall a. a -> Maybe a
Just Constant
charArray
    , unnamedAddr :: Maybe UnnamedAddr
unnamedAddr           = UnnamedAddr -> Maybe UnnamedAddr
forall a. a -> Maybe a
Just UnnamedAddr
GlobalAddr
    }
  Constant -> m Constant
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant -> m Constant) -> Constant -> m Constant
forall a b. (a -> b) -> a -> b
$ Bool -> Constant -> [Constant] -> Constant
C.GetElementPtr Bool
True
                           (Type -> Name -> Constant
C.GlobalReference (Type -> Type
ptr Type
ty) Name
nm)
                           [(Word32 -> Integer -> Constant
C.Int 32 0), (Word32 -> Integer -> Constant
C.Int 32 0)]