diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-10-19 10:21:33 -0400 |
---|---|---|
committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-10-19 10:21:34 -0400 |
commit | de8752e40bfdb05727c723abf97bdf158b5d9392 (patch) | |
tree | 4d26282aa3320df9b1cfcc9f40b534bcf53651e3 | |
parent | 8846a7fdcf2060dd37e66b4d1f89bd8fdfad4620 (diff) | |
download | haskell-de8752e40bfdb05727c723abf97bdf158b5d9392.tar.gz |
Export injectiveVarsOf{Binder,Type} from TyCoRep
Summary:
I ended up needing to use the functionality of
`injectiveVarsOfBinder`/`injectiveVarsOfType` in this Haddock PR
(https://github.com/haskell/haddock/pull/681), but alas, neither of
these functions were exported. Let's do so.
Test Plan: Does it compile?
Reviewers: austin, goldfire, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie
Differential Revision: https://phabricator.haskell.org/D4107
-rw-r--r-- | compiler/typecheck/TcSplice.hs | 29 | ||||
-rw-r--r-- | compiler/types/TyCoRep.hs | 36 |
2 files changed, 36 insertions, 29 deletions
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 04adbc30e5..45e18e69fe 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -1912,35 +1912,6 @@ reify_tc_app tc tys in not (subVarSet result_vars dropped_vars) - injectiveVarsOfBinder :: TyConBinder -> FV - injectiveVarsOfBinder (TvBndr tv vis) = - case vis of - AnonTCB -> injectiveVarsOfType (tyVarKind tv) - NamedTCB Required -> FV.unitFV tv `unionFV` - injectiveVarsOfType (tyVarKind tv) - NamedTCB _ -> emptyFV - - injectiveVarsOfType :: Type -> FV - injectiveVarsOfType = go - where - go ty | Just ty' <- coreView ty - = go ty' - go (TyVarTy v) = FV.unitFV v `unionFV` go (tyVarKind v) - go (AppTy f a) = go f `unionFV` go a - go (FunTy ty1 ty2) = go ty1 `unionFV` go ty2 - go (TyConApp tc tys) = - case tyConInjectivityInfo tc of - NotInjective -> emptyFV - Injective inj -> mapUnionFV go $ - filterByList (inj ++ repeat True) tys - -- Oversaturated arguments to a tycon are - -- always injective, hence the repeat True - go (ForAllTy tvb ty) = tyCoFVsBndr tvb $ go (tyVarKind (binderVar tvb)) - `unionFV` go ty - go LitTy{} = emptyFV - go (CastTy ty _) = go ty - go CoercionTy{} = emptyFV - reifyPred :: TyCoRep.PredType -> TcM TH.Pred reifyPred ty -- We could reify the invisible parameter as a class but it seems diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 5e32bb12ba..55b9e1c8a2 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -79,6 +79,7 @@ module TyCoRep ( tyCoFVsOfCo, tyCoFVsOfCos, tyCoVarsOfCoList, tyCoVarsOfProv, closeOverKinds, + injectiveVarsOfBinder, injectiveVarsOfType, noFreeVarsOfType, noFreeVarsOfCo, @@ -1559,6 +1560,41 @@ closeOverKindsList tvs = fvVarList $ closeOverKindsFV tvs closeOverKindsDSet :: DTyVarSet -> DTyVarSet closeOverKindsDSet = fvDVarSet . closeOverKindsFV . dVarSetElems +-- | Returns the free variables of a 'TyConBinder' that are in injective +-- positions. (See @Note [Kind annotations on TyConApps]@ in "TcSplice" for an +-- explanation of what an injective position is.) +injectiveVarsOfBinder :: TyConBinder -> FV +injectiveVarsOfBinder (TvBndr tv vis) = + case vis of + AnonTCB -> injectiveVarsOfType (tyVarKind tv) + NamedTCB Required -> unitFV tv `unionFV` + injectiveVarsOfType (tyVarKind tv) + NamedTCB _ -> emptyFV + +-- | Returns the free variables of a 'Type' that are in injective positions. +-- (See @Note [Kind annotations on TyConApps]@ in "TcSplice" for an explanation +-- of what an injective position is.) +injectiveVarsOfType :: Type -> FV +injectiveVarsOfType = go + where + go ty | Just ty' <- coreView ty + = go ty' + go (TyVarTy v) = unitFV v `unionFV` go (tyVarKind v) + go (AppTy f a) = go f `unionFV` go a + go (FunTy ty1 ty2) = go ty1 `unionFV` go ty2 + go (TyConApp tc tys) = + case tyConInjectivityInfo tc of + NotInjective -> emptyFV + Injective inj -> mapUnionFV go $ + filterByList (inj ++ repeat True) tys + -- Oversaturated arguments to a tycon are + -- always injective, hence the repeat True + go (ForAllTy tvb ty) = tyCoFVsBndr tvb $ go (tyVarKind (binderVar tvb)) + `unionFV` go ty + go LitTy{} = emptyFV + go (CastTy ty _) = go ty + go CoercionTy{} = emptyFV + -- | Returns True if this type has no free variables. Should be the same as -- isEmptyVarSet . tyCoVarsOfType, but faster in the non-forall case. noFreeVarsOfType :: Type -> Bool |