Print tidy rules in user style, to avoid gratuitous uniques

[ghc-hetmet.git] / compiler / specialise / Specialise.lhs

diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index 41bdfd7..b424e4a 100644 (file)
--- 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
@@ -1164,11 +1165,15 @@ dumpUDs :: [CoreBndr]
 dumpUDs bndrs (MkUD { dict_binds = orig_dbs
                    , calls = orig_calls
                    , ud_fvs = fvs}) body
-  = (MkUD { dict_binds = free_dbs
-         , calls      = free_calls 
-         , ud_fvs     = fvs `minusVarSet` bndr_set},  -- This may delete fewer variables 
-     foldrBag add_let body dump_dbs)                  -- than in priciple possible
+  = (new_uds, foldrBag add_let body dump_dbs)          
+               -- This may delete fewer variables 
+               -- than in priciple possible
   where
+    new_uds = 
+     MkUD { dict_binds = free_dbs
+         , calls      = free_calls 
+         , ud_fvs     = fvs `minusVarSet` bndr_set}
+
     bndr_set = mkVarSet bndrs
     add_let (bind,_) body = Let bind body