Andreas Klebinger pushed to branch wip/andreask/dfm-cleanup at Glasgow Haskell Compiler / GHC Commits: 9cf5853f by Andreas Klebinger at 2026-08-10T19:01:09+02:00 Simplify comparison in DFM.hs Fixes #27669 - - - - - 5 changed files: - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Map/Lazy.hs - compiler/GHC/Data/Word64Map/Strict.hs - compiler/GHC/Data/Word64Map/Strict/Internal.hs - compiler/GHC/Types/Unique/DFM.hs Changes: ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -72,6 +72,7 @@ module GHC.Data.Word64Map.Internal ( -- * Query , null , size + , sizeAtMost , compareSize , member , notMember @@ -533,6 +534,10 @@ size = go 0 go acc (Tip _ _) = 1 + acc go acc Nil = acc +-- | Check if the map is <= n in O(min(|map|,n)) +sizeAtMost :: Word64Map a -> Int -> Bool +sizeAtMost map n = compareSize map n /= GT + -- | \(O(\min(n,c))\). Compare the number of entries in the map to an @Int@. -- -- @compareSize m c@ returns the same result as @compare ('size' m) c@ but is ===================================== compiler/GHC/Data/Word64Map/Lazy.hs ===================================== @@ -113,6 +113,7 @@ module GHC.Data.Word64Map.Lazy ( -- ** Size , WM.null , size + , sizeAtMost , compareSize -- * Combine ===================================== compiler/GHC/Data/Word64Map/Strict.hs ===================================== @@ -130,6 +130,7 @@ module GHC.Data.Word64Map.Strict ( -- ** Size , null , size + , sizeAtMost , compareSize -- * Combine ===================================== compiler/GHC/Data/Word64Map/Strict/Internal.hs ===================================== @@ -132,6 +132,7 @@ module GHC.Data.Word64Map.Strict.Internal ( -- ** Size , null , size + , sizeAtMost , compareSize -- * Combine @@ -324,6 +325,7 @@ import GHC.Data.Word64Map.Internal , spanAntitone , restrictKeys , size + , sizeAtMost , compareSize , split , splitLookup ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -351,8 +351,8 @@ foldUDFM :: (elt -> a -> a) -> a -> UniqDFM key elt -> a {-# INLINE foldUDFM #-} -- Specialises k and z into M.foldr on the small-map path. foldUDFM k z (UDFM m ub) - | M.compareSize m 1 /= GT = M.foldr (k . taggedFst) z m - | otherwise = fold_udfm k z m ub + | M.sizeAtMost m 1 = M.foldr (k . taggedFst) z m + | otherwise = fold_udfm k z m ub fold_udfm :: (elt -> a -> a) -> a -> M.Word64Map (TaggedVal elt) -> Int -> a {-# NOINLINE fold_udfm #-} @@ -402,8 +402,8 @@ eltsUDFM :: UniqDFM key elt -> [elt] {-# INLINE eltsUDFM #-} -- so the small case is a good producer -- This matters for T13719. eltsUDFM (UDFM m ub) - | M.compareSize m 1 /= GT = build (\c n -> M.foldr (c . taggedFst) n m) - | otherwise = elts_udfm m ub + | M.sizeAtMost m 1 = build (\c n -> M.foldr (c . taggedFst) n m) + | otherwise = elts_udfm m ub elts_udfm :: M.Word64Map (TaggedVal elt) -> Int -> [elt] {-# NOINLINE elts_udfm #-} @@ -511,7 +511,7 @@ udfmToList :: UniqDFM key elt -> [(Unique, elt)] -- traverseUSDFM in the pattern-match checker, which doesn't fuse. Inlining -- the size dispatch into it regresses T17836. udfmToList (UDFM m ub) - | M.compareSize m 1 /= GT = + | M.sizeAtMost m 1 = M.foldrWithKey (\k tv r -> (mkUniqueGrimily k, taggedFst tv) : r) [] m | usePigeonholeSort m ub = pigeonholeSort ub (\k tv -> TaggedVal (mkUniqueGrimily k, taggedFst tv) (taggedSnd tv)) m View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cf5853f111858fc3136ec2a6ef94f34... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cf5853f111858fc3136ec2a6ef94f34... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help