never executed always true always false
    1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    2 
    3 module GHC.Llvm.MetaData where
    4 
    5 import GHC.Prelude
    6 
    7 import GHC.Llvm.Types
    8 import GHC.Utils.Outputable
    9 
   10 -- The LLVM Metadata System.
   11 --
   12 -- The LLVM metadata feature is poorly documented but roughly follows the
   13 -- following design:
   14 -- - Metadata can be constructed in a few different ways (See below).
   15 -- - After which it can either be attached to LLVM statements to pass along
   16 -- extra information to the optimizer and code generator OR specifically named
   17 -- metadata has an affect on the whole module (i.e., linking behaviour).
   18 --
   19 --
   20 -- # Constructing metadata
   21 -- Metadata comes largely in three forms:
   22 --
   23 -- - Metadata expressions -- these are the raw metadata values that encode
   24 --   information. They consist of metadata strings, metadata nodes, regular
   25 --   LLVM values (both literals and references to global variables) and
   26 --   metadata expressions (i.e., recursive data type). Some examples:
   27 --     !{ !"hello", !0, i32 0 }
   28 --     !{ !1, !{ i32 0 } }
   29 --
   30 -- - Metadata nodes -- global metadata variables that attach a metadata
   31 --   expression to a number. For example:
   32 --     !0 = !{ [<metadata expressions>] !}
   33 --
   34 -- - Named metadata -- global metadata variables that attach a metadata nodes
   35 --   to a name. Used ONLY to communicated module level information to LLVM
   36 --   through a meaningful name. For example:
   37 --     !llvm.module.linkage = !{ !0, !1 }
   38 --
   39 --
   40 -- # Using Metadata
   41 -- Using metadata depends on the form it is in:
   42 --
   43 -- - Attach to instructions -- metadata can be attached to LLVM instructions
   44 --   using a specific reference as follows:
   45 --     %l = load i32* @glob, !nontemporal !10
   46 --     %m = load i32* @glob, !nontemporal !{ i32 0, !{ i32 0 } }
   47 --   Only metadata nodes or expressions can be attached, named metadata cannot.
   48 --   Refer to LLVM documentation for which instructions take metadata and its
   49 --   meaning.
   50 --
   51 -- - As arguments -- llvm functions can take metadata as arguments, for
   52 --   example:
   53 --     call void @llvm.dbg.value(metadata !{ i32 0 }, i64 0, metadata !1)
   54 --   As with instructions, only metadata nodes or expressions can be attached.
   55 --
   56 -- - As a named metadata -- Here the metadata is simply declared in global
   57 --   scope using a specific name to communicate module level information to LLVM.
   58 --   For example:
   59 --     !llvm.module.linkage = !{ !0, !1 }
   60 --
   61 
   62 -- | A reference to an un-named metadata node.
   63 newtype MetaId = MetaId Int
   64                deriving (Eq, Ord, Enum)
   65 
   66 instance Outputable MetaId where
   67     ppr (MetaId n) = char '!' <> int n
   68 
   69 -- | LLVM metadata expressions
   70 data MetaExpr = MetaStr !LMString
   71               | MetaNode !MetaId
   72               | MetaVar !LlvmVar
   73               | MetaStruct [MetaExpr]
   74               deriving (Eq)
   75 
   76 -- | Associates some metadata with a specific label for attaching to an
   77 -- instruction.
   78 data MetaAnnot = MetaAnnot LMString MetaExpr
   79                deriving (Eq)
   80 
   81 -- | Metadata declarations. Metadata can only be declared in global scope.
   82 data MetaDecl
   83     -- | Named metadata. Only used for communicating module information to
   84     -- LLVM. ('!name = !{ [!\<n>] }' form).
   85     = MetaNamed !LMString [MetaId]
   86     -- | Metadata node declaration.
   87     -- ('!0 = metadata !{ \<metadata expression> }' form).
   88     | MetaUnnamed !MetaId !MetaExpr