Commit b2c61670 authored by eir@cis.upenn.edu's avatar eir@cis.upenn.edu
Browse files

Change treatment of CUSKs for synonyms and families (#9200).

parent 3dfd3c33
......@@ -1067,22 +1067,41 @@ kcStrategy :: TyClDecl Name -> KindCheckingStrategy
kcStrategy d@(ForeignType {}) = pprPanic "kcStrategy" (ppr d)
kcStrategy (FamDecl fam_decl)
= kcStrategyFamDecl fam_decl
kcStrategy (SynDecl {}) = ParametricKinds
kcStrategy (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
| all_tyvars_annotated tyvars
, rhs_annotated rhs
= FullKindSignature
| otherwise
= ParametricKinds
where
rhs_annotated (L _ ty) = case ty of
HsParTy lty -> rhs_annotated lty
HsKindSig {} -> True
_ -> False
kcStrategy decl@(DataDecl {}) = kcStrategyAlgDecl decl
kcStrategy decl@(ClassDecl {}) = kcStrategyAlgDecl decl
kcStrategyAlgDecl :: TyClDecl Name -> KindCheckingStrategy
kcStrategyAlgDecl decl
| all (isHsKindedTyVar . unLoc) (hsQTvBndrs $ tcdTyVars decl)
| all_tyvars_annotated $ tcdTyVars decl
= FullKindSignature
| otherwise
= ParametricKinds
-- if the ClosedTypeFamily has no equations, do the defaulting to *, etc.
kcStrategyFamDecl :: FamilyDecl Name -> KindCheckingStrategy
kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily (_:_) }) = NonParametricKinds
kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily _
, fdTyVars = tyvars
, fdKindSig = Just _ })
| all (isHsKindedTyVar . unLoc) (hsQTvBndrs tyvars)
= FullKindSignature
-- if the ClosedTypeFamily has no equations, do the defaulting to *, etc.
kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily (_:_) }) = ParametricKinds
kcStrategyFamDecl _ = FullKindSignature
-- | Are all the type variables given with a kind annotation?
all_tyvars_annotated :: LHsTyVarBndrs name -> Bool
all_tyvars_annotated = all (isHsKindedTyVar . unLoc) . hsQTvBndrs
mkKindSigVar :: Name -> TcM KindVar
-- Use the specified name; don't clone it
mkKindSigVar n
......
{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds #-}
{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds,
TypeFamilies #-}
module T9200 where
......@@ -17,3 +18,12 @@ data T1 a b c = MkT1 (S True b c)
data T2 p q r = MkT2 (S p 5 r)
data T3 x y q = MkT3 (S x y '())
type S (f :: k1) (g :: k2) (h :: k3) = ((T1 f g h, T2 f g h, T3 f g h) :: *)
----------
-- test CUSK on closed type families
type family F (a :: k) :: k where
F True = False
F False = True
F x = 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