pprCoreExpr, pprParendExpr,
pprCoreBinding, pprCoreBindings, pprIdBndr,
pprCoreBinding, pprCoreBindings, pprCoreAlt,
- pprCoreRules, pprCoreRule, pprIdCoreRule
+ pprIdRules, pprCoreRule
) where
#include "HsVersions.h"
import CoreSyn
import CostCentre ( pprCostCentreCore )
import Id ( Id, idType, isDataConId_maybe, idLBVarInfo, idArity,
- idInfo, idInlinePragma, idDemandInfo, idOccInfo,
- globalIdDetails, isGlobalId, isExportedId, isSpecPragmaId
+ idInfo, idInlinePragma, idOccInfo,
+#ifdef OLD_STRICTNESS
+ idDemandInfo,
+#endif
+ globalIdDetails, isGlobalId, isExportedId,
+ isSpecPragmaId, idNewDemandInfo
)
import Var ( isTyVar )
import IdInfo ( IdInfo, megaSeqIdInfo,
arityInfo, ppArityInfo,
- specInfo, cprInfo, ppCprInfo,
- strictnessInfo, ppStrictnessInfo,
- cprInfo, ppCprInfo,
+ specInfo, ppStrictnessInfo,
workerInfo, ppWorkerInfo,
tyGenInfo, ppTyGenInfo,
- newDemandInfo, newStrictnessInfo
+ newStrictnessInfo,
+#ifdef OLD_STRICTNESS
+ cprInfo, ppCprInfo,
+ strictnessInfo,
+#endif
)
import DataCon ( dataConTyCon )
import TyCon ( tupleTyConBoxity, isTupleTyCon )
import PprType ( pprParendType, pprTyVarBndr )
import BasicTypes ( tupleParens )
import PprEnv
+import Util ( lengthIs )
import Outputable
\end{code}
-> tupleParens (tupleTyConBoxity tc) pp_tup_args
where
tc = dataConTyCon dc
- saturated = length val_args == idArity f
+ saturated = val_args `lengthIs` idArity f
other -> add_par (hang (pOcc pe f) 2 pp_args)
ppr_expr add_par pe (Note (Coerce to_ty from_ty) expr)
= add_par $
getPprStyle $ \ sty ->
- if debugStyle sty && not (ifaceStyle sty) then
+ if debugStyle sty then
sep [ptext SLIT("__coerce") <+> sep [pTy pe to_ty, pTy pe from_ty],
ppr_parend_expr pe expr]
else
(megaSeqIdInfo (idInfo id) `seq`
-- Useful for poking on black holes
ifPprDebug (ppr (idInlinePragma id) <+> ppr (idOccInfo id) <+>
- ppr (idDemandInfo id)) <+> ppr (newDemandInfo (idInfo id)) <+>
- ppr (idLBVarInfo id))
+#ifdef OLD_STRICTNESS
+ ppr (idDemandInfo id) <+>
+#endif
+ ppr (idNewDemandInfo id) <+>
+ ppr (idLBVarInfo id)))
\end{code}
= hsep [ ppArityInfo a,
ppTyGenInfo g,
ppWorkerInfo (workerInfo info),
+#ifdef OLD_STRICTNESS
ppStrictnessInfo s,
ppCprInfo m,
+#endif
ppr (newStrictnessInfo info),
- pprCoreRules b p
+ 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
g = tyGenInfo info
+#ifdef OLD_STRICTNESS
s = strictnessInfo info
m = cprInfo info
+#endif
p = specInfo info
\end{code}
\begin{code}
-pprCoreRules :: Id -> CoreRules -> SDoc
-pprCoreRules var (Rules rules _) = vcat (map (pprCoreRule (ppr var)) rules)
+pprIdRules :: [IdCoreRule] -> SDoc
+pprIdRules rules = vcat (map pprIdRule rules)
-pprIdCoreRule :: IdCoreRule -> SDoc
-pprIdCoreRule (id,rule) = pprCoreRule (ppr id) rule
+pprIdRule :: IdCoreRule -> SDoc
+pprIdRule (id,rule) = pprCoreRule (ppr id) rule
pprCoreRule :: SDoc -> CoreRule -> SDoc
pprCoreRule pp_fn (BuiltinRule name _)
- = ifPprDebug (ptext SLIT("Built in rule") <+> doubleQuotes (ptext name))
+ = ifPprDebug (ptext SLIT("Built in rule for") <+> pp_fn <> colon <+> doubleQuotes (ptext name))
pprCoreRule pp_fn (Rule name act tpl_vars tpl_args rhs)
= doubleQuotes (ptext name) <+> ppr act <+>