[commit: ghc] master: Export injectiveVarsOf{Binder, Type} from TyCoRep (de8752e)
git at git.haskell.org
git at git.haskell.org
Thu Oct 19 14:26:31 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/de8752e40bfdb05727c723abf97bdf158b5d9392/ghc
>---------------------------------------------------------------
commit de8752e40bfdb05727c723abf97bdf158b5d9392
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date: Thu Oct 19 10:21:33 2017 -0400
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
>---------------------------------------------------------------
de8752e40bfdb05727c723abf97bdf158b5d9392
compiler/typecheck/TcSplice.hs | 29 -----------------------------
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 04adbc3..45e18e6 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 5e32bb1..55b9e1c 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
More information about the ghc-commits
mailing list