- ghc-commits - Haskell.org

[Git][ghc/ghc][master] Fix build with werror on glibc 2.43.
by Marge Bot (＠marge-bot) 26 Mar '26

26 Mar '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7b9a75f0 by Phil Hazelden at 2026-03-26T03:58:37-04:00 Fix build with werror on glibc 2.43. We've been defining `_XOPEN_SOURCE` and `_POSIX_C_SOURCE` to the same values as defined in glibc prior to 2.43. But in 2.43, glibc changes them to new values, which means we get a warning when redefining them. By `#undef`ing them first, we no longer get a warning. Closes #27076. - - - - - 1 changed file: - rts/include/rts/PosixSource.h Changes: ===================================== rts/include/rts/PosixSource.h ===================================== @@ -29,6 +29,8 @@ Oracle's Solaris 11 supports only up to XPG6, hence the ifdef. */ +#undef _POSIX_C_SOURCE +#undef _XOPEN_SOURCE #if defined(solaris2_HOST_OS) #define _POSIX_C_SOURCE 200112L #define _XOPEN_SOURCE 600 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b9a75f09a0a8d11d843f43e8e938b6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b9a75f09a0a8d11d843f43e8e938b6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Fix race condition between flushEventLog and start/endEventLogging.
by Marge Bot (＠marge-bot) 26 Mar '26

26 Mar '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3d6492ce by Wen Kokke at 2026-03-26T03:57:53-04:00 Fix race condition between flushEventLog and start/endEventLogging. This commit changes `flushEventLog` to acquire/release the `state_change` mutex to prevent interleaving with `startEventLogging` and `endEventLogging`. In the current RTS, `flushEventLog` _does not_ acquire this mutex, which may lead to eventlog corruption on the following interleaving: - `startEventLogging` writes the new `EventLogWriter` to `event_log_writer`. - `flushEventLog` flushes some events to `event_log_writer`. - `startEventLogging` writes the eventlog header to `event_log_writer`. This causes the eventlog to be written out in an unreadable state, with one or more events preceding the eventlog header. This commit renames the old function to `flushEventLog_` and defines `flushEventLog` simply as: ```c void flushEventLog(Capability **cap USED_IF_THREADS) { ACQUIRE_LOCK(&state_change_mutex); flushEventLog_(cap); RELEASE_LOCK(&state_change_mutex); } ``` The old function is still needed internally within the compilation unit, where it is used in `endEventLogging` in a context where the `state_change` mutex has already been acquired. I've chosen to mark `flushEventLog_` as static and let other uses of `flushEventLog` within the RTS refer to the new version. There is one use in `hs_init_ghc` via `flushTrace`, where the new locking behaviour should be harmless, and one use in `handle_tick`, which I believe was likely vulnerable to the same race condition, so the new locking behaviour is desirable. I have not added a test. The behaviour is highly non-deterministic and requires a program that concurrently calls `flushEventLog` and `startEventLogging`/`endEventLogging`. I encountered the issue while developing `eventlog-socket` and within that context have verified that my patch likely addresses the issue: a test that used to fail within the first dozen or so runs now has been running on repeat for several hours. - - - - - 1 changed file: - rts/eventlog/EventLog.c Changes: ===================================== rts/eventlog/EventLog.c ===================================== @@ -161,6 +161,8 @@ static void freeEventLoggingBuffer(void); static void ensureRoomForEvent(EventsBuf *eb, EventTypeNum tag); static int ensureRoomForVariableEvent(EventsBuf *eb, StgWord size); +static void flushEventLog_(Capability **cap USED_IF_THREADS); + static inline void postWord8(EventsBuf *eb, StgWord8 i) { *(eb->pos++) = i; @@ -491,7 +493,7 @@ endEventLogging(void) eventlog_enabled = false; - flushEventLog(NULL); + flushEventLog_(NULL); ACQUIRE_LOCK(&eventBufMutex); @@ -1615,6 +1617,17 @@ void flushAllCapsEventsBufs(void) } void flushEventLog(Capability **cap USED_IF_THREADS) +{ + ACQUIRE_LOCK(&state_change_mutex); + flushEventLog_(cap); + RELEASE_LOCK(&state_change_mutex); +} + +// This is an unsafe version of flushEventLog that does not acquire/release the +// state_change mutex. It is for internal use only and should only be used when +// (1) you're sure that there's no chance of racing with start/endEventLogging, +// and (2) there is an event_log_writer. +static void flushEventLog_(Capability **cap USED_IF_THREADS) { if (!event_log_writer) { return; @@ -1644,7 +1657,7 @@ void flushEventLog(Capability **cap USED_IF_THREADS) flushEventLogWriter(); } -#else +#else /*!TRACING*/ enum EventLogStatus eventLogStatus(void) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d6492ce311611707e80b2594103ddb… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d6492ce311611707e80b2594103ddb… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 3 commits: ghc-boot: move GHC.Data.SmallArray to ghc-boot
by Marge Bot (＠marge-bot) 26 Mar '26

26 Mar '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 36eed985 by Cheng Shao at 2026-03-26T03:57:03-04:00 ghc-boot: move GHC.Data.SmallArray to ghc-boot This commit moves `GHC.Data.SmallArray` from the `ghc` library to `ghc-boot`, so that it can be used by `ghci` as well: - The `Binary` (from `ghc`) instance of `SmallArray` is moved to `GHC.Utils.Binary` - Util functions `replicateSmallArrayIO`, `mapSmallArrayIO`, `mapSmallArrayM_`, `imapSmallArrayM_` , `smallArrayFromList` and `smallArrayToList` are added - The `Show` instance is added - The `Binary` (from `binary`) instance is added - - - - - fdf828ae by Cheng Shao at 2026-03-26T03:57:03-04:00 compiler: use `Binary` instance of `BCOByteArray` for bytecode objects This commit defines `Binary` (from `compiler`) instance of `BCOByteArray` which serializes the underlying buffer directly, and uses it directly in bytecode object serialization. Previously we reuse the `Binary` (from `binary`) instance, and this change allows us to avoid double-copying via an intermediate `ByteString` when using `put`/`get` in `binnary`. Also see added comment for explanation. - - - - - 3bf62d0a by Cheng Shao at 2026-03-26T03:57:03-04:00 ghci: use SmallArray directly in ResolvedBCO This patch makes ghci use `SmallArray` directly in `ResolvedBCO` when applicable, making the memory representation more compact and reducing marshaling overhead. Closes #27058. - - - - - 10 changed files: - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/Utils/Binary.hs - compiler/ghc.cabal.in - compiler/GHC/Data/SmallArray.hs → libraries/ghc-boot/GHC/Data/SmallArray.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/ResolvedBCO.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -29,7 +29,7 @@ import GHC.Unit.Types import GHC.Data.FastString import GHC.Data.Maybe -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import GHC.Linker.Types @@ -43,7 +43,10 @@ import GHC.Types.Unique.DFM -- Standard libraries import Control.Concurrent -import Data.Array.Unboxed +import Control.Monad +import Data.Array.Base +import Data.Array.IO.Internals +import Data.Functor import Foreign.Ptr import GHC.Exts @@ -62,15 +65,18 @@ linkBCO interp pkgs_loaded bytecode_state bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded bytecode_state) (elemsFlatBag lits0) - ptrs <- mapM (resolvePtr interp pkgs_loaded bytecode_state bco_ix) (elemsFlatBag ptrs0) - let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits + litsMut <- unsafeNewArray_ (0, fromIntegral (sizeFlatBag lits0) - 1) + foldM_ (\(!i) lit -> (unsafeWrite litsMut i =<< lookupLiteral interp pkgs_loaded bytecode_state lit) $> succ i) 0 lits0 + lits <- unsafeFreezeIOUArray litsMut + ptrsMut <- newSmallArrayIO (fromIntegral (sizeFlatBag ptrs0)) undefined + foldM_ (\(!i) ptr -> (writeSmallArrayIO ptrsMut i =<< resolvePtr interp pkgs_loaded bytecode_state bco_ix ptr) $> succ i) 0 ptrs0 + ptrs <- unsafeFreezeSmallArrayIO ptrsMut return $ ResolvedBCO { resolvedBCOIsLE = isLittleEndian , resolvedBCOArity = arity , resolvedBCOInstrs = insns , resolvedBCOBitmap = bitmap - , resolvedBCOLits = mkBCOByteArray lits' - , resolvedBCOPtrs = addListToSS emptySS ptrs + , resolvedBCOLits = mkBCOByteArray lits + , resolvedBCOPtrs = ptrs } lookupLiteral :: Interp -> PkgsLoaded -> BytecodeLoaderState -> BCONPtr -> IO Word ===================================== compiler/GHC/ByteCode/Serialize.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RecordWildCards #-} -- Orphans are here since the Binary instances use an ad-hoc means of serialising @@ -20,7 +21,7 @@ module GHC.ByteCode.Serialize where import Control.Monad -import Data.Binary qualified as Binary +import Data.ByteString.Short (ShortByteString(..)) import Data.Foldable import Data.IORef import Data.Proxy @@ -320,19 +321,30 @@ instance Binary UnlinkedBCO where UnlinkedBCO <$> getViaBinName bh <*> get bh - <*> (Binary.decode <$> get bh) - <*> (Binary.decode <$> get bh) + <*> get bh + <*> get bh <*> get bh <*> get bh put_ bh UnlinkedBCO {..} = do putViaBinName bh unlinkedBCOName put_ bh unlinkedBCOArity - put_ bh $ Binary.encode unlinkedBCOInstrs - put_ bh $ Binary.encode unlinkedBCOBitmap + put_ bh unlinkedBCOInstrs + put_ bh unlinkedBCOBitmap put_ bh unlinkedBCOLits put_ bh unlinkedBCOPtrs +-- Also see Note [BCOByteArray serialization]. This instance is unlike +-- the `Binary` instances in `ghci`, which are for the `Binary` class +-- in `binary` and are used across host/target platforms; here this +-- instance is only used on the host for bytecode object serialization +-- and doesn't cross host/target boundary. Therefore it's safe to +-- serialize the underlying buffer directly. +instance Binary (BCOByteArray a) where + put_ bh (BCOByteArray ba#) = put_ bh $ SBS ba# + + get bh = (\(SBS ba#) -> BCOByteArray ba#) <$> get bh + instance Binary BCOPtr where get bh = do t <- getByte bh ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -132,6 +132,7 @@ import GHC.Data.FastMutInt import GHC.Utils.Fingerprint import GHC.Types.SrcLoc import GHC.Types.Unique +import GHC.Data.SmallArray import qualified GHC.Data.Strict as Strict import GHC.Utils.Outputable( JoinPointHood(..) ) import GHCi.FFI @@ -975,6 +976,15 @@ instance (Ix a, Binary a, Binary b) => Binary (Array a b) where xs <- get bh return $ listArray bounds xs +instance Binary a => Binary (SmallArray a) where + put_ bh sa = do + put_ bh $ sizeofSmallArray sa + mapSmallArrayM_ (put_ bh) sa + + get bh = do + n <- get bh + replicateSmallArrayIO n $ get bh + instance (Binary a, Binary b) => Binary (a,b) where put_ bh (a,b) = do put_ bh a; put_ bh b get bh = do a <- get bh ===================================== compiler/ghc.cabal.in ===================================== @@ -461,7 +461,6 @@ Library GHC.Data.OrdList GHC.Data.OsPath GHC.Data.Pair - GHC.Data.SmallArray GHC.Data.Stream GHC.Data.Strict GHC.Data.StringBuffer ===================================== compiler/GHC/Data/SmallArray.hs → libraries/ghc-boot/GHC/Data/SmallArray.hs ===================================== @@ -1,6 +1,8 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE ImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} -- | Small-array module GHC.Data.SmallArray @@ -13,8 +15,14 @@ module GHC.Data.SmallArray , indexSmallArray , sizeofSmallArray , listToArray + , smallArrayFromList + , smallArrayToList , mapSmallArray , foldMapSmallArray + , replicateSmallArrayIO + , mapSmallArrayIO + , mapSmallArrayM_ + , imapSmallArrayM_ , rnfSmallArray -- * IO Operations @@ -26,12 +34,13 @@ module GHC.Data.SmallArray where import GHC.Exts -import GHC.Prelude import GHC.IO import GHC.ST -import GHC.Utils.Binary import Control.DeepSeq +import Control.Monad +import Data.Binary import Data.Foldable +import Data.List (unfoldr) data SmallArray a = SmallArray (SmallArray# a) @@ -39,6 +48,17 @@ data SmallMutableArray s a = SmallMutableArray (SmallMutableArray# s a) type SmallMutableArrayIO a = SmallMutableArray RealWorld a +instance Binary a => Binary (SmallArray a) where + put sa = put (sizeofSmallArray sa) *> foldMapSmallArray put sa + + get = do + n <- get + smallArrayFromList <$> replicateM n get + + +instance Show a => Show (SmallArray a) where + showsPrec p = showsPrec p . smallArrayToList + newSmallArray :: Int -- ^ size -> a -- ^ initial contents @@ -142,6 +162,45 @@ foldMapSmallArray f sa = go 0 | i < n = f (indexSmallArray sa i) `mappend` go (i + 1) | otherwise = mempty +-- | Execute the 'IO' action the given number of times and store the +-- results in a 'SmallArray'. +{-# INLINE replicateSmallArrayIO #-} +replicateSmallArrayIO :: Int -> IO a -> IO (SmallArray a) +replicateSmallArrayIO n m = do + arr <- newSmallArrayIO n undefined + let go i + | i < n = do + writeSmallArrayIO arr i =<< m + go $ succ i + | otherwise = pure () + go 0 + unsafeFreezeSmallArrayIO arr + +-- | Apply the 'IO' action to every element, producing a new +-- 'SmallArray'. +{-# INLINE mapSmallArrayIO #-} +mapSmallArrayIO :: (a -> IO b) -> SmallArray a -> IO (SmallArray b) +mapSmallArrayIO f sa = do + ma <- newSmallArrayIO (sizeofSmallArray sa) undefined + flip imapSmallArrayM_ sa $ \i v -> writeSmallArrayIO ma i =<< f v + unsafeFreezeSmallArrayIO ma + +-- | Apply the monadic action to every element, ignoring the results. +{-# INLINE mapSmallArrayM_ #-} +mapSmallArrayM_ :: Applicative f => (a -> f b) -> SmallArray a -> f () +mapSmallArrayM_ f = imapSmallArrayM_ (\_ v -> f v) + +-- | Apply the monadic action to every element and its index, ignoring +-- the results. +{-# INLINE imapSmallArrayM_ #-} +imapSmallArrayM_ :: Applicative f => (Int -> a -> f b) -> SmallArray a -> f () +imapSmallArrayM_ f sa = go 0 + where + n = sizeofSmallArray sa + go i + | i < n = f i (indexSmallArray sa i) *> go (succ i) + | otherwise = pure () + -- | Force the elements of the given 'SmallArray' -- rnfSmallArray :: NFData a => SmallArray a -> () @@ -169,16 +228,27 @@ listToArray (I# size) index_of value_of xs = runST $ ST \s -> s'' -> case unsafeFreezeSmallArray# ma s'' of (# s''', a #) -> (# s''', SmallArray a #) -instance (Binary a) => Binary (SmallArray a) where - get bh = do - len <- get bh - ma <- newSmallArrayIO len undefined - for_ [0 .. len - 1] $ \i -> do - a <- get bh - writeSmallArrayIO ma i a - unsafeFreezeSmallArrayIO ma - - put_ bh sa = do - let len = sizeofSmallArray sa - put_ bh len - for_ [0 .. len - 1] $ \i -> put_ bh $ sa `indexSmallArray` i +-- | Construct a 'SmallArray' from a list. This is different from +-- 'listToArray' since the list elements fill the 'SmallArray' +-- sequentially without recalculating the indices or remapping to +-- other element types. +{-# INLINE smallArrayFromList #-} +smallArrayFromList :: [a] -> SmallArray a +smallArrayFromList vs = runST $ ST $ \s0 -> + case newSmallArray (length vs) undefined s0 of + (# s1, ma #) -> + case foldlM (\i v -> ST $ \s0 -> + case writeSmallArray ma i v s0 of + s1 -> (# s1, succ i #)) 0 vs of + ST m -> case m s1 of + (# s2, _ #) -> unsafeFreezeSmallArray ma s2 + +-- | Construct a list from a 'SmallArray'. +{-# INLINE smallArrayToList #-} +smallArrayToList :: SmallArray a -> [a] +smallArrayToList sa = unfoldr go 0 + where + n = sizeofSmallArray sa + go i + | i < n = Just (indexSmallArray sa i, succ i) + | otherwise = Nothing ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -45,7 +45,7 @@ Flag bootstrap Manual: True Library - default-language: Haskell2010 + default-language: GHC2024 other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables default-extensions: NoImplicitPrelude @@ -53,6 +53,7 @@ Library GHC.BaseDir GHC.Data.ShortText GHC.Data.SizedSeq + GHC.Data.SmallArray GHC.Utils.Encoding GHC.Utils.Encoding.UTF8 GHC.LanguageExtensions ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -18,10 +18,9 @@ import Prelude -- See note [Why do we import Prelude here?] import GHCi.ResolvedBCO import GHCi.RemoteTypes import GHCi.BreakArray -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import System.IO (fixIO) -import Control.Monad import Data.Array.Base import Foreign hiding (newArray) import Unsafe.Coerce (unsafeCoerce) @@ -72,9 +71,6 @@ createBCO arr bco linkBCO' :: Array Int HValue -> ResolvedBCO -> IO BCO linkBCO' arr ResolvedBCO{..} = do let - ptrs = ssElts resolvedBCOPtrs - n_ptrs = sizeSS resolvedBCOPtrs - !(I# arity#) = resolvedBCOArity !(EmptyArr empty#) = emptyArr -- See Note [BCO empty array] @@ -83,7 +79,7 @@ linkBCO' arr ResolvedBCO{..} = do bitmap_barr = barr (getBCOByteArray resolvedBCOBitmap) literals_barr = barr (getBCOByteArray resolvedBCOLits) - PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs + PtrsArr marr <- mkPtrsArray arr resolvedBCOPtrs IO $ \s -> case unsafeFreezeArray# marr s of { (# s, arr #) -> case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io -> @@ -92,24 +88,25 @@ linkBCO' arr ResolvedBCO{..} = do -- we recursively link any sub-BCOs while making the ptrs array -mkPtrsArray :: Array Int HValue -> Word -> [ResolvedBCOPtr] -> IO PtrsArr -mkPtrsArray arr n_ptrs ptrs = do - marr <- newPtrsArray (fromIntegral n_ptrs) +mkPtrsArray :: Array Int HValue -> SmallArray ResolvedBCOPtr -> IO PtrsArr +mkPtrsArray arr ptrs = do + let n_ptrs = sizeofSmallArray ptrs + marr <- newPtrsArray n_ptrs let - fill (ResolvedBCORef n) i = + fill i (ResolvedBCORef n) = writePtrsArrayHValue i (arr ! n) marr -- must be lazy! - fill (ResolvedBCOPtr r) i = do + fill i (ResolvedBCOPtr r) = do hv <- localRef r writePtrsArrayHValue i hv marr - fill (ResolvedBCOStaticPtr r) i = do + fill i (ResolvedBCOStaticPtr r) = do writePtrsArrayPtr i (fromRemotePtr r) marr - fill (ResolvedBCOPtrBCO bco) i = do + fill i (ResolvedBCOPtrBCO bco) = do bco <- linkBCO' arr bco writePtrsArrayBCO i bco marr - fill (ResolvedBCOPtrBreakArray r) i = do + fill i (ResolvedBCOPtrBreakArray r) = do BA mba <- localRef r writePtrsArrayMBA i mba marr - zipWithM_ fill ptrs [0..] + imapSmallArrayM_ fill ptrs return marr data PtrsArr = PtrsArr (MutableArray# RealWorld HValue) ===================================== libraries/ghci/GHCi/ResolvedBCO.hs ===================================== @@ -12,7 +12,7 @@ module GHCi.ResolvedBCO #include "MachDeps.h" import Prelude -- See note [Why do we import Prelude here?] -import GHC.Data.SizedSeq +import GHC.Data.SmallArray import GHCi.RemoteTypes import GHCi.BreakArray @@ -51,13 +51,13 @@ isLittleEndian = True -- data ResolvedBCO = ResolvedBCO { - resolvedBCOIsLE :: Bool, + resolvedBCOIsLE :: !Bool, resolvedBCOArity :: {-# UNPACK #-} !Int, - resolvedBCOInstrs :: BCOByteArray Word16, -- ^ insns - resolvedBCOBitmap :: BCOByteArray Word, -- ^ bitmap - resolvedBCOLits :: BCOByteArray Word, + resolvedBCOInstrs :: !(BCOByteArray Word16), -- ^ insns + resolvedBCOBitmap :: !(BCOByteArray Word), -- ^ bitmap + resolvedBCOLits :: !(BCOByteArray Word), -- ^ non-ptrs - subword sized entries still take up a full (host) word - resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr) -- ^ ptrs + resolvedBCOPtrs :: !(SmallArray ResolvedBCOPtr) -- ^ ptrs } deriving (Generic, Show) ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -76,7 +76,6 @@ GHC.Data.Maybe GHC.Data.OrdList GHC.Data.OsPath GHC.Data.Pair -GHC.Data.SmallArray GHC.Data.Strict GHC.Data.StringBuffer GHC.Data.TrieMap ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -77,7 +77,6 @@ GHC.Data.Maybe GHC.Data.OrdList GHC.Data.OsPath GHC.Data.Pair -GHC.Data.SmallArray GHC.Data.Strict GHC.Data.StringBuffer GHC.Data.TrieMap View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/161d3285215e85a9ebb24d798cea93… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/161d3285215e85a9ebb24d798cea93… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Revert "Set default eventlog-flush-interval to 5s"
by Marge Bot (＠marge-bot) 26 Mar '26

26 Mar '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 161d3285 by Teo Camarasu at 2026-03-26T03:56:18-04:00 Revert "Set default eventlog-flush-interval to 5s" Flushing the eventlog forces a synchronisation of all the capabilities and there was a worry that this might lead to a performance cost for some highly parallel workloads. This reverts commit 66b96e2a591d8e3d60e74af3671344dfe4061cf2. - - - - - 2 changed files: - docs/users_guide/9.16.1-notes.rst - rts/RtsFlags.c Changes: ===================================== docs/users_guide/9.16.1-notes.rst ===================================== @@ -142,8 +142,6 @@ Runtime system kqueue). This first one, based on `poll()`, is merely intended to be portable. -- The default for :rts-flag:`--eventlog-flush-interval=⟨seconds⟩` has changed from being disabled to being enabled with a flush inverval of 5 seconds. - Cmm ~~~ ===================================== rts/RtsFlags.c ===================================== @@ -252,7 +252,7 @@ void initRtsFlagsDefaults(void) RtsFlags.TraceFlags.ticky = false; RtsFlags.TraceFlags.trace_output = NULL; # if defined(THREADED_RTS) - RtsFlags.TraceFlags.eventlogFlushTime = SecondsToTime(5); // 5s + RtsFlags.TraceFlags.eventlogFlushTime = 0; # endif RtsFlags.TraceFlags.nullWriter = false; #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/161d3285215e85a9ebb24d798cea931… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/161d3285215e85a9ebb24d798cea931… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 2 commits: release tracking: adopt release tracking ticket from #16816
by Marge Bot (＠marge-bot) 26 Mar '26

26 Mar '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ef0a1bd2 by mangoiv at 2026-03-26T03:55:34-04:00 release tracking: adopt release tracking ticket from #16816 - - - - - a7f40fd9 by mangoiv at 2026-03-26T03:55:34-04:00 release tracking: add a release tracking ticket Brings the information in the release tracking ticket up to date with https://gitlab.haskell.org/ghc/ghc-hq/-/blob/main/release-management.mkd Resolves #26691 - - - - - 1 changed file: - + .gitlab/issue_templates/release_tracking.md Changes: ===================================== .gitlab/issue_templates/release_tracking.md ===================================== @@ -0,0 +1,201 @@ + + +This is the release checklist for the **TODO milestone**. + + + +See the milestone for the planned release schedule, and other details. See [GHC HQ - Release Management](https://gitlab.haskell.org/ghc/ghc-hq/-/blob/main/release-manag… for release policies. + +This template is part of the ghc repository at `.gitlab/issue_templates/release_tracking.md`. + + +# Pre-fork checklist + + +When forking a new release branch for a new major release series (e.g. `ghc-9.14`), please check the following: + +* [ ] Add the release to the [status page](https://gitlab.haskell.org/ghc/ghc/-/wikis/GHC-Status), including a link to the milestone. +* [ ] Verify that the platform support documentation is up-to-date with reality: + * https://gitlab.haskell.org/ghc/ghc/-/wikis/platforms/windows + * https://gitlab.haskell.org/ghc/ghc/-/wikis/platforms/ +* [ ] Remove the release notes for the previous release (e.g. `docs/users_guide/8.6.*-notes.rst`) +* [ ] In `configure.ac` update `MinBootGhcVersion` to be the major version of the last supported bootstrap compiler. We currently guarantee bootstrapping with the last two major releases; therefore, when preparing, e.g., GHC `9.14` you should set `MinBootGhcVersion` to `9.10`. +* [ ] Create the new branch: `git branch ghc-9.14` +* [ ] In the new branch bump the version number in `configure.ac` to, e.g., `9.14` +* [ ] In `master` bump the version number in `configure.ac` to that of the next development series, e.g., `9.15` and ensure that `MinBootGhcVersion` is set correctly +* [ ] Verify that package versions have been bumped as necessary under PVP: + * [ ] `base` + * [ ] `template-haskell` + * [ ] `ghc-prim` +* [ ] Tag this `master` commit as, e.g., `ghc-9.14-start` +* [ ] Push all of the above tags and branches +* [ ] Create a new worksheet in the GHC submodule tracking spreadsheet (ask in `#ghc` for a link), populate the "current" and "desired" version columns, and send an email to submodule maintainers and `ghc-releases@haskell.org` asking them to notify us of their needs +* [ ] After forking, remove release notes from `master` and start a new set of release notes for the next release +* [ ] After forking, notify `ghc-releases@haskell.org` that fork has been made +* [ ] Create a weekly scheduled pipeline building the new branch to ensure that it does not bit-rot and bindists are persistently available + +# Pre-release checklist + +* [ ] Ensure that the Haddock (haddock-library, haddock-api) version numbers have been appropriately bumped. +* [ ] Ensure that submodules are on released tags (the below is produced using [this script](https://gitlab.haskell.org/bgamari/ghc-utils/blob/master/rel-eng/su…) + * [ ] `libraries/Cabal`: version *todo* + * [ ] `libraries/Win32`: version *todo* + * [ ] `libraries/array`: version *todo* + * [ ] `libraries/binary`: version *todo* + * [ ] `libraries/bytestring`: version *todo* + * [ ] `libraries/containers`: version *todo* + * [ ] `libraries/deepseq`: version *todo* + * [ ] `libraries/directory`: version *todo* + * [ ] `libraries/exceptions`: version *todo* + * [ ] `libraries/file-io`: version *todo* + * [ ] `libraries/filepath`: version *todo* + * [ ] `libraries/haskeline`: version *todo* + * [ ] `libraries/hpc`: version *todo* + * [ ] `libraries/libffi-clib`: version *todo* + * [ ] `libraries/mtl`: version *todo* + * [ ] `libraries/os-string`: version *todo* + * [ ] `libraries/parsec`: version *todo* + * [ ] `libraries/pretty`: version *todo* + * [ ] `libraries/process`: version *todo* + * [ ] `libraries/semaphore-compat`: version *todo* + * [ ] `libraries/stm`: version *todo* + * [ ] `libraries/template-haskell-lift`: version *todo* + * [ ] `libraries/template-haskell-quasiquoter`: version *todo* + * [ ] `libraries/terminfo`: version *todo* + * [ ] `libraries/text`: version *todo* + * [ ] `libraries/time`: version *todo* + * [ ] `libraries/transformers`: version *todo* + * [ ] `libraries/unix`: version *todo* + * [ ] `libraries/xhtml`: version *todo* + * [ ] `utils/hpc`: version *todo* + * [ ] `utils/hsc2hs`: version *todo* +* [ ] Announce the boot lib versions that are planned to be included in the next release to the boot library maintainers, then allow for appropriate amount of grace time for boot library maintainers to include revisions. +* [ ] Ensure that all of the versions above are newer than the ones for older major releases and incorporate any patch updates +* [ ] Notify stakeholders of release progress, **including timeline, reason, what to look out for, platform tier changes, build platform changes, Bindist Changes** [^1]: + * [ ] [Julian Ospald](mailto:hasufell@posteo.de) + * [ ] [GHC releases](mailto:ghc-releases@haskell.org) + * [ ] [GHC developers](mailto:ghc-devs@haskell.org) + * [ ] [GHC users](mailto:glasgow-haskell-users@haskell.org) +* [ ] Non-released submodules up-to-date: + * [ ] `nofib` (upstream: ghc/nofib>) + * [ ] `libffi-tarballs` (upstream: ghc/libffi-tarballs>) + * [ ] `libraries/ghc-bignum/gmp/gmp-tarballs` (upstream: ghc/gmp-tarballs>) +* [ ] `LlvmMinVersion` and `LlvmMaxVersion` in `configure.ac` is targetting intended LLVM version +* [ ] `llvm-targets` file [updated](https://gitlab.haskell.org/ghc/ghc/wikis/making-releases#updating-… +* [ ] Release notes (`docs/users_guide/x.y.z-notes.rst`) written + * Release notes linked in `docs/users_guide/release-notes.rst` + * LLVM version requirement mentioned +* [ ] Remove "Included libraries" sections from old release notes +* [ ] `autoconf` scripts [updated](https://gitlab.haskell.org/ghc/ghc/wikis/making-releases#updating-… +* [ ] Check that Unicode database in `base` (`libraries/base/cbits/README.Unicode`) reflects current standard release (http://www.unicode.org/versions/latest/) +* [ ] Verify that the ~"backport needed" label has no more issues/merge requests needing backport +* [ ] Verify that all CI builds are green before moving to *release checklist* +* [ ] Update hadrian bootstrap plans for the latest compiler releases: + * Update `hadrian/bootstrap/generate_bootstrap_plans` to include any new compiler releases in the last two major release series + * Drop any plans that are outside of the bootstrap support window + * Run `hadrian/bootstrap/generate_bootstrap_plans` and commit the files that it generates + * Update `bootstrap_matrix` in `.gitlab-ci.yml` to reflect the most recent minor release in each major series supported by bootstrapping + +# Release candidate checklist + +* Announce on: + * [ ] [GHC developers](mailto:ghc-devs@haskell.org) + * [ ] [GHC releases](mailto:ghc-releases@haskell.org), + * [ ] [GHC users](mailto:glasgow-haskell-users@haskell.org) +* [ ] For minor releases: Ask stackage maintainers to test the release candidate. +* Give grace time + + +# Release checklist + +* [ ] Ensure that the [Migration](https://gitlab.haskell.org/ghc/ghc/wikis/migration/) page is up-to-date +* [ ] Push a provisional release commit to trigger the release builds using `git push -o ci.variable="RELEASE_JOB=yes"` +* [ ] Wait until builds finish; verify that they finished successfully +* [ ] Write down a link to the release pipeline here:  +* [ ] Fetch release artifacts: + ```bash + $ mkdir $VERSION + $ cd $VERSION + $ nix run $GHC/.gitlab/rel_eng#fetch-gitlab --pipeline $PIPELINE_ID --release $VERSION + ``` + where `GHC` is the path to a GHC source tree, `VERSION` is the version number, and `PIPELINE_ID` is the release pipeline id. +* [ ] Recompress release artifacts: `nix run $GHC/.gitlab/rel_eng#upload -- recompress` +* [ ] Generate hashes: `nix run $GHC/.gitlab/rel_eng#upload -- gen_hashes` +* [ ] Sign release artifacts: `nix run $GHC/.gitlab/rel_eng#upload -- sign` +* [ ] Upload to `downloads.haskell.org`: `nix run $GHC/.gitlab/rel_eng#upload -- upload` +* [ ] If most recent release: Update `latest` symlink: `nix run $GHC/.gitlab/rel_eng#upload -- set_symlink latest` +* [ ] Update `X.Y-latest` symlink: `nix run $GHC/.gitlab/rel_eng#upload -- set_symlink 9.8-latest` +* [ ] Purge CDN cache: `nix run $GHC/.gitlab/rel_eng#upload -- purge` +* [ ] Submit `ghcup` metadata upstream: + * Manually trigger the `ghcup-metadata-testing-release` job of the release pipeline + * Download the `metadata_test.yaml` artifact from the `ghcup-metadata-release` job of the release pipeline + * Clone [`ghcup-metadata`](https://github.com/haskell/ghcup-metadata/) + * Integrate the appropriate release section into `ghcup-metadata/ghcup-0.0.7.yaml` (or `ghcup-prerelease-0.0.7.yaml` for pre-releases) + * Replace the `&id<n>` identifiers with unique names + * Add the `Latest` (or `LatestPrerelease`) to the new release's `viTags` field + * Remove `Latest` for the previous release's `viTags` field; for pre-releases add the `Prerelease` tag) + * Add the `base-w.x.y.z` (e.g. `base-4.19.0.0`) tag to `viTags` + * Sign the resulting metadata YAML file with `gpg --detach-sign` + * Open a merge request submitting the metadata upstream + * Start a "Bindist installation" [workflow](https://github.com/haskell/ghcup-metadata/actions/workflows/bindi… +* [ ] [Make a release tag](https://gitlab.haskell.org/ghc/ghc/wikis/making-releases#tagging-the-r… +* [ ] Release/revise GHC-maintained libraries on Hackage using [this script](https://gitlab.haskell.org/ghc/ghc/-/blob/master/.gitlab/rel_eng/up…: + * [ ] `libraries/base` + * [ ] `libraries/ghc-prim` + * [ ] `libraries/array` + * [ ] `libraries/stm` + * [ ] `libraries/ghc-heap` + * [ ] `libraries/ghc-compact` + * [ ] `libraries/ghc-boot` + * [ ] `libraries/ghc-boot-th` + * [ ] `libraries/hpc` + * [ ] `libraries/libiserv` + * [ ] `libraries/template-haskell` + * [ ] `libraries/ghc-bignum` +* [ ] Update ghc/homepage>: + * [ ] Write download page (see ghc/homepage>) + * [ ] Make sure that the Signing Key is correct for the relevant release + * [ ] Add news item to [`index.html`](https://gitlab.haskell.org/ghc/homepage/blob/master/index.shtml) + * [ ] Add link to [`download.shtml`](https://gitlab.haskell.org/ghc/homepage/blob/master/download.shtml). Be sure to link to the Migration guide. + * [ ] Look over changes locally + * [ ] Add release announcement to [GHC blog](https://gitlab.haskell.org/ghc/homepage/tree/master/blog). Be sure to link to the Migration guide. + * [ ] Push changes to `master` +* [ ] Announce on: + * [ ] [GHC developers](mailto:ghc-devs@haskell.org) + * [ ] [GHC releases](mailto:ghc-releases@haskell.org), + * [ ] [Boot libraries maintainers](mailto:ghc-boot-libraries@haskell.org) + * [ ] [GHC users](mailto:glasgow-haskell-users@haskell.org) + * [ ] adjacent matrix channels: #haskell-releases:matrix.org, #GHC:matrix.org, #ghc-devs:matrix.org + * [ ] [Haskell Cafe](mailto:haskell-cafe@haskell.org) + * [ ] Mention sponsors + * [ ] Mention ghc / ghc-hq + * [ ] Link to release notes and migration guide +* [ ] Announce on: [Haskell Discourse](https://discourse.haskell.org/), [/r/haskell](https://reddit.com/r/haskell), [/m/haskell](https://kbin.social/m/haskell) +* [ ] When releasing the latest version, update `latest` symlink on `downloads.haskell.org`, e.g. `ln -sfT 9.6.3 latest` if 9.6 was the latest major series. + +# Post-release checklist + +* [ ] Update the Wiki [status page](https://gitlab.haskell.org/ghc/ghc/-/wikis/GHC-Status) +* [ ] Update the [language pragma history](https://gitlab.haskell.org/ghc/ghc/wikis/language-pragma-history) +* [ ] Mark milestone as *closed* +* [ ] Update `/topic` in `#ghc` +* [ ] Update the [VersionHistory](https://gitlab.haskell.org/ghc/ghc/wikis/commentary/librari… wiki page +* [ ] Set `RELEASE=NO` +* [ ] Create a release tracking ticket for the next release using the template in #16816 + +[^1]: Build platform changes are major changes to how GHC is being built from sources. + Bindist changes are significant changes to the toolchains, changes to the layout of the bindists or changes to the user facing installation procedure. + Platform tier changes are changes that move platforms up or down a tier or drop a given platform from the tierlist. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b550754ca0153a705ec607407074f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b550754ca0153a705ec607407074f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] rts: forward clone-stack messages after TSO migration
by Marge Bot (＠marge-bot) 26 Mar '26

26 Mar '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5b550754 by Matthew Pickering at 2026-03-26T03:54:51-04:00 rts: forward clone-stack messages after TSO migration MSG_CLONE_STACK assumed that the target TSO was still owned by the capability that received the message. This is not always true: the TSO can migrate before the inbox entry is handled. When that happened, handleCloneStackMessage could clone a live stack from the wrong capability and use the wrong capability for allocation and performTryPutMVar, leading to stack sanity failures such as checkStackFrame: weird activation record found on stack. Fix this by passing the current capability into handleCloneStackMessage, rechecking msg->tso->cap at handling time, and forwarding the message if the TSO has migrated. Once ownership matches, use the executing capability consistently for cloneStack, rts_apply, and performTryPutMVar. Fixes #27008 - - - - - 5 changed files: - rts/CloneStack.c - rts/CloneStack.h - rts/Messages.c - testsuite/tests/rts/all.T - + testsuite/tests/rts/cloneThreadStackMigrating.hs Changes: ===================================== rts/CloneStack.c ===================================== @@ -84,15 +84,31 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar) { sendMessage(srcCapability, tso->cap, (Message *)msg); } -void handleCloneStackMessage(MessageCloneStack *msg){ - StgStack* newStackClosure = cloneStack(msg->tso->cap, msg->tso->stackobj); +// The cap argument is the capability which is handling the CloneStack message +void handleCloneStackMessage(Capability *cap, MessageCloneStack *msg){ + // We must check that the current owner of the thread we want to clone the stack for + // is still this capability. + Capability *owner = RELAXED_LOAD(&msg->tso->cap); + if (owner != cap) { + // The target TSO may have migrated after the message was queued on the old + // capability. In that case we must forward the request to the current + // owner; otherwise we would race with another capability mutating the + // stack while we clone it. + sendMessage(cap, owner, (Message *)msg); + return; + } + + // At this point the executing capability owns the TSO, so it is the only + // capability that may safely inspect the live stack and the one whose + // allocator we must use for the cloned StgStack closure. + StgStack* newStackClosure = cloneStack(cap, msg->tso->stackobj); // Lift StackSnapshot# to StackSnapshot by applying it's constructor. // This is necessary because performTryPutMVar() puts the closure onto the // stack for evaluation and stacks can not be evaluated (entered). - HaskellObj result = rts_apply(msg->tso->cap, StackSnapshot_constructor_closure, (HaskellObj) newStackClosure); + HaskellObj result = rts_apply(cap, StackSnapshot_constructor_closure, (HaskellObj) newStackClosure); - bool putMVarWasSuccessful = performTryPutMVar(msg->tso->cap, msg->result, result); + bool putMVarWasSuccessful = performTryPutMVar(cap, msg->result, result); if(!putMVarWasSuccessful) { barf("Can't put stack cloning result into MVar."); ===================================== rts/CloneStack.h ===================================== @@ -17,7 +17,7 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar); #include "BeginPrivate.h" #if defined(THREADED_RTS) -void handleCloneStackMessage(MessageCloneStack *msg); +void handleCloneStackMessage(Capability *cap, MessageCloneStack *msg); #endif #include "EndPrivate.h" ===================================== rts/Messages.c ===================================== @@ -135,7 +135,7 @@ loop: } else if(i == &stg_MSG_CLONE_STACK_info){ MessageCloneStack *cloneStackMessage = (MessageCloneStack*) m; - handleCloneStackMessage(cloneStackMessage); + handleCloneStackMessage(cap, cloneStackMessage); } else { ===================================== testsuite/tests/rts/all.T ===================================== @@ -587,6 +587,15 @@ test('cloneMyStack_retBigStackFrame', [req_c, extra_files(['cloneStackLib.c']), test('cloneThreadStack', [req_c, only_ways(['threaded1']), extra_ways(['threaded1']), extra_files(['cloneStackLib.c']), req_ghc_with_threaded_rts], compile_and_run, ['cloneStackLib.c -threaded']) +test('cloneThreadStackMigrating', + [ ignore_stdout + , only_ways(['threaded1']) + , extra_ways(['threaded1']) + , extra_run_opts('+RTS -N -DS -RTS') + , req_ghc_with_threaded_rts + , req_target_smp + ], compile_and_run, ['-threaded -debug -rtsopts']) + test('decodeMyStack', [ omit_ghci, js_broken(22261) # cloneMyStack# not yet implemented , when(ghc_with_ipe(), skip) # IPE builds can change decoded stack output. ===================================== testsuite/tests/rts/cloneThreadStackMigrating.hs ===================================== @@ -0,0 +1,37 @@ +module Main where + +import Control.Concurrent +import Control.Monad +import GHC.Exts.Stack +import GHC.Stack.CloneStack + +numWorkers :: Int +numWorkers = 100 + +startN :: Int +startN = 10 + +runForMicros :: Int +runForMicros = 1000000 + +fib :: Int -> Int +fib 0 = 1 +fib 1 = 1 +fib n = fib (n - 1) + fib (n - 2) + +workerThread :: Int -> IO () +workerThread n = do + fib n `seq` pure () + workerThread (n + 1) + +cloneThread :: ThreadId -> IO () +cloneThread tid = forever $ do + snapshot <- cloneThreadStack tid + stack <- decodeStack snapshot + stack `seq` pure () + +main :: IO () +main = do + tids <- replicateM numWorkers (forkIO $ workerThread startN) + mapM_ (forkIO . cloneThread) tids + threadDelay runForMicros View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b550754ca0153a705ec607407074fe… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b550754ca0153a705ec607407074fe… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Generate assembly on x86 for word2float (#22252)
by Marge Bot (＠marge-bot) 26 Mar '26

26 Mar '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5ebcfb57 by Benjamin Maurer at 2026-03-26T03:54:02-04:00 Generate assembly on x86 for word2float (#22252) We used to emit C function call for MO_UF_Conv primitive. Now emits direct assembly instead. Co-Authored-By: Sylvain Henry <sylvain(a)haskus.fr> Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com> - - - - - 6 changed files: - compiler/GHC/Cmm/Node.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - testsuite/tests/codeGen/should_run/Word2Float32.hs - testsuite/tests/codeGen/should_run/Word2Float32.stdout - testsuite/tests/codeGen/should_run/Word2Float64.hs - testsuite/tests/codeGen/should_run/Word2Float64.stdout Changes: ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -417,8 +417,8 @@ instance NonLocal CmmNode where -------------------------------------------------- -- Various helper types -type CmmActual = CmmExpr -type CmmFormal = LocalReg +type CmmActual = CmmExpr -- ^ Usually used to refer to arguments +type CmmFormal = LocalReg -- ^ Usually used to refer to result registers. type UpdFrameOffset = ByteOff ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -6714,10 +6714,172 @@ genClz bid width dst src = do -- W8/W16 cases because the 'MOV' insn already -- took care of implicitly clearing the upper bits +{- +Note [Word-to-float conversion on x86-64] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +CVTSI2SD/CVTSI2SS treat their source as a *signed* integer, so an +unsigned Word with the MSB set would yield a negative float. + +We use a halve-and-double trick: + 1. If src < 2^63 (MSB clear): convert directly; the signed and + unsigned interpretations agree. + 2. If src >= 2^63 (MSB set): + (a) Compute tmp = (src `shiftR` 1) .|. (src .&. 1) + which halves src while preserving the LSB as a "round bit". + (b) Convert tmp as a signed integer (its MSB is now clear). + (c) Double the float result. + +The round bit in step (a) is crucial for correct rounding. Without +it, adjacent even and odd large values would produce the same float. +With it, the conversion in step (b) sees the correct rounding +information, and doubling in step (c) scales back to the right range. + +Example (Float64, src = 2^64 - 1 = 0xFFFF_FFFF_FFFF_FFFF): + tmp = 0x7FFF_FFFF_FFFF_FFFF | 1 = 0x7FFF_FFFF_FFFF_FFFF + float64(tmp) rounds to 2^63 ≈ 9.2234e18 + 2 × 9.2234e18 = 1.8447e19 (= float64(2^64 - 1)) ✓ + +Note [Word-to-float64 conversion on i386] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +On 32-bit x86, StgWord is 32 bits. CVTSI2SD converts a *signed* +32-bit integer, so inputs with the MSB set look negative. + +Trick: add 2^31 to flip the MSB, convert as signed, then add back 2^31 as a +Float64 constant. + +Let src' = src + 2^31 (mod 2^32): + src in [0, 2^31): src' in [2^31, 2^32), signed value = src - 2^31. + CVTSI2SD gives src - 2^31. + 2^31.0 → src ✓ + src = 2^31: src' = 0 (wraps). CVTSI2SD gives 0.0. + 2^31.0 → 2^31 ✓ + src in (2^31, 2^32): src' = src - 2^31 ∈ (0, 2^31), positive. + CVTSI2SD gives src - 2^31. + 2^31.0 → src ✓ + +The constant 2^31 is materialised without a memory load: 0x4F000000 +is the IEEE 754 float32 bit-pattern for 2^31; a MOVD + CVTSS2SD +gives the exact float64 value. + +Note [Word-to-float32 conversion on i386] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +On 32-bit x86, StgWord is 32 bits. CVTSI2SS converts a *signed* +32-bit integer, so values >= 2^31 would convert incorrectly. + +We split the 32-bit unsigned value into its high and low 16-bit halves +and convert each separately: + result = float32(high16) × 65536.0 + float32(low16) + +Both halves are in [0, 65535], within float32's exact integer range +(24-bit mantissa covers integers up to 2^24 = 16777216 > 65535). +Multiplying by 65536.0 = 2^16 is exact (no mantissa bits consumed). +The final addition rounds to the nearest float32, matching a direct +uint32→float32 conversion. + +The constant 65536.0 (= 0x47800000 in float32 bit-pattern) is loaded +via a MOV + MOVD, avoiding a memory load. +-} + genWordToFloat :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock -genWordToFloat bid width dst src = - -- TODO: generate assembly instead - genPrimCCall bid (word2FloatLabel width) [dst] [src] +genWordToFloat bid width dst src = do + is32Bit <- is32BitPlatform + platform <- getPlatform + + let srcFormat = intFormat $ cmmExprWidth platform src + let dst_r = getLocalRegReg dst + let conv = case width of + W64 -> CVTSI2SD + W32 -> CVTSI2SS + _ -> pprPanic "genWordToFloat: unsupported width" (ppr width) + let dstFormat = floatFormat width + + (src_r, code_src) <- getSomeReg src + + if is32Bit + then case (srcFormat, width) of + (II32, W64) -> do + -- See Note [Word-to-float64 conversion on i386] + cst_r <- getNewRegNat srcFormat + cst_v <- getNewRegNat dstFormat + flip_r <- getNewRegNat srcFormat + return $ code_src `appOL` toOL + [ MOV srcFormat (OpImm (ImmInt 0x4F000000)) (OpReg cst_r) -- load the constant + , MOVD srcFormat (floatFormat W32) (OpReg cst_r) (OpReg cst_v) + , CVTSS2SD cst_v cst_v + , MOV srcFormat (OpReg src_r) (OpReg flip_r) -- copy src (modified below) + , ADD srcFormat (OpImm $ ImmInteger 0x80000000) (OpReg flip_r) -- flip_r = flip MSB(src) + -- XOR dst_r with itself to avoid a false dependency: CVTSI2SD + -- (SSE2) only writes the lower 64 bits of the destination XMM + -- register, leaving the upper bits unchanged. That creates a + -- dependency on the old value of dst_r. Zeroing it first breaks + -- the dependency chain. + , XOR dstFormat (OpReg dst_r) (OpReg dst_r) + , conv srcFormat (OpReg flip_r) dst_r + , ADD dstFormat (OpReg cst_v) (OpReg dst_r) -- +2147483648.0 + ] + (II32, W32) -> do + -- See Note [Word-to-float32 conversion on i386] + tmp_v <- getNewRegNat dstFormat + cst_v <- getNewRegNat dstFormat + cst_r <- getNewRegNat srcFormat + high_r <- getNewRegNat srcFormat + low_r <- getNewRegNat srcFormat + return $ code_src `appOL` toOL + [ MOV srcFormat (OpImm (ImmInt 0x47800000)) (OpReg cst_r) -- load the constant + , MOVD srcFormat dstFormat (OpReg cst_r) (OpReg cst_v) + , MOVZxL II16 (OpReg src_r) (OpReg low_r) -- low_r = low 16 bits + , MOV srcFormat (OpReg src_r) (OpReg high_r) -- copy src (modified below) + , SHR srcFormat (OpImm $ ImmInt 16) (OpReg high_r) -- high_r = high 16 bits + , conv srcFormat (OpReg high_r) dst_r -- dst_r = float(high) + , MUL dstFormat (OpReg cst_v) (OpReg dst_r) -- dst_r = float(high) * 65536.0 + -- XOR tmp_v to avoid a false dependency on its previous value + -- before the CVTSI2SS below (same reasoning as in the W64 case). + , XOR dstFormat (OpReg tmp_v) (OpReg tmp_v) + , conv srcFormat (OpReg low_r) tmp_v -- tmp_v = float(low) + , ADD dstFormat (OpReg tmp_v) (OpReg dst_r) -- dst_r = float(high)*65536.0 + float(low) + ] + _ -> panic ("genWordToFloat: unsupported source operand format: " ++ show srcFormat) + else do + -- See Note [Word-to-float conversion on x86-64] + half_r <- getNewRegNat srcFormat + round_r <- getNewRegNat srcFormat + + lblLarge <- getBlockIdNat + lblSmall <- getBlockIdNat + lblAfter <- getBlockIdNat + + -- We're building a diamond CFG: + -- bid -> lblSmall -> lblAfter -> origSucc + -- \-> lblLarge ->/ + -- addImmediateSuccessorNat moves bid's original successor to lblAfter, + -- then we fix up the other edges. + addImmediateSuccessorNat bid lblAfter + -- Small values (MSB clear, i.e. < 2^63) are assumed more common in + -- practice, hence the higher weight on the lblSmall edge. + updateCfgNat ( addWeightEdge bid lblSmall 100 + . addWeightEdge bid lblLarge 50 + . addWeightEdge lblSmall lblAfter 1 + . addWeightEdge lblLarge lblAfter 1 + . delEdge bid lblAfter ) + + return $ appOL (code_src) + $ toOL + [ TEST srcFormat (OpReg src_r) (OpReg src_r) + , JXX NEG lblLarge + -- Adding this label to allow optimizations to either invert condition or just eliminate + , JXX ALWAYS lblSmall + , NEWBLOCK lblSmall + , conv srcFormat (OpReg src_r) dst_r -- direct conversion for src < 2^63 + , JXX ALWAYS lblAfter + , NEWBLOCK lblLarge + -- Halve src, preserving the LSB as a round bit, then convert and double. + , MOV srcFormat (OpReg src_r) (OpReg half_r) + , SHR srcFormat (OpImm $ ImmInt 1) (OpReg half_r) -- half_r = src >> 1 + , MOV srcFormat (OpReg src_r) (OpReg round_r) -- copy src (modified below) + , AND srcFormat (OpImm $ ImmInt 1) (OpReg round_r) -- round_r = src & 1 (round bit) + , OR srcFormat (OpReg round_r) (OpReg half_r) -- half_r = (src >> 1) | (src & 1) + , conv srcFormat (OpReg half_r) dst_r + , ADD dstFormat (OpReg dst_r) (OpReg dst_r) -- double the result + , JXX ALWAYS lblAfter + , NEWBLOCK lblAfter + ] genAtomicRead :: Width -> MemoryOrdering -> LocalReg -> CmmExpr -> NatM InstrBlock genAtomicRead width _mord dst addr = do ===================================== testsuite/tests/codeGen/should_run/Word2Float32.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE MagicHash #-} module Main (main) where -import GHC.Exts (Double(D#), Float(F#), word2Double#, word2Float#) +import GHC.Exts (Double(D#), Float(F#), Word(W#), word2Double#, word2Float#) main :: IO () main = do @@ -15,3 +15,13 @@ main = do -- stored in a 32-bit IEEE floating-point value without loss of -- precision print (F# (word2Float# 16777216##)) + + -- We also want to check for sane behaviour for cases that lose precision + let W# max_word = (maxBound :: Word) + print (F# (word2Float# max_word)) + + -- 2^31 sits exactly at the MSB boundary exercised by the i386 algorithms + -- (see Notes [Word-to-float64 conversion on i386] and + -- [Word-to-float32 conversion on i386] in GHC.CmmToAsm.X86.CodeGen) + print (D# (word2Double# 2147483648##)) + print (F# (word2Float# 2147483648##)) ===================================== testsuite/tests/codeGen/should_run/Word2Float32.stdout ===================================== @@ -2,3 +2,6 @@ 4.294967295e9 0.0 1.6777216e7 +4.2949673e9 +2.147483648e9 +2.1474836e9 ===================================== testsuite/tests/codeGen/should_run/Word2Float64.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE MagicHash #-} module Main (main) where -import GHC.Exts (Double(D#), Float(F#), word2Double#, word2Float#) +import GHC.Exts (Double(D#), Float(F#), Word(W#), word2Double#, word2Float#) main :: IO () main = do @@ -15,3 +15,14 @@ main = do -- stored in a 32-bit IEEE floating-point value without loss of -- precision print (F# (word2Float# 16777216##)) + + -- We also want to check for sane behaviour for cases that lose precision + let W# max_word = (maxBound :: Word) + print (F# (word2Float# max_word)) + print (D# (word2Double# max_word)) + + -- 2^63 is the first value that requires the halve-and-double path + -- (see Note [Word-to-float conversion on x86-64] in GHC.CmmToAsm.X86.CodeGen) + let W# two63 = 0x8000000000000000 + print (F# (word2Float# two63)) + print (D# (word2Double# two63)) ===================================== testsuite/tests/codeGen/should_run/Word2Float64.stdout ===================================== @@ -2,3 +2,7 @@ 9.007199254740992e15 0.0 1.6777216e7 +1.8446744e19 +1.8446744073709552e19 +9.223372e18 +9.223372036854776e18 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ebcfb5767804895488da29f0852fa0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ebcfb5767804895488da29f0852fa0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 7 commits: Add regression test for #12002
by Marge Bot (＠marge-bot) 26 Mar '26

26 Mar '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 57b7878d by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #12002 Closes #12002. - - - - - c8f9df2d by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #12046 Closes #12046. Co-authored-by: Andreas Klebinger <klebinger.andreas(a)gmx.at> - - - - - 615d72ac by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #13180 Closes #13180. - - - - - 423eebcf by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #11141 Closes #11141. - - - - - 286849a4 by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #11505 Closes #11505. - - - - - 7db149d9 by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression perf test for #13820 Closes #13820. - - - - - e73c4adb by Simon Jakobi at 2026-03-26T03:53:07-04:00 Add regression test for #10381 Closes #10381. - - - - - 19 changed files: - + testsuite/tests/parser/should_compile/T12002.hs - + testsuite/tests/parser/should_compile/T12002.stderr - testsuite/tests/parser/should_compile/all.T - + testsuite/tests/perf/compiler/T13820.hs - testsuite/tests/perf/compiler/all.T - + testsuite/tests/rebindable/T10381.hs - testsuite/tests/rebindable/all.T - + testsuite/tests/typecheck/T13180/T13180.hs - + testsuite/tests/typecheck/T13180/T13180.hs-boot - + testsuite/tests/typecheck/T13180/T13180.stderr - + testsuite/tests/typecheck/T13180/T13180A.hs - + testsuite/tests/typecheck/T13180/all.T - + testsuite/tests/typecheck/should_compile/T11141.hs - + testsuite/tests/typecheck/should_compile/T11141.stderr - + testsuite/tests/typecheck/should_compile/T11505Bar.hs - + testsuite/tests/typecheck/should_compile/T11505Foo.hs - + testsuite/tests/typecheck/should_compile/T11505Foo.hs-boot - + testsuite/tests/typecheck/should_compile/T12046.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== testsuite/tests/parser/should_compile/T12002.hs ===================================== @@ -0,0 +1,5 @@ +-- Test that the misplaced LANGUAGE pragma results in a warning but doesn't +-- cause the program to be rejected. +module T12002 where + +{-# LANGUAGE OverloadedStrings #-} ===================================== testsuite/tests/parser/should_compile/T12002.stderr ===================================== @@ -0,0 +1,6 @@ +T12002.hs:5:1: warning: [GHC-28007] [-Wmisplaced-pragmas (in -Wdefault)] + Misplaced LANGUAGE pragma + Suggested fix: + Perhaps you meant to place it in the module header? + The module header is the section at the top of the file, before the ‘module’ keyword + ===================================== testsuite/tests/parser/should_compile/all.T ===================================== @@ -116,6 +116,7 @@ test('DumpParsedAst', normal, compile, ['-dsuppress-uniques -ddump-parsed-a test('DumpParsedAstComments', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments']) test('DumpRenamedAst', normal, compile, ['-dsuppress-uniques -ddump-rn-ast']) test('DumpTypecheckedAst', normal, compile, ['-dsuppress-uniques -ddump-tc-ast']) +test('T12002', normal, compile, ['']) test('T12045e', normal, compile, ['']) test('T13087', normal, compile, ['']) test('T13747', normal, compile, ['']) ===================================== testsuite/tests/perf/compiler/T13820.hs ===================================== @@ -0,0 +1,11 @@ +-- Regression test for #13820. Instead of the original 27 `id`s, this +-- test uses only 24, so a regression is less likely to result in an +-- out-of-memory situation. +f = id id id id + id id id id + id id id id + id id id id + id id id id + id id id id + +main = print 1 ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -680,6 +680,12 @@ test ('T13253-spj', ], compile, ['-v0 -O']) +test ('T13820', + [ collect_compiler_stats('peak_megabytes_allocated', 5), + collect_compiler_stats('bytes allocated', 2), + ], + compile, + ['-v0']) test ('T14766', [ collect_compiler_stats('bytes allocated',2), pre_cmd('python3 genT14766.py > T14766.hs'), ===================================== testsuite/tests/rebindable/T10381.hs ===================================== @@ -0,0 +1,43 @@ +{-# LANGUAGE RebindableSyntax, RankNTypes #-} + +module T10381 where + +import Prelude ( String, undefined ) + +newtype Cont r a = Cont { runCont :: (forall i. a i -> r) -> r } + +(>>=) :: Cont r a -> (forall i. a i -> Cont r b) -> Cont r b +ma >>= fmb + = Cont (\k -> runCont ma (\a -> runCont (fmb a) k)) + +fail :: String -> Cont r a +fail = undefined + +return :: a i -> Cont r a +return x = Cont (\k -> k x) + +foo :: Cont r [] +foo = do + bar <- foo + return bar + +{- Previously, GHC used to reject this program with: + + Couldn't match type ‘i0’ with ‘i’ + because type variable ‘i’ would escape its scope + This (rigid, skolem) type variable is bound by + a type expected by the context: [i] -> Cont r [] + at Bug.hs:21:3-12 + Expected type: Cont r [] -> ([i0] -> Cont r []) -> Cont r [] + Actual type: Cont r [] + -> (forall i. [i] -> Cont r []) -> Cont r [] + In a stmt of a 'do' block: bar <- foo + In the expression: + do { bar <- foo; + return bar } + In an equation for ‘foo’: + foo + = do { bar <- foo; + return bar } +-} + ===================================== testsuite/tests/rebindable/all.T ===================================== @@ -35,6 +35,7 @@ test('T4851', normal, compile, ['']) test('T5908', normal, compile, ['']) test('T10112', normal, compile, ['']) +test('T10381', normal, compile, ['']) test('T11216', normal, compile, ['']) test('T11216A', normal, compile, ['']) test('T12080', normal, compile, ['']) ===================================== testsuite/tests/typecheck/T13180/T13180.hs ===================================== @@ -0,0 +1,15 @@ +-- Should only report an error of kind: +-- +-- Type constructor ‘T’ has conflicting definitions ... +-- +-- Previously, GHC also used to emit an error regarding f: +-- +-- Identifier ‘f’ has conflicting definitions ... +module T13180 (T, f) where + +import qualified T13180A + +type T = Int + +f :: T -> T +f x = T13180A.f x ===================================== testsuite/tests/typecheck/T13180/T13180.hs-boot ===================================== @@ -0,0 +1,4 @@ +module T13180 where + +data T +f :: T -> T ===================================== testsuite/tests/typecheck/T13180/T13180.stderr ===================================== @@ -0,0 +1,12 @@ +[1 of 3] Compiling T13180[boot] ( T13180.hs-boot, T13180.o-boot ) +[2 of 3] Compiling T13180A ( T13180A.hs, T13180A.o ) +[3 of 3] Compiling T13180 ( T13180.hs, T13180.o ) +T13180.hs-boot:3:1: error: [GHC-15843] + • Type constructor ‘T’ has conflicting definitions in the module + and its hs-boot file. + Main module: type T :: * + type T = Int + Boot file: type T :: * + data T + • In the type synonym declaration for ‘T’ + ===================================== testsuite/tests/typecheck/T13180/T13180A.hs ===================================== @@ -0,0 +1,3 @@ +module T13180A (f) where + +import {-# SOURCE #-} T13180 ===================================== testsuite/tests/typecheck/T13180/all.T ===================================== @@ -0,0 +1 @@ +test('T13180', normal, multimod_compile_fail, ['T13180', '-fforce-recomp']) ===================================== testsuite/tests/typecheck/should_compile/T11141.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ScopedTypeVariables #-} +module T11141 where + +data F a = F a +instance Show a => Show (F a) where + show :: forall a. Show a => F a -> String + show (F x) = show x + +{- Previously emitted error: + + Could not deduce (Show a0) + from the context (Show a) + bound by the type signature for show :: Show a => F a -> String + at A.hs:8:13-45 + The type variable ‘a0’ is ambiguous + When checking that: + forall a. Show a => forall a1. Show a1 => F a1 -> String + is more polymorphic than: forall a. Show a => F a -> String + When checking that instance signature for ‘show’ + is more general than its signature in the class + Instance sig: forall a. + Show a => + forall a1. Show a1 => F a1 -> String + Class sig: forall a. Show a => F a -> String + In the instance declaration for ‘Show (F a)’ +-} ===================================== testsuite/tests/typecheck/should_compile/T11141.stderr ===================================== @@ -0,0 +1,4 @@ +T11141.hs:8:20: warning: [GHC-63397] [-Wname-shadowing (in -Wall)] + This binding for ‘a’ shadows the existing binding + bound at T11141.hs:7:10 + ===================================== testsuite/tests/typecheck/should_compile/T11505Bar.hs ===================================== @@ -0,0 +1,3 @@ +module T11505Bar where + +import {-# SOURCE #-} T11505Foo ===================================== testsuite/tests/typecheck/should_compile/T11505Foo.hs ===================================== @@ -0,0 +1,12 @@ +module T11505Foo where + +import T11505Bar + +-- #11505: this used to fail with: +-- +-- T11505Foo.hs:12:1: +-- Type constructor `Foo' has conflicting definitions in the module +-- and its hs-boot file +-- Main module: data Foo = Foo {x :: {-# UNPACK #-} !Int} +-- Boot file: data Foo = Foo {x :: !Int} +data Foo = Foo { x :: {-# UNPACK #-} !Int } ===================================== testsuite/tests/typecheck/should_compile/T11505Foo.hs-boot ===================================== @@ -0,0 +1,3 @@ +module T11505Foo where + +data Foo = Foo { x :: {-# UNPACK #-} !Int } ===================================== testsuite/tests/typecheck/should_compile/T12046.hs ===================================== @@ -0,0 +1,16 @@ +-- Test that AllowAmbiguousTypes works with UndecidableSuperClasses. +-- Both test1 and test2 should be accepted. +{-# LANGUAGE UndecidableSuperClasses #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeFamilies #-} +module T12046 where + +class A (T a) => A a where + type T a + +test1 :: forall a. A a => () +test1 = () + +test2 :: A a => proxy a -> () +test2 _ = () + ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -496,6 +496,7 @@ test('T10770b', expect_broken(10770), compile, ['']) test('T10935', normal, compile, ['']) test('T10971a', normal, compile, ['']) test('T11062', [extra_files(['T11062.hs', 'T11062.hs-boot', 'T11062a.hs'])], multimod_compile, ['T11062', '-v0']) +test('T11141', normal, compile, ['-Wname-shadowing']) test('T11237', normal, compile, ['']) test('T10592', normal, compile, ['']) test('T11305', normal, compile, ['']) @@ -507,6 +508,7 @@ test('RebindNegate', normal, compile, ['']) test('T11319', normal, compile, ['']) test('T11397', normal, compile, ['']) test('T11458', normal, compile, ['']) +test('T11505', [extra_files(['T11505Foo.hs', 'T11505Foo.hs-boot', 'T11505Bar.hs'])], multimod_compile, ['T11505Foo', '-v0']) test('T11506', normal, compile, ['']) test('T11524', normal, compile, ['']) test('T11552', normal, compile, ['']) @@ -525,6 +527,7 @@ test('T11982a', expect_broken(11982), compile, ['']) test('T11982b', expect_broken(11982), compile, ['']) test('T11982c', normal, compile, ['']) test('T12045a', normal, compile, ['']) +test('T12046', normal, compile, ['']) test('T12064', [], multimod_compile, ['T12064', '-v0']) test('ExPat', normal, compile, ['']) test('ExPatFail', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2823b03966e495581f4695f07649c5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2823b03966e495581f4695f07649c5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] AArch64: fix MOVK regUsageOfInstr to mark dst as both read and written
by Marge Bot (＠marge-bot) 26 Mar '26

26 Mar '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2823b039 by Ian Duncan at 2026-03-26T03:52:21-04:00 AArch64: fix MOVK regUsageOfInstr to mark dst as both read and written MOVK (move with keep) modifies only a 16-bit slice of the destination register, so the destination is both read and written. The register allocator must know this to avoid clobbering live values. Update regUsageOfInstr to list the destination in both src and dst sets. No regression test: triggering the misallocation requires specific register pressure around a MOVK sequence, which is difficult to reliably provoke from Haskell source. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/Instr.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -119,7 +119,7 @@ regUsageOfInstr platform instr = case instr of LSL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) MOV dst src -> usage (regOp src, regOp dst) - MOVK dst src -> usage (regOp src, regOp dst) + MOVK dst src -> usage (regOp src ++ regOp dst, regOp dst) MOVZ dst src -> usage (regOp src, regOp dst) MVN dst src -> usage (regOp src, regOp dst) ORR _fmt dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2823b03966e495581f4695f07649c58… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2823b03966e495581f4695f07649c58… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Avoid infinite loop in deep subsumption
by Marge Bot (＠marge-bot) 26 Mar '26

26 Mar '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 45428f88 by sheaf at 2026-03-26T03:51:31-04:00 Avoid infinite loop in deep subsumption This commit ensures we only unify after we recur in the deep subsumption code in the FunTy vs non-FunTy case of GHC.Tc.Utils.Unify.tc_sub_type_deep, to avoid falling into an infinite loop. See the new Wrinkle [Avoiding a loop in tc_sub_type_deep] in Note [FunTy vs non-FunTy case in tc_sub_type_deep] in GHC.Tc.Utils.Unify. Fixes #26823 Co-authored-by: simonpj <simon.peytonjones(a)gmail.com> - - - - - 5 changed files: - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/typecheck/should_compile/T26225.hs - + testsuite/tests/typecheck/should_fail/T26823.hs - + testsuite/tests/typecheck/should_fail/T26823.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -1948,6 +1948,41 @@ the LHS vs the new RHS. And vice-versa (if it's the RHS that is a FunTy). See T11305 and T26225 for examples of when this is important. +Wrinkle [Avoiding a loop in tc_sub_type_deep] + + In #26823, we had: + + alpha <= a -> alpha + + If we simply unified the two types, the occurs-check would trigger. + In deep subsumption however, we need to be careful, as we might do the + following: + + A1. Create fresh metavariables beta, gamma + A2. Unify alpha ~ beta -> gamma + A3. Decompose "beta -> gamma <= a -> (beta -> gamma)", obtaining + a <= beta and gamma <= beta -> gamma + A4. Recur with gamma <= beta -> gamma + + If we do this, we enter an infinite loop and GHC hangs at compile time. + To avoid this, we must first recur, before unifying. So the above becomes: + + B1 (like A1). Create fresh metavariables beta, gamma + B2 (like A3). Decompose "beta -> gamma <= a -> alpha", obtaining + a <= beta and gamma <= alpha + B3. Solve these two sub-problems by unification + a ~ beta, gamma ~ alpha + B4 (like A2). Then, and only then, unify alpha ~ beta->gamma + + With this approach, GHC will be left with the following unifications: + + - alpha ~ (beta -> gamma) + - a ~ beta + - gamma ~ alpha + + GHC will fail to solve this unification problem due to an occurs check + failure, thus rejecting the program with a type error (as desired). + Note [Deep subsumption and required foralls] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A required forall, (forall a -> ty) behaves like a "rho-type", one with no @@ -2117,8 +2152,9 @@ tc_sub_type_deep fun_pos@(tc_fun, pos) ds_depth unify inst_orig ctxt ty_actual t ; exp_arg <- newOpenFlexiTyVarTy -- NB: no FRR check needed; we might not need to eta-expand ; exp_res <- newOpenFlexiTyVarTy ; let exp_funTy = FunTy { ft_af = af1, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res } - ; unify_wrap <- just_unify exp_funTy ty_e + -- Recur before unifying; see Wrinkle [Avoiding a loop in tc_sub_type_deep] ; fun_wrap <- go_fun af1 act_mult act_arg act_res af1 exp_mult exp_arg exp_res + ; unify_wrap <- just_unify exp_funTy ty_e ; return $ unify_wrap <.> fun_wrap -- unify_wrap :: exp_funTy ~~> ty_e -- fun_wrap :: ty_a ~~> exp_funTy @@ -2129,8 +2165,9 @@ tc_sub_type_deep fun_pos@(tc_fun, pos) ds_depth unify inst_orig ctxt ty_actual t ; act_arg <- newOpenFlexiTyVarTy -- NB: no FRR check needed; we might not need to eta-expand ; act_res <- newOpenFlexiTyVarTy ; let act_funTy = FunTy { ft_af = af2, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res } - ; unify_wrap <- just_unify ty_a act_funTy + -- Recur before unifying; see Wrinkle [Avoiding a loop in tc_sub_type_deep] ; fun_wrap <- go_fun af2 act_mult act_arg act_res af2 exp_mult exp_arg exp_res + ; unify_wrap <- just_unify ty_a act_funTy ; return $ fun_wrap <.> unify_wrap -- unify_wrap :: ty_a ~~> act_funTy -- fun_wrap :: act_funTy ~~> ty_e ===================================== testsuite/tests/typecheck/should_compile/T26225.hs ===================================== @@ -26,7 +26,7 @@ ex0 = in g f -- ((∀ a. a->a) -> Int) -> Bool ⊑ α[tau] --- Rejected by GHC up to and including 9.14. +-- Rejected by GHC up to and including 9.12. ex1' :: () ex1' = let @@ -38,7 +38,7 @@ ex1' = -- Couldn't match expected type ‘α’ with actual type ‘((∀ a. a -> a) -> Int) -> Bool’ -- ((∀ a. a->a) -> Int) -> Bool ⊑ β[tau] Bool --- Rejected by GHC up to and including 9.14. +-- Rejected by GHC up to and including 9.12. ex2' :: () ex2' = let @@ -50,7 +50,7 @@ ex2' = -- Couldn't match expected type ‘β’ with actual type ‘(->) ((∀ a. a -> a) -> Int)’ -- ex3 :: β[tau] Bool ⊑ (∀ a. a->a) -> Bool --- Rejected by GHC up to and including 9.14. +-- Rejected by GHC up to and including 9.12. ex3 :: () ex3 = let @@ -62,7 +62,7 @@ ex3 = -- Couldn't match expected type ‘β’ with actual type ‘(->) (∀ a. a -> a)’ -- ex3' :: F Int Bool ⊑ (∀ a. a->a) -> Bool, where F Int = (->) (Int -> Int) --- Rejected by GHC up to and including 9.14. +-- Rejected by GHC up to and including 9.12. ex3' :: () ex3' = let ===================================== testsuite/tests/typecheck/should_fail/T26823.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE DeepSubsumption #-} + +module T26823 where + +allocArray :: Int -> IO () +allocArray n = do + let + !off = 18 + !size = 8 + !vecAli = size + + !rem = off `rem` vecAli + !start = if rem == 0 then off else off + ( vecAli - rem ) + + return () ===================================== testsuite/tests/typecheck/should_fail/T26823.stderr ===================================== @@ -0,0 +1,32 @@ +T26823.hs:12:14: error: [GHC-25897] + • Couldn't match expected type ‘a0 -> a0 -> t’ with actual type ‘t’ + ‘t’ is a rigid type variable bound by + the inferred type of rem :: a0 -> a0 -> t + at T26823.hs:12:5-29 + • In the expression: off `rem` vecAli + In an equation for ‘rem’: !rem = off `rem` vecAli + In a stmt of a 'do' block: + let !off = 18 + !size = 8 + !vecAli = size + !rem = off `rem` vecAli + !start = if rem == 0 then off else off + (vecAli - rem) + • Relevant bindings include + rem :: a0 -> a0 -> t (bound at T26823.hs:12:6) + off :: a0 (bound at T26823.hs:8:6) + vecAli :: a0 (bound at T26823.hs:10:6) + size :: a0 (bound at T26823.hs:9:6) + +T26823.hs:13:57: error: [GHC-27958] + • Couldn't match expected type ‘a0’ + with actual type ‘a0 -> a0 -> t0’ + • In the second argument of ‘(-)’, namely ‘rem’ + In the second argument of ‘(+)’, namely ‘(vecAli - rem)’ + In the expression: off + (vecAli - rem) + • Relevant bindings include + start :: a0 (bound at T26823.hs:13:6) + rem :: forall {t}. a0 -> a0 -> t (bound at T26823.hs:12:6) + off :: a0 (bound at T26823.hs:8:6) + vecAli :: a0 (bound at T26823.hs:10:6) + size :: a0 (bound at T26823.hs:9:6) + ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -755,5 +755,6 @@ test('T23162a', normal, compile_fail, ['']) test('T23162b', normal, compile_fail, ['']) test('T23162c', normal, compile, ['']) test('T23162d', normal, compile, ['']) +test('T26823', normal, compile_fail, ['']) test('T26861', normal, compile_fail, ['']) test('T26862', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45428f88f62896650156dc822229974… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45428f88f62896650156dc822229974… You're receiving this email because of your account on gitlab.haskell.org.

1 0