- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/sjakobi/udfm-placement] 3 commits: Add Word64Map.compareSize; use it in UniqDFM's sorting guards
by Simon Jakobi (＠sjakobi2) 06 Jul '26

06 Jul '26

Simon Jakobi pushed to branch wip/sjakobi/udfm-placement at Glasgow Haskell Compiler / GHC Commits: e4fa09ab by Simon Jakobi at 2026-07-03T12:47:23+02:00 Add Word64Map.compareSize; use it in UniqDFM's sorting guards The guards in eltsUDFM/udfmToList need the map's size only to compare it against a small bound, but computed it with a full O(n) traversal. Add compareSize, a verbatim port of Data.IntMap.compareSize from containers (haskell/containers#1139), which stops traversing as soon as the outcome is decided, and use it for both guards: the singleton check becomes O(1) and the placement/mergesort dispatch O(min(n, i)). Assisted-by: Claude Fable 5 - - - - - 1fdedb00 by Simon Jakobi at 2026-07-03T12:53:57+02:00 Fill placementSort's array directly from the Word64Map eltsUDFM and udfmToList materialized an intermediate list (for udfmToList even one of freshly allocated TaggedVals) only for placementSort to consume it in a single strict fill pass. Instead pass placementSort the map itself plus a per-element projection, and fill the array with the new Word64Map.traverseWithKey_, which visits each entry with an applicative action without building any intermediate structure. Instantiated at ST, this compiles to a fill loop that allocates nothing beyond the array (verified in the Core dump). Assisted-by: Claude Fable 5 - - - - - b4022ce8 by Simon Jakobi at 2026-07-06T01:17:53+02:00 Fixes and wibbles - - - - - 5 changed files: - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Map/Lazy.hs - compiler/GHC/Data/Word64Map/Strict.hs - compiler/GHC/Data/Word64Map/Strict/Internal.hs - compiler/GHC/Types/Unique/DFM.hs Changes: ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -72,6 +72,7 @@ module GHC.Data.Word64Map.Internal ( -- * Query , null , size + , compareSize , member , notMember , lookup @@ -169,6 +170,7 @@ module GHC.Data.Word64Map.Internal ( , map , mapWithKey , traverseWithKey + , traverseWithKey_ , traverseMaybeWithKey , mapAccum , mapAccumWithKey @@ -522,6 +524,8 @@ null _ = False -- > size empty == 0 -- > size (singleton 1 'a') == 1 -- > size (fromList([(1,'a'), (2,'c'), (3,'b')])) == 3 +-- +-- See also: 'compareSize' size :: Word64Map a -> Int size = go 0 where @@ -529,6 +533,23 @@ size = go 0 go acc (Tip _ _) = 1 + acc go acc Nil = acc +-- | $O(\min(n,c))$. Compare the number of entries in the map to an @Int@. +-- +-- @compareSize m c@ returns the same result as @compare ('size' m) c@ but is +-- more efficient when @c@ is smaller than the size of the map. +compareSize :: Word64Map a -> Int -> Ordering +compareSize Nil c0 = compare 0 c0 +compareSize _ c0 | c0 <= 0 = GT +compareSize t c0 = compare 0 (go t (c0 - 1)) + where + go (Bin _ _ _ _) 0 = -1 + go (Bin _ _ l r) c + | c' < 0 = c' + | otherwise = go r c' + where + c' = go l (c - 1) + go _ c = c -- Must be Tip (Nil is never a child of Bin) + -- | $O(\min(n,W))$. Is the key a member of the map? -- -- > member 5 (fromList [(5,'a'), (3,'b')]) == True @@ -2500,6 +2521,18 @@ traverseWithKey f = go | otherwise = liftA2 (Bin p m) (go l) (go r) {-# INLINE traverseWithKey #-} +-- | $O(n)$. Visit each key\/value pair in ascending key order, discarding +-- the results. +-- +-- Unlike @traverse_ . toList@, this builds no intermediate structure. +traverseWithKey_ :: Applicative t => (Key -> a -> t ()) -> Word64Map a -> t () +traverseWithKey_ f = go + where + go Nil = pure () + go (Tip k v) = f k v + go (Bin _ _ l r) = go l *> go r +{-# INLINE traverseWithKey_ #-} + -- | $O(n)$. The function @'mapAccum'@ threads an accumulating -- argument through the map in ascending order of keys. -- ===================================== compiler/GHC/Data/Word64Map/Lazy.hs ===================================== @@ -113,6 +113,7 @@ module GHC.Data.Word64Map.Lazy ( -- ** Size , WM.null , size + , compareSize -- * Combine @@ -148,6 +149,7 @@ module GHC.Data.Word64Map.Lazy ( , WM.map , mapWithKey , traverseWithKey + , traverseWithKey_ , traverseMaybeWithKey , mapAccum , mapAccumWithKey ===================================== compiler/GHC/Data/Word64Map/Strict.hs ===================================== @@ -130,6 +130,7 @@ module GHC.Data.Word64Map.Strict ( -- ** Size , null , size + , compareSize -- * Combine @@ -165,6 +166,7 @@ module GHC.Data.Word64Map.Strict ( , map , mapWithKey , traverseWithKey + , traverseWithKey_ , traverseMaybeWithKey , mapAccum , mapAccumWithKey ===================================== compiler/GHC/Data/Word64Map/Strict/Internal.hs ===================================== @@ -132,6 +132,7 @@ module GHC.Data.Word64Map.Strict.Internal ( -- ** Size , null , size + , compareSize -- * Combine @@ -167,6 +168,7 @@ module GHC.Data.Word64Map.Strict.Internal ( , map , mapWithKey , traverseWithKey + , traverseWithKey_ , traverseMaybeWithKey , mapAccum , mapAccumWithKey @@ -322,12 +324,14 @@ import GHC.Data.Word64Map.Internal , spanAntitone , restrictKeys , size + , compareSize , split , splitLookup , splitRoot , toAscList , toDescList , toList + , traverseWithKey_ , union , unions , withoutKeys ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -97,9 +97,9 @@ import qualified GHC.Data.Word64Set as W -- If the client of the map performs operations on the map in deterministic -- order then `udfmToList` returns them in deterministic order. -- --- There is an implementation cost: each element is given a serial number +-- There is an implementation cost: each element is given an insertion tag -- as it is added, and functions like `udfmToList` or `eltsUDFM` order their --- results by this serial number (see +-- results by this tag (see -- Note [Cost of deterministic iteration]). So you should only use `UniqDFM` -- if you need the deterministic property. -- @@ -114,7 +114,7 @@ import qualified GHC.Data.Word64Set as W -- -- -- There's more than one way to implement this. The implementation here tags --- every value with the insertion time that can later be used to sort the +-- every value with its insertion tag that can later be used to sort the -- values when asked to convert to a list. -- -- An alternative would be to have @@ -133,11 +133,11 @@ import qualified GHC.Data.Word64Set as W -- -- may also be worth considering. Compare Dhall.Map in the dhall package. --- | A type of values tagged with insertion time +-- | A type of values carrying an insertion tag data TaggedVal val = TaggedVal !val - {-# UNPACK #-} !Int -- ^ insertion time + {-# UNPACK #-} !Int -- ^ insertion tag deriving stock (Data, Functor, Foldable, Traversable) taggedFst :: TaggedVal val -> val @@ -159,13 +159,25 @@ instance Eq val => Eq (TaggedVal val) where data UniqDFM key ele = UDFM !(M.Word64Map (TaggedVal ele)) -- A map where keys are Unique's values and - -- values are tagged with insertion time. - -- The invariant is that all the tags will - -- be distinct within a single map + -- values carry an insertion tag. {-# UNPACK #-} !Int -- Upper bound on the values' insertion - -- time. See Note [Overflow on plusUDFM] + -- tags. See Note [Overflow on plusUDFM] + -- See Note [UDFM invariants] deriving (Data, Functor) +{- Note [UDFM invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~ +In a map (UDFM m ub): + + (a) The insertion tags of the elements of m are distinct. + (b) Every tag lies in [0, ub). + +Consequently ub >= size m. + +The tags determine the order of deterministic iteration (eltsUDFM, +udfmToList); see Note [Sorting a UDFM]. +-} + -- | Deterministic. -- -- See Note [Cost of deterministic iteration]. @@ -266,8 +278,8 @@ plusUDFM_CK f udfml@(UDFM _ i) udfmr@(UDFM _ j) -- Note [Overflow on plusUDFM] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- There are multiple ways of implementing plusUDFM. --- The main problem that needs to be solved is overlap on times of --- insertion between different keys in two maps. +-- The main problem that needs to be solved is overlap on insertion +-- tags between different keys in two maps. -- Consider: -- -- A = fromList [(a, (x, 1))] @@ -355,84 +367,108 @@ 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. +{- Note [Cost of deterministic iteration] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Deterministic iteration -- eltsUDFM, udfmToList, and everything built on +them, such as foldUDFM and UniqDFM's Foldable instance -- 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] -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 +eltsUDFM (UDFM m ub) + | M.compareSize m 1 /= GT = map taggedFst (M.elems m) + | usePlacement m ub = placementSort ub (\_ tv -> tv) m + | otherwise = map taggedFst (sort_it m) 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 +{- Note [Sorting a UDFM] +~~~~~~~~~~~~~~~~~~~~~~~~ +Deterministic iteration must order elements by insertion tag. A comparison +sort is needlessly expensive: the list mergesort behind sortBy allocates +~n*log n cons cells, and in #27459 those allocations made up a large share +of the compiler's total allocation on the InstanceMatching perf tests. + +Instead we exploit the UDFM invariants (all tags in (UDFM m ub) are distinct +Ints in [0, ub); see Note [UDFM invariants]): allocate an array of size ub, +write each element at +@index = tag@, freeze, and read out in index order. The fill is O(n) work, +where n = size m; the readout is O(ub); and since ub >= n, the whole sort is +O(ub) -- with no comparisons. 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 read, but something must fill it: not a +panic thunk -- TaggedVal's strict value field would force it as soon as the +readout inspects a hole's tag -- so we borrow the value of an arbitrary map +element. (Safe: the callers' guards send maps of size < 2 down a different +path, so the map is never empty here.) + +This sorting method loses when ub is much larger than n = M.size m: ub never +shrinks (overwrites keep bumping it, delete/filter shrink n but not ub). We +fall back to the mergesort when ub > 4 * n; the decision about which sort to +use is made by usePlacement. It checks the threshold with M.compareSize, +which stops traversing the map as soon as the outcome is decided (so the +guard costs O(min(n, ub)), not a full O(n) size computation). Maps built by +plain insertion -- the common case -- have ub == n. The guard also caps the +fast path's O(ub) at O(n). +-} + +-- | @ub <= 4 * size m@, computed without a full 'M.size' traversal. +usePlacement :: M.Word64Map a -> Int -> Bool +usePlacement m ub = M.compareSize m ceil_ub_div_4 /= LT + where + ceil_ub_div_4 = (ub + 3) `div` 4 -- ceil(ub/4): ub <= 4*n iff n >= ceil(ub/4) + +-- | Order the map's elements by tag, by placing @mk key elt@ at array index = +-- the tag of @elt@. +-- +-- The map must be non-empty, its tags distinct and in @[0, ub)@; @mk@ must +-- preserve the tag. See Note [Sorting a UDFM]. +placementSort :: forall e r. Int + -> (M.Key -> TaggedVal e -> TaggedVal r) + -> M.Word64Map (TaggedVal e) + -> [r] +{-# INLINE placementSort #-} -- specializes mk into the fill loop +placementSort ub mk m = runST (ST (\s0 -> + case newSmallArray ub hole s0 of + (# s1, marr #) -> case fill marr s1 of + (# s2, () #) -> case unsafeFreezeSmallArray marr s2 of (# s3, arr #) -> (# s3, readout arr 0 #))) where + -- The tag -1 marks unfilled slots; the value field is never read, but + -- it is strict, so it needs a real value of type r -- borrow one from + -- the map. See Note [Sorting a UDFM]. hole :: TaggedVal r - hole = TaggedVal (unsafeCoerce ()) (-1) + hole = case M.findMin m of + (k, tv) -> TaggedVal (taggedFst (mk k tv)) (-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' + fill :: SmallMutableArray s (TaggedVal r) -> State# s -> (# State# s, () #) + fill marr s = case M.traverseWithKey_ write m of ST st -> st s + where + write k tv = ST (\s' -> + (# writeSmallArray marr (taggedSnd tv) (mk k tv) s', () #)) readout :: SmallArray (TaggedVal r) -> Int -> [r] readout arr j - | j >= i = [] + | j >= ub = [] | t < 0 = readout arr (j + 1) | otherwise = v : readout arr (j + 1) where TaggedVal v t = indexSmallArray arr j @@ -461,19 +497,17 @@ udfmRestrictKeysSet (UDFM val_set i) set = -- as this already incurs most of the cost of returning the full list. -- See Note [Cost of deterministic iteration]. udfmToList :: UniqDFM key elt -> [(Unique, elt)] -udfmToList (UDFM m i) - | n <= 1 = [ (mkUniqueGrimily k, taggedFst v) | (k, v) <- M.toList m ] +udfmToList (UDFM m ub) + | M.compareSize m 1 /= GT = + [ (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) + -- (they make up the result). + | usePlacement m ub = placementSort ub + (\k tv -> TaggedVal (mkUniqueGrimily k, taggedFst tv) (taggedSnd tv)) 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/-/compare/1c645b9c8d5318d36dd37c23c4abb6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1c645b9c8d5318d36dd37c23c4abb6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Decoupling 'L.H.S' from 'GHC.Hs.Doc'
by Marge Bot (＠marge-bot) 06 Jul '26

06 Jul '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 925959db by Recursion Ninja at 2026-07-04T04:14:12-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 - - - - - b7e24044 by mangoiv at 2026-07-04T04:14:56-04:00 ci: retry fetching test metrics Retry fetching test metrics to make the CI not fail if the services is temporarily unavailable - - - - - 4180af3f by Zubin Duggal at 2026-07-04T04:15:38-04:00 Bump semaphore-compat submodule to 2.0.1 This versions includes some cruicial fixes for darwin - - - - - 242d4317 by sheaf at 2026-07-04T04:16:19-04:00 Remove outdated comment in GHC.Data.ShortText There was a long comment in GHC.Data.ShortText about a workaround that was necessary when bootstrapping with GHC 9.2 and below. The actual logic has since been dropped, but the comment remained. This commit removes the vestigial comment. - - - - - 9b714c4c by Zubin Duggal at 2026-07-05T09:40:36+05:30 CorePrep: Don't speculatively evaluate bindings that we have already discovered to be absent In #25924, we segfault because speculation forces a projection out of a RUBBISH dictionary (which we generated because it absent). Solution: Don't speculate on bindings we already know are absent. Fixes 25924 - - - - - 4a59b3ee by Zubin Duggal at 2026-07-05T09:40:36+05:30 Don't make absent fillers for terminating types In #25924 we discovered that we could speculatively evaluate an absent filler for a dictionary, and project a field (a superclass selector) out of it, resulting in segfaults. Solution: Never make an absent filler or rubbish literal for a terminating type like a dictionary. mkAbsentFiller returns Nothing for isTerminatingType, so worker/wrapper and the specialiser keep the real argument instead. Some small metric decreases because we do a little less work in the simplifier now. Metric Decrease: T9872a T9872b T9872c TcPlugin_RewritePerf - - - - - b47e4111 by Alan Zimmerman at 2026-07-05T18:02:07-04:00 EPA: Move the 'where' annotation for PatSynBind This allows us to move it out of the MatchGroup exact print annotation too - - - - - 83 changed files: - .gitlab/test-metrics.sh - + changelog.d/fix-absent-dict-projection - changelog.d/semaphore-v2 - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Doc.hs - − compiler/GHC/Hs/Doc.hs-boot - compiler/GHC/Hs/DocString.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.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.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - 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/GHC/Types/Literal.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 - hadrian/src/Settings/Warnings.hs - libraries/ghc-boot/GHC/Data/ShortText.hs - libraries/semaphore-compat - + testsuite/tests/core-to-stg/T25924/B.hs - + testsuite/tests/core-to-stg/T25924/Main.hs - + testsuite/tests/core-to-stg/T25924/all.T - + testsuite/tests/core-to-stg/T25924a.hs - + testsuite/tests/core-to-stg/T25924a.stdout - testsuite/tests/core-to-stg/all.T - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/dmdanal/should_compile/T18982.stderr - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr - testsuite/tests/module/mod185.stderr - 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/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/parser/should_compile/T23315/T23315.stderr - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/HaddockSpanIssueT24378.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/showIface/NoExportList.stdout - testsuite/tests/simplCore/should_compile/T26615.stderr - 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/-/compare/f6fd263280f8db452416bf873f0367… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f6fd263280f8db452416bf873f0367… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/az/exactprint-annotation-rationalisation] 5 commits: EPA: Remove LocatedE completely, last usage for pats
by Alan Zimmerman (＠alanz) 05 Jul '26

05 Jul '26

Alan Zimmerman pushed to branch wip/az/exactprint-annotation-rationalisation at Glasgow Haskell Compiler / GHC Commits: 236950e1 by Alan Zimmerman at 2026-07-05T12:48:23+01:00 EPA: Remove LocatedE completely, last usage for pats - - - - - 77fd15ee by Alan Zimmerman at 2026-07-05T15:17:14+01:00 EPA: Remove AnnList (EpToken "where") usages This is moving toward removing the parameter from AnnList completely - - - - - 12f5b438 by Alan Zimmerman at 2026-07-05T16:37:44+01:00 EPA remove AnnList (EpToken "rec") usages - - - - - 81455814 by Alan Zimmerman at 2026-07-05T18:57:01+01:00 EPA: Remove last parameterised AnnList usage (EpaLocation) Also remove the parameter - - - - - 0d13d46c by Alan Zimmerman at 2026-07-05T21:18:28+01:00 TTG: Add extension points to BooleanFormula They are currently unused, but will be used for exact print annotations next - - - - - 39 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/Language/Haskell/Syntax/BooleanFormula.hs - compiler/Language/Haskell/Syntax/Extension.hs - testsuite/tests/ghc-api/T25121_status.stdout - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/module/mod185.stderr - 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/DumpSemis.stderr - testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T15279.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.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/982953c9be962a6b309312a7b0cfc4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/982953c9be962a6b309312a7b0cfc4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/sjakobi/cbe2
by Simon Jakobi (＠sjakobi2) 05 Jul '26

05 Jul '26

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

1 0

[Git][ghc/ghc][wip/T27456] base: Display ExceptionContext in WhileHandling's textual description
by Ben Gamari (＠bgamari) 05 Jul '26

05 Jul '26

Ben Gamari pushed to branch wip/T27456 at Glasgow Haskell Compiler / GHC Commits: d3680f06 by Ben Gamari at 2026-07-05T12:03:34-04:00 base: Display ExceptionContext in WhileHandling's textual description As originally-implemented the implementation for `WhileHandling(displayExceptionAnnotation)` would display the `ExceptionContext` of the exception which it carries (as this was the behavior of `displayException`, in terms of which `displayExceptionAnnotation` was implemented). However, in 284ffab3 the definition of `SomeException(displayException)` was changed to exclude the `ExceptionContext`. This means that `WhileHandling(displayExceptionAnnotation)` fails to describe the provenance of the exception which it captures, greatly limiting its utility. Return the implementation to its originally-specified behavior by implementing `WhileHandling(displayExceptionAnnotation)` in terms of `displayExceptionWithInfo`. Fixes #27456. - - - - - 10 changed files: - + changelog.d/T27456 - libraries/base/changelog.md - libraries/base/tests/T15349.stderr - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs - libraries/ghc-internal/tests/backtraces/T14532b.stdout - testsuite/tests/codeGen/should_run/cgrun025.stderr - testsuite/tests/exceptions/T26759.stderr - testsuite/tests/ghc-e/should_fail/T18441fail7.stderr - testsuite/tests/mdo/should_fail/mdofail006.stderr - testsuite/tests/runghc/T7859.stderr-mingw32 Changes: ===================================== changelog.d/T27456 ===================================== @@ -0,0 +1,8 @@ +section: base +issues: #27456 +mrs: !16275 +synopsis: + Show `ExceptionContext` in `displayExceptionAnnotation` implementation of `WhileHandling` +description: + In the past ``displayException`` (in terms of which ``WhileHandling``\'s ``displayExceptionAnnotation` is implemented) was changed to hide ``ExceptionContext``. This regressed the behavior of ``displayExceptionAnnotation`` from that which was originally specified. Restore the intended behavior of showing the ``ExceptionContext`` of the carried exception. + ===================================== libraries/base/changelog.md ===================================== @@ -31,6 +31,7 @@ * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376)) * Add a new module `System.IO.OS` with operations for obtaining operating-system handles (file descriptors, Windows handles). ([CLC proposal #369](https://github.com/haskell/core-libraries-committee/issues/369)) * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383)) + * Show `ExceptionContext` in `displayExceptionAnnotation` implementation of `WhileHandling` ([GHC #27456](https://gitlab.haskell.org/ghc/ghc/-/issues/27456)) * Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387)) * Change `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. ([CLC proposal #371](github.com/haskell/core-libraries-committee/issues/371)) * Annotate `onException` continuation with `WhileHandling`. ([CLC Proposal #397](https://github.com/haskell/core-libraries-committee/issues/397)) ===================================== libraries/base/tests/T15349.stderr ===================================== @@ -1,9 +1,11 @@ -T15349: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.NonTermination: +T15349.exe: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.NonTermination: <<loop>> -While handling thread blocked indefinitely in an MVar operation +While handling ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnMVar: + | + | thread blocked indefinitely in an MVar operation HasCallStack backtrace: - throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs:58:37 in ghc-internal:GHC.Internal.Control.Monad.ST.Imp + throwIO, called at libraries\ghc-internal\src\GHC\Internal\Control\Monad\ST\Imp.hs:59:37 in ghc-internal:GHC.Internal.Control.Monad.ST.Imp ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs ===================================== @@ -84,7 +84,7 @@ data WhileHandling = WhileHandling SomeException deriving Show instance ExceptionAnnotation WhileHandling where displayExceptionAnnotation (WhileHandling e) = - "While handling " ++ case lines $ displayException e of + "While handling " ++ case lines $ displayExceptionWithInfo e of [] -> "" (l1:ls) -> -- Indent lines forward. ===================================== libraries/ghc-internal/tests/backtraces/T14532b.stdout ===================================== @@ -2,7 +2,14 @@ ghc-internal:GHC.Internal.Exception.ErrorCall: Error in Exception Handler -While handling Main Error +While handling ghc-internal:GHC.Internal.Exception.ErrorCall: + | + | Main Error + | + | My custom Backtraces: + | HasCallStack backtrace: + | throwIO, called at T14532b.hs:32:6 in main:Main + | My custom Backtraces: HasCallStack backtrace: @@ -13,7 +20,14 @@ ghc-internal:GHC.Internal.Exception.ErrorCall: Error in Exception Handler -While handling Main Error +While handling ghc-internal:GHC.Internal.Exception.ErrorCall: + | + | Main Error + | + | My custom Backtraces: + | HasCallStack backtrace: + | error, called at T14532b.hs:41:6 in main:Main + | My custom Backtraces: HasCallStack backtrace: ===================================== testsuite/tests/codeGen/should_run/cgrun025.stderr ===================================== @@ -1,4 +1,4 @@ -"cgrun025" +"cgrun025.exe" ["cgrun025.hs"] GOT PATH {-# LANGUAGE ScopedTypeVariables #-} @@ -27,11 +27,16 @@ main = do trace "hello, trace" $ catch (getEnv "__WURBLE__" >> return ()) (\ (e :: SomeException) -> error "hello, error") hello, trace -cgrun025: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: +cgrun025.exe: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: hello, error -While handling __WURBLE__: getEnv: does not exist (no environment variable) +While handling ghc-internal:GHC.Internal.IO.Exception.IOException: + | + | __WURBLE__: getEnv: does not exist (no environment variable) + | + | HasCallStack backtrace: + | ioException, called at libraries\ghc-internal\src\GHC\Internal\System\Environment.hs:204:26 in ghc-internal:GHC.Internal.System.Environment HasCallStack backtrace: error, called at cgrun025.hs:25:75 in main:Main ===================================== testsuite/tests/exceptions/T26759.stderr ===================================== @@ -1,8 +1,13 @@ -T26759: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: +T26759.exe: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: cleanup failure -While handling outer failure +While handling ghc-internal:GHC.Internal.Exception.ErrorCall: + | + | outer failure + | + | HasCallStack backtrace: + | throwIO, called at T26759.hs:6:21 in main:Main HasCallStack backtrace: throwIO, called at T26759.hs:7:22 in main:Main ===================================== testsuite/tests/ghc-e/should_fail/T18441fail7.stderr ===================================== @@ -1,10 +1,12 @@ -<interactive>: Uncaught exception ghc-9.13-inplace:GHC.Utils.Panic.GhcException: +<interactive>: Uncaught exception ghc-10.1-inplace:GHC.Utils.Panic.GhcException: IO error: "Abcde" does not exist -While handling IO error: "Abcde" does not exist +While handling ghc-10.1-inplace:GHC.Utils.Panic.GhcException: + | + | IO error: "Abcde" does not exist HasCallStack backtrace: - throwIO, called at compiler/GHC/Utils/Error.hs:512:19 in ghc-9.13-inplace:GHC.Utils.Error + throwIO, called at compiler\GHC\Utils\Error.hs:499:19 in ghc-10.1-inplace:GHC.Utils.Error 1 ===================================== testsuite/tests/mdo/should_fail/mdofail006.stderr ===================================== @@ -1,9 +1,11 @@ -mdofail006: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.FixIOException: +mdofail006.exe: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.FixIOException: cyclic evaluation in fixIO -While handling thread blocked indefinitely in an MVar operation +While handling ghc-internal:GHC.Internal.IO.Exception.BlockedIndefinitelyOnMVar: + | + | thread blocked indefinitely in an MVar operation HasCallStack backtrace: - throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs:167:37 in ghc-internal:GHC.Internal.Control.Monad.Fix + throwIO, called at libraries\ghc-internal\src\GHC\Internal\Control\Monad\Fix.hs:169:37 in ghc-internal:GHC.Internal.Control.Monad.Fix ===================================== testsuite/tests/runghc/T7859.stderr-mingw32 ===================================== @@ -2,7 +2,12 @@ runghc-9.13.20241015.exe: Uncaught exception ghc-internal:GHC.Internal.IO.Except defer-type-errors: rawSystem: does not exist (No such file or directory) -While handling rawSystem: does not exist (No such file or directory) +While handling ghc-internal:GHC.Internal.IO.Exception.IOException: + | + | rawSystem: does not exist (No such file or directory) + | + | HasCallStack backtrace: + | ioError, called at libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs:<line>:<column> in <package-id>:GHC.Internal.Foreign.C.Error HasCallStack backtrace: ioError, called at libraries\process\System\Process\Common.hs:239:16 in process-1.6.25.0-inplace:System.Process.Common View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3680f06085ccc0cb055abca84085e0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3680f06085ccc0cb055abca84085e0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/sjakobi/T21394
by Simon Jakobi (＠sjakobi2) 05 Jul '26

05 Jul '26

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

1 0

[Git][ghc/ghc] Pushed new branch wip/az/epa-tidy-locatedxxx-5
by Alan Zimmerman (＠alanz) 05 Jul '26

05 Jul '26

Alan Zimmerman pushed new branch wip/az/epa-tidy-locatedxxx-5 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-tidy-locatedxxx-5 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/T25181] Simplifier: unbox through seq# on manifest values (#25181)
by Simon Jakobi (＠sjakobi2) 05 Jul '26

05 Jul '26

Simon Jakobi pushed to branch wip/sjakobi/T25181 at Glasgow Haskell Compiler / GHC Commits: 22a6adcc by Simon Jakobi at 2026-07-05T12:47:01+02:00 Simplifier: unbox through seq# on manifest values (#25181) For 'case seq# <manifest-value> s of (# s', r #) -> rhs' the Simplifier previously could neither let case-of-known-constructor see through r nor discard the seq#, so programs like T25181 retained a redundant box (and 480MB of allocation in the reproducer, vs 40KB on GHC 9.8). This patch adds three cooperating transformations in GHC.Core.Opt.Simplify.Iteration, restricted to manifest values (never merely-known-evaluated variables, which would reintroduce the #24334 unsoundness): * rebuildCase (0): ANF-ise a constructor argument of seq# when the result is scrutinised immediately, so that the unfolding below is expandable. * simplAlt: give the seq# result binder an unfolding pointing at the manifest-value argument, enabling case-of-known-constructor. * rebuildCase (2c): discard 'case seq# <manifest-value> s of (# s', _dead #) -> rhs' to rhs[s/s']. See the new (SEQ5) in Note [seq# magic] in GHC.Types.Id.Make. Adds the reproducer as perf test T25181. Assisted-by: Claude Fable 5 - - - - - 4 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Types/Id/Make.hs - + testsuite/tests/perf/should_run/T25181.hs - testsuite/tests/perf/should_run/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -3218,6 +3218,35 @@ rebuildCase, reallyRebuildCase -> SimplCont -> SimplM (SimplFloats, OutExpr) +-------------------------------------------------- +-- 0. ANF-ise a manifest-value seq# argument +-------------------------------------------------- + +rebuildCase (saf,env) scrut case_bndr alts@[Alt _ [_token, res] rhs] cont + -- ANF-ise `case seq# (Con e1 .. en) s of (# s', r #) -> case r of ...` + -- to `let a1 = e1 .. in case seq# (Con a1 .. an) s of ...`, so that + -- simplAlt can give `r` an *expandable* unfolding `Con a1 .. an` and + -- case-of-known-constructor can see through the seq#. + -- Guarded on `r` being scrutinised immediately, which guarantees that the + -- unfolding pays off; otherwise the let-floats would just be inlined back + -- on the next iteration. See (SEQ5) in Note [seq# magic] in GHC.Types.Id.Make + | (Var f, [ty_a, ty_s, arg, tok]) <- collectArgs scrut + , f `hasKey` seqHashKey + , scrutinises_res rhs + , exprIsManifestValue arg + , (_, con_args) <- collectArgs arg + , any (\a -> isValArg a && not (exprIsTrivial a)) con_args + = do { (anf_floats, arg') <- prepareRhs env NotTopLevel (fsLit "sat") arg + ; let floats = emptyFloats env `addLetFloats` anf_floats + env' = env `setInScopeFromF` floats + scrut' = Var f `mkApps` [ty_a, ty_s, arg', tok] + ; (floats2, expr') <- rebuildCase (saf,env') scrut' case_bndr alts cont + ; return (floats `addFloats` floats2, expr') } + where + scrutinises_res (Case (Var v) _ _ _) = v == res + scrutinises_res (Tick _ e) = scrutinises_res e + scrutinises_res _ = False + -------------------------------------------------- -- 1. Eliminate the case if there's a known constructor -------------------------------------------------- @@ -3292,7 +3321,21 @@ rebuildCase (saf,env) scrut case_bndr alts@[Alt _ bndrs rhs] cont ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } - -- 2c. Try the seq rules if + -- 2c. Discard a seq# on a manifest value if its result is dead: + -- case seq# <manifest-value> s of (# s', _ #) -> rhs ==> rhs[s/s'] + -- See (SEQ5) in Note [seq# magic] in GHC.Types.Id.Make + | [token_out, res] <- bndrs + , isDeadBinder res, isDeadBinder case_bndr + , (Var f, [_ty1, _ty2, arg, Var token_in]) <- collectArgs scrut + , f `hasKey` seqHashKey + , exprIsManifestValue arg + , exprOkToDiscard arg + = do { tick (CaseElim case_bndr) + ; (floats1, env') <- simplAuxBind (saf,env) token_out (Var token_in) + ; (floats2, expr') <- simplExprF env' rhs cont + ; return (floats1 `addFloats` floats2, expr') } + + -- 2d. Try the seq rules if -- a) it binds only the case binder -- b) a rule for seq applies -- See Note [User-defined RULES for seq] in GHC.Types.Id.Make @@ -3317,6 +3360,24 @@ rebuildCase (saf,env) scrut case_bndr alts cont | otherwise = reallyRebuildCase (saf,env) scrut case_bndr alts cont +exprIsManifestValue :: OutExpr -> Bool +-- True of expressions that are values no matter what the context: +-- literals, lambdas, and (saturated or partial) constructor applications. +-- Unlike exprIsHNF, never true for a variable that is merely *known* to be +-- evaluated: for the seq#-discarding transformations that use this +-- predicate, such a variable carries a dependency on its binding site that +-- must not be lost. See (SEQ5) in Note [seq# magic] in GHC.Types.Id.Make. +exprIsManifestValue e = go e + where + go (Cast e _) = go e + go (Tick t e) = not (tickishCounts t) && go e + go (Lit _) = True + go (Lam b e) = isRuntimeVar b || go e + go (Var f) = isDataConWorkId f + go e@(App {}) | (Var f, _) <- collectArgs e + = isDataConWorkId f && exprIsHNF e + go _ = False + doCaseToLet :: OutExpr -- Scrutinee -> InId -- Case binder -> Bool @@ -3590,7 +3651,21 @@ simplAlt (saf,env) scrut' _ case_bndr' bndr_swap' cont' (Alt (DataAlt con) vs rh con_app = mkConApp2 con inst_tys' vs' env'' = addAltUnfoldings env' case_bndr' bndr_swap' con_app - ; rhs' <- simplAltExprC (saf,env'') rhs cont' + -- If the scrutinee is (seq# <manifest-value> s), record that + -- value as the unfolding of the result binder, so that + -- case-of-known-constructor can see through the seq#. + -- See (SEQ5) in Note [seq# magic] in GHC.Types.Id.Make + env_seq | Just scr <- scrut' + , isUnboxedTupleDataCon con + , [_token, res] <- vs' + , (Var f, [_ty1, _ty2, arg, _]) <- collectArgs scr + , f `hasKey` seqHashKey + , exprIsManifestValue arg + = addBinderUnfolding env'' res $ + mkSimpleUnfolding (seUnfoldingOpts env) arg + | otherwise = env'' + + ; rhs' <- simplAltExprC (saf,env_seq) rhs cont' ; return (Alt (DataAlt con) vs' rhs') } {- Note [Adding evaluatedness info to pattern-bound variables] ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -2516,6 +2516,43 @@ Things to note example in #24334 (immortalised as test T24334) for why it should be done in CorePrep. +(SEQ5) + T25181 shows that we additionally want to unbox through seq# when its + argument is a manifest value: + + case seq# (f x, y) s of (# s', p #) -> + case p of (a, b) -> rhs + + Evaluating a manifest value (a literal, lambda, or constructor application; + see exprIsManifestValue in GHC.Core.Opt.Simplify.Iteration) is a no-op, so + here seq# guarantees nothing beyond ordinary data dependencies; the only + remaining cost is the allocation of the value itself, which we want the + Simplifier to eliminate where possible. Hence three cooperating + transformations in GHC.Core.Opt.Simplify.Iteration: + + * rebuildCase (0) ANF-ises the seq# argument when the result is scrutinised + immediately: `let sat = f x in case seq# (sat, y) s of ...`. Without this + the unfolding below would be a con-app with non-trivial fields, which is + not *expandable*, so exprIsConApp_maybe would refuse to expand it and + case-of-known-constructor would never fire. + + * simplAlt gives `p` an unfolding `(sat, y)`, so that + case-of-known-constructor rewrites `case p of (a, b) -> rhs` to + `let a = sat; b = y in rhs`, typically making `p` dead. + + * rebuildCase (2c) then discards the seq# when its result is dead: + case seq# <manifest-value> s of (# s', _ #) -> rhs[s'] ==> rhs[s] + + Soundness: unlike the late, unsound seqRule of #24334, all transformations + demand a *manifest* value, not a variable that is merely known to be + evaluated (hence exprIsManifestValue, not exprIsHNF). Discarding + `seq# x s` for an evaluated variable `x` would lose the syntactic + dependency of the continuation on `x`, allowing lazy computations to float + past x's binding site and thereby evaluate too early; see the `pseq` + example in #24334. A manifest value, by contrast, converges unconditionally + and depends on nothing except its own (pure, discardable) field + expressions, so no ordering constraint is lost. + Implementing seq#. The compiler has magic for `seq#` in - GHC.CoreToStg.Prep.cpeRhsE: Implement (SEQ4). ===================================== testsuite/tests/perf/should_run/T25181.hs ===================================== @@ -0,0 +1,24 @@ +-- T25181 +import Control.Exception (evaluate) + +import Prelude hiding (repeat) + +repeat :: a -> [a] +repeat a = res + where res = a : res +{-# NOINLINE repeat #-} + +silly :: [(Int, Int)] -> IO () +silly = foldr go (pure ()) + where + go p r = do + (x, y) <- evaluate p + (x', y') <- evaluate (x + 3, y) + evaluate y' + r + +main :: IO () +-- 10,000,000 repetitions take only a twentieth of a second, +-- but allocations go up dramatically if the result is not +-- known evaluated. +main = silly $ take 10000000 $ repeat (1,1) ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -367,6 +367,12 @@ test('T15226a', compile_and_run, ['-O']) +test('T25181', + [collect_stats('bytes allocated',5), + only_ways(['normal'])], + compile_and_run, + ['-O']) + test('T15263', [collect_stats('bytes allocated', 4), only_ways(['normal'])], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22a6adcc7fc803de96661dd25808ab5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22a6adcc7fc803de96661dd25808ab5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/sjakobi/T25181
by Simon Jakobi (＠sjakobi2) 05 Jul '26

05 Jul '26

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

1 0

[Git][ghc/ghc][wip/az/exactprint-annotation-rationalisation] 3 commits: EPA: Remove LocatedE from WarningCategory
by Alan Zimmerman (＠alanz) 05 Jul '26

05 Jul '26

Alan Zimmerman pushed to branch wip/az/exactprint-annotation-rationalisation at Glasgow Haskell Compiler / GHC Commits: 030cd0f1 by Alan Zimmerman at 2026-07-04T14:53:06+01:00 EPA: Remove LocatedE from WarningCategory - - - - - e05bcb77 by Alan Zimmerman at 2026-07-04T15:59:29+01:00 EPA: Remove LocateE from XCImport and XCExport - - - - - 982953c9 by Alan Zimmerman at 2026-07-05T09:52:40+01:00 EPA: Remove LocatedE from HsRecFields dot - - - - - 9 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Unit/Module/Warnings.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1472,10 +1472,10 @@ type instance XForeignExport GhcTc = Coercion type instance XXForeignDecl (GhcPass _) = DataConCantHappen -type instance XCImport (GhcPass _) = LocatedE SourceText -- original source text for the C entity +type instance XCImport (GhcPass _) = LocatedA SourceText -- original source text for the C entity type instance XXForeignImport (GhcPass _) = DataConCantHappen -type instance XCExport (GhcPass _) = LocatedE SourceText -- original source text for the C entity +type instance XCExport (GhcPass _) = LocatedA SourceText -- original source text for the C entity type instance XXForeignExport (GhcPass _) = DataConCantHappen @@ -1729,6 +1729,6 @@ type instance Anno (WarnDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (AnnDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (RoleAnnotDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (Maybe Role) = EpAnnCO -type instance Anno CCallConv = EpaLocation -type instance Anno Safety = EpaLocation -type instance Anno CExportSpec = EpaLocation +type instance Anno CCallConv = SrcSpanAnnA +type instance Anno Safety = SrcSpanAnnA +type instance Anno CExportSpec = SrcSpanAnnA ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -353,7 +353,7 @@ hsRecFieldId = hsRecFieldSel ************************************************************************ -} -instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ LocatedE RecFieldsDotDot) +instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ LocatedA RecFieldsDotDot) => Outputable (HsRecFields p arg) where ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing }) = braces (fsep (punctuate comma (map ppr flds))) @@ -1178,4 +1178,4 @@ type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA type instance Anno (HsOverLit (GhcPass p)) = EpAnnCO type instance Anno ConLike = SrcSpanAnnN type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA -type instance Anno RecFieldsDotDot = EpaLocation +type instance Anno RecFieldsDotDot = SrcSpanAnnA ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -2210,15 +2210,15 @@ instance ToHie (LocatedA (ForeignDecl GhcRn)) where instance ToHie (ForeignImport GhcRn) where toHie (CImport (L c _) (L a _) (L b _) _ _) = concatM $ - [ locOnlyE a - , locOnlyE b - , locOnlyE c + [ locOnlyE (entry a) + , locOnlyE (entry b) + , locOnlyE (entry c) ] instance ToHie (ForeignExport GhcRn) where toHie (CExport (L b _) (L a _)) = concatM $ - [ locOnlyE a - , locOnlyE b + [ locOnlyE (entry a) + , locOnlyE (entry b) ] instance ToHie (LocatedA (WarnDecls GhcRn)) where ===================================== compiler/GHC/Parser.y ===================================== @@ -2084,7 +2084,7 @@ maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) } $2 (snd $ unLoc $3))} | {- empty -} { Nothing } -warning_category :: { Maybe (LocatedE (InWarningCategory GhcPs)) } +warning_category :: { Maybe (LocatedA (InWarningCategory GhcPs)) } : 'in' STRING { Just (reLoc $ sLL $1 $> $ InWarningCategory (epTok $1, getSTRINGs $2) (reLoc $ sL1 $2 $ mkWarningCategory (getSTRING $2))) } | {- empty -} { Nothing } ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -3214,7 +3214,7 @@ mkImport cconv safety (L loc sLit, v, ty) (timport, td) = -- the string "foo" is ambiguous: either a header or a C identifier. The -- C identifier case comes first in the alternatives below, so we pick -- that one. -parseCImport :: LocatedE CCallConv -> LocatedE Safety -> FastString -> String +parseCImport :: LocatedA CCallConv -> LocatedA Safety -> FastString -> String -> Located SourceText -> Maybe (ForeignImport GhcPs) parseCImport cconv safety nm str sourceText = ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -859,7 +859,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) , hfbRHS = arg' , hfbPun = pun } } - rn_dotdot :: Maybe (LocatedE RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat + rn_dotdot :: Maybe (LocatedA RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat -> Maybe (WithUserRdr Name) -- The constructor (Nothing for an out of scope constructor) -> [LHsRecField GhcRn (LocatedA arg)] -- Explicit fields ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -72,7 +72,6 @@ import GHC.Rename.Utils( mkRnSyntaxExpr ) import GHC.Types.Id.Make( mkDictFunId ) import GHC.Types.Arity ( Arity, VisArity ) import GHC.Types.Basic ( TypeOrKind(..) ) -import GHC.Types.SourceText import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var.Env import GHC.Types.Id ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -166,8 +166,8 @@ type instance XInWarningCategory (GhcPass _) = (EpToken "in", SourceText) type instance XXInWarningCategory (GhcPass _) = DataConCantHappen type instance Anno (WithHsDocIdentifiers (StringLiteral pass) pass) = SrcSpanAnnA -type instance Anno (InWarningCategory (GhcPass pass)) = EpaLocation -type instance Anno (WarningCategory) = EpaLocation +type instance Anno (InWarningCategory (GhcPass pass)) = SrcSpanAnnA +type instance Anno (WarningCategory) = SrcSpanAnnA type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnA deriving stock instance Eq (WarningTxt GhcPs) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -726,6 +726,11 @@ printStringAtMLocL an l s = do printStringAdvanceA :: (Monad m, Monoid w) => String -> EP w m () printStringAdvanceA str = printStringAtAA (EpaDelta noSrcSpan (SameLine 0) []) str >> return () +printStringAtA :: (Monad m, Monoid w) => EpAnn a -> String -> EP w m (EpAnn a) +printStringAtA ann s = do + l' <- printStringAtAA (entry ann) s + return ann { entry = l' } + printStringAtAA :: (Monad m, Monoid w) => EpaLocation -> String -> EP w m EpaLocation printStringAtAA el str = printStringAtAAC CaptureComments el str @@ -750,9 +755,13 @@ printStringAtAAC capture (EpaDelta ss d cs) s = do -- --------------------------------------------------------------------- -markExternalSourceTextE :: (Monad m, Monoid w) => EpaLocation -> SourceText -> String -> EP w m EpaLocation -markExternalSourceTextE l NoSourceText txt = printStringAtAA l txt -markExternalSourceTextE l (SourceText txt) _ = printStringAtAA l (unpackFS txt) +markExternalSourceTextA :: (Monad m, Monoid w) => EpAnn a -> SourceText -> String -> EP w m (EpAnn a) +markExternalSourceTextA ann src txt = do + l' <- mark_source_text ann src txt + return (ann { entry = l'}) + where + mark_source_text l NoSourceText txt' = printStringAtAA (entry l) txt' + mark_source_text l (SourceText txt') _ = printStringAtAA (entry l) (unpackFS txt') -- --------------------------------------------------------------------- @@ -1868,11 +1877,11 @@ instance ExactPrint (ForeignImport GhcPs) where setAnnotationAnchor a _ _ _ = a exact (CImport (L ls src) cconv safety@(L l _) mh imp) = do cconv' <- markAnnotated cconv - safety' <- if notDodgyE l + safety' <- if notDodgyE (entry l) then markAnnotated safety else return safety - ls' <- if notDodgyE ls - then markExternalSourceTextE ls src "" + ls' <- if notDodgyE (entry ls) + then markExternalSourceTextA ls src "" else return ls return (CImport (L ls' src) cconv' safety' mh imp) @@ -1884,8 +1893,8 @@ instance ExactPrint (ForeignExport GhcPs) where exact (CExport (L ls src) spec) = do debugM $ "CExport starting" spec' <- markAnnotated spec - ls' <- if notDodgyE ls - then markExternalSourceTextE ls src "" + ls' <- if notDodgyE (entry ls) + then markExternalSourceTextA ls src "" else return ls return (CExport (L ls' src) spec') @@ -3215,7 +3224,7 @@ instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where mdot' <- case mdot of Nothing -> return Nothing Just (L ss d) -> do - ss' <- printStringAtAA ss ".." + ss' <- printStringAtA ss ".." return $ Just (L ss' d) -- Note: mdot contains the SrcSpan where the ".." appears, if present cc' <- markEpToken cc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5cbcb2b2c83f34d4e55224b829ce4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5cbcb2b2c83f34d4e55224b829ce4… You're receiving this email because of your account on gitlab.haskell.org.

1 0