From: simonpj@microsoft.com <unknown>
Date: Thu, 3 May 2007 12:47:15 +0000 (+0000)
Subject: Less voluminous debug
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=de905f504a3e129e2c4a1906d7e0a26e36cd6c4b

Less voluminous debug
---

diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs
index f8259c7..11eec3e 100644
--- a/compiler/simplCore/CSE.lhs
+++ b/compiler/simplCore/CSE.lhs
@@ -19,6 +19,7 @@ import CoreSyn
 import VarEnv	
 import CoreLint		( showPass, endPass )
 import Outputable
+import StaticFlags	( opt_PprStyle_Debug )
 import BasicTypes	( isAlwaysActive )
 import Util		( mapAccumL, lengthExceeds )
 import UniqFM
@@ -314,13 +315,14 @@ addCSEnvItem env expr expr' | exprIsBig expr = env
 extendCSEnv (CS cs in_scope sub) expr expr'
   = CS (addToUFM_C combine cs hash [(expr, expr')]) in_scope sub
   where
-    hash   = hashExpr expr
-    combine old new = WARN( result `lengthExceeds` 4, ((text "extendCSEnv: long list (length" <+> int (length result) <> comma 
-							<+> text "hash code" <+> text (show hash) <> char ')')
-							$$ nest 4 (ppr result)) )
-		      result
-		    where
-		      result = new ++ old
+    hash = hashExpr expr
+    combine old new 
+	= WARN( result `lengthExceeds` 4, short_msg $$ nest 2 long_msg ) result
+	where
+	  result = new ++ old
+	  short_msg = ptext SLIT("extendCSEnv: long list, length") <+> int (length result)
+	  long_msg | opt_PprStyle_Debug = (text "hash code" <+> text (show hash)) $$ ppr result 
+		   | otherwise	        = empty
 
 lookupSubst (CS _ _ sub) x = case lookupVarEnv sub x of
 			       Just y  -> y
diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 9985397..5223fe0 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -123,12 +123,12 @@ instance Outputable LetRhsFlag where
 
 instance Outputable SimplCont where
   ppr (Stop ty is_rhs _)  	     = ptext SLIT("Stop") <> brackets (ppr is_rhs) <+> ppr ty
-  ppr (ApplyTo dup arg se cont)      = ((ptext SLIT("ApplyTo") <+> ppr dup <+> pprParendExpr arg) $$ 
-					  nest 2 (pprSimplEnv se)) $$ ppr cont
+  ppr (ApplyTo dup arg se cont)      = ((ptext SLIT("ApplyTo") <+> ppr dup <+> pprParendExpr arg)
+					  {-  $$ nest 2 (pprSimplEnv se) -}) $$ ppr cont
   ppr (StrictBind b _ _ _ cont)      = (ptext SLIT("StrictBind") <+> ppr b) $$ ppr cont
   ppr (StrictArg f _ _ cont)         = (ptext SLIT("StrictArg") <+> ppr f) $$ ppr cont
   ppr (Select dup bndr alts se cont) = (ptext SLIT("Select") <+> ppr dup <+> ppr bndr) $$ 
-				       (nest 4 (ppr alts $$ pprSimplEnv se)) $$ ppr cont
+				       (nest 4 (ppr alts)) $$ ppr cont 
   ppr (CoerceIt co cont)	     = (ptext SLIT("CoerceIt") <+> ppr co) $$ ppr cont
 
 data DupFlag = OkToDup | NoDup
diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index 758d60d..fb0ad40 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -38,6 +38,7 @@ import Name		( Name, NamedThing(..) )
 import NameEnv
 import Unify 		( ruleMatchTyX, MatchEnv(..) )
 import BasicTypes	( Activation, CompilerPhase, isActive )
+import StaticFlags	( opt_PprStyle_Debug )
 import Outputable
 import FastString
 import Maybes
@@ -258,10 +259,15 @@ findBest target (rule1,ans1) ((rule2,ans2):prs)
   | rule1 `isMoreSpecific` rule2 = findBest target (rule1,ans1) prs
   | rule2 `isMoreSpecific` rule1 = findBest target (rule2,ans2) prs
 #ifdef DEBUG
-  | otherwise = pprTrace "Rules.findBest: rule overlap (Rule 1 wins)"
-			 (vcat [ptext SLIT("Expression to match:") <+> ppr fn <+> sep (map ppr args),
-				ptext SLIT("Rule 1:") <+> ppr rule1, 
-				ptext SLIT("Rule 2:") <+> ppr rule2]) $
+  | otherwise = let pp_rule rule 
+			| opt_PprStyle_Debug = ppr rule
+			| otherwise          = doubleQuotes (ftext (ru_name rule))
+		in pprTrace "Rules.findBest: rule overlap (Rule 1 wins)"
+			 (vcat [if opt_PprStyle_Debug then 
+				   ptext SLIT("Expression to match:") <+> ppr fn <+> sep (map ppr args)
+				else empty,
+				ptext SLIT("Rule 1:") <+> pp_rule rule1, 
+				ptext SLIT("Rule 2:") <+> pp_rule rule2]) $
 		findBest target (rule1,ans1) prs
 #else
   | otherwise = findBest target (rule1,ans1) prs