From 03edcb58482b016a8ee019a06e114c8e8c996400 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Wed, 15 Dec 2010 12:37:25 +0000 Subject: [PATCH] Fix a bug in functorLikeTraverse, which was giving wrong answer for tuples This bug led to Trac #4816, which is hereby fixed --- compiler/typecheck/TcDeriv.lhs | 2 +- compiler/typecheck/TcGenDeriv.lhs | 12 +++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 88236a6..2988f08 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -750,7 +750,7 @@ inferConstraints _ cls inst_tys rep_tc rep_tc_args get_constrained_tys :: [Type] -> [Type] get_constrained_tys tys - | is_functor_like = concatMap (deepSubtypesContaining last_tv) tys + | is_functor_like = concatMap (deepSubtypesContaining last_tv) tys | otherwise = tys rep_tc_tvs = tyConTyVars rep_tc diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs index 54d786f..2c04cf4 100644 --- a/compiler/typecheck/TcGenDeriv.lhs +++ b/compiler/typecheck/TcGenDeriv.lhs @@ -1457,11 +1457,13 @@ functorLikeTraverse var (FT { ft_triv = caseTrivial, ft_var = caseVar where (_, xc) = go co x (yr,yc) = go co y go co ty@(TyConApp con args) - | isTupleTyCon con = (caseTuple (tupleTyConBoxity con) xrs,True) - | null args = (caseTrivial,False) -- T - | or (init xcs) = (caseWrongArg,True) -- T (..var..) ty - | last xcs = -- T (..no var..) ty - (caseTyApp (fst (splitAppTy ty)) (last xrs),True) + | not (or xcs) = (caseTrivial, False) -- Variable does not occur + -- At this point we know that xrs, xcs is not empty, + -- and at least one xr is True + | isTupleTyCon con = (caseTuple (tupleTyConBoxity con) xrs, True) + | or (init xcs) = (caseWrongArg, True) -- T (..var..) ty + | otherwise = -- T (..no var..) ty + (caseTyApp (fst (splitAppTy ty)) (last xrs), True) where (xrs,xcs) = unzip (map (go co) args) go co (ForAllTy v x) | v /= var && xc = (caseForAll v xr,True) where (xr,xc) = go co x -- 1.7.10.4