{-# LANGUAGE GADTs, TypeFamilies, FlexibleContexts, FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

----------------------------------------------------------------------------
--
-- Pretty-printing of Cmm as (a superset of) C--
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------
--
-- This is where we walk over CmmNode 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

module PprCmm
  ( module PprCmmDecl
  , module PprCmmExpr
  )
where

import GhcPrelude hiding (succ)

import BlockId ()
import CLabel
import Cmm
import CmmUtils
import CmmSwitch
import DynFlags
import FastString
import Outputable
import PprCmmDecl
import PprCmmExpr
import Util
import PprCore ()

import BasicTypes
import Hoopl.Block
import Hoopl.Graph

-------------------------------------------------
-- Outputable instances

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

instance Outputable CmmTopInfo where
    ppr :: CmmTopInfo -> SDoc
ppr = CmmTopInfo -> SDoc
pprTopInfo


instance Outputable (CmmNode e x) where
    ppr :: CmmNode e x -> SDoc
ppr = CmmNode e x -> SDoc
forall e x. CmmNode e x -> SDoc
pprNode

instance Outputable Convention where
    ppr :: Convention -> SDoc
ppr = Convention -> SDoc
pprConvention

instance Outputable ForeignConvention where
    ppr :: ForeignConvention -> SDoc
ppr = ForeignConvention -> SDoc
pprForeignConvention

instance Outputable ForeignTarget where
    ppr :: ForeignTarget -> SDoc
ppr = ForeignTarget -> SDoc
pprForeignTarget

instance Outputable CmmReturnInfo where
    ppr :: CmmReturnInfo -> SDoc
ppr = CmmReturnInfo -> SDoc
pprReturnInfo

instance Outputable (Block CmmNode C C) where
    ppr :: Block CmmNode C C -> SDoc
ppr = Block CmmNode C C -> SDoc
forall x e.
(IndexedCO x SDoc SDoc ~ SDoc) =>
Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock
instance Outputable (Block CmmNode C O) where
    ppr :: Block CmmNode C O -> SDoc
ppr = Block CmmNode C O -> SDoc
forall x e.
(IndexedCO x SDoc SDoc ~ SDoc) =>
Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock
instance Outputable (Block CmmNode O C) where
    ppr :: Block CmmNode O C -> SDoc
ppr = Block CmmNode O C -> SDoc
forall x e.
(IndexedCO x SDoc SDoc ~ SDoc) =>
Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock
instance Outputable (Block CmmNode O O) where
    ppr :: Block CmmNode O O -> SDoc
ppr = Block CmmNode O O -> SDoc
forall x e.
(IndexedCO x SDoc SDoc ~ SDoc) =>
Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock

instance Outputable (Graph CmmNode e x) where
    ppr :: Graph CmmNode e x -> SDoc
ppr = Graph CmmNode e x -> SDoc
forall e x. Graph CmmNode e x -> SDoc
pprGraph

instance Outputable CmmGraph where
    ppr :: CmmGraph -> SDoc
ppr = CmmGraph -> SDoc
pprCmmGraph

----------------------------------------------------------
-- Outputting types Cmm contains

pprStackInfo :: CmmStackInfo -> SDoc
pprStackInfo :: CmmStackInfo -> SDoc
pprStackInfo (StackInfo {arg_space :: CmmStackInfo -> ByteOff
arg_space=ByteOff
arg_space, updfr_space :: CmmStackInfo -> Maybe ByteOff
updfr_space=Maybe ByteOff
updfr_space}) =
  String -> SDoc
text "arg_space: " SDoc -> SDoc -> SDoc
<> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
arg_space SDoc -> SDoc -> SDoc
<+>
  String -> SDoc
text "updfr_space: " SDoc -> SDoc -> SDoc
<> Maybe ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe ByteOff
updfr_space

pprTopInfo :: CmmTopInfo -> SDoc
pprTopInfo :: CmmTopInfo -> SDoc
pprTopInfo (TopInfo {info_tbls :: CmmTopInfo -> LabelMap CmmInfoTable
info_tbls=LabelMap CmmInfoTable
info_tbl, stack_info :: CmmTopInfo -> CmmStackInfo
stack_info=CmmStackInfo
stack_info}) =
  [SDoc] -> SDoc
vcat [String -> SDoc
text "info_tbls: " SDoc -> SDoc -> SDoc
<> LabelMap CmmInfoTable -> SDoc
forall a. Outputable a => a -> SDoc
ppr LabelMap CmmInfoTable
info_tbl,
        String -> SDoc
text "stack_info: " SDoc -> SDoc -> SDoc
<> CmmStackInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmStackInfo
stack_info]

----------------------------------------------------------
-- Outputting blocks and graphs

pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
         => Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock :: Block CmmNode e x -> IndexedCO e SDoc SDoc
pprBlock block :: Block CmmNode e x
block
    = (CmmNode C O -> SDoc -> SDoc, CmmNode O O -> SDoc -> SDoc,
 CmmNode O C -> SDoc -> SDoc)
-> Block CmmNode e x
-> IndexedCO x SDoc SDoc
-> IndexedCO e SDoc SDoc
forall (n :: * -> * -> *) a b c.
(n C O -> b -> c, n O O -> b -> b, n O C -> a -> b)
-> forall e x. Block n e x -> IndexedCO x a b -> IndexedCO e c b
foldBlockNodesB3 ( SDoc -> SDoc -> SDoc
($$) (SDoc -> SDoc -> SDoc)
-> (CmmNode C O -> SDoc) -> CmmNode C O -> SDoc -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode C O -> SDoc
forall a. Outputable a => a -> SDoc
ppr
                       , SDoc -> SDoc -> SDoc
($$) (SDoc -> SDoc -> SDoc)
-> (CmmNode O O -> SDoc) -> CmmNode O O -> SDoc -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteOff -> SDoc -> SDoc
nest 4) (SDoc -> SDoc) -> (CmmNode O O -> SDoc) -> CmmNode O O -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode O O -> SDoc
forall a. Outputable a => a -> SDoc
ppr
                       , SDoc -> SDoc -> SDoc
($$) (SDoc -> SDoc -> SDoc)
-> (CmmNode O C -> SDoc) -> CmmNode O C -> SDoc -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteOff -> SDoc -> SDoc
nest 4) (SDoc -> SDoc) -> (CmmNode O C -> SDoc) -> CmmNode O C -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode O C -> SDoc
forall a. Outputable a => a -> SDoc
ppr
                       )
                       Block CmmNode e x
block
                       IndexedCO x SDoc SDoc
SDoc
empty

pprGraph :: Graph CmmNode e x -> SDoc
pprGraph :: Graph CmmNode e x -> SDoc
pprGraph GNil = SDoc
empty
pprGraph (GUnit block :: Block CmmNode O O
block) = Block CmmNode O O -> SDoc
forall a. Outputable a => a -> SDoc
ppr Block CmmNode O O
block
pprGraph (GMany entry :: MaybeO e (Block CmmNode O C)
entry body :: Body' Block CmmNode
body exit :: MaybeO x (Block CmmNode C O)
exit)
   = String -> SDoc
text "{"
  SDoc -> SDoc -> SDoc
$$ ByteOff -> SDoc -> SDoc
nest 2 (MaybeO e (Block CmmNode O C) -> SDoc
forall e x ex.
Outputable (Block CmmNode e x) =>
MaybeO ex (Block CmmNode e x) -> SDoc
pprMaybeO MaybeO e (Block CmmNode O C)
entry SDoc -> SDoc -> SDoc
$$ ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (Block CmmNode C C -> SDoc) -> [Block CmmNode C C] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Block CmmNode C C -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([Block CmmNode C C] -> [SDoc]) -> [Block CmmNode C C] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ Body' Block CmmNode -> [Block CmmNode C C]
bodyToBlockList Body' Block CmmNode
body) SDoc -> SDoc -> SDoc
$$ MaybeO x (Block CmmNode C O) -> SDoc
forall e x ex.
Outputable (Block CmmNode e x) =>
MaybeO ex (Block CmmNode e x) -> SDoc
pprMaybeO MaybeO x (Block CmmNode C O)
exit)
  SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "}"
  where pprMaybeO :: Outputable (Block CmmNode e x)
                  => MaybeO ex (Block CmmNode e x) -> SDoc
        pprMaybeO :: MaybeO ex (Block CmmNode e x) -> SDoc
pprMaybeO NothingO = SDoc
empty
        pprMaybeO (JustO block :: Block CmmNode e x
block) = Block CmmNode e x -> SDoc
forall a. Outputable a => a -> SDoc
ppr Block CmmNode e x
block

pprCmmGraph :: CmmGraph -> SDoc
pprCmmGraph :: CmmGraph -> SDoc
pprCmmGraph g :: CmmGraph
g
   = String -> SDoc
text "{" SDoc -> SDoc -> SDoc
<> String -> SDoc
text "offset"
  SDoc -> SDoc -> SDoc
$$ ByteOff -> SDoc -> SDoc
nest 2 ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (Block CmmNode C C -> SDoc) -> [Block CmmNode C C] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Block CmmNode C C -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Block CmmNode C C]
blocks)
  SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "}"
  where blocks :: [Block CmmNode C C]
blocks = CmmGraph -> [Block CmmNode C C]
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.

---------------------------------------------
-- Outputting CmmNode and types which it contains

pprConvention :: Convention -> SDoc
pprConvention :: Convention -> SDoc
pprConvention (NativeNodeCall   {}) = String -> SDoc
text "<native-node-call-convention>"
pprConvention (NativeDirectCall {}) = String -> SDoc
text "<native-direct-call-convention>"
pprConvention (NativeReturn {})     = String -> SDoc
text "<native-ret-convention>"
pprConvention  Slow                 = String -> SDoc
text "<slow-convention>"
pprConvention  GC                   = String -> SDoc
text "<gc-convention>"

pprForeignConvention :: ForeignConvention -> SDoc
pprForeignConvention :: ForeignConvention -> SDoc
pprForeignConvention (ForeignConvention c :: CCallConv
c args :: [ForeignHint]
args res :: [ForeignHint]
res ret :: CmmReturnInfo
ret) =
          SDoc -> SDoc
doubleQuotes (CCallConv -> SDoc
forall a. Outputable a => a -> SDoc
ppr CCallConv
c) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "arg hints: " SDoc -> SDoc -> SDoc
<+> [ForeignHint] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ForeignHint]
args SDoc -> SDoc -> SDoc
<+> String -> SDoc
text " result hints: " SDoc -> SDoc -> SDoc
<+> [ForeignHint] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ForeignHint]
res SDoc -> SDoc -> SDoc
<+> CmmReturnInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmReturnInfo
ret

pprReturnInfo :: CmmReturnInfo -> SDoc
pprReturnInfo :: CmmReturnInfo -> SDoc
pprReturnInfo CmmMayReturn = SDoc
empty
pprReturnInfo CmmNeverReturns = String -> SDoc
text "never returns"

pprForeignTarget :: ForeignTarget -> SDoc
pprForeignTarget :: ForeignTarget -> SDoc
pprForeignTarget (ForeignTarget fn :: CmmExpr
fn c :: ForeignConvention
c) = ForeignConvention -> SDoc
forall a. Outputable a => a -> SDoc
ppr ForeignConvention
c SDoc -> SDoc -> SDoc
<+> CmmExpr -> SDoc
ppr_target CmmExpr
fn
  where
        ppr_target :: CmmExpr -> SDoc
        ppr_target :: CmmExpr -> SDoc
ppr_target t :: CmmExpr
t@(CmmLit _) = CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
t
        ppr_target fn' :: CmmExpr
fn'          = SDoc -> SDoc
parens (CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
fn')

pprForeignTarget (PrimTarget op :: CallishMachOp
op)
 -- HACK: We're just using a ForeignLabel to get this printed, the label
 --       might not really be foreign.
 = CmmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr
               (CLabel -> CmmLit
CmmLabel (FastString
-> Maybe ByteOff -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel
                         (String -> FastString
mkFastString (CallishMachOp -> String
forall a. Show a => a -> String
show CallishMachOp
op))
                         Maybe ByteOff
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInThisPackage FunctionOrData
IsFunction))

pprNode :: CmmNode e x -> SDoc
pprNode :: CmmNode e x -> SDoc
pprNode node :: CmmNode e x
node = SDoc
pp_node SDoc -> SDoc -> SDoc
<+> SDoc
pp_debug
  where
    pp_node :: SDoc
    pp_node :: SDoc
pp_node = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags -> case CmmNode e x
node of
      -- label:
      CmmEntry id :: Label
id tscope :: CmmTickScope
tscope -> SDoc
lbl SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+>
         ((DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
           Bool -> SDoc -> SDoc
ppUnless (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressTicks DynFlags
dflags) (String -> SDoc
text "//" SDoc -> SDoc -> SDoc
<+> CmmTickScope -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmTickScope
tscope))
          where
            lbl :: SDoc
lbl = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressUniques DynFlags
dflags
                then String -> SDoc
text "_lbl_"
                else Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
id

      -- // text
      CmmComment s :: FastString
s -> String -> SDoc
text "//" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
ftext FastString
s

      -- //tick bla<...>
      CmmTick t :: CmmTickish
t -> Bool -> SDoc -> SDoc
ppUnless (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressTicks DynFlags
dflags) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                   String -> SDoc
text "//tick" SDoc -> SDoc -> SDoc
<+> CmmTickish -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmTickish
t

      -- unwind reg = expr;
      CmmUnwind regs :: [(GlobalReg, Maybe CmmExpr)]
regs ->
          String -> SDoc
text "unwind "
          SDoc -> SDoc -> SDoc
<> [SDoc] -> SDoc
commafy (((GlobalReg, Maybe CmmExpr) -> SDoc)
-> [(GlobalReg, Maybe CmmExpr)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\(r :: GlobalReg
r,e :: Maybe CmmExpr
e) -> GlobalReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalReg
r SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char '=' SDoc -> SDoc -> SDoc
<+> Maybe CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe CmmExpr
e) [(GlobalReg, Maybe CmmExpr)]
regs) SDoc -> SDoc -> SDoc
<> SDoc
semi

      -- reg = expr;
      CmmAssign reg :: CmmReg
reg expr :: CmmExpr
expr -> CmmReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmReg
reg SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
expr SDoc -> SDoc -> SDoc
<> SDoc
semi

      -- rep[lv] = expr;
      CmmStore lv :: CmmExpr
lv expr :: CmmExpr
expr -> SDoc
rep SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets(CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
lv) SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
expr SDoc -> SDoc -> SDoc
<> SDoc
semi
          where
            rep :: SDoc
rep = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
                  CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr ( DynFlags -> CmmExpr -> CmmType
cmmExprType DynFlags
dflags CmmExpr
expr )

      -- call "ccall" foo(x, y)[r1, r2];
      -- ToDo ppr volatile
      CmmUnsafeForeignCall target :: ForeignTarget
target results :: [CmmFormal]
results args :: [CmmExpr]
args ->
          [SDoc] -> SDoc
hsep [ Bool -> SDoc -> SDoc
ppUnless ([CmmFormal] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CmmFormal]
results) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                    SDoc -> SDoc
parens ([SDoc] -> SDoc
commafy ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (CmmFormal -> SDoc) -> [CmmFormal] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CmmFormal -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CmmFormal]
results) SDoc -> SDoc -> SDoc
<+> SDoc
equals,
                 String -> SDoc
text "call",
                 ForeignTarget -> SDoc
forall a. Outputable a => a -> SDoc
ppr ForeignTarget
target SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens ([SDoc] -> SDoc
commafy ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (CmmExpr -> SDoc) -> [CmmExpr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CmmExpr]
args) SDoc -> SDoc -> SDoc
<> SDoc
semi]

      -- goto label;
      CmmBranch ident :: Label
ident -> String -> SDoc
text "goto" SDoc -> SDoc -> SDoc
<+> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
ident SDoc -> SDoc -> SDoc
<> SDoc
semi

      -- if (expr) goto t; else goto f;
      CmmCondBranch expr :: CmmExpr
expr t :: Label
t f :: Label
f l :: Maybe Bool
l ->
          [SDoc] -> SDoc
hsep [ String -> SDoc
text "if"
               , SDoc -> SDoc
parens(CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
expr)
               , case Maybe Bool
l of
                   Nothing -> SDoc
empty
                   Just b :: Bool
b -> SDoc -> SDoc
parens (String -> SDoc
text "likely:" SDoc -> SDoc -> SDoc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
b)
               , String -> SDoc
text "goto"
               , Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
t SDoc -> SDoc -> SDoc
<> SDoc
semi
               , String -> SDoc
text "else goto"
               , Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
f SDoc -> SDoc -> SDoc
<> SDoc
semi
               ]

      CmmSwitch expr :: CmmExpr
expr ids :: SwitchTargets
ids ->
          SDoc -> ByteOff -> SDoc -> SDoc
hang ([SDoc] -> SDoc
hsep [ String -> SDoc
text "switch"
                     , SDoc
range
                     , if CmmExpr -> Bool
isTrivialCmmExpr CmmExpr
expr
                       then CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
expr
                       else SDoc -> SDoc
parens (CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
expr)
                     , String -> SDoc
text "{"
                     ])
             4 ([SDoc] -> SDoc
vcat ((([Integer], Label) -> SDoc) -> [([Integer], Label)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ([Integer], Label) -> SDoc
forall a. Outputable a => ([Integer], a) -> SDoc
ppCase [([Integer], Label)]
cases) SDoc -> SDoc -> SDoc
$$ SDoc
def) SDoc -> SDoc -> SDoc
$$ SDoc
rbrace
          where
            (cases :: [([Integer], Label)]
cases, mbdef :: Maybe Label
mbdef) = SwitchTargets -> ([([Integer], Label)], Maybe Label)
switchTargetsFallThrough SwitchTargets
ids
            ppCase :: ([Integer], a) -> SDoc
ppCase (is :: [Integer]
is,l :: a
l) = [SDoc] -> SDoc
hsep
                            [ String -> SDoc
text "case"
                            , [SDoc] -> SDoc
commafy ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (Integer -> SDoc) -> [Integer] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> SDoc
integer [Integer]
is
                            , String -> SDoc
text ": goto"
                            , a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
l SDoc -> SDoc -> SDoc
<> SDoc
semi
                            ]
            def :: SDoc
def | Just l :: Label
l <- Maybe Label
mbdef = [SDoc] -> SDoc
hsep
                            [ String -> SDoc
text "default:"
                            , SDoc -> SDoc
braces (String -> SDoc
text "goto" SDoc -> SDoc -> SDoc
<+> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
l SDoc -> SDoc -> SDoc
<> SDoc
semi)
                            ]
                | Bool
otherwise = SDoc
empty

            range :: SDoc
range = SDoc -> SDoc
brackets (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hsep [Integer -> SDoc
integer Integer
lo, String -> SDoc
text "..", Integer -> SDoc
integer Integer
hi]
              where (lo :: Integer
lo,hi :: Integer
hi) = SwitchTargets -> (Integer, Integer)
switchTargetsRange SwitchTargets
ids

      CmmCall tgt :: CmmExpr
tgt k :: Maybe Label
k regs :: [GlobalReg]
regs out :: ByteOff
out res :: ByteOff
res updfr_off :: ByteOff
updfr_off ->
          [SDoc] -> SDoc
hcat [ String -> SDoc
text "call", SDoc
space
               , CmmExpr -> SDoc
pprFun CmmExpr
tgt, SDoc -> SDoc
parens ([GlobalReg] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [GlobalReg]
regs), SDoc
space
               , SDoc
returns SDoc -> SDoc -> SDoc
<+>
                 String -> SDoc
text "args: " SDoc -> SDoc -> SDoc
<> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
out SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+>
                 String -> SDoc
text "res: " SDoc -> SDoc -> SDoc
<> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
res SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+>
                 String -> SDoc
text "upd: " SDoc -> SDoc -> SDoc
<> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
updfr_off
               , SDoc
semi ]
          where pprFun :: CmmExpr -> SDoc
pprFun f :: CmmExpr
f@(CmmLit _) = CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
f
                pprFun f :: CmmExpr
f = SDoc -> SDoc
parens (CmmExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmExpr
f)

                returns :: SDoc
returns
                  | Just r :: Label
r <- Maybe Label
k = String -> SDoc
text "returns to" SDoc -> SDoc -> SDoc
<+> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
r SDoc -> SDoc -> SDoc
<> SDoc
comma
                  | Bool
otherwise   = SDoc
empty

      CmmForeignCall {tgt :: CmmNode O C -> ForeignTarget
tgt=ForeignTarget
t, res :: CmmNode O C -> [CmmFormal]
res=[CmmFormal]
rs, args :: CmmNode O C -> [CmmExpr]
args=[CmmExpr]
as, succ :: CmmNode O C -> Label
succ=Label
s, ret_args :: CmmNode O C -> ByteOff
ret_args=ByteOff
a, ret_off :: CmmNode O C -> ByteOff
ret_off=ByteOff
u, intrbl :: CmmNode O C -> Bool
intrbl=Bool
i} ->
          [SDoc] -> SDoc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ if Bool
i then [String -> SDoc
text "interruptible", SDoc
space] else [] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
               [ String -> SDoc
text "foreign call", SDoc
space
               , ForeignTarget -> SDoc
forall a. Outputable a => a -> SDoc
ppr ForeignTarget
t, String -> SDoc
text "(...)", SDoc
space
               , String -> SDoc
text "returns to" SDoc -> SDoc -> SDoc
<+> Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
s
                    SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "args:" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens ([CmmExpr] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CmmExpr]
as)
                    SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "ress:" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens ([CmmFormal] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CmmFormal]
rs)
               , String -> SDoc
text "ret_args:" SDoc -> SDoc -> SDoc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
a
               , String -> SDoc
text "ret_off:" SDoc -> SDoc -> SDoc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
u
               , SDoc
semi ]

    pp_debug :: SDoc
    pp_debug :: SDoc
pp_debug =
      if Bool -> Bool
not Bool
debugIsOn then SDoc
empty
      else case CmmNode e x
node of
             CmmEntry {}             -> SDoc
empty -- Looks terrible with text "  // CmmEntry"
             CmmComment {}           -> SDoc
empty -- Looks also terrible with text "  // CmmComment"
             CmmTick {}              -> SDoc
empty
             CmmUnwind {}            -> String -> SDoc
text "  // CmmUnwind"
             CmmAssign {}            -> String -> SDoc
text "  // CmmAssign"
             CmmStore {}             -> String -> SDoc
text "  // CmmStore"
             CmmUnsafeForeignCall {} -> String -> SDoc
text "  // CmmUnsafeForeignCall"
             CmmBranch {}            -> String -> SDoc
text "  // CmmBranch"
             CmmCondBranch {}        -> String -> SDoc
text "  // CmmCondBranch"
             CmmSwitch {}            -> String -> SDoc
text "  // CmmSwitch"
             CmmCall {}              -> String -> SDoc
text "  // CmmCall"
             CmmForeignCall {}       -> String -> SDoc
text "  // CmmForeignCall"

    commafy :: [SDoc] -> SDoc
    commafy :: [SDoc] -> SDoc
commafy xs :: [SDoc]
xs = [SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma [SDoc]
xs