From ac97c15c33cb5658d2da35fd2a6768a4c0556361 Mon Sep 17 00:00:00 2001
From: Roman Leshchinskiy <rl@cse.unsw.edu.au>
Date: Wed, 14 Oct 2009 00:30:58 +0000
Subject: [PATCH] New flag -dsuppress-coercions to avoid printing coercions in
 Core dumps

---
 compiler/coreSyn/PprCore.lhs      |    7 +++++--
 compiler/main/StaticFlagParser.hs |    1 +
 compiler/main/StaticFlags.hs      |    3 +++
 docs/users_guide/debugging.xml    |   11 +++++++++++
 docs/users_guide/flags.xml        |    6 ++++++
 5 files changed, 26 insertions(+), 2 deletions(-)

diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index e210937..3b829f7 100644
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -27,6 +27,7 @@ import DataCon
 import TyCon
 import Type
 import Coercion
+import StaticFlags
 import BasicTypes
 import Util
 import Outputable
@@ -114,9 +115,11 @@ ppr_expr _       (Lit lit)  = ppr lit
 ppr_expr add_par (Cast expr co) 
   = add_par $
     sep [pprParendExpr expr, 
-	 ptext (sLit "`cast`") <+> parens (pprCo co)]
+	 ptext (sLit "`cast`") <+> pprCo co]
   where
-    pprCo co = sep [ppr co, dcolon <+> ppr (coercionKindPredTy co)]
+    pprCo co | opt_SuppressCoercions = ptext (sLit "...")
+             | otherwise = parens
+                         $ sep [ppr co, dcolon <+> ppr (coercionKindPredTy co)]
 	 
 
 ppr_expr add_par expr@(Lam _ _)
diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index bcc96a6..966b6ec 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -120,6 +120,7 @@ static_flags = [
         ------ Debugging ----------------------------------------------------
   , Flag "dppr-debug"        (PassFlag addOpt) Supported
   , Flag "dsuppress-uniques" (PassFlag addOpt) Supported
+  , Flag "dsuppress-coercions" (PassFlag addOpt) Supported
   , Flag "dppr-user-length"  (AnySuffix addOpt) Supported
   , Flag "dopt-fuel"         (AnySuffix addOpt) Supported
   , Flag "dno-debug-output"  (PassFlag addOpt) Supported
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 8035211..2d3b3ad 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -22,6 +22,7 @@ module StaticFlags (
 	-- Output style options
 	opt_PprUserLength,
 	opt_SuppressUniques,
+        opt_SuppressCoercions,
 	opt_PprStyle_Debug,
         opt_NoDebugOutput,
 
@@ -182,6 +183,8 @@ opt_IgnoreDotGhci		= lookUp (fsLit "-ignore-dot-ghci")
 -- debugging opts
 opt_SuppressUniques :: Bool
 opt_SuppressUniques		= lookUp  (fsLit "-dsuppress-uniques")
+opt_SuppressCoercions :: Bool
+opt_SuppressCoercions           = lookUp  (fsLit "-dsuppress-coercions")
 opt_PprStyle_Debug  :: Bool
 opt_PprStyle_Debug		= lookUp  (fsLit "-dppr-debug")
 opt_PprUserLength   :: Int
diff --git a/docs/users_guide/debugging.xml b/docs/users_guide/debugging.xml
index d6a520a..d1e9e16 100644
--- a/docs/users_guide/debugging.xml
+++ b/docs/users_guide/debugging.xml
@@ -437,6 +437,17 @@
 
       <varlistentry>
 	<term>
+          <option>-dsuppress-coercions</option>
+          <indexterm><primary><option>-dsuppress-coercions</option></primary></indexterm>
+        </term>
+	<listitem>
+          <para>Suppress the printing of coercions in Core dumps to make them
+shorter.</para>
+	</listitem>
+      </varlistentry>
+
+      <varlistentry>
+	<term>
           <option>-dppr-user-length</option>
           <indexterm><primary><option>-dppr-user-length</option></primary></indexterm>
         </term>
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index aae0f59..afec9bd 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -2307,6 +2307,12 @@
 	      <entry>-</entry>
 	    </row>
 	    <row>
+	      <entry><option>-dsuppress-coercions</option></entry>
+	      <entry>Suppress the printing of coercions in Core dumps to make them shorter.</entry>
+	      <entry>static</entry>
+	      <entry>-</entry>
+	    </row>
+	    <row>
 	      <entry><option>-dppr-noprags</option></entry>
 	      <entry>Don't output pragma info in dumps</entry>
 	      <entry>static</entry>
-- 
1.7.10.4