[commit: ghc] master: Improve -dsuppress-coercions (421308e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/421308ef6ae3987f8077c6bfe1d9a6a03e53458c/ghc

>---------------------------------------------------------------

commit 421308ef6ae3987f8077c6bfe1d9a6a03e53458c
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Feb 8 11:31:32 2017 +0000

    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.


>---------------------------------------------------------------

421308ef6ae3987f8077c6bfe1d9a6a03e53458c
 compiler/coreSyn/PprCore.hs      | 5 +++--
 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 196a9b9..c61b166 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 2e985c5..7deaf5b 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