Add -dsuppress-coercion-types to make coercions even smaller.

Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)``
simply print `` `cast` <Co:11> :: ... ``

4 files changed, 14 insertions, 3 deletions

diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index c24e223553..d4b2cbeb93 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -172,8 +172,12 @@ noParens pp = pp
 pprOptCo :: Coercion -> SDoc
 -- Print a coercion optionally; i.e. honouring -dsuppress-coercions
 pprOptCo co = sdocOption sdocSuppressCoercions $ \case
-              True  -> angleBrackets (text "Co:" <> int (coercionSize co)) <+> dcolon <+> ppr (coercionType co)
-              False -> parens $ sep [ppr co, dcolon <+> ppr (coercionType co)]
+              True  -> angleBrackets (text "Co:" <> int (coercionSize co)) <+> dcolon <+> co_type
+              False -> parens $ sep [ppr co, dcolon <+> co_type]
+    where
+      co_type = sdocOption sdocSuppressCoercionTypes $ \case
+          True -> text "..."
+          False -> ppr (coercionType co)
 
 ppr_id_occ :: (SDoc -> SDoc) -> Id -> SDoc
 ppr_id_occ add_par id
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index f158e6a42b..a4e5827bc6 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -399,8 +399,10 @@ data GeneralFlag
    | Opt_ShowLoadedModules
    | Opt_HexWordLiterals -- See Note [Print Hexadecimal Literals]
 
-   -- Suppress all coercions, them replacing with '...'
+   -- Suppress a coercions inner structure, replacing it with '...'
    | Opt_SuppressCoercions
+   -- Suppress the type of a coercion as well
+   | Opt_SuppressCoercionTypes
    | Opt_SuppressVarKinds
    -- Suppress module id prefixes on variables.
    | Opt_SuppressModulePrefixes
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 061209d315..43f58884fc 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -2376,6 +2376,7 @@ dynamic_flags_deps = [
   -- have otherwise identical names.
   , make_ord_flag defGhcFlag "dsuppress-all"
       (NoArg $ do setGeneralFlag Opt_SuppressCoercions
+                  setGeneralFlag Opt_SuppressCoercionTypes
                   setGeneralFlag Opt_SuppressVarKinds
                   setGeneralFlag Opt_SuppressModulePrefixes
                   setGeneralFlag Opt_SuppressTypeApplications
@@ -3330,6 +3331,7 @@ dFlagsDeps = [
      (useInstead "-d" "suppress-stg-exts"),
   flagSpec "suppress-stg-exts"          Opt_SuppressStgExts,
   flagSpec "suppress-coercions"         Opt_SuppressCoercions,
+  flagSpec "suppress-coercion-types"    Opt_SuppressCoercionTypes,
   flagSpec "suppress-idinfo"            Opt_SuppressIdInfo,
   flagSpec "suppress-unfoldings"        Opt_SuppressUnfoldings,
   flagSpec "suppress-module-prefixes"   Opt_SuppressModulePrefixes,
@@ -4997,6 +4999,7 @@ initSDocContext dflags style = SDC
   , sdocSuppressTypeApplications    = gopt Opt_SuppressTypeApplications dflags
   , sdocSuppressIdInfo              = gopt Opt_SuppressIdInfo dflags
   , sdocSuppressCoercions           = gopt Opt_SuppressCoercions dflags
+  , sdocSuppressCoercionTypes       = gopt Opt_SuppressCoercionTypes dflags
   , sdocSuppressUnfoldings          = gopt Opt_SuppressUnfoldings dflags
   , sdocSuppressVarKinds            = gopt Opt_SuppressVarKinds dflags
   , sdocSuppressUniques             = gopt Opt_SuppressUniques dflags
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index 6ff57e5775..c820c8b51d 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -381,6 +381,7 @@ data SDocContext = SDC
   , sdocSuppressTypeApplications    :: !Bool
   , sdocSuppressIdInfo              :: !Bool
   , sdocSuppressCoercions           :: !Bool
+  , sdocSuppressCoercionTypes       :: !Bool
   , sdocSuppressUnfoldings          :: !Bool
   , sdocSuppressVarKinds            :: !Bool
   , sdocSuppressUniques             :: !Bool
@@ -441,6 +442,7 @@ defaultSDocContext = SDC
   , sdocSuppressTypeApplications    = False
   , sdocSuppressIdInfo              = False
   , sdocSuppressCoercions           = False
+  , sdocSuppressCoercionTypes       = False
   , sdocSuppressUnfoldings          = False
   , sdocSuppressVarKinds            = False
   , sdocSuppressUniques             = False