summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Tc')
-rw-r--r--compiler/GHC/Tc/Gen/HsType.hs4
-rw-r--r--compiler/GHC/Tc/TyCl/Instance.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs4
-rw-r--r--compiler/GHC/Tc/Utils/Instantiate.hs2
-rw-r--r--compiler/GHC/Tc/Utils/TcType.hs23
-rw-r--r--compiler/GHC/Tc/Validity.hs2
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
View Lorry Controller Status