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

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

    #include "HsVersions.h"

    import GHC.Prelude

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

    import GHC.StgToCmm.CgUtils ( fixStgRegisters )
    import GHC.Cmm
    import GHC.Cmm.Dataflow.Collections
    import GHC.Cmm.Ppr

    import GHC.Utils.BufHandle
    import GHC.Driver.Session
    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 GHC.SysTools ( figureLlvmVersion )
    import qualified GHC.Data.Stream as Stream

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

    -- -----------------------------------------------------------------------------
    -- | Top-level of the LLVM Code generator
    --
    llvmCodeGen :: Logger -> DynFlags -> Handle
                   -> Stream.Stream IO RawCmmGroup a
                   -> IO a
    llvmCodeGen :: forall a.
    Logger -> DynFlags -> Handle -> Stream IO RawCmmGroup a -> IO a
    llvmCodeGen Logger
    logger DynFlags
    dflags Handle
    h Stream IO RawCmmGroup a
    cmm_stream
      = Logger -> DynFlags -> SDoc -> (a -> ()) -> IO a -> IO a
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> DynFlags -> SDoc -> (a -> ()) -> m a -> m a
    withTiming Logger
    logger DynFlags
    dflags (String -> SDoc
    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
           BufHandle
    bufh <- Handle -> IO BufHandle
    newBufHandle Handle
    h

           -- Pass header
           Logger -> DynFlags -> String -> IO ()
    showPass Logger
    logger DynFlags
    dflags String
    "LLVM CodeGen"

           -- get llvm version, cache for later use
           Maybe LlvmVersion
    mb_ver <- Logger -> DynFlags -> IO (Maybe LlvmVersion)
    figureLlvmVersion Logger
    logger DynFlags
    dflags

           -- warn if unsupported
           Maybe LlvmVersion -> (LlvmVersion -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ Maybe LlvmVersion
    mb_ver ((LlvmVersion -> IO ()) -> IO ())
    -> (LlvmVersion -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \LlvmVersion
    ver -> do
             Logger -> DynFlags -> Int -> SDoc -> IO ()
    debugTraceMsg Logger
    logger DynFlags
    dflags Int
    2
                  (String -> SDoc
    text String
    "Using LLVM version:" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text (LlvmVersion -> String
    llvmVersionStr LlvmVersion
    ver))
             let doWarn :: Bool
    doWarn = WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnUnsupportedLlvmVersion DynFlags
    dflags
             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 -> DynFlags -> SDoc -> IO ()
    putMsg Logger
    logger DynFlags
    dflags (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
               SDoc
    "You are using an unsupported version of LLVM!" SDoc -> SDoc -> SDoc
    $$
               SDoc
    "Currently only" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text (LlvmVersion -> String
    llvmVersionStr LlvmVersion
    supportedLlvmVersionLowerBound) SDoc -> SDoc -> SDoc
    <+>
               SDoc
    "to" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text (LlvmVersion -> String
    llvmVersionStr LlvmVersion
    supportedLlvmVersionUpperBound) SDoc -> SDoc -> SDoc
    <+> SDoc
    "is supported." SDoc -> SDoc -> SDoc
    <+>
               SDoc
    "System LLVM version: " SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text (LlvmVersion -> String
    llvmVersionStr LlvmVersion
    ver) SDoc -> SDoc -> SDoc
    $$
               SDoc
    "We will try though..."
             let isS390X :: Bool
    isS390X = Platform -> Arch
    platformArch (DynFlags -> Platform
    targetPlatform DynFlags
    dflags) Arch -> Arch -> Bool
    forall a. Eq a => a -> a -> Bool
    == Arch
    ArchS390X
             let major_ver :: Int
    major_ver = [Int] -> Int
    forall a. [a] -> a
    head ([Int] -> Int) -> (LlvmVersion -> [Int]) -> LlvmVersion -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LlvmVersion -> [Int]
    llvmVersionList (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 -> DynFlags -> SDoc -> IO ()
    putMsg Logger
    logger DynFlags
    dflags (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
    <+>
               SDoc
    "You are using LLVM version: " SDoc -> SDoc -> SDoc
    <> String -> SDoc
    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
    llvm_ver = LlvmVersion -> Maybe LlvmVersion -> LlvmVersion
    forall a. a -> Maybe a -> a
    fromMaybe LlvmVersion
    supportedLlvmVersionLowerBound Maybe LlvmVersion
    mb_ver

           -- run code generation
           a
    a <- Logger -> DynFlags -> LlvmVersion -> BufHandle -> LlvmM a -> IO a
    forall a.
    Logger -> DynFlags -> LlvmVersion -> BufHandle -> LlvmM a -> IO a
    runLlvm Logger
    logger DynFlags
    dflags LlvmVersion
    llvm_ver BufHandle
    bufh (LlvmM a -> IO a) -> LlvmM a -> IO a
    forall a b. (a -> b) -> a -> b
    $
             DynFlags -> Stream IO RawCmmGroup a -> LlvmM a
    forall a. DynFlags -> Stream IO RawCmmGroup a -> LlvmM a
    llvmCodeGen' DynFlags
    dflags Stream IO RawCmmGroup a
    cmm_stream

           BufHandle -> IO ()
    bFlush BufHandle
    bufh

           a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    llvmCodeGen' :: DynFlags -> Stream.Stream IO RawCmmGroup a -> LlvmM a
    llvmCodeGen' :: forall a. DynFlags -> Stream IO RawCmmGroup a -> LlvmM a
    llvmCodeGen' DynFlags
    dflags Stream IO RawCmmGroup a
    cmm_stream
      = do  -- Preamble
            SDoc -> LlvmM ()
    renderLlvm SDoc
    header
            LlvmM ()
    ghcInternalFunctions
            LlvmM ()
    cmmMetaLlvmPrelude

            -- Procedures
            a
    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 forall a1. IO a1 -> LlvmM a1
    liftIO RawCmmGroup -> LlvmM ()
    llvmGroupLlvmGens

            -- Declare aliases for forward references
            LlvmOpts
    opts <- LlvmM LlvmOpts
    getLlvmOpts
            SDoc -> LlvmM ()
    renderLlvm (SDoc -> LlvmM ()) -> (LlvmData -> SDoc) -> LlvmData -> LlvmM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LlvmOpts -> LlvmData -> SDoc
    pprLlvmData LlvmOpts
    opts (LlvmData -> LlvmM ()) -> LlvmM LlvmData -> LlvmM ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< LlvmM LlvmData
    generateExternDecls

            -- Postamble
            LlvmM ()
    cmmUsedLlvmGens

            a -> LlvmM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a
      where
        header :: SDoc
        header :: SDoc
    header =
          let target :: String
    target = PlatformMisc -> String
    platformMisc_llvmTarget (PlatformMisc -> String) -> PlatformMisc -> String
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> PlatformMisc
    platformMisc DynFlags
    dflags
          in     String -> SDoc
    text (String
    "target datalayout = \"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ LlvmConfig -> String -> String
    getDataLayout (DynFlags -> LlvmConfig
    llvmConfig DynFlags
    dflags) String
    target String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\"")
             SDoc -> SDoc -> SDoc
    $+$ String -> SDoc
    text (String
    "target triple = \"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    target String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\"")

        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
    text String
    "Target:" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    target SDoc -> SDoc -> SDoc
    $$
                       SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Available targets:") Int
    4
                            ([SDoc] -> SDoc
    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
    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)

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

            -- Insert functions into map, collect data
            let split :: GenCmmDecl b (map RawCmmStatics) (GenCmmGraph n)
    -> LlvmM (Maybe (Section, b))
    split (CmmData Section
    s b
    d' )     = Maybe (Section, b) -> LlvmM (Maybe (Section, b))
    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 map RawCmmStatics
    h CLabel
    l [GlobalReg]
    live GenCmmGraph n
    g) = do
                  -- Set function type
                  let l' :: CLabel
    l' = case KeyOf map -> map RawCmmStatics -> Maybe RawCmmStatics
    forall (map :: * -> *) a.
    IsMap map =>
    KeyOf map -> map a -> Maybe a
    mapLookup (GenCmmGraph n -> Label
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Label
    g_entry GenCmmGraph n
    g) map RawCmmStatics
    h :: Maybe RawCmmStatics of
                             Maybe RawCmmStatics
    Nothing                   -> CLabel
    l
                             Just (CmmStaticsRaw CLabel
    info_lbl [CmmStatic]
    _) -> CLabel
    info_lbl
                  LMString
    lml <- CLabel -> LlvmM LMString
    strCLabel_llvm CLabel
    l'
                  LMString -> LlvmType -> LlvmM ()
    forall key. Uniquable key => key -> LlvmType -> LlvmM ()
    funInsert LMString
    lml (LlvmType -> LlvmM ()) -> LlvmM LlvmType -> LlvmM ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [GlobalReg] -> LlvmM LlvmType
    llvmFunTy [GlobalReg]
    live
                  Maybe (Section, b) -> LlvmM (Maybe (Section, b))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Section, b)
    forall a. Maybe a
    Nothing
            [(Section, RawCmmStatics)]
    cdata <- ([Maybe (Section, RawCmmStatics)] -> [(Section, RawCmmStatics)])
    -> LlvmM [Maybe (Section, RawCmmStatics)]
    -> LlvmM [(Section, RawCmmStatics)]
    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)
    mapM GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    -> LlvmM (Maybe (Section, RawCmmStatics))
    forall {map :: * -> *} {b}
           {n :: Extensibility -> Extensibility -> *}.
    (KeyOf map ~ Label, IsMap map) =>
    GenCmmDecl b (map RawCmmStatics) (GenCmmGraph n)
    -> LlvmM (Maybe (Section, b))
    split RawCmmGroup
    cmm

            {-# SCC "llvm_datas_gen" #-}
              [(Section, RawCmmStatics)] -> LlvmM ()
    cmmDataLlvmGens [(Section, RawCmmStatics)]
    cdata
            {-# SCC "llvm_procs_gen" #-}
              (GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
     -> LlvmM ())
    -> RawCmmGroup -> LlvmM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    -> LlvmM ()
    cmmLlvmGen RawCmmGroup
    cmm

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

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

           let ([[LMGlobal]] -> [LMGlobal]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat -> [LMGlobal]
    gs, [[LlvmType]]
    tss) = [LlvmData] -> ([[LMGlobal]], [[LlvmType]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [LlvmData]
    lmdatas

           let regGlobal :: LMGlobal -> LlvmM ()
    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 (f :: * -> *) a. Applicative f => a -> f a
    pure ()
           (LMGlobal -> LlvmM ()) -> [LMGlobal] -> LlvmM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ LMGlobal -> LlvmM ()
    regGlobal [LMGlobal]
    gs
           [[LMGlobal]]
    gss' <- (LMGlobal -> LlvmM [LMGlobal]) -> [LMGlobal] -> LlvmM [[LMGlobal]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM LMGlobal -> LlvmM [LMGlobal]
    aliasify ([LMGlobal] -> LlvmM [[LMGlobal]])
    -> [LMGlobal] -> LlvmM [[LMGlobal]]
    forall a b. (a -> b) -> a -> b
    $ [LMGlobal]
    gs

           LlvmOpts
    opts <- LlvmM LlvmOpts
    getLlvmOpts
           SDoc -> LlvmM ()
    renderLlvm (SDoc -> LlvmM ()) -> SDoc -> LlvmM ()
    forall a b. (a -> b) -> a -> b
    $ LlvmOpts -> LlvmData -> SDoc
    pprLlvmData LlvmOpts
    opts ([[LMGlobal]] -> [LMGlobal]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[LMGlobal]]
    gss', [[LlvmType]] -> [LlvmType]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[LlvmType]]
    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
    platform <- LlvmM Platform
    getPlatform
        let fixed_cmm :: GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    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

        DumpFlag -> String -> DumpFormat -> SDoc -> LlvmM ()
    dumpIfSetLlvm DumpFlag
    Opt_D_dump_opt_cmm String
    "Optimised Cmm"
          DumpFormat
    FormatCMM (Platform -> RawCmmGroup -> SDoc
    forall d info g.
    (OutputableP Platform d, OutputableP Platform info,
     OutputableP Platform g) =>
    Platform -> GenCmmGroup d info g -> SDoc
    pprCmmGroup Platform
    platform [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    fixed_cmm])

        -- generate llvm code from cmm
        [LlvmCmmDecl]
    llvmBC <- LlvmM [LlvmCmmDecl] -> LlvmM [LlvmCmmDecl]
    forall a. LlvmM a -> LlvmM a
    withClearVars (LlvmM [LlvmCmmDecl] -> LlvmM [LlvmCmmDecl])
    -> LlvmM [LlvmCmmDecl] -> LlvmM [LlvmCmmDecl]
    forall a b. (a -> b) -> a -> b
    $ GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    -> LlvmM [LlvmCmmDecl]
    genLlvmProc GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
    fixed_cmm

        -- pretty print
        ([SDoc]
    docs, [[LlvmVar]]
    ivars) <- ([(SDoc, [LlvmVar])] -> ([SDoc], [[LlvmVar]]))
    -> LlvmM [(SDoc, [LlvmVar])] -> LlvmM ([SDoc], [[LlvmVar]])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [(SDoc, [LlvmVar])] -> ([SDoc], [[LlvmVar]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (LlvmM [(SDoc, [LlvmVar])] -> LlvmM ([SDoc], [[LlvmVar]]))
    -> LlvmM [(SDoc, [LlvmVar])] -> LlvmM ([SDoc], [[LlvmVar]])
    forall a b. (a -> b) -> a -> b
    $ (LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar]))
    -> [LlvmCmmDecl] -> LlvmM [(SDoc, [LlvmVar])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
    pprLlvmCmmDecl [LlvmCmmDecl]
    llvmBC

        -- Output, note down used variables
        SDoc -> LlvmM ()
    renderLlvm ([SDoc] -> SDoc
    vcat [SDoc]
    docs)
        (LlvmVar -> LlvmM ()) -> [LlvmVar] -> LlvmM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ LlvmVar -> LlvmM ()
    markUsedVar ([LlvmVar] -> LlvmM ()) -> [LlvmVar] -> LlvmM ()
    forall a b. (a -> b) -> a -> b
    $ [[LlvmVar]] -> [LlvmVar]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[LlvmVar]]
    ivars

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

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

    cmmMetaLlvmPrelude :: LlvmM ()
    cmmMetaLlvmPrelude :: LlvmM ()
    cmmMetaLlvmPrelude = do
      [MetaDecl]
    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)
    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
        MetaId
    tbaaId <- LlvmM MetaId
    getMetaUniqueId
        Unique -> MetaId -> LlvmM ()
    setUniqMeta Unique
    uniq MetaId
    tbaaId
        Maybe MetaId
    parentId <- LlvmM (Maybe MetaId)
    -> (Unique -> LlvmM (Maybe MetaId))
    -> Maybe Unique
    -> LlvmM (Maybe MetaId)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Maybe MetaId -> LlvmM (Maybe MetaId)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe MetaId
    forall a. Maybe a
    Nothing) Unique -> LlvmM (Maybe MetaId)
    getUniqMeta Maybe Unique
    parent
        -- Build definition
        MetaDecl -> LlvmM MetaDecl
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MetaDecl -> LlvmM MetaDecl) -> MetaDecl -> LlvmM MetaDecl
    forall a b. (a -> b) -> a -> b
    $ MetaId -> MetaExpr -> MetaDecl
    MetaUnnamed MetaId
    tbaaId (MetaExpr -> MetaDecl) -> MetaExpr -> MetaDecl
    forall a b. (a -> b) -> a -> b
    $ [MetaExpr] -> MetaExpr
    MetaStruct ([MetaExpr] -> MetaExpr) -> [MetaExpr] -> MetaExpr
    forall a b. (a -> b) -> a -> b
    $
              case Maybe MetaId
    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 ]
      LlvmOpts
    opts <- LlvmM LlvmOpts
    getLlvmOpts
      SDoc -> LlvmM ()
    renderLlvm (SDoc -> LlvmM ()) -> SDoc -> LlvmM ()
    forall a b. (a -> b) -> a -> b
    $ LlvmOpts -> [MetaDecl] -> SDoc
    ppLlvmMetas LlvmOpts
    opts [MetaDecl]
    metas

    -- -----------------------------------------------------------------------------
    -- | 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.
      [LlvmVar]
    ivars <- LlvmM [LlvmVar]
    getUsedVars
      let cast :: LlvmVar -> LlvmStatic
    cast LlvmVar
    x = LlvmStatic -> LlvmType -> LlvmStatic
    LMBitc (LlvmVar -> LlvmStatic
    LMStaticPointer (LlvmVar -> LlvmVar
    pVarLift LlvmVar
    x)) LlvmType
    i8Ptr
          ty :: LlvmType
    ty     = (Int -> LlvmType -> LlvmType
    LMArray ([LlvmVar] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [LlvmVar]
    ivars) LlvmType
    i8Ptr)
          usedArray :: LlvmStatic
    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 :: LMSection
    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 :: LlvmVar
    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 :: LMGlobal
    lmUsed    = LlvmVar -> Maybe LlvmStatic -> LMGlobal
    LMGlobal LlvmVar
    lmUsedVar (LlvmStatic -> Maybe LlvmStatic
    forall a. a -> Maybe a
    Just LlvmStatic
    usedArray)
      LlvmOpts
    opts <- LlvmM LlvmOpts
    getLlvmOpts
      if [LlvmVar] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LlvmVar]
    ivars
         then () -> LlvmM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
         else SDoc -> LlvmM ()
    renderLlvm (SDoc -> LlvmM ()) -> SDoc -> LlvmM ()
    forall a b. (a -> b) -> a -> b
    $ LlvmOpts -> LlvmData -> SDoc
    pprLlvmData LlvmOpts
    opts ([LMGlobal
    lmUsed], [])