summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2017-10-19 10:21:33 -0400
committerRyan Scott <ryan.gl.scott@gmail.com>2017-10-19 10:21:34 -0400
commitde8752e40bfdb05727c723abf97bdf158b5d9392 (patch)
tree4d26282aa3320df9b1cfcc9f40b534bcf53651e3
parent8846a7fdcf2060dd37e66b4d1f89bd8fdfad4620 (diff)
downloadhaskell-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.hs29
-rw-r--r--compiler/types/TyCoRep.hs36
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