X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprCore.lhs;h=d641a9e833140f8e900d69f31057e50c4c81a835;hp=595b6d3370ddfddd56110db214dc60ea7793facc;hb=e79c9ce01d0ce4412bd4bcd99c8c728a6a2ec569;hpb=6ccd648bf016aa9cfa13612f0f19be6badea16d1 diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index 595b6d3..d641a9e 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/compiler/coreSyn/PprCore.lhs @@ -209,6 +209,9 @@ ppr_expr add_par (Let bind expr) 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)], @@ -265,9 +268,6 @@ pprCoreBinder LambdaBind bndr -- 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) @@ -325,10 +325,6 @@ pprIdBndrInfo info \end{code} ------------------------------------------------------ --- IdInfo ------------------------------------------------------ - \begin{code} pprIdDetails :: Id -> SDoc pprIdDetails id | isGlobalId id = ppr (globalIdDetails id) @@ -339,13 +335,13 @@ 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 @@ -361,38 +357,6 @@ ppIdInfo _ 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