summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2021-11-25 12:47:25 -0500
committerdoyougnu <jeffrey.young@iohk.io>2023-01-12 11:51:48 +0000
commit609312697cadddb370b87665e2d52bc014933477 (patch)
tree0757861e99661ec2dea6ad47c97d3532d7fa58ff
parent8f13544377fe3b785f16d347cd53e6de91e2814a (diff)
downloadhaskell-wip/uniqset-fusion.tar.gz
compiler/Types: Ensure that fromList-type operations can fusewip/uniqset-fusion
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.
-rw-r--r--compiler/GHC/Types/Unique/DFM.hs3
-rw-r--r--compiler/GHC/Types/Unique/FM.hs3
-rw-r--r--compiler/GHC/Types/Unique/Set.hs4
3 files changed, 10 insertions, 0 deletions
diff --git a/compiler/GHC/Types/Unique/DFM.hs b/compiler/GHC/Types/Unique/DFM.hs
index ca0b45e970..7957f40c75 100644
--- a/compiler/GHC/Types/Unique/DFM.hs
+++ b/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
diff --git a/compiler/GHC/Types/Unique/FM.hs b/compiler/GHC/Types/Unique/FM.hs
index 137e985f92..0759f2fc37 100644
--- a/compiler/GHC/Types/Unique/FM.hs
+++ b/compiler/GHC/Types/Unique/FM.hs
@@ -137,9 +137,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
@@ -150,6 +152,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)
diff --git a/compiler/GHC/Types/Unique/Set.hs b/compiler/GHC/Types/Unique/Set.hs
index 88e56f9e44..a1e28f972e 100644
--- a/compiler/GHC/Types/Unique/Set.hs
+++ b/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)