diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2011-05-26 17:19:18 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2011-05-26 17:19:18 +0100 |
| commit | 3afdf90d0f9fb18f13a6b76fe41e5fc60bbdaac3 (patch) | |
| tree | 70e7ece16dfdfdf62b4e84a170d357a39370c93d /compiler/coreSyn | |
| parent | 80f5e7009434750cee746bd89f7eea5f7c7fa3fd (diff) | |
| download | haskell-3afdf90d0f9fb18f13a6b76fe41e5fc60bbdaac3.tar.gz | |
Treat the (~) type constructor a bit specially
when kind-checking in Core Lint. It's unusual
becuase it is poly-kinded; for example
(~) Int a
and (~) Maybe b
are both ok. We don't want the full generality
of kind polymorphism (yet anyway) so these changes
in effect give (~) its own private kinding rule.
It won't work right if (~) appears un-saturated,
and Lint now checks for that too.
Diffstat (limited to 'compiler/coreSyn')
| -rw-r--r-- | compiler/coreSyn/CoreLint.lhs | 15 |
1 files changed, 14 insertions, 1 deletions
diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index 031fd613cc..869f276c50 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -717,6 +717,8 @@ lintType ty@(FunTy t1 t2) = lint_ty_app ty (tyConKind funTyCon) [t1,t2] lintType ty@(TyConApp tc tys) + | tc `hasKey` eqPredPrimTyConKey -- See Note [The (~) TyCon] in TysPrim + = lint_eq_pred ty tys | tyConHasKind tc = lint_ty_app ty (tyConKind tc) tys | otherwise @@ -745,7 +747,18 @@ lint_ty_app :: Type -> Kind -> [OutType] -> LintM Kind lint_ty_app ty k tys = do { ks <- mapM lintType tys ; lint_kind_app (ptext (sLit "type") <+> quotes (ppr ty)) k ks } - + +lint_eq_pred :: Type -> [OutType] -> LintM Kind +lint_eq_pred ty arg_tys + | [ty1,ty2] <- arg_tys + = do { k1 <- lintType ty1 + ; k2 <- lintType ty2 + ; checkL (k1 `eqKind` k2) + (ptext (sLit "Mismatched arg kinds:") <+> ppr ty) + ; return unliftedTypeKind } + | otherwise + = failWithL (ptext (sLit "Unsaturated (~) type") <+> ppr ty) + ---------------- check_co_app :: Coercion -> Kind -> [OutType] -> LintM () check_co_app ty k tys |