Simon Jakobi pushed to branch wip/sjakobi/udfm-placement at Glasgow Haskell Compiler / GHC Commits: 6990e63f by Simon Jakobi at 2026-07-07T17:28:20+02:00 UDFM: restore list fusion for tiny eltsUDFM/udfmToList The n <= 1 shortcut was out of line, so each singleton call materialised two cons cells (48 bytes) where the old INLINE eltsUDFM fused with its consumer (~27 bytes). T13719 walks ~2M singleton instance envs and paid ~40 MB for this: the +0.7% ghc/alloc regression in the CI perf run. Make eltsUDFM/udfmToList INLINE again, with the small case as a build-based good producer and the placement/mergesort paths out of line (elts_nonempty/to_list_nonempty). Fused, a tiny-map readout now allocates nothing; unfused, one cons cell per element. T13719 ghc/alloc (locally, perf flavour): -4.25% vs the previous commit, -3.54% below master's baseline -- udfmToList's small case fusing is a gain even over master, which never inlined udfmToList at all. Assisted-by: Claude Fable 5 - - - - - 1 changed file: - compiler/GHC/Types/Unique/DFM.hs Changes: ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -83,7 +83,7 @@ import Data.List (sortBy) import Data.Function (on) import GHC.Types.Unique.FM (UniqFM, nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM) import GHC.Data.SmallArray -import GHC.Exts (State#) +import GHC.Exts (State#, build) import GHC.ST (ST(..), runST) import Unsafe.Coerce import qualified GHC.Data.Word64Set as W @@ -388,10 +388,17 @@ if you don't need the deterministic order at all, use the nonDet functions. -- -- See Note [Sorting a UDFM] and Note [Cost of deterministic iteration]. eltsUDFM :: UniqDFM key elt -> [elt] +{-# INLINE eltsUDFM #-} -- so the small case is a good producer eltsUDFM (UDFM m ub) - | M.compareSize m 1 /= GT = map taggedFst (M.elems m) - | usePlacement m ub = placementSort ub (\_ tv -> tv) m - | otherwise = map taggedFst (sort_it m) + -- n <= 1: any order is trivially tag order, so read straight off the map + | M.compareSize m 1 /= GT = build (\c n -> M.foldr (c . taggedFst) n m) + | otherwise = elts_nonempty m ub + +-- Precondition: m is non-empty +elts_nonempty :: M.Word64Map (TaggedVal elt) -> Int -> [elt] +elts_nonempty m ub + | usePlacement m ub = placementSort ub (\_ tv -> tv) m + | otherwise = map taggedFst (sort_it m) sort_it :: M.Word64Map (TaggedVal elt) -> [TaggedVal elt] sort_it m = sortBy (compare `on` taggedSnd) (M.elems m) @@ -497,11 +504,18 @@ udfmRestrictKeysSet (UDFM val_set i) set = -- as this already incurs most of the cost of returning the full list. -- See Note [Cost of deterministic iteration]. udfmToList :: UniqDFM key elt -> [(Unique, elt)] +{-# INLINE udfmToList #-} -- so the small case is a good producer udfmToList (UDFM m ub) + -- n <= 1: any order is trivially tag order, so read straight off the map | M.compareSize m 1 /= GT = - [ (mkUniqueGrimily k, taggedFst v) | (k, v) <- M.toList m ] - - -- Unlike eltsUDFM, this allocates a fresh TaggedVal + pair per element + build (\c n -> + M.foldrWithKey (\k tv r -> c (mkUniqueGrimily k, taggedFst tv) r) n m) + | otherwise = to_list_nonempty m ub + +-- Precondition: m is non-empty +to_list_nonempty :: M.Word64Map (TaggedVal elt) -> Int -> [(Unique, elt)] +to_list_nonempty m ub + -- Unlike elts_nonempty, this allocates a fresh TaggedVal + pair per element -- (they make up the result). | usePlacement m ub = placementSort ub (\k tv -> TaggedVal (mkUniqueGrimily k, taggedFst tv) (taggedSnd tv)) m View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6990e63f1e7b454e5a7d293556708319... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6990e63f1e7b454e5a7d293556708319... You're receiving this email because of your account on gitlab.haskell.org.