diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2020-11-13 10:56:20 -0500 |
---|---|---|
committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2020-11-13 13:40:02 -0500 |
commit | e5dabf5534b55a340df10ed486fdb6afb054457d (patch) | |
tree | 9307f057bbbf0fa4c91b6b651e734dbb27dabc10 /compiler/GHC/Tc | |
parent | 2987366d0b061b35b85e72228115a616b6616dd9 (diff) | |
download | haskell-wip/T18939.tar.gz |
Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more placeswip/T18939
The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate
cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars`
function (which behaves like `tcSplitForAllTyVars` but only splits invisible
type variables) fixes the issue. However, this led me to realize that _most_
uses of `tcSplitForAllTyVars` in GHC really ought to be
`tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace
most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the
likelihood of such bugs in the future.
I say "most uses" above since there is one notable place where we _do_ want
to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces
the "`Illegal polymorphic type`" error message if you try to use a higher-rank
`forall` without having `RankNTypes` enabled. Here, we really do want to split
all `forall`s, not just invisible ones, or we run the risk of giving an
inaccurate error message in the newly added `T18939_Fail` test case.
I debated at some length whether I wanted to name the new function
`tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end,
I decided that I liked the former better. For consistency's sake, I opted to
rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions
to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the
same naming convention. As a consequence, this ended up requiring a `haddock`
submodule bump.
Fixes #18939.
Diffstat (limited to 'compiler/GHC/Tc')
-rw-r--r-- | compiler/GHC/Tc/Gen/HsType.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Tc/TyCl/Instance.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/Backpack.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/Instantiate.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/TcType.hs | 23 | ||||
-rw-r--r-- | compiler/GHC/Tc/Validity.hs | 2 |
6 files changed, 22 insertions, 15 deletions
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs index 5e5ffd41ad..6e42b9e21e 100644 --- a/compiler/GHC/Tc/Gen/HsType.hs +++ b/compiler/GHC/Tc/Gen/HsType.hs @@ -2568,13 +2568,13 @@ kcCheckDeclHeader_sig kisig name flav split_invis :: Kind -> Maybe Kind -> ([TyCoBinder], Kind) split_invis sig_ki Nothing = -- instantiate all invisible binders - splitPiTysInvisible sig_ki + splitInvisPiTys sig_ki split_invis sig_ki (Just res_ki) = -- subtraction a la checkExpectedKind let n_res_invis_bndrs = invisibleTyBndrCount res_ki n_sig_invis_bndrs = invisibleTyBndrCount sig_ki n_inst = n_sig_invis_bndrs - n_res_invis_bndrs - in splitPiTysInvisibleN n_inst sig_ki + in splitInvisPiTysN n_inst sig_ki -- A quantifier from a kind signature zipped with a user-written binder for it. data ZippedBinder = diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs index 5ff7308f80..e3e1b7aa16 100644 --- a/compiler/GHC/Tc/TyCl/Instance.hs +++ b/compiler/GHC/Tc/TyCl/Instance.hs @@ -950,7 +950,7 @@ tcDataFamInstHeader mb_clsinfo fam_tc outer_bndrs fixity tc_kind_sig (Just hs_kind) = do { sig_kind <- tcLHsKindSig data_ctxt hs_kind ; lvl <- getTcLevel - ; let (tvs, inner_kind) = tcSplitForAllTyVars sig_kind + ; let (tvs, inner_kind) = tcSplitForAllInvisTyVars sig_kind ; (subst, _tvs') <- tcInstSkolTyVarsAt lvl False emptyTCvSubst tvs -- Perhaps surprisingly, we don't need the skolemised tvs themselves ; return (substTy subst inner_kind) } diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs index de114c3817..6214434fce 100644 --- a/compiler/GHC/Tc/Utils/Backpack.hs +++ b/compiler/GHC/Tc/Utils/Backpack.hs @@ -223,8 +223,8 @@ check_inst sig_inst = do skol_info = InstSkol -- Based off of tcSplitDFunTy (tvs, theta, pred) = - case tcSplitForAllTyVars ty of { (tvs, rho) -> - case splitFunTys rho of { (theta, pred) -> + case tcSplitForAllInvisTyVars ty of { (tvs, rho) -> + case splitFunTys rho of { (theta, pred) -> (tvs, theta, pred) }} origin = InstProvidedOrigin (tcg_semantic_mod tcg_env) sig_inst (skol_subst, tvs_skols) <- tcInstSkolTyVars tvs -- Skolemize diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs index 9bb0675f6c..27d01a5c4d 100644 --- a/compiler/GHC/Tc/Utils/Instantiate.hs +++ b/compiler/GHC/Tc/Utils/Instantiate.hs @@ -464,7 +464,7 @@ tcInstType inst_tyvars id subst' = extendTCvInScopeSet subst (tyCoVarsOfType rho) ; return (tv_prs, substTheta subst' theta, substTy subst' tau) } where - (tyvars, rho) = tcSplitForAllTyVars (idType id) + (tyvars, rho) = tcSplitForAllInvisTyVars (idType id) (theta, tau) = tcSplitPhiTy rho tcInstTypeBndrs :: Id -> TcM ([(Name, InvisTVBinder)], TcThetaType, TcType) diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index f355a016ae..c408ffb54c 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -60,7 +60,7 @@ module GHC.Tc.Utils.TcType ( -- These are important because they do not look through newtypes getTyVar, tcSplitForAllTyVarBinder_maybe, - tcSplitForAllTyVars, tcSplitSomeForAllTyVars, + tcSplitForAllTyVars, tcSplitForAllInvisTyVars, tcSplitSomeForAllTyVars, tcSplitForAllReqTVBinders, tcSplitForAllInvisTVBinders, tcSplitPiTys, tcSplitPiTy_maybe, tcSplitForAllTyVarBinders, tcSplitPhiTy, tcSplitPredFunTy_maybe, @@ -1223,12 +1223,17 @@ tcSplitForAllTyVarBinder_maybe (ForAllTy tv ty) = ASSERT( isTyVarBinder tv ) Jus tcSplitForAllTyVarBinder_maybe _ = Nothing -- | Like 'tcSplitPiTys', but splits off only named binders, --- returning just the tycovars. +-- returning just the tyvars. tcSplitForAllTyVars :: Type -> ([TyVar], Type) tcSplitForAllTyVars ty = ASSERT( all isTyVar (fst sty) ) sty where sty = splitForAllTyCoVars ty +-- | Like 'tcSplitForAllTyVars', but only splits 'ForAllTy's with 'Invisible' +-- type variable binders. +tcSplitForAllInvisTyVars :: Type -> ([TyVar], Type) +tcSplitForAllInvisTyVars ty = tcSplitSomeForAllTyVars isInvisibleArgFlag ty + -- | Like 'tcSplitForAllTyVars', but only splits a 'ForAllTy' if @argf_pred argf@ -- is 'True', where @argf@ is the visibility of the @ForAllTy@'s binder and -- @argf_pred@ is a predicate over visibilities provided as an argument to this @@ -1284,9 +1289,11 @@ tcSplitPhiTy ty Just (pred, ty) -> split ty (pred:ts) Nothing -> (reverse ts, ty) --- | Split a sigma type into its parts. +-- | Split a sigma type into its parts. This only splits /invisible/ type +-- variable binders, as these are the only forms of binder that the typechecker +-- will implicitly instantiate. tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type) -tcSplitSigmaTy ty = case tcSplitForAllTyVars ty of +tcSplitSigmaTy ty = case tcSplitForAllInvisTyVars ty of (tvs, rho) -> case tcSplitPhiTy rho of (theta, tau) -> (tvs, theta, tau) @@ -1469,9 +1476,9 @@ tcSplitDFunTy :: Type -> ([TyVar], [Type], Class, [Type]) -- the latter specifically stops at PredTy arguments, -- and we don't want to do that here tcSplitDFunTy ty - = case tcSplitForAllTyVars ty of { (tvs, rho) -> - case splitFunTys rho of { (theta, tau) -> - case tcSplitDFunHead tau of { (clas, tys) -> + = case tcSplitForAllInvisTyVars ty of { (tvs, rho) -> + case splitFunTys rho of { (theta, tau) -> + case tcSplitDFunHead tau of { (clas, tys) -> (tvs, map scaledThing theta, clas, tys) }}} tcSplitDFunHead :: Type -> (Class, [Type]) @@ -1489,7 +1496,7 @@ tcSplitMethodTy :: Type -> ([TyVar], PredType, Type) -- tcSplitMethodTy just peels off the outer forall and -- that first predicate tcSplitMethodTy ty - | (sel_tyvars,sel_rho) <- tcSplitForAllTyVars ty + | (sel_tyvars,sel_rho) <- tcSplitForAllInvisTyVars ty , Just (first_pred, local_meth_ty) <- tcSplitPredFunTy_maybe sel_rho = (sel_tyvars, first_pred, local_meth_ty) | otherwise diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs index 87be216d9b..6f290cb7ab 100644 --- a/compiler/GHC/Tc/Validity.hs +++ b/compiler/GHC/Tc/Validity.hs @@ -924,7 +924,7 @@ forAllTyErr env rank ty , vcat [ hang herald 2 (ppr_tidy env ty) , suggestion ] ) where - (tvs, _theta, _tau) = tcSplitSigmaTy ty + (tvs, _rho) = tcSplitForAllTyVars ty herald | null tvs = text "Illegal qualified type:" | otherwise = text "Illegal polymorphic type:" suggestion = case rank of |