+ | 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 <+>
+ (megaSeqIdInfo (idInfo id) `seq`
+ -- Useful for poking on black holes
+ ifPprDebug (ppr (idInlinePragma id) <+> ppr (idOccInfo id) <+>
+#ifdef OLD_STRICTNESS
+ ppr (idDemandInfo id) <+>
+#endif
+ ppr (idNewDemandInfo id) <+>
+ ppr (idLBVarInfo id)))
+\end{code}
+
+
+\begin{code}
+pprIdDetails :: Id -> SDoc
+pprIdDetails id | isGlobalId id = ppr (globalIdDetails id)
+ | isExportedId id = ptext SLIT("[Exported]")
+ | isSpecPragmaId id = ptext SLIT("[SpecPrag]")
+ | otherwise = empty
+
+ppIdInfo :: Id -> IdInfo -> SDoc
+ppIdInfo b info
+ = hsep [ ppArityInfo a,
+ ppWorkerInfo (workerInfo info),
+ ppCafInfo (cafInfo info),
+#ifdef OLD_STRICTNESS
+ ppStrictnessInfo s,
+ ppCprInfo m,
+#endif
+ pprNewStrictness (newStrictnessInfo info),
+ vcat (map (pprCoreRule (ppr b)) (rulesRules p))
+ -- 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
+ p = specInfo info
+\end{code}
+
+
+\begin{code}
+pprIdRules :: [IdCoreRule] -> SDoc
+pprIdRules rules = vcat (map pprIdRule rules)
+
+pprIdRule :: IdCoreRule -> SDoc
+pprIdRule (IdCoreRule id _ rule) = pprCoreRule (ppr id) rule
+
+pprCoreRule :: SDoc -> CoreRule -> SDoc
+pprCoreRule pp_fn (BuiltinRule name _)
+ = ptext SLIT("Built in rule for") <+> pp_fn <> colon <+> doubleQuotes (ftext name)
+
+pprCoreRule pp_fn (Rule name act tpl_vars tpl_args rhs)
+ = doubleQuotes (ftext name) <+> ppr act <+>
+ sep [
+ ptext SLIT("__forall") <+> braces (sep (map pprTypedBinder tpl_vars)),
+ nest 2 (pp_fn <+> sep (map pprArg tpl_args)),
+ nest 2 (ptext SLIT("=") <+> pprCoreExpr rhs)
+ ] <+> semi