diff options
Diffstat (limited to 'compiler')
31 files changed, 140 insertions, 140 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs index f3204c8bc2..13d8ba5ec7 100644 --- a/compiler/GHC.hs +++ b/compiler/GHC.hs @@ -215,7 +215,7 @@ module GHC ( FamInst, -- ** Types and Kinds - Type, splitForAllTys, funResultTy, + Type, splitForAllTyCoVars, funResultTy, pprParendType, pprTypeApp, Kind, PredType, diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs index 16d8f427e9..4413c7355b 100644 --- a/compiler/GHC/Core/Coercion.hs +++ b/compiler/GHC/Core/Coercion.hs @@ -427,8 +427,8 @@ decomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args -- Invariant: co :: subst1(k2) ~ subst2(k2) go acc_arg_cos (subst1,k1) co (subst2,k2) (ty:tys) - | Just (a, t1) <- splitForAllTy_maybe k1 - , Just (b, t2) <- splitForAllTy_maybe k2 + | Just (a, t1) <- splitForAllTyCoVar_maybe k1 + , Just (b, t2) <- splitForAllTyCoVar_maybe k2 -- know co :: (forall a:s1.t1) ~ (forall b:s2.t2) -- function :: forall a:s1.t1 (the function is not passed to decomposePiCos) -- a :: s1 @@ -1029,7 +1029,7 @@ mkNthCo r n co go r 0 co | Just (ty, _) <- isReflCo_maybe co - , Just (tv, _) <- splitForAllTy_maybe ty + , Just (tv, _) <- splitForAllTyCoVar_maybe ty = -- works for both tyvar and covar ASSERT( r == Nominal ) mkNomReflCo (varType tv) @@ -1080,8 +1080,8 @@ mkNthCo r n co good_call -- If the Coercion passed in is between forall-types, then the Int must -- be 0 and the role must be Nominal. - | Just (_tv1, _) <- splitForAllTy_maybe ty1 - , Just (_tv2, _) <- splitForAllTy_maybe ty2 + | Just (_tv1, _) <- splitForAllTyCoVar_maybe ty1 + , Just (_tv2, _) <- splitForAllTyCoVar_maybe ty2 = n == 0 && r == Nominal -- If the Coercion passed in is between T tys and T tys', then the Int @@ -1140,7 +1140,7 @@ nthCoRole n co | Just (tc, _) <- splitTyConApp_maybe lty = nthRole r tc n - | Just _ <- splitForAllTy_maybe lty + | Just _ <- splitForAllTyCoVar_maybe lty = Nominal | otherwise @@ -2330,7 +2330,7 @@ go_nth d ty args `getNth` d | d == 0 - , Just (tv,_) <- splitForAllTy_maybe ty + , Just (tv,_) <- splitForAllTyCoVar_maybe ty = tyVarKind tv | otherwise diff --git a/compiler/GHC/Core/Coercion/Opt.hs b/compiler/GHC/Core/Coercion/Opt.hs index fb0a6b0cc0..76ffde9c4d 100644 --- a/compiler/GHC/Core/Coercion/Opt.hs +++ b/compiler/GHC/Core/Coercion/Opt.hs @@ -335,7 +335,7 @@ opt_co4 env _sym rep r (NthCo _r n co) | Just (ty, _) <- isReflCo_maybe co , n == 0 - , Just (tv, _) <- splitForAllTy_maybe ty + , Just (tv, _) <- splitForAllTyCoVar_maybe ty -- works for both tyvar and covar = liftCoSubst (chooseRole rep r) env (varType tv) @@ -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. - | Just (tv1, ty1) <- splitForAllTy_ty_maybe oty1 - , Just (tv2, ty2) <- splitForAllTy_ty_maybe oty2 + | Just (tv1, ty1) <- splitForAllTyVar_maybe oty1 + , Just (tv2, ty2) <- splitForAllTyVar_maybe oty2 -- NB: prov isn't interesting here either = let k1 = tyVarKind tv1 k2 = tyVarKind tv2 @@ -544,8 +544,8 @@ opt_univ env sym prov role oty1 oty2 in mkForAllCo tv1' eta' (opt_univ env' sym prov' role ty1 ty2') - | Just (cv1, ty1) <- splitForAllTy_co_maybe oty1 - , Just (cv2, ty2) <- splitForAllTy_co_maybe oty2 + | Just (cv1, ty1) <- splitForAllCoVar_maybe oty1 + , Just (cv2, ty2) <- splitForAllCoVar_maybe oty2 -- NB: prov isn't interesting here either = let k1 = varType cv1 k2 = varType cv2 @@ -1121,7 +1121,7 @@ etaForAllCo_ty_maybe co = Just (tv, kind_co, r) | Pair ty1 ty2 <- coercionKind co - , Just (tv1, _) <- splitForAllTy_ty_maybe ty1 + , Just (tv1, _) <- splitForAllTyVar_maybe ty1 , isForAllTy_ty ty2 , let kind_co = mkNthCo Nominal 0 co = Just ( tv1, kind_co @@ -1137,7 +1137,7 @@ etaForAllCo_co_maybe co = Just (cv, kind_co, r) | Pair ty1 ty2 <- coercionKind co - , Just (cv1, _) <- splitForAllTy_co_maybe ty1 + , Just (cv1, _) <- splitForAllCoVar_maybe ty1 , isForAllTy_co ty2 = let kind_co = mkNthCo Nominal 0 co r = coVarRole cv1 diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs index a61b788dc9..4dc3ec0abe 100644 --- a/compiler/GHC/Core/Lint.hs +++ b/compiler/GHC/Core/Lint.hs @@ -1240,7 +1240,7 @@ checkCaseLinearity ue case_bndr var_w bndr = do ----------------- lintTyApp :: LintedType -> LintedType -> LintM LintedType 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 ; in_scope <- getInScope -- substTy needs the set of tyvars in scope to avoid generating @@ -2172,7 +2172,7 @@ lintCoercion co@(TransCo co1 co2) lintCoercion the_co@(NthCo r0 n co) = do { co' <- lintCoercion 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 _) -- works for both tyvar and covar | n == 0 @@ -2214,7 +2214,7 @@ lintCoercion (InstCo co 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 { (Just (tv1,_), Just (tv2,_)) | typeKind s1 `eqType` tyVarKind tv1 @@ -2223,7 +2223,7 @@ lintCoercion (InstCo co arg) | otherwise -> 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 { (Just (cv1, _), Just (cv2, _)) | typeKind s1 `eqType` varType cv1 diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs index 03a8052328..fed664d6fb 100644 --- a/compiler/GHC/Core/Opt/Arity.hs +++ b/compiler/GHC/Core/Opt/Arity.hs @@ -145,7 +145,7 @@ typeArity ty = go initRecTc ty where go rec_nts ty - | Just (_, ty') <- splitForAllTy_maybe ty + | Just (_, ty') <- splitForAllTyCoVar_maybe ty = go rec_nts ty' | Just (_,arg,res) <- splitFunTy_maybe 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] ----------- Forall types (forall a. ty) - | Just (tcv,ty') <- splitForAllTy_maybe ty + | Just (tcv,ty') <- splitForAllTyCoVar_maybe ty , (subst', tcv') <- Type.substVarBndr subst tcv , let oss' | isTyVar tcv = oss | otherwise = oss1 @@ -1884,7 +1884,7 @@ etaBodyForJoinPoint need_args body go 0 _ _ rev_bs e = (reverse 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 = go (n-1) res_ty subst' (tv' : rev_bs) (e `App` varToCoreExpr tv') | Just (mult, arg_ty, res_ty) <- splitFunTy_maybe ty diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 52fd2bbf8e..e02a470d7e 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -1181,7 +1181,7 @@ unsafeEqualityProofRule = do { [Type rep, Type t1, Type t2] <- getArgs ; guard (t1 `eqType` t2) ; fn <- getFunction - ; let (_, ue) = splitForAllTys (idType fn) + ; let (_, ue) = splitForAllTyCoVars (idType fn) tc = tyConAppTyCon ue -- tycon: UnsafeEquality (dc:_) = tyConDataCons tc -- data con: UnsafeRefl -- UnsafeRefl :: forall (r :: RuntimeRep) (a :: TYPE r). diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs index bed5309232..6497abc091 100644 --- a/compiler/GHC/Core/Opt/Simplify/Utils.hs +++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs @@ -576,7 +576,7 @@ mkArgInfo env fun rules n_val_args call_cont add_type_strictness fun_ty 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 | Just (_, arg_ty, fun_ty') <- splitFunTy_maybe fun_ty -- Add strict-type info diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs index c613ac2ebd..4601407723 100644 --- a/compiler/GHC/Core/Opt/SpecConstr.hs +++ b/compiler/GHC/Core/Opt/SpecConstr.hs @@ -971,7 +971,7 @@ decreaseSpecCount env n_specs --------------------------------------------------- -- See Note [Forcing specialisation] 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 env = any (forceSpecArgTy env) . map scaledThing . fst . splitFunTys diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs index 490ca1a189..99f3147ba1 100644 --- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs +++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs @@ -434,7 +434,7 @@ mkWWargs subst fun_ty demands apply_or_bind_then work_fn_args (varToCoreExpr id), res_ty) } - | Just (tv, fun_ty') <- splitForAllTy_maybe fun_ty + | Just (tv, fun_ty') <- splitForAllTyCoVar_maybe fun_ty = do { uniq <- getUniqueM ; let (subst', tv') = cloneTyVarBndr subst tv uniq -- See Note [Freshen WW arguments] @@ -1026,7 +1026,7 @@ findTypeShape fam_envs ty | Just (tc, tc_args) <- splitTyConApp_maybe ty = go_tc rec_tc tc tc_args - | Just (_, ty') <- splitForAllTy_maybe ty + | Just (_, ty') <- splitForAllTyCoVar_maybe ty = go rec_tc ty' | otherwise diff --git a/compiler/GHC/Core/Predicate.hs b/compiler/GHC/Core/Predicate.hs index a19f129161..43f52b9b5c 100644 --- a/compiler/GHC/Core/Predicate.hs +++ b/compiler/GHC/Core/Predicate.hs @@ -69,7 +69,7 @@ classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of | Just clas <- tyConClass_maybe tc -> ClassPred clas tys - _ | (tvs, rho) <- splitForAllTys ev_ty + _ | (tvs, rho) <- splitForAllTyCoVars ev_ty , (theta, pred) <- splitFunTys rho , not (null tvs && null theta) -> ForAllPred tvs (map scaledThing theta) pred diff --git a/compiler/GHC/Core/TyCo/Ppr.hs b/compiler/GHC/Core/TyCo/Ppr.hs index 0a14150ed7..2929474d84 100644 --- a/compiler/GHC/Core/TyCo/Ppr.hs +++ b/compiler/GHC/Core/TyCo/Ppr.hs @@ -34,7 +34,7 @@ import {-# SOURCE #-} GHC.Core.DataCon ( dataConFullSig , dataConUserTyVarBinders, DataCon ) import GHC.Core.Type ( pickyIsLiftedTypeKind, pattern One, pattern Many, - splitForAllTysReq, splitForAllTysInvis ) + splitForAllReqTVBinders, splitForAllInvisTVBinders ) import GHC.Core.TyCon import GHC.Core.TyCo.Rep @@ -269,7 +269,7 @@ debug_ppr_ty _ (CoercionTy co) -- Invisible forall: forall {k} (a :: k). t debug_ppr_ty prec t - | (bndrs, body) <- splitForAllTysInvis t + | (bndrs, body) <- splitForAllInvisTVBinders t , not (null bndrs) = maybeParen prec funPrec $ sep [ text "forall" <+> fsep (map ppr_bndr bndrs) <> dot, @@ -282,7 +282,7 @@ debug_ppr_ty prec t -- Visible forall: forall x y -> t debug_ppr_ty prec t - | (bndrs, body) <- splitForAllTysReq t + | (bndrs, body) <- splitForAllReqTVBinders t , not (null bndrs) = maybeParen prec funPrec $ sep [ text "forall" <+> fsep (map ppr_bndr bndrs) <+> arrow, @@ -294,7 +294,7 @@ debug_ppr_ty prec t -- Impossible case: neither visible nor invisible forall. 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] diff --git a/compiler/GHC/Core/TyCo/Tidy.hs b/compiler/GHC/Core/TyCo/Tidy.hs index dd07a2775f..9a3103972c 100644 --- a/compiler/GHC/Core/TyCo/Tidy.hs +++ b/compiler/GHC/Core/TyCo/Tidy.hs @@ -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' } tidyType env (ty@(ForAllTy{})) = mkForAllTys' (zip tvs' vis) $! tidyType env' body_ty where - (tvs, vis, body_ty) = splitForAllTys' ty + (tvs, vis, body_ty) = splitForAllTyCoVars' ty (env', tvs') = tidyVarBndrs env tvs tidyType env (CastTy ty co) = (CastTy $! tidyType env ty) $! (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 -- how should they be named? mkForAllTys' :: [(TyCoVar, ArgFlag)] -> Type -> Type @@ -153,8 +153,8 @@ mkForAllTys' tvvs ty = foldr strictMkForAllTy ty tvvs where strictMkForAllTy (tv,vis) ty = (ForAllTy $! ((Bndr $! tv) $! vis)) $! ty -splitForAllTys' :: Type -> ([TyCoVar], [ArgFlag], Type) -splitForAllTys' ty = go ty [] [] +splitForAllTyCoVars' :: Type -> ([TyCoVar], [ArgFlag], Type) +splitForAllTyCoVars' ty = go ty [] [] where go (ForAllTy (Bndr tv vis) ty) tvs viss = go ty (tv:tvs) (vis:viss) go ty tvs viss = (reverse tvs, reverse viss, ty) diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index 8ae7812c07..bf5fe081d8 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -48,11 +48,11 @@ module GHC.Core.Type ( mkSpecForAllTy, mkSpecForAllTys, mkVisForAllTys, mkTyCoInvForAllTy, mkInfForAllTy, mkInfForAllTys, - splitForAllTys, - splitForAllTysReq, splitForAllTysInvis, - splitForAllVarBndrs, - splitForAllTy_maybe, splitForAllTy, - splitForAllTy_ty_maybe, splitForAllTy_co_maybe, + splitForAllTyCoVars, + splitForAllReqTVBinders, splitForAllInvisTVBinders, + splitForAllTyCoVarBinders, + splitForAllTyCoVar_maybe, splitForAllTyCoVar, + splitForAllTyVar_maybe, splitForAllCoVar_maybe, splitPiTy_maybe, splitPiTy, splitPiTys, mkTyConBindersPreferAnon, mkPiTy, mkPiTys, @@ -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. -- 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. -splitForAllTys :: Type -> ([TyCoVar], Type) -splitForAllTys ty = split ty ty [] +splitForAllTyCoVars :: Type -> ([TyCoVar], Type) +splitForAllTyCoVars ty = split ty ty [] where 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 @@ -1561,38 +1561,38 @@ splitForAllTys ty = split ty ty [] -- | Splits the longest initial sequence of ForAllTys' that satisfy -- @argf_pred@, returning the binders transformed by @argf_pred@ -splitSomeForAllTys :: (ArgFlag -> Maybe af) -> Type -> ([VarBndr TyCoVar af], Type) -splitSomeForAllTys argf_pred ty = split ty ty [] +splitSomeForAllTyCoVarBndrs :: (ArgFlag -> Maybe af) -> Type -> ([VarBndr TyCoVar af], Type) +splitSomeForAllTyCoVarBndrs argf_pred ty = split ty ty [] where split _ (ForAllTy (Bndr tcv argf) ty) 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 _ 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 '()'. -splitForAllTysReq :: Type -> ([ReqTVBinder], Type) -splitForAllTysReq ty = splitSomeForAllTys argf_pred ty +splitForAllReqTVBinders :: Type -> ([ReqTVBinder], Type) +splitForAllReqTVBinders ty = splitSomeForAllTyCoVarBndrs argf_pred ty where argf_pred :: ArgFlag -> Maybe () argf_pred Required = Just () 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 -- 'Specificity'. -splitForAllTysInvis :: Type -> ([InvisTVBinder], Type) -splitForAllTysInvis ty = splitSomeForAllTys argf_pred ty +splitForAllInvisTVBinders :: Type -> ([InvisTVBinder], Type) +splitForAllInvisTVBinders ty = splitSomeForAllTyCoVarBndrs argf_pred ty where argf_pred :: ArgFlag -> Maybe Specificity argf_pred Required = Nothing 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 -- result type returned may have free variables that were bound by a forall. -splitTyVarForAllTys :: Type -> ([TyVar], Type) -splitTyVarForAllTys ty = split ty ty [] +splitForAllTyVars :: Type -> ([TyVar], Type) +splitForAllTyVars ty = split ty ty [] where 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 @@ -1636,10 +1636,10 @@ isFunTy ty | otherwise = False -- | Take a forall type apart, or panics if that is not possible. -splitForAllTy :: Type -> (TyCoVar, Type) -splitForAllTy ty - | Just answer <- splitForAllTy_maybe ty = answer - | otherwise = pprPanic "splitForAllTy" (ppr ty) +splitForAllTyCoVar :: Type -> (TyCoVar, Type) +splitForAllTyCoVar ty + | Just answer <- splitForAllTyCoVar_maybe ty = answer + | otherwise = pprPanic "splitForAllTyCoVar" (ppr ty) -- | Drops all ForAllTys dropForAlls :: Type -> Type @@ -1651,23 +1651,23 @@ dropForAlls ty = go ty -- | Attempts to take a forall type apart, but only if it's a proper forall, -- with a named binder -splitForAllTy_maybe :: Type -> Maybe (TyCoVar, Type) -splitForAllTy_maybe ty +splitForAllTyCoVar_maybe :: Type -> Maybe (TyCoVar, Type) +splitForAllTyCoVar_maybe ty | ForAllTy (Bndr tv _) inner_ty <- coreFullView ty = Just (tv, inner_ty) | otherwise = Nothing --- | Like splitForAllTy_maybe, but only returns Just if it is a tyvar binder. -splitForAllTy_ty_maybe :: Type -> Maybe (TyCoVar, Type) -splitForAllTy_ty_maybe ty +-- | Like 'splitForAllTyCoVar_maybe', but only returns Just if it is a tyvar binder. +splitForAllTyVar_maybe :: Type -> Maybe (TyCoVar, Type) +splitForAllTyVar_maybe ty | ForAllTy (Bndr tv _) inner_ty <- coreFullView ty , isTyVar tv = Just (tv, inner_ty) | otherwise = Nothing --- | Like splitForAllTy_maybe, but only returns Just if it is a covar binder. -splitForAllTy_co_maybe :: Type -> Maybe (TyCoVar, Type) -splitForAllTy_co_maybe ty +-- | Like 'splitForAllTyCoVar_maybe', but only returns Just if it is a covar binder. +splitForAllCoVar_maybe :: Type -> Maybe (TyCoVar, Type) +splitForAllCoVar_maybe ty | ForAllTy (Bndr tv _) inner_ty <- coreFullView ty , isCoVar tv = Just (tv, inner_ty) @@ -1702,14 +1702,14 @@ splitPiTys ty = split ty ty [] split orig_ty _ bs = (reverse bs, orig_ty) -- | Like 'splitPiTys' but split off only /named/ binders --- and returns TyCoVarBinders rather than TyCoBinders -splitForAllVarBndrs :: Type -> ([TyCoVarBinder], Type) -splitForAllVarBndrs ty = split ty ty [] +-- and returns 'TyCoVarBinder's rather than 'TyCoBinder's +splitForAllTyCoVarBinders :: Type -> ([TyCoVarBinder], Type) +splitForAllTyCoVarBinders ty = split ty ty [] where split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs split _ (ForAllTy b res) bs = split res res (b:bs) split orig_ty _ bs = (reverse bs, orig_ty) -{-# INLINE splitForAllVarBndrs #-} +{-# INLINE splitForAllTyCoVarBinders #-} invisibleTyBndrCount :: Type -> Int -- Returns the number of leading invisible forall'd binders in the type @@ -2114,7 +2114,7 @@ isValidJoinPointType arity ty valid_under tvs arity ty | arity == 0 = tvs `disjointVarSet` tyCoVarsOfType ty - | Just (t, ty') <- splitForAllTy_maybe ty + | Just (t, ty') <- splitForAllTyCoVar_maybe ty = valid_under (tvs `extendVarSet` t) (arity-1) ty' | Just (_, _, res_ty) <- splitFunTy_maybe ty = valid_under tvs (arity-1) res_ty @@ -2497,7 +2497,7 @@ typeKind ty@(ForAllTy {}) Nothing -> pprPanic "typeKind" (ppr ty $$ ppr tvs $$ ppr body <+> dcolon <+> ppr body_kind) where - (tvs, body) = splitTyVarForAllTys ty + (tvs, body) = splitForAllTyVars ty body_kind = typeKind body --------------------------------------------- @@ -2542,7 +2542,7 @@ tcTypeKind ty@(ForAllTy {}) Nothing -> pprPanic "tcTypeKind" (ppr ty $$ ppr tvs $$ ppr body <+> dcolon <+> ppr body_kind) where - (tvs, body) = splitTyVarForAllTys ty + (tvs, body) = splitForAllTyVars ty body_kind = tcTypeKind body diff --git a/compiler/GHC/HsToCore/Foreign/Call.hs b/compiler/GHC/HsToCore/Foreign/Call.hs index 56ec46cd99..e580057b77 100644 --- a/compiler/GHC/HsToCore/Foreign/Call.hs +++ b/compiler/GHC/HsToCore/Foreign/Call.hs @@ -346,7 +346,7 @@ resultWrapper result_ty -- The type might contain foralls (eg. for dummy type arguments, -- referring to 'Ptr a' is legal). - | Just (tyvar, rest) <- splitForAllTy_maybe result_ty + | Just (tyvar, rest) <- splitForAllTyCoVar_maybe result_ty = do { (maybe_ty, wrapper) <- resultWrapper rest ; return (maybe_ty, \e -> Lam tyvar (wrapper e)) } diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs index e50db56eec..c7907682ae 100644 --- a/compiler/GHC/HsToCore/Foreign/Decl.hs +++ b/compiler/GHC/HsToCore/Foreign/Decl.hs @@ -212,7 +212,7 @@ dsFCall :: Id -> Coercion -> ForeignCall -> Maybe Header dsFCall fn_id co fcall mDeclHeader = do let ty = coercionLKind co - (tv_bndrs, rho) = tcSplitForAllVarBndrs ty + (tv_bndrs, rho) = tcSplitForAllTyVarBinders ty (arg_tys, io_res_ty) = tcSplitFunTys rho args <- newSysLocalsDs arg_tys -- no FFI levity-polymorphism @@ -316,7 +316,7 @@ dsPrimCall :: Id -> Coercion -> ForeignCall dsPrimCall fn_id co fcall = do let ty = coercionLKind co - (tvs, fun_ty) = tcSplitForAllTys ty + (tvs, fun_ty) = tcSplitForAllTyVars ty (arg_tys, io_res_ty) = tcSplitFunTys fun_ty args <- newSysLocalsDs arg_tys -- no FFI levity-polymorphism @@ -489,7 +489,7 @@ dsFExportDynamic id co0 cconv = do where ty = coercionLKind co0 - (tvs,sans_foralls) = tcSplitForAllTys ty + (tvs,sans_foralls) = tcSplitForAllTyVars ty ([Scaled arg_mult arg_ty], fn_res_ty) = tcSplitFunTys sans_foralls Just (io_tc, res_ty) = tcSplitIOType_maybe fn_res_ty -- Must have an IO type; hence Just diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs index 4c369e0bc4..f9ad42a3c9 100644 --- a/compiler/GHC/Iface/Make.hs +++ b/compiler/GHC/Iface/Make.hs @@ -656,7 +656,7 @@ classToIfaceDecl env clas -- op :: (?x :: String) => a -> a -- and class Baz a where -- op :: (Ord a) => a -> a - (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id) + (sel_tyvars, rho_ty) = splitForAllTyCoVars (idType sel_id) op_ty = funResultTy rho_ty toDmSpec :: (Name, DefMethSpec Type) -> DefMethSpec IfaceType diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs index 8de6a0d39d..ff2bb50fa9 100644 --- a/compiler/GHC/Runtime/Heap/Inspect.hs +++ b/compiler/GHC/Runtime/Heap/Inspect.hs @@ -1389,4 +1389,4 @@ quantifyType ty = ( filter isTyVar $ tyCoVarsOfTypeWellScoped rho , rho) where - (_tvs, rho) = tcSplitForAllTys ty + (_tvs, rho) = tcSplitForAllTyVars ty diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs index 5ae117bf55..32091e7836 100644 --- a/compiler/GHC/Tc/Errors/Hole.hs +++ b/compiler/GHC/Tc/Errors/Hole.hs @@ -467,7 +467,7 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (HoleFit {..}) = unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of Just (_, _, unfunned) -> unwrapTypeVars unfunned _ -> [] - where (vars, unforalled) = splitForAllVarBndrs t + where (vars, unforalled) = splitForAllTyCoVarBinders t holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) hfMatches holeDisp = if sMs then holeVs else sep $ replicate (length hfMatches) $ text "_" diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs index ab8c3c7247..eb5540c539 100644 --- a/compiler/GHC/Tc/Gen/App.hs +++ b/compiler/GHC/Tc/Gen/App.hs @@ -450,7 +450,7 @@ tcInstFun do_ql inst_final rn_fun fun_sigma rn_args -- Rule IALL from Fig 4 of the QL paper go1 delta acc so_far fun_ty args - | (tvs, body1) <- tcSplitSomeForAllTys (inst_fun args) fun_ty + | (tvs, body1) <- tcSplitSomeForAllTyVars (inst_fun args) fun_ty , (theta, body2) <- tcSplitPhiTy body1 , not (null tvs && null theta) = do { (inst_tvs, wrap, fun_rho) <- setSrcSpanFromArgs rn_args $ @@ -556,7 +556,7 @@ tcVTA :: TcType -- Function type -- Deal with a visible type application -- The function type has already had its Inferred binders instantiated tcVTA fun_ty hs_ty - | Just (tvb, inner_ty) <- tcSplitForAllTy_maybe fun_ty + | Just (tvb, inner_ty) <- tcSplitForAllTyVarBinder_maybe fun_ty , binderArgFlag tvb == Specified -- It really can't be Inferred, because we've just -- instantiated those. But, oddly, it might just be Required. @@ -969,11 +969,11 @@ findNoQuantVars fun_ty args go bvs fun_ty (EPrag {} : args) = go bvs fun_ty args go bvs fun_ty args@(ETypeArg {} : rest_args) - | (tvs, body1) <- tcSplitSomeForAllTys (== Inferred) fun_ty + | (tvs, body1) <- tcSplitSomeForAllTyVars (== Inferred) fun_ty , (theta, body2) <- tcSplitPhiTy body1 , not (null tvs && null theta) = go (bvs `extendVarSetList` tvs) body2 args - | Just (_tv, res_ty) <- tcSplitForAllTy_maybe fun_ty + | Just (_tv, res_ty) <- tcSplitForAllTyVarBinder_maybe fun_ty = go bvs res_ty rest_args | otherwise = False -- E.g. head ids @Int diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs index ed55e6c943..9818642d47 100644 --- a/compiler/GHC/Tc/Gen/Foreign.hs +++ b/compiler/GHC/Tc/Gen/Foreign.hs @@ -124,7 +124,7 @@ normaliseFfiType' env ty0 = go Representational initRecTc ty0 | Just (tc, tys) <- splitTyConApp_maybe ty = go_tc_app role rec_nts tc tys - | (bndrs, inner_ty) <- splitForAllVarBndrs ty + | (bndrs, inner_ty) <- splitForAllTyCoVarBinders ty , not (null bndrs) = do (coi, nty1, gres1) <- go role rec_nts inner_ty return ( mkHomoForAllCos (binderVars bndrs) coi diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs index 685a1bc815..5e5ffd41ad 100644 --- a/compiler/GHC/Tc/Gen/HsType.hs +++ b/compiler/GHC/Tc/Gen/HsType.hs @@ -554,7 +554,7 @@ tcHsDeriv hs_ty = do { ty <- checkNoErrs $ -- Avoid redundant error report -- with "illegal deriving", below tcTopLHsType DerivClauseCtxt hs_ty - ; let (tvs, pred) = splitForAllTys ty + ; let (tvs, pred) = splitForAllTyCoVars ty (kind_args, _) = splitFunTys (tcTypeKind pred) ; case getClassPredTys_maybe pred of Just (cls, tys) -> return (tvs, cls, tys, map scaledThing kind_args) @@ -583,7 +583,7 @@ tcDerivStrategy mb_lds tc_deriv_strategy NewtypeStrategy = boring_case NewtypeStrategy tc_deriv_strategy (ViaStrategy ty) = do ty' <- checkNoErrs $ tcTopLHsType DerivClauseCtxt ty - let (via_tvs, via_pred) = splitForAllTys ty' + let (via_tvs, via_pred) = splitForAllTyCoVars ty' pure (ViaStrategy via_pred, via_tvs) boring_case :: ds -> TcM (ds, [TyVar]) diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index 98050b275b..ed248c09cc 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -2148,12 +2148,12 @@ reify_for_all :: TyCoRep.ArgFlag -> TyCoRep.Type -> TcM TH.Type -- Arg of reify_for_all is always ForAllTy or a predicate FunTy reify_for_all argf ty | isVisibleArgFlag argf - = do let (req_bndrs, phi) = tcSplitForAllTysReq ty + = do let (req_bndrs, phi) = tcSplitForAllReqTVBinders ty tvbndrs' <- reifyTyVarBndrs req_bndrs phi' <- reifyType phi pure $ TH.ForallVisT tvbndrs' phi' | otherwise - = do let (inv_bndrs, phi) = tcSplitForAllTysInvis ty + = do let (inv_bndrs, phi) = tcSplitForAllInvisTVBinders ty tvbndrs' <- reifyTyVarBndrs inv_bndrs let (cxt, tau) = tcSplitPhiTy phi cxt' <- reifyCxt cxt diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs index 09f90567db..01f18a7d6b 100644 --- a/compiler/GHC/Tc/Instance/Typeable.hs +++ b/compiler/GHC/Tc/Instance/Typeable.hs @@ -407,7 +407,7 @@ mkTyConRepBinds :: TypeableStuff -> TypeRepTodo -> TypeableTyCon -> KindRepM (LHsBinds GhcTc) mkTyConRepBinds stuff todo (TypeableTyCon {..}) = do -- Make a KindRep - let (bndrs, kind) = splitForAllVarBndrs (tyConKind tycon) + let (bndrs, kind) = splitForAllTyCoVarBinders (tyConKind tycon) liftTc $ traceTc "mkTyConKindRepBinds" (ppr tycon $$ ppr (tyConKind tycon) $$ ppr kind) let ctx = mkDeBruijnContext (map binderVar bndrs) diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs index 5bd83982f1..7068d3176d 100644 --- a/compiler/GHC/Tc/Solver/Canonical.hs +++ b/compiler/GHC/Tc/Solver/Canonical.hs @@ -549,7 +549,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) mk_given_desc sel_id sc_pred = (swizzled_pred, swizzled_evterm) where - (sc_tvs, sc_rho) = splitForAllTys sc_pred + (sc_tvs, sc_rho) = splitForAllTyCoVars sc_pred (sc_theta, sc_inner_pred) = splitFunTys sc_rho all_tvs = tvs `chkAppend` sc_tvs @@ -1147,8 +1147,8 @@ can_eq_nc_forall :: CtEvidence -> EqRel can_eq_nc_forall ev eq_rel s1 s2 | CtWanted { ctev_loc = loc, ctev_dest = orig_dest } <- ev = do { let free_tvs = tyCoVarsOfTypes [s1,s2] - (bndrs1, phi1) = tcSplitForAllVarBndrs s1 - (bndrs2, phi2) = tcSplitForAllVarBndrs s2 + (bndrs1, phi1) = tcSplitForAllTyVarBinders s1 + (bndrs2, phi2) = tcSplitForAllTyVarBinders s2 ; if not (equalLength bndrs1 bndrs2) then do { traceTcS "Forall failure" $ vcat [ ppr s1, ppr s2, ppr bndrs1, ppr bndrs2 diff --git a/compiler/GHC/Tc/Solver/Flatten.hs b/compiler/GHC/Tc/Solver/Flatten.hs index 48b9c55588..22c92cff80 100644 --- a/compiler/GHC/Tc/Solver/Flatten.hs +++ b/compiler/GHC/Tc/Solver/Flatten.hs @@ -1196,7 +1196,7 @@ flatten_one ty@(ForAllTy {}) -- We allow for-alls when, but only when, no type function -- applications inside the forall involve the bound type variables. - = do { let (bndrs, rho) = tcSplitForAllVarBndrs ty + = do { let (bndrs, rho) = tcSplitForAllTyVarBinders ty tvs = binderVars bndrs ; (rho', co) <- setMode FM_SubstOnly $ flatten_one rho -- Substitute only under a forall diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs index 2c52a89248..5ff7308f80 100644 --- a/compiler/GHC/Tc/TyCl/Instance.hs +++ b/compiler/GHC/Tc/TyCl/Instance.hs @@ -496,7 +496,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds -- See Note [Associated data family instances and di_scoped_tvs]. tv_skol_env = mkVarEnv $ map swap tv_skol_prs n_inferred = countWhile ((== Inferred) . binderArgFlag) $ - fst $ splitForAllVarBndrs dfun_ty + fst $ splitForAllTyCoVarBinders dfun_ty visible_skol_tvs = drop n_inferred skol_tvs ; traceTc "tcLocalInstDecl 1" (ppr dfun_ty $$ ppr (invisibleTyBndrCount dfun_ty) $$ ppr skol_tvs) @@ -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) = tcSplitForAllTys sig_kind + ; let (tvs, inner_kind) = tcSplitForAllTyVars 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 ecdc4ae624..de114c3817 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 tcSplitForAllTys ty of { (tvs, rho) -> - case splitFunTys rho of { (theta, pred) -> + case tcSplitForAllTyVars 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 c2140f7deb..9bb0675f6c 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) = tcSplitForAllTys (idType id) + (tyvars, rho) = tcSplitForAllTyVars (idType id) (theta, tau) = tcSplitPhiTy rho tcInstTypeBndrs :: Id -> TcM ([(Name, InvisTVBinder)], TcThetaType, TcType) @@ -480,7 +480,7 @@ tcInstTypeBndrs id subst' = extendTCvInScopeSet subst (tyCoVarsOfType rho) ; return (tv_prs, substTheta subst' theta, substTy subst' tau) } where - (tyvars, rho) = splitForAllTysInvis (idType id) + (tyvars, rho) = splitForAllInvisTVBinders (idType id) (theta, tau) = tcSplitPhiTy rho inst_invis_bndr :: TCvSubst -> InvisTVBinder diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index 83256c9c8c..f355a016ae 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -59,10 +59,10 @@ module GHC.Tc.Utils.TcType ( -- Splitters -- These are important because they do not look through newtypes getTyVar, - tcSplitForAllTy_maybe, - tcSplitForAllTys, tcSplitSomeForAllTys, - tcSplitForAllTysReq, tcSplitForAllTysInvis, - tcSplitPiTys, tcSplitPiTy_maybe, tcSplitForAllVarBndrs, + tcSplitForAllTyVarBinder_maybe, + tcSplitForAllTyVars, tcSplitSomeForAllTyVars, + tcSplitForAllReqTVBinders, tcSplitForAllInvisTVBinders, + tcSplitPiTys, tcSplitPiTy_maybe, tcSplitForAllTyVarBinders, tcSplitPhiTy, tcSplitPredFunTy_maybe, tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcFunResultTyN, tcSplitFunTysN, @@ -1217,24 +1217,24 @@ tcSplitPiTy_maybe ty isMaybeTyBinder (Just (t,_)) = isTyBinder t isMaybeTyBinder _ = True -tcSplitForAllTy_maybe :: Type -> Maybe (TyVarBinder, Type) -tcSplitForAllTy_maybe ty | Just ty' <- tcView ty = tcSplitForAllTy_maybe ty' -tcSplitForAllTy_maybe (ForAllTy tv ty) = ASSERT( isTyVarBinder tv ) Just (tv, ty) -tcSplitForAllTy_maybe _ = Nothing +tcSplitForAllTyVarBinder_maybe :: Type -> Maybe (TyVarBinder, Type) +tcSplitForAllTyVarBinder_maybe ty | Just ty' <- tcView ty = tcSplitForAllTyVarBinder_maybe ty' +tcSplitForAllTyVarBinder_maybe (ForAllTy tv ty) = ASSERT( isTyVarBinder tv ) Just (tv, ty) +tcSplitForAllTyVarBinder_maybe _ = Nothing -- | Like 'tcSplitPiTys', but splits off only named binders, -- returning just the tycovars. -tcSplitForAllTys :: Type -> ([TyVar], Type) -tcSplitForAllTys ty +tcSplitForAllTyVars :: Type -> ([TyVar], Type) +tcSplitForAllTyVars ty = ASSERT( all isTyVar (fst sty) ) sty - where sty = splitForAllTys ty + where sty = splitForAllTyCoVars ty --- | Like 'tcSplitForAllTys', but only splits a 'ForAllTy' if @argf_pred argf@ +-- | 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 -- function. -tcSplitSomeForAllTys :: (ArgFlag -> Bool) -> Type -> ([TyVar], Type) -tcSplitSomeForAllTys argf_pred ty +tcSplitSomeForAllTyVars :: (ArgFlag -> Bool) -> Type -> ([TyVar], Type) +tcSplitSomeForAllTyVars argf_pred ty = split ty ty [] where split _ (ForAllTy (Bndr tv argf) ty) tvs @@ -1242,22 +1242,22 @@ tcSplitSomeForAllTys argf_pred ty split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs split orig_ty _ tvs = (reverse tvs, orig_ty) --- | Like 'tcSplitForAllTys', but only splits 'ForAllTy's with 'Required' type +-- | Like 'tcSplitForAllTyVars', but only splits 'ForAllTy's with 'Required' type -- variable binders. All split tyvars are annotated with '()'. -tcSplitForAllTysReq :: Type -> ([TcReqTVBinder], Type) -tcSplitForAllTysReq ty = ASSERT( all (isTyVar . binderVar) (fst sty) ) sty - where sty = splitForAllTysReq ty +tcSplitForAllReqTVBinders :: Type -> ([TcReqTVBinder], Type) +tcSplitForAllReqTVBinders ty = ASSERT( all (isTyVar . binderVar) (fst sty) ) sty + where sty = splitForAllReqTVBinders ty --- | Like 'tcSplitForAllTys', but only splits 'ForAllTy's with 'Invisible' type +-- | Like 'tcSplitForAllTyVars', but only splits 'ForAllTy's with 'Invisible' type -- variable binders. All split tyvars are annotated with their 'Specificity'. -tcSplitForAllTysInvis :: Type -> ([TcInvisTVBinder], Type) -tcSplitForAllTysInvis ty = ASSERT( all (isTyVar . binderVar) (fst sty) ) sty - where sty = splitForAllTysInvis ty +tcSplitForAllInvisTVBinders :: Type -> ([TcInvisTVBinder], Type) +tcSplitForAllInvisTVBinders ty = ASSERT( all (isTyVar . binderVar) (fst sty) ) sty + where sty = splitForAllInvisTVBinders ty --- | Like 'tcSplitForAllTys', but splits off only named binders. -tcSplitForAllVarBndrs :: Type -> ([TyVarBinder], Type) -tcSplitForAllVarBndrs ty = ASSERT( all isTyVarBinder (fst sty)) sty - where sty = splitForAllVarBndrs ty +-- | Like 'tcSplitForAllTyVars', but splits off only named binders. +tcSplitForAllTyVarBinders :: Type -> ([TyVarBinder], Type) +tcSplitForAllTyVarBinders ty = ASSERT( all isTyVarBinder (fst sty)) sty + where sty = splitForAllTyCoVarBinders ty -- | Is this a ForAllTy with a named binder? tcIsForAllTy :: Type -> Bool @@ -1286,7 +1286,7 @@ tcSplitPhiTy ty -- | Split a sigma type into its parts. tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type) -tcSplitSigmaTy ty = case tcSplitForAllTys ty of +tcSplitSigmaTy ty = case tcSplitForAllTyVars ty of (tvs, rho) -> case tcSplitPhiTy rho of (theta, tau) -> (tvs, theta, tau) @@ -1469,9 +1469,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 tcSplitForAllTys ty of { (tvs, rho) -> - case splitFunTys rho of { (theta, tau) -> - case tcSplitDFunHead tau of { (clas, tys) -> + = case tcSplitForAllTyVars 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 +1489,7 @@ tcSplitMethodTy :: Type -> ([TyVar], PredType, Type) -- tcSplitMethodTy just peels off the outer forall and -- that first predicate tcSplitMethodTy ty - | (sel_tyvars,sel_rho) <- tcSplitForAllTys ty + | (sel_tyvars,sel_rho) <- tcSplitForAllTyVars 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 68ef82785d..87be216d9b 100644 --- a/compiler/GHC/Tc/Validity.hs +++ b/compiler/GHC/Tc/Validity.hs @@ -254,11 +254,11 @@ checkUserTypeError :: Type -> TcM () checkUserTypeError = check where check ty - | Just msg <- userTypeError_maybe ty = fail_with msg - | Just (_,ts) <- splitTyConApp_maybe ty = mapM_ check ts - | Just (t1,t2) <- splitAppTy_maybe ty = check t1 >> check t2 - | Just (_,t1) <- splitForAllTy_maybe ty = check t1 - | otherwise = return () + | Just msg <- userTypeError_maybe ty = fail_with msg + | Just (_,ts) <- splitTyConApp_maybe ty = mapM_ check ts + | Just (t1,t2) <- splitAppTy_maybe ty = check t1 >> check t2 + | Just (_,t1) <- splitForAllTyCoVar_maybe ty = check t1 + | otherwise = return () fail_with msg = do { env0 <- tcInitTidyEnv ; let (env1, tidy_msg) = tidyOpenType env0 msg @@ -751,7 +751,7 @@ check_type ve@(ValidityEnv{ ve_tidy_env = env, ve_ctxt = ctxt ; checkEscapingKind env' tvbs' theta tau } where - (tvbs, phi) = tcSplitForAllVarBndrs ty + (tvbs, phi) = tcSplitForAllTyVarBinders ty (theta, tau) = tcSplitPhiTy phi (env', tvbs') = tidyTyCoVarBinders env tvbs @@ -1056,7 +1056,7 @@ case, but this can lead to bugs. Imagine you have this scenario (from #15954): If the rank-n case came first, then in the process of checking for `forall`s or contexts, we would expand away `B A` to `forall x. x -> x`. This is because the functions that split apart `forall`s/contexts -(tcSplitForAllVarBndrs/tcSplitPhiTy) expand type synonyms! If `B A` is expanded +(tcSplitForAllTyVarBinders/tcSplitPhiTy) expand type synonyms! If `B A` is expanded away to `forall x. x -> x` before the actually validity checks occur, we will have completely obfuscated the fact that we had an unsaturated application of the `A` type synonym. diff --git a/compiler/GHC/Types/Var.hs b/compiler/GHC/Types/Var.hs index 2758ae2ded..397bc7ed77 100644 --- a/compiler/GHC/Types/Var.hs +++ b/compiler/GHC/Types/Var.hs @@ -610,11 +610,11 @@ Currently there are nine different uses of 'VarBndr': * Var.InvisTVBinder = VarBndr TyVar Specificity Specialised form of TyVarBinder, when ArgFlag = Invisible s - See GHC.Core.Type.splitForAllTysInvis + See GHC.Core.Type.splitForAllInvisTVBinders * Var.ReqTVBinder = VarBndr TyVar () Specialised form of TyVarBinder, when ArgFlag = Required - See GHC.Core.Type.splitForAllTysReq + See GHC.Core.Type.splitForAllReqTVBinders This one is barely used * TyCon.TyConBinder = VarBndr TyVar TyConBndrVis |