[commit: ghc] wip/T14880-just-tvs: Implement tyCoVarsOfCo(s) in terms of VarSet (649f852)

git at git.haskell.org git at git.haskell.org
Thu Aug 2 09:05:26 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T14880-just-tvs
Link       : http://ghc.haskell.org/trac/ghc/changeset/649f8523170ef33d855e24f39b1b1248f6de9d49/ghc

>---------------------------------------------------------------

commit 649f8523170ef33d855e24f39b1b1248f6de9d49
Author: Tobias Dammers <tdammers at gmail.com>
Date:   Wed Aug 1 11:59:52 2018 +0200

    Implement tyCoVarsOfCo(s) in terms of VarSet


>---------------------------------------------------------------

649f8523170ef33d855e24f39b1b1248f6de9d49
 compiler/types/TyCoRep.hs | 45 +++++++++++++++++++++++++++++++++++++++------
 1 file changed, 39 insertions(+), 6 deletions(-)

diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index 2fdf172..3d68f2a 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -1543,14 +1543,15 @@ tyCoFVsBndr (TvBndr tv _) fvs = (delFV tv fvs)
 -- synonym.
 tyCoVarsOfTypes :: [Type] -> TyCoVarSet
 -- See Note [Free variables of types]
-tyCoVarsOfTypes tys = fvVarSet $ tyCoFVsOfTypes tys
+-- tyCoVarsOfTypes tys = fvVarSet $ tyCoFVsOfTypes tys
+tyCoVarsOfTypes tys = mapUnionVarSet tyCoVarsOfType tys
 
 -- | Returns free variables of types, including kind variables as
 -- a non-deterministic set. For type synonyms it does /not/ expand the
 -- synonym.
 tyCoVarsOfTypesSet :: TyVarEnv Type -> TyCoVarSet
 -- See Note [Free variables of types]
-tyCoVarsOfTypesSet tys = fvVarSet $ tyCoFVsOfTypes $ nonDetEltsUFM tys
+tyCoVarsOfTypesSet tys = tyCoVarsOfTypes $ nonDetEltsUFM tys
   -- It's OK to use nonDetEltsUFM here because we immediately forget the
   -- ordering by returning a set
 
@@ -1575,8 +1576,38 @@ tyCoFVsOfTypes []       fv_cand in_scope acc = emptyFV fv_cand in_scope acc
 
 tyCoVarsOfCo :: Coercion -> TyCoVarSet
 -- See Note [Free variables of types]
-tyCoVarsOfCo co = fvVarSet $ tyCoFVsOfCo co
-
+-- tyCoVarsOfCo co = fvVarSet $ tyCoFVsOfCo co
+tyCoVarsOfCo (Refl _ ty)         = tyCoVarsOfType ty
+tyCoVarsOfCo (TyConAppCo _ _ cos) = tyCoVarsOfCos cos
+tyCoVarsOfCo (AppCo co arg)
+  = (tyCoVarsOfCo co `unionVarSet` tyCoVarsOfCo arg)
+tyCoVarsOfCo (ForAllCo tv kind_co co)
+  = (delVarSet (tyCoVarsOfCo co) tv `unionVarSet` tyCoVarsOfCo kind_co)
+tyCoVarsOfCo (FunCo _ co1 co2)
+  = (tyCoVarsOfCo co1 `unionVarSet` tyCoVarsOfCo co2)
+tyCoVarsOfCo (CoVarCo v)
+  = tyCoVarsOfCoVar v
+tyCoVarsOfCo (HoleCo h)
+  = tyCoVarsOfCoVar (coHoleCoVar h)
+    -- See Note [CoercionHoles and coercion free variables]
+tyCoVarsOfCo (AxiomInstCo _ _ cos) = tyCoVarsOfCos cos
+tyCoVarsOfCo (UnivCo p _ t1 t2)
+  = (tyCoVarsOfProv p `unionVarSet` tyCoVarsOfType t1
+                     `unionVarSet` tyCoVarsOfType t2)
+tyCoVarsOfCo (SymCo co)          = tyCoVarsOfCo co
+tyCoVarsOfCo (TransCo co1 co2)   = (tyCoVarsOfCo co1 `unionVarSet` tyCoVarsOfCo co2)
+tyCoVarsOfCo (NthCo _ _ co)      = tyCoVarsOfCo co
+tyCoVarsOfCo (LRCo _ co)         = tyCoVarsOfCo co
+tyCoVarsOfCo (InstCo co arg)     = (tyCoVarsOfCo co `unionVarSet` tyCoVarsOfCo arg)
+tyCoVarsOfCo (CoherenceCo c1 c2) = (tyCoVarsOfCo c1 `unionVarSet` tyCoVarsOfCo c2)
+tyCoVarsOfCo (KindCo co)         = tyCoVarsOfCo co
+tyCoVarsOfCo (SubCo co)          = tyCoVarsOfCo co
+tyCoVarsOfCo (AxiomRuleCo _ cs)  = tyCoVarsOfCos cs
+
+tyCoVarsOfCoVar :: CoVar -> VarSet
+tyCoVarsOfCoVar v
+  = (unitVarSet v `unionVarSet` tyCoVarsOfType (varType v))
+--
 -- | Get a deterministic set of the vars free in a coercion
 tyCoVarsOfCoDSet :: Coercion -> DTyCoVarSet
 -- See Note [Free variables of types]
@@ -1630,10 +1661,12 @@ tyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand
 tyCoFVsOfProv (PluginProv _)      fv_cand in_scope acc = emptyFV fv_cand in_scope acc
 
 tyCoVarsOfCos :: [Coercion] -> TyCoVarSet
-tyCoVarsOfCos cos = fvVarSet $ tyCoFVsOfCos cos
+-- tyCoVarsOfCos cos = fvVarSet $ tyCoFVsOfCos cos
+tyCoVarsOfCos cos = mapUnionVarSet tyCoVarsOfCo cos
 
 tyCoVarsOfCosSet :: CoVarEnv Coercion -> TyCoVarSet
-tyCoVarsOfCosSet cos = fvVarSet $ tyCoFVsOfCos $ nonDetEltsUFM cos
+-- tyCoVarsOfCosSet cos = fvVarSet $ tyCoFVsOfCos $ nonDetEltsUFM cos
+tyCoVarsOfCosSet cos = tyCoVarsOfCos $ nonDetEltsUFM cos
   -- It's OK to use nonDetEltsUFM here because we immediately forget the
   -- ordering by returning a set
 



More information about the ghc-commits mailing list