X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fspecialise%2FSpecConstr.lhs;h=6a2cd92224d7287fdf22f5088d83a0f0733d0a2d;hb=674689e20127e199e76cd19dd2f81dc5c2346bac;hp=b5f3f0eebe9269db62bd2c9dad4a4b2eef5a23e1;hpb=d1c1b7d0e7b94ede238845c91f58582bad3b3ef3;p=ghc-hetmet.git

diff --git a/ghc/compiler/specialise/SpecConstr.lhs b/ghc/compiler/specialise/SpecConstr.lhs
index b5f3f0e..6a2cd92 100644
--- a/ghc/compiler/specialise/SpecConstr.lhs
+++ b/ghc/compiler/specialise/SpecConstr.lhs
@@ -14,24 +14,22 @@ import CoreSyn
 import CoreLint		( showPass, endPass )
 import CoreUtils	( exprType, tcEqExpr, mkPiTypes )
 import CoreFVs 		( exprsFreeVars )
-import CoreTidy		( pprTidyIdRules )
+import CoreTidy		( tidyRules )
+import PprCore		( pprRules )
 import WwLib		( mkWorkerArgs )
 import DataCon		( dataConRepArity )
 import Type		( tyConAppArgs )
-import Id		( Id, idName, idType, 
-			  isDataConWorkId_maybe, 
+import Id		( Id, idName, idType, isDataConWorkId_maybe, 
 			  mkUserLocal, mkSysLocal )
 import Var		( Var )
 import VarEnv
 import VarSet
 import Name		( nameOccName, nameSrcLoc )
-import Rules		( addIdSpecialisations )
+import Rules		( addIdSpecialisations, mkLocalRule, rulesOfBinds )
 import OccName		( mkSpecOcc )
 import ErrUtils		( dumpIfSet_dyn )
-import DynFlags	( DynFlags, DynFlag(..) )
+import DynFlags		( DynFlags, DynFlag(..) )
 import BasicTypes	( Activation(..) )
-import Outputable
-
 import Maybes		( orElse )
 import Util		( mapAccumL, lengthAtLeast, notNull )
 import List		( nubBy, partition )
@@ -182,7 +180,7 @@ specConstrProgram dflags us binds
 	endPass dflags "SpecConstr" Opt_D_dump_spec binds'
 
 	dumpIfSet_dyn dflags Opt_D_dump_rules "Top-level specialisations"
-		  (vcat (map pprTidyIdRules (concat (map bindersOf binds'))))
+		  (pprRules (tidyRules emptyTidyEnv (rulesOfBinds binds')))
 
 	return binds'
   where
@@ -512,8 +510,8 @@ spec_one env fn rhs (pats, rule_number)
 	rule_name = mkFastString ("SC:" ++ showSDoc (ppr fn <> int rule_number))
 	spec_rhs  = mkLams spec_lam_args spec_body
 	spec_id   = mkUserLocal spec_occ spec_uniq (mkPiTypes spec_lam_args body_ty) fn_loc
-	rule      = Rule rule_name specConstrActivation
-			 bndrs pats (mkVarApps (Var spec_id) spec_call_args)
+	rule_rhs  = mkVarApps (Var spec_id) spec_call_args
+	rule      = mkLocalRule rule_name specConstrActivation fn_name bndrs pats rule_rhs
     in
     returnUs (rule, (spec_id, spec_rhs))