[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