X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FRules.lhs;h=090f0f0b807d9bda8203e9591179ba18f05443d0;hb=235edf36cc202bb21c00d0e5e05ebf076fb0542e;hp=bbb678deecc1712556bc3017333bf4d09ccaed1c;hpb=609db9ce4ad70c8cf64350b75da03229a7c33b0f;p=ghc-hetmet.git

diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index bbb678d..090f0f0 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -35,8 +35,7 @@ import Type		( Type, TvSubstEnv )
 import Coercion         ( coercionKind )
 import TcType		( tcSplitTyConApp_maybe )
 import CoreTidy		( tidyRules )
-import Id		( Id, idUnfolding, isLocalId, isGlobalId, idName, idType,
-			  idSpecialisation, idCoreRules, setIdSpecialisation ) 
+import Id
 import IdInfo		( SpecInfo( SpecInfo ) )
 import Var		( Var )
 import VarEnv
@@ -233,9 +232,11 @@ getRules :: RuleBase -> Id -> [CoreRule]
 	--	(b) rules added in subsequent modules (extra_rules)
 	-- PrimOps, for example, are born with a bunch of rules under (a)
 getRules rule_base fn
-  | isLocalId fn = idCoreRules fn
-  | otherwise    = WARN( null (idCoreRules fn), ppr fn <+> ppr (idCoreRules fn) )
-		   lookupNameEnv rule_base (idName fn) `orElse` []
+  | isLocalId fn  = idCoreRules fn
+  | otherwise     = WARN( not (isPrimOpId fn) && notNull (idCoreRules fn), 
+ 			  ppr fn <+> ppr (idCoreRules fn) )
+		    idCoreRules fn ++ (lookupNameEnv rule_base (idName fn) `orElse` [])
+	-- Only PrimOpIds have rules inside themselves, and perhaps more besides
 
 matchRules :: (Activation -> Bool) -> InScopeSet
 	   -> Id -> [CoreExpr]