-----------------------------------------------------------------------------
pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
-----------------------------------------------------------------------------
pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
-- --------------------------------------------------------------------------
-- Top level `procedure' blocks.
-- --------------------------------------------------------------------------
-- Top level `procedure' blocks.
instance Outputable CmmSafety where
ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
ppr (CmmSafe srt) = ppr srt
instance Outputable CmmSafety where
ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
ppr (CmmSafe srt) = ppr srt
-- --------------------------------------------------------------------------
-- Info tables. The current pretty printer needs refinement
-- --------------------------------------------------------------------------
-- Info tables. The current pretty printer needs refinement
pprInfo :: CmmInfo -> SDoc
pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
vcat [{-ptext (sLit "gc_target: ") <>
pprInfo :: CmmInfo -> SDoc
pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
vcat [{-ptext (sLit "gc_target: ") <>
ptext (sLit "update_frame: ") <>
maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame]
pprInfo (CmmInfo _gc_target update_frame
ptext (sLit "update_frame: ") <>
maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame]
pprInfo (CmmInfo _gc_target update_frame
ptext (sLit "update_frame: ") <>
maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
ptext (sLit "type: ") <> pprLit closure_type,
ptext (sLit "update_frame: ") <>
maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
ptext (sLit "type: ") <> pprLit closure_type,
-- --------------------------------------------------------------------------
-- Statements. C-- usually, exceptions to this should be obvious.
-- --------------------------------------------------------------------------
-- Statements. C-- usually, exceptions to this should be obvious.
pp_lhs | null results = empty
| otherwise = commafy (map ppr_ar results) <+> equals
-- Don't print the hints on a native C-- call
pp_lhs | null results = empty
| otherwise = commafy (map ppr_ar results) <+> equals
-- Don't print the hints on a native C-- call
- lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
+ -- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we
+ -- use one to get the label printed.
+ lbl = CmmLabel (mkForeignLabel
+ (mkFastString (show op))
+ Nothing ForeignLabelInThisPackage IsFunction)
-- --------------------------------------------------------------------------
-- Conditional. [1], section 6.4
-- --------------------------------------------------------------------------
-- Conditional. [1], section 6.4
-- --------------------------------------------------------------------------
-- A tail call. [1], Section 6.9
-- --------------------------------------------------------------------------
-- A tail call. [1], Section 6.9
in hsep [ ptext (sLit "case")
, hcat (punctuate comma (map int is))
, ptext (sLit ": goto")
in hsep [ ptext (sLit "case")
, hcat (punctuate comma (map int is))
, ptext (sLit ": goto")
CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ]
CmmLabel clbl -> pprCLabel clbl
CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
<> pprCLabel clbl2 <> ppr_offset i
CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ]
CmmLabel clbl -> pprCLabel clbl
CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
<> pprCLabel clbl2 <> ppr_offset i
-----------------------------------------------------------------------------
commafy :: [SDoc] -> SDoc
-----------------------------------------------------------------------------
commafy :: [SDoc] -> SDoc