Commit a0e8bb74 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Implement -dsuppress-unfoldings

This extra "suppress" flag helps when there are a lot of Ids
with big unfoldings that clutter up the dump

Also slightly refactor printing of coercions in Core
parent 0df2348a
......@@ -120,6 +120,12 @@ pprCoreExpr expr = ppr_expr noParens expr
noParens :: SDoc -> SDoc
noParens pp = pp
pprOptCo :: Coercion -> SDoc
pprOptCo co = sdocWithDynFlags $ \dflags ->
if gopt Opt_SuppressCoercions dflags
then ptext (sLit "...")
else parens (sep [ppr co, dcolon <+> ppr (coercionType co)])
ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
-- The function adds parens in context that need
-- an atomic value (e.g. function args)
......@@ -130,16 +136,7 @@ ppr_expr add_par (Coercion co) = add_par (ptext (sLit "CO") <+> ppr co)
ppr_expr add_par (Lit lit) = pprLiteral add_par lit
ppr_expr add_par (Cast expr co)
= add_par $
sep [pprParendExpr expr,
ptext (sLit "`cast`") <+> pprCo co]
where
pprCo co = sdocWithDynFlags $ \dflags ->
if gopt Opt_SuppressCoercions dflags
then ptext (sLit "...")
else parens $
sep [ppr co, dcolon <+> ppr (coercionType co)]
= add_par $ sep [pprParendExpr expr, ptext (sLit "`cast`") <+> pprOptCo co]
ppr_expr add_par expr@(Lam _ _)
= let
......@@ -271,7 +268,7 @@ pprArg (Type ty)
if gopt Opt_SuppressTypeApplications dflags
then empty
else ptext (sLit "@") <+> pprParendType ty
pprArg (Coercion co) = ptext (sLit "@~") <+> pprParendCo co
pprArg (Coercion co) = ptext (sLit "@~") <+> pprOptCo co
pprArg expr = pprParendExpr expr
{-
......@@ -361,9 +358,8 @@ pprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id)
pprIdBndrInfo :: IdInfo -> SDoc
pprIdBndrInfo info
= sdocWithDynFlags $ \dflags ->
if gopt Opt_SuppressIdInfo dflags
then empty
else info `seq` doc -- The seq is useful for poking on black holes
ppUnless (gopt Opt_SuppressIdInfo dflags) $
info `seq` doc -- The seq is useful for poking on black holes
where
prag_info = inlinePragInfo info
occ_info = occInfo info
......@@ -391,9 +387,7 @@ pprIdBndrInfo info
ppIdInfo :: Id -> IdInfo -> SDoc
ppIdInfo id info
= sdocWithDynFlags $ \dflags ->
if gopt Opt_SuppressIdInfo dflags
then empty
else
ppUnless (gopt Opt_SuppressIdInfo dflags) $
showAttributes
[ (True, pp_scope <> ppr (idDetails id))
, (has_arity, ptext (sLit "Arity=") <> int arity)
......@@ -478,7 +472,9 @@ instance Outputable Unfolding where
, ptext (sLit "WorkFree=") <> ppr wf
, ptext (sLit "Expandable=") <> ppr exp
, ptext (sLit "Guidance=") <> ppr g ]
pp_tmpl = ptext (sLit "Tmpl=") <+> ppr rhs
pp_tmpl = sdocWithDynFlags $ \dflags ->
ppUnless (gopt Opt_SuppressUnfoldings dflags) $
ptext (sLit "Tmpl=") <+> ppr rhs
pp_rhs | isStableSource src = pp_tmpl
| otherwise = empty
-- Don't print the RHS or we get a quadratic
......
......@@ -442,6 +442,8 @@ data GeneralFlag
| Opt_SuppressIdInfo
-- Suppress separate type signatures in core, but leave types on
-- lambda bound vars
| Opt_SuppressUnfoldings
-- Suppress the details of even stable unfoldings
| Opt_SuppressTypeSignatures
-- Suppress unique ids on variables.
-- Except for uniques, as some simplifier phases introduce new
......@@ -2905,6 +2907,7 @@ dFlags = [
flagSpec "ppr-ticks" Opt_PprShowTicks,
flagSpec "suppress-coercions" Opt_SuppressCoercions,
flagSpec "suppress-idinfo" Opt_SuppressIdInfo,
flagSpec "suppress-unfoldings" Opt_SuppressUnfoldings,
flagSpec "suppress-module-prefixes" Opt_SuppressModulePrefixes,
flagSpec "suppress-type-applications" Opt_SuppressTypeApplications,
flagSpec "suppress-type-signatures" Opt_SuppressTypeSignatures,
......
......@@ -10,8 +10,8 @@ T2431.$WRefl [InlPrag=INLINE] :: forall a. a :~: a
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=False)
Tmpl= \ (@ a) -> T2431.Refl @ a @ a @~ <a>_N}]
T2431.$WRefl = \ (@ a) -> T2431.Refl @ a @ a @~ <a>_N
Tmpl= \ (@ a) -> T2431.Refl @ a @ a @~ (<a>_N :: a ~# a)}]
T2431.$WRefl = \ (@ a) -> T2431.Refl @ a @ a @~ (<a>_N :: a ~# a)
-- RHS size: {terms: 4, types: 7, coercions: 0}
absurd :: forall a. Int :~: Bool -> a
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment