X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fspecialise%2FRules.lhs;h=4f538599202d1cfac7f6261b5efd8de3a4d15477;hb=59c796f8e77325d35f29ddd3e724bfa780466d40;hp=7a2f3204a79f0891a4143fbcfde7cdd493b8f9be;hpb=7e7c11b2b285fd00758baac1be3784322a2aff62;p=ghc-hetmet.git

diff --git a/ghc/compiler/specialise/Rules.lhs b/ghc/compiler/specialise/Rules.lhs
index 7a2f320..4f53859 100644
--- a/ghc/compiler/specialise/Rules.lhs
+++ b/ghc/compiler/specialise/Rules.lhs
@@ -6,9 +6,8 @@
 \begin{code}
 module Rules (
 	RuleBase, emptyRuleBase, 
-	extendRuleBase, extendRuleBaseList, 
-	ruleBaseIds, getLocalRules,
-	pprRuleBase, ruleCheckProgram,
+	extendRuleBaseList, 
+	ruleBaseIds, pprRuleBase, ruleCheckProgram,
 
         lookupRule, addRule, addIdSpecialisations
     ) where
@@ -25,21 +24,20 @@ import Subst		( Subst, InScopeSet, mkInScopeSet, lookupSubst, extendSubst,
 			  substEnv, setSubstEnv, emptySubst, isInScope, emptyInScopeSet,
 			  bindSubstList, unBindSubstList, substInScope, uniqAway
 			)
-import Id		( Id, idIsFrom, idUnfolding, idSpecialisation, setIdSpecialisation ) 
+import Id		( Id, idUnfolding, idSpecialisation, setIdSpecialisation ) 
 import Var		( isId )
 import VarSet
 import VarEnv
 import TcType		( mkTyVarTy )
 import qualified TcType ( match )
 import BasicTypes	( Activation, CompilerPhase, isActive )
-import Module		( Module )
 
 import Outputable
 import FastString
 import Maybe		( isJust, isNothing, fromMaybe )
-import Util		( sortLt )
+import Util		( sortLe )
 import Bag
-import List		( isPrefixOf, partition )
+import List		( isPrefixOf )
 \end{code}
 
 
@@ -294,7 +292,7 @@ match e1 (Lam x2 e2) tpl_vars kont subst
 match (Case e1 x1 alts1) (Case e2 x2 alts2) tpl_vars kont subst
   = match e1 e2 tpl_vars case_kont subst
   where
-    case_kont subst = bind [x1] [x2] (match_alts alts1 (sortLt lt_alt alts2))
+    case_kont subst = bind [x1] [x2] (match_alts alts1 (sortLe le_alt alts2))
 				     tpl_vars kont subst
 
 match (Type ty1) (Type ty2) tpl_vars kont subst
@@ -349,7 +347,7 @@ match_alts ((c1,vs1,r1):alts1) ((c2,vs2,r2):alts2) tpl_vars kont subst
 		 subst
 match_alts alts1 alts2 tpl_vars kont subst = match_fail
 
-lt_alt (con1, _, _) (con2, _, _) = con1 < con2
+le_alt (con1, _, _) (con2, _, _) = con1 <= con2
 
 ----------------------------------------
 bind :: [CoreBndr]	-- Template binders
@@ -608,23 +606,6 @@ extendRuleBase (RuleBase rule_ids) (id, rule)
 	-- in which case it may have rules in its belly already.  Seems
 	-- dreadfully hackoid.
 
-getLocalRules :: Module -> RuleBase -> (IdSet,		-- Ids with local rules
-					RuleBase)	-- Non-local rules
--- Get the rules for locally-defined Ids out of the RuleBase
--- If we miss any rules for Ids defined here, then we end up
--- giving the local decl a new Unique (because the in-scope-set is the
--- same as the rule-id set), and now the binding for the class method 
--- doesn't have the same Unique as the one in the Class and the tc-env
---	Example:	class Foo a where
---			  op :: a -> a
---			{-# RULES "op" op x = x #-}
--- 
--- NB we can't use isLocalId, because isLocalId isn't true of class methods.
-getLocalRules this_mod (RuleBase ids)
-  = (mkVarSet local_ids, RuleBase (mkVarSet imp_ids))
-  where
-    (local_ids, imp_ids) = partition (idIsFrom this_mod) (varSetElems ids)
-
 pprRuleBase :: RuleBase -> SDoc
 pprRuleBase (RuleBase rules) = vcat [ pprTidyIdRules id | id <- varSetElems rules ]
 \end{code}