    {-# LANGUAGE GeneralizedNewtypeDeriving #-}

    module GHC.Llvm.MetaData
      ( MetaId(..)
      , ppMetaId
      , MetaExpr(..)
      , MetaAnnot(..)
      , MetaDecl(..)
        -- * Module flags
      , ModuleFlagBehavior(..)
      , ModuleFlag(..)
      , moduleFlagToMetaExpr
      ) where

    import GHC.Prelude

    import GHC.Llvm.Types
    import GHC.Utils.Outputable

    -- The LLVM Metadata System.
    --
    -- The LLVM metadata feature is poorly documented but roughly follows the
    -- following design:
    -- - Metadata can be constructed in a few different ways (See below).
    -- - After which it can either be attached to LLVM statements to pass along
    -- extra information to the optimizer and code generator OR specifically named
    -- metadata has an affect on the whole module (i.e., linking behaviour).
    --
    --
    -- # Constructing metadata
    -- Metadata comes largely in three forms:
    --
    -- - Metadata expressions -- these are the raw metadata values that encode
    --   information. They consist of metadata strings, metadata nodes, regular
    --   LLVM values (both literals and references to global variables) and
    --   metadata expressions (i.e., recursive data type). Some examples:
    --     !{ !"hello", !0, i32 0 }
    --     !{ !1, !{ i32 0 } }
    --
    -- - Metadata nodes -- global metadata variables that attach a metadata
    --   expression to a number. For example:
    --     !0 = !{ [<metadata expressions>] !}
    --
    -- - Named metadata -- global metadata variables that attach a metadata nodes
    --   to a name. Used ONLY to communicated module level information to LLVM
    --   through a meaningful name. For example:
    --     !llvm.module.linkage = !{ !0, !1 }
    --
    --
    -- # Using Metadata
    -- Using metadata depends on the form it is in:
    --
    -- - Attach to instructions -- metadata can be attached to LLVM instructions
    --   using a specific reference as follows:
    --     %l = load i32* @glob, !nontemporal !10
    --     %m = load i32* @glob, !nontemporal !{ i32 0, !{ i32 0 } }
    --   Only metadata nodes or expressions can be attached, named metadata cannot.
    --   Refer to LLVM documentation for which instructions take metadata and its
    --   meaning.
    --
    -- - As arguments -- llvm functions can take metadata as arguments, for
    --   example:
    --     call void @llvm.dbg.value(metadata !{ i32 0 }, i64 0, metadata !1)
    --   As with instructions, only metadata nodes or expressions can be attached.
    --
    -- - As a named metadata -- Here the metadata is simply declared in global
    --   scope using a specific name to communicate module level information to LLVM.
    --   For example:
    --     !llvm.module.linkage = !{ !0, !1 }
    --

    -- | A reference to an un-named metadata node.
    newtype MetaId = MetaId Int
                   deriving (MetaId -> MetaId -> Bool
    (MetaId -> MetaId -> Bool)
    -> (MetaId -> MetaId -> Bool) -> Eq MetaId
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: MetaId -> MetaId -> Bool
    == :: MetaId -> MetaId -> Bool
    $c/= :: MetaId -> MetaId -> Bool
    /= :: MetaId -> MetaId -> Bool
    Eq, Eq MetaId
    Eq MetaId =>
    (MetaId -> MetaId -> Ordering)
    -> (MetaId -> MetaId -> Bool)
    -> (MetaId -> MetaId -> Bool)
    -> (MetaId -> MetaId -> Bool)
    -> (MetaId -> MetaId -> Bool)
    -> (MetaId -> MetaId -> MetaId)
    -> (MetaId -> MetaId -> MetaId)
    -> Ord MetaId
    MetaId -> MetaId -> Bool
    MetaId -> MetaId -> Ordering
    MetaId -> MetaId -> MetaId
    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 :: MetaId -> MetaId -> Ordering
    compare :: MetaId -> MetaId -> Ordering
    $c< :: MetaId -> MetaId -> Bool
    < :: MetaId -> MetaId -> Bool
    $c<= :: MetaId -> MetaId -> Bool
    <= :: MetaId -> MetaId -> Bool
    $c> :: MetaId -> MetaId -> Bool
    > :: MetaId -> MetaId -> Bool
    $c>= :: MetaId -> MetaId -> Bool
    >= :: MetaId -> MetaId -> Bool
    $cmax :: MetaId -> MetaId -> MetaId
    max :: MetaId -> MetaId -> MetaId
    $cmin :: MetaId -> MetaId -> MetaId
    min :: MetaId -> MetaId -> MetaId
    Ord, Int -> MetaId
    MetaId -> Int
    MetaId -> [MetaId]
    MetaId -> MetaId
    MetaId -> MetaId -> [MetaId]
    MetaId -> MetaId -> MetaId -> [MetaId]
    (MetaId -> MetaId)
    -> (MetaId -> MetaId)
    -> (Int -> MetaId)
    -> (MetaId -> Int)
    -> (MetaId -> [MetaId])
    -> (MetaId -> MetaId -> [MetaId])
    -> (MetaId -> MetaId -> [MetaId])
    -> (MetaId -> MetaId -> MetaId -> [MetaId])
    -> Enum MetaId
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: MetaId -> MetaId
    succ :: MetaId -> MetaId
    $cpred :: MetaId -> MetaId
    pred :: MetaId -> MetaId
    $ctoEnum :: Int -> MetaId
    toEnum :: Int -> MetaId
    $cfromEnum :: MetaId -> Int
    fromEnum :: MetaId -> Int
    $cenumFrom :: MetaId -> [MetaId]
    enumFrom :: MetaId -> [MetaId]
    $cenumFromThen :: MetaId -> MetaId -> [MetaId]
    enumFromThen :: MetaId -> MetaId -> [MetaId]
    $cenumFromTo :: MetaId -> MetaId -> [MetaId]
    enumFromTo :: MetaId -> MetaId -> [MetaId]
    $cenumFromThenTo :: MetaId -> MetaId -> MetaId -> [MetaId]
    enumFromThenTo :: MetaId -> MetaId -> MetaId -> [MetaId]
    Enum)

    instance Outputable MetaId where
        ppr :: MetaId -> SDoc
    ppr = MetaId -> SDoc
    forall doc. IsLine doc => MetaId -> doc
    ppMetaId

    ppMetaId :: IsLine doc => MetaId -> doc
    ppMetaId :: forall doc. IsLine doc => MetaId -> doc
    ppMetaId (MetaId Int
    n) = Char -> doc
    forall doc. IsLine doc => Char -> doc
    char Char
    '!' doc -> doc -> doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Int -> doc
    forall doc. IsLine doc => Int -> doc
    int Int
    n
    {-# SPECIALIZE ppMetaId :: MetaId -> SDoc #-}
    {-# SPECIALIZE ppMetaId :: MetaId -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

    -- | LLVM metadata expressions
    data MetaExpr = MetaStr !LMString
                  | MetaLit !LlvmLit
                  | MetaNode !MetaId
                  | MetaVar !LlvmVar
                  | MetaStruct [MetaExpr]
                  deriving (MetaExpr -> MetaExpr -> Bool
    (MetaExpr -> MetaExpr -> Bool)
    -> (MetaExpr -> MetaExpr -> Bool) -> Eq MetaExpr
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: MetaExpr -> MetaExpr -> Bool
    == :: MetaExpr -> MetaExpr -> Bool
    $c/= :: MetaExpr -> MetaExpr -> Bool
    /= :: MetaExpr -> MetaExpr -> Bool
    Eq)

    -- | Associates some metadata with a specific label for attaching to an
    -- instruction.
    data MetaAnnot = MetaAnnot LMString MetaExpr
                   deriving (MetaAnnot -> MetaAnnot -> Bool
    (MetaAnnot -> MetaAnnot -> Bool)
    -> (MetaAnnot -> MetaAnnot -> Bool) -> Eq MetaAnnot
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: MetaAnnot -> MetaAnnot -> Bool
    == :: MetaAnnot -> MetaAnnot -> Bool
    $c/= :: MetaAnnot -> MetaAnnot -> Bool
    /= :: MetaAnnot -> MetaAnnot -> Bool
    Eq)

    -- | Metadata declarations. Metadata can only be declared in global scope.
    data MetaDecl
        -- | Named metadata. Only used for communicating module information to
        -- LLVM. ('!name = !{ [!\<n>] }' form).
        = MetaNamed !LMString [MetaId]
        -- | Metadata node declaration.
        -- ('!0 = metadata !{ \<metadata expression> }' form).
        | MetaUnnamed !MetaId !MetaExpr

    ----------------------------------------------------------------
    -- Module flags
    ----------------------------------------------------------------
    data ModuleFlagBehavior
      = MFBError
      | MFBWarning
      | MFBRequire
      | MFBOverride
      | MFBAppend
      | MFBAppendUnique
      | MFBMax
      | MFBMin

    moduleFlagBehaviorToMetaExpr :: ModuleFlagBehavior -> MetaExpr
    moduleFlagBehaviorToMetaExpr :: ModuleFlagBehavior -> MetaExpr
    moduleFlagBehaviorToMetaExpr ModuleFlagBehavior
    mfb =
        LlvmLit -> MetaExpr
    MetaLit (LlvmLit -> MetaExpr) -> LlvmLit -> MetaExpr
    forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit Integer
    n LlvmType
    i32
      where
        n :: Integer
    n = case ModuleFlagBehavior
    mfb of
          ModuleFlagBehavior
    MFBError -> Integer
    1
          ModuleFlagBehavior
    MFBWarning -> Integer
    2
          ModuleFlagBehavior
    MFBRequire -> Integer
    3
          ModuleFlagBehavior
    MFBOverride -> Integer
    4
          ModuleFlagBehavior
    MFBAppend -> Integer
    5
          ModuleFlagBehavior
    MFBAppendUnique -> Integer
    6
          ModuleFlagBehavior
    MFBMax -> Integer
    7
          ModuleFlagBehavior
    MFBMin -> Integer
    8

    data ModuleFlag = ModuleFlag { ModuleFlag -> ModuleFlagBehavior
    mfBehavior :: ModuleFlagBehavior
                                 , ModuleFlag -> LMString
    mfName :: LMString
                                 , ModuleFlag -> MetaExpr
    mfValue :: MetaExpr
                                 }

    moduleFlagToMetaExpr :: ModuleFlag -> MetaExpr
    moduleFlagToMetaExpr :: ModuleFlag -> MetaExpr
    moduleFlagToMetaExpr ModuleFlag
    flag = [MetaExpr] -> MetaExpr
    MetaStruct
        [ ModuleFlagBehavior -> MetaExpr
    moduleFlagBehaviorToMetaExpr (ModuleFlag -> ModuleFlagBehavior
    mfBehavior ModuleFlag
    flag)
        , LMString -> MetaExpr
    MetaStr (ModuleFlag -> LMString
    mfName ModuleFlag
    flag)
        , ModuleFlag -> MetaExpr
    mfValue ModuleFlag
    flag
        ]