    {-# LANGUAGE TypeFamilies, ViewPatterns, OverloadedStrings #-}

    -- -----------------------------------------------------------------------------
    -- | This is the top-level module in the LLVM code generator.
    --
    module GHC.CmmToLlvm
       ( LlvmVersion
       , llvmVersionList
       , llvmCodeGen
       , llvmFixupAsm
       )
    where

    import GHC.Prelude hiding ( head )

    import GHC.Llvm
    import GHC.CmmToLlvm.Base
    import GHC.CmmToLlvm.CodeGen
    import GHC.CmmToLlvm.Config
    import GHC.CmmToLlvm.Data
    import GHC.CmmToLlvm.Ppr
    import GHC.CmmToLlvm.Regs
    import GHC.CmmToLlvm.Mangler
    import GHC.CmmToLlvm.Version

    import GHC.StgToCmm.CgUtils ( fixStgRegisters )
    import GHC.Cmm
    import GHC.Cmm.Dataflow.Label

    import GHC.Utils.BufHandle
    import GHC.Driver.DynFlags
    import GHC.Platform ( platformArch, Arch(..) )
    import GHC.Utils.Error
    import GHC.Data.FastString
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Logger
    import qualified GHC.Data.Stream as Stream

    import Control.Monad ( when, forM_ )
    import Data.List.NonEmpty ( head )
    import Data.Maybe ( fromMaybe, catMaybes )
    import System.IO

    -- -----------------------------------------------------------------------------
    -- | Top-level of the LLVM Code generator
    --
    llvmCodeGen :: Logger -> LlvmCgConfig -> Handle
                   -> Stream.Stream IO RawCmmGroup a
                   -> IO a
    llvmCodeGen :: forall a.
    Logger -> LlvmCgConfig -> Handle -> Stream IO RawCmmGroup a -> IO a
    llvmCodeGen Logger
    logger LlvmCgConfig
    cfg Handle
    h Stream IO RawCmmGroup a
    cmm_stream
      = Logger -> SDoc -> (a -> ()) -> IO a -> IO a
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> SDoc -> (a -> ()) -> m a -> m a
    withTiming Logger
    logger (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "LLVM CodeGen") (() -> a -> ()
    forall a b. a -> b -> a
    const ()) (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ do
           bufh <- Handle -> IO BufHandle
    newBufHandle Handle
    h

           -- Pass header
           showPass logger "LLVM CodeGen"

           -- get llvm version, cache for later use
           let mb_ver = LlvmCgConfig -> Maybe LlvmVersion
    llvmCgLlvmVersion LlvmCgConfig
    cfg

           -- warn if unsupported
           forM_ mb_ver $ \LlvmVersion
    ver -> do
             Logger -> Int -> SDoc -> IO ()
    debugTraceMsg Logger
    logger Int
    2
                  (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Using LLVM version:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (LlvmVersion -> String
    llvmVersionStr LlvmVersion
    ver))
             let doWarn :: Bool
    doWarn = LlvmCgConfig -> Bool
    llvmCgDoWarn LlvmCgConfig
    cfg
             Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (LlvmVersion -> Bool
    llvmVersionSupported LlvmVersion
    ver) Bool -> Bool -> Bool
    && Bool
    doWarn) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> SDoc -> IO ()
    putMsg Logger
    logger (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
               SDoc
    "You are using an unsupported version of LLVM!" SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
               SDoc
    "Currently only" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (LlvmVersion -> String
    llvmVersionStr LlvmVersion
    supportedLlvmVersionLowerBound) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
               SDoc
    "up to" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (LlvmVersion -> String
    llvmVersionStr LlvmVersion
    supportedLlvmVersionUpperBound) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    "(non inclusive) is supported." SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
               SDoc
    "System LLVM version: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (LlvmVersion -> String
    llvmVersionStr LlvmVersion
    ver) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
               SDoc
    "We will try though..."
             let isS390X :: Bool
    isS390X = Platform -> Arch
    platformArch (LlvmCgConfig -> Platform
    llvmCgPlatform LlvmCgConfig
    cfg)  Arch -> Arch -> Bool
    forall a. Eq a => a -> a -> Bool
    == Arch
    ArchS390X
             let major_ver :: Int
    major_ver = NonEmpty Int -> Int
    forall a. NonEmpty a -> a
    head (NonEmpty Int -> Int)
    -> (LlvmVersion -> NonEmpty Int) -> LlvmVersion -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LlvmVersion -> NonEmpty Int
    llvmVersionNE (LlvmVersion -> Int) -> LlvmVersion -> Int
    forall a b. (a -> b) -> a -> b
    $ LlvmVersion
    ver
             Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    isS390X Bool -> Bool -> Bool
    && Int
    major_ver Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    10 Bool -> Bool -> Bool
    && Bool
    doWarn) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> SDoc -> IO ()
    putMsg Logger
    logger (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
               SDoc
    "Warning: For s390x the GHC calling convention is only supported since LLVM version 10." SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
               SDoc
    "You are using LLVM version: " SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (LlvmVersion -> String
    llvmVersionStr LlvmVersion
    ver)

           -- HACK: the Nothing case here is potentially wrong here but we
           -- currently don't use the LLVM version to guide code generation
           -- so this is okay.
           let llvm_ver :: LlvmVersion
               llvm_ver = LlvmVersion -> Maybe LlvmVersion -> LlvmVersion
    forall a. a -> Maybe a -> a
    fromMaybe LlvmVersion
    supportedLlvmVersionLowerBound Maybe LlvmVersion
    mb_ver

           -- run code generation
           a <- runLlvm logger cfg llvm_ver bufh $
             llvmCodeGen' cfg cmm_stream

           bFlush bufh

           return a

    llvmCodeGen' :: LlvmCgConfig -> Stream.Stream IO RawCmmGroup a -> LlvmM a
    llvmCodeGen' :: forall a. LlvmCgConfig -> Stream IO RawCmmGroup a -> LlvmM a
    llvmCodeGen' LlvmCgConfig
    cfg Stream IO RawCmmGroup a
    cmm_stream
      = do  -- Preamble
            HDoc -> SDoc -> LlvmM ()
    renderLlvm (LlvmCgConfig -> HDoc
    forall doc. IsDoc doc => LlvmCgConfig -> doc
    llvmHeader LlvmCgConfig
    cfg) (LlvmCgConfig -> SDoc
    forall doc. IsDoc doc => LlvmCgConfig -> doc
    llvmHeader LlvmCgConfig
    cfg)
            LlvmM ()
    ghcInternalFunctions
            LlvmM ()
    cmmMetaLlvmPrelude

            -- Procedures
            a <- Stream IO RawCmmGroup a
    -> (forall a1. IO a1 -> LlvmM a1)
    -> (RawCmmGroup -> LlvmM ())
    -> LlvmM a
    forall (m :: * -> *) (n :: * -> *) a b.
    (Monad m, Monad n) =>
    Stream m a b -> (forall a1. m a1 -> n a1) -> (a -> n ()) -> n b
    Stream.consume Stream IO RawCmmGroup a
    cmm_stream IO a1 -> LlvmM a1
    forall a1. IO a1 -> LlvmM a1
    liftIO RawCmmGroup -> LlvmM ()
    llvmGroupLlvmGens

            -- Declare aliases for forward references
            decls <- generateExternDecls
            renderLlvm (pprLlvmData cfg decls)
                       (pprLlvmData cfg decls)

            -- Postamble
            cmmUsedLlvmGens

            return a

    llvmHeader :: IsDoc doc => LlvmCgConfig -> doc
    llvmHeader :: forall doc. IsDoc doc => LlvmCgConfig -> doc
    llvmHeader LlvmCgConfig
    cfg =
      let target :: String
    target  = LlvmCgConfig -> String
    llvmCgLlvmTarget LlvmCgConfig
    cfg
          llvmCfg :: LlvmConfig
    llvmCfg = LlvmCgConfig -> LlvmConfig
    llvmCgLlvmConfig LlvmCgConfig
    cfg
      in [Line doc] -> doc
    forall doc. IsDoc doc => [Line doc] -> doc
    lines_
          [ String -> Line doc
    forall doc. IsLine doc => String -> doc
    text String
    "target datalayout = \"" Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> Line doc
    forall doc. IsLine doc => String -> doc
    text (LlvmConfig -> String -> String
    getDataLayout LlvmConfig
    llvmCfg String
    target) Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> Line doc
    forall doc. IsLine doc => String -> doc
    text String
    "\""
          , String -> Line doc
    forall doc. IsLine doc => String -> doc
    text String
    "target triple = \"" Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> Line doc
    forall doc. IsLine doc => String -> doc
    text String
    target Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> Line doc
    forall doc. IsLine doc => String -> doc
    text String
    "\"" ]
      where
        getDataLayout :: LlvmConfig -> String -> String
        getDataLayout :: LlvmConfig -> String -> String
    getDataLayout LlvmConfig
    config String
    target =
          case String -> [(String, LlvmTarget)] -> Maybe LlvmTarget
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    target (LlvmConfig -> [(String, LlvmTarget)]
    llvmTargets LlvmConfig
    config) of
            Just (LlvmTarget {lDataLayout :: LlvmTarget -> String
    lDataLayout=String
    dl}) -> String
    dl
            Maybe LlvmTarget
    Nothing -> String -> SDoc -> String
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "Failed to lookup LLVM data layout" (SDoc -> String) -> SDoc -> String
    forall a b. (a -> b) -> a -> b
    $
                       String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Target:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    target SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                       SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Available targets:") Int
    4
                            ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ ((String, LlvmTarget) -> SDoc) -> [(String, LlvmTarget)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String -> SDoc)
    -> ((String, LlvmTarget) -> String) -> (String, LlvmTarget) -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, LlvmTarget) -> String
    forall a b. (a, b) -> a
    fst) ([(String, LlvmTarget)] -> [SDoc])
    -> [(String, LlvmTarget)] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ LlvmConfig -> [(String, LlvmTarget)]
    llvmTargets LlvmConfig
    config)
    {-# SPECIALIZE llvmHeader :: LlvmCgConfig -> SDoc #-}
    {-# SPECIALIZE llvmHeader :: LlvmCgConfig -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

    llvmGroupLlvmGens :: RawCmmGroup -> LlvmM ()
    llvmGroupLlvmGens :: RawCmmGroup -> LlvmM ()
    llvmGroupLlvmGens RawCmmGroup
    cmm = do

            -- Insert functions into map, collect data
            let split :: GenCmmDecl b (LabelMap RawCmmStatics) (GenCmmGraph n)
    -> LlvmM (Maybe (Section, b))
    split (CmmData Section
    s b
    d' )     = Maybe (Section, b) -> LlvmM (Maybe (Section, b))
    forall a. a -> LlvmM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Section, b) -> LlvmM (Maybe (Section, b)))
    -> Maybe (Section, b) -> LlvmM (Maybe (Section, b))
    forall a b. (a -> b) -> a -> b
    $ (Section, b) -> Maybe (Section, b)
    forall a. a -> Maybe a
    Just (Section
    s, b
    d')
                split (CmmProc LabelMap RawCmmStatics
    h CLabel
    l [GlobalReg]
    live GenCmmGraph n
    g) = do
                  -- Set function type
                  let l' :: CLabel
    l' = case Label -> LabelMap RawCmmStatics -> Maybe RawCmmStatics
    forall a. Label -> LabelMap a -> Maybe a
    mapLookup (GenCmmGraph n -> Label
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Label
    g_entry GenCmmGraph n
    g) LabelMap RawCmmStatics
    h :: Maybe RawCmmStatics of
                             Maybe RawCmmStatics
    Nothing                   -> CLabel
    l
                             Just (CmmStaticsRaw CLabel
    info_lbl [CmmStatic]
    _) -> CLabel
    info_lbl
                  lml <- CLabel -> LlvmM LMString
    strCLabel_llvm CLabel
    l'
                  funInsert lml =<< llvmFunTy live
                  return Nothing
            cdata <- ([Maybe (Section, RawCmmStatics)] -> [(Section, RawCmmStatics)])
    -> LlvmM [Maybe (Section, RawCmmStatics)]
    -> LlvmM [(Section, RawCmmStatics)]
    forall a b. (a -> b) -> LlvmM a -> LlvmM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Maybe (Section, RawCmmStatics)] -> [(Section, RawCmmStatics)]
    forall a. [Maybe a] -> [a]
    catMaybes (LlvmM [Maybe (Section, RawCmmStatics)]
     -> LlvmM [(Section, RawCmmStatics)])
    -> LlvmM [Maybe (Section, RawCmmStatics)]
    -> LlvmM [(Section, RawCmmStatics)]
    forall a b. (a -> b) -> a -> b
    $ (GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
     -> LlvmM (Maybe (Section, RawCmmStatics)))
    -> RawCmmGroup -> LlvmM [Maybe (Section, RawCmmStatics)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    -> LlvmM (Maybe (Section, RawCmmStatics))
    forall {b} {n :: Extensibility -> Extensibility -> *}.
    GenCmmDecl b (LabelMap RawCmmStatics) (GenCmmGraph n)
    -> LlvmM (Maybe (Section, b))
    split RawCmmGroup
    cmm

            {-# SCC "llvm_datas_gen" #-}
              cmmDataLlvmGens cdata
            {-# SCC "llvm_procs_gen" #-}
              mapM_ cmmLlvmGen cmm

    -- -----------------------------------------------------------------------------
    -- | Do LLVM code generation on all these Cmms data sections.
    --
    cmmDataLlvmGens :: [(Section,RawCmmStatics)] -> LlvmM ()

    cmmDataLlvmGens :: [(Section, RawCmmStatics)] -> LlvmM ()
    cmmDataLlvmGens [(Section, RawCmmStatics)]
    statics
      = do lmdatas <- ((Section, RawCmmStatics) -> LlvmM ([LMGlobal], [LlvmType]))
    -> [(Section, RawCmmStatics)] -> LlvmM [([LMGlobal], [LlvmType])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Section, RawCmmStatics) -> LlvmM ([LMGlobal], [LlvmType])
    genLlvmData [(Section, RawCmmStatics)]
    statics

           let (concat -> gs, tss) = unzip lmdatas

           let regGlobal (LMGlobal (LMGlobalVar LMString
    l LlvmType
    ty LlvmLinkageType
    _ LMSection
    _ LMAlign
    _ LMConst
    _) Maybe LlvmStatic
    _)
                            = LMString -> LlvmType -> LlvmM ()
    forall key. Uniquable key => key -> LlvmType -> LlvmM ()
    funInsert LMString
    l LlvmType
    ty
               regGlobal LMGlobal
    _  = () -> LlvmM ()
    forall a. a -> LlvmM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
           mapM_ regGlobal gs
           gss' <- mapM aliasify gs

           cfg <- getConfig
           renderLlvm (pprLlvmData cfg (concat gss', concat tss))
                      (pprLlvmData cfg (concat gss', concat tss))

    -- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
    cmmLlvmGen ::RawCmmDecl -> LlvmM ()
    cmmLlvmGen :: GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    -> LlvmM ()
    cmmLlvmGen cmm :: GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    cmm@CmmProc{} = do

        -- rewrite assignments to global regs
        platform <- LlvmM Platform
    getPlatform
        let fixed_cmm = {-# SCC "llvm_fix_regs" #-} Platform
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    -> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    fixStgRegisters Platform
    platform GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    cmm

        dumpIfSetLlvm Opt_D_dump_opt_cmm "Optimised Cmm"
          FormatCMM (pprCmmGroup platform [fixed_cmm])

        -- generate llvm code from cmm
        llvmBC <- withClearVars $ genLlvmProc fixed_cmm

        -- pretty print - print as we go, since we produce HDocs, we know
        -- no nesting state needs to be maintained for the SDocs.
        forM_ llvmBC (\LlvmCmmDecl
    decl -> do
            (hdoc, sdoc) <- LlvmCmmDecl -> LlvmM (HDoc, SDoc)
    pprLlvmCmmDecl LlvmCmmDecl
    decl
            renderLlvm (hdoc $$ empty) (sdoc $$ empty)
          )

    cmmLlvmGen GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    _ = () -> LlvmM ()
    forall a. a -> LlvmM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- -----------------------------------------------------------------------------
    -- | Generate meta data nodes
    --

    cmmMetaLlvmPrelude :: LlvmM ()
    cmmMetaLlvmPrelude :: LlvmM ()
    cmmMetaLlvmPrelude = do
      tbaa_metas <- (((Unique, LMString, Maybe Unique) -> LlvmM MetaDecl)
     -> [(Unique, LMString, Maybe Unique)] -> LlvmM [MetaDecl])
    -> [(Unique, LMString, Maybe Unique)]
    -> ((Unique, LMString, Maybe Unique) -> LlvmM MetaDecl)
    -> LlvmM [MetaDecl]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((Unique, LMString, Maybe Unique) -> LlvmM MetaDecl)
    -> [(Unique, LMString, Maybe Unique)] -> LlvmM [MetaDecl]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM [(Unique, LMString, Maybe Unique)]
    stgTBAA (((Unique, LMString, Maybe Unique) -> LlvmM MetaDecl)
     -> LlvmM [MetaDecl])
    -> ((Unique, LMString, Maybe Unique) -> LlvmM MetaDecl)
    -> LlvmM [MetaDecl]
    forall a b. (a -> b) -> a -> b
    $ \(Unique
    uniq, LMString
    name, Maybe Unique
    parent) -> do
        -- Generate / lookup meta data IDs
        tbaaId <- LlvmM MetaId
    getMetaUniqueId
        setUniqMeta uniq tbaaId
        parentId <- maybe (return Nothing) getUniqMeta parent
        -- Build definition
        return $ MetaUnnamed tbaaId $ MetaStruct $
              case parentId of
                  Just MetaId
    p  -> [ LMString -> MetaExpr
    MetaStr LMString
    name, MetaId -> MetaExpr
    MetaNode MetaId
    p ]
                  -- As of LLVM 4.0, a node without parents should be rendered as
                  -- just a name on its own. Previously `null` was accepted as the
                  -- name.
                  Maybe MetaId
    Nothing -> [ LMString -> MetaExpr
    MetaStr LMString
    name ]

      platform <- getPlatform
      cfg <- getConfig
      let stack_alignment_metas =
              case Platform -> Arch
    platformArch Platform
    platform of
                Arch
    ArchX86_64 | LlvmCgConfig -> Bool
    llvmCgAvxEnabled LlvmCgConfig
    cfg -> [Integer -> ModuleFlag
    mkStackAlignmentMeta Integer
    32]
                Arch
    _                                 -> []
      module_flags_metas <- mkModuleFlagsMeta stack_alignment_metas
      let metas = [MetaDecl]
    tbaa_metas [MetaDecl] -> [MetaDecl] -> [MetaDecl]
    forall a. [a] -> [a] -> [a]
    ++ [MetaDecl]
    module_flags_metas
      cfg <- getConfig
      renderLlvm (ppLlvmMetas cfg metas)
                 (ppLlvmMetas cfg metas)

    mkNamedMeta :: LMString -> [MetaExpr] -> LlvmM [MetaDecl]
    mkNamedMeta :: LMString -> [MetaExpr] -> LlvmM [MetaDecl]
    mkNamedMeta LMString
    name [MetaExpr]
    exprs = do
        (ids, decls) <- [(MetaId, MetaDecl)] -> ([MetaId], [MetaDecl])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(MetaId, MetaDecl)] -> ([MetaId], [MetaDecl]))
    -> LlvmM [(MetaId, MetaDecl)] -> LlvmM ([MetaId], [MetaDecl])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (MetaExpr -> LlvmM (MetaId, MetaDecl))
    -> [MetaExpr] -> LlvmM [(MetaId, MetaDecl)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM MetaExpr -> LlvmM (MetaId, MetaDecl)
    f [MetaExpr]
    exprs
        return $ decls ++ [MetaNamed name ids]
      where
        f :: MetaExpr -> LlvmM (MetaId, MetaDecl)
    f MetaExpr
    expr = do
          i <- LlvmM MetaId
    getMetaUniqueId
          return (i, MetaUnnamed i expr)

    mkModuleFlagsMeta :: [ModuleFlag] -> LlvmM [MetaDecl]
    mkModuleFlagsMeta :: [ModuleFlag] -> LlvmM [MetaDecl]
    mkModuleFlagsMeta =
        LMString -> [MetaExpr] -> LlvmM [MetaDecl]
    mkNamedMeta LMString
    "llvm.module.flags" ([MetaExpr] -> LlvmM [MetaDecl])
    -> ([ModuleFlag] -> [MetaExpr]) -> [ModuleFlag] -> LlvmM [MetaDecl]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ModuleFlag -> MetaExpr) -> [ModuleFlag] -> [MetaExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleFlag -> MetaExpr
    moduleFlagToMetaExpr

    mkStackAlignmentMeta :: Integer -> ModuleFlag
    mkStackAlignmentMeta :: Integer -> ModuleFlag
    mkStackAlignmentMeta Integer
    alignment =
        ModuleFlagBehavior -> LMString -> MetaExpr -> ModuleFlag
    ModuleFlag ModuleFlagBehavior
    MFBError LMString
    "override-stack-alignment" (LlvmLit -> MetaExpr
    MetaLit (LlvmLit -> MetaExpr) -> LlvmLit -> MetaExpr
    forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit Integer
    alignment LlvmType
    i32)

    -- -----------------------------------------------------------------------------
    -- | Marks variables as used where necessary
    --

    cmmUsedLlvmGens :: LlvmM ()
    cmmUsedLlvmGens :: LlvmM ()
    cmmUsedLlvmGens = do

      -- LLVM would discard variables that are internal and not obviously
      -- used if we didn't provide these hints. This will generate a
      -- definition of the form
      --
      --   @llvm.used = appending global [42 x i8*] [i8* bitcast <var> to i8*, ...]
      --
      -- Which is the LLVM way of protecting them against getting removed.
      ivars <- LlvmM [LlvmVar]
    getUsedVars
      let cast LlvmVar
    x = LlvmStatic -> LlvmType -> LlvmStatic
    LMBitc (LlvmVar -> LlvmStatic
    LMStaticPointer (LlvmVar -> LlvmVar
    pVarLift LlvmVar
    x)) LlvmType
    i8Ptr
          ty     = Int -> LlvmType -> LlvmType
    LMArray ([LlvmVar] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [LlvmVar]
    ivars) LlvmType
    i8Ptr
          usedArray = [LlvmStatic] -> LlvmType -> LlvmStatic
    LMStaticArray ((LlvmVar -> LlvmStatic) -> [LlvmVar] -> [LlvmStatic]
    forall a b. (a -> b) -> [a] -> [b]
    map LlvmVar -> LlvmStatic
    cast [LlvmVar]
    ivars) LlvmType
    ty
          sectName  = LMString -> LMSection
    forall a. a -> Maybe a
    Just (LMString -> LMSection) -> LMString -> LMSection
    forall a b. (a -> b) -> a -> b
    $ String -> LMString
    fsLit String
    "llvm.metadata"
          lmUsedVar = LMString
    -> LlvmType
    -> LlvmLinkageType
    -> LMSection
    -> LMAlign
    -> LMConst
    -> LlvmVar
    LMGlobalVar (String -> LMString
    fsLit String
    "llvm.used") LlvmType
    ty LlvmLinkageType
    Appending LMSection
    sectName LMAlign
    forall a. Maybe a
    Nothing LMConst
    Constant
          lmUsed    = LlvmVar -> Maybe LlvmStatic -> LMGlobal
    LMGlobal LlvmVar
    lmUsedVar (LlvmStatic -> Maybe LlvmStatic
    forall a. a -> Maybe a
    Just LlvmStatic
    usedArray)
      if null ivars
         then return ()
         else do
          cfg <- getConfig
          renderLlvm (pprLlvmData cfg ([lmUsed], []))
                     (pprLlvmData cfg ([lmUsed], []))