X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FSpecConstr.lhs;h=7eb3529d4e191930eaa03d86977c506d151d0fce;hb=baa26ed728b6164f2827a97133306131aa89ed6f;hp=b4fd460cd67d5ba44df8d60ff03a465bc065ab29;hpb=82d592e6b1ccb4a74f2e73f2cfa9af0f6e931cbe;p=ghc-hetmet.git

diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index b4fd460..7eb3529 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -22,11 +22,10 @@ import CoreUtils
 import CoreUnfold	( couldBeSmallEnoughToInline )
 import CoreLint		( showPass, endPass )
 import CoreFVs 		( exprsFreeVars )
-import CoreTidy		( tidyRules )
-import PprCore		( pprRules )
 import WwLib		( mkWorkerArgs )
 import DataCon		( dataConRepArity, dataConUnivTyVars )
 import Coercion	
+import Rules
 import Type		hiding( substTy )
 import Id		( Id, idName, idType, isDataConWorkId_maybe, idArity,
 			  mkUserLocal, mkSysLocal, idUnfolding, isLocalId )
@@ -34,7 +33,6 @@ import Var
 import VarEnv
 import VarSet
 import Name
-import Rules		( addIdSpecialisations, mkLocalRule, rulesOfBinds )
 import OccName		( mkSpecOcc )
 import ErrUtils		( dumpIfSet_dyn )
 import DynFlags		( DynFlags(..), DynFlag(..) )
@@ -463,7 +461,7 @@ 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')))
+		      (pprRulesForUser (rulesOfBinds binds'))
 
 	return binds'
   where
@@ -498,9 +496,9 @@ data ScEnv = SCE { sc_size  :: Maybe Int,	-- Size threshold
 
 ---------------------
 -- As we go, we apply a substitution (sc_subst) to the current term
-type InExpr = CoreExpr		-- *Before* applying the subst
+type InExpr = CoreExpr		-- _Before_ applying the subst
 
-type OutExpr = CoreExpr		-- *After* applying the subst
+type OutExpr = CoreExpr		-- _After_ applying the subst
 type OutId   = Id
 type OutVar  = Var
 
@@ -509,7 +507,7 @@ type HowBoundEnv = VarEnv HowBound	-- Domain is OutVars
 
 ---------------------
 type ValueEnv = IdEnv Value		-- Domain is OutIds
-data Value    = ConVal AltCon [CoreArg]	-- *Saturated* constructors
+data Value    = ConVal AltCon [CoreArg]	-- _Saturated_ constructors
 	      | LambdaVal		-- Inlinable lambdas or PAPs
 
 instance Outputable Value where
@@ -707,7 +705,7 @@ combineOccs :: [ArgOcc] -> [ArgOcc] -> [ArgOcc]
 combineOccs xs ys = zipWithEqual "combineOccs" combineOcc xs ys
 
 setScrutOcc :: ScEnv -> ScUsage -> OutExpr -> ArgOcc -> ScUsage
--- *Overwrite* the occurrence info for the scrutinee, if the scrutinee 
+-- _Overwrite_ the occurrence info for the scrutinee, if the scrutinee
 -- is a variable, and an interesting variable
 setScrutOcc env usg (Cast e _) occ = setScrutOcc env usg e occ
 setScrutOcc env usg (Note _ e) occ = setScrutOcc env usg e occ
@@ -796,7 +794,7 @@ scExpr' env (Case scrut b ty alts)
 	   ; let (usg', arg_occs) = lookupOccs usg bs'
 		 scrut_occ = case con of
 				DataAlt dc -> ScrutOcc (unitUFM dc arg_occs)
-				_ofther	   -> ScrutOcc emptyUFM
+				_      	   -> ScrutOcc emptyUFM
 	   ; return (usg', scrut_occ, (con,bs',rhs')) }
 
 scExpr' env (Let (NonRec bndr rhs) body)
@@ -1028,9 +1026,9 @@ specialise env bind_calls (fn, arg_bndrs, body, arg_occs)
 				ptext (sLit "Specialisations:") <+> ppr (pats ++ [p | OS p _ _ _ <- specs])])
 			 return (nullUsage, spec_info)
 
-	    _normal_case -> do
-				
-	{ (spec_usgs, new_specs) <- mapAndUnzipM (spec_one env fn arg_bndrs body)
+	    _normal_case -> do {
+
+	  (spec_usgs, new_specs) <- mapAndUnzipM (spec_one env fn arg_bndrs body)
 					         (pats `zip` [spec_count..])
 
 	; let spec_usg = combineUsages spec_usgs