-------------------------------------------------------------------------------- -- | The LLVM abstract syntax. -- module GHC.Llvm.Syntax where import GHC.Prelude import GHC.Llvm.MetaData import GHC.Llvm.Types import GHC.Types.Unique -- | Block labels type LlvmBlockId = Unique -- | A block of LLVM code. data LlvmBlock = LlvmBlock { -- | The code label for this block LlvmBlock -> LlvmBlockId blockLabel :: LlvmBlockId, -- | A list of LlvmStatement's representing the code for this block. -- This list must end with a control flow statement. LlvmBlock -> [LlvmStatement] blockStmts :: [LlvmStatement] } type LlvmBlocks = [LlvmBlock] -- | An LLVM Module. This is a top level container in LLVM. data LlvmModule = LlvmModule { -- | Comments to include at the start of the module. LlvmModule -> [LMString] modComments :: [LMString], -- | LLVM Alias type definitions. LlvmModule -> [LlvmAlias] modAliases :: [LlvmAlias], -- | LLVM meta data. LlvmModule -> [MetaDecl] modMeta :: [MetaDecl], -- | Global variables to include in the module. LlvmModule -> [LMGlobal] modGlobals :: [LMGlobal], -- | LLVM Functions used in this module but defined in other modules. LlvmModule -> LlvmFunctionDecls modFwdDecls :: LlvmFunctionDecls, -- | LLVM Functions defined in this module. LlvmModule -> LlvmFunctions modFuncs :: LlvmFunctions } -- | An LLVM Function data LlvmFunction = LlvmFunction { -- | The signature of this declared function. LlvmFunction -> LlvmFunctionDecl funcDecl :: LlvmFunctionDecl, -- | The functions arguments LlvmFunction -> [LMString] funcArgs :: [LMString], -- | The function attributes. LlvmFunction -> [LlvmFuncAttr] funcAttrs :: [LlvmFuncAttr], -- | The section to put the function into, LlvmFunction -> LMSection funcSect :: LMSection, -- | Prefix data LlvmFunction -> Maybe LlvmStatic funcPrefix :: Maybe LlvmStatic, -- | The body of the functions. LlvmFunction -> LlvmBlocks funcBody :: LlvmBlocks } type LlvmFunctions = [LlvmFunction] type SingleThreaded = Bool -- | LLVM ordering types for synchronization purposes. (Introduced in LLVM -- 3.0). Please see the LLVM documentation for a better description. data LlvmSyncOrdering -- | Some partial order of operations exists. = SyncUnord -- | A single total order for operations at a single address exists. | SyncMonotonic -- | Acquire synchronization operation. | SyncAcquire -- | Release synchronization operation. | SyncRelease -- | Acquire + Release synchronization operation. | SyncAcqRel -- | Full sequential Consistency operation. | SyncSeqCst deriving (Int -> LlvmSyncOrdering -> ShowS [LlvmSyncOrdering] -> ShowS LlvmSyncOrdering -> String (Int -> LlvmSyncOrdering -> ShowS) -> (LlvmSyncOrdering -> String) -> ([LlvmSyncOrdering] -> ShowS) -> Show LlvmSyncOrdering forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> LlvmSyncOrdering -> ShowS showsPrec :: Int -> LlvmSyncOrdering -> ShowS $cshow :: LlvmSyncOrdering -> String show :: LlvmSyncOrdering -> String $cshowList :: [LlvmSyncOrdering] -> ShowS showList :: [LlvmSyncOrdering] -> ShowS Show, LlvmSyncOrdering -> LlvmSyncOrdering -> Bool (LlvmSyncOrdering -> LlvmSyncOrdering -> Bool) -> (LlvmSyncOrdering -> LlvmSyncOrdering -> Bool) -> Eq LlvmSyncOrdering forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: LlvmSyncOrdering -> LlvmSyncOrdering -> Bool == :: LlvmSyncOrdering -> LlvmSyncOrdering -> Bool $c/= :: LlvmSyncOrdering -> LlvmSyncOrdering -> Bool /= :: LlvmSyncOrdering -> LlvmSyncOrdering -> Bool Eq) -- | LLVM atomic operations. Please see the @atomicrmw@ instruction in -- the LLVM documentation for a complete description. data LlvmAtomicOp = LAO_Xchg | LAO_Add | LAO_Sub | LAO_And | LAO_Nand | LAO_Or | LAO_Xor | LAO_Max | LAO_Min | LAO_Umax | LAO_Umin deriving (Int -> LlvmAtomicOp -> ShowS [LlvmAtomicOp] -> ShowS LlvmAtomicOp -> String (Int -> LlvmAtomicOp -> ShowS) -> (LlvmAtomicOp -> String) -> ([LlvmAtomicOp] -> ShowS) -> Show LlvmAtomicOp forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> LlvmAtomicOp -> ShowS showsPrec :: Int -> LlvmAtomicOp -> ShowS $cshow :: LlvmAtomicOp -> String show :: LlvmAtomicOp -> String $cshowList :: [LlvmAtomicOp] -> ShowS showList :: [LlvmAtomicOp] -> ShowS Show, LlvmAtomicOp -> LlvmAtomicOp -> Bool (LlvmAtomicOp -> LlvmAtomicOp -> Bool) -> (LlvmAtomicOp -> LlvmAtomicOp -> Bool) -> Eq LlvmAtomicOp forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: LlvmAtomicOp -> LlvmAtomicOp -> Bool == :: LlvmAtomicOp -> LlvmAtomicOp -> Bool $c/= :: LlvmAtomicOp -> LlvmAtomicOp -> Bool /= :: LlvmAtomicOp -> LlvmAtomicOp -> Bool Eq) -- | Llvm Statements data LlvmStatement {- | Assign an expression to a variable: * dest: Variable to assign to * source: Source expression -} = Assignment LlvmVar LlvmExpression {- | Memory fence operation -} | Fence Bool LlvmSyncOrdering {- | Always branch to the target label -} | Branch LlvmVar {- | Branch to label targetTrue if cond is true otherwise to label targetFalse * cond: condition that will be tested, must be of type i1 * targetTrue: label to branch to if cond is true * targetFalse: label to branch to if cond is false -} | BranchIf LlvmVar LlvmVar LlvmVar {- | Comment Plain comment. -} | Comment [LMString] {- | Set a label on this position. * name: Identifier of this label, unique for this module -} | MkLabel LlvmBlockId {- | Store variable value in pointer ptr. If value is of type t then ptr must be of type t*. * value: Variable/Constant to store. * ptr: Location to store the value in -} | Store LlvmVar LlvmVar LMAlign [MetaAnnot] {- | Multiway branch * scrutinee: Variable or constant which must be of integer type that is determines which arm is chosen. * def: The default label if there is no match in target. * target: A list of (value,label) where the value is an integer constant and label the corresponding label to jump to if the scrutinee matches the value. -} | Switch LlvmVar LlvmVar [(LlvmVar, LlvmVar)] {- | Return a result. * result: The variable or constant to return -} | Return (Maybe LlvmVar) {- | An instruction for the optimizer that the code following is not reachable -} | Unreachable {- | Raise an expression to a statement (if don't want result or want to use Llvm unnamed values. -} | Expr LlvmExpression {- | A nop LLVM statement. Useful as its often more efficient to use this then to wrap LLvmStatement in a Just or []. -} | Nop deriving (LlvmStatement -> LlvmStatement -> Bool (LlvmStatement -> LlvmStatement -> Bool) -> (LlvmStatement -> LlvmStatement -> Bool) -> Eq LlvmStatement forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: LlvmStatement -> LlvmStatement -> Bool == :: LlvmStatement -> LlvmStatement -> Bool $c/= :: LlvmStatement -> LlvmStatement -> Bool /= :: LlvmStatement -> LlvmStatement -> Bool Eq) -- | Llvm Expressions data LlvmExpression {- | Allocate amount * sizeof(tp) bytes on the stack * tp: LlvmType to reserve room for * amount: The nr of tp's which must be allocated -} = Alloca LlvmType Int {- | Perform the machine operator op on the operands left and right * op: operator * left: left operand * right: right operand -} | LlvmOp LlvmMachOp LlvmVar LlvmVar {- | Perform a compare operation on the operands left and right * op: operator * left: left operand * right: right operand -} | Compare LlvmCmpOp LlvmVar LlvmVar {- | Extract a scalar element from a vector * val: The vector * idx: The index of the scalar within the vector -} | Extract LlvmVar LlvmVar {- | Extract a scalar element from a structure * val: The structure * idx: The index of the scalar within the structure Corresponds to "extractvalue" instruction. -} | ExtractV LlvmVar Int {- | Insert a scalar element into a vector * val: The source vector * elt: The scalar to insert * index: The index at which to insert the scalar -} | Insert LlvmVar LlvmVar LlvmVar {- | Shuffle two vectors into a destination vector using given indices -} | Shuffle LlvmVar LlvmVar [Int] {- | Allocate amount * sizeof(tp) bytes on the heap * tp: LlvmType to reserve room for * amount: The nr of tp's which must be allocated -} | Malloc LlvmType Int {- | Load the value at location ptr -} | Load LlvmVar LMAlign {- | Atomic load of the value at location ptr -} | ALoad LlvmSyncOrdering SingleThreaded LlvmVar {- | Navigate in a structure, selecting elements * inbound: Is the pointer inbounds? (computed pointer doesn't overflow) * ptr: Location of the structure * indexes: A list of indexes to select the correct value. -} | GetElemPtr Bool LlvmVar [LlvmVar] {- | Cast the variable from to the to type. This is an abstraction of three cast operators in Llvm, inttoptr, ptrtoint and bitcast. * cast: Cast type * from: Variable to cast * to: type to cast to -} | Cast LlvmCastOp LlvmVar LlvmType {- | Atomic read-modify-write operation * op: Atomic operation * addr: Address to modify * operand: Operand to operation * ordering: Ordering requirement -} | AtomicRMW LlvmAtomicOp LlvmVar LlvmVar LlvmSyncOrdering {- | Compare-and-exchange operation * addr: Address to modify * old: Expected value * new: New value * suc_ord: Ordering required in success case * fail_ord: Ordering required in failure case, can be no stronger than suc_ord Result is an @i1@, true if store was successful. -} | CmpXChg LlvmVar LlvmVar LlvmVar LlvmSyncOrdering LlvmSyncOrdering {- | Call a function. The result is the value of the expression. * tailJumps: CallType to signal if the function should be tail called * fnptrval: An LLVM value containing a pointer to a function to be invoked. Can be indirect. Should be LMFunction type. * args: Concrete arguments for the parameters * attrs: A list of function attributes for the call. Only NoReturn, NoUnwind, ReadOnly and ReadNone are valid here. -} | Call LlvmCallType LlvmVar [LlvmVar] [LlvmFuncAttr] {- | Call a function as above but potentially taking metadata as arguments. * tailJumps: CallType to signal if the function should be tail called * fnptrval: An LLVM value containing a pointer to a function to be invoked. Can be indirect. Should be LMFunction type. * args: Arguments that may include metadata. * attrs: A list of function attributes for the call. Only NoReturn, NoUnwind, ReadOnly and ReadNone are valid here. -} | CallM LlvmCallType LlvmVar [MetaExpr] [LlvmFuncAttr] {- | Merge variables from different basic blocks which are predecessors of this basic block in a new variable of type tp. * tp: type of the merged variable, must match the types of the predecessor variables. * predecessors: A list of variables and the basic block that they originate from. -} | Phi LlvmType [(LlvmVar,LlvmVar)] {- | Inline assembly expression. Syntax is very similar to the style used by GCC. * assembly: Actual inline assembly code. * constraints: Operand constraints. * return ty: Return type of function. * vars: Any variables involved in the assembly code. * sideeffect: Does the expression have side effects not visible from the constraints list. * alignstack: Should the stack be conservatively aligned before this expression is executed. -} | Asm LMString LMString LlvmType [LlvmVar] Bool Bool {- | A LLVM expression with metadata attached to it. -} | MExpr [MetaAnnot] LlvmExpression deriving (LlvmExpression -> LlvmExpression -> Bool (LlvmExpression -> LlvmExpression -> Bool) -> (LlvmExpression -> LlvmExpression -> Bool) -> Eq LlvmExpression forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: LlvmExpression -> LlvmExpression -> Bool == :: LlvmExpression -> LlvmExpression -> Bool $c/= :: LlvmExpression -> LlvmExpression -> Bool /= :: LlvmExpression -> LlvmExpression -> Bool Eq)