diff options
| -rw-r--r-- | compiler/typecheck/TcDeriv.lhs | 2 | ||||
| -rw-r--r-- | 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 88236a6dd3..2988f08a38 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 54d786ff9d..2c04cf4bc3 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 |