diff options
author | RyanGlScott <ryan.gl.scott@gmail.com> | 2016-05-02 12:38:04 -0400 |
---|---|---|
committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2016-05-02 12:38:04 -0400 |
commit | fa86ac7c14b67f27017d795811265c3a9750024b (patch) | |
tree | 97185a8a642f7b9d517d9378c69d1931a3674c66 /compiler | |
parent | c5be5e2e9e2679318a84447c0443f04c98b60371 (diff) | |
download | haskell-fa86ac7c14b67f27017d795811265c3a9750024b.tar.gz |
Make validDerivPred ignore non-visible arguments to a class type constructor
Summary:
GHC choked when trying to derive the following:
```
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
module Example where
class Category (cat :: k -> k -> *) where
catId :: cat a a
catComp :: cat b c -> cat a b -> cat a c
newtype T (c :: * -> * -> *) a b = MkT (c a b) deriving Category
```
Unlike in #8865, where we were deriving `Category` for a concrete type like
`Either`, in the above example we are attempting to derive an instance of the
form:
```
instance Category * c => Category (T * c) where ...
```
(using `-fprint-explicit-kinds` syntax). But `validDerivPred` is checking if
`sizePred (Category * c)` equals the number of free type variables in
`Category * c`. But note that `sizePred` counts both type variables //and//
type constructors, and `*` is a type constructor! So `validDerivPred`
erroneously rejects the above instance.
The fix is to make `validDerivPred` ignore non-visible arguments to the class
type constructor (e.g., ignore `*` is `Category * c`) by using
`filterOutInvisibleTypes`.
Fixes #11833.
Test Plan: ./validate
Reviewers: goldfire, hvr, simonpj, austin, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2112
GHC Trac Issues: #11833
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/typecheck/TcValidity.hs | 22 |
1 files changed, 16 insertions, 6 deletions
diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 0833243b19..d9f43d39c3 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -1178,6 +1178,15 @@ It checks for three things So if they are the same, there must be no constructors. But there might be applications thus (f (g x)). + Note that tys only includes the visible arguments of the class type + constructor. Including the non-vivisble arguments can cause the following, + perfectly valid instance to be rejected: + class Category (cat :: k -> k -> *) where ... + newtype T (c :: * -> * -> *) a b = MkT (c a b) + instance Category c => Category (T c) where ... + since the first argument to Category is a non-visible *, which sizeTypes + would count as a constructor! See Trac #11833. + * Also check for a bizarre corner case, when the derived instance decl would look like instance C a b => D (T a) where ... @@ -1198,19 +1207,20 @@ validDerivPred :: TyVarSet -> PredType -> Bool -- See Note [Valid 'deriving' predicate] validDerivPred tv_set pred = case classifyPredType pred of - ClassPred cls _ -> cls `hasKey` typeableClassKey + ClassPred cls tys -> cls `hasKey` typeableClassKey -- Typeable constraints are bigger than they appear due -- to kind polymorphism, but that's OK - || check_tys + || check_tys cls tys EqPred {} -> False -- reject equality constraints _ -> True -- Non-class predicates are ok where - check_tys = hasNoDups fvs + check_tys cls tys + = hasNoDups fvs -- use sizePred to ignore implicit args && sizePred pred == fromIntegral (length fvs) && all (`elemVarSet` tv_set) fvs - - fvs = fvType pred + where tys' = filterOutInvisibleTypes (classTyCon cls) tys + fvs = fvTypes tys' {- ************************************************************************ @@ -1937,7 +1947,7 @@ sizePred ty = goClass ty go (ClassPred cls tys') | isTerminatingClass cls = 0 - | otherwise = sizeTypes tys' + | otherwise = sizeTypes (filterOutInvisibleTypes (classTyCon cls) tys') go (EqPred {}) = 0 go (IrredPred ty) = sizeType ty |