X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FcoreSyn%2FPprCore.lhs;h=950e37bc84cc049f5774f70e726cb28e80866798;hb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba;hp=56c6572a5e0e2d9ed14a436c7b9af37132fa453f;hpb=bcadca676448e38427b910bad5d7063f948a99c8;p=ghc-hetmet.git diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index 56c6572..950e37b 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/compiler/coreSyn/PprCore.lhs @@ -17,12 +17,7 @@ import CostCentre import Var import Id import IdInfo -import NewDemand -#ifdef OLD_STRICTNESS -import Id -import IdInfo -#endif - +import Demand import DataCon import TyCon import Type @@ -269,9 +264,6 @@ pprCoreBinder LambdaBind bndr -- 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) @@ -311,7 +303,7 @@ pprIdBndrInfo info 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) @@ -339,7 +331,7 @@ ppIdInfo id 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 @@ -356,7 +348,7 @@ ppIdInfo id 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 @@ -420,8 +412,9 @@ instance Outputable Unfolding where UnfoldNever -> usually_empty UnfoldIfGoodArgs {} -> usually_empty _other -> pp_tmpl - usually_empty = ifPprDebug pp_tmpl - -- In this case show 'rhs' only in debug mode + usually_empty = ifPprDebug (ptext (sLit "")) + -- Don't print the RHS or we get a quadratic + -- blowup in the size of the printout! \end{code} -----------------------------------------------------