+ | isTyVar binder = ptext SLIT("@") <+> pprTyVarBndr binder
+ | otherwise = pprIdBndr binder <+> dcolon <+> pprType (idType binder)
+
+pprTyVarBndr :: TyVar -> SDoc
+pprTyVarBndr tyvar
+ = getPprStyle $ \ sty ->
+ if debugStyle sty then
+ hsep [ppr tyvar, dcolon, pprParendKind kind]
+ -- See comments with ppDcolon in PprCore.lhs
+ else
+ ppr tyvar
+ where
+ kind = tyVarKind tyvar
+
+-- pprIdBndr does *not* print the type
+-- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness
+pprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id)
+
+pprIdBndrInfo info
+ = megaSeqIdInfo `seq` doc -- The seq is useful for poking on black holes
+ where
+ prag_info = inlinePragInfo info
+ occ_info = occInfo info
+ dmd_info = newDemandInfo info
+ lbv_info = lbvarInfo info
+
+ no_info = isAlwaysActive prag_info && isNoOcc occ_info &&
+ (case dmd_info of { Nothing -> True; Just d -> isTop d }) &&
+ hasNoLBVarInfo lbv_info
+
+ doc | no_info = empty
+ | otherwise
+ = brackets $ hcat [ppr prag_info, ppr occ_info,
+ ppr dmd_info, ppr lbv_info
+#ifdef OLD_STRICTNESS
+ , ppr (demandInfo id)
+#endif
+ ]
+\end{code}
+
+
+\begin{code}
+pprIdDetails :: Id -> SDoc
+pprIdDetails id | isGlobalId id = ppr (globalIdDetails id)
+ | isExportedId id = ptext SLIT("[Exported]")
+ | otherwise = empty
+
+ppIdInfo :: Id -> IdInfo -> SDoc
+ppIdInfo b info
+ = brackets $
+ vcat [ ppArityInfo a,
+ ppWorkerInfo (workerInfo info),
+ ppCafInfo (cafInfo info),
+#ifdef OLD_STRICTNESS
+ ppStrictnessInfo s,
+ ppCprInfo m,
+#endif
+ pprNewStrictness (newStrictnessInfo info),
+ if null rules then empty
+ else ptext SLIT("RULES:") <+> vcat (map pprRule rules)
+ -- Inline pragma, occ, demand, lbvar info
+ -- printed out with all binders (when debug is on);
+ -- see PprCore.pprIdBndr
+ ]
+ where
+ a = arityInfo info
+#ifdef OLD_STRICTNESS
+ s = strictnessInfo info
+ m = cprInfo info
+#endif
+ rules = specInfoRules (specInfo info)
+\end{code}
+
+
+\begin{code}
+instance Outputable CoreRule where
+ ppr = pprRule
+
+pprRules :: [CoreRule] -> SDoc
+pprRules rules = vcat (map pprRule rules)
+
+pprRule :: CoreRule -> SDoc
+pprRule (BuiltinRule { ru_fn = fn, ru_name = name})
+ = ptext SLIT("Built in rule for") <+> ppr fn <> colon <+> doubleQuotes (ftext name)
+
+pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn,
+ ru_bndrs = tpl_vars, ru_args = tpl_args,
+ ru_rhs = rhs })
+ = doubleQuotes (ftext name) <+> ppr act <+>
+ sep [
+ ptext SLIT("__forall") <+> braces (sep (map pprTypedBinder tpl_vars)),
+ nest 2 (ppr fn <+> sep (map pprArg tpl_args)),
+ nest 2 (ptext SLIT("=") <+> pprCoreExpr rhs)
+ ] <+> semi