From bb523f5164db9ac4581b8a314632309c6772810d Mon Sep 17 00:00:00 2001 From: Ross Paterson Date: Mon, 24 Apr 2006 09:03:25 +0000 Subject: extend 'deriving' heuristic a little If an argument of a data constructor has a type variable head, it is irreducible and the same type class can be copied into the constraint. (Formerly we just did this for type variable arguments.) --- src/Main.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'src/Main.hs') diff --git a/src/Main.hs b/src/Main.hs index c78836f9..b2ea7709 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -659,19 +659,21 @@ derivedInstances mdl decl = case decl of where derived srcloc ctxt n tvs cons drv = [HsInstDecl srcloc - (ctxt ++ [(cls,[v]) | v <- simple_tvars] ++ extra_constraint) + (ctxt ++ [(cls,[t]) | t <- simple_args] ++ extra_constraint) (cls,[lhs]) [] | cls <- drv] where targs = map stripDocs (targsConstrs cons) - -- a type variable is simple if it occurs as a data constructor argument - simple_tvars = map HsTyVar $ Set.elems $ Set.fromList $ [tv | HsTyVar tv <- targs] + -- an argument of a data constructor is simple if it has a variable head + simple_args = nub $ filter varHead targs -- a type variable is complex if it occurs inside a data constructor -- argument, except where the argument is identical to the lhs. complex_tvars = map HsTyVar $ Set.elems $ Set.unions $ map tvarsType $ - filter (/= lhs) $ filter (not . isVar) targs - isVar (HsTyVar _) = True - isVar _ = False + filter (/= lhs) $ filter (not . varHead) targs + varHead (HsTyVar _) = True + varHead (HsTyApp t _) = varHead t + varHead (HsTyDoc t _) = varHead t + varHead _ = False extra_constraint | null complex_tvars = [] | otherwise = [(unknownConstraint,complex_tvars)] -- cgit v1.2.3