{-# 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.