diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-02-08 11:31:32 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2017-02-08 11:33:32 +0000 |
| commit | 421308ef6ae3987f8077c6bfe1d9a6a03e53458c (patch) | |
| tree | 62224e93dc34354f5f4c5dd8f1c1ba052bcaf4af | |
| parent | 8e9593fb2147252ecb8b685ef6bf9c0237a71219 (diff) | |
| download | haskell-421308ef6ae3987f8077c6bfe1d9a6a03e53458c.tar.gz | |
Improve -dsuppress-coercions
The -dsuppress-coercions flag was being ignored when printing the
CastIt constructor in SimplUtils.SimplCont. This fixes ths problem,
and improves what is printed when suppressing coercions, to show the
size of the suppressed coercion.
| -rw-r--r-- | compiler/coreSyn/PprCore.hs | 5 | ||||
| -rw-r--r-- | compiler/simplCore/SimplUtils.hs | 2 |
2 files changed, 4 insertions, 3 deletions
diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs index 196a9b9973..c61b16605e 100644 --- a/compiler/coreSyn/PprCore.hs +++ b/compiler/coreSyn/PprCore.hs @@ -12,7 +12,7 @@ module PprCore ( pprCoreExpr, pprParendExpr, pprCoreBinding, pprCoreBindings, pprCoreAlt, pprCoreBindingWithSize, pprCoreBindingsWithSize, - pprRules + pprRules, pprOptCo ) where import CoreSyn @@ -130,9 +130,10 @@ noParens :: SDoc -> SDoc noParens pp = pp pprOptCo :: Coercion -> SDoc +-- Print a coercion optionally; i.e. honouring -dsuppress-coercions pprOptCo co = sdocWithDynFlags $ \dflags -> if gopt Opt_SuppressCoercions dflags - then text "..." + then angleBrackets (text "Co:" <> int (coercionSize co)) else parens (sep [ppr co, dcolon <+> ppr (coercionType co)]) ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index 2e985c5713..7deaf5bf0c 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -179,7 +179,7 @@ instance Outputable DupFlag where instance Outputable SimplCont where ppr (Stop ty interesting) = text "Stop" <> brackets (ppr interesting) <+> ppr ty - ppr (CastIt co cont ) = (text "CastIt" <+> ppr co) $$ ppr cont + ppr (CastIt co cont ) = (text "CastIt" <+> pprOptCo co) $$ ppr cont ppr (TickIt t cont) = (text "TickIt" <+> ppr t) $$ ppr cont ppr (ApplyToTy { sc_arg_ty = ty, sc_cont = cont }) = (text "ApplyToTy" <+> pprParendType ty) $$ ppr cont |