-- Cmm representations using Hoopl's Graph CmmNode e x.
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE EmptyCase #-}

module GHC.Cmm (
     -- * Cmm top-level datatypes
     DCmmGroup,
     CmmProgram, CmmGroup, CmmGroupSRTs, RawCmmGroup, GenCmmGroup,
     CmmDecl, DCmmDecl, CmmDeclSRTs, GenCmmDecl(..),
     CmmDataDecl, cmmDataDeclCmmDecl, DCmmGraph,
     CmmGraph, GenCmmGraph, GenGenCmmGraph(..),
     toBlockMap, revPostorder, toBlockList,
     CmmBlock, RawCmmDecl,
     Section(..), SectionType(..),
     GenCmmStatics(..), type CmmStatics, type RawCmmStatics, CmmStatic(..),
     SectionProtection(..), sectionProtection,

     DWrap(..), unDeterm, removeDeterm, removeDetermDecl, removeDetermGraph,

     -- ** Blocks containing lists
     GenBasicBlock(..), blockId,
     ListGraph(..), pprBBlock,

     -- * Info Tables
     GenCmmTopInfo(..)
     , DCmmTopInfo
     , CmmTopInfo
     , CmmStackInfo(..), CmmInfoTable(..), topInfoTable, topInfoTableD,
     ClosureTypeInfo(..),
     ProfilingInfo(..), ConstrDescription,

     -- * Statements, expressions and types
     module GHC.Cmm.Node,
     module GHC.Cmm.Expr,

     -- * Pretty-printing
     pprCmmGroup, pprSection, pprStatic
  ) where

import GHC.Prelude

import GHC.Platform
import GHC.Types.Id
import GHC.Types.CostCentre
import GHC.Cmm.CLabel
import GHC.Cmm.BlockId
import GHC.Cmm.Node
import GHC.Runtime.Heap.Layout
import GHC.Cmm.Expr
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Utils.Outputable

import Data.Void (Void)
import Data.List (intersperse)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS

-----------------------------------------------------------------------------
--  Cmm, GenCmm
-----------------------------------------------------------------------------

-- A CmmProgram is a list of CmmGroups
-- A CmmGroup is a list of top-level declarations

-- When object-splitting is on, each group is compiled into a separate
-- .o file. So typically we put closely related stuff in a CmmGroup.
-- Section-splitting follows suit and makes one .text subsection for each
-- CmmGroup.

type CmmProgram = [CmmGroup]

type GenCmmGroup d h g = [GenCmmDecl d h g]
-- | Cmm group after STG generation
type DCmmGroup    = GenCmmGroup CmmStatics    DCmmTopInfo              DCmmGraph
-- | Cmm group before SRT generation
type CmmGroup     = GenCmmGroup CmmStatics    CmmTopInfo               CmmGraph
-- | Cmm group with SRTs
type CmmGroupSRTs = GenCmmGroup RawCmmStatics CmmTopInfo               CmmGraph
-- | "Raw" cmm group (TODO (osa): not sure what that means)
type RawCmmGroup  = GenCmmGroup RawCmmStatics (LabelMap RawCmmStatics) CmmGraph

-----------------------------------------------------------------------------
--  CmmDecl, GenCmmDecl
-----------------------------------------------------------------------------

-- GenCmmDecl is abstracted over
--   d, the type of static data elements in CmmData
--   h, the static info preceding the code of a CmmProc
--   g, the control-flow graph of a CmmProc
--
-- We expect there to be two main instances of this type:
--   (a) C--, i.e. populated with various C-- constructs
--   (b) Native code, populated with data/instructions

-- | A top-level chunk, abstracted over the type of the contents of
-- the basic blocks (Cmm or instructions are the likely instantiations).
data GenCmmDecl d h g
  = CmmProc     -- A procedure
     h                 -- Extra header such as the info table
     CLabel            -- Entry label
     [GlobalRegUse]    -- Registers live on entry. Note that the set of live
                       -- registers will be correct in generated C-- code, but
                       -- not in hand-written C-- code. However,
                       -- splitAtProcPoints calculates correct liveness
                       -- information for CmmProcs.
     g                 -- Control-flow graph for the procedure's code

  | CmmData     -- Static data
        Section
        d

  deriving ((forall a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b)
-> (forall a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a)
-> Functor (GenCmmDecl d h)
forall a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
forall a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
forall d h a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
forall d h a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall d h a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
fmap :: forall a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
$c<$ :: forall d h a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
<$ :: forall a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
Functor)

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

type DCmmDecl    = GenCmmDecl CmmStatics DCmmTopInfo DCmmGraph
type CmmDecl     = GenCmmDecl CmmStatics    CmmTopInfo CmmGraph
type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
type CmmDataDecl = GenCmmDataDecl CmmStatics
type GenCmmDataDecl d = GenCmmDecl d Void Void -- When `CmmProc` case can be statically excluded

cmmDataDeclCmmDecl :: GenCmmDataDecl d -> GenCmmDecl d h g
cmmDataDeclCmmDecl :: forall d h g. GenCmmDataDecl d -> GenCmmDecl d h g
cmmDataDeclCmmDecl = \ case
    CmmProc Void
void CLabel
_ [GlobalRegUse]
_ Void
_ -> case Void
void of
    CmmData Section
section d
d -> Section -> d -> GenCmmDecl d h g
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
section d
d
{-# INLINE cmmDataDeclCmmDecl #-}

type RawCmmDecl
   = GenCmmDecl
        RawCmmStatics
        (LabelMap RawCmmStatics)
        CmmGraph

-----------------------------------------------------------------------------
--     Graphs
-----------------------------------------------------------------------------

type CmmGraph = GenCmmGraph CmmNode
type DCmmGraph = GenGenCmmGraph DWrap CmmNode

type GenCmmGraph n = GenGenCmmGraph LabelMap n

data GenGenCmmGraph s n = CmmGraph { forall (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
GenGenCmmGraph s n -> BlockId
g_entry :: BlockId, forall (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
GenGenCmmGraph s n -> Graph' s Block n C C
g_graph :: Graph' s Block n C C }
type CmmBlock = Block CmmNode C C

instance OutputableP Platform CmmGraph where
    pdoc :: Platform -> CmmGraph -> SDoc
pdoc = Platform -> CmmGraph -> SDoc
pprCmmGraph

toBlockMap :: CmmGraph -> LabelMap CmmBlock
toBlockMap :: CmmGraph -> LabelMap CmmBlock
toBlockMap (CmmGraph {g_graph :: forall (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
GenGenCmmGraph s n -> Graph' s Block n C C
g_graph=GMany MaybeO C (Block CmmNode O C)
NothingO LabelMap CmmBlock
body MaybeO C (Block CmmNode C O)
NothingO}) = LabelMap CmmBlock
body

pprCmmGraph :: Platform -> CmmGraph -> SDoc
pprCmmGraph :: Platform -> CmmGraph -> SDoc
pprCmmGraph Platform
platform CmmGraph
g
   = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"{" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"offset"
  SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ ByteOff -> SDoc -> SDoc
nest ByteOff
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (CmmBlock -> SDoc) -> [CmmBlock] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmBlock -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform) [CmmBlock]
blocks)
  SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"}"
  where blocks :: [CmmBlock]
blocks = CmmGraph -> [CmmBlock]
revPostorder CmmGraph
g
    -- revPostorder has the side-effect of discarding unreachable code,
    -- so pretty-printed Cmm will omit any unreachable blocks.  This can
    -- sometimes be confusing.

revPostorder :: CmmGraph -> [CmmBlock]
revPostorder :: CmmGraph -> [CmmBlock]
revPostorder CmmGraph
g = {-# SCC "revPostorder" #-}
    LabelMap CmmBlock -> BlockId -> [CmmBlock]
forall (block :: Extensibility -> Extensibility -> *).
NonLocal block =>
LabelMap (block C C) -> BlockId -> [block C C]
revPostorderFrom (CmmGraph -> LabelMap CmmBlock
toBlockMap CmmGraph
g) (CmmGraph -> BlockId
forall (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
GenGenCmmGraph s n -> BlockId
g_entry CmmGraph
g)

toBlockList :: CmmGraph -> [CmmBlock]
toBlockList :: CmmGraph -> [CmmBlock]
toBlockList CmmGraph
g = LabelMap CmmBlock -> [CmmBlock]
forall a. LabelMap a -> [a]
mapElems (LabelMap CmmBlock -> [CmmBlock])
-> LabelMap CmmBlock -> [CmmBlock]
forall a b. (a -> b) -> a -> b
$ CmmGraph -> LabelMap CmmBlock
toBlockMap CmmGraph
g

-----------------------------------------------------------------------------
--     Info Tables
-----------------------------------------------------------------------------

-- | CmmTopInfo is attached to each CmmDecl (see defn of CmmGroup), and contains
-- the extra info (beyond the executable code) that belongs to that CmmDecl.
data GenCmmTopInfo f = TopInfo { forall (f :: * -> *). GenCmmTopInfo f -> f CmmInfoTable
info_tbls  :: f CmmInfoTable
                               , forall (f :: * -> *). GenCmmTopInfo f -> CmmStackInfo
stack_info :: CmmStackInfo }

newtype DWrap a = DWrap [(BlockId, a)]

unDeterm :: DWrap a -> [(BlockId, a)]
unDeterm :: forall a. DWrap a -> [(BlockId, a)]
unDeterm (DWrap [(BlockId, a)]
f) = [(BlockId, a)]
f

type DCmmTopInfo = GenCmmTopInfo DWrap
type CmmTopInfo  = GenCmmTopInfo LabelMap

instance OutputableP Platform CmmTopInfo where
    pdoc :: Platform -> CmmTopInfo -> SDoc
pdoc = Platform -> CmmTopInfo -> SDoc
pprTopInfo

pprTopInfo :: Platform -> CmmTopInfo -> SDoc
pprTopInfo :: Platform -> CmmTopInfo -> SDoc
pprTopInfo Platform
platform (TopInfo {info_tbls :: forall (f :: * -> *). GenCmmTopInfo f -> f CmmInfoTable
info_tbls=LabelMap CmmInfoTable
info_tbl, stack_info :: forall (f :: * -> *). GenCmmTopInfo f -> CmmStackInfo
stack_info=CmmStackInfo
stack_info}) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"info_tbls: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> LabelMap CmmInfoTable -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform LabelMap CmmInfoTable
info_tbl,
        FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"stack_info: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CmmStackInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmStackInfo
stack_info]

topInfoTableD :: GenCmmDecl a DCmmTopInfo (GenGenCmmGraph s n) -> Maybe CmmInfoTable
topInfoTableD :: forall a (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
GenCmmDecl a DCmmTopInfo (GenGenCmmGraph s n) -> Maybe CmmInfoTable
topInfoTableD (CmmProc DCmmTopInfo
infos CLabel
_ [GlobalRegUse]
_ GenGenCmmGraph s n
g) = case (DCmmTopInfo -> DWrap CmmInfoTable
forall (f :: * -> *). GenCmmTopInfo f -> f CmmInfoTable
info_tbls DCmmTopInfo
infos) of
                                          DWrap [(BlockId, CmmInfoTable)]
xs -> BlockId -> [(BlockId, CmmInfoTable)] -> Maybe CmmInfoTable
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (GenGenCmmGraph s n -> BlockId
forall (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
GenGenCmmGraph s n -> BlockId
g_entry GenGenCmmGraph s n
g) [(BlockId, CmmInfoTable)]
xs
topInfoTableD GenCmmDecl a DCmmTopInfo (GenGenCmmGraph s n)
_                     = Maybe CmmInfoTable
forall a. Maybe a
Nothing

topInfoTable :: GenCmmDecl a CmmTopInfo (GenGenCmmGraph s n) -> Maybe CmmInfoTable
topInfoTable :: forall a (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
GenCmmDecl a CmmTopInfo (GenGenCmmGraph s n) -> Maybe CmmInfoTable
topInfoTable (CmmProc CmmTopInfo
infos CLabel
_ [GlobalRegUse]
_ GenGenCmmGraph s n
g) = BlockId -> LabelMap CmmInfoTable -> Maybe CmmInfoTable
forall a. BlockId -> LabelMap a -> Maybe a
mapLookup (GenGenCmmGraph s n -> BlockId
forall (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
GenGenCmmGraph s n -> BlockId
g_entry GenGenCmmGraph s n
g) (CmmTopInfo -> LabelMap CmmInfoTable
forall (f :: * -> *). GenCmmTopInfo f -> f CmmInfoTable
info_tbls CmmTopInfo
infos)
topInfoTable GenCmmDecl a CmmTopInfo (GenGenCmmGraph s n)
_                     = Maybe CmmInfoTable
forall a. Maybe a
Nothing

data CmmStackInfo
   = StackInfo {
       CmmStackInfo -> ByteOff
arg_space :: ByteOff,
               -- number of bytes of arguments on the stack on entry to the
               -- the proc.  This is filled in by GHC.StgToCmm.codeGen, and
               -- used by the stack allocator later.
       CmmStackInfo -> Bool
do_layout :: Bool
               -- Do automatic stack layout for this proc.  This is
               -- True for all code generated by the code generator,
               -- but is occasionally False for hand-written Cmm where
               -- we want to do the stack manipulation manually.
  }

instance Outputable CmmStackInfo where
    ppr :: CmmStackInfo -> SDoc
ppr = CmmStackInfo -> SDoc
pprStackInfo

pprStackInfo :: CmmStackInfo -> SDoc
pprStackInfo :: CmmStackInfo -> SDoc
pprStackInfo (StackInfo {arg_space :: CmmStackInfo -> ByteOff
arg_space=ByteOff
arg_space}) =
  FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"arg_space: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
arg_space

-- | Info table as a haskell data type
data CmmInfoTable
  = CmmInfoTable {
      CmmInfoTable -> CLabel
cit_lbl  :: CLabel, -- Info table label
      CmmInfoTable -> SMRep
cit_rep  :: SMRep,
      CmmInfoTable -> ProfilingInfo
cit_prof :: ProfilingInfo,
      CmmInfoTable -> Maybe CLabel
cit_srt  :: Maybe CLabel,   -- empty, or a closure address
      CmmInfoTable -> Maybe (Id, CostCentreStack)
cit_clo  :: Maybe (Id, CostCentreStack)
        -- Just (id,ccs) <=> build a static closure later
        -- Nothing <=> don't build a static closure
        --
        -- Static closures for FUNs and THUNKs are *not* generated by
        -- the code generator, because we might want to add SRT
        -- entries to them later (for FUNs at least; THUNKs are
        -- treated the same for consistency). See Note [SRTs] in
        -- GHC.Cmm.Info.Build, in particular the [FUN] optimisation.
        --
        -- This is strictly speaking not a part of the info table that
        -- will be finally generated, but it's the only convenient
        -- place to convey this information from the code generator to
        -- where we build the static closures in
        -- GHC.Cmm.Info.Build.doSRTs.
    } deriving (CmmInfoTable -> CmmInfoTable -> Bool
(CmmInfoTable -> CmmInfoTable -> Bool)
-> (CmmInfoTable -> CmmInfoTable -> Bool) -> Eq CmmInfoTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmmInfoTable -> CmmInfoTable -> Bool
== :: CmmInfoTable -> CmmInfoTable -> Bool
$c/= :: CmmInfoTable -> CmmInfoTable -> Bool
/= :: CmmInfoTable -> CmmInfoTable -> Bool
Eq, Eq CmmInfoTable
Eq CmmInfoTable =>
(CmmInfoTable -> CmmInfoTable -> Ordering)
-> (CmmInfoTable -> CmmInfoTable -> Bool)
-> (CmmInfoTable -> CmmInfoTable -> Bool)
-> (CmmInfoTable -> CmmInfoTable -> Bool)
-> (CmmInfoTable -> CmmInfoTable -> Bool)
-> (CmmInfoTable -> CmmInfoTable -> CmmInfoTable)
-> (CmmInfoTable -> CmmInfoTable -> CmmInfoTable)
-> Ord CmmInfoTable
CmmInfoTable -> CmmInfoTable -> Bool
CmmInfoTable -> CmmInfoTable -> Ordering
CmmInfoTable -> CmmInfoTable -> CmmInfoTable
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CmmInfoTable -> CmmInfoTable -> Ordering
compare :: CmmInfoTable -> CmmInfoTable -> Ordering
$c< :: CmmInfoTable -> CmmInfoTable -> Bool
< :: CmmInfoTable -> CmmInfoTable -> Bool
$c<= :: CmmInfoTable -> CmmInfoTable -> Bool
<= :: CmmInfoTable -> CmmInfoTable -> Bool
$c> :: CmmInfoTable -> CmmInfoTable -> Bool
> :: CmmInfoTable -> CmmInfoTable -> Bool
$c>= :: CmmInfoTable -> CmmInfoTable -> Bool
>= :: CmmInfoTable -> CmmInfoTable -> Bool
$cmax :: CmmInfoTable -> CmmInfoTable -> CmmInfoTable
max :: CmmInfoTable -> CmmInfoTable -> CmmInfoTable
$cmin :: CmmInfoTable -> CmmInfoTable -> CmmInfoTable
min :: CmmInfoTable -> CmmInfoTable -> CmmInfoTable
Ord)

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

data ProfilingInfo
  = NoProfilingInfo
  | ProfilingInfo ByteString ByteString -- closure_type, closure_desc
  deriving (ProfilingInfo -> ProfilingInfo -> Bool
(ProfilingInfo -> ProfilingInfo -> Bool)
-> (ProfilingInfo -> ProfilingInfo -> Bool) -> Eq ProfilingInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProfilingInfo -> ProfilingInfo -> Bool
== :: ProfilingInfo -> ProfilingInfo -> Bool
$c/= :: ProfilingInfo -> ProfilingInfo -> Bool
/= :: ProfilingInfo -> ProfilingInfo -> Bool
Eq, Eq ProfilingInfo
Eq ProfilingInfo =>
(ProfilingInfo -> ProfilingInfo -> Ordering)
-> (ProfilingInfo -> ProfilingInfo -> Bool)
-> (ProfilingInfo -> ProfilingInfo -> Bool)
-> (ProfilingInfo -> ProfilingInfo -> Bool)
-> (ProfilingInfo -> ProfilingInfo -> Bool)
-> (ProfilingInfo -> ProfilingInfo -> ProfilingInfo)
-> (ProfilingInfo -> ProfilingInfo -> ProfilingInfo)
-> Ord ProfilingInfo
ProfilingInfo -> ProfilingInfo -> Bool
ProfilingInfo -> ProfilingInfo -> Ordering
ProfilingInfo -> ProfilingInfo -> ProfilingInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ProfilingInfo -> ProfilingInfo -> Ordering
compare :: ProfilingInfo -> ProfilingInfo -> Ordering
$c< :: ProfilingInfo -> ProfilingInfo -> Bool
< :: ProfilingInfo -> ProfilingInfo -> Bool
$c<= :: ProfilingInfo -> ProfilingInfo -> Bool
<= :: ProfilingInfo -> ProfilingInfo -> Bool
$c> :: ProfilingInfo -> ProfilingInfo -> Bool
> :: ProfilingInfo -> ProfilingInfo -> Bool
$c>= :: ProfilingInfo -> ProfilingInfo -> Bool
>= :: ProfilingInfo -> ProfilingInfo -> Bool
$cmax :: ProfilingInfo -> ProfilingInfo -> ProfilingInfo
max :: ProfilingInfo -> ProfilingInfo -> ProfilingInfo
$cmin :: ProfilingInfo -> ProfilingInfo -> ProfilingInfo
min :: ProfilingInfo -> ProfilingInfo -> ProfilingInfo
Ord)

-----------------------------------------------------------------------------
--              Static Data
-----------------------------------------------------------------------------

data SectionType
  = Text
  | Data
  | ReadOnlyData
  | RelocatableReadOnlyData
  | UninitialisedData
    -- See Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini
  | InitArray           -- .init_array on ELF, .ctor on Windows
  | FiniArray           -- .fini_array on ELF, .dtor on Windows
  | CString
  | OtherSection String
  deriving (ByteOff -> SectionType -> ShowS
[SectionType] -> ShowS
SectionType -> FilePath
(ByteOff -> SectionType -> ShowS)
-> (SectionType -> FilePath)
-> ([SectionType] -> ShowS)
-> Show SectionType
forall a.
(ByteOff -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: ByteOff -> SectionType -> ShowS
showsPrec :: ByteOff -> SectionType -> ShowS
$cshow :: SectionType -> FilePath
show :: SectionType -> FilePath
$cshowList :: [SectionType] -> ShowS
showList :: [SectionType] -> ShowS
Show)

data SectionProtection
  = ReadWriteSection
  | ReadOnlySection
  | WriteProtectedSection -- See Note [Relocatable Read-Only Data]
  deriving (SectionProtection -> SectionProtection -> Bool
(SectionProtection -> SectionProtection -> Bool)
-> (SectionProtection -> SectionProtection -> Bool)
-> Eq SectionProtection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SectionProtection -> SectionProtection -> Bool
== :: SectionProtection -> SectionProtection -> Bool
$c/= :: SectionProtection -> SectionProtection -> Bool
/= :: SectionProtection -> SectionProtection -> Bool
Eq)

-- | Should a data in this section be considered constant at runtime
sectionProtection :: Section -> SectionProtection
sectionProtection :: Section -> SectionProtection
sectionProtection (Section SectionType
t CLabel
_) = case SectionType
t of
    SectionType
Text                    -> SectionProtection
ReadOnlySection
    SectionType
ReadOnlyData            -> SectionProtection
ReadOnlySection
    SectionType
RelocatableReadOnlyData -> SectionProtection
WriteProtectedSection
    SectionType
InitArray               -> SectionProtection
ReadOnlySection
    SectionType
FiniArray               -> SectionProtection
ReadOnlySection
    SectionType
CString                 -> SectionProtection
ReadOnlySection
    SectionType
Data                    -> SectionProtection
ReadWriteSection
    SectionType
UninitialisedData       -> SectionProtection
ReadWriteSection
    (OtherSection FilePath
_)        -> SectionProtection
ReadWriteSection

{-
Note [Relocatable Read-Only Data]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Relocatable data are only read-only after relocation at the start of the
program. They should be writable from the source code until then. Failure to
do so would end up in segfaults at execution when using linkers that do not
enforce writability of those sections, such as the gold linker.
-}

data Section = Section SectionType CLabel

data CmmStatic
  = CmmStaticLit CmmLit
        -- ^ a literal value, size given by cmmLitRep of the literal.
  | CmmUninitialised Int
        -- ^ uninitialised data, N bytes long
  | CmmString ByteString
        -- ^ string of 8-bit values only, not zero terminated.
  | CmmFileEmbed FilePath Int
        -- ^ an embedded binary file and its byte length

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

instance Outputable CmmStatic where
  ppr :: CmmStatic -> SDoc
ppr (CmmStaticLit CmmLit
lit) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"CmmStaticLit" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> CmmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmLit
lit
  ppr (CmmUninitialised ByteOff
n) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"CmmUninitialised" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
n
  ppr (CmmString ByteString
_) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"CmmString"
  ppr (CmmFileEmbed FilePath
fp ByteOff
_) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"CmmFileEmbed" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
fp

-- | Static data before or after SRT generation
data GenCmmStatics (rawOnly :: Bool) where
    CmmStatics
      :: CLabel       -- Label of statics
      -> CmmInfoTable
      -> CostCentreStack
      -> [CmmLit]     -- Payload
      -> [CmmLit]     -- Non-pointers that go to the end of the closure
                      -- This is used by stg_unpack_cstring closures.
                      -- See Note [unpack_cstring closures] in StgStdThunks.cmm.
      -> GenCmmStatics 'False

    -- | Static data, after SRTs are generated
    CmmStaticsRaw
      :: CLabel       -- Label of statics
      -> [CmmStatic]  -- The static data itself
      -> GenCmmStatics a

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

type CmmStatics    = GenCmmStatics 'False
type RawCmmStatics = GenCmmStatics 'True

{-
-----------------------------------------------------------------------------
--              Deterministic Cmm / Info Tables
-----------------------------------------------------------------------------

Note [DCmmGroup vs CmmGroup or: Deterministic Info Tables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Consulting Note [Object determinism] one will learn that in order to produce
deterministic objects just after cmm is produced we perform a renaming pass which
provides fresh uniques for all unique-able things in the input Cmm.

After this point, we use a deterministic unique supply (an incrementing counter)
so any resulting labels which make their way into object code have a deterministic name.

A key assumption to this process is that the input is deterministic modulo the uniques
and the order that bindings appear in the definitions is the same.

CmmGroup uses LabelMap in two places:

* In CmmProc for info tables
* In CmmGraph for the blocks of the graph

LabelMap is not a deterministic structure, so traversing a LabelMap can process
elements in different order (depending on the given uniques).

Therefore before we do the renaming we need to use a deterministic structure, one
which we can traverse in a guaranteed order. A list does the job perfectly.

Once the renaming happens it is converted back into a LabelMap, which is now deterministic
due to the uniques being generated and assigned in a deterministic manner.

We prefer using the renamed LabelMap rather than the list in the rest of the
code generation because it is much more efficient than lists for the needs of
the code generator.
-}

-- Converting out of deterministic Cmm

removeDeterm :: DCmmGroup -> CmmGroup
removeDeterm :: DCmmGroup -> CmmGroup
removeDeterm = (GenCmmDecl CmmStatics DCmmTopInfo DCmmGraph
 -> GenCmmDecl CmmStatics CmmTopInfo CmmGraph)
-> DCmmGroup -> CmmGroup
forall a b. (a -> b) -> [a] -> [b]
map GenCmmDecl CmmStatics DCmmTopInfo DCmmGraph
-> GenCmmDecl CmmStatics CmmTopInfo CmmGraph
removeDetermDecl

removeDetermDecl :: DCmmDecl -> CmmDecl
removeDetermDecl :: GenCmmDecl CmmStatics DCmmTopInfo DCmmGraph
-> GenCmmDecl CmmStatics CmmTopInfo CmmGraph
removeDetermDecl (CmmProc DCmmTopInfo
h CLabel
e [GlobalRegUse]
r DCmmGraph
g) = CmmTopInfo
-> CLabel
-> [GlobalRegUse]
-> CmmGraph
-> GenCmmDecl CmmStatics CmmTopInfo CmmGraph
forall d h g.
h -> CLabel -> [GlobalRegUse] -> g -> GenCmmDecl d h g
CmmProc (DCmmTopInfo -> CmmTopInfo
removeDetermTop DCmmTopInfo
h) CLabel
e [GlobalRegUse]
r (DCmmGraph -> CmmGraph
removeDetermGraph DCmmGraph
g)
removeDetermDecl (CmmData Section
a CmmStatics
b) = Section -> CmmStatics -> GenCmmDecl CmmStatics CmmTopInfo CmmGraph
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
a CmmStatics
b

removeDetermTop :: DCmmTopInfo -> CmmTopInfo
removeDetermTop :: DCmmTopInfo -> CmmTopInfo
removeDetermTop (TopInfo DWrap CmmInfoTable
a CmmStackInfo
b) = LabelMap CmmInfoTable -> CmmStackInfo -> CmmTopInfo
forall (f :: * -> *).
f CmmInfoTable -> CmmStackInfo -> GenCmmTopInfo f
TopInfo ([(BlockId, CmmInfoTable)] -> LabelMap CmmInfoTable
forall v. [(BlockId, v)] -> LabelMap v
mapFromList ([(BlockId, CmmInfoTable)] -> LabelMap CmmInfoTable)
-> [(BlockId, CmmInfoTable)] -> LabelMap CmmInfoTable
forall a b. (a -> b) -> a -> b
$ DWrap CmmInfoTable -> [(BlockId, CmmInfoTable)]
forall a. DWrap a -> [(BlockId, a)]
unDeterm DWrap CmmInfoTable
a) CmmStackInfo
b

removeDetermGraph :: DCmmGraph -> CmmGraph
removeDetermGraph :: DCmmGraph -> CmmGraph
removeDetermGraph (CmmGraph BlockId
x Graph' DWrap Block CmmNode C C
y) =
  let y' :: Graph' LabelMap Block CmmNode C C
y' = case Graph' DWrap Block CmmNode C C
y of
            GMany MaybeO C (Block CmmNode O C)
a (DWrap [(BlockId, CmmBlock)]
b) MaybeO C (Block CmmNode C O)
c -> MaybeO C (Block CmmNode O C)
-> LabelMap CmmBlock
-> MaybeO C (Block CmmNode C O)
-> Graph' LabelMap Block CmmNode C C
forall (e :: Extensibility)
       (block :: (Extensibility -> Extensibility -> *)
                 -> Extensibility -> Extensibility -> *)
       (n :: Extensibility -> Extensibility -> *) (s :: * -> *)
       (x :: Extensibility).
MaybeO e (block n O C)
-> Body' s block n
-> MaybeO x (block n C O)
-> Graph' s block n e x
GMany MaybeO C (Block CmmNode O C)
a ([(BlockId, CmmBlock)] -> LabelMap CmmBlock
forall v. [(BlockId, v)] -> LabelMap v
mapFromList [(BlockId, CmmBlock)]
b) MaybeO C (Block CmmNode C O)
c
  in BlockId -> Graph' LabelMap Block CmmNode C C -> CmmGraph
forall (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
BlockId -> Graph' s Block n C C -> GenGenCmmGraph s n
CmmGraph BlockId
x Graph' LabelMap Block CmmNode C C
y'

-- -----------------------------------------------------------------------------
-- Basic blocks consisting of lists

-- These are used by the LLVM and NCG backends, when populating Cmm
-- with lists of instructions.

data GenBasicBlock i
   = BasicBlock BlockId [i]
   deriving ((forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b)
-> (forall a b. a -> GenBasicBlock b -> GenBasicBlock a)
-> Functor GenBasicBlock
forall a b. a -> GenBasicBlock b -> GenBasicBlock a
forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
fmap :: forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
$c<$ :: forall a b. a -> GenBasicBlock b -> GenBasicBlock a
<$ :: forall a b. a -> GenBasicBlock b -> GenBasicBlock a
Functor)


-- | The branch block id is that of the first block in
-- the branch, which is that branch's entry point
blockId :: GenBasicBlock i -> BlockId
blockId :: forall i. GenBasicBlock i -> BlockId
blockId (BasicBlock BlockId
blk_id [i]
_ ) = BlockId
blk_id

newtype ListGraph i
   = ListGraph [GenBasicBlock i]
   deriving ((forall a b. (a -> b) -> ListGraph a -> ListGraph b)
-> (forall a b. a -> ListGraph b -> ListGraph a)
-> Functor ListGraph
forall a b. a -> ListGraph b -> ListGraph a
forall a b. (a -> b) -> ListGraph a -> ListGraph b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ListGraph a -> ListGraph b
fmap :: forall a b. (a -> b) -> ListGraph a -> ListGraph b
$c<$ :: forall a b. a -> ListGraph b -> ListGraph a
<$ :: forall a b. a -> ListGraph b -> ListGraph a
Functor)

instance Outputable instr => Outputable (ListGraph instr) where
    ppr :: ListGraph instr -> SDoc
ppr (ListGraph [GenBasicBlock instr]
blocks) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GenBasicBlock instr -> SDoc) -> [GenBasicBlock instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenBasicBlock instr -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenBasicBlock instr]
blocks)

instance OutputableP env instr => OutputableP env (ListGraph instr) where
    pdoc :: env -> ListGraph instr -> SDoc
pdoc env
env ListGraph instr
g = ListGraph SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((instr -> SDoc) -> ListGraph instr -> ListGraph SDoc
forall a b. (a -> b) -> ListGraph a -> ListGraph b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (env -> instr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env) ListGraph instr
g)


instance Outputable instr => Outputable (GenBasicBlock instr) where
    ppr :: GenBasicBlock instr -> SDoc
ppr = GenBasicBlock instr -> SDoc
forall instr. Outputable instr => GenBasicBlock instr -> SDoc
pprBBlock

instance OutputableP env instr => OutputableP env (GenBasicBlock instr) where
    pdoc :: env -> GenBasicBlock instr -> SDoc
pdoc env
env GenBasicBlock instr
block = GenBasicBlock SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((instr -> SDoc) -> GenBasicBlock instr -> GenBasicBlock SDoc
forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (env -> instr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env) GenBasicBlock instr
block)

pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
pprBBlock :: forall instr. Outputable instr => GenBasicBlock instr -> SDoc
pprBBlock (BasicBlock BlockId
ident [stmt]
stmts) =
    SDoc -> ByteOff -> SDoc -> SDoc
hang (BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
ident SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon) ByteOff
4 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((stmt -> SDoc) -> [stmt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map stmt -> SDoc
forall a. Outputable a => a -> SDoc
ppr [stmt]
stmts))


-- --------------------------------------------------------------------------
-- Pretty-printing Cmm
-- --------------------------------------------------------------------------
--
-- 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.

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
forall doc. IsDoc doc => [doc] -> doc
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 [GlobalRegUse]
live i
graph)

  = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
lparen SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
rparen SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
lbrace SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"// " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [GlobalRegUse] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRegUse]
live
         , ByteOff -> SDoc -> SDoc
nest ByteOff
8 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
forall doc. IsLine doc => doc
lbrace SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> info -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform info
info SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
forall doc. IsLine doc => doc
rbrace
         , ByteOff -> SDoc -> SDoc
nest ByteOff
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
forall doc. IsLine doc => doc
rbrace ]

-- --------------------------------------------------------------------------
-- We follow [1], 4.5
--
--      section "data" { ... }
--

pprTop Platform
platform (CmmData Section
section d
ds) =
    (SDoc -> ByteOff -> SDoc -> SDoc
hang (Platform -> Section -> SDoc
pprSection Platform
platform Section
section SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
lbrace) ByteOff
4 (Platform -> d -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform d
ds))
    SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
forall doc. IsLine doc => doc
rbrace

-- --------------------------------------------------------------------------
-- Pretty-printing 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
forall doc. IsDoc doc => [doc] -> doc
vcat [ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"label: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl
         , FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"rep: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SMRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr SMRep
rep
         , case ProfilingInfo
prof_info of
             ProfilingInfo
NoProfilingInfo -> SDoc
forall doc. IsOutput doc => doc
empty
             ProfilingInfo ByteString
ct ByteString
cd ->
               [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"type: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text ([Word8] -> FilePath
forall a. Show a => a -> FilePath
show (ByteString -> [Word8]
BS.unpack ByteString
ct))
                    , FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"desc: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text ([Word8] -> FilePath
forall a. Show a => a -> FilePath
show (ByteString -> [Word8]
BS.unpack ByteString
cd)) ]
         , FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"srt: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Maybe CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform Maybe CLabel
srt ]

-- --------------------------------------------------------------------------
-- 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 [CmmLit]
extras) =
  Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CmmInfoTable -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmInfoTable
itbl SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> CostCentreStack -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentreStack
ccs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [CmmLit] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform [CmmLit]
payload SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [CmmLit] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CmmLit]
extras
pprStatics Platform
platform (CmmStaticsRaw CLabel
lbl [CmmStatic]
ds) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
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   -> ByteOff -> SDoc -> SDoc
nest ByteOff
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"const" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CmmLit -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmLit
lit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi
    CmmUninitialised ByteOff
i -> ByteOff -> SDoc -> SDoc
nest ByteOff
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"I8" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (ByteOff -> SDoc
forall doc. IsLine doc => ByteOff -> doc
int ByteOff
i)
    CmmString ByteString
s'       -> ByteOff -> SDoc -> SDoc
nest ByteOff
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"I8[]" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
s')
    CmmFileEmbed FilePath
path ByteOff
_ -> ByteOff -> SDoc -> SDoc
nest ByteOff
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"incbin " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (ShowS
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
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (SectionType -> SDoc
pprSectionType SectionType
t SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'.' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
suffix)
  where
    section :: SDoc
section = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"section"

pprSectionType :: SectionType -> SDoc
pprSectionType :: SectionType -> SDoc
pprSectionType SectionType
s = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ case SectionType
s of
  SectionType
Text                    -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"text"
  SectionType
Data                    -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"data"
  SectionType
ReadOnlyData            -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"readonly"
  SectionType
RelocatableReadOnlyData -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"relreadonly"
  SectionType
UninitialisedData       -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"uninitialised"
  SectionType
InitArray               -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"initarray"
  SectionType
FiniArray               -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"finiarray"
  SectionType
CString                 -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"cstring"
  OtherSection FilePath
s'         -> FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
s'