ppr_expr add_par (Note (SCC cc) expr)
= add_par (sep [pprCostCentreCore cc, pprCoreExpr expr])
+ppr_expr add_par (Note InlineMe expr)
+ = add_par $ ptext (sLit "__inline_me") <+> pprParendExpr expr
+
ppr_expr add_par (Note (CoreNote s) expr)
= add_par $
sep [sep [ptext (sLit "__core_note"), pprHsString (mkFastString s)],
pprCoreBinder LetBind binder
| isTyVar binder = pprKindedTyVarBndr binder
| otherwise
- = vcat [sig, pprIdDetails binder, pragmas]
+ = vcat [sig, pprIdExtras binder, pragmas]
where
sig = pprTypedBinder binder
pragmas = ppIdInfo binder (idInfo binder)
-- Case bound things don't get a signature or a herald, unless we have debug on
pprCoreBinder CaseBind bndr
- | isDeadBinder bndr -- False for tyvars
- = ptext (sLit "_")
- | otherwise
= getPprStyle $ \ sty ->
if debugStyle sty then
parens (pprTypedBinder bndr)
dmd_info = newDemandInfo info
lbv_info = lbvarInfo info
- no_info = isAlwaysActive prag_info && isNoOcc occ_info &&
+ no_info = isDefaultInlinePragma prag_info && isNoOcc occ_info &&
(case dmd_info of { Nothing -> True; Just d -> isTop d }) &&
hasNoLBVarInfo lbv_info
\end{code}
------------------------------------------------------
--- IdInfo
------------------------------------------------------
-
\begin{code}
-pprIdDetails :: Id -> SDoc
-pprIdDetails id | isGlobalId id = ppr (globalIdDetails id)
- | isExportedId id = ptext (sLit "[Exported]")
- | otherwise = empty
+pprIdExtras :: Id -> SDoc
+pprIdExtras id = pp_scope <> ppr (idDetails id)
+ where
+ pp_scope | isGlobalId id = ptext (sLit "GblId")
+ | isExportedId id = ptext (sLit "LclIdX")
+ | otherwise = ptext (sLit "LclId")
ppIdInfo :: Id -> IdInfo -> SDoc
ppIdInfo _ info
= brackets $
vcat [ ppArityInfo a,
+ ppWorkerInfo (workerInfo info),
ppCafInfo (cafInfo info),
#ifdef OLD_STRICTNESS
ppStrictnessInfo s,
ppCprInfo m,
#endif
pprNewStrictness (newStrictnessInfo info),
- pprInlineInfo (unfoldingInfo info),
if null rules then empty
else ptext (sLit "RULES:") <+> vcat (map pprRule rules)
-- Inline pragma, occ, demand, lbvar info
rules = specInfoRules (specInfo info)
\end{code}
------------------------------------------------------
--- Unfolding and UnfoldingGuidance
------------------------------------------------------
-
-\begin{code}
-instance Outputable UnfoldingGuidance where
- ppr UnfoldNever = ptext (sLit "NEVER")
- ppr (UnfoldIfGoodArgs { ug_arity = v, ug_args = cs
- , ug_size = size, ug_res = discount })
- = hsep [ ptext (sLit "IF_ARGS"), int v,
- brackets (hsep (map int cs)),
- int size,
- int discount ]
-
-instance Outputable Unfolding where
- ppr NoUnfolding = ptext (sLit "No unfolding")
- ppr (OtherCon cs) = ptext (sLit "OtherCon") <+> ppr cs
- ppr (CompulsoryUnfolding e) = ptext (sLit "Compulsory") <+> ppr e
- ppr (InlineRule { uf_tmpl = e, uf_is_value = hnf, uf_arity = arity, uf_worker = wkr })
- = ptext (sLit "INLINE") <+> sep [ppr arity <+> ppr hnf <+> ppr wkr, ppr e]
- ppr (CoreUnfolding e top hnf cheap g)
- = ptext (sLit "Unf") <+> sep [ppr top <+> ppr hnf <+> ppr cheap <+> ppr g,
- ppr e]
-
-pprInlineInfo :: Unfolding -> SDoc -- Print an inline RULE
-pprInlineInfo unf | isInlineRule unf = ppr unf
- | otherwise = empty
-\end{code}
-
------------------------------------------------------
--- Rules
------------------------------------------------------
\begin{code}
instance Outputable CoreRule where