- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/sjakobi/udfm-placement] Use a placement sort for deterministic UniqDFM iteration
by Simon Jakobi (＠sjakobi2) 02 Jul '26

02 Jul '26

Simon Jakobi pushed to branch wip/sjakobi/udfm-placement at Glasgow Haskell Compiler / GHC Commits: 1c645b9c by Simon Jakobi at 2026-07-02T21:26:00+02:00 Use a placement sort for deterministic UniqDFM iteration eltsUDFM/udfmToList (and with them foldUDFM and UniqDFM's Foldable instance) ordered elements with a list mergesort, allocating ~n*log n cons cells per call. In the profile for the InstanceMatching1 perf test this pipeline accounted for a large share of total allocations (#27459). This commit instead uses a more efficient placement sort in most cases. See Note [Sorting a UDFM]. Also add Note [Cost of deterministic iteration], prompted by #27459. - - - - - 1 changed file: - compiler/GHC/Types/Unique/DFM.hs Changes: ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -14,6 +14,9 @@ See Note [Unique Determinism] in GHC.Types.Unique for explanation why @Unique@ o is not deterministic. -} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + {-# OPTIONS_GHC -Wall #-} module GHC.Types.Unique.DFM ( @@ -79,6 +82,9 @@ import Data.Functor.Classes (Eq1 (..)) 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.ST (ST(..), runST) import Unsafe.Coerce import qualified GHC.Data.Word64Set as W @@ -92,9 +98,10 @@ import qualified GHC.Data.Word64Set as W -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts its result by this serial --- number. So you should only use `UniqDFM` if you need the deterministic --- property. +-- as it is added, and functions like `udfmToList` or `eltsUDFM` order their +-- results by this serial number (see +-- Note [Cost of deterministic iteration]). So you should only use `UniqDFM` +-- if you need the deterministic property. -- -- `foldUDFM` also preserves determinism. -- @@ -112,13 +119,19 @@ import qualified GHC.Data.Word64Set as W -- -- An alternative would be to have -- --- data UniqDFM ele = UDFM (M.IntMap ele) [ele] +-- data UniqDFM ele = UDFM (Word64Map ele) [ele] -- -- where the list determines the order. This makes deletion tricky as we'd -- only accumulate elements in that list, but makes merging easier as you -- can just merge both structures independently. -- Deletion can probably be done in amortized fashion when the size of the -- list is twice the size of the set. +-- +-- A representation like +-- +-- data UniqDFM ele = UDFM (Word64Map ele) [Unique] +-- +-- may also be worth considering. Compare Dhall.Map in the dhall package. -- | A type of values tagged with insertion time data TaggedVal val = @@ -153,11 +166,15 @@ data UniqDFM key ele = -- time. See Note [Overflow on plusUDFM] deriving (Data, Functor) --- | Deterministic, in O(n log n). +-- | Deterministic. +-- +-- See Note [Cost of deterministic iteration]. instance Foldable (UniqDFM key) where foldr = foldUDFM --- | Deterministic, in O(n log n). +-- | Deterministic. +-- +-- See Note [Cost of deterministic iteration]. instance Traversable (UniqDFM key) where traverse f = fmap listToUDFM_Directly . traverse (\(u,a) -> (u,) <$> f a) @@ -310,13 +327,20 @@ elemUDFM :: Uniquable key => key -> UniqDFM key elt -> Bool elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m -- | Performs a deterministic fold over the UniqDFM. --- It's O(n log n) while the corresponding function on `UniqFM` is O(n). +-- +-- O(n) in the common case, with an O(n log n) fallback. +-- +-- Don't use this to access the first element or to check for emptiness, +-- as this already incurs most of the cost of returning the full list. +-- See Note [Cost of deterministic iteration]. foldUDFM :: (elt -> a -> a) -> a -> UniqDFM key elt -> a {-# INLINE foldUDFM #-} -- This INLINE prevents a regression in !10568 foldUDFM k z m = foldr k z (eltsUDFM m) --- | Like 'foldUDFM' but the function also receives a key +-- | Like 'foldUDFM' but the function also receives a key. +-- +-- See Note [Cost of deterministic iteration]. foldWithKeyUDFM :: (Unique -> elt -> a -> a) -> a -> UniqDFM key elt -> a {-# INLINE foldWithKeyUDFM #-} -- This INLINE was copied from foldUDFM @@ -331,14 +355,88 @@ nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m where k' acc (TaggedVal v _) = k v acc +-- Note [Cost of deterministic iteration] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Deterministic iteration orders elements by insertion tag, and any such +-- ordering must inspect every element's tag before it can emit the first +-- element. So even the head of the result costs a full traversal of the map +-- plus -- on the main path -- the allocation of an O(n)-sized array (see +-- Note [Sorting a UDFM]). Laziness in the result list only avoids allocating +-- for elements that are never demanded; it does not make the iteration +-- incremental. #27459 shows this cost biting in consumers that demanded only +-- the head. +-- +-- So: to test for emptiness, use isNullUDFM rather than null on eltsUDFM; +-- for order-oblivious queries, prefer short-circuiting anyUDFM/allUDFM; and +-- if you don't need the deterministic order at all, use the nonDet functions. + +-- | Deterministic, in order of insertion. +-- +-- See Note [Sorting a UDFM] and Note [Cost of deterministic iteration]. eltsUDFM :: UniqDFM key elt -> [elt] -{-# INLINE eltsUDFM #-} --- The INLINE makes it a good producer (from the map) -eltsUDFM (UDFM m _i) = map taggedFst (sort_it m) +eltsUDFM (UDFM m i) + | n <= 1 = map taggedFst (M.elems m) + | usePlacement n i = placementSort i (M.elems m) + | otherwise = map taggedFst (sort_it m) + where n = M.size m sort_it :: M.Word64Map (TaggedVal elt) -> [TaggedVal elt] sort_it m = sortBy (compare `on` taggedSnd) (M.elems m) + +-- Note [Sorting a UDFM] +-- ~~~~~~~~~~~~~~~~~~~~~ +-- Deterministic iteration must order elements by insertion tag. Instead of a +-- comparison sort -- the list mergesort behind sortBy allocates ~n*log n cons +-- cells -- we exploit the invariant that in (UDFM m i) all tags are distinct +-- Ints in [0, i): allocate an array of size i, write each element at +-- @index = tag@, freeze, and read out in index order. That's O(i) work (which +-- subsumes the O(n) fill, since distinct tags force n <= i), no comparisons, +-- and the readout is lazy, so consumers that demand only a prefix pay almost +-- nothing beyond the fill (but the fill itself is unavoidable; see +-- Note [Cost of deterministic iteration]). +-- +-- Holes: slots whose tag never occurs keep the initial sentinel, a TaggedVal +-- with tag -1. Real tags are non-negative, so the readout skips on tag < 0; +-- the sentinel's value field is never touched (it is unsafeCoerced ()). +-- +-- This sorting method loses when i is much larger than n: i never shrinks +-- (overwrites keep bumping it, delete/filter shrink n but not i). We compute +-- n = M.size m (O(n), cheap next to either sort) and fall back to the +-- mergesort when i > 4 * n. Maps built by plain insertion -- the common +-- case -- have i == n. The guard also caps the fast path's O(i) at O(n). + +usePlacement :: Int -> Int -> Bool +usePlacement n i = i <= 4 * n + +-- | Order a list of 'TaggedVal's by tag, by placing each at array index = +-- its tag. +-- +-- The tags must be distinct and in @[0, i)@. +-- See Note [Sorting a UDFM]. +placementSort :: forall r. Int -> [TaggedVal r] -> [r] +placementSort i tvs = runST (ST (\s0 -> + case newSmallArray i hole s0 of + (# s1, marr #) -> case fill marr tvs s1 of + s2 -> case unsafeFreezeSmallArray marr s2 of + (# s3, arr #) -> (# s3, readout arr 0 #))) + where + hole :: TaggedVal r + hole = TaggedVal (unsafeCoerce ()) (-1) + + fill :: SmallMutableArray s (TaggedVal r) -> [TaggedVal r] -> State# s -> State# s + fill _ [] s = s + fill marr (tv : tvs') s = + case writeSmallArray marr (taggedSnd tv) tv s of + s' -> fill marr tvs' s' + + readout :: SmallArray (TaggedVal r) -> Int -> [r] + readout arr j + | j >= i = [] + | t < 0 = readout arr (j + 1) + | otherwise = v : readout arr (j + 1) + where TaggedVal v t = indexSmallArray arr j + filterUDFM :: (elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt filterUDFM p (UDFM m i) = UDFM (M.filter (\(TaggedVal v _) -> p v) m) i @@ -356,11 +454,26 @@ udfmRestrictKeysSet (UDFM val_set i) set = in UDFM (M.restrictKeys val_set key_set) i -- | Converts `UniqDFM` to a list, with elements in deterministic order. --- It's O(n log n) while the corresponding function on `UniqFM` is O(n). +-- +-- O(n) in the common case, with an O(n log n) fallback. +-- +-- Don't use this to access the first element or to check for emptiness, +-- 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)] -udfmToList (UDFM m _i) = - [ (mkUniqueGrimily k, taggedFst v) - | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ] +udfmToList (UDFM m i) + | n <= 1 = [ (mkUniqueGrimily k, taggedFst v) | (k, v) <- M.toList m ] + + -- Unlike eltsUDFM, this allocates a fresh TaggedVal + pair per element + -- before the sort. If it ever matters, a parallel Word64 array of + -- keys filled in the same pass would avoid the eager boxes. + | usePlacement n i = placementSort i + (M.foldrWithKey (\k tv rest -> + TaggedVal (mkUniqueGrimily k, taggedFst tv) (taggedSnd tv) : rest) [] m) + | otherwise = + [ (mkUniqueGrimily k, taggedFst v) + | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ] + where n = M.size m -- Determines whether two 'UniqDFM's contain the same keys. equalKeysUDFM :: UniqDFM key a -> UniqDFM key b -> Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c645b9c8d5318d36dd37c23c4abb6a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c645b9c8d5318d36dd37c23c4abb6a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/udfm-placement] Use a placement sort for deterministic UniqDFM iteration
by Simon Jakobi (＠sjakobi2) 02 Jul '26

02 Jul '26

Simon Jakobi pushed to branch wip/sjakobi/udfm-placement at Glasgow Haskell Compiler / GHC Commits: a06b74dc by Simon Jakobi at 2026-07-02T20:41:07+02:00 Use a placement sort for deterministic UniqDFM iteration eltsUDFM/udfmToList (and with them foldUDFM and UniqDFM's Foldable instance) ordered elements with a list mergesort, allocating ~n*log n cons cells per call. In the profile of InstanceMatching1 this pipeline accounted for a large share of total allocations (#27459). This commit instead uses a placement sort in most cases. See Note [Sorting a UDFM]. Also add Note [Cost of deterministic iteration], prompted by #27459. - - - - - 1 changed file: - compiler/GHC/Types/Unique/DFM.hs Changes: ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -14,6 +14,9 @@ See Note [Unique Determinism] in GHC.Types.Unique for explanation why @Unique@ o is not deterministic. -} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + {-# OPTIONS_GHC -Wall #-} module GHC.Types.Unique.DFM ( @@ -79,6 +82,9 @@ import Data.Functor.Classes (Eq1 (..)) 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.ST (ST(..), runST) import Unsafe.Coerce import qualified GHC.Data.Word64Set as W @@ -92,9 +98,10 @@ import qualified GHC.Data.Word64Set as W -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts its result by this serial --- number. So you should only use `UniqDFM` if you need the deterministic --- property. +-- as it is added, and functions like `udfmToList` or `eltsUDFM` order their +-- results by this serial number (see +-- Note [Cost of deterministic iteration]). So you should only use `UniqDFM` +-- if you need the deterministic property. -- -- `foldUDFM` also preserves determinism. -- @@ -112,13 +119,17 @@ import qualified GHC.Data.Word64Set as W -- -- An alternative would be to have -- --- data UniqDFM ele = UDFM (M.IntMap ele) [ele] +-- data UniqDFM ele = UDFM (Word64Map ele) [ele] -- -- where the list determines the order. This makes deletion tricky as we'd -- only accumulate elements in that list, but makes merging easier as you -- can just merge both structures independently. -- Deletion can probably be done in amortized fashion when the size of the -- list is twice the size of the set. +-- +-- data UniqDFM ele = UDFM (Word64Map ele) [Unique] +-- +-- may also be worth considering. Compare Dhall.Map in the dhall package. -- | A type of values tagged with insertion time data TaggedVal val = @@ -153,11 +164,15 @@ data UniqDFM key ele = -- time. See Note [Overflow on plusUDFM] deriving (Data, Functor) --- | Deterministic, in O(n log n). +-- | Deterministic. +-- +-- See Note [Cost of deterministic iteration]. instance Foldable (UniqDFM key) where foldr = foldUDFM --- | Deterministic, in O(n log n). +-- | Deterministic. +-- +-- See Note [Cost of deterministic iteration]. instance Traversable (UniqDFM key) where traverse f = fmap listToUDFM_Directly . traverse (\(u,a) -> (u,) <$> f a) @@ -310,13 +325,20 @@ elemUDFM :: Uniquable key => key -> UniqDFM key elt -> Bool elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m -- | Performs a deterministic fold over the UniqDFM. --- It's O(n log n) while the corresponding function on `UniqFM` is O(n). +-- +-- O(n) in the common case, with an O(n log n) fallback. +-- +-- Don't use this to access the first element or to check for emptiness, +-- as this already incurs most of the cost of returning the full list. +-- See Note [Cost of deterministic iteration]. foldUDFM :: (elt -> a -> a) -> a -> UniqDFM key elt -> a {-# INLINE foldUDFM #-} -- This INLINE prevents a regression in !10568 foldUDFM k z m = foldr k z (eltsUDFM m) --- | Like 'foldUDFM' but the function also receives a key +-- | Like 'foldUDFM' but the function also receives a key. +-- +-- See Note [Cost of deterministic iteration]. foldWithKeyUDFM :: (Unique -> elt -> a -> a) -> a -> UniqDFM key elt -> a {-# INLINE foldWithKeyUDFM #-} -- This INLINE was copied from foldUDFM @@ -331,14 +353,90 @@ nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m where k' acc (TaggedVal v _) = k v acc +-- Note [Cost of deterministic iteration] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Deterministic iteration orders elements by insertion tag, and any such +-- ordering must inspect every element's tag before it can emit the first +-- element. So even the head of the result costs a full traversal of the map +-- plus the allocation of an O(n)-sized array -- or, on the fallback path, +-- O(n log n) cons cells (see Note [Sorting a UDFM]). Laziness in the result +-- list only avoids allocating for elements that are never demanded; it does +-- not make the iteration incremental. #27459 shows this cost biting in +-- consumers that demanded only the head. +-- +-- So: to test for emptiness, use isNullUDFM rather than null on eltsUDFM; +-- for order-oblivious queries, prefer short-circuiting anyUDFM/allUDFM; and +-- if you don't need the deterministic order at all, use the nonDet functions. + +-- | Deterministic, in order of insertion. +-- +-- See Notes [Sorting a UDFM] and [Cost of deterministic iteration]. eltsUDFM :: UniqDFM key elt -> [elt] {-# INLINE eltsUDFM #-} -- The INLINE makes it a good producer (from the map) -eltsUDFM (UDFM m _i) = map taggedFst (sort_it m) +eltsUDFM (UDFM m i) + | n <= 1 = map taggedFst (M.elems m) + | usePlacement n i = placementSort i (M.elems m) + | otherwise = map taggedFst (sort_it m) + where n = M.size m sort_it :: M.Word64Map (TaggedVal elt) -> [TaggedVal elt] sort_it m = sortBy (compare `on` taggedSnd) (M.elems m) + +-- Note [Sorting a UDFM] +-- ~~~~~~~~~~~~~~~~~~~~~ +-- Deterministic iteration must order elements by insertion tag. Instead of a +-- comparison sort -- the list mergesort behind sortBy allocates ~n*log n cons +-- cells -- we exploit the invariant that in (UDFM m i) all tags are distinct +-- Ints in [0, i): allocate an array of size i, write each element at +-- @index = tag@, freeze, and read out in index order. That's O(i) work (which +-- subsumes the O(n) fill, since distinct tags force n <= i), no comparisons, +-- and the readout is lazy, so consumers that demand only a prefix pay almost +-- nothing beyond the fill (but the fill itself is unavoidable; see +-- Note [Cost of deterministic iteration]). +-- +-- Holes: slots whose tag never occurs keep the initial sentinel, a TaggedVal +-- with tag -1. Real tags are non-negative, so the readout skips on tag < 0; +-- the sentinel's value field is never touched (it is unsafeCoerced ()). +-- +-- This sorting method loses when i is much larger than n: i never shrinks +-- (overwrites keep bumping it, delete/filter shrink n but not i). We compute +-- n = M.size m (O(n), cheap next to either sort) and fall back to the +-- mergesort when i > 4 * n. Maps built by plain insertion -- the common +-- case -- have i == n. The guard also caps the fast path's O(i) at O(n). + +usePlacement :: Int -> Int -> Bool +usePlacement n i = i <= 4 * n + +-- | Order a list of 'TaggedVal's by tag, by placing each at array index = +-- its tag. +-- +-- The tags must be distinct and in @[0, i)@. +-- See Note [Sorting a UDFM]. +placementSort :: forall r. Int -> [TaggedVal r] -> [r] +placementSort i tvs = runST (ST (\s0 -> + case newSmallArray i hole s0 of + (# s1, marr #) -> case fill marr tvs s1 of + s2 -> case unsafeFreezeSmallArray marr s2 of + (# s3, arr #) -> (# s3, readout arr 0 #))) + where + hole :: TaggedVal r + hole = TaggedVal (unsafeCoerce ()) (-1) + + fill :: SmallMutableArray s (TaggedVal r) -> [TaggedVal r] -> State# s -> State# s + fill _ [] s = s + fill marr (tv : tvs') s = + case writeSmallArray marr (taggedSnd tv) tv s of + s' -> fill marr tvs' s' + + readout :: SmallArray (TaggedVal r) -> Int -> [r] + readout arr j + | j >= i = [] + | t < 0 = readout arr (j + 1) + | otherwise = v : readout arr (j + 1) + where TaggedVal v t = indexSmallArray arr j + filterUDFM :: (elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt filterUDFM p (UDFM m i) = UDFM (M.filter (\(TaggedVal v _) -> p v) m) i @@ -356,11 +454,25 @@ udfmRestrictKeysSet (UDFM val_set i) set = in UDFM (M.restrictKeys val_set key_set) i -- | Converts `UniqDFM` to a list, with elements in deterministic order. --- It's O(n log n) while the corresponding function on `UniqFM` is O(n). +-- +-- O(n) in the common case, with an O(n log n) fallback. +-- +-- Don't use this to access the first element or to check for emptiness, +-- 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)] -udfmToList (UDFM m _i) = - [ (mkUniqueGrimily k, taggedFst v) - | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ] +udfmToList (UDFM m i) + | n <= 1 = [ (mkUniqueGrimily k, taggedFst v) | (k, v) <- M.toList m ] + -- Unlike eltsUDFM, this allocates a fresh TaggedVal + pair per element + -- before the sort. If it ever matters, a parallel Word64 array of + -- keys filled in the same pass would avoid the eager boxes. + | usePlacement n i = placementSort i + (M.foldrWithKey (\k tv rest -> + TaggedVal (mkUniqueGrimily k, taggedFst tv) (taggedSnd tv) : rest) [] m) + | otherwise = + [ (mkUniqueGrimily k, taggedFst v) + | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ] + where n = M.size m -- Determines whether two 'UniqDFM's contain the same keys. equalKeysUDFM :: UniqDFM key a -> UniqDFM key b -> Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a06b74dc58af1433cb6d5a2c0952198… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a06b74dc58af1433cb6d5a2c0952198… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/ghc-9-14-building-base] Correct the path to `ghc`
by Wolfgang Jeltsch (＠jeltsch) 02 Jul '26

02 Jul '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/ghc-9-14-building-base at Glasgow Haskell Compiler / GHC Commits: 9532461e by Wolfgang Jeltsch at 2026-07-02T21:01:34+03:00 Correct the path to `ghc` - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1175,7 +1175,7 @@ base-build-with-released-ghcs: make install cd - cd libraries/base - cabal build --with-compiler ghc-${ghc_version}-installed/bin/ghc \ + cabal build --with-compiler ../../ghc-${ghc_version}-installed/bin/ghc \ --allow-boot-library-installs \ -O0 cd - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9532461e2cd966935981a7ecd479c75… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9532461e2cd966935981a7ecd479c75… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/25924] accept failing tests
by Zubin (＠wz1000) 02 Jul '26

02 Jul '26

Zubin pushed to branch wip/25924 at Glasgow Haskell Compiler / GHC Commits: e4e24735 by Zubin Duggal at 2026-07-02T21:58:04+05:30 accept failing tests - - - - - 2 changed files: - testsuite/tests/dmdanal/should_compile/T18982.stderr - testsuite/tests/simplCore/should_compile/T26615.stderr Changes: ===================================== testsuite/tests/dmdanal/should_compile/T18982.stderr ===================================== @@ -1,38 +1,26 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 295, types: 206, coercions: 4, joins: 0/0} - --- RHS size: {terms: 8, types: 9, coercions: 1, joins: 0/0} -T18982.$WExGADT :: forall e. (e ~ Int) => e %1 -> Int %1 -> ExGADT Int -T18982.$WExGADT = \ (@e) (conrep :: e ~ Int) (conrep1 :: e) (conrep2 :: Int) -> T18982.ExGADT @Int @e @~(<Int>_N :: Int GHC.Internal.Prim.~# Int) conrep conrep1 conrep2 - --- RHS size: {terms: 3, types: 2, coercions: 1, joins: 0/0} -T18982.$WGADT :: Int %1 -> GADT Int -T18982.$WGADT = \ (conrep :: Int) -> T18982.GADT @Int @~(<Int>_N :: Int GHC.Internal.Prim.~# Int) conrep - --- RHS size: {terms: 7, types: 6, coercions: 0, joins: 0/0} -T18982.$WEx :: forall e a. e %1 -> a %1 -> Ex a -T18982.$WEx = \ (@e) (@a) (conrep :: e) (conrep1 :: a) -> T18982.Ex @a @e conrep conrep1 +Result size of Tidy Core = {terms: 276, types: 179, coercions: 2, joins: 0/0} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule4 :: GHC.Internal.Prim.Addr# -T18982.$trModule4 = "main"# +$trModule1 :: GHC.Internal.Prim.Addr# +$trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule3 :: GHC.Internal.Types.TrName -T18982.$trModule3 = GHC.Internal.Types.TrNameS T18982.$trModule4 +$trModule2 :: GHC.Internal.Types.TrName +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule2 :: GHC.Internal.Prim.Addr# -T18982.$trModule2 = "T18982"# +$trModule3 :: GHC.Internal.Prim.Addr# +$trModule3 = "T18982"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$trModule1 :: GHC.Internal.Types.TrName -T18982.$trModule1 = GHC.Internal.Types.TrNameS T18982.$trModule2 +$trModule4 :: GHC.Internal.Types.TrName +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T18982.$trModule :: GHC.Internal.Types.Module -T18982.$trModule = GHC.Internal.Types.Module T18982.$trModule3 T18982.$trModule1 +T18982.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Internal.Types.KindRep @@ -47,16 +35,16 @@ $krep2 :: GHC.Internal.Types.KindRep $krep2 = GHC.Internal.Types.KindRepVar 0# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcBox2 :: GHC.Internal.Prim.Addr# -T18982.$tcBox2 = "Box"# +$tcBox1 :: GHC.Internal.Prim.Addr# +$tcBox1 = "Box"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcBox1 :: GHC.Internal.Types.TrName -T18982.$tcBox1 = GHC.Internal.Types.TrNameS T18982.$tcBox2 +$tcBox2 :: GHC.Internal.Types.TrName +$tcBox2 = GHC.Internal.Types.TrNameS $tcBox1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcBox :: GHC.Internal.Types.TyCon -T18982.$tcBox = GHC.Internal.Types.TyCon 16948648223906549518#Word64 2491460178135962649#Word64 T18982.$trModule T18982.$tcBox1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcBox = GHC.Internal.Types.TyCon 16948648223906549518#Word64 2491460178135962649#Word64 T18982.$trModule $tcBox2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} $krep3 :: [GHC.Internal.Types.KindRep] @@ -67,140 +55,140 @@ $krep4 :: GHC.Internal.Types.KindRep $krep4 = GHC.Internal.Types.KindRepTyConApp T18982.$tcBox $krep3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Box1 :: GHC.Internal.Types.KindRep -T18982.$tc'Box1 = GHC.Internal.Types.KindRepFun $krep2 $krep4 +$krep5 :: GHC.Internal.Types.KindRep +$krep5 = GHC.Internal.Types.KindRepFun $krep2 $krep4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Box3 :: GHC.Internal.Prim.Addr# -T18982.$tc'Box3 = "'Box"# +$tc'Box1 :: GHC.Internal.Prim.Addr# +$tc'Box1 = "'Box"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Box2 :: GHC.Internal.Types.TrName -T18982.$tc'Box2 = GHC.Internal.Types.TrNameS T18982.$tc'Box3 +$tc'Box2 :: GHC.Internal.Types.TrName +$tc'Box2 = GHC.Internal.Types.TrNameS $tc'Box1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'Box :: GHC.Internal.Types.TyCon -T18982.$tc'Box = GHC.Internal.Types.TyCon 1412068769125067428#Word64 8727214667407894081#Word64 T18982.$trModule T18982.$tc'Box2 1# T18982.$tc'Box1 +T18982.$tc'Box = GHC.Internal.Types.TyCon 1412068769125067428#Word64 8727214667407894081#Word64 T18982.$trModule $tc'Box2 1# $krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcEx2 :: GHC.Internal.Prim.Addr# -T18982.$tcEx2 = "Ex"# +$tcEx1 :: GHC.Internal.Prim.Addr# +$tcEx1 = "Ex"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcEx1 :: GHC.Internal.Types.TrName -T18982.$tcEx1 = GHC.Internal.Types.TrNameS T18982.$tcEx2 +$tcEx2 :: GHC.Internal.Types.TrName +$tcEx2 = GHC.Internal.Types.TrNameS $tcEx1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcEx :: GHC.Internal.Types.TyCon -T18982.$tcEx = GHC.Internal.Types.TyCon 4376661818164435927#Word64 18005417598910668817#Word64 T18982.$trModule T18982.$tcEx1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcEx = GHC.Internal.Types.TyCon 4376661818164435927#Word64 18005417598910668817#Word64 T18982.$trModule $tcEx2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep5 :: [GHC.Internal.Types.KindRep] -$krep5 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep1 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) +$krep6 :: [GHC.Internal.Types.KindRep] +$krep6 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep1 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep6 :: GHC.Internal.Types.KindRep -$krep6 = GHC.Internal.Types.KindRepTyConApp T18982.$tcEx $krep5 +$krep7 :: GHC.Internal.Types.KindRep +$krep7 = GHC.Internal.Types.KindRepTyConApp T18982.$tcEx $krep6 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep7 :: GHC.Internal.Types.KindRep -$krep7 = GHC.Internal.Types.KindRepFun $krep1 $krep6 +$krep8 :: GHC.Internal.Types.KindRep +$krep8 = GHC.Internal.Types.KindRepFun $krep1 $krep7 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Ex1 :: GHC.Internal.Types.KindRep -T18982.$tc'Ex1 = GHC.Internal.Types.KindRepFun $krep2 $krep7 +$krep9 :: GHC.Internal.Types.KindRep +$krep9 = GHC.Internal.Types.KindRepFun $krep2 $krep8 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Ex3 :: GHC.Internal.Prim.Addr# -T18982.$tc'Ex3 = "'Ex"# +$tc'Ex1 :: GHC.Internal.Prim.Addr# +$tc'Ex1 = "'Ex"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'Ex2 :: GHC.Internal.Types.TrName -T18982.$tc'Ex2 = GHC.Internal.Types.TrNameS T18982.$tc'Ex3 +$tc'Ex2 :: GHC.Internal.Types.TrName +$tc'Ex2 = GHC.Internal.Types.TrNameS $tc'Ex1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'Ex :: GHC.Internal.Types.TyCon -T18982.$tc'Ex = GHC.Internal.Types.TyCon 14609381081172201359#Word64 3077219645053200509#Word64 T18982.$trModule T18982.$tc'Ex2 2# T18982.$tc'Ex1 +T18982.$tc'Ex = GHC.Internal.Types.TyCon 14609381081172201359#Word64 3077219645053200509#Word64 T18982.$trModule $tc'Ex2 2# $krep9 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcGADT2 :: GHC.Internal.Prim.Addr# -T18982.$tcGADT2 = "GADT"# +$tcGADT1 :: GHC.Internal.Prim.Addr# +$tcGADT1 = "GADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcGADT1 :: GHC.Internal.Types.TrName -T18982.$tcGADT1 = GHC.Internal.Types.TrNameS T18982.$tcGADT2 +$tcGADT2 :: GHC.Internal.Types.TrName +$tcGADT2 = GHC.Internal.Types.TrNameS $tcGADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcGADT :: GHC.Internal.Types.TyCon -T18982.$tcGADT = GHC.Internal.Types.TyCon 9243924476135839950#Word64 5096619276488416461#Word64 T18982.$trModule T18982.$tcGADT1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcGADT = GHC.Internal.Types.TyCon 9243924476135839950#Word64 5096619276488416461#Word64 T18982.$trModule $tcGADT2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep8 :: [GHC.Internal.Types.KindRep] -$krep8 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) +$krep10 :: [GHC.Internal.Types.KindRep] +$krep10 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep9 :: GHC.Internal.Types.KindRep -$krep9 = GHC.Internal.Types.KindRepTyConApp T18982.$tcGADT $krep8 +$krep11 :: GHC.Internal.Types.KindRep +$krep11 = GHC.Internal.Types.KindRepTyConApp T18982.$tcGADT $krep10 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'GADT1 :: GHC.Internal.Types.KindRep -T18982.$tc'GADT1 = GHC.Internal.Types.KindRepFun $krep $krep9 +$krep12 :: GHC.Internal.Types.KindRep +$krep12 = GHC.Internal.Types.KindRepFun $krep $krep11 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'GADT3 :: GHC.Internal.Prim.Addr# -T18982.$tc'GADT3 = "'GADT"# +$tc'GADT1 :: GHC.Internal.Prim.Addr# +$tc'GADT1 = "'GADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'GADT2 :: GHC.Internal.Types.TrName -T18982.$tc'GADT2 = GHC.Internal.Types.TrNameS T18982.$tc'GADT3 +$tc'GADT2 :: GHC.Internal.Types.TrName +$tc'GADT2 = GHC.Internal.Types.TrNameS $tc'GADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'GADT :: GHC.Internal.Types.TyCon -T18982.$tc'GADT = GHC.Internal.Types.TyCon 2077850259354179864#Word64 16731205864486799217#Word64 T18982.$trModule T18982.$tc'GADT2 0# T18982.$tc'GADT1 +T18982.$tc'GADT = GHC.Internal.Types.TyCon 2077850259354179864#Word64 16731205864486799217#Word64 T18982.$trModule $tc'GADT2 0# $krep12 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tcExGADT2 :: GHC.Internal.Prim.Addr# -T18982.$tcExGADT2 = "ExGADT"# +$tcExGADT1 :: GHC.Internal.Prim.Addr# +$tcExGADT1 = "ExGADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tcExGADT1 :: GHC.Internal.Types.TrName -T18982.$tcExGADT1 = GHC.Internal.Types.TrNameS T18982.$tcExGADT2 +$tcExGADT2 :: GHC.Internal.Types.TrName +$tcExGADT2 = GHC.Internal.Types.TrNameS $tcExGADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tcExGADT :: GHC.Internal.Types.TyCon -T18982.$tcExGADT = GHC.Internal.Types.TyCon 6470898418160489500#Word64 10361108917441214060#Word64 T18982.$trModule T18982.$tcExGADT1 0# GHC.Internal.Types.krep$*Arr* +T18982.$tcExGADT = GHC.Internal.Types.TyCon 6470898418160489500#Word64 10361108917441214060#Word64 T18982.$trModule $tcExGADT2 0# GHC.Internal.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep10 :: GHC.Internal.Types.KindRep -$krep10 = GHC.Internal.Types.KindRepTyConApp T18982.$tcExGADT $krep8 +$krep13 :: GHC.Internal.Types.KindRep +$krep13 = GHC.Internal.Types.KindRepTyConApp T18982.$tcExGADT $krep10 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11 :: GHC.Internal.Types.KindRep -$krep11 = GHC.Internal.Types.KindRepFun $krep $krep10 +$krep14 :: GHC.Internal.Types.KindRep +$krep14 = GHC.Internal.Types.KindRepFun $krep $krep13 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'ExGADT1 :: GHC.Internal.Types.KindRep -T18982.$tc'ExGADT1 = GHC.Internal.Types.KindRepFun $krep2 $krep11 +$krep15 :: GHC.Internal.Types.KindRep +$krep15 = GHC.Internal.Types.KindRepFun $krep2 $krep14 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'ExGADT3 :: GHC.Internal.Prim.Addr# -T18982.$tc'ExGADT3 = "'ExGADT"# +$tc'ExGADT1 :: GHC.Internal.Prim.Addr# +$tc'ExGADT1 = "'ExGADT"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T18982.$tc'ExGADT2 :: GHC.Internal.Types.TrName -T18982.$tc'ExGADT2 = GHC.Internal.Types.TrNameS T18982.$tc'ExGADT3 +$tc'ExGADT2 :: GHC.Internal.Types.TrName +$tc'ExGADT2 = GHC.Internal.Types.TrNameS $tc'ExGADT1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T18982.$tc'ExGADT :: GHC.Internal.Types.TyCon -T18982.$tc'ExGADT = GHC.Internal.Types.TyCon 8468257409157161049#Word64 5503123603717080600#Word64 T18982.$trModule T18982.$tc'ExGADT2 1# T18982.$tc'ExGADT1 +T18982.$tc'ExGADT = GHC.Internal.Types.TyCon 8468257409157161049#Word64 5503123603717080600#Word64 T18982.$trModule $tc'ExGADT2 1# $krep15 --- RHS size: {terms: 11, types: 10, coercions: 0, joins: 0/0} -T18982.$wi :: forall a e. (a GHC.Internal.Prim.~# Int) => e -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -T18982.$wi = \ (@a) (@e) (ww :: a GHC.Internal.Prim.~# Int) (ww1 :: e) (ww2 :: GHC.Internal.Prim.Int#) -> case ww1 of { __DEFAULT -> GHC.Internal.Prim.+# ww2 1# } +-- RHS size: {terms: 12, types: 14, coercions: 0, joins: 0/0} +T18982.$wi :: forall a e. (a GHC.Internal.Prim.~# Int, e ~ Int) => e -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# +T18982.$wi = \ (@a) (@e) (ww :: a GHC.Internal.Prim.~# Int) (ww1 :: e ~ Int) (ww2 :: e) (ww3 :: GHC.Internal.Prim.Int#) -> case ww2 of { __DEFAULT -> GHC.Internal.Prim.+# ww3 1# } --- RHS size: {terms: 15, types: 22, coercions: 1, joins: 0/0} +-- RHS size: {terms: 16, types: 22, coercions: 1, joins: 0/0} i :: forall a. ExGADT a -> Int -i = \ (@a) (ds :: ExGADT a) -> case ds of { ExGADT @e ww ww1 ww2 ww3 -> case ww3 of { GHC.Internal.Types.I# ww4 -> case T18982.$wi @a @e @~(ww :: a GHC.Internal.Prim.~# Int) ww2 ww4 of ww5 { __DEFAULT -> GHC.Internal.Types.I# ww5 } } } +i = \ (@a) (ds :: ExGADT a) -> case ds of { ExGADT @e ww ww1 ww2 ww3 -> case ww3 of { GHC.Internal.Types.I# ww4 -> case T18982.$wi @a @e @~(ww :: a GHC.Internal.Prim.~# Int) ww1 ww2 ww4 of ww5 { __DEFAULT -> GHC.Internal.Types.I# ww5 } } } -- RHS size: {terms: 6, types: 7, coercions: 0, joins: 0/0} T18982.$wh :: forall a. (a GHC.Internal.Prim.~# Int) => GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# ===================================== testsuite/tests/simplCore/should_compile/T26615.stderr ===================================== @@ -2,7 +2,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 1,209, types: 1,155, coercions: 18, joins: 17/29} + = {terms: 1,229, types: 1,163, coercions: 18, joins: 17/29} -- RHS size: {terms: 6, types: 8, coercions: 0, joins: 0/0} unArray :: forall a. Array a -> SmallArray# a @@ -414,7 +414,7 @@ T26615a.$tc'BitmapIndexed 2# $krep24 --- RHS size: {terms: 98, types: 109, coercions: 0, joins: 3/4} +-- RHS size: {terms: 101, types: 113, coercions: 0, joins: 3/4} T26615a.$wdisjointCollisions [InlPrag=INLINABLE[2]] :: forall k a b. Eq k => @@ -561,13 +561,14 @@ T26615a.$wdisjointCollisions joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) + (k1 :: k) (ww3 :: SmallArray# (Leaf k b)) (ww4 :: Int#) (ww5 :: Int#) @@ -578,7 +579,7 @@ T26615a.$wdisjointCollisions { (# ipv2 #) -> case ipv2 of { L kx v -> case == @k $dEq k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww3 (+# ww4 1#) ww5; + False -> jump $wlookupInArrayCont_ $dEq k2 ww3 (+# ww4 1#) ww5; True -> GHC.Internal.Types.False } } @@ -586,7 +587,7 @@ T26615a.$wdisjointCollisions 1# -> jump $j } }; } in - jump $wlookupInArrayCont_ kA ww2 0# lvl2 + jump $wlookupInArrayCont_ $dEq kA ww2 0# lvl2 } }; 1# -> sc3 @@ -611,7 +612,7 @@ lvl1 = GHC.Internal.Control.Exception.Base.patError @LiftedRep @() lvl Rec { --- RHS size: {terms: 133, types: 126, coercions: 0, joins: 1/2} +-- RHS size: {terms: 136, types: 130, coercions: 0, joins: 1/2} T26615a.disjointSubtrees_$s$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] :: forall k a b. @@ -641,13 +642,14 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq [Occ=Dead] :: Eq k) + (k1 :: k) (ww :: SmallArray# (Leaf k a)) (ww1 :: Int#) (ww2 :: Int#) @@ -657,7 +659,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees case indexSmallArray# @Lifted @(Leaf k a) ww ww1 of { (# ipv #) -> case ipv of { L kx v -> case == @k sc k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww (+# ww1 1#) ww2; + False -> jump $wlookupInArrayCont_ sc k2 ww (+# ww1 1#) ww2; True -> GHC.Internal.Types.False } } @@ -666,7 +668,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) + sc k0 sc3 0# (sizeofSmallArray# @Lifted @(Leaf k a) sc3) } } }; @@ -708,7 +710,7 @@ T26615a.disjointSubtrees_$s$wdisjointSubtrees end Rec } Rec { --- RHS size: {terms: 705, types: 748, coercions: 18, joins: 13/23} +-- RHS size: {terms: 719, types: 748, coercions: 18, joins: 13/23} T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] :: forall k a b. Eq k => Int# -> HashMap k a -> HashMap k b -> Bool [GblId[StrictWorker([~, ~, !])], @@ -1065,23 +1067,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> joinrec { @@ -1234,23 +1236,23 @@ T26615a.$wdisjointSubtrees [InlPrag=INLINABLE[2], Occ=LoopBreaker] case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> jump go (GHC.Internal.Types.I# 31#); 1# -> GHC.Internal.Types.False @@ -1310,13 +1312,14 @@ T26615a.$wdisjointSubtrees joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k a) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) + (k1 :: k) (ww2 :: SmallArray# (Leaf k a)) (ww3 :: Int#) (ww4 :: Int#) @@ -1327,7 +1330,8 @@ T26615a.$wdisjointSubtrees { (# ipv #) -> case ipv of { L kx v -> case == @k $dEq k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww2 (+# ww3 1#) ww4; + False -> + jump $wlookupInArrayCont_ $dEq k2 ww2 (+# ww3 1#) ww4; True -> GHC.Internal.Types.False } } @@ -1336,18 +1340,19 @@ T26615a.$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - ds4 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k a) bx2) + $dEq ds4 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k a) bx2) } } in joinrec { $wlookupCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Word# -> k -> Int# -> HashMap k a -> Bool - [LclId[JoinId(4)(Just [~, !, ~, !])], - Arity=4, - Str=<L><1L><L><1L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => Word# -> k -> Int# -> HashMap k a -> Bool + [LclId[JoinId(5)(Just [~, ~, !, ~, !])], + Arity=5, + Str=<A><L><1L><L><1L>, Unf=OtherCon []] - $wlookupCont_ (ww1 :: Word#) + $wlookupCont_ ($dEq1 [Occ=Dead] :: Eq k) + (ww1 :: Word#) (ds4 :: k) (ww2 :: Int#) (ds5 :: HashMap k a) @@ -1371,7 +1376,7 @@ T26615a.$wdisjointSubtrees (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds6 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds6 (+# ww2 5#) ipv }; 0## -> GHC.Internal.Types.True }; @@ -1383,11 +1388,11 @@ T26615a.$wdisjointSubtrees (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds6 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds6 (+# ww2 5#) ipv } } }; } in - jump $wlookupCont_ bx k0 ww ds + jump $wlookupCont_ $dEq bx k0 ww ds } }; Collision bx bx1 -> @@ -1435,13 +1440,14 @@ T26615a.$wdisjointSubtrees joinrec { $wlookupInArrayCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool - [LclId[JoinId(4)(Just [!])], - Arity=4, - Str=<1L><L><L><L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => k -> SmallArray# (Leaf k b) -> Int# -> Int# -> Bool + [LclId[JoinId(5)(Just [~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: k) + $wlookupInArrayCont_ ($dEq1 [Occ=Dead] :: Eq k) + (k1 :: k) (ww2 :: SmallArray# (Leaf k b)) (ww3 :: Int#) (ww4 :: Int#) @@ -1452,7 +1458,7 @@ T26615a.$wdisjointSubtrees { (# ipv #) -> case ipv of { L kx v -> case == @k $dEq k2 kx of { - False -> jump $wlookupInArrayCont_ k2 ww2 (+# ww3 1#) ww4; + False -> jump $wlookupInArrayCont_ $dEq k2 ww2 (+# ww3 1#) ww4; True -> GHC.Internal.Types.False } } @@ -1461,18 +1467,19 @@ T26615a.$wdisjointSubtrees } }; } in jump $wlookupInArrayCont_ - ds3 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k b) bx2) + $dEq ds3 bx2 0# (sizeofSmallArray# @Lifted @(Leaf k b) bx2) } } in joinrec { $wlookupCont_ [InlPrag=[2], Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] - :: Word# -> k -> Int# -> HashMap k b -> Bool - [LclId[JoinId(4)(Just [~, !, ~, !])], - Arity=4, - Str=<L><1L><L><1L>, + Dmd=SC(S,C(1,C(1,C(1,C(1,L)))))] + :: Eq k => Word# -> k -> Int# -> HashMap k b -> Bool + [LclId[JoinId(5)(Just [~, ~, !, ~, !])], + Arity=5, + Str=<A><L><1L><L><1L>, Unf=OtherCon []] - $wlookupCont_ (ww1 :: Word#) + $wlookupCont_ ($dEq1 [Occ=Dead] :: Eq k) + (ww1 :: Word#) (ds3 :: k) (ww2 :: Int#) (ds4 :: HashMap k b) @@ -1496,7 +1503,7 @@ T26615a.$wdisjointSubtrees (word2Int# (popCnt# (and# bx1 (minusWord# m 1##)))) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds5 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds5 (+# ww2 5#) ipv }; 0## -> GHC.Internal.Types.True }; @@ -1508,11 +1515,11 @@ T26615a.$wdisjointSubtrees (word2Int# (and# (uncheckedShiftRL# ww1 ww2) 31##)) of { (# ipv #) -> - jump $wlookupCont_ ww1 ds5 (+# ww2 5#) ipv + jump $wlookupCont_ $dEq ww1 ds5 (+# ww2 5#) ipv } } }; } in - jump $wlookupCont_ bx k0 ww wild2 + jump $wlookupCont_ $dEq bx k0 ww wild2 }; Leaf bx1 ds3 -> case ds3 of { L kB ds4 -> @@ -1570,23 +1577,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> let { @@ -1715,23 +1722,23 @@ T26615a.$wdisjointSubtrees case GHC.Internal.Unsafe.Coerce.unsafeEqualityProof @(*) @(SmallArray# (HashMap k a) -> SmallArray# (HashMap k b) -> Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case reallyUnsafePtrEquality# @Lifted @Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: SmallArray# (HashMap k a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: SmallArray# (HashMap k b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> let { @@ -1838,7 +1845,7 @@ disjointSubtrees ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 614, types: 682, coercions: 18, joins: 8/14} + = {terms: 622, types: 674, coercions: 18, joins: 8/14} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule1 :: GHC.Internal.Prim.Addr# @@ -1878,20 +1885,22 @@ lvl1 @GHC.Internal.Types.LiftedRep @() lvl Rec { --- RHS size: {terms: 37, types: 30, coercions: 0, joins: 0/0} +-- RHS size: {terms: 39, types: 32, coercions: 0, joins: 0/0} $wpoly_lookupInArrayCont_ :: forall a. + Eq String => String -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf String a) -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> Bool -[GblId[StrictWorker([!])], - Arity=4, - Str=<1L><L><L><L>, +[GblId[StrictWorker([~, !])], + Arity=5, + Str=<A><1L><L><L><L>, Unf=OtherCon []] $wpoly_lookupInArrayCont_ = \ (@a) + ($dEq2 [Occ=Dead] :: Eq String) (k1 :: String) (ww :: GHC.Internal.Prim.SmallArray# (T26615a.Leaf String a)) (ww1 :: GHC.Internal.Prim.Int#) @@ -1907,7 +1916,12 @@ $wpoly_lookupInArrayCont_ case GHC.Internal.Base.eqString k2 kx of { False -> $wpoly_lookupInArrayCont_ - @a k2 ww (GHC.Internal.Prim.+# ww1 1#) ww2; + @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 + k2 + ww + (GHC.Internal.Prim.+# ww1 1#) + ww2; True -> GHC.Internal.Types.False } } @@ -1918,17 +1932,19 @@ $wpoly_lookupInArrayCont_ end Rec } Rec { --- RHS size: {terms: 98, types: 73, coercions: 0, joins: 0/1} +-- RHS size: {terms: 102, types: 75, coercions: 0, joins: 0/1} $wpoly_lookupCont_ :: forall a. + Eq String => GHC.Internal.Prim.Word# -> String -> GHC.Internal.Prim.Int# -> HashMap String a -> Bool -[GblId[StrictWorker([~, !, ~, !])], - Arity=4, - Str=<L><1L><L><1L>, +[GblId[StrictWorker([~, ~, !, ~, !])], + Arity=5, + Str=<A><L><1L><L><1L>, Unf=OtherCon []] $wpoly_lookupCont_ = \ (@a) + ($dEq1 [Occ=Dead] :: Eq String) (ww :: GHC.Internal.Prim.Word#) (ds5 :: String) (ww1 :: GHC.Internal.Prim.Int#) @@ -1953,6 +1969,7 @@ $wpoly_lookupCont_ 1# -> $wpoly_lookupInArrayCont_ @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 ds9 bx2 0# @@ -1979,7 +1996,13 @@ $wpoly_lookupCont_ (GHC.Internal.Prim.and# bx1 (GHC.Internal.Prim.minusWord# m 1##)))) of { (# ipv2 #) -> - $wpoly_lookupCont_ @a ww ds9 (GHC.Internal.Prim.+# ww1 5#) ipv2 + $wpoly_lookupCont_ + @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 + ww + ds9 + (GHC.Internal.Prim.+# ww1 5#) + ipv2 }; 0## -> GHC.Internal.Types.True }; @@ -1993,14 +2016,20 @@ $wpoly_lookupCont_ (GHC.Internal.Prim.uncheckedShiftRL# ww ww1) 31##)) of { (# ipv2 #) -> - $wpoly_lookupCont_ @a ww ds9 (GHC.Internal.Prim.+# ww1 5#) ipv2 + $wpoly_lookupCont_ + @a + GHC.Internal.Classes.$fEqList_$s$fEqList1 + ww + ds9 + (GHC.Internal.Prim.+# ww1 5#) + ipv2 } } } end Rec } Rec { --- RHS size: {terms: 448, types: 523, coercions: 18, joins: 8/13} +-- RHS size: {terms: 450, types: 507, coercions: 18, joins: 8/13} T26615.$s$wdisjointSubtrees [InlPrag=[~], Occ=LoopBreaker] :: forall a b. GHC.Internal.Prim.Int# @@ -2021,7 +2050,8 @@ T26615.$s$wdisjointSubtrees T26615a.Empty -> GHC.Internal.Types.True; T26615a.Leaf bx ds2 -> case ds2 of { T26615a.L kB ds3 -> - $wpoly_lookupCont_ @a bx kB ww ds + $wpoly_lookupCont_ + @a GHC.Internal.Classes.$fEqList_$s$fEqList1 bx kB ww ds }; T26615a.Collision bx bx1 -> T26615.$s$wdisjointSubtrees @b @a ww wild ds @@ -2031,7 +2061,9 @@ T26615.$s$wdisjointSubtrees T26615a.Leaf bx ds1 -> case ds1 of { T26615a.L kA ds2 -> case _b of wild2 { - __DEFAULT -> $wpoly_lookupCont_ @b bx kA ww wild2; + __DEFAULT -> + $wpoly_lookupCont_ + @b GHC.Internal.Classes.$fEqList_$s$fEqList1 bx kA ww wild2; T26615a.Leaf bx1 ds3 -> case ds3 of { T26615a.L kB ds4 -> case GHC.Internal.Prim.neWord# bx bx1 of { @@ -2085,9 +2117,9 @@ T26615.$s$wdisjointSubtrees [LclId[JoinId(0)(Nothing)]] $j = jump $s$wfoldr_ sc sc1 (GHC.Internal.Prim.+# sc2 1#) sc3 } in joinrec { - $wlookupInArrayCont_ [InlPrag=[2], - Occ=LoopBreaker, - Dmd=SC(S,C(1,C(1,C(1,L))))] + $w$slookupInArrayCont_ [InlPrag=[2], + Occ=LoopBreaker, + Dmd=SC(S,C(1,C(1,C(1,L))))] :: String -> GHC.Internal.Prim.SmallArray# (T26615a.Leaf String b) -> GHC.Internal.Prim.Int# @@ -2097,12 +2129,12 @@ T26615.$s$wdisjointSubtrees Arity=4, Str=<1L><L><L><L>, Unf=OtherCon []] - $wlookupInArrayCont_ (k1 :: String) - (ww1 - :: GHC.Internal.Prim.SmallArray# - (T26615a.Leaf String b)) - (ww2 :: GHC.Internal.Prim.Int#) - (ww3 :: GHC.Internal.Prim.Int#) + $w$slookupInArrayCont_ (k1 :: String) + (ww1 + :: GHC.Internal.Prim.SmallArray# + (T26615a.Leaf String b)) + (ww2 :: GHC.Internal.Prim.Int#) + (ww3 :: GHC.Internal.Prim.Int#) = case k1 of k2 { __DEFAULT -> case GHC.Internal.Prim.>=# ww2 ww3 of { __DEFAULT -> @@ -2116,7 +2148,7 @@ T26615.$s$wdisjointSubtrees case ipv5 of { T26615a.L kx v -> case GHC.Internal.Base.eqString k2 kx of { False -> - jump $wlookupInArrayCont_ + jump $w$slookupInArrayCont_ k2 ww1 (GHC.Internal.Prim.+# ww2 1#) ww3; True -> GHC.Internal.Types.False } @@ -2125,7 +2157,7 @@ T26615.$s$wdisjointSubtrees 1# -> jump $j } }; } in - jump $wlookupInArrayCont_ kA bx3 0# lvl2 + jump $w$slookupInArrayCont_ kA bx3 0# lvl2 } }; 1# -> sc3 @@ -2187,23 +2219,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx1 `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx3 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> joinrec { @@ -2365,23 +2397,23 @@ T26615.$s$wdisjointSubtrees @(GHC.Internal.Prim.SmallArray# (HashMap String a) -> GHC.Internal.Prim.SmallArray# (HashMap String b) -> GHC.Internal.Prim.Int#) - @(GHC.Internal.Types.UnusedType 0 "a" - -> GHC.Internal.Types.UnusedType 1 "b" -> GHC.Internal.Prim.Int#) + @(GHC.Internal.Types.UnusedType "a_0" + -> GHC.Internal.Types.UnusedType "b_1" -> GHC.Internal.Prim.Int#) of { GHC.Internal.Unsafe.Coerce.UnsafeRefl v2 -> case GHC.Internal.Prim.reallyUnsafePtrEquality# @GHC.Internal.Types.Lifted @GHC.Internal.Types.Lifted - @(GHC.Internal.Types.UnusedType 0 "a") - @(GHC.Internal.Types.UnusedType 1 "b") + @(GHC.Internal.Types.UnusedType "a_0") + @(GHC.Internal.Types.UnusedType "b_1") (bx `cast` (SelCo:Fun(arg) (Sub (Sym v2)) :: GHC.Internal.Prim.SmallArray# (HashMap String a) - ~R# GHC.Internal.Types.UnusedType 0 "a")) + ~R# GHC.Internal.Types.UnusedType "a_0")) (bx1 `cast` (SelCo:Fun(arg) (SelCo:Fun(res) (Sub (Sym v2))) :: GHC.Internal.Prim.SmallArray# (HashMap String b) - ~R# GHC.Internal.Types.UnusedType 1 "b")) + ~R# GHC.Internal.Types.UnusedType "b_1")) of { __DEFAULT -> joinrec { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4e24735545aa600febf194aac86757… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4e24735545aa600febf194aac86757… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/hadrian-target] hadrian: binary-dist-dir should not be the default target
by Zubin (＠wz1000) 02 Jul '26

02 Jul '26

Zubin pushed to branch wip/hadrian-target at Glasgow Haskell Compiler / GHC Commits: 0e020352 by Zubin Duggal at 2026-07-02T21:53:46+05:30 hadrian: binary-dist-dir should not be the default target Revert behaviour to pre 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2 In 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2, we applied the following behaviour change: ``` hadrian: Build stage 2 cross compilers ... * hadrian: Make binary-dist-dir the default build target. This allows us to have the logic in one place about which libraries/stages to build with cross compilers. Fixes #24192 ``` This is a major regression to development experience, a plain hadrian/build --freeze1 now takes ages because we rebuild all docs (which need to go in the binary dist dir). `binary-dist-dir` is the wrong default target for regular GHC development work Fixes #27445 - - - - - 2 changed files: - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs Changes: ===================================== hadrian/src/Rules.hs ===================================== @@ -10,6 +10,7 @@ import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile import qualified Hadrian.Haskell.Hash +import BindistConfig import Expression import qualified Oracles.Flavour import qualified Oracles.ModuleFiles @@ -32,17 +33,49 @@ import Settings.Program (programContext) import Target import UserSettings --- | This rule defines what the default build configuration is when no targets --- are selected. +-- | This rule calls 'need' on all top-level build targets that Hadrian builds +-- by default, respecting the 'finalStage' flag. topLevelTargets :: Rules () topLevelTargets = action $ do - let targets = ["binary-dist-dir"] + verbosity <- getVerbosity + forM_ [ Stage1, Stage2, Stage3] $ \stage -> do + when (verbosity >= Verbose) $ do + (libraries, programs) <- partition isLibrary <$> stagePackages stage + libNames <- mapM (name stage) libraries + pgmNames <- mapM (name stage) programs + let stageHeader t ps = + "| Building " ++ show stage ++ " " + ++ t ++ ": " ++ intercalate ", " ps + putInfo . unlines $ + [ stageHeader "libraries" libNames + , stageHeader "programs" pgmNames ] + let buildStages = [ s | s <- allStages, s < finalStage ] + targets <- concatForM buildStages $ \stage -> do + packages <- stagePackages stage + mapM (path stage) packages + + -- For cross compilers, also build the target (stage 2) libraries. + cfg <- implicitBindistConfig + lib_targets <- if executable_stage cfg < finalStage + then map snd . fst <$> Rules.BinaryDist.bindistPackageTargets cfg + else return [] -- Why we need wrappers: https://gitlab.haskell.org/ghc/ghc/issues/16534. root <- buildRoot let wrappers = [ root -/- ("ghc-" ++ stageString s) | s <- [Stage1, Stage2, Stage3] , s < finalStage ] - need (targets ++ wrappers) + need (targets ++ lib_targets ++ wrappers) + where + -- either the package database config file for libraries or + -- the programPath for programs. However this still does + -- not support multiple targets, where a cabal package has + -- a library /and/ a program. + path :: Stage -> Package -> Action FilePath + path stage pkg | isLibrary pkg = pkgConfFile (vanillaContext stage pkg) + | otherwise = programPath =<< programContext stage pkg + name :: Stage -> Package -> Action String + name stage pkg | isLibrary pkg = return (pkgName pkg) + | otherwise = programName (vanillaContext stage pkg) -- | Return the list of targets associated with a given 'Stage' and 'Package'. packageTargets :: Stage -> Package -> Action [FilePath] ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -124,11 +124,8 @@ installTo relocatable prefix = do runBuilderWithCmdOptions env (Make bindistFilesDir) ["install"] [] [] -buildBinDistDir :: FilePath -> BindistConfig -> Action () -buildBinDistDir root conf@BindistConfig{..} = do - - verbosity <- getVerbosity - -- We 'need' all binaries and libraries +bindistPackageTargets :: BindistConfig -> Action ([(Package, FilePath)], [(Package, FilePath)]) +bindistPackageTargets conf@BindistConfig{..} = do lib_pkgs <- stagePackages library_stage (lib_targets, _) <- partitionEithers <$> mapM (pkgTarget conf) lib_pkgs @@ -137,6 +134,14 @@ buildBinDistDir root conf@BindistConfig{..} = do let excluded_packages = [ genapply ] bin_pkgs = filter (`notElem` excluded_packages) bin_pkgs_all (_, bin_targets) <- partitionEithers <$> mapM (pkgTarget conf) bin_pkgs + return (lib_targets, bin_targets) + +buildBinDistDir :: FilePath -> BindistConfig -> Action () +buildBinDistDir root conf@BindistConfig{..} = do + + verbosity <- getVerbosity + -- We 'need' all binaries and libraries + (lib_targets, bin_targets) <- bindistPackageTargets conf when (verbosity >= Verbose) $ do let libNames = map (pkgName . fst) lib_targets View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e0203528dfbad75f2d6ae79404a84a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e0203528dfbad75f2d6ae79404a84a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/hadrian-target] 42 commits: rts: handle large AP closures in compacting GC
by Zubin (＠wz1000) 02 Jul '26

02 Jul '26

Zubin pushed to branch wip/hadrian-target at Glasgow Haskell Compiler / GHC Commits: cca0d589 by Luite Stegeman at 2026-06-30T13:33:40-04:00 rts: handle large AP closures in compacting GC The function update_fwd_large in the compacting GC could run into an unexpected object with the following error: internal error: update_fwd_large: unknown/strange object 24 Closure type 24 is the AP closure, which was not handled in upd_fwd_large. This patch adds handling them. fixes #27434 - - - - - 42935858 by Luite Stegeman at 2026-06-30T13:33:40-04:00 testsuite: use compacting_gc way instead of hardcoding +RTS -c - - - - - bf7b5ce6 by Alan Zimmerman at 2026-06-30T13:34:23-04:00 EPA: Remove LocatedLW from LStmtLR HsDo already had its XDo extension point for an AnnList, which also appeared in LocatedLW. So we remove the redundant one and use the one inside HsDo as originally intended. Also delete LocatedLC/LocatedLS as they were unused - - - - - d7cfea49 by Recursion Ninja at 2026-06-30T21:37:12-04:00 Decoupling 'L.H.S' from 'GHC.Types.SourceText' * Migrated 'IntegralLit' to 'L.H.S.Lit'. * Migrated 'FractionalLit' to 'L.H.S.Lit'. * Migrated 'StringLiteral' to 'L.H.S.Lit'. * Added TTG extension points to the types above. * Added nice export list to 'GHC.Hs.Lit'. * Added 'rnOverLitVal' and 'tcOverLitVal' functions to 'GHC.Hs.Lit'. * Added instance 'Anno (StringLiteral (GhcPass p)) = SrcSpanAnnN' * Moved [Notes] about 'SourceText' from 'L.H.S.*' to 'GHC.*'. * Removed all references to 'SourceText' from 'L.H.S'. * Removed the trailing comma record field from 'StringLiteral' * Renamed exported functions for nomenclature consistency. * Deprecated the renamed functions Fixes #26953 - - - - - a1f2558b by Recursion Ninja at 2026-06-30T21:37:12-04:00 Monomorphising GHC pass parameters where appropriate - - - - - 7bf9e3c5 by Teo Camarasu at 2026-06-30T21:38:03-04:00 Make Q abstract This patch aims to clearly demarcate the internal and external interfaces of Q. In the past the `Quasi` typeclass was both part of the external, public-facing interface, and was used to give the implementation of `Q`. Now we separate out these two distinct roles. `Quasi` continues to exist in the public interface, but we introduce a new `MetaHandlers` type, which is equivalent to `Dict Quasi`. `Q a` is now defined to be `MetaHandlers -> IO a`, and, crucially, the constructor and the new `MetaHandlers` type are not exposed from the public interface. This gives us the ability to vary the interface on the GHC side without forcing a breaking change on the `template-haskell` side. Similarly `template-haskell` has more freedom to change the `Quasi` typeclass without needing any changes in `lib:ghc`. Implements https://github.com/ghc-proposals/ghc-proposals/pull/700 Resolves #27341 - - - - - 4262af36 by L0neGamer at 2026-06-30T21:38:56-04:00 generically defines mconcat in terms of internal type's Semigroup instance add changelog entry use simpler definition for mconcat `nonEmpty` isn't available yet; inline branches in case add test case fixup generically defines mconcat in terms of internal type's Semigroup instance add comment on Generically and deriving mishaps swap mconcat to foldr version add some strictness testing for mconcat add to `base` changelog entry - - - - - e22ad997 by Cheng Shao at 2026-06-30T21:39:43-04:00 hadrian/rts: fix unregisterised build for gcc 15+ This patch fixes unregisterised build for gcc 15+: - Pass -optc-Wno-error in hadrian when +werror enables -optc-Werror, see added comment for details. - For RTS functions that the codegen would emit calls, ensure their real prototype is hidden when the header is included in .hc fies (IN_STG_CODE), and the dummy prototype is provided to match the EFF_ convention. In the future we should get rid of EFF_ (#14647) and remove these hacks, but for now this patch makes unregisterised work again on newer toolchains. Fixes #27404. Co-authored-by: Codex <codex(a)openai.com> - - - - - 3f00f234 by Cheng Shao at 2026-06-30T21:40:32-04:00 compiler: fix missing handling of CmmUnsafeForeignCall node in LayoutStack This patch fixes missing handling of `CmmUnsafeForeignCall` middle node in the `LayoutStack` pass. Before proc-points splitting, this pass computes liveliness of local registers, and spills those alive across a Cmm native call onto the stack. It need to traverse all middle nodes in each block and check whether a local register is an assignee, if so then the previous mapping in `sm_regs` is invalidated and needs to be dropped. However, it didn't handle `CmmUnsafeForeignCall` node which may also assign to a local register. When proc-points splitting is enabled, this can produce an invalid basic block that doesn't properly backup the updated local register to the stack before doing a Cmm call, resulting in completely invalid runtime behavior. The patch also adds a `T27447` regression test. With no-TNTC or with LLVM backend, without the fix the test case would output a stale 0x1111111111111111 value, instead of the expected 0x2222222222222222 output. Fixes #27447. Co-authored-by: Codex <codex(a)openai.com> - - - - - 701088db by Ben Gamari at 2026-07-01T10:34:03-04:00 gitlab-ci: Drop vestigial references to make build system - - - - - 62d54a53 by Ben Gamari at 2026-07-01T10:34:03-04:00 gitlab-ci: Add support for running specifying a job's testsuite ways - - - - - 7f97ac2c by Ben Gamari at 2026-07-01T10:34:03-04:00 gitlab-ci: Run llvm testsuite ways in llvm jobs Addresses #25762. - - - - - 7ea75116 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Add normalise_ddump_deriv setup function Some tests check the result of -ddump-deriv, which may contain INLINE pragmas depending on optimization flags. With normalise_ddump_deriv setup function, INLINE pragmas are stripped off. - - - - - c7a8199f by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Use -dsuppress-idinfo to make tests more robust Previously, T18052a and T21755 were failing on 'optasm' and 'optllvm' ways because of visibility of unfoldings. - - - - - a12122e5 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Use a trick to keep large objects alive Previously, T17574 and T19381 were failing on 'optasm' and 'optllvm' ways because of compiler optimizations. Change them to use NOINLINE to prevent unwanted optimizations. - - - - - 1a95b327 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Only run T24224 in 'normal' way This test is a frontend-only one and breaks if optimizations are enabled. - - - - - 8abea737 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Ignore T18118's stderr When optimizations are enabled, the compiler emits a warning (You cannot SPECIALISE ...). The message is not important, so ignore it. - - - - - 9453a722 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Mark T816 and tc216 broken with optimizations These tests are about type checking, so we should not care too much if they are broken with optimizations. See #26952 - - - - - 0aef9ec0 by Ben Gamari at 2026-07-01T10:34:03-04:00 testsuite: ds014 is not longer broken It now appears to pass in the ways it was marked as broken in. Closes #14901. - - - - - 4692d1e4 by Ben Gamari at 2026-07-01T10:34:03-04:00 testsuite: Only run stack cloning tests in the normal way These are too dependent upon code generation specifics to pass in most other ways. - - - - - c154df26 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Update options_ghc_fbyte-code The `-fbyte-code` option used to be overriden by `-fllvm` but it is no longer true since !14872 was merged. I updated the test to accept the new behavior. Closes #27049 - - - - - 5d8bb7b5 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Only run T22744 in 'normal' way This test takes a long time on optimized ways. - - - - - d1e74c8e by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Disable tests that use -finfo-table-map on llvm ways Currently, -finfo-table-map does not work with -fllvm. See #26435 - - - - - 3bf38c84 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Don't run T24726 on optimized ways If optimizations are enabled, the rewrite rule just fires and -drule-check will report nothing. - - - - - e4eef116 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Use -fno-unoptimized-core-for-interpreter when running LinkableUsage01/02 Optimizations for the bytecode interpreter are considered experimental, and need a flag to be enabled. - - - - - 234a9872 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Suppress unwanted optimizations on T25284 - - - - - 99a2af2f by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Don't run stack_big_ret with optimizations Stack layout may change with optimizations enabled. - - - - - 04c836df by ARATA Mizuki at 2026-07-01T10:34:04-04:00 testsuite: Mark memo001 broken on optimized ways See #27396 - - - - - 1a8a24f4 by ARATA Mizuki at 2026-07-01T10:34:04-04:00 testsuite: Mark syn-perf broken on optimized ways See #27398 - - - - - 40412093 by Duncan Coutts at 2026-07-01T10:34:50-04:00 Add a test for thread scheduler fairness It also tests that the interval timer and context switching works. We also test that fairness is lost when the context switching interval is too coarse for the duration of the test. We add this test before doing surgery on the interval timer, so we have decent coverage. - - - - - 3f34d557 by Duncan Coutts at 2026-07-01T10:34:50-04:00 Make exported stop/startTimer no-ops, and rename internal functions Specifically, internally rename: stop/startTimer to pause/unpauseTimer stop/startTicker to pause/unpauseTicker and keep stop/startTimer as exported functions, but now as no-ops. In the past the stop/startTicker actions were used incorrectly as if they were synchronous, which they are not. See issue #27105. We now document pause/unpackTicker as being async and not to be used for the purpose of concurrency safety. The existing stop/startTimer (note Timer not Ticker, the Timer calls the Ticker!) are also exported from the RTS as a public API. This was historically because the ticker used signals and it was important to suspend the timer signel over a process fork. So these functions were exported to be used by the process and unix libraries. We cannot just remove the RTS exports, but we now make them no-ops, and they can be removed from the process and unix library later. This was already documented in a changelog.d entry no-more-timer-signal but due to changes during the MR process the change to make stop/startTicker into no-ops didn't make it into the earlier MR. - - - - - 02e84e5f by Duncan Coutts at 2026-07-01T10:34:51-04:00 Make exitTicker/exitTimer unconditionally synchronous We never use them asynchronously, and we should never need to do so. And update some related comments. - - - - - 13db6a72 by Duncan Coutts at 2026-07-01T10:34:51-04:00 posix ticker: update and improve comments on (un)pause and exit Clarify what is async vs sync. - - - - - 43d9a07d by Duncan Coutts at 2026-07-01T10:34:51-04:00 posix ticker: split out ppoll/select helper functions Move the #ifdefs out of the main code body by introducing local helper functions and types, which themselves have two implementations (with a common API) based on ppoll or select. This helps improve clarity/readability. - - - - - a5491baa by Duncan Coutts at 2026-07-01T10:34:51-04:00 posix ticker: improve the implementation The existing implementation supported pausing and exiting, with the implementation of pausing reling on a mutex and condition variable. It needed to check the pause and stop shared variables on every iteration. It relies on ppoll or select, to wait on the timeout and also wait on an interrupt fd. The interrupt fd was only used for prompt exit/shutdown, and not for pausing or other notification. The pause only needed a lock and a memory operation, but the pause was not prompt. The resume used a lock, and signaling a cond var. The new implementation uses a somewhat more regular design: every notification is done by setting a shared variable and interrupting/notifying the ticker via the fd. The ticker thread does not need to check any shared variables on normal timer expiry, only when it recevies notification. This may be a micro-optimisation, but the tick occurs 100 times a second by default so any improvements in the hot path are amplified. When the ticker thread does receive notification it can check the various shared variables and update its local state. The blocking relies on using ppoll/select but without a timeout. This avoids the condition var and also allows further notifications when paused (also used for unpausing). This design can be extended with further notification types if needed by using and checking further shared vars (or making existing shared vars an enum or counter). This may be used in future for additional notifications to the ticker thread. This will likely be used to proxy wakeUpRts from a single handler context for example. And this approach, avoiding mutexes, is compatible with use from signal handlers. So overall, it's: * slightly simpler / more regular; * easier to extend with additional notifications; * probably slightly more efficient (but a micro-optimisation); * and supports calling notification from signal handlers - - - - - 5b20821e by Duncan Coutts at 2026-07-01T10:34:51-04:00 posix ticker: further minor local renaming for code clarity Improve the clarity with better choice of names for several local vars and function. - - - - - 1f3ec5e0 by Duncan Coutts at 2026-07-01T10:34:51-04:00 win32 ticker: split out local helper functions - - - - - 596e7307 by Duncan Coutts at 2026-07-01T10:34:51-04:00 win32 ticker: provide guarantee about concurrency and idempotency Use a lock to ensure pause/unpause can be used concurrently. Use a paused variable, protected by the lock, to ensure that pause and unpause are both idempotent. This is what the portable API expects. - - - - - 1870edd7 by Duncan Coutts at 2026-07-01T10:34:51-04:00 win32 ticker: make the initial tick be after one wait interval There is no need to tick immediately. This is consistent with the posix implementation. - - - - - 7c15ab5b by Duncan Coutts at 2026-07-01T10:34:51-04:00 ticker: remove now-unnecessary layer of enable/disable There was an atomic variable used to block *part* of the actions of the tick handler. This still did not make stopTimer synchronous, even for the part of the the handle_tick actions it covered. It also added a more expensive (sequentuially consistent) atomic operation in the hot path for the handle_tick action, whereas our new design requires no atomic ops at all. Now that we have eliminate the need for synchronous stop/startTicker, we don't need this not-quite-working-anyway atomic protocol. The new pause/unpauseTicker is explicitly asynchronous and idempotent. - - - - - 8585f8cb by Duncan Coutts at 2026-07-01T10:34:51-04:00 ticker: add TODOs about issue #27250: too much being done from handle_tick The handle_tick should not perform I/O, block, perform long-running operations or call arbitrary user code. Unfortunately, everything to do with the eventlog (at the moment) falls into all those categories. - - - - - 0bd4c106 by Zubin Duggal at 2026-07-02T21:46:18+05:30 hadrian: binary-dist-dir should not be the default target Revert behaviour to pre 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2 In 23c9b6c392f52ec9d7a8618b204ff6b885f5fba2, we applied the following behaviour change: ``` hadrian: Build stage 2 cross compilers ... * hadrian: Make binary-dist-dir the default build target. This allows us to have the logic in one place about which libraries/stages to build with cross compilers. Fixes #24192 ``` This is a major regression to development experience, a plain hadrian/build --freeze1 now takes ages because we rebuild all docs (which need to go in the binary dist dir). `binary-dist-dir` is the wrong default target for regular GHC development work Fixes #27445 - - - - - 137 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - + changelog.d/AbstractQ - + changelog.d/fix-compacting-gc-ap-27434 - + changelog.d/fix-layout-stack-fcall - + changelog.d/fix-unreg - + changelog.d/generically-mconcat - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Warnings.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Lit.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Gen/Splice.hs-boot - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/PkgQual.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Decls/Foreign.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - hadrian/src/Flavour.hs - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs - libraries/base/changelog.md - libraries/base/tests/all.T - libraries/ghc-heap/tests/all.T - libraries/ghc-internal/src/GHC/Internal/Generics.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs - libraries/ghci/GHCi/TH.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - rts/RtsStartup.c - rts/Schedule.c - rts/Ticker.h - rts/Timer.c - rts/Timer.h - rts/include/rts/NonMoving.h - rts/include/rts/Timer.h - rts/include/stg/MiscClosures.h - rts/posix/Ticker.c - rts/sm/Compact.c - rts/win32/Ticker.c - testsuite/driver/testlib.py - testsuite/tests/arityanal/should_compile/T21755.stderr - testsuite/tests/arityanal/should_compile/all.T - testsuite/tests/bytecode/TLinkable/all.T - testsuite/tests/cmm/should_compile/all.T - + testsuite/tests/cmm/should_run/T27447.hs - + testsuite/tests/cmm/should_run/T27447.stdout - + testsuite/tests/cmm/should_run/T27447_cmm.cmm - testsuite/tests/cmm/should_run/all.T - + testsuite/tests/concurrent/should_run/T27105.hs - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/core-to-stg/T25284/Cls.hs - testsuite/tests/deSugar/should_fail/all.T - testsuite/tests/deSugar/should_run/all.T - testsuite/tests/deriving/should_compile/all.T - testsuite/tests/driver/options_ghc/Mod_fbyte_code.hs - testsuite/tests/driver/options_ghc/all.T - testsuite/tests/driver/options_ghc/options_ghc_fbyte-code.stderr - testsuite/tests/generics/GenDerivOutput.hs - testsuite/tests/generics/GenDerivOutput1_0.hs - testsuite/tests/generics/GenDerivOutput1_1.hs - testsuite/tests/generics/T10604/T10604_deriving.hs - testsuite/tests/generics/T10604/all.T - + testsuite/tests/generics/T27245.hs - + testsuite/tests/generics/T27245.stdout - testsuite/tests/generics/all.T - testsuite/tests/ghc-api/annotations-literals/literals.stdout - testsuite/tests/ghc-api/annotations-literals/parsed.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/template-haskell-exports.stdout - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/T18052a.stderr - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/all.T - testsuite/tests/profiling/perf/T23103/all.T - testsuite/tests/profiling/should_run/all.T - testsuite/tests/rts/T17574.hs - testsuite/tests/rts/T19381.hs - + testsuite/tests/rts/T27434.hs - + testsuite/tests/rts/T27434.stdout - testsuite/tests/rts/all.T - testsuite/tests/rts/ipe/T24005/all.T - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/typecheck/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b07092bb9db2691eb45448e6c4e06… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b07092bb9db2691eb45448e6c4e06… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/udfm-placement] UniqDFM: make head-element cost explicit in Note [Cost of deterministic iteration]
by Simon Jakobi (＠sjakobi2) 02 Jul '26

02 Jul '26

Simon Jakobi pushed to branch wip/sjakobi/udfm-placement at Glasgow Haskell Compiler / GHC Commits: 9da8424e by Simon Jakobi at 2026-07-02T17:59:23+02:00 UniqDFM: make head-element cost explicit in Note [Cost of deterministic iteration] Spell out that producing even the first element allocates an O(n)-sized array (or O(n log n) cons cells on the fallback path), and that laziness does not make the iteration incremental. Assisted-by: Claude Fable 5 - - - - - 1 changed file: - compiler/GHC/Types/Unique/DFM.hs Changes: ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -351,11 +351,12 @@ nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Deterministic iteration orders elements by insertion tag, and any such -- ordering must inspect every element's tag before it can emit the first --- element. So even the head of the result costs a full O(n) traversal of the --- map -- the iteration is not incremental, and laziness in the result list (see --- Note [Placement sort in eltsUDFM]) saves allocation for undemanded --- elements, not that up-front traversal. #27459 shows this cost biting in --- consumers that demanded only the head. +-- element. So even the head of the result costs a full traversal of the map +-- plus the allocation of an O(n)-sized array -- or, on the fallback path, +-- O(n log n) cons cells (see Note [Placement sort in eltsUDFM]). Laziness in +-- the result list only avoids allocating for elements that are never +-- demanded; it does not make the iteration incremental. #27459 shows this +-- cost biting in consumers that demanded only the head. -- -- So: to test for emptiness, use isNullUDFM rather than null on eltsUDFM; -- for order-oblivious queries, prefer short-circuiting anyUDFM/allUDFM; and View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9da8424e1da6991f9493f5e91f77b46… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9da8424e1da6991f9493f5e91f77b46… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/hadrian-target
by Zubin (＠wz1000) 02 Jul '26

02 Jul '26

Zubin pushed new branch wip/hadrian-target at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hadrian-target You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/ast-ohne-faststring] 33 commits: gitlab-ci: Drop vestigial references to make build system
by Rodrigo Mesquita (＠alt-romes) 02 Jul '26

02 Jul '26

Rodrigo Mesquita pushed to branch wip/romes/ast-ohne-faststring at Glasgow Haskell Compiler / GHC Commits: 701088db by Ben Gamari at 2026-07-01T10:34:03-04:00 gitlab-ci: Drop vestigial references to make build system - - - - - 62d54a53 by Ben Gamari at 2026-07-01T10:34:03-04:00 gitlab-ci: Add support for running specifying a job's testsuite ways - - - - - 7f97ac2c by Ben Gamari at 2026-07-01T10:34:03-04:00 gitlab-ci: Run llvm testsuite ways in llvm jobs Addresses #25762. - - - - - 7ea75116 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Add normalise_ddump_deriv setup function Some tests check the result of -ddump-deriv, which may contain INLINE pragmas depending on optimization flags. With normalise_ddump_deriv setup function, INLINE pragmas are stripped off. - - - - - c7a8199f by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Use -dsuppress-idinfo to make tests more robust Previously, T18052a and T21755 were failing on 'optasm' and 'optllvm' ways because of visibility of unfoldings. - - - - - a12122e5 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Use a trick to keep large objects alive Previously, T17574 and T19381 were failing on 'optasm' and 'optllvm' ways because of compiler optimizations. Change them to use NOINLINE to prevent unwanted optimizations. - - - - - 1a95b327 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Only run T24224 in 'normal' way This test is a frontend-only one and breaks if optimizations are enabled. - - - - - 8abea737 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Ignore T18118's stderr When optimizations are enabled, the compiler emits a warning (You cannot SPECIALISE ...). The message is not important, so ignore it. - - - - - 9453a722 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Mark T816 and tc216 broken with optimizations These tests are about type checking, so we should not care too much if they are broken with optimizations. See #26952 - - - - - 0aef9ec0 by Ben Gamari at 2026-07-01T10:34:03-04:00 testsuite: ds014 is not longer broken It now appears to pass in the ways it was marked as broken in. Closes #14901. - - - - - 4692d1e4 by Ben Gamari at 2026-07-01T10:34:03-04:00 testsuite: Only run stack cloning tests in the normal way These are too dependent upon code generation specifics to pass in most other ways. - - - - - c154df26 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Update options_ghc_fbyte-code The `-fbyte-code` option used to be overriden by `-fllvm` but it is no longer true since !14872 was merged. I updated the test to accept the new behavior. Closes #27049 - - - - - 5d8bb7b5 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Only run T22744 in 'normal' way This test takes a long time on optimized ways. - - - - - d1e74c8e by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Disable tests that use -finfo-table-map on llvm ways Currently, -finfo-table-map does not work with -fllvm. See #26435 - - - - - 3bf38c84 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Don't run T24726 on optimized ways If optimizations are enabled, the rewrite rule just fires and -drule-check will report nothing. - - - - - e4eef116 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Use -fno-unoptimized-core-for-interpreter when running LinkableUsage01/02 Optimizations for the bytecode interpreter are considered experimental, and need a flag to be enabled. - - - - - 234a9872 by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Suppress unwanted optimizations on T25284 - - - - - 99a2af2f by ARATA Mizuki at 2026-07-01T10:34:03-04:00 testsuite: Don't run stack_big_ret with optimizations Stack layout may change with optimizations enabled. - - - - - 04c836df by ARATA Mizuki at 2026-07-01T10:34:04-04:00 testsuite: Mark memo001 broken on optimized ways See #27396 - - - - - 1a8a24f4 by ARATA Mizuki at 2026-07-01T10:34:04-04:00 testsuite: Mark syn-perf broken on optimized ways See #27398 - - - - - 40412093 by Duncan Coutts at 2026-07-01T10:34:50-04:00 Add a test for thread scheduler fairness It also tests that the interval timer and context switching works. We also test that fairness is lost when the context switching interval is too coarse for the duration of the test. We add this test before doing surgery on the interval timer, so we have decent coverage. - - - - - 3f34d557 by Duncan Coutts at 2026-07-01T10:34:50-04:00 Make exported stop/startTimer no-ops, and rename internal functions Specifically, internally rename: stop/startTimer to pause/unpauseTimer stop/startTicker to pause/unpauseTicker and keep stop/startTimer as exported functions, but now as no-ops. In the past the stop/startTicker actions were used incorrectly as if they were synchronous, which they are not. See issue #27105. We now document pause/unpackTicker as being async and not to be used for the purpose of concurrency safety. The existing stop/startTimer (note Timer not Ticker, the Timer calls the Ticker!) are also exported from the RTS as a public API. This was historically because the ticker used signals and it was important to suspend the timer signel over a process fork. So these functions were exported to be used by the process and unix libraries. We cannot just remove the RTS exports, but we now make them no-ops, and they can be removed from the process and unix library later. This was already documented in a changelog.d entry no-more-timer-signal but due to changes during the MR process the change to make stop/startTicker into no-ops didn't make it into the earlier MR. - - - - - 02e84e5f by Duncan Coutts at 2026-07-01T10:34:51-04:00 Make exitTicker/exitTimer unconditionally synchronous We never use them asynchronously, and we should never need to do so. And update some related comments. - - - - - 13db6a72 by Duncan Coutts at 2026-07-01T10:34:51-04:00 posix ticker: update and improve comments on (un)pause and exit Clarify what is async vs sync. - - - - - 43d9a07d by Duncan Coutts at 2026-07-01T10:34:51-04:00 posix ticker: split out ppoll/select helper functions Move the #ifdefs out of the main code body by introducing local helper functions and types, which themselves have two implementations (with a common API) based on ppoll or select. This helps improve clarity/readability. - - - - - a5491baa by Duncan Coutts at 2026-07-01T10:34:51-04:00 posix ticker: improve the implementation The existing implementation supported pausing and exiting, with the implementation of pausing reling on a mutex and condition variable. It needed to check the pause and stop shared variables on every iteration. It relies on ppoll or select, to wait on the timeout and also wait on an interrupt fd. The interrupt fd was only used for prompt exit/shutdown, and not for pausing or other notification. The pause only needed a lock and a memory operation, but the pause was not prompt. The resume used a lock, and signaling a cond var. The new implementation uses a somewhat more regular design: every notification is done by setting a shared variable and interrupting/notifying the ticker via the fd. The ticker thread does not need to check any shared variables on normal timer expiry, only when it recevies notification. This may be a micro-optimisation, but the tick occurs 100 times a second by default so any improvements in the hot path are amplified. When the ticker thread does receive notification it can check the various shared variables and update its local state. The blocking relies on using ppoll/select but without a timeout. This avoids the condition var and also allows further notifications when paused (also used for unpausing). This design can be extended with further notification types if needed by using and checking further shared vars (or making existing shared vars an enum or counter). This may be used in future for additional notifications to the ticker thread. This will likely be used to proxy wakeUpRts from a single handler context for example. And this approach, avoiding mutexes, is compatible with use from signal handlers. So overall, it's: * slightly simpler / more regular; * easier to extend with additional notifications; * probably slightly more efficient (but a micro-optimisation); * and supports calling notification from signal handlers - - - - - 5b20821e by Duncan Coutts at 2026-07-01T10:34:51-04:00 posix ticker: further minor local renaming for code clarity Improve the clarity with better choice of names for several local vars and function. - - - - - 1f3ec5e0 by Duncan Coutts at 2026-07-01T10:34:51-04:00 win32 ticker: split out local helper functions - - - - - 596e7307 by Duncan Coutts at 2026-07-01T10:34:51-04:00 win32 ticker: provide guarantee about concurrency and idempotency Use a lock to ensure pause/unpause can be used concurrently. Use a paused variable, protected by the lock, to ensure that pause and unpause are both idempotent. This is what the portable API expects. - - - - - 1870edd7 by Duncan Coutts at 2026-07-01T10:34:51-04:00 win32 ticker: make the initial tick be after one wait interval There is no need to tick immediately. This is consistent with the posix implementation. - - - - - 7c15ab5b by Duncan Coutts at 2026-07-01T10:34:51-04:00 ticker: remove now-unnecessary layer of enable/disable There was an atomic variable used to block *part* of the actions of the tick handler. This still did not make stopTimer synchronous, even for the part of the the handle_tick actions it covered. It also added a more expensive (sequentuially consistent) atomic operation in the hot path for the handle_tick action, whereas our new design requires no atomic ops at all. Now that we have eliminate the need for synchronous stop/startTicker, we don't need this not-quite-working-anyway atomic protocol. The new pause/unpauseTicker is explicitly asynchronous and idempotent. - - - - - 8585f8cb by Duncan Coutts at 2026-07-01T10:34:51-04:00 ticker: add TODOs about issue #27250: too much being done from handle_tick The handle_tick should not perform I/O, block, perform long-running operations or call arbitrary user code. Unfortunately, everything to do with the eventlog (at the moment) falls into all those categories. - - - - - 8d69c720 by Rodrigo Mesquita at 2026-07-02T16:46:41+01:00 ttg: Using Text over FastString in the AST To make the AST independent of GHC, this commit replaces usages of `FastString` with `HText` in the AST, killing the last edge from Language.Haskell.* to GHC.* modules. Even though we /do/ want to use FastStrings in general -- critically in Names or Ids -- there is no particular reason for the FastStrings that occur in the AST proper to be FastStrings. Strings in the AST are typically unique and don't benefit particularly from being interned FastStrings with Uniques for fast comparison. `HText` is a type synonym for `ShortText` which uses GHC's Modified UTF-8 encoding exclusively. Modified UTF-8 must be used to represent the Haskell AST because the Haskell Report allows surrogate code points. `Data.Text.Text` functions use Standard UTF-8 which replace surrogates with a placeholder value, thus `Data.Text.Text` is unsuitable for AST strings. See the `Language.Haskell.Syntax.Text` module header for more details. Final progress towards #21592 Closes #21628 - - - - - 138 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - + changelog.d/T21628 - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Data/StringBuffer.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Foreign.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Literal.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Basic.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Decls/Foreign.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Language/Haskell/Syntax/Module/Name.hs - + compiler/Language/Haskell/Syntax/Text.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/ghc.cabal.in - libraries/base/tests/all.T - libraries/ghc-boot/GHC/Data/ShortText.hs - libraries/ghc-heap/tests/all.T - rts/RtsStartup.c - rts/Schedule.c - rts/Ticker.h - rts/Timer.c - rts/Timer.h - rts/include/rts/Timer.h - rts/posix/Ticker.c - rts/win32/Ticker.c - testsuite/driver/testlib.py - testsuite/tests/arityanal/should_compile/T21755.stderr - testsuite/tests/arityanal/should_compile/all.T - testsuite/tests/bytecode/TLinkable/all.T - testsuite/tests/cmm/should_compile/all.T - + testsuite/tests/concurrent/should_run/T27105.hs - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/core-to-stg/T25284/Cls.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/deSugar/should_fail/all.T - testsuite/tests/deSugar/should_run/all.T - testsuite/tests/deriving/should_compile/all.T - testsuite/tests/driver/options_ghc/Mod_fbyte_code.hs - testsuite/tests/driver/options_ghc/all.T - testsuite/tests/driver/options_ghc/options_ghc_fbyte-code.stderr - testsuite/tests/generics/GenDerivOutput.hs - testsuite/tests/generics/GenDerivOutput1_0.hs - testsuite/tests/generics/GenDerivOutput1_1.hs - testsuite/tests/generics/T10604/T10604_deriving.hs - testsuite/tests/generics/T10604/all.T - testsuite/tests/generics/all.T - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr - + testsuite/tests/parser/should_run/StringStartsWithNull.hs - + testsuite/tests/parser/should_run/StringStartsWithNull.stdout - testsuite/tests/parser/should_run/all.T - testsuite/tests/perf/compiler/all.T - testsuite/tests/perf/compiler/hard_hole_fits.stderr - testsuite/tests/printer/T18052a.stderr - testsuite/tests/printer/all.T - testsuite/tests/profiling/perf/T23103/all.T - testsuite/tests/profiling/should_run/all.T - testsuite/tests/rts/T17574.hs - testsuite/tests/rts/T19381.hs - testsuite/tests/rts/all.T - testsuite/tests/rts/ipe/T24005/all.T - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/typecheck/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/check-exact.cabal - utils/haddock/haddock-api/haddock-api.cabal - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ae75a6a3e6a8a221af43082d85ed0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ae75a6a3e6a8a221af43082d85ed0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/udfm-placement] UniqDFM: add Note [Cost of deterministic iteration]
by Simon Jakobi (＠sjakobi2) 02 Jul '26

02 Jul '26

Simon Jakobi pushed to branch wip/sjakobi/udfm-placement at Glasgow Haskell Compiler / GHC Commits: 66057bcf by Simon Jakobi at 2026-07-02T16:46:29+02:00 UniqDFM: add Note [Cost of deterministic iteration] Deterministic iteration cannot be incremental: even the head of the result costs a full O(n) traversal, as observed in #27459. Document this in a new Note and reference it from eltsUDFM, foldUDFM, udfmToList, the Foldable/Traversable instances, and the module head. Assisted-by: Claude Fable 5 - - - - - 1 changed file: - compiler/GHC/Types/Unique/DFM.hs Changes: ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -99,7 +99,8 @@ import qualified GHC.Data.Word64Set as W -- -- There is an implementation cost: each element is given a serial number -- as it is added, and `udfmToList` orders its result by this serial number --- (see Note [Placement sort in eltsUDFM]). So you should only use `UniqDFM` +-- (see Note [Placement sort in eltsUDFM] and +-- Note [Cost of deterministic iteration]). So you should only use `UniqDFM` -- if you need the deterministic property. -- -- `foldUDFM` also preserves determinism. @@ -159,11 +160,15 @@ data UniqDFM key ele = -- time. See Note [Overflow on plusUDFM] deriving (Data, Functor) --- | Deterministic. See Note [Placement sort in eltsUDFM] for the cost. +-- | Deterministic. +-- +-- See Note [Cost of deterministic iteration]. instance Foldable (UniqDFM key) where foldr = foldUDFM --- | Deterministic. See Note [Placement sort in eltsUDFM] for the cost. +-- | Deterministic. +-- +-- See Note [Cost of deterministic iteration]. instance Traversable (UniqDFM key) where traverse f = fmap listToUDFM_Directly . traverse (\(u,a) -> (u,) <$> f a) @@ -316,14 +321,18 @@ elemUDFM :: Uniquable key => key -> UniqDFM key elt -> Bool elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m -- | Performs a deterministic fold over the UniqDFM. +-- -- It's O(n) in the common case, with an O(n log n) fallback --- (see Note [Placement sort in eltsUDFM]). +-- (see Note [Placement sort in eltsUDFM]), and pays that in full even if +-- only a prefix is demanded (see Note [Cost of deterministic iteration]). foldUDFM :: (elt -> a -> a) -> a -> UniqDFM key elt -> a {-# INLINE foldUDFM #-} -- This INLINE prevents a regression in !10568 foldUDFM k z m = foldr k z (eltsUDFM m) --- | Like 'foldUDFM' but the function also receives a key +-- | Like 'foldUDFM' but the function also receives a key. +-- +-- See Note [Cost of deterministic iteration]. foldWithKeyUDFM :: (Unique -> elt -> a -> a) -> a -> UniqDFM key elt -> a {-# INLINE foldWithKeyUDFM #-} -- This INLINE was copied from foldUDFM @@ -338,6 +347,24 @@ nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m where k' acc (TaggedVal v _) = k v acc +-- Note [Cost of deterministic iteration] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Deterministic iteration orders elements by insertion tag, and any such +-- ordering must inspect every element's tag before it can emit the first +-- element. So even the head of the result costs a full O(n) traversal of the +-- map -- the iteration is not incremental, and laziness in the result list (see +-- Note [Placement sort in eltsUDFM]) saves allocation for undemanded +-- elements, not that up-front traversal. #27459 shows this cost biting in +-- consumers that demanded only the head. +-- +-- So: to test for emptiness, use isNullUDFM rather than null on eltsUDFM; +-- for order-oblivious queries, prefer short-circuiting anyUDFM/allUDFM; and +-- if you don't need the deterministic order at all, use the nonDet functions +-- (with a justification). + +-- | Deterministic, in order of insertion. +-- +-- See Note [Cost of deterministic iteration]. eltsUDFM :: UniqDFM key elt -> [elt] {-# INLINE eltsUDFM #-} -- The INLINE makes it a good producer (from the map) @@ -359,7 +386,8 @@ sort_it m = sortBy (compare `on` taggedSnd) (M.elems m) -- its tag, freeze, and read out in index order. That's O(i) work (which -- subsumes the O(n) fill, since distinct tags force n <= i), no comparisons, -- and the readout is lazy, so consumers that demand only a prefix pay almost --- nothing beyond the fill. +-- nothing beyond the fill (but the fill itself is unavoidable; see +-- Note [Cost of deterministic iteration]). -- -- Holes: slots whose tag never occurs keep the initial sentinel, a TaggedVal -- with tag -1. Real tags are non-negative, so the readout skips on tag < 0; @@ -378,7 +406,9 @@ usePlacement :: Int -> Int -> Bool usePlacement n i = i <= 4 * n -- | Order a list of 'TaggedVal's by tag, by placing each at array index = --- its tag. The tags must be distinct and in @[0, i)@. +-- its tag. +-- +-- The tags must be distinct and in @[0, i)@. -- See Note [Placement sort in eltsUDFM]. placementSort :: forall r. Int -> [TaggedVal r] -> [r] placementSort i tvs = runST (ST (\s0 -> @@ -420,8 +450,10 @@ udfmRestrictKeysSet (UDFM val_set i) set = in UDFM (M.restrictKeys val_set key_set) i -- | Converts `UniqDFM` to a list, with elements in deterministic order. +-- -- It's O(n) in the common case, with an O(n log n) fallback --- (see Note [Placement sort in eltsUDFM]). +-- (see Note [Placement sort in eltsUDFM]), and pays that in full even if +-- only a prefix is demanded (see Note [Cost of deterministic iteration]). udfmToList :: UniqDFM key elt -> [(Unique, elt)] udfmToList (UDFM m i) | n <= 1 = [ (mkUniqueGrimily k, taggedFst v) | (k, v) <- M.toList m ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66057bcf09f120f72f8247dfe9f5915… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66057bcf09f120f72f8247dfe9f5915… You're receiving this email because of your account on gitlab.haskell.org.

1 0