import Var
import Id
import IdInfo
-import NewDemand
-#ifdef OLD_STRICTNESS
-import Id
-import IdInfo
-#endif
-
+import Demand
import DataCon
import TyCon
import Type
where
pprCo co | opt_SuppressCoercions = ptext (sLit "...")
| otherwise = parens
- $ sep [ppr co, dcolon <+> ppr (coercionKindPredTy co)]
+ $ sep [ppr co, dcolon <+> pprEqPred (coercionKind co)]
ppr_expr add_par expr@(Lam _ _)
-- 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)
where
prag_info = inlinePragInfo info
occ_info = occInfo info
- dmd_info = newDemandInfo info
+ dmd_info = demandInfo info
lbv_info = lbvarInfo info
has_prag = not (isDefaultInlinePragma prag_info)
[ (True, pp_scope <> ppr (idDetails id))
, (has_arity, ptext (sLit "Arity=") <> int arity)
, (has_caf_info, ptext (sLit "Caf=") <> ppr caf_info)
- , (has_strictness, ptext (sLit "Str=") <> pprNewStrictness str_info)
+ , (has_strictness, ptext (sLit "Str=") <> pprStrictness str_info)
, (has_unf, ptext (sLit "Unf=") <> ppr unf_info)
, (not (null rules), ptext (sLit "RULES:") <+> vcat (map pprRule rules))
] -- Inline pragma, occ, demand, lbvar info
caf_info = cafInfo info
has_caf_info = not (mayHaveCafRefs caf_info)
- str_info = newStrictnessInfo info
+ str_info = strictnessInfo info
has_strictness = isJust str_info
unf_info = unfoldingInfo info
\begin{code}
instance Outputable UnfoldingGuidance where
- ppr UnfoldNever = ptext (sLit "NEVER")
- ppr (InlineRule { ir_info = info, ir_sat = sat })
- = ptext (sLit "InlineRule") <> ppr (sat,info)
- ppr (UnfoldIfGoodArgs { ug_args = cs, ug_size = size, ug_res = discount })
+ ppr UnfNever = ptext (sLit "NEVER")
+ ppr (UnfWhen unsat_ok boring_ok)
+ = ptext (sLit "ALWAYS_IF") <>
+ parens (ptext (sLit "unsat_ok=") <> ppr unsat_ok <> comma <>
+ ptext (sLit "boring_ok=") <> ppr boring_ok)
+ ppr (UnfIfGoodArgs { 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 InlSatFlag where
- ppr InlSat = ptext (sLit "sat")
- ppr InlUnSat = ptext (sLit "unsat")
-
-instance Outputable InlineRuleInfo where
- ppr (InlWrapper w) = ptext (sLit "worker=") <> ppr w
- ppr InlSmall = ptext (sLit "small")
- ppr InlAlways = ptext (sLit "always")
- ppr InlVanilla = ptext (sLit "-")
+instance Outputable UnfoldingSource where
+ ppr InlineCompulsory = ptext (sLit "Compulsory")
+ ppr (InlineWrapper w) = ptext (sLit "Worker=") <> ppr w
+ ppr InlineRule = ptext (sLit "InlineRule")
+ ppr InlineRhs = ptext (sLit "<vanilla>")
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
+ ppr (CoreUnfolding { uf_src = src
+ , 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
+ pp_info = fsep $ punctuate comma
+ [ ptext (sLit "Src=") <> ppr src
+ , 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
+ , ptext (sLit "Guidance=") <> ppr g ]
+ pp_tmpl = ptext (sLit "Tmpl=") <+> ppr rhs
+ pp_rhs | isInlineRuleSource src = pp_tmpl
+ | otherwise = empty
+ -- Don't print the RHS or we get a quadratic
+ -- blowup in the size of the printout!
\end{code}
-----------------------------------------------------