X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FRules.lhs;h=4c223d40d6687342f85366e279afd684afc74932;hb=e923340fea0fea85f55600b8ee709f1cf8b62803;hp=4d743140ea66e63bc1242acdc80c9cb58fac3e23;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index 4d74314..4c223d4 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -115,8 +115,13 @@ ruleCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
 -- definitely can't match 'tpl' by instantiating 'tpl'.  
 -- It's only a one-way match; unlike instance matching we 
 -- don't consider unification
+-- 
+-- Notice that there is no case
+--	ruleCantMatch (Just n1 : ts) (Nothing : as) = True
+-- Reason: a local variable 'v' in the actuals might 
+-- 	   have an unfolding which is a global.
+--	   This quite often happens with case scrutinees.
 ruleCantMatch (Just n1 : ts) (Just n2 : as) = n1 /= n2 || ruleCantMatch ts as
-ruleCantMatch (Just n1 : ts) (Nothing : as) = True
 ruleCantMatch (t       : ts) (a       : as) = ruleCantMatch ts as
 ruleCantMatch ts	     as		    = False
 \end{code}
@@ -403,10 +408,10 @@ match menv subst@(tv_subst, id_subst) (Var v1) e2
 
 	other -> Nothing
 
-  | otherwise	-- v1 is not a template variable
-  = case e2 of
-	Var v2 | v1' == rnOccR rn_env v2 -> Just subst
-	other				 -> Nothing
+  | 	-- v1 is not a template variable; check for an exact match with e2
+    Var v2 <- e2, v1' == rnOccR rn_env v2
+  = Just subst
+
   where
     rn_env = me_env menv
     v1'    = rnOccL rn_env v1