Commit 03edcb58 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Fix a bug in functorLikeTraverse, which was giving wrong answer for tuples

This bug led to Trac #4816, which is hereby fixed
parent 47673f2f
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment