diff options
| author | Richard Eisenberg <eir@cis.upenn.edu> | 2014-08-07 08:28:32 -0400 |
|---|---|---|
| committer | Richard Eisenberg <eir@cis.upenn.edu> | 2014-08-12 11:46:21 -0400 |
| commit | b2c61670fced7a59d19c0665de23d38984f8d01c (patch) | |
| tree | 07d4ef6a2f94a60d2d5a3a4ebbc8c4b5be0bc520 /compiler | |
| parent | 3dfd3c33a46ae01a45802cb5b97fe7a2c8a8f31a (diff) | |
| download | haskell-b2c61670fced7a59d19c0665de23d38984f8d01c.tar.gz | |
Change treatment of CUSKs for synonyms and families (#9200).
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/typecheck/TcHsType.lhs | 27 |
1 files changed, 23 insertions, 4 deletions
diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index 14a3c175f8..d075cbcfbf 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -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 |