[Git][ghc/ghc][wip/T16806] Use disjoint for closureGrowth

[Simon Jakobi]

Simon Jakobi pushed to branch wip/T16806 at Glasgow Haskell Compiler / GHC


Commits:
1cbda2e3 by Simon Jakobi at 2020-03-30T23:23:27+02:00
Use disjoint for closureGrowth

- - - - -


3 changed files:

- compiler/GHC/Stg/Lift/Analysis.hs
- compiler/GHC/Types/Unique/DSet.hs
- compiler/GHC/Types/Var/Set.hs


Changes:

=====================================
compiler/GHC/Stg/Lift/Analysis.hs
=====================================
@@ -533,7 +533,7 @@ closureGrowth expander sizer group abs_ids = go
     go (ClosureSk _ clo_fvs rhs)
       -- If no binder of the @group@ occurs free in the closure, the lifting
       -- won't have any effect on it and we can omit the recursive call.
-      | n_occs == 0 = 0
+      | dVarSetDisjointVarSet clo_fvs' group = 0
       -- Otherwise, we account the cost of allocating the closure and add it to
       -- the closure growth of its RHS.
       | otherwise   = mkIntWithInf cost + go rhs
@@ -545,7 +545,7 @@ closureGrowth expander sizer group abs_ids = go
         -- we lift @f@
         newbies = abs_ids `minusDVarSet` clo_fvs'
         -- Lifting @f@ removes @f@ from the closure but adds all @newbies@
-        cost = foldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs
+        cost = foldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs -- TODO: Do we  really want a right fold here? Also: no need to do this in deterministic order!
     go (RhsSk body_dmd body)
       -- The conservative assumption would be that
       --   1. Every RHS with positive growth would be called multiple times,


=====================================
compiler/GHC/Types/Unique/DSet.hs
=====================================
@@ -26,6 +26,7 @@ module GHC.Types.Unique.DSet (
         unionUniqDSets, unionManyUniqDSets,
         minusUniqDSet, uniqDSetMinusUniqSet,
         intersectUniqDSets, uniqDSetIntersectUniqSet,
+        uniqDSetDisjointUniqSet,
         foldUniqDSet,
         elementOfUniqDSet,
         filterUniqDSet,
@@ -98,6 +99,10 @@ uniqDSetIntersectUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a
 uniqDSetIntersectUniqSet xs ys
   = UniqDSet (udfmIntersectUFM (getUniqDSet xs) (getUniqSet ys))
 
+uniqDSetDisjointUniqSet :: UniqDSet a -> UniqSet b -> Bool
+uniqDSetDisjointUniqSet xs ys
+  = disjointUdfmUfm (getUniqDSet xs) (getUniqSet ys)
+
 foldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b
 foldUniqDSet c n (UniqDSet s) = foldUDFM c n s
 


=====================================
compiler/GHC/Types/Var/Set.hs
=====================================
@@ -34,7 +34,7 @@ module GHC.Types.Var.Set (
         elemDVarSet, dVarSetElems, subDVarSet,
         unionDVarSet, unionDVarSets, mapUnionDVarSet,
         intersectDVarSet, dVarSetIntersectVarSet,
-        intersectsDVarSet, disjointDVarSet,
+        intersectsDVarSet, disjointDVarSet, dVarSetDisjointVarSet,
         isEmptyDVarSet, delDVarSet, delDVarSetList,
         minusDVarSet, foldDVarSet, filterDVarSet, mapDVarSet,
         dVarSetMinusVarSet, anyDVarSet, allDVarSet,
@@ -274,6 +274,9 @@ dVarSetIntersectVarSet = uniqDSetIntersectUniqSet
 disjointDVarSet :: DVarSet -> DVarSet -> Bool
 disjointDVarSet s1 s2 = disjointUDFM (getUniqDSet s1) (getUniqDSet s2)
 
+dVarSetDisjointVarSet :: DVarSet -> VarSet -> Bool
+dVarSetDisjointVarSet = uniqDSetDisjointUniqSet
+
 -- | True if non-empty intersection
 intersectsDVarSet :: DVarSet -> DVarSet -> Bool
 intersectsDVarSet s1 s2 = not (s1 `disjointDVarSet` s2)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cbda2e3d6f14769602cdd1bc63276afc3e27ac6

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cbda2e3d6f14769602cdd1bc63276afc3e27ac6
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200330/9b68f371/attachment-0001.html>