From 37cc35d23202c9846e68e4c0a279fa75273f6f1c Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Thu, 3 Jul 2008 19:25:40 +0000 Subject: [PATCH] Fix trac #2307: conflicting functional dependencies We were accepting some instances that should have been rejected as their fundep constraints were violated. e.g. we accepted class C a b c | b -> c instance C Bool Int Float instance C Char Int Double --- compiler/types/FunDeps.lhs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/types/FunDeps.lhs b/compiler/types/FunDeps.lhs index 69533dc..7f9f050 100644 --- a/compiler/types/FunDeps.lhs +++ b/compiler/types/FunDeps.lhs @@ -494,16 +494,16 @@ badFunDeps cls_insts clas ins_tv_set ins_tys trimRoughMatchTcs :: [TyVar] -> FunDep TyVar -> [Maybe Name] -> [Maybe Name] -- Computing rough_tcs for a particular fundep --- class C a b c | a -> b where ... +-- class C a b c | a -> b where ... -- For each instance .... => C ta tb tc --- we want to match only on the types ta, tc; so our +-- we want to match only on the type ta; so our -- rough-match thing must similarly be filtered. --- Hence, we Nothing-ise the tb type right here -trimRoughMatchTcs clas_tvs (_,rtvs) mb_tcs +-- Hence, we Nothing-ise the tb and tc types right here +trimRoughMatchTcs clas_tvs (ltvs, _) mb_tcs = zipWith select clas_tvs mb_tcs where - select clas_tv mb_tc | clas_tv `elem` rtvs = Nothing - | otherwise = mb_tc + select clas_tv mb_tc | clas_tv `elem` ltvs = mb_tc + | otherwise = Nothing \end{code} -- 1.7.10.4