diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2019-02-21 15:27:17 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-03-09 02:07:53 -0500 |
| commit | 1f5cc9dc8aeeafa439d6d12c3c4565ada524b926 (patch) | |
| tree | a83c219447dc397524535f408368437422178cba /compiler/deSugar | |
| parent | 2762f94dc27cc065dded7755f99c66cba26683dd (diff) | |
| download | haskell-1f5cc9dc8aeeafa439d6d12c3c4565ada524b926.tar.gz | |
Stop inferring over-polymorphic kinds
Before this patch GHC was trying to be too clever
(Trac #16344); it succeeded in kind-checking this
polymorphic-recursive declaration
data T ka (a::ka) b
= MkT (T Type Int Bool)
(T (Type -> Type) Maybe Bool)
As Note [No polymorphic recursion] discusses, the "solution" was
horribly fragile. So this patch deletes the key lines in
TcHsType, and a wodge of supporting stuff in the renamer.
There were two regressions, both the same: a closed type family
decl like this (T12785b) does not have a CUSK:
type family Payload (n :: Peano) (s :: HTree n x) where
Payload Z (Point a) = a
Payload (S n) (a `Branch` stru) = a
To kind-check the equations we need a dependent kind for
Payload, and we don't get that any more. Solution: make it
a CUSK by giving the result kind -- probably a good thing anyway.
The other case (T12442) was very similar: a close type family
declaration without a CUSK.
Diffstat (limited to 'compiler/deSugar')
| -rw-r--r-- | compiler/deSugar/DsMeta.hs | 15 |
1 files changed, 4 insertions, 11 deletions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 67a05d647d..2aaafad29f 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -43,7 +43,6 @@ import Id import Name hiding( isVarOcc, isTcOcc, varName, tcName ) import THNames import NameEnv -import NameSet import TcType import TyCon import TysWiredIn @@ -392,9 +391,7 @@ repFamilyDecl decl@(dL->L loc (FamilyDecl { fdInfo = info , fdInjectivityAnn = injectivity })) = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences] ; let mkHsQTvs :: [LHsTyVarBndr GhcRn] -> LHsQTyVars GhcRn - mkHsQTvs tvs = HsQTvs { hsq_ext = HsQTvsRn - { hsq_implicit = [] - , hsq_dependent = emptyNameSet } + mkHsQTvs tvs = HsQTvs { hsq_ext = [] , hsq_explicit = tvs } resTyVar = case resultSig of TyVarSig _ bndr -> mkHsQTvs [bndr] @@ -569,9 +566,7 @@ repTyFamEqn (HsIB { hsib_ext = var_names , feqn_fixity = fixity , feqn_rhs = rhs }}) = do { tc <- lookupLOcc tc_name -- See note [Binders and occurrences] - ; let hs_tvs = HsQTvs { hsq_ext = HsQTvsRn - { hsq_implicit = var_names - , hsq_dependent = emptyNameSet } -- Yuk + ; let hs_tvs = HsQTvs { hsq_ext = var_names , hsq_explicit = fromMaybe [] mb_bndrs } ; addTyClTyVarBinds hs_tvs $ \ _ -> do { mb_bndrs1 <- repMaybeList tyVarBndrQTyConName @@ -610,9 +605,7 @@ repDataFamInstD (DataFamInstDecl { dfid_eqn = , feqn_fixity = fixity , feqn_rhs = defn }})}) = do { tc <- lookupLOcc tc_name -- See note [Binders and occurrences] - ; let hs_tvs = HsQTvs { hsq_ext = HsQTvsRn - { hsq_implicit = var_names - , hsq_dependent = emptyNameSet } -- Yuk + ; let hs_tvs = HsQTvs { hsq_ext = var_names , hsq_explicit = fromMaybe [] mb_bndrs } ; addTyClTyVarBinds hs_tvs $ \ _ -> do { mb_bndrs1 <- repMaybeList tyVarBndrQTyConName @@ -1052,7 +1045,7 @@ addTyVarBinds :: LHsQTyVars GhcRn -- the binders to be added -- gensym a list of type variables and enter them into the meta environment; -- the computations passed as the second argument is executed in that extended -- meta environment and gets the *new* names on Core-level as an argument -addTyVarBinds (HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = imp_tvs} +addTyVarBinds (HsQTvs { hsq_ext = imp_tvs , hsq_explicit = exp_tvs }) thing_inside = addSimpleTyVarBinds imp_tvs $ |