    {-# LANGUAGE CPP #-}

    -- ----------------------------------------------------------------------------
    -- | Pretty print helpers for the LLVM Code generator.
    --
    module GHC.CmmToLlvm.Ppr (
            pprLlvmCmmDecl, pprLlvmData, infoSection
        ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Driver.Ppr

    import GHC.Llvm
    import GHC.CmmToLlvm.Base
    import GHC.CmmToLlvm.Data

    import GHC.Cmm.CLabel
    import GHC.Cmm

    import GHC.Data.FastString
    import GHC.Utils.Outputable
    import GHC.Types.Unique

    -- ----------------------------------------------------------------------------
    -- * Top level
    --

    -- | Pretty print LLVM data code
    pprLlvmData :: LlvmOpts -> LlvmData -> SDoc
    pprLlvmData :: LlvmOpts -> LlvmData -> SDoc
    pprLlvmData LlvmOpts
    opts ([LMGlobal]
    globals, [LlvmType]
    types) =
        let ppLlvmTys :: LlvmType -> SDoc
    ppLlvmTys (LMAlias    LlvmAlias
    a) = LlvmAlias -> SDoc
    ppLlvmAlias LlvmAlias
    a
            ppLlvmTys (LMFunction LlvmFunctionDecl
    f) = LlvmFunctionDecl -> SDoc
    ppLlvmFunctionDecl LlvmFunctionDecl
    f
            ppLlvmTys LlvmType
    _other         = SDoc
    empty

            types' :: SDoc
    types'   = [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (LlvmType -> SDoc) -> [LlvmType] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map LlvmType -> SDoc
    ppLlvmTys [LlvmType]
    types
            globals' :: SDoc
    globals' = LlvmOpts -> [LMGlobal] -> SDoc
    ppLlvmGlobals LlvmOpts
    opts [LMGlobal]
    globals
        in SDoc
    types' SDoc -> SDoc -> SDoc
    $+$ SDoc
    globals'

    -- | Pretty print LLVM code
    pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
    pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar])
    pprLlvmCmmDecl (CmmData Section
    _ [LlvmData]
    lmdata) = do
      LlvmOpts
    opts <- LlvmM LlvmOpts
    getLlvmOpts
      (SDoc, [LlvmVar]) -> LlvmM (SDoc, [LlvmVar])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (LlvmData -> SDoc) -> [LlvmData] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (LlvmOpts -> LlvmData -> SDoc
    pprLlvmData LlvmOpts
    opts) [LlvmData]
    lmdata, [])

    pprLlvmCmmDecl (CmmProc Maybe RawCmmStatics
    mb_info CLabel
    entry_lbl [GlobalReg]
    live (ListGraph [GenBasicBlock LlvmStatement]
    blks))
      = do let lbl :: CLabel
    lbl = case Maybe RawCmmStatics
    mb_info of
                         Maybe RawCmmStatics
    Nothing -> CLabel
    entry_lbl
                         Just (CmmStaticsRaw CLabel
    info_lbl [CmmStatic]
    _) -> CLabel
    info_lbl
               link :: LlvmLinkageType
    link = if CLabel -> Bool
    externallyVisibleCLabel CLabel
    lbl
                          then LlvmLinkageType
    ExternallyVisible
                          else LlvmLinkageType
    Internal
               lmblocks :: [LlvmBlock]
    lmblocks = (GenBasicBlock LlvmStatement -> LlvmBlock)
    -> [GenBasicBlock LlvmStatement] -> [LlvmBlock]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(BasicBlock BlockId
    id [LlvmStatement]
    stmts) ->
                                    LlvmBlockId -> [LlvmStatement] -> LlvmBlock
    LlvmBlock (BlockId -> LlvmBlockId
    forall a. Uniquable a => a -> LlvmBlockId
    getUnique BlockId
    id) [LlvmStatement]
    stmts) [GenBasicBlock LlvmStatement]
    blks

           LlvmFunctionDecl
    funDec <- [GlobalReg] -> CLabel -> LlvmLinkageType -> LlvmM LlvmFunctionDecl
    llvmFunSig [GlobalReg]
    live CLabel
    lbl LlvmLinkageType
    link
           DynFlags
    dflags <- LlvmM DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           LlvmOpts
    opts <- LlvmM LlvmOpts
    getLlvmOpts
           Platform
    platform <- LlvmM Platform
    getPlatform
           let buildArg :: LlvmVar -> FastString
    buildArg = String -> FastString
    fsLit (String -> FastString)
    -> (LlvmVar -> String) -> LlvmVar -> FastString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (SDoc -> String) -> (LlvmVar -> SDoc) -> LlvmVar -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LlvmOpts -> LlvmVar -> SDoc
    ppPlainName LlvmOpts
    opts
               funArgs :: [FastString]
    funArgs = (LlvmVar -> FastString) -> [LlvmVar] -> [FastString]
    forall a b. (a -> b) -> [a] -> [b]
    map LlvmVar -> FastString
    buildArg (Platform -> [GlobalReg] -> [LlvmVar]
    llvmFunArgs Platform
    platform [GlobalReg]
    live)
               funSect :: LMSection
    funSect = LlvmOpts -> FastString -> LMSection
    llvmFunSection LlvmOpts
    opts (LlvmFunctionDecl -> FastString
    decName LlvmFunctionDecl
    funDec)

           -- generate the info table
           Maybe LlvmStatic
    prefix <- case Maybe RawCmmStatics
    mb_info of
                         Maybe RawCmmStatics
    Nothing -> Maybe LlvmStatic -> LlvmM (Maybe LlvmStatic)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe LlvmStatic
    forall a. Maybe a
    Nothing
                         Just (CmmStaticsRaw CLabel
    _ [CmmStatic]
    statics) -> do
                           [LlvmStatic]
    infoStatics <- (CmmStatic -> LlvmM LlvmStatic)
    -> [CmmStatic] -> LlvmM [LlvmStatic]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM CmmStatic -> LlvmM LlvmStatic
    genData [CmmStatic]
    statics
                           let infoTy :: LlvmType
    infoTy = [LlvmType] -> LlvmType
    LMStruct ([LlvmType] -> LlvmType) -> [LlvmType] -> LlvmType
    forall a b. (a -> b) -> a -> b
    $ (LlvmStatic -> LlvmType) -> [LlvmStatic] -> [LlvmType]
    forall a b. (a -> b) -> [a] -> [b]
    map LlvmStatic -> LlvmType
    getStatType [LlvmStatic]
    infoStatics
                           Maybe LlvmStatic -> LlvmM (Maybe LlvmStatic)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe LlvmStatic -> LlvmM (Maybe LlvmStatic))
    -> Maybe LlvmStatic -> LlvmM (Maybe LlvmStatic)
    forall a b. (a -> b) -> a -> b
    $ LlvmStatic -> Maybe LlvmStatic
    forall a. a -> Maybe a
    Just (LlvmStatic -> Maybe LlvmStatic) -> LlvmStatic -> Maybe LlvmStatic
    forall a b. (a -> b) -> a -> b
    $ [LlvmStatic] -> LlvmType -> LlvmStatic
    LMStaticStruc [LlvmStatic]
    infoStatics LlvmType
    infoTy

           let fun :: LlvmFunction
    fun = LlvmFunctionDecl
    -> [FastString]
    -> [LlvmFuncAttr]
    -> LMSection
    -> Maybe LlvmStatic
    -> [LlvmBlock]
    -> LlvmFunction
    LlvmFunction LlvmFunctionDecl
    funDec [FastString]
    funArgs [LlvmFuncAttr]
    llvmStdFunAttrs LMSection
    funSect
                                  Maybe LlvmStatic
    prefix [LlvmBlock]
    lmblocks
               name :: FastString
    name = LlvmFunctionDecl -> FastString
    decName (LlvmFunctionDecl -> FastString) -> LlvmFunctionDecl -> FastString
    forall a b. (a -> b) -> a -> b
    $ LlvmFunction -> LlvmFunctionDecl
    funcDecl LlvmFunction
    fun
               defName :: FastString
    defName = FastString -> FastString
    llvmDefLabel FastString
    name
               funcDecl' :: LlvmFunctionDecl
    funcDecl' = (LlvmFunction -> LlvmFunctionDecl
    funcDecl LlvmFunction
    fun) { decName :: FastString
    decName = FastString
    defName }
               fun' :: LlvmFunction
    fun' = LlvmFunction
    fun { funcDecl :: LlvmFunctionDecl
    funcDecl = LlvmFunctionDecl
    funcDecl' }
               funTy :: LlvmType
    funTy = LlvmFunctionDecl -> LlvmType
    LMFunction LlvmFunctionDecl
    funcDecl'
               funVar :: LlvmVar
    funVar = FastString
    -> LlvmType
    -> LlvmLinkageType
    -> LMSection
    -> LMAlign
    -> LMConst
    -> LlvmVar
    LMGlobalVar FastString
    name
                                    (LlvmType -> LlvmType
    LMPointer LlvmType
    funTy)
                                    LlvmLinkageType
    link
                                    LMSection
    forall a. Maybe a
    Nothing
                                    LMAlign
    forall a. Maybe a
    Nothing
                                    LMConst
    Alias
               defVar :: LlvmVar
    defVar = FastString
    -> LlvmType
    -> LlvmLinkageType
    -> LMSection
    -> LMAlign
    -> LMConst
    -> LlvmVar
    LMGlobalVar FastString
    defName
                                    (LlvmType -> LlvmType
    LMPointer LlvmType
    funTy)
                                    (LlvmFunctionDecl -> LlvmLinkageType
    funcLinkage LlvmFunctionDecl
    funcDecl')
                                    (LlvmFunction -> LMSection
    funcSect LlvmFunction
    fun)
                                    (LlvmFunctionDecl -> LMAlign
    funcAlign LlvmFunctionDecl
    funcDecl')
                                    LMConst
    Alias
               alias :: LMGlobal
    alias = LlvmVar -> Maybe LlvmStatic -> LMGlobal
    LMGlobal LlvmVar
    funVar
                                (LlvmStatic -> Maybe LlvmStatic
    forall a. a -> Maybe a
    Just (LlvmStatic -> Maybe LlvmStatic) -> LlvmStatic -> Maybe LlvmStatic
    forall a b. (a -> b) -> a -> b
    $ LlvmStatic -> LlvmType -> LlvmStatic
    LMBitc (LlvmVar -> LlvmStatic
    LMStaticPointer LlvmVar
    defVar)
                                               LlvmType
    i8Ptr)

           (SDoc, [LlvmVar]) -> LlvmM (SDoc, [LlvmVar])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LlvmOpts -> LMGlobal -> SDoc
    ppLlvmGlobal LlvmOpts
    opts LMGlobal
    alias SDoc -> SDoc -> SDoc
    $+$ LlvmOpts -> LlvmFunction -> SDoc
    ppLlvmFunction LlvmOpts
    opts LlvmFunction
    fun', [])

    -- | The section we are putting info tables and their entry code into, should
    -- be unique since we process the assembly pattern matching this.
    infoSection :: String
    infoSection :: String
    infoSection = String
    "X98A__STRIP,__me"