X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FRules.lhs;h=35a0bdda055aa6e068baaeeaf453da991c7e3c5d;hb=7745c6095145f1be0ca8fff76ef558ca7ad2ebed;hp=4a87560616f633071eca19914feaf13f9c5af23e;hpb=7d44782fdfab8c280ae8de1846cb40a78b6edb95;p=ghc-hetmet.git

diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index 4a87560..35a0bdd 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -10,6 +10,8 @@ module Rules (
 
 	mkSpecInfo, extendSpecInfo, addSpecInfo,
 	rulesOfBinds, addIdSpecialisations, 
+	
+	matchN,
 
         lookupRule, mkLocalRule, roughTopNames
     ) where
@@ -23,6 +25,7 @@ import CoreUnfold	( isCheapUnfolding, unfoldingTemplate )
 import CoreUtils	( tcEqExprX )
 import PprCore		( pprRules )
 import Type		( TvSubstEnv )
+import Coercion         ( coercionKind )
 import TcType		( tcSplitTyConApp_maybe )
 import CoreTidy		( tidyRules )
 import Id		( Id, idUnfolding, isLocalId, isGlobalId, idName,
@@ -239,7 +242,7 @@ findBest :: (Id, [CoreExpr])
 findBest target (rule,ans)   [] = (rule,ans)
 findBest target (rule1,ans1) ((rule2,ans2):prs)
   | rule1 `isMoreSpecific` rule2 = findBest target (rule1,ans1) prs
-  | rule2 `isMoreSpecific` rule1 = findBest target (rule1,ans1) prs
+  | rule2 `isMoreSpecific` rule1 = findBest target (rule2,ans2) prs
 #ifdef DEBUG
   | otherwise = pprTrace "Rules.findBest: rule overlap (Rule 1 wins)"
 			 (vcat [ptext SLIT("Expression to match:") <+> ppr fn <+> sep (map ppr args),
@@ -459,14 +462,16 @@ match menv subst e1 (Lam x2 e2)
 match menv subst (Case e1 x1 ty1 alts1) (Case e2 x2 ty2 alts2)
   = do	{ subst1 <- match_ty menv subst ty1 ty2
 	; subst2 <- match menv subst1 e1 e2
-	; let menv' = menv { me_env = rnBndr2 (me_env menv) x2 x2 }
+	; let menv' = menv { me_env = rnBndr2 (me_env menv) x1 x2 }
 	; match_alts menv' subst2 alts1 alts2	-- Alts are both sorted
 	}
 
 match menv subst (Type ty1) (Type ty2)
   = match_ty menv subst ty1 ty2
 
-match menv subst (Note (Coerce to1 from1) e1) (Note (Coerce to2 from2) e2)
+match menv subst (Cast e1 co1) (Cast e2 co2)
+  | (from1, to1) <- coercionKind co1
+  , (from2, to2) <- coercionKind co2
   = do	{ subst1 <- match_ty menv subst  to1   to2
 	; subst2 <- match_ty menv subst1 from1 from2
 	; match menv subst2 e1 e2 }