From: simonpj@microsoft.com <unknown>
Date: Mon, 11 Aug 2008 14:42:57 +0000 (+0000)
Subject: Print tidy rules in user style, to avoid gratuitous uniques
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=9bcaaaaa59acff95886ad3675677e58c43106bd2

Print tidy rules in user style, to avoid gratuitous uniques

The uniques that come out in dumpStyle make it harder to compare
output in the testsuite.  And the rules are tidied, so uniques
are not necessary.  If you want the uniques, use -dppr-debug.
---

diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index 86d3ec0..5b52d2d 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -284,7 +284,8 @@ prepareRules :: HscEnv
 					-- 	(b) Rules are now just orphan rules
 
 prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt })
-	     guts@(ModGuts { mg_binds = binds, mg_deps = deps, mg_rules = local_rules })
+	     guts@(ModGuts { mg_binds = binds, mg_deps = deps 
+	     		   , mg_rules = local_rules, mg_rdr_env = rdr_env })
 	     us 
   = do	{ let 	-- Simplify the local rules; boringly, we need to make an in-scope set
 		-- from the local binders, to avoid warnings from Simplify.simplVar
@@ -317,7 +318,8 @@ prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt })
 	      imp_rule_base = extendRuleBaseList hpt_rule_base rules_for_imps
 
 	; dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules"
-		(vcat [text "Local rules", pprRules better_rules,
+		(withPprStyle (mkUserStyle (mkPrintUnqualified dflags rdr_env) AllTheWay) $
+		 vcat [text "Local rules", pprRules better_rules,
 		       text "",
 		       text "Imported rules", pprRuleBase imp_rule_base])
 
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 055f794..a52de10 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -463,7 +463,8 @@ specConstrProgram dflags us binds
 	endPass dflags "SpecConstr" Opt_D_dump_spec binds'
 
 	dumpIfSet_dyn dflags Opt_D_dump_rules "Top-level specialisations"
-		  (pprRules (tidyRules emptyTidyEnv (rulesOfBinds binds')))
+		  (withPprStyle defaultUserStyle $
+		   pprRules (tidyRules emptyTidyEnv (rulesOfBinds binds')))
 
 	return binds'
   where
diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index a3b5dd6..b424e4a 100644
--- a/compiler/specialise/Specialise.lhs
+++ b/compiler/specialise/Specialise.lhs
@@ -588,7 +588,8 @@ specProgram dflags us binds = do
 	endPass dflags "Specialise" Opt_D_dump_spec binds'
 
 	dumpIfSet_dyn dflags Opt_D_dump_rules "Top-level specialisations"
-		  (pprRules (tidyRules emptyTidyEnv (rulesOfBinds binds')))
+		  (withPprStyle defaultUserStyle $
+		   pprRules (tidyRules emptyTidyEnv (rulesOfBinds binds')))
 
 	return binds'
   where