+
+showAttributes :: [(Bool,SDoc)] -> SDoc
+showAttributes stuff
+ | null docs = empty
+ | otherwise = brackets (sep (punctuate comma docs))
+ where
+ docs = [d | (True,d) <- stuff]
+\end{code}
+
+-----------------------------------------------------
+-- Unfolding and UnfoldingGuidance
+-----------------------------------------------------
+
+\begin{code}
+instance Outputable UnfoldingGuidance where
+ ppr UnfoldNever = ptext (sLit "NEVER")
+ ppr UnfoldAlways = ptext (sLit "ALWAYS")
+ ppr (InlineRule { ug_ir_info = inl_info, ug_small = small })
+ = ptext (sLit "InlineRule") <> ppr (inl_info,small)
+ ppr (UnfoldIfGoodArgs { ug_args = cs, ug_size = size, ug_res = discount })
+ = hsep [ ptext (sLit "IF_ARGS"),
+ brackets (hsep (map int cs)),
+ int size,
+ int discount ]
+
+instance Outputable InlineRuleInfo where
+ ppr (InlWrapper w) = ptext (sLit "worker=") <> ppr w
+ ppr InlSat = ptext (sLit "sat")
+ ppr InlUnSat = ptext (sLit "unsat")
+
+instance Outputable Unfolding where
+ ppr NoUnfolding = ptext (sLit "No unfolding")
+ ppr (OtherCon cs) = ptext (sLit "OtherCon") <+> ppr cs
+ ppr (DFunUnfolding con ops) = ptext (sLit "DFun") <+> ppr con
+ <+> brackets (pprWithCommas pprParendExpr ops)
+ ppr (CoreUnfolding { uf_tmpl=rhs, uf_is_top=top, uf_is_value=hnf
+ , uf_is_conlike=conlike, uf_is_cheap=cheap
+ , uf_expandable=exp, uf_guidance=g, uf_arity=arity})
+ = ptext (sLit "Unf") <> braces (pp_info $$ pp_rhs)
+ where
+ pp_info = hsep [ ptext (sLit "TopLvl=") <> ppr top
+ , ptext (sLit "Arity=") <> int arity
+ , ptext (sLit "Value=") <> ppr hnf
+ , ptext (sLit "ConLike=") <> ppr conlike
+ , ptext (sLit "Cheap=") <> ppr cheap
+ , ptext (sLit "Expandable=") <> ppr exp
+ , ppr g ]
+ pp_rhs = case g of
+ UnfoldNever -> usually_empty
+ UnfoldIfGoodArgs {} -> usually_empty
+ _other -> ppr rhs
+ usually_empty = ifPprDebug (ppr rhs)
+ -- In this case show 'rhs' only in debug mode