[Git][ghc/ghc][master] 3 commits: Reg.Liveness: Strictness

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Jul 19 07:33:43 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00
Reg.Liveness: Strictness

- - - - -
c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00
Reg.Liveness: Don't repeatedly construct UniqSets

- - - - -
b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00
compiler/Types: Ensure that fromList-type operations can fuse

In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing
it to do so makes a considerable difference in allocations due to the
backend.

Metric Decrease:
    T12707
    T13379
    T3294
    T4801
    T5321FD
    T5321Fun
    T783

- - - - -


4 changed files:

- compiler/GHC/CmmToAsm/Reg/Liveness.hs
- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Unique/Set.hs


Changes:

=====================================
compiler/GHC/CmmToAsm/Reg/Liveness.hs
=====================================
@@ -1001,7 +1001,7 @@ livenessBack
 livenessBack _        liveregs _        done []  = (liveregs, done)
 
 livenessBack platform liveregs blockmap acc (instr : instrs)
- = let  (liveregs', instr')     = liveness1 platform liveregs blockmap instr
+ = let  !(!liveregs', instr')     = liveness1 platform liveregs blockmap instr
    in   livenessBack platform liveregs' blockmap (instr' : acc) instrs
 
 
@@ -1024,15 +1024,15 @@ liveness1 platform liveregs blockmap (LiveInstr instr _)
         = (liveregs1, LiveInstr instr
                         (Just $ Liveness
                         { liveBorn      = emptyUniqSet
-                        , liveDieRead   = mkUniqSet r_dying
-                        , liveDieWrite  = mkUniqSet w_dying }))
+                        , liveDieRead   = r_dying
+                        , liveDieWrite  = w_dying }))
 
         | otherwise
         = (liveregs_br, LiveInstr instr
                         (Just $ Liveness
                         { liveBorn      = emptyUniqSet
                         , liveDieRead   = mkUniqSet r_dying_br
-                        , liveDieWrite  = mkUniqSet w_dying }))
+                        , liveDieWrite  = w_dying }))
 
         where
             !(RU read written) = regUsageOfInstr platform instr
@@ -1044,10 +1044,12 @@ liveness1 platform liveregs blockmap (LiveInstr instr _)
 
             -- registers that are not live beyond this point, are recorded
             --  as dying here.
-            r_dying     = [ reg | reg <- read, reg `notElem` written,
+            r_dying     = mkUniqSet
+                          [ reg | reg <- read, reg `notElem` written,
                               not (elementOfUniqSet reg liveregs) ]
 
-            w_dying     = [ reg | reg <- written,
+            w_dying     = mkUniqSet
+                          [ reg | reg <- written,
                              not (elementOfUniqSet reg liveregs) ]
 
             -- union in the live regs from all the jump destinations of this
@@ -1067,6 +1069,6 @@ liveness1 platform liveregs blockmap (LiveInstr instr _)
             -- registers that are live only in the branch targets should
             -- be listed as dying here.
             live_branch_only = live_from_branch `minusUniqSet` liveregs
-            r_dying_br  = nonDetEltsUniqSet (mkUniqSet r_dying `unionUniqSets`
+            r_dying_br  = nonDetEltsUniqSet (r_dying `unionUniqSets`
                                              live_branch_only)
                           -- See Note [Unique Determinism and code generation]


=====================================
compiler/GHC/Types/Unique/DFM.hs
=====================================
@@ -212,13 +212,16 @@ addToUDFM_C f m k v = addToUDFM_C_Directly f m (getUnique k) v
 
 addListToUDFM :: Uniquable key => UniqDFM key elt -> [(key,elt)] -> UniqDFM key elt
 addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v)
+{-# INLINEABLE addListToUDFM #-}
 
 addListToUDFM_Directly :: UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt
 addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v)
+{-# INLINEABLE addListToUDFM_Directly #-}
 
 addListToUDFM_Directly_C
   :: (elt -> elt -> elt) -> UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt
 addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_C_Directly f m k v)
+{-# INLINEABLE addListToUDFM_Directly_C #-}
 
 delFromUDFM :: Uniquable key => UniqDFM key elt -> key -> UniqDFM key elt
 delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i


=====================================
compiler/GHC/Types/Unique/FM.hs
=====================================
@@ -139,9 +139,11 @@ zipToUFM ks vs = assert (length ks == length vs ) innerZip emptyUFM ks vs
 
 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM key elt
 listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM
+{-# INLINEABLE listToUFM #-}
 
 listToUFM_Directly :: [(Unique, elt)] -> UniqFM key elt
 listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
+{-# INLINEABLE listToUFM_Directly #-}
 
 listToIdentityUFM :: Uniquable key => [key] -> UniqFM key key
 listToIdentityUFM = foldl' (\m x -> addToUFM m x x) emptyUFM
@@ -152,6 +154,7 @@ listToUFM_C
   -> [(key, elt)]
   -> UniqFM key elt
 listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM
+{-# INLINEABLE listToUFM_C #-}
 
 addToUFM :: Uniquable key => UniqFM key elt -> key -> elt  -> UniqFM key elt
 addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)


=====================================
compiler/GHC/Types/Unique/Set.hs
=====================================
@@ -74,12 +74,14 @@ unitUniqSet x = UniqSet $ unitUFM x x
 
 mkUniqSet :: Uniquable a => [a] -> UniqSet a
 mkUniqSet = foldl' addOneToUniqSet emptyUniqSet
+{-# INLINEABLE mkUniqSet #-}
 
 addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
 addOneToUniqSet (UniqSet set) x = UniqSet (addToUFM set x x)
 
 addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
 addListToUniqSet = foldl' addOneToUniqSet
+{-# INLINEABLE addListToUniqSet #-}
 
 delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
 delOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a)
@@ -89,10 +91,12 @@ delOneFromUniqSet_Directly (UniqSet s) u = UniqSet (delFromUFM_Directly s u)
 
 delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
 delListFromUniqSet (UniqSet s) l = UniqSet (delListFromUFM s l)
+{-# INLINEABLE delListFromUniqSet #-}
 
 delListFromUniqSet_Directly :: UniqSet a -> [Unique] -> UniqSet a
 delListFromUniqSet_Directly (UniqSet s) l =
     UniqSet (delListFromUFM_Directly s l)
+{-# INLINEABLE delListFromUniqSet_Directly #-}
 
 unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
 unionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/257f1567395be441ebf7ada996e4edf36abbe7e9...b947250bda6ab996242faf18b82a42008c228eaf

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/257f1567395be441ebf7ada996e4edf36abbe7e9...b947250bda6ab996242faf18b82a42008c228eaf
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/20230719/e20f029e/attachment-0001.html>


More information about the ghc-commits mailing list