From 1f5cc9dc8aeeafa439d6d12c3c4565ada524b926 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Thu, 21 Feb 2019 15:27:17 +0000 Subject: 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. --- compiler/rename/RnSource.hs | 4 +--- compiler/rename/RnTypes.hs | 14 ++------------ 2 files changed, 3 insertions(+), 15 deletions(-) (limited to 'compiler/rename') diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index f902b0ef07..19f0d315d2 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -2166,9 +2166,7 @@ rnConDecl decl@(ConDeclGADT { con_names = names -- See Note [GADT abstract syntax] in HsDecls (PrefixCon arg_tys, final_res_ty) - new_qtvs = HsQTvs { hsq_ext = HsQTvsRn - { hsq_implicit = implicit_tkvs - , hsq_dependent = emptyNameSet } + new_qtvs = HsQTvs { hsq_ext = implicit_tkvs , hsq_explicit = explicit_tkvs } ; traceRn "rnConDecl2" (ppr names $$ ppr implicit_tkvs $$ ppr explicit_tkvs) diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index b84bbe3bae..53bcadee2a 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -822,11 +822,7 @@ bindHsQTyVars doc mb_in_doc mb_assoc body_kv_occs hsq_bndrs thing_inside -- body kvs, as mandated by -- Note [Ordering of implicit variables] implicit_kvs = filter_occs bndrs kv_occs - -- dep_bndrs is the subset of bndrs that are dependent - -- i.e. appear in bndr/body_kv_occs - -- Can't use implicit_kvs because we've deleted bndrs from that! - dep_bndrs = filter (`elemRdr` kv_occs) bndrs - del = deleteBys eqLocated + del = deleteBys eqLocated all_bound_on_lhs = null ((body_kv_occs `del` bndrs) `del` bndr_kv_occs) ; traceRn "checkMixedVars3" $ @@ -841,10 +837,7 @@ bindHsQTyVars doc mb_in_doc mb_assoc body_kv_occs hsq_bndrs thing_inside ; bindLocalNamesFV implicit_kv_nms $ bindLHsTyVarBndrs doc mb_in_doc mb_assoc hs_tv_bndrs $ \ rn_bndrs -> do { traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs) - ; dep_bndr_nms <- mapM (lookupLocalOccRn . unLoc) dep_bndrs - ; thing_inside (HsQTvs { hsq_ext = HsQTvsRn - { hsq_implicit = implicit_kv_nms - , hsq_dependent = mkNameSet dep_bndr_nms } + ; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms , hsq_explicit = rn_bndrs }) all_bound_on_lhs } } @@ -879,9 +872,6 @@ Then: * We want to quantify add implicit bindings for implicit_kvs -* The "dependent" bndrs (hsq_dependent) are the subset of - bndrs that are free in bndr_kv_occs or body_kv_occs - * If implicit_body_kvs is non-empty, then there is a kind variable mentioned in the kind signature that is not bound "on the left". That's one of the rules for a CUSK, so we pass that info on -- cgit v1.2.1