Commit d61adb3d authored by Ryan Scott's avatar Ryan Scott Committed by Marge Bot

Name (tc)SplitForAll- functions more consistently

There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as
`tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar
things, but vary in the particular form of type variable that they return. To
make things worse, the names of these functions are often quite misleading.
Some particularly egregious examples:

* `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns
  `VarBndr`s.
* `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns
  `TyVar`s.
* `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns
  `InvisTVBinder`s. (This in particular arose in the context of #18939, and
  this finally motivated me to bite the bullet and improve the status quo
  vis-à-vis how we name these functions.)

In an attempt to bring some sanity to how these functions are named, I have
opted to rename most of these functions en masse to use consistent suffixes
that describe the particular form of type variable that each function returns.
In concrete terms, this amounts to:

* Functions that return a `TyVar` now use the suffix `-TyVar`.
  This caused the following functions to be renamed:
  * `splitTyVarForAllTys` -> `splitForAllTyVars`
  * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe`
  * `tcSplitForAllTys` -> `tcSplitForAllTyVars`
  * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars`
* Functions that return a `CoVar` now use the suffix `-CoVar`.
  This caused the following functions to be renamed:
  * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe`
* Functions that return a `TyCoVar` now use the suffix `-TyCoVar`.
  This caused the following functions to be renamed:
  * `splitForAllTy` -> `splitForAllTyCoVar`
  * `splitForAllTys` -> `splitForAllTyCoVars`
  * `splitForAllTys'` -> `splitForAllTyCoVars'`
  * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe`
* Functions that return a `VarBndr` now use the suffix corresponding to the
  most relevant type synonym. This caused the following functions to be renamed:
  * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders`
  * `splitForAllTysInvis` -> `splitForAllInvisTVBinders`
  * `splitForAllTysReq` -> `splitForAllReqTVBinders`
  * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs`
  * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders`
  * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders`
  * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders`
  * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe`

Note that I left the following functions alone:

* Functions that split apart things besides `ForAllTy`s, such as `splitFunTys`
  or `splitPiTys`. Thankfully, there are far fewer of these functions than
  there are functions that split apart `ForAllTy`s, so there isn't much of a
  pressing need to apply the new naming convention elsewhere.
* Functions that split apart `ForAllCo`s in `Coercion`s, such as
  `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new
  naming convention here, but then we'd have to figure out how to disambiguate
  `Type`-splitting functions from `Coercion`-splitting functions. Ultimately,
  the `Coercion`-splitting functions aren't used nearly as much as the
  `Type`-splitting functions, so I decided to leave the former alone.

This is purely refactoring and should cause no change in behavior.
parent a2539650
...@@ -215,7 +215,7 @@ module GHC ( ...@@ -215,7 +215,7 @@ module GHC (
FamInst, FamInst,
-- ** Types and Kinds -- ** Types and Kinds
Type, splitForAllTys, funResultTy, Type, splitForAllTyCoVars, funResultTy,
pprParendType, pprTypeApp, pprParendType, pprTypeApp,
Kind, Kind,
PredType, PredType,
......
...@@ -427,8 +427,8 @@ decomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args ...@@ -427,8 +427,8 @@ decomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args
-- Invariant: co :: subst1(k2) ~ subst2(k2) -- Invariant: co :: subst1(k2) ~ subst2(k2)
go acc_arg_cos (subst1,k1) co (subst2,k2) (ty:tys) go acc_arg_cos (subst1,k1) co (subst2,k2) (ty:tys)
| Just (a, t1) <- splitForAllTy_maybe k1 | Just (a, t1) <- splitForAllTyCoVar_maybe k1
, Just (b, t2) <- splitForAllTy_maybe k2 , Just (b, t2) <- splitForAllTyCoVar_maybe k2
-- know co :: (forall a:s1.t1) ~ (forall b:s2.t2) -- know co :: (forall a:s1.t1) ~ (forall b:s2.t2)
-- function :: forall a:s1.t1 (the function is not passed to decomposePiCos) -- function :: forall a:s1.t1 (the function is not passed to decomposePiCos)
-- a :: s1 -- a :: s1
...@@ -1029,7 +1029,7 @@ mkNthCo r n co ...@@ -1029,7 +1029,7 @@ mkNthCo r n co
go r 0 co go r 0 co
| Just (ty, _) <- isReflCo_maybe co | Just (ty, _) <- isReflCo_maybe co
, Just (tv, _) <- splitForAllTy_maybe ty , Just (tv, _) <- splitForAllTyCoVar_maybe ty
= -- works for both tyvar and covar = -- works for both tyvar and covar
ASSERT( r == Nominal ) ASSERT( r == Nominal )
mkNomReflCo (varType tv) mkNomReflCo (varType tv)
...@@ -1080,8 +1080,8 @@ mkNthCo r n co ...@@ -1080,8 +1080,8 @@ mkNthCo r n co
good_call good_call
-- If the Coercion passed in is between forall-types, then the Int must -- If the Coercion passed in is between forall-types, then the Int must
-- be 0 and the role must be Nominal. -- be 0 and the role must be Nominal.
| Just (_tv1, _) <- splitForAllTy_maybe ty1 | Just (_tv1, _) <- splitForAllTyCoVar_maybe ty1
, Just (_tv2, _) <- splitForAllTy_maybe ty2 , Just (_tv2, _) <- splitForAllTyCoVar_maybe ty2
= n == 0 && r == Nominal = n == 0 && r == Nominal
-- If the Coercion passed in is between T tys and T tys', then the Int -- If the Coercion passed in is between T tys and T tys', then the Int
...@@ -1140,7 +1140,7 @@ nthCoRole n co ...@@ -1140,7 +1140,7 @@ nthCoRole n co
| Just (tc, _) <- splitTyConApp_maybe lty | Just (tc, _) <- splitTyConApp_maybe lty
= nthRole r tc n = nthRole r tc n
| Just _ <- splitForAllTy_maybe lty | Just _ <- splitForAllTyCoVar_maybe lty
= Nominal = Nominal
| otherwise | otherwise
...@@ -2330,7 +2330,7 @@ go_nth d ty ...@@ -2330,7 +2330,7 @@ go_nth d ty
args `getNth` d args `getNth` d
| d == 0 | d == 0
, Just (tv,_) <- splitForAllTy_maybe ty , Just (tv,_) <- splitForAllTyCoVar_maybe ty
= tyVarKind tv = tyVarKind tv
| otherwise | otherwise
......
...@@ -335,7 +335,7 @@ opt_co4 env _sym rep r (NthCo _r n co) ...@@ -335,7 +335,7 @@ opt_co4 env _sym rep r (NthCo _r n co)
| Just (ty, _) <- isReflCo_maybe co | Just (ty, _) <- isReflCo_maybe co
, n == 0 , n == 0
, Just (tv, _) <- splitForAllTy_maybe ty , Just (tv, _) <- splitForAllTyCoVar_maybe ty
-- works for both tyvar and covar -- works for both tyvar and covar
= liftCoSubst (chooseRole rep r) env (varType tv) = liftCoSubst (chooseRole rep r) env (varType tv)
...@@ -531,8 +531,8 @@ opt_univ env sym prov role oty1 oty2 ...@@ -531,8 +531,8 @@ opt_univ env sym prov role oty1 oty2
-- can't optimize the AppTy case because we can't build the kind coercions. -- can't optimize the AppTy case because we can't build the kind coercions.
| Just (tv1, ty1) <- splitForAllTy_ty_maybe oty1 | Just (tv1, ty1) <- splitForAllTyVar_maybe oty1
, Just (tv2, ty2) <- splitForAllTy_ty_maybe oty2 , Just (tv2, ty2) <- splitForAllTyVar_maybe oty2
-- NB: prov isn't interesting here either -- NB: prov isn't interesting here either
= let k1 = tyVarKind tv1 = let k1 = tyVarKind tv1
k2 = tyVarKind tv2 k2 = tyVarKind tv2
...@@ -544,8 +544,8 @@ opt_univ env sym prov role oty1 oty2 ...@@ -544,8 +544,8 @@ opt_univ env sym prov role oty1 oty2
in in
mkForAllCo tv1' eta' (opt_univ env' sym prov' role ty1 ty2') mkForAllCo tv1' eta' (opt_univ env' sym prov' role ty1 ty2')
| Just (cv1, ty1) <- splitForAllTy_co_maybe oty1 | Just (cv1, ty1) <- splitForAllCoVar_maybe oty1
, Just (cv2, ty2) <- splitForAllTy_co_maybe oty2 , Just (cv2, ty2) <- splitForAllCoVar_maybe oty2
-- NB: prov isn't interesting here either -- NB: prov isn't interesting here either
= let k1 = varType cv1 = let k1 = varType cv1
k2 = varType cv2 k2 = varType cv2
...@@ -1121,7 +1121,7 @@ etaForAllCo_ty_maybe co ...@@ -1121,7 +1121,7 @@ etaForAllCo_ty_maybe co
= Just (tv, kind_co, r) = Just (tv, kind_co, r)
| Pair ty1 ty2 <- coercionKind co | Pair ty1 ty2 <- coercionKind co
, Just (tv1, _) <- splitForAllTy_ty_maybe ty1 , Just (tv1, _) <- splitForAllTyVar_maybe ty1
, isForAllTy_ty ty2 , isForAllTy_ty ty2
, let kind_co = mkNthCo Nominal 0 co , let kind_co = mkNthCo Nominal 0 co
= Just ( tv1, kind_co = Just ( tv1, kind_co
...@@ -1137,7 +1137,7 @@ etaForAllCo_co_maybe co ...@@ -1137,7 +1137,7 @@ etaForAllCo_co_maybe co
= Just (cv, kind_co, r) = Just (cv, kind_co, r)
| Pair ty1 ty2 <- coercionKind co | Pair ty1 ty2 <- coercionKind co
, Just (cv1, _) <- splitForAllTy_co_maybe ty1 , Just (cv1, _) <- splitForAllCoVar_maybe ty1
, isForAllTy_co ty2 , isForAllTy_co ty2
= let kind_co = mkNthCo Nominal 0 co = let kind_co = mkNthCo Nominal 0 co
r = coVarRole cv1 r = coVarRole cv1
......
...@@ -1240,7 +1240,7 @@ checkCaseLinearity ue case_bndr var_w bndr = do ...@@ -1240,7 +1240,7 @@ checkCaseLinearity ue case_bndr var_w bndr = do
----------------- -----------------
lintTyApp :: LintedType -> LintedType -> LintM LintedType lintTyApp :: LintedType -> LintedType -> LintM LintedType
lintTyApp fun_ty arg_ty lintTyApp fun_ty arg_ty
| Just (tv,body_ty) <- splitForAllTy_maybe fun_ty | Just (tv,body_ty) <- splitForAllTyCoVar_maybe fun_ty
= do { lintTyKind tv arg_ty = do { lintTyKind tv arg_ty
; in_scope <- getInScope ; in_scope <- getInScope
-- substTy needs the set of tyvars in scope to avoid generating -- substTy needs the set of tyvars in scope to avoid generating
...@@ -2172,7 +2172,7 @@ lintCoercion co@(TransCo co1 co2) ...@@ -2172,7 +2172,7 @@ lintCoercion co@(TransCo co1 co2)
lintCoercion the_co@(NthCo r0 n co) lintCoercion the_co@(NthCo r0 n co)
= do { co' <- lintCoercion co = do { co' <- lintCoercion co
; let (Pair s t, r) = coercionKindRole co' ; let (Pair s t, r) = coercionKindRole co'
; case (splitForAllTy_maybe s, splitForAllTy_maybe t) of ; case (splitForAllTyCoVar_maybe s, splitForAllTyCoVar_maybe t) of
{ (Just _, Just _) { (Just _, Just _)
-- works for both tyvar and covar -- works for both tyvar and covar
| n == 0 | n == 0
...@@ -2214,7 +2214,7 @@ lintCoercion (InstCo co arg) ...@@ -2214,7 +2214,7 @@ lintCoercion (InstCo co arg)
; lintRole arg Nominal (coercionRole arg') ; lintRole arg Nominal (coercionRole arg')
; case (splitForAllTy_ty_maybe t1, splitForAllTy_ty_maybe t2) of ; case (splitForAllTyVar_maybe t1, splitForAllTyVar_maybe t2) of
-- forall over tvar -- forall over tvar
{ (Just (tv1,_), Just (tv2,_)) { (Just (tv1,_), Just (tv2,_))
| typeKind s1 `eqType` tyVarKind tv1 | typeKind s1 `eqType` tyVarKind tv1
...@@ -2223,7 +2223,7 @@ lintCoercion (InstCo co arg) ...@@ -2223,7 +2223,7 @@ lintCoercion (InstCo co arg)
| otherwise | otherwise
-> failWithL (text "Kind mis-match in inst coercion1" <+> ppr co) -> failWithL (text "Kind mis-match in inst coercion1" <+> ppr co)
; _ -> case (splitForAllTy_co_maybe t1, splitForAllTy_co_maybe t2) of ; _ -> case (splitForAllCoVar_maybe t1, splitForAllCoVar_maybe t2) of
-- forall over covar -- forall over covar
{ (Just (cv1, _), Just (cv2, _)) { (Just (cv1, _), Just (cv2, _))
| typeKind s1 `eqType` varType cv1 | typeKind s1 `eqType` varType cv1
......
...@@ -145,7 +145,7 @@ typeArity ty ...@@ -145,7 +145,7 @@ typeArity ty
= go initRecTc ty = go initRecTc ty
where where
go rec_nts ty go rec_nts ty
| Just (_, ty') <- splitForAllTy_maybe ty | Just (_, ty') <- splitForAllTyCoVar_maybe ty
= go rec_nts ty' = go rec_nts ty'
| Just (_,arg,res) <- splitFunTy_maybe ty | Just (_,arg,res) <- splitFunTy_maybe ty
...@@ -1516,7 +1516,7 @@ mkEtaWW orig_oss ppr_orig_expr in_scope orig_ty ...@@ -1516,7 +1516,7 @@ mkEtaWW orig_oss ppr_orig_expr in_scope orig_ty
go n oss@(one_shot:oss1) subst ty eis -- See Note [exprArity invariant] go n oss@(one_shot:oss1) subst ty eis -- See Note [exprArity invariant]
----------- Forall types (forall a. ty) ----------- Forall types (forall a. ty)
| Just (tcv,ty') <- splitForAllTy_maybe ty | Just (tcv,ty') <- splitForAllTyCoVar_maybe ty
, (subst', tcv') <- Type.substVarBndr subst tcv , (subst', tcv') <- Type.substVarBndr subst tcv
, let oss' | isTyVar tcv = oss , let oss' | isTyVar tcv = oss
| otherwise = oss1 | otherwise = oss1
...@@ -1884,7 +1884,7 @@ etaBodyForJoinPoint need_args body ...@@ -1884,7 +1884,7 @@ etaBodyForJoinPoint need_args body
go 0 _ _ rev_bs e go 0 _ _ rev_bs e
= (reverse rev_bs, e) = (reverse rev_bs, e)
go n ty subst rev_bs e go n ty subst rev_bs e
| Just (tv, res_ty) <- splitForAllTy_maybe ty | Just (tv, res_ty) <- splitForAllTyCoVar_maybe ty
, let (subst', tv') = substVarBndr subst tv , let (subst', tv') = substVarBndr subst tv
= go (n-1) res_ty subst' (tv' : rev_bs) (e `App` varToCoreExpr tv') = go (n-1) res_ty subst' (tv' : rev_bs) (e `App` varToCoreExpr tv')
| Just (mult, arg_ty, res_ty) <- splitFunTy_maybe ty | Just (mult, arg_ty, res_ty) <- splitFunTy_maybe ty
......
...@@ -1181,7 +1181,7 @@ unsafeEqualityProofRule ...@@ -1181,7 +1181,7 @@ unsafeEqualityProofRule
= do { [Type rep, Type t1, Type t2] <- getArgs = do { [Type rep, Type t1, Type t2] <- getArgs
; guard (t1 `eqType` t2) ; guard (t1 `eqType` t2)
; fn <- getFunction ; fn <- getFunction
; let (_, ue) = splitForAllTys (idType fn) ; let (_, ue) = splitForAllTyCoVars (idType fn)
tc = tyConAppTyCon ue -- tycon: UnsafeEquality tc = tyConAppTyCon ue -- tycon: UnsafeEquality
(dc:_) = tyConDataCons tc -- data con: UnsafeRefl (dc:_) = tyConDataCons tc -- data con: UnsafeRefl
-- UnsafeRefl :: forall (r :: RuntimeRep) (a :: TYPE r). -- UnsafeRefl :: forall (r :: RuntimeRep) (a :: TYPE r).
......
...@@ -576,7 +576,7 @@ mkArgInfo env fun rules n_val_args call_cont ...@@ -576,7 +576,7 @@ mkArgInfo env fun rules n_val_args call_cont
add_type_strictness fun_ty dmds add_type_strictness fun_ty dmds
| null dmds = [] | null dmds = []
| Just (_, fun_ty') <- splitForAllTy_maybe fun_ty | Just (_, fun_ty') <- splitForAllTyCoVar_maybe fun_ty
= add_type_strictness fun_ty' dmds -- Look through foralls = add_type_strictness fun_ty' dmds -- Look through foralls
| Just (_, arg_ty, fun_ty') <- splitFunTy_maybe fun_ty -- Add strict-type info | Just (_, arg_ty, fun_ty') <- splitFunTy_maybe fun_ty -- Add strict-type info
......
...@@ -971,7 +971,7 @@ decreaseSpecCount env n_specs ...@@ -971,7 +971,7 @@ decreaseSpecCount env n_specs
--------------------------------------------------- ---------------------------------------------------
-- See Note [Forcing specialisation] -- See Note [Forcing specialisation]
forceSpecBndr :: ScEnv -> Var -> Bool forceSpecBndr :: ScEnv -> Var -> Bool
forceSpecBndr env var = forceSpecFunTy env . snd . splitForAllTys . varType $ var forceSpecBndr env var = forceSpecFunTy env . snd . splitForAllTyCoVars . varType $ var
forceSpecFunTy :: ScEnv -> Type -> Bool forceSpecFunTy :: ScEnv -> Type -> Bool
forceSpecFunTy env = any (forceSpecArgTy env) . map scaledThing . fst . splitFunTys forceSpecFunTy env = any (forceSpecArgTy env) . map scaledThing . fst . splitFunTys
......
...@@ -434,7 +434,7 @@ mkWWargs subst fun_ty demands ...@@ -434,7 +434,7 @@ mkWWargs subst fun_ty demands
apply_or_bind_then work_fn_args (varToCoreExpr id), apply_or_bind_then work_fn_args (varToCoreExpr id),
res_ty) } res_ty) }
| Just (tv, fun_ty') <- splitForAllTy_maybe fun_ty | Just (tv, fun_ty') <- splitForAllTyCoVar_maybe fun_ty
= do { uniq <- getUniqueM = do { uniq <- getUniqueM
; let (subst', tv') = cloneTyVarBndr subst tv uniq ; let (subst', tv') = cloneTyVarBndr subst tv uniq
-- See Note [Freshen WW arguments] -- See Note [Freshen WW arguments]
...@@ -1026,7 +1026,7 @@ findTypeShape fam_envs ty ...@@ -1026,7 +1026,7 @@ findTypeShape fam_envs ty
| Just (tc, tc_args) <- splitTyConApp_maybe ty | Just (tc, tc_args) <- splitTyConApp_maybe ty
= go_tc rec_tc tc tc_args = go_tc rec_tc tc tc_args
| Just (_, ty') <- splitForAllTy_maybe ty | Just (_, ty') <- splitForAllTyCoVar_maybe ty
= go rec_tc ty' = go rec_tc ty'
| otherwise | otherwise
......
...@@ -69,7 +69,7 @@ classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of ...@@ -69,7 +69,7 @@ classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of
| Just clas <- tyConClass_maybe tc | Just clas <- tyConClass_maybe tc
-> ClassPred clas tys -> ClassPred clas tys
_ | (tvs, rho) <- splitForAllTys ev_ty _ | (tvs, rho) <- splitForAllTyCoVars ev_ty
, (theta, pred) <- splitFunTys rho , (theta, pred) <- splitFunTys rho
, not (null tvs && null theta) , not (null tvs && null theta)
-> ForAllPred tvs (map scaledThing theta) pred -> ForAllPred tvs (map scaledThing theta) pred
......
...@@ -34,7 +34,7 @@ import {-# SOURCE #-} GHC.Core.DataCon ...@@ -34,7 +34,7 @@ import {-# SOURCE #-} GHC.Core.DataCon
( dataConFullSig , dataConUserTyVarBinders, DataCon ) ( dataConFullSig , dataConUserTyVarBinders, DataCon )
import GHC.Core.Type ( pickyIsLiftedTypeKind, pattern One, pattern Many, import GHC.Core.Type ( pickyIsLiftedTypeKind, pattern One, pattern Many,
splitForAllTysReq, splitForAllTysInvis ) splitForAllReqTVBinders, splitForAllInvisTVBinders )
import GHC.Core.TyCon import GHC.Core.TyCon
import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Rep
...@@ -269,7 +269,7 @@ debug_ppr_ty _ (CoercionTy co) ...@@ -269,7 +269,7 @@ debug_ppr_ty _ (CoercionTy co)
-- Invisible forall: forall {k} (a :: k). t -- Invisible forall: forall {k} (a :: k). t
debug_ppr_ty prec t debug_ppr_ty prec t
| (bndrs, body) <- splitForAllTysInvis t | (bndrs, body) <- splitForAllInvisTVBinders t
, not (null bndrs) , not (null bndrs)
= maybeParen prec funPrec $ = maybeParen prec funPrec $
sep [ text "forall" <+> fsep (map ppr_bndr bndrs) <> dot, sep [ text "forall" <+> fsep (map ppr_bndr bndrs) <> dot,
...@@ -282,7 +282,7 @@ debug_ppr_ty prec t ...@@ -282,7 +282,7 @@ debug_ppr_ty prec t
-- Visible forall: forall x y -> t -- Visible forall: forall x y -> t
debug_ppr_ty prec t debug_ppr_ty prec t
| (bndrs, body) <- splitForAllTysReq t | (bndrs, body) <- splitForAllReqTVBinders t
, not (null bndrs) , not (null bndrs)
= maybeParen prec funPrec $ = maybeParen prec funPrec $
sep [ text "forall" <+> fsep (map ppr_bndr bndrs) <+> arrow, sep [ text "forall" <+> fsep (map ppr_bndr bndrs) <+> arrow,
...@@ -294,7 +294,7 @@ debug_ppr_ty prec t ...@@ -294,7 +294,7 @@ debug_ppr_ty prec t
-- Impossible case: neither visible nor invisible forall. -- Impossible case: neither visible nor invisible forall.
debug_ppr_ty _ ForAllTy{} debug_ppr_ty _ ForAllTy{}
= panic "debug_ppr_ty: neither splitForAllTysInvis nor splitForAllTysReq returned any binders" = panic "debug_ppr_ty: neither splitForAllInvisTVBinders nor splitForAllReqTVBinders returned any binders"
{- {-
Note [Infix type variables] Note [Infix type variables]
......
...@@ -139,13 +139,13 @@ tidyType env ty@(FunTy _ w arg res) = let { !w' = tidyType env w ...@@ -139,13 +139,13 @@ tidyType env ty@(FunTy _ w arg res) = let { !w' = tidyType env w
in ty { ft_mult = w', ft_arg = arg', ft_res = res' } in ty { ft_mult = w', ft_arg = arg', ft_res = res' }
tidyType env (ty@(ForAllTy{})) = mkForAllTys' (zip tvs' vis) $! tidyType env' body_ty tidyType env (ty@(ForAllTy{})) = mkForAllTys' (zip tvs' vis) $! tidyType env' body_ty
where where
(tvs, vis, body_ty) = splitForAllTys' ty (tvs, vis, body_ty) = splitForAllTyCoVars' ty
(env', tvs') = tidyVarBndrs env tvs (env', tvs') = tidyVarBndrs env tvs
tidyType env (CastTy ty co) = (CastTy $! tidyType env ty) $! (tidyCo env co) tidyType env (CastTy ty co) = (CastTy $! tidyType env ty) $! (tidyCo env co)
tidyType env (CoercionTy co) = CoercionTy $! (tidyCo env co) tidyType env (CoercionTy co) = CoercionTy $! (tidyCo env co)
-- The following two functions differ from mkForAllTys and splitForAllTys in that -- The following two functions differ from mkForAllTys and splitForAllTyCoVars in that
-- they expect/preserve the ArgFlag argument. These belong to "GHC.Core.Type", but -- they expect/preserve the ArgFlag argument. These belong to "GHC.Core.Type", but
-- how should they be named? -- how should they be named?
mkForAllTys' :: [(TyCoVar, ArgFlag)] -> Type -> Type mkForAllTys' :: [(TyCoVar, ArgFlag)] -> Type -> Type
...@@ -153,8 +153,8 @@ mkForAllTys' tvvs ty = foldr strictMkForAllTy ty tvvs ...@@ -153,8 +153,8 @@ mkForAllTys' tvvs ty = foldr strictMkForAllTy ty tvvs
where where
strictMkForAllTy (tv,vis) ty = (ForAllTy $! ((Bndr $! tv) $! vis)) $! ty strictMkForAllTy (tv,vis) ty = (ForAllTy $! ((Bndr $! tv) $! vis)) $! ty
splitForAllTys' :: Type -> ([TyCoVar], [ArgFlag], Type) splitForAllTyCoVars' :: Type -> ([TyCoVar], [ArgFlag], Type)
splitForAllTys' ty = go ty [] [] splitForAllTyCoVars' ty = go ty [] []
where where
go (ForAllTy (Bndr tv vis) ty) tvs viss = go ty (tv:tvs) (vis:viss) go (ForAllTy (Bndr tv vis) ty) tvs viss = go ty (tv:tvs) (vis:viss)
go ty tvs viss = (reverse tvs, reverse viss, ty) go ty tvs viss = (reverse tvs, reverse viss, ty)
......
...@@ -48,11 +48,11 @@ module GHC.Core.Type ( ...@@ -48,11 +48,11 @@ module GHC.Core.Type (
mkSpecForAllTy, mkSpecForAllTys, mkSpecForAllTy, mkSpecForAllTys,
mkVisForAllTys, mkTyCoInvForAllTy, mkVisForAllTys, mkTyCoInvForAllTy,
mkInfForAllTy, mkInfForAllTys, mkInfForAllTy, mkInfForAllTys,
splitForAllTys, splitForAllTyCoVars,
splitForAllTysReq, splitForAllTysInvis, splitForAllReqTVBinders, splitForAllInvisTVBinders,
splitForAllVarBndrs, splitForAllTyCoVarBinders,
splitForAllTy_maybe, splitForAllTy, splitForAllTyCoVar_maybe, splitForAllTyCoVar,
splitForAllTy_ty_maybe, splitForAllTy_co_maybe, splitForAllTyVar_maybe, splitForAllCoVar_maybe,
splitPiTy_maybe, splitPiTy, splitPiTys, splitPiTy_maybe, splitPiTy, splitPiTys,
mkTyConBindersPreferAnon, mkTyConBindersPreferAnon,
mkPiTy, mkPiTys, mkPiTy, mkPiTys,
...@@ -1552,8 +1552,8 @@ mkTyConBindersPreferAnon vars inner_tkvs = ASSERT( all isTyVar vars) ...@@ -1552,8 +1552,8 @@ mkTyConBindersPreferAnon vars inner_tkvs = ASSERT( all isTyVar vars)
-- | Take a ForAllTy apart, returning the list of tycovars and the result type. -- | Take a ForAllTy apart, returning the list of tycovars and the result type.
-- This always succeeds, even if it returns only an empty list. Note that the -- This always succeeds, even if it returns only an empty list. Note that the
-- result type returned may have free variables that were bound by a forall. -- result type returned may have free variables that were bound by a forall.
splitForAllTys :: Type -> ([TyCoVar], Type) splitForAllTyCoVars :: Type -> ([TyCoVar], Type)
splitForAllTys ty = split ty ty [] splitForAllTyCoVars ty = split ty ty []
where where
split _ (ForAllTy (Bndr tv _) ty) tvs = split ty ty (tv:tvs) split _ (ForAllTy (Bndr tv _) ty) tvs = split ty ty (tv:tvs)
split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
...@@ -1561,38 +1561,38 @@ splitForAllTys ty = split ty ty [] ...@@ -1561,38 +1561,38 @@ splitForAllTys ty = split ty ty []
-- | Splits the longest initial sequence of ForAllTys' that satisfy -- | Splits the longest initial sequence of ForAllTys' that satisfy
-- @argf_pred@, returning the binders transformed by @argf_pred@ -- @argf_pred@, returning the binders transformed by @argf_pred@
splitSomeForAllTys :: (ArgFlag -> Maybe af) -> Type -> ([VarBndr TyCoVar af], Type) splitSomeForAllTyCoVarBndrs :: (ArgFlag -> Maybe af) -> Type -> ([VarBndr TyCoVar af], Type)
splitSomeForAllTys argf_pred ty = split ty ty [] splitSomeForAllTyCoVarBndrs argf_pred ty = split ty ty []
where where
split _ (ForAllTy (Bndr tcv argf) ty) tvs split _ (ForAllTy (Bndr tcv argf) ty) tvs
| Just argf' <- argf_pred argf = split ty ty (Bndr tcv argf' : tvs) | Just argf' <- argf_pred argf = split ty ty (Bndr tcv argf' : tvs)
split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
split orig_ty _ tvs = (reverse tvs, orig_ty) split orig_ty _ tvs = (reverse tvs, orig_ty)
-- | Like 'splitForAllTys', but only splits 'ForAllTy's with 'Required' type -- | Like 'splitForAllTyCoVars', but only splits 'ForAllTy's with 'Required' type
-- variable binders. Furthermore, each returned tyvar is annotated with '()'. -- variable binders. Furthermore, each returned tyvar is annotated with '()'.
splitForAllTysReq :: Type -> ([ReqTVBinder], Type) splitForAllReqTVBinders :: Type -> ([ReqTVBinder], Type)
splitForAllTysReq ty = splitSomeForAllTys argf_pred ty splitForAllReqTVBinders ty = splitSomeForAllTyCoVarBndrs argf_pred ty
where where
argf_pred :: ArgFlag -> Maybe () argf_pred :: ArgFlag -> Maybe ()
argf_pred Required = Just () argf_pred Required = Just ()
argf_pred (Invisible {}) = Nothing argf_pred (Invisible {}) = Nothing
-- | Like 'splitForAllTys', but only splits 'ForAllTy's with 'Invisible' type -- | Like 'splitForAllTyCoVars', but only splits 'ForAllTy's with 'Invisible' type
-- variable binders. Furthermore, each returned tyvar is annotated with its -- variable binders. Furthermore, each returned tyvar is annotated with its
-- 'Specificity'. -- 'Specificity'.
splitForAllTysInvis :: Type -> ([InvisTVBinder], Type) splitForAllInvisTVBinders :: Type -> ([InvisTVBinder], Type)
splitForAllTysInvis ty = splitSomeForAllTys argf_pred ty splitForAllInvisTVBinders ty = splitSomeForAllTyCoVarBndrs argf_pred ty
where where
argf_pred :: ArgFlag -> Maybe Specificity argf_pred :: ArgFlag -> Maybe Specificity
argf_pred Required = Nothing argf_pred Required = Nothing
argf_pred (Invisible spec) = Just spec argf_pred (Invisible spec) = Just spec
-- | Like splitForAllTys, but split only for tyvars. -- | Like 'splitForAllTyCoVars', but split only for tyvars.
-- This always succeeds, even if it returns only an empty list. Note that the -- This always succeeds, even if it returns only an empty list. Note that the
-- result type returned may have free variables that were bound by a forall. -- result type returned may have free variables that were bound by a forall.
splitTyVarForAllTys :: Type -> ([TyVar], Type) splitForAllTyVars :: Type -> ([TyVar], Type)
splitTyVarForAllTys ty = split ty ty [] splitForAllTyVars ty = split ty ty []
where where
split _ (ForAllTy (Bndr tv _) ty) tvs | isTyVar tv = split ty ty (tv:tvs) split _ (ForAllTy (Bndr tv _) ty) tvs | isTyVar tv = split ty ty (tv:tvs)
split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
...@@ -1636,10 +1636,10 @@ isFunTy ty ...@@ -1636,10 +1636,10 @@ isFunTy ty
| otherwise = False | otherwise = False
-- | Take a forall type apart, or panics if that is not possible. -- | Take a forall type apart, or panics if that is not possible.
splitForAllTy :: Type -> (TyCoVar, Type) splitForAllTyCoVar :: Type -> (TyCoVar, Type)
splitForAllTy ty splitForAllTyCoVar ty
| Just answer <- splitForAllTy_maybe ty = answer | Just answer <- splitForAllTyCoVar_maybe ty = answer
| otherwise = pprPanic "splitForAllTy" (ppr ty) | otherwise = pprPanic "splitForAllTyCoVar" (ppr ty)
-- | Drops all ForAllTys -- | Drops all ForAllTys
dropForAlls :: Type -> Type dropForAlls :: Type -> Type
...@@ -1651,23 +1651,23 @@ dropForAlls ty = go ty ...@@ -1651,23 +1651,23 @@ dropForAlls ty = go ty
-- | Attempts to take a forall type apart, but only if it's a proper forall, -- | Attempts to take a forall type apart, but only if it's a proper forall,
-- with a named binder -- with a named binder
splitForAllTy_maybe :: Type -> Maybe (TyCoVar, Type) splitForAllTyCoVar_maybe :: Type -> Maybe (TyCoVar, Type)
splitForAllTy_maybe ty splitForAllTyCoVar_maybe ty
| ForAllTy (Bndr tv _) inner_ty <- coreFullView ty = Just (tv, inner_ty) | ForAllTy (Bndr tv _) inner_ty <- coreFullView ty = Just (tv, inner_ty)
| otherwise = Nothing | otherwise = Nothing
-- | Like splitForAllTy_maybe, but only returns Just if it is a tyvar binder. -- | Like 'splitForAllTyCoVar_maybe', but only returns Just if it is a tyvar binder.
splitForAllTy_ty_maybe :: Type -> Maybe (TyCoVar, Type) splitForAllTyVar_maybe :: Type -> Maybe (TyCoVar, Type)
splitForAllTy_ty_maybe ty splitForAllTyVar_maybe ty
| ForAllTy (Bndr tv _) inner_ty <- coreFullView ty | ForAllTy (Bndr tv _) inner_ty <- coreFullView ty
, isTyVar tv , isTyVar tv
= Just (tv, inner_ty) = Just (tv, inner_ty)
| otherwise = Nothing | otherwise = Nothing
-- | Like splitForAllTy_maybe, but only returns Just if it is a covar binder. -- | Like 'splitForAllTyCoVar_maybe', but only returns Just if it is a covar binder.
splitForAllTy_co_maybe :: Type -> Maybe (TyCoVar, Type) splitForAllCoVar_maybe :: Type -> Maybe (TyCoVar, Type)
splitForAllTy_co_maybe ty splitForAllCoVar_maybe ty
| ForAllTy (Bndr tv _) inner_ty <- coreFullView ty | ForAllTy (Bndr tv _) inner_ty <- coreFullView ty
, isCoVar tv , isCoVar tv
= Just (tv, inner_ty) = Just (tv, inner_ty)
...@@ -1702,14 +1702,14 @@ splitPiTys ty = split ty ty [] ...@@ -1702,14 +1702,14 @@ splitPiTys ty = split ty ty []
split orig_ty _ bs = (reverse bs, orig_ty) split orig_ty _ bs = (reverse bs, orig_ty)
-- | Like 'splitPiTys' but split off only /named/ binders -- | Like 'splitPiTys' but split off only /named/ binders
-- and returns TyCoVarBinders rather than TyCoBinders -- and returns 'TyCoVarBinder's rather than 'TyCoBinder's