diff options
Diffstat (limited to 'compiler/GHC/Core/Type.hs')
| -rw-r--r-- | compiler/GHC/Core/Type.hs | 53 |
1 files changed, 41 insertions, 12 deletions
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index 57e570cd79..a183308526 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -15,7 +15,7 @@ module GHC.Core.Type ( -- $type_classification -- $representation_types - TyThing(..), Type, ArgFlag(..), AnonArgFlag(..), ForallVisFlag(..), + TyThing(..), Type, ArgFlag(..), AnonArgFlag(..), Specificity(..), KindOrType, PredType, ThetaType, Var, TyVar, isTyVar, TyCoVar, TyCoBinder, TyCoVarBinder, TyVarBinder, @@ -44,7 +44,8 @@ module GHC.Core.Type ( mkSpecForAllTy, mkSpecForAllTys, mkVisForAllTys, mkTyCoInvForAllTy, mkInfForAllTy, mkInfForAllTys, - splitForAllTys, splitForAllTysSameVis, + splitForAllTys, splitSomeForAllTys, + splitForAllTysReq, splitForAllTysInvis, splitForAllVarBndrs, splitForAllTy_maybe, splitForAllTy, splitForAllTy_ty_maybe, splitForAllTy_co_maybe, @@ -271,7 +272,7 @@ import GHC.Data.List.SetOps import GHC.Types.Unique ( nonDetCmpUnique ) import GHC.Data.Maybe ( orElse ) -import Data.Maybe ( isJust ) +import Data.Maybe ( isJust, mapMaybe ) import Control.Monad ( guard ) -- $type_classification @@ -1576,19 +1577,47 @@ splitForAllTys ty = split ty ty [] split _ (ForAllTy (Bndr tv _) ty) tvs = split ty ty (tv:tvs) split orig_ty _ tvs = (reverse tvs, orig_ty) --- | Like 'splitForAllTys', but only splits a 'ForAllTy' if --- @'sameVis' argf supplied_argf@ is 'True', where @argf@ is the visibility --- of the @ForAllTy@'s binder and @supplied_argf@ is the visibility provided --- as an argument to this function. --- Furthermore, each returned tyvar is annotated with its argf. -splitForAllTysSameVis :: ArgFlag -> Type -> ([TyCoVarBinder], Type) -splitForAllTysSameVis supplied_argf ty = split ty ty [] +-- | Like 'splitForAllTys', 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. Furthermore, each returned tyvar is annotated with its @argf@. +splitSomeForAllTys :: (ArgFlag -> Bool) -> Type -> ([TyCoVarBinder], Type) +splitSomeForAllTys argf_pred ty = split ty ty [] where split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs - split _ (ForAllTy (Bndr tv argf) ty) tvs - | argf `sameVis` supplied_argf = split ty ty ((Bndr tv argf):tvs) + split _ (ForAllTy tvb@(Bndr _ argf) ty) tvs + | argf_pred argf = split ty ty (tvb:tvs) split orig_ty _ tvs = (reverse tvs, orig_ty) +-- | Like 'splitForAllTys', but only splits 'ForAllTy's with 'Required' type +-- variable binders. Furthermore, each returned tyvar is annotated with '()'. +splitForAllTysReq :: Type -> ([ReqTVBinder], Type) +splitForAllTysReq ty = + let (all_bndrs, body) = splitSomeForAllTys isVisibleArgFlag ty + req_bndrs = mapMaybe mk_req_bndr_maybe all_bndrs in + ASSERT( req_bndrs `equalLength` all_bndrs ) + (req_bndrs, body) + where + mk_req_bndr_maybe :: TyCoVarBinder -> Maybe ReqTVBinder + mk_req_bndr_maybe (Bndr tv argf) = case argf of + Required -> Just $ Bndr tv () + Invisible _ -> Nothing + +-- | Like 'splitForAllTys', 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 = + let (all_bndrs, body) = splitSomeForAllTys isInvisibleArgFlag ty + inv_bndrs = mapMaybe mk_inv_bndr_maybe all_bndrs in + ASSERT( inv_bndrs `equalLength` all_bndrs ) + (inv_bndrs, body) + where + mk_inv_bndr_maybe :: TyCoVarBinder -> Maybe InvisTVBinder + mk_inv_bndr_maybe (Bndr tv argf) = case argf of + Invisible s -> Just $ Bndr tv s + Required -> Nothing + -- | Like splitForAllTys, 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. |