From: simonpj <unknown>
Date: Thu, 28 Jul 2005 12:48:25 +0000 (+0000)
Subject: [project @ 2005-07-28 12:48:25 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~293
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=52ed73913693626b505287178c20f05913d00a07

[project @ 2005-07-28 12:48:25 by simonpj]
Fix another minor bogon in the new rules stuff
---

diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index 8e3139e..a386a3d 100644
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -18,7 +18,7 @@ import HscTypes		( HscEnv(..), ModGuts(..), ExternalPackageState(..),
 import CSE		( cseProgram )
 import Rules		( RuleBase, emptyRuleBase, mkRuleBase, unionRuleBase,
 			  extendRuleBaseList, pprRuleBase, ruleCheckProgram,
-			  mkSpecInfo, addSpecInfo )
+			  addSpecInfo, addIdSpecialisations )
 import PprCore		( pprCoreBindings, pprCoreExpr, pprRules )
 import OccurAnal	( occurAnalysePgm, occurAnalyseExpr )
 import IdInfo		( setNewStrictnessInfo, newStrictnessInfo, 
@@ -33,7 +33,7 @@ import CoreLint		( endPass )
 import FloatIn		( floatInwards )
 import FloatOut		( floatOutwards )
 import Id		( Id, modifyIdInfo, idInfo, isExportedId, isLocalId,
-			  idSpecialisation, setIdSpecialisation, idName )
+			  idSpecialisation, idName )
 import VarSet
 import VarEnv
 import NameEnv		( lookupNameEnv )
@@ -266,7 +266,9 @@ updateBinders local_rules binds
 
     update_bndr bndr = case lookupNameEnv local_rules (idName bndr) of
 			  Nothing    -> bndr
-			  Just rules -> bndr `setIdSpecialisation` mkSpecInfo rules
+			  Just rules -> bndr `addIdSpecialisations` rules
+				-- The binder might have some existing rules,
+				-- arising from specialisation pragmas
 \end{code}