X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fspecialise%2FSpecConstr.lhs;h=603c2a684ee281f72066c16a96509ab7bff8f4de;hb=d32c5227315009f38355fe3233f0f4e5b1f61dc6;hp=85bbd96ebd037127085bd299a56c64ba56d87bf1;hpb=7d841483081735f5f906a6bb5e80249d97f3226b;p=ghc-hetmet.git

diff --git a/ghc/compiler/specialise/SpecConstr.lhs b/ghc/compiler/specialise/SpecConstr.lhs
index 85bbd96..603c2a6 100644
--- a/ghc/compiler/specialise/SpecConstr.lhs
+++ b/ghc/compiler/specialise/SpecConstr.lhs
@@ -14,13 +14,12 @@ import CoreSyn
 import CoreLint		( showPass, endPass )
 import CoreUtils	( exprType, eqExpr, mkPiTypes )
 import CoreFVs 		( exprsFreeVars )
-import CoreTidy		( tidyIdRules )
+import CoreTidy		( pprTidyIdRules )
 import WwLib		( mkWorkerArgs )
 import DataCon		( dataConRepArity )
 import Type		( tyConAppArgs )
-import PprCore		( pprIdRules )
-import Id		( Id, idName, idType, idSpecialisation,
-			  isDataConId_maybe, 
+import Id		( Id, idName, idType, 
+			  isDataConWorkId_maybe, 
 			  mkUserLocal, mkSysLocal )
 import Var		( Var )
 import VarEnv
@@ -34,10 +33,11 @@ import BasicTypes	( Activation(..) )
 import Outputable
 
 import Maybes		( orElse )
-import Util		( mapAccumL, lengthAtLeast )
+import Util		( mapAccumL, lengthAtLeast, notNull )
 import List		( nubBy, partition )
 import UniqSupply
 import Outputable
+import FastString
 \end{code}
 
 -----------------------------------------------------
@@ -182,7 +182,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 dump_specs (concat (map bindersOf binds'))))
+		  (vcat (map pprTidyIdRules (concat (map bindersOf binds'))))
 
 	return binds'
   where
@@ -190,8 +190,6 @@ specConstrProgram dflags us binds
     go env (bind:binds) = scBind env bind 	`thenUs` \ (env', _, bind') ->
 			  go env' binds 	`thenUs` \ binds' ->
 			  returnUs (bind' : binds')
-
-    dump_specs var = pprIdRules (tidyIdRules var)
 \end{code}
 
 
@@ -377,7 +375,7 @@ scExpr env e@(App _ _)
 ----------------------
 scBind :: ScEnv -> CoreBind -> UniqSM (ScEnv, ScUsage, CoreBind)
 scBind env (Rec [(fn,rhs)])
-  | not (null val_bndrs)
+  | notNull val_bndrs
   = scExpr env_fn_body body		`thenUs` \ (usg, body') ->
     let
 	SCU { calls = calls, occs = occs } = usg
@@ -511,7 +509,7 @@ spec_one env fn rhs (pats, rule_number)
 		-- Usual w/w hack to avoid generating 
 		-- a spec_rhs of unlifted type and no args
 	
-	rule_name = _PK_ ("SC:" ++ showSDoc (ppr fn <> int 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
@@ -584,7 +582,7 @@ is_con_app_maybe env (Lit lit)
 
 is_con_app_maybe env expr
   = case collectArgs expr of
-	(Var fun, args) | Just con <- isDataConId_maybe fun,
+	(Var fun, args) | Just con <- isDataConWorkId_maybe fun,
 			  args `lengthAtLeast` dataConRepArity con
 		-- Might be > because the arity excludes type args
 		        -> Just (DataAlt con,args)