X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FRules.lhs;h=66442ebb55ed4c068024669c04ef35b8844c3b17;hb=fb0a3438b4a3c3df99cbe35baab7da97150d41cd;hp=03038337268fc8a93b4aa44e7c7d318cc73acd7b;hpb=2a8123e1eaac6198fdf1c029561dddffc1ab2cff;p=ghc-hetmet.git

diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index 0303833..66442eb 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -29,7 +29,7 @@ module Rules (
 	addIdSpecialisations, 
 	
 	-- * Misc. CoreRule helpers
-        rulesOfBinds,
+        rulesOfBinds, pprRulesForUser,
         
         lookupRule, mkLocalRule, roughTopNames
     ) where
@@ -152,6 +152,22 @@ ruleCantMatch (t       : ts) (a       : as) = ruleCantMatch ts as
 ruleCantMatch ts	     as		    = False
 \end{code}
 
+\begin{code}
+pprRulesForUser :: [CoreRule] -> SDoc
+-- (a) tidy the rules
+-- (b) sort them into order based on the rule name
+-- (c) suppress uniques (unless -dppr-debug is on)
+-- This combination makes the output stable so we can use in testing
+-- It's here rather than in PprCore because it calls tidyRules
+pprRulesForUser rules
+  = withPprStyle defaultUserStyle $
+    pprRules $
+    sortLe le_rule  $
+    tidyRules emptyTidyEnv rules
+  where 
+    le_rule r1 r2 = ru_name r1 <= ru_name r2
+\end{code}
+
 
 %************************************************************************
 %*									*
@@ -168,7 +184,6 @@ mkSpecInfo rules = SpecInfo rules (rulesFreeVars rules)
 extendSpecInfo :: SpecInfo -> [CoreRule] -> SpecInfo
 extendSpecInfo (SpecInfo rs1 fvs1) rs2
   = SpecInfo (rs2 ++ rs1) (rulesFreeVars rs2 `unionVarSet` fvs1)
-
 addSpecInfo :: SpecInfo -> SpecInfo -> SpecInfo
 addSpecInfo (SpecInfo rs1 fvs1) (SpecInfo rs2 fvs2) 
   = SpecInfo (rs1 ++ rs2) (fvs1 `unionVarSet` fvs2)