[commit: ghc] wip/T14880-2-step2: Avoid going through FV when closing over kinds (#14880) (17732b4)

git at git.haskell.org git at git.haskell.org
Wed Sep 12 20:48:28 UTC 2018


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

On branch  : wip/T14880-2-step2
Link       : http://ghc.haskell.org/trac/ghc/changeset/17732b472bebbe0341f6992dce6bd259e176725c/ghc

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

commit 17732b472bebbe0341f6992dce6bd259e176725c
Author: Tobias Dammers <tdammers at gmail.com>
Date:   Wed Sep 12 22:47:56 2018 +0200

    Avoid going through FV when closing over kinds (#14880)


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

17732b472bebbe0341f6992dce6bd259e176725c
 compiler/basicTypes/VarSet.hs | 8 +++++++-
 compiler/types/TyCoRep.hs     | 5 ++---
 2 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/compiler/basicTypes/VarSet.hs b/compiler/basicTypes/VarSet.hs
index ac3c545..1c82b38 100644
--- a/compiler/basicTypes/VarSet.hs
+++ b/compiler/basicTypes/VarSet.hs
@@ -13,7 +13,7 @@ module VarSet (
         emptyVarSet, unitVarSet, mkVarSet,
         extendVarSet, extendVarSetList,
         elemVarSet, subVarSet,
-        unionVarSet, unionVarSets, mapUnionVarSet,
+        unionVarSet, unionVarSets, mapUnionVarSet, mapUnionVarSetSet,
         intersectVarSet, intersectsVarSet, disjointVarSet,
         isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
         minusVarSet, filterVarSet, mapVarSet,
@@ -85,6 +85,9 @@ unionVarSets    :: [VarSet] -> VarSet
 mapUnionVarSet  :: (a -> VarSet) -> [a] -> VarSet
 -- ^ map the function over the list, and union the results
 
+mapUnionVarSetSet :: (Var -> VarSet) -> VarSet -> VarSet
+-- ^ map the function over the set, and union the results
+
 unitVarSet      :: Var -> VarSet
 extendVarSet    :: VarSet -> Var -> VarSet
 extendVarSetList:: VarSet -> [Var] -> VarSet
@@ -137,6 +140,9 @@ partitionVarSet = partitionUniqSet
 
 mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs
 
+mapUnionVarSetSet get_set =
+  nonDetFoldUniqSet (\var acc -> get_set var `unionVarSet` acc) emptyVarSet
+
 -- See comments with type signatures
 intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
 disjointVarSet   s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2)
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index d2cb070..2823280 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -1898,9 +1898,8 @@ coVarsOfCos = mapUnionVarSet coVarsOfCo
 -- | Add the kind variables free in the kinds of the tyvars in the given set.
 -- Returns a non-deterministic set.
 closeOverKinds :: TyVarSet -> TyVarSet
-closeOverKinds = fvVarSet . closeOverKindsFV . nonDetEltsUniqSet
-  -- It's OK to use nonDetEltsUniqSet here because we immediately forget
-  -- about the ordering by returning a set.
+closeOverKinds tvs =
+  mapUnionVarSetSet (tyCoVarsOfType . tyVarKind) tvs `unionVarSet` tvs
 
 -- | Given a list of tyvars returns a deterministic FV computation that
 -- returns the given tyvars with the kind variables free in the kinds of the



More information about the ghc-commits mailing list