    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE FlexibleContexts #-}

    ----------------------------------------------------------------------------
    --
    -- Pretty-printing of common Cmm types
    --
    -- (c) The University of Glasgow 2004-2006
    --
    -----------------------------------------------------------------------------

    --
    -- This is where we walk over Cmm emitting an external representation,
    -- suitable for parsing, in a syntax strongly reminiscent of C--. This
    -- is the "External Core" for the Cmm layer.
    --
    -- As such, this should be a well-defined syntax: we want it to look nice.
    -- Thus, we try wherever possible to use syntax defined in [1],
    -- "The C-- Reference Manual", http://www.cs.tufts.edu/~nr/c--/index.html. We
    -- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather
    -- than C--'s bits8 .. bits64.
    --
    -- We try to ensure that all information available in the abstract
    -- syntax is reproduced, or reproducible, in the concrete syntax.
    -- Data that is not in printed out can be reconstructed according to
    -- conventions used in the pretty printer. There are at least two such
    -- cases:
    --      1) if a value has wordRep type, the type is not appended in the
    --      output.
    --      2) MachOps that operate over wordRep type are printed in a
    --      C-style, rather than as their internal MachRep name.
    --
    -- These conventions produce much more readable Cmm output.
    --
    -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
    --

    {-# OPTIONS_GHC -fno-warn-orphans #-}
    module GHC.Cmm.Ppr.Decl
        ( pprCmms, pprCmmGroup, pprSection, pprStatic
        )
    where

    import GHC.Prelude

    import GHC.Platform
    import GHC.Cmm.Ppr.Expr
    import GHC.Cmm

    import GHC.Utils.Outputable
    import GHC.Data.FastString

    import Data.List (intersperse)

    import qualified Data.ByteString as BS

    pprCmms :: (OutputableP Platform info, OutputableP Platform g)
            => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc
    pprCmms :: forall info g.
    (OutputableP Platform info, OutputableP Platform g) =>
    Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc
    pprCmms Platform
    platform [GenCmmGroup RawCmmStatics info g]
    cmms = LabelStyle -> SDoc -> SDoc
    pprCode LabelStyle
    CStyle ([SDoc] -> SDoc
    vcat (SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    intersperse SDoc
    separator ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ (GenCmmGroup RawCmmStatics info g -> SDoc)
    -> [GenCmmGroup RawCmmStatics info g] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> GenCmmGroup RawCmmStatics info g -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform) [GenCmmGroup RawCmmStatics info g]
    cmms))
            where
              separator :: SDoc
    separator = SDoc
    space SDoc -> SDoc -> SDoc
    $$ FilePath -> SDoc
    text FilePath
    "-------------------" SDoc -> SDoc -> SDoc
    $$ SDoc
    space

    -----------------------------------------------------------------------------

    instance (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
          => OutputableP Platform (GenCmmDecl d info i) where
        pdoc :: Platform -> GenCmmDecl d info i -> SDoc
    pdoc = Platform -> GenCmmDecl d info i -> SDoc
    forall d info i.
    (OutputableP Platform d, OutputableP Platform info,
     OutputableP Platform i) =>
    Platform -> GenCmmDecl d info i -> SDoc
    pprTop

    instance OutputableP Platform (GenCmmStatics a) where
        pdoc :: Platform -> GenCmmStatics a -> SDoc
    pdoc = Platform -> GenCmmStatics a -> SDoc
    forall (a :: Bool). Platform -> GenCmmStatics a -> SDoc
    pprStatics

    instance OutputableP Platform CmmStatic where
        pdoc :: Platform -> CmmStatic -> SDoc
    pdoc = Platform -> CmmStatic -> SDoc
    pprStatic

    instance OutputableP Platform CmmInfoTable where
        pdoc :: Platform -> CmmInfoTable -> SDoc
    pdoc = Platform -> CmmInfoTable -> SDoc
    pprInfoTable

    -----------------------------------------------------------------------------

    pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g)
                => Platform -> GenCmmGroup d info g -> SDoc
    pprCmmGroup :: forall d info g.
    (OutputableP Platform d, OutputableP Platform info,
     OutputableP Platform g) =>
    Platform -> GenCmmGroup d info g -> SDoc
    pprCmmGroup Platform
    platform GenCmmGroup d info g
    tops
        = [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    intersperse SDoc
    blankLine ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ (GenCmmDecl d info g -> SDoc) -> GenCmmGroup d info g -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> GenCmmDecl d info g -> SDoc
    forall d info i.
    (OutputableP Platform d, OutputableP Platform info,
     OutputableP Platform i) =>
    Platform -> GenCmmDecl d info i -> SDoc
    pprTop Platform
    platform) GenCmmGroup d info g
    tops

    -- --------------------------------------------------------------------------
    -- Top level `procedure' blocks.
    --
    pprTop :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
           => Platform -> GenCmmDecl d info i -> SDoc

    pprTop :: forall d info i.
    (OutputableP Platform d, OutputableP Platform info,
     OutputableP Platform i) =>
    Platform -> GenCmmDecl d info i -> SDoc
    pprTop Platform
    platform (CmmProc info
    info CLabel
    lbl [GlobalReg]
    live i
    graph)

      = [SDoc] -> SDoc
    vcat [ Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    lbl SDoc -> SDoc -> SDoc
    <> SDoc
    lparen SDoc -> SDoc -> SDoc
    <> SDoc
    rparen SDoc -> SDoc -> SDoc
    <+> SDoc
    lbrace SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    text FilePath
    "// " SDoc -> SDoc -> SDoc
    <+> [GlobalReg] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [GlobalReg]
    live
             , Int -> SDoc -> SDoc
    nest Int
    8 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc
    lbrace SDoc -> SDoc -> SDoc
    <+> Platform -> info -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform info
    info SDoc -> SDoc -> SDoc
    $$ SDoc
    rbrace
             , Int -> SDoc -> SDoc
    nest Int
    4 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Platform -> i -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform i
    graph
             , SDoc
    rbrace ]

    -- --------------------------------------------------------------------------
    -- We follow [1], 4.5
    --
    --      section "data" { ... }
    --
    pprTop Platform
    platform (CmmData Section
    section d
    ds) =
        (SDoc -> Int -> SDoc -> SDoc
    hang (Platform -> Section -> SDoc
    pprSection Platform
    platform Section
    section SDoc -> SDoc -> SDoc
    <+> SDoc
    lbrace) Int
    4 (Platform -> d -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform d
    ds))
        SDoc -> SDoc -> SDoc
    $$ SDoc
    rbrace

    -- --------------------------------------------------------------------------
    -- Info tables.

    pprInfoTable :: Platform -> CmmInfoTable -> SDoc
    pprInfoTable :: Platform -> CmmInfoTable -> SDoc
    pprInfoTable Platform
    platform (CmmInfoTable { cit_lbl :: CmmInfoTable -> CLabel
    cit_lbl = CLabel
    lbl, cit_rep :: CmmInfoTable -> SMRep
    cit_rep = SMRep
    rep
                               , cit_prof :: CmmInfoTable -> ProfilingInfo
    cit_prof = ProfilingInfo
    prof_info
                               , cit_srt :: CmmInfoTable -> Maybe CLabel
    cit_srt = Maybe CLabel
    srt })
      = [SDoc] -> SDoc
    vcat [ FilePath -> SDoc
    text FilePath
    "label: " SDoc -> SDoc -> SDoc
    <> Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    lbl
             , FilePath -> SDoc
    text FilePath
    "rep: " SDoc -> SDoc -> SDoc
    <> SMRep -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SMRep
    rep
             , case ProfilingInfo
    prof_info of
                 ProfilingInfo
    NoProfilingInfo -> SDoc
    empty
                 ProfilingInfo ByteString
    ct ByteString
    cd ->
                   [SDoc] -> SDoc
    vcat [ FilePath -> SDoc
    text FilePath
    "type: " SDoc -> SDoc -> SDoc
    <> FilePath -> SDoc
    text ([Word8] -> FilePath
    forall a. Show a => a -> FilePath
    show (ByteString -> [Word8]
    BS.unpack ByteString
    ct))
                        , FilePath -> SDoc
    text FilePath
    "desc: " SDoc -> SDoc -> SDoc
    <> FilePath -> SDoc
    text ([Word8] -> FilePath
    forall a. Show a => a -> FilePath
    show (ByteString -> [Word8]
    BS.unpack ByteString
    cd)) ]
             , FilePath -> SDoc
    text FilePath
    "srt: " SDoc -> SDoc -> SDoc
    <> Platform -> Maybe CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform Maybe CLabel
    srt ]

    instance Outputable ForeignHint where
      ppr :: ForeignHint -> SDoc
    ppr ForeignHint
    NoHint     = SDoc
    empty
      ppr ForeignHint
    SignedHint = SDoc -> SDoc
    quotes(FilePath -> SDoc
    text FilePath
    "signed")
    --  ppr AddrHint   = quotes(text "address")
    -- Temp Jan08
      ppr ForeignHint
    AddrHint   = (FilePath -> SDoc
    text FilePath
    "PtrHint")

    -- --------------------------------------------------------------------------
    -- Static data.
    --      Strings are printed as C strings, and we print them as I8[],
    --      following C--
    --

    pprStatics :: Platform -> GenCmmStatics a -> SDoc
    pprStatics :: forall (a :: Bool). Platform -> GenCmmStatics a -> SDoc
    pprStatics Platform
    platform (CmmStatics CLabel
    lbl CmmInfoTable
    itbl CostCentreStack
    ccs [CmmLit]
    payload) =
      Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    lbl SDoc -> SDoc -> SDoc
    <> SDoc
    colon SDoc -> SDoc -> SDoc
    <+> Platform -> CmmInfoTable -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmInfoTable
    itbl SDoc -> SDoc -> SDoc
    <+> CostCentreStack -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CostCentreStack
    ccs SDoc -> SDoc -> SDoc
    <+> Platform -> [CmmLit] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [CmmLit]
    payload
    pprStatics Platform
    platform (CmmStaticsRaw CLabel
    lbl [CmmStatic]
    ds) = [SDoc] -> SDoc
    vcat ((Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    lbl SDoc -> SDoc -> SDoc
    <> SDoc
    colon) SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : (CmmStatic -> SDoc) -> [CmmStatic] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmStatic -> SDoc
    pprStatic Platform
    platform) [CmmStatic]
    ds)

    pprStatic :: Platform -> CmmStatic -> SDoc
    pprStatic :: Platform -> CmmStatic -> SDoc
    pprStatic Platform
    platform CmmStatic
    s = case CmmStatic
    s of
        CmmStaticLit CmmLit
    lit   -> Int -> SDoc -> SDoc
    nest Int
    4 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ FilePath -> SDoc
    text FilePath
    "const" SDoc -> SDoc -> SDoc
    <+> Platform -> CmmLit -> SDoc
    pprLit Platform
    platform CmmLit
    lit SDoc -> SDoc -> SDoc
    <> SDoc
    semi
        CmmUninitialised Int
    i -> Int -> SDoc -> SDoc
    nest Int
    4 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ FilePath -> SDoc
    text FilePath
    "I8" SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    brackets (Int -> SDoc
    int Int
    i)
        CmmString ByteString
    s'       -> Int -> SDoc -> SDoc
    nest Int
    4 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ FilePath -> SDoc
    text FilePath
    "I8[]" SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    text (ByteString -> FilePath
    forall a. Show a => a -> FilePath
    show ByteString
    s')
        CmmFileEmbed FilePath
    path  -> Int -> SDoc -> SDoc
    nest Int
    4 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ FilePath -> SDoc
    text FilePath
    "incbin " SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    text (FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    path)

    -- --------------------------------------------------------------------------
    -- data sections
    --
    pprSection :: Platform -> Section -> SDoc
    pprSection :: Platform -> Section -> SDoc
    pprSection Platform
    platform (Section SectionType
    t CLabel
    suffix) =
      SDoc
    section SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    doubleQuotes (SectionType -> SDoc
    pprSectionType SectionType
    t SDoc -> SDoc -> SDoc
    <+> Char -> SDoc
    char Char
    '.' SDoc -> SDoc -> SDoc
    <+> Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    suffix)
      where
        section :: SDoc
    section = FilePath -> SDoc
    text FilePath
    "section"

    pprSectionType :: SectionType -> SDoc
    pprSectionType :: SectionType -> SDoc
    pprSectionType SectionType
    s = SDoc -> SDoc
    doubleQuotes (PtrString -> SDoc
    ptext PtrString
    t)
     where
      t :: PtrString
    t = case SectionType
    s of
        SectionType
    Text              -> FilePath -> PtrString
    sLit FilePath
    "text"
        SectionType
    Data              -> FilePath -> PtrString
    sLit FilePath
    "data"
        SectionType
    ReadOnlyData      -> FilePath -> PtrString
    sLit FilePath
    "readonly"
        SectionType
    ReadOnlyData16    -> FilePath -> PtrString
    sLit FilePath
    "readonly16"
        SectionType
    RelocatableReadOnlyData
                          -> FilePath -> PtrString
    sLit FilePath
    "relreadonly"
        SectionType
    UninitialisedData -> FilePath -> PtrString
    sLit FilePath
    "uninitialised"
        SectionType
    CString           -> FilePath -> PtrString
    sLit FilePath
    "cstring"
        OtherSection FilePath
    s'   -> FilePath -> PtrString
    sLit FilePath
    s' -- Not actually a literal though.