- ghc-commits - Haskell.org

[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

[Git][ghc/ghc][wip/semaphore-compat-2.0.1] Bump semaphore-compat submodule to 2.0.1
by Zubin (＠wz1000) 02 Jul '26

02 Jul '26

Zubin pushed to branch wip/semaphore-compat-2.0.1 at Glasgow Haskell Compiler / GHC Commits: 3a0c0693 by Zubin Duggal at 2026-07-02T20:02:08+05:30 Bump semaphore-compat submodule to 2.0.1 This versions includes some cruicial fixes for darwin - - - - - 2 changed files: - changelog.d/semaphore-v2 - libraries/semaphore-compat Changes: ===================================== changelog.d/semaphore-v2 ===================================== @@ -2,7 +2,7 @@ section: compiler issues: #25087 mrs: !15729 synopsis: - Update to semaphore-compat 2.0.0 (``-jsem`` protocol v2) + Update to semaphore-compat 2.0.1 (``-jsem`` protocol v2) description: On Linux and other POSIX platforms, GHC's ``-jsem`` jobserver client now speaks v2 of the semaphore-compat protocol, which uses Unix ===================================== libraries/semaphore-compat ===================================== @@ -1 +1 @@ -Subproject commit 44e7488dd93cbf333ceca1319a60146898f6224f +Subproject commit ebcb68506e67de9c8190c0394e10c913593d85da View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a0c06935946314f0c70543ea05c9fe… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a0c06935946314f0c70543ea05c9fe… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T27466
by Simon Peyton Jones (＠simonpj) 02 Jul '26

02 Jul '26

Simon Peyton Jones pushed new branch wip/T27466 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T27466 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: 67814479 by Simon Jakobi at 2026-07-02T16:09:28+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 on insertion tags, allocating ~n*log n cons cells per call; in the profile of #27459 this pipeline accounted for a large share of total allocation. Since all tags in (UDFM m i) are distinct Ints in [0, i), we can instead place each element into an array at index = its tag and read it out in index order: O(n) after the guard, no comparisons, lazy readout. Maps whose tag bound has drifted far above their size fall back to the old sort, and singleton maps skip sorting entirely. See Note [Placement sort in eltsUDFM]. Assisted-by: Claude Fable 5 - - - - - 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,9 @@ 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 `udfmToList` orders its result by this serial number +-- (see Note [Placement sort in eltsUDFM]). So you should only use `UniqDFM` +-- if you need the deterministic property. -- -- `foldUDFM` also preserves determinism. -- @@ -153,11 +159,11 @@ data UniqDFM key ele = -- time. See Note [Overflow on plusUDFM] deriving (Data, Functor) --- | Deterministic, in O(n log n). +-- | Deterministic. See Note [Placement sort in eltsUDFM] for the cost. instance Foldable (UniqDFM key) where foldr = foldUDFM --- | Deterministic, in O(n log n). +-- | Deterministic. See Note [Placement sort in eltsUDFM] for the cost. instance Traversable (UniqDFM key) where traverse f = fmap listToUDFM_Directly . traverse (\(u,a) -> (u,) <$> f a) @@ -310,7 +316,8 @@ 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). +-- It's O(n) in the common case, with an O(n log n) fallback +-- (see Note [Placement sort in eltsUDFM]). foldUDFM :: (elt -> a -> a) -> a -> UniqDFM key elt -> a {-# INLINE foldUDFM #-} -- This INLINE prevents a regression in !10568 @@ -334,11 +341,68 @@ nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m 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) -- no sorting needed + | 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 [Placement sort in eltsUDFM] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- 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 = +-- 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. +-- +-- 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 ()). +-- +-- The array 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). +-- +-- Determinism is unaffected: the tags are distinct, so they fully determine +-- the order; the previous sort never relied on stability. + +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 [Placement sort in eltsUDFM]. +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 +420,21 @@ 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). +-- It's O(n) in the common case, with an O(n log n) fallback +-- (see Note [Placement sort in eltsUDFM]). 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/67814479462f5e0d542ae214e6d4f45… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67814479462f5e0d542ae214e6d4f45… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26971] Decoupling 'L.H.S' from 'GHC.Hs.Doc'
by recursion-ninja (＠recursion-ninja) 02 Jul '26

02 Jul '26

recursion-ninja pushed to branch wip/fix-26971 at Glasgow Haskell Compiler / GHC Commits: 809c867c by Recursion Ninja at 2026-07-02T09:52:21-04:00 Decoupling 'L.H.S' from 'GHC.Hs.Doc' * Migrated 'GHC.Hs.Doc' and 'GHC.Hs.DocString' AST defintions from 'GHC.*' namespace, to new 'Language.Haskell.Syntax.Doc' module in the 'L.H.S' "namespace." * Updated 'HsDocString to be TTG-parameterised as 'HsDocString pass'. * Added 'GHC.Hs.Extension.Pass': splits 'GhcPass'/'Pass' and all 'HsDocString' TTG instances out of 'GHC.Hs.Extension', which re-exports it unchanged (this is backwards compatible and prevents the introduction of a boot file). * Deleted 'GHC.Hs.Doc.hs-boot'; removed all 'L.H.S.*' imports of 'GHC.Hs.Doc'. * Updated 'GHC.Hs.DocString' to be TTG pass-parameterised throughout; moved 'mkHsDocStringChunk'/'unpackHDSC' here (require 'GHC.Utils.Encoding'). * Split 'GHC.Rename.Doc.rnHsDoc' from 'rnHsDocIdentifiersOnly'. * Updated parser, renamer, typechecker, HIE, and exact-print for new types. * Added 'HsDocString' TTG instances for 'DocNameI' to 'Haddock.Types'. * Killed the last module loop between GHC.* and LHS.*. - Only edges from LHS.* to GHC.Data.FastString now! Resolves #26971 - - - - - 46 changed files: - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Doc.hs - − compiler/GHC/Hs/Doc.hs-boot - compiler/GHC/Hs/DocString.hs - compiler/GHC/Hs/Extension.hs - + compiler/GHC/Hs/Extension/Pass.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Types/Basic.hs - compiler/Language/Haskell/Syntax.hs - compiler/Language/Haskell/Syntax/Decls.hs - + compiler/Language/Haskell/Syntax/Doc.hs - compiler/Language/Haskell/Syntax/Expr.hs-boot - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - compiler/Language/Haskell/Syntax/Type.hs - − compiler/Language/Haskell/Syntax/Type.hs-boot - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr - testsuite/tests/parser/should_compile/T23315/T23315.stderr - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/HaddockSpanIssueT24378.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/showIface/NoExportList.stdout - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.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/-/commit/809c867c9a64e34616b1be09b5aff62… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/809c867c9a64e34616b1be09b5aff62… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/textual-bytecode-output] Add support for missing cost center information
by Wolfgang Jeltsch (＠jeltsch) 02 Jul '26

02 Jul '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC Commits: 8966f683 by Wolfgang Jeltsch at 2026-07-02T16:42:22+03:00 Add support for missing cost center information - - - - - 1 changed file: - compiler/GHC/ByteCode/Show.hs Changes: ===================================== compiler/GHC/ByteCode/Show.hs ===================================== @@ -8,16 +8,29 @@ module GHC.ByteCode.Show (showByteCode) where import Prelude ((+), (-), Integral, div) import Control.Arrow ((>>>)) import Control.Exception (assert) -import Data.Eq ((==)) +import Data.Eq (Eq, (==)) +import Data.Ord ((<=)) import Data.Bits (FiniteBits, finiteBitSize) import Data.Function (($), id, (.)) import Data.Tuple (fst, snd, uncurry) import Data.Bool (Bool, otherwise, not, (&&)) import Data.Int (Int) import Data.Word (Word) -import Data.Maybe (Maybe, maybe) +import Data.Maybe (Maybe (Nothing, Just), maybe) import Data.Either (Either, either) -import Data.List (length, (++), map, zipWith, zipWith5, take, drop, replicate) +import Data.List + ( + length, + (++), + repeat, + map, + zipWith, + zipWith5, + and, + take, + drop, + replicate + ) import Data.String (String) import Data.ByteString (ByteString, unpack) import Data.ByteString.Short (ShortByteString) @@ -44,6 +57,7 @@ import GHC.Utils.Outputable ( defaultDumpStyle, SDoc, + empty, text, (<>), (<+>), @@ -297,46 +311,56 @@ pprBreakpointsInSource :: Module -> ModBreaks -> SDoc pprBreakpointsInSource currentModule ModBreaks {..} = entry (text "breakpoints in source:") $ assert (modBreaks_module == currentModule) $ - assert boundsAreIdentical $ + assert boundsAreConsistent $ vcatOrNone $ zipWith5 pprBreakpointInSource (indices modBreaks_locs_) (elems modBreaks_locs_) (elems modBreaks_decls) (elems modBreaks_vars) - (elems modBreaks_ccs) + potentialCostCenterInfos where - boundsAreIdentical :: Bool - boundsAreIdentical = bounds modBreaks_locs_ == bounds modBreaks_decls && - bounds modBreaks_locs_ == bounds modBreaks_vars && - bounds modBreaks_locs_ == bounds modBreaks_ccs + costCenterInfoIsPresent :: Bool + costCenterInfoIsPresent = fst (bounds modBreaks_ccs) <= + snd (bounds modBreaks_ccs) + + boundsAreConsistent :: Bool + boundsAreConsistent + = allAreEqual $ + [ + bounds modBreaks_locs_, + bounds modBreaks_decls, + bounds modBreaks_vars + ] ++ if costCenterInfoIsPresent then [bounds modBreaks_ccs] else [] + where + + allAreEqual :: Eq a => [a] -> Bool + allAreEqual list = and $ zipWith (==) list (drop 1 list) + + potentialCostCenterInfos :: [Maybe (ShortByteString, ShortByteString)] + potentialCostCenterInfos + | costCenterInfoIsPresent = map Just (elems modBreaks_ccs) + | otherwise = repeat Nothing -- | […] pprBreakpointInSource :: BreakTickIndex -> BinSrcSpan -> [String] -> [OccName] - -> (ShortByteString, ShortByteString) + -> Maybe (ShortByteString, ShortByteString) -> SDoc -pprBreakpointInSource ix srcSpan declarationPath freeVars costCenterInfo +pprBreakpointInSource ix + srcSpan + declarationPath + freeVars + potentialCostCenterInfo = entry (text "breakpoint" <+> ppr ix <> text ":") $ vcat [ - pprSrcSpan $ srcSpan, - pprDeclarationPath $ declarationPath, - pprFreeVariables $ freeVars, - pprCostCenterPath $ costCenterPath, - pprCostCenterLocation $ costCenterLocation + pprSrcSpan $ srcSpan, + pprDeclarationPath $ declarationPath, + pprFreeVariables $ freeVars, + pprPotentialCostCenterInfo $ potentialCostCenterInfo ] - where - - costCenterPath :: String - costCenterPath = utf8DecodeShortByteString (fst costCenterInfo) - - costCenterLocation :: String - costCenterLocation = utf8DecodeShortByteString (snd costCenterInfo) - - -- The structure of the cost center information is apparent from the - -- implementation of 'GHC.HsToCore.Breakpoints.mkModBreaks'. -- | […] pprSrcSpan :: BinSrcSpan -> SDoc @@ -350,6 +374,26 @@ pprDeclarationPath = entry (text "declaration path:") . vcat . map text pprFreeVariables :: [OccName] -> SDoc pprFreeVariables = entry (text "free variables:") . hsep . map ppr +-- | […] +pprPotentialCostCenterInfo :: Maybe (ShortByteString, ShortByteString) -> SDoc +pprPotentialCostCenterInfo Nothing + = empty +pprPotentialCostCenterInfo (Just costCenterInfo) + = vcat [ + pprCostCenterPath $ costCenterPath, + pprCostCenterLocation $ costCenterLocation + ] + where + + costCenterPath :: String + costCenterPath = utf8DecodeShortByteString (fst costCenterInfo) + + costCenterLocation :: String + costCenterLocation = utf8DecodeShortByteString (snd costCenterInfo) + + -- The structure of the cost center information is apparent from the + -- implementation of 'GHC.HsToCore.Breakpoints.mkModBreaks'. + -- | […] pprCostCenterPath :: String -> SDoc pprCostCenterPath = entry (text "cost center path:") . text View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8966f683f2ca0e03fb3648aed64b747… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8966f683f2ca0e03fb3648aed64b747… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/textual-bytecode-output] Change wrong use of `(<$>)` and `(<*>)` to `zipWith5` use
by Wolfgang Jeltsch (＠jeltsch) 02 Jul '26

02 Jul '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC Commits: a1681c68 by Wolfgang Jeltsch at 2026-07-02T16:22:47+03:00 Change wrong use of `(<$>)` and `(<*>)` to `zipWith5` use - - - - - 1 changed file: - compiler/GHC/ByteCode/Show.hs Changes: ===================================== compiler/GHC/ByteCode/Show.hs ===================================== @@ -6,7 +6,6 @@ module GHC.ByteCode.Show (showByteCode) where import Prelude ((+), (-), Integral, div) -import Control.Applicative ((<$>), (<*>)) import Control.Arrow ((>>>)) import Control.Exception (assert) import Data.Eq ((==)) @@ -18,7 +17,7 @@ import Data.Int (Int) import Data.Word (Word) import Data.Maybe (Maybe, maybe) import Data.Either (Either, either) -import Data.List (length, (++), map, zipWith, take, drop, replicate) +import Data.List (length, (++), map, zipWith, zipWith5, take, drop, replicate) import Data.String (String) import Data.ByteString (ByteString, unpack) import Data.ByteString.Short (ShortByteString) @@ -296,15 +295,15 @@ pprBreakpointsData currentModule InternalModBreaks {..} -- | […] pprBreakpointsInSource :: Module -> ModBreaks -> SDoc pprBreakpointsInSource currentModule ModBreaks {..} - = entry (text "breakpoints in source:") $ - assert (modBreaks_module == currentModule) $ - assert boundsAreIdentical $ - vcatOrNone $ - pprBreakpointInSource <$> indices modBreaks_locs_ <*> - elems modBreaks_locs_ <*> - elems modBreaks_decls <*> - elems modBreaks_vars <*> - elems modBreaks_ccs + = entry (text "breakpoints in source:") $ + assert (modBreaks_module == currentModule) $ + assert boundsAreIdentical $ + vcatOrNone $ + zipWith5 pprBreakpointInSource (indices modBreaks_locs_) + (elems modBreaks_locs_) + (elems modBreaks_decls) + (elems modBreaks_vars) + (elems modBreaks_ccs) where boundsAreIdentical :: Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1681c68a2fb169acf861f59e5af4df… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1681c68a2fb169acf861f59e5af4df… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/textual-bytecode-output] 2 commits: Slightly improve the output of info table literals
by Wolfgang Jeltsch (＠jeltsch) 02 Jul '26

02 Jul '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC Commits: 41db7f1b by Wolfgang Jeltsch at 2026-07-02T13:41:21+03:00 Slightly improve the output of info table literals - - - - - 8ae540da by Wolfgang Jeltsch at 2026-07-02T15:27:53+03:00 Change wrong use of `(<$>)` and `(<*>)` to `zipWith5` use - - - - - 1 changed file: - compiler/GHC/ByteCode/Show.hs Changes: ===================================== compiler/GHC/ByteCode/Show.hs ===================================== @@ -18,7 +18,7 @@ import Data.Int (Int) import Data.Word (Word) import Data.Maybe (Maybe, maybe) import Data.Either (Either, either) -import Data.List (length, (++), map, zipWith, take, drop, replicate) +import Data.List (length, (++), map, zipWith, zipWith5, take, drop, replicate) import Data.String (String) import Data.ByteString (ByteString, unpack) import Data.ByteString.Short (ShortByteString) @@ -179,7 +179,7 @@ pprLiteral currentModule literal = case literal of -> text "label" <+> ppr label BCONPtrItbl infoTableName - -> text "info table" <+> + -> text "info table of" <+> ppr infoTableName BCONPtrAddr addrName -> text "address" <+> @@ -296,15 +296,15 @@ pprBreakpointsData currentModule InternalModBreaks {..} -- | […] pprBreakpointsInSource :: Module -> ModBreaks -> SDoc pprBreakpointsInSource currentModule ModBreaks {..} - = entry (text "breakpoints in source:") $ - assert (modBreaks_module == currentModule) $ - assert boundsAreIdentical $ - vcatOrNone $ - pprBreakpointInSource <$> indices modBreaks_locs_ <*> - elems modBreaks_locs_ <*> - elems modBreaks_decls <*> - elems modBreaks_vars <*> - elems modBreaks_ccs + = entry (text "breakpoints in source:") $ + assert (modBreaks_module == currentModule) $ + assert boundsAreIdentical $ + vcatOrNone $ + zipWith5 pprBreakpointInSource (indices modBreaks_locs_) + (elems modBreaks_locs_) + (elems modBreaks_decls) + (elems modBreaks_vars) + (elems modBreaks_ccs) where boundsAreIdentical :: Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/17901d772fde45976e8a74bd4d21cc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/17901d772fde45976e8a74bd4d21cc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/fix-peekitbl-no-tntc
by Cheng Shao (＠TerrorJack) 02 Jul '26

02 Jul '26

Cheng Shao pushed new branch wip/fix-peekitbl-no-tntc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-peekitbl-no-tntc You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/upd-short-text-hack-comment
by sheaf (＠sheaf) 02 Jul '26

02 Jul '26

sheaf pushed new branch wip/upd-short-text-hack-comment at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/upd-short-text-hack-comment You're receiving this email because of your account on gitlab.haskell.org.

1 0