never executed always true always false
    1 --------------------------------------------------------------------------------
    2 -- | The LLVM abstract syntax.
    3 --
    4 
    5 module GHC.Llvm.Syntax where
    6 
    7 import GHC.Prelude
    8 
    9 import GHC.Llvm.MetaData
   10 import GHC.Llvm.Types
   11 
   12 import GHC.Types.Unique
   13 
   14 -- | Block labels
   15 type LlvmBlockId = Unique
   16 
   17 -- | A block of LLVM code.
   18 data LlvmBlock = LlvmBlock {
   19     -- | The code label for this block
   20     blockLabel :: LlvmBlockId,
   21 
   22     -- | A list of LlvmStatement's representing the code for this block.
   23     -- This list must end with a control flow statement.
   24     blockStmts :: [LlvmStatement]
   25   }
   26 
   27 type LlvmBlocks = [LlvmBlock]
   28 
   29 -- | An LLVM Module. This is a top level container in LLVM.
   30 data LlvmModule = LlvmModule  {
   31     -- | Comments to include at the start of the module.
   32     modComments  :: [LMString],
   33 
   34     -- | LLVM Alias type definitions.
   35     modAliases   :: [LlvmAlias],
   36 
   37     -- | LLVM meta data.
   38     modMeta      :: [MetaDecl],
   39 
   40     -- | Global variables to include in the module.
   41     modGlobals   :: [LMGlobal],
   42 
   43     -- | LLVM Functions used in this module but defined in other modules.
   44     modFwdDecls  :: LlvmFunctionDecls,
   45 
   46     -- | LLVM Functions defined in this module.
   47     modFuncs     :: LlvmFunctions
   48   }
   49 
   50 -- | An LLVM Function
   51 data LlvmFunction = LlvmFunction {
   52     -- | The signature of this declared function.
   53     funcDecl      :: LlvmFunctionDecl,
   54 
   55     -- | The functions arguments
   56     funcArgs      :: [LMString],
   57 
   58     -- | The function attributes.
   59     funcAttrs     :: [LlvmFuncAttr],
   60 
   61     -- | The section to put the function into,
   62     funcSect      :: LMSection,
   63 
   64     -- | Prefix data
   65     funcPrefix    :: Maybe LlvmStatic,
   66 
   67     -- | The body of the functions.
   68     funcBody      :: LlvmBlocks
   69   }
   70 
   71 type LlvmFunctions = [LlvmFunction]
   72 
   73 type SingleThreaded = Bool
   74 
   75 -- | LLVM ordering types for synchronization purposes. (Introduced in LLVM
   76 -- 3.0). Please see the LLVM documentation for a better description.
   77 data LlvmSyncOrdering
   78   -- | Some partial order of operations exists.
   79   = SyncUnord
   80   -- | A single total order for operations at a single address exists.
   81   | SyncMonotonic
   82   -- | Acquire synchronization operation.
   83   | SyncAcquire
   84   -- | Release synchronization operation.
   85   | SyncRelease
   86   -- | Acquire + Release synchronization operation.
   87   | SyncAcqRel
   88   -- | Full sequential Consistency operation.
   89   | SyncSeqCst
   90   deriving (Show, Eq)
   91 
   92 -- | LLVM atomic operations. Please see the @atomicrmw@ instruction in
   93 -- the LLVM documentation for a complete description.
   94 data LlvmAtomicOp
   95   = LAO_Xchg
   96   | LAO_Add
   97   | LAO_Sub
   98   | LAO_And
   99   | LAO_Nand
  100   | LAO_Or
  101   | LAO_Xor
  102   | LAO_Max
  103   | LAO_Min
  104   | LAO_Umax
  105   | LAO_Umin
  106   deriving (Show, Eq)
  107 
  108 -- | Llvm Statements
  109 data LlvmStatement
  110   {- |
  111     Assign an expression to a variable:
  112       * dest:   Variable to assign to
  113       * source: Source expression
  114   -}
  115   = Assignment LlvmVar LlvmExpression
  116 
  117   {- |
  118     Memory fence operation
  119   -}
  120   | Fence Bool LlvmSyncOrdering
  121 
  122   {- |
  123     Always branch to the target label
  124   -}
  125   | Branch LlvmVar
  126 
  127   {- |
  128     Branch to label targetTrue if cond is true otherwise to label targetFalse
  129       * cond:        condition that will be tested, must be of type i1
  130       * targetTrue:  label to branch to if cond is true
  131       * targetFalse: label to branch to if cond is false
  132   -}
  133   | BranchIf LlvmVar LlvmVar LlvmVar
  134 
  135   {- |
  136     Comment
  137     Plain comment.
  138   -}
  139   | Comment [LMString]
  140 
  141   {- |
  142     Set a label on this position.
  143       * name: Identifier of this label, unique for this module
  144   -}
  145   | MkLabel LlvmBlockId
  146 
  147   {- |
  148     Store variable value in pointer ptr. If value is of type t then ptr must
  149     be of type t*.
  150       * value: Variable/Constant to store.
  151       * ptr:   Location to store the value in
  152   -}
  153   | Store LlvmVar LlvmVar
  154 
  155   {- |
  156     Multiway branch
  157       * scrutinee: Variable or constant which must be of integer type that is
  158                    determines which arm is chosen.
  159       * def:       The default label if there is no match in target.
  160       * target:    A list of (value,label) where the value is an integer
  161                    constant and label the corresponding label to jump to if the
  162                    scrutinee matches the value.
  163   -}
  164   | Switch LlvmVar LlvmVar [(LlvmVar, LlvmVar)]
  165 
  166   {- |
  167     Return a result.
  168       * result: The variable or constant to return
  169   -}
  170   | Return (Maybe LlvmVar)
  171 
  172   {- |
  173     An instruction for the optimizer that the code following is not reachable
  174   -}
  175   | Unreachable
  176 
  177   {- |
  178     Raise an expression to a statement (if don't want result or want to use
  179     Llvm unnamed values.
  180   -}
  181   | Expr LlvmExpression
  182 
  183   {- |
  184     A nop LLVM statement. Useful as its often more efficient to use this
  185     then to wrap LLvmStatement in a Just or [].
  186   -}
  187   | Nop
  188 
  189   {- |
  190     A LLVM statement with metadata attached to it.
  191   -}
  192   | MetaStmt [MetaAnnot] LlvmStatement
  193 
  194   deriving (Eq)
  195 
  196 
  197 -- | Llvm Expressions
  198 data LlvmExpression
  199   {- |
  200     Allocate amount * sizeof(tp) bytes on the stack
  201       * tp:     LlvmType to reserve room for
  202       * amount: The nr of tp's which must be allocated
  203   -}
  204   = Alloca LlvmType Int
  205 
  206   {- |
  207     Perform the machine operator op on the operands left and right
  208       * op:    operator
  209       * left:  left operand
  210       * right: right operand
  211   -}
  212   | LlvmOp LlvmMachOp LlvmVar LlvmVar
  213 
  214   {- |
  215     Perform a compare operation on the operands left and right
  216       * op:    operator
  217       * left:  left operand
  218       * right: right operand
  219   -}
  220   | Compare LlvmCmpOp LlvmVar LlvmVar
  221 
  222   {- |
  223     Extract a scalar element from a vector
  224       * val: The vector
  225       * idx: The index of the scalar within the vector
  226   -}
  227   | Extract LlvmVar LlvmVar
  228 
  229   {- |
  230     Extract a scalar element from a structure
  231       * val: The structure
  232       * idx: The index of the scalar within the structure
  233     Corresponds to "extractvalue" instruction.
  234   -}
  235   | ExtractV LlvmVar Int
  236 
  237   {- |
  238     Insert a scalar element into a vector
  239       * val:   The source vector
  240       * elt:   The scalar to insert
  241       * index: The index at which to insert the scalar
  242   -}
  243   | Insert LlvmVar LlvmVar LlvmVar
  244 
  245   {- |
  246     Allocate amount * sizeof(tp) bytes on the heap
  247       * tp:     LlvmType to reserve room for
  248       * amount: The nr of tp's which must be allocated
  249   -}
  250   | Malloc LlvmType Int
  251 
  252   {- |
  253     Load the value at location ptr
  254   -}
  255   | Load LlvmVar
  256 
  257   {- |
  258     Atomic load of the value at location ptr
  259   -}
  260   | ALoad LlvmSyncOrdering SingleThreaded LlvmVar
  261 
  262   {- |
  263     Navigate in a structure, selecting elements
  264       * inbound: Is the pointer inbounds? (computed pointer doesn't overflow)
  265       * ptr:     Location of the structure
  266       * indexes: A list of indexes to select the correct value.
  267   -}
  268   | GetElemPtr Bool LlvmVar [LlvmVar]
  269 
  270   {- |
  271     Cast the variable from to the to type. This is an abstraction of three
  272     cast operators in Llvm, inttoptr, ptrtoint and bitcast.
  273        * cast: Cast type
  274        * from: Variable to cast
  275        * to:   type to cast to
  276   -}
  277   | Cast LlvmCastOp LlvmVar LlvmType
  278 
  279   {- |
  280     Atomic read-modify-write operation
  281        * op:       Atomic operation
  282        * addr:     Address to modify
  283        * operand:  Operand to operation
  284        * ordering: Ordering requirement
  285   -}
  286   | AtomicRMW LlvmAtomicOp LlvmVar LlvmVar LlvmSyncOrdering
  287 
  288   {- |
  289     Compare-and-exchange operation
  290        * addr:     Address to modify
  291        * old:      Expected value
  292        * new:      New value
  293        * suc_ord:  Ordering required in success case
  294        * fail_ord: Ordering required in failure case, can be no stronger than
  295                    suc_ord
  296 
  297     Result is an @i1@, true if store was successful.
  298   -}
  299   | CmpXChg LlvmVar LlvmVar LlvmVar LlvmSyncOrdering LlvmSyncOrdering
  300 
  301   {- |
  302     Call a function. The result is the value of the expression.
  303       * tailJumps: CallType to signal if the function should be tail called
  304       * fnptrval:  An LLVM value containing a pointer to a function to be
  305                    invoked. Can be indirect. Should be LMFunction type.
  306       * args:      Concrete arguments for the parameters
  307       * attrs:     A list of function attributes for the call. Only NoReturn,
  308                    NoUnwind, ReadOnly and ReadNone are valid here.
  309   -}
  310   | Call LlvmCallType LlvmVar [LlvmVar] [LlvmFuncAttr]
  311 
  312   {- |
  313     Call a function as above but potentially taking metadata as arguments.
  314       * tailJumps: CallType to signal if the function should be tail called
  315       * fnptrval:  An LLVM value containing a pointer to a function to be
  316                    invoked. Can be indirect. Should be LMFunction type.
  317       * args:      Arguments that may include metadata.
  318       * attrs:     A list of function attributes for the call. Only NoReturn,
  319                    NoUnwind, ReadOnly and ReadNone are valid here.
  320   -}
  321   | CallM LlvmCallType LlvmVar [MetaExpr] [LlvmFuncAttr]
  322 
  323   {- |
  324     Merge variables from different basic blocks which are predecessors of this
  325     basic block in a new variable of type tp.
  326       * tp:         type of the merged variable, must match the types of the
  327                     predecessor variables.
  328       * predecessors: A list of variables and the basic block that they originate
  329                       from.
  330   -}
  331   | Phi LlvmType [(LlvmVar,LlvmVar)]
  332 
  333   {- |
  334     Inline assembly expression. Syntax is very similar to the style used by GCC.
  335       * assembly:    Actual inline assembly code.
  336       * constraints: Operand constraints.
  337       * return ty:   Return type of function.
  338       * vars:        Any variables involved in the assembly code.
  339       * sideeffect:  Does the expression have side effects not visible from the
  340                      constraints list.
  341       * alignstack:  Should the stack be conservatively aligned before this
  342                      expression is executed.
  343   -}
  344   | Asm LMString LMString LlvmType [LlvmVar] Bool Bool
  345 
  346   {- |
  347     A LLVM expression with metadata attached to it.
  348   -}
  349   | MExpr [MetaAnnot] LlvmExpression
  350 
  351   deriving (Eq)
  352