Apoorv Ingle pushed new branch wip/ani/hackage-test at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ani/hackage-test
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/jeltsch/improve-closure-property-check] Change the implementation of `collect` so that it uses `concatMapM`
by Wolfgang Jeltsch (@jeltsch) 14 Sep '26
by Wolfgang Jeltsch (@jeltsch) 14 Sep '26
14 Sep '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/improve-closure-property-check at Glasgow Haskell Compiler / GHC
Commits:
002c2052 by Wolfgang Jeltsch at 2026-09-14T17:01:35+03:00
Change the implementation of `collect` so that it uses `concatMapM`
- - - - -
1 changed file:
- compiler/GHC/Driver/Downsweep.hs
Changes:
=====================================
compiler/GHC/Driver/Downsweep.hs
=====================================
@@ -72,6 +72,7 @@ import GHC.Utils.Logger
import GHC.Utils.Fingerprint
import GHC.Utils.TmpFs
import GHC.Utils.Constants
+import GHC.Utils.Monad (concatMapM)
import GHC.Utils.Monad.State.Strict
import GHC.Types.Error
@@ -983,13 +984,10 @@ checkHomeUnitsClosed unit_env
-- that have not yet been found, using its state to keep track
-- of which units have already been considered as sources of
-- offending dependencies.
- collect []
- = pure []
- collect (current_unit_state : remaining_unit_states)
- = (++) <$> collect_for_home_unit
- (unitInfoMap current_unit_state)
- (map (toUnitId . fst) $ explicitUnits $ current_unit_state)
- <*> collect remaining_unit_states
+ collect = concatMapM $ \ unit_state ->
+ collect_for_home_unit
+ (unitInfoMap unit_state)
+ (map (toUnitId . fst) $ explicitUnits $ unit_state)
where
-- | Collects offending dependencies that are reachable from a particular
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/002c20528a7b1994927f8e13c074cc4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/002c20528a7b1994927f8e13c074cc4…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
Apoorv Ingle pushed to branch wip/ani/T27156 at Glasgow Haskell Compiler / GHC
Commits:
bb7d52fd by Apoorv Ingle at 2026-09-14T08:57:11-05:00
wibbles
- - - - -
1 changed file:
- compiler/GHC/Tc/Gen/Expr.hs
Changes:
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -595,7 +595,7 @@ tcExprNoExpand (HsProc x pat cmd) res_ty
-- and wrap (static e) in a call to
-- fromStaticPtr :: IsStatic p => StaticPtr a -> p a
-tcExprNoExpand (HsStatic _ expr) res_ty
+tcExprNoExpand (HsStatic free_names expr) res_ty
= do { res_ty <- expTypeToType res_ty
; (co, (p_ty, expr_ty)) <- matchExpectedAppTy res_ty
; (expr', lie) <- captureConstraints $
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb7d52fd6397872f27a99b8dd7414d2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb7d52fd6397872f27a99b8dd7414d2…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/apk/iface-encoding] .hi files: Various encoding improvements
by Andreas Klebinger (@AndreasK) 14 Sep '26
by Andreas Klebinger (@AndreasK) 14 Sep '26
14 Sep '26
Andreas Klebinger pushed to branch wip/apk/iface-encoding at Glasgow Haskell Compiler / GHC
Commits:
0df4842a by Andreas Klebinger at 2026-09-14T13:47:32+00:00
.hi files: Various encoding improvements
Binders: Encode non-linear binders more efficiently.
There is no need to serialize the Many type. We just use one bit to
encode that there is an implicit Many as multiplicity when writing to
disk.
Names: Use the low rather than high bit to encode the "compactness".
Since we encode name references as LEB128 using the high bit forces
5-byte references. By using the low bit we can actually compress the
small references when when storing name references using putName.
This allows use to LEB128 encode the combination of tag + value efficiently.
instance Binary Integer:
We used to use a tag byte to store if it fits in a Int64, and if not the
sign and then encode the actual value as LEB128.
Instead we now just encode as SLEB128. The only real downside is that we
have to discover during LEB decoding if we need to swap from Int to
Integer. This saves one byte for small values.
instance Binary iteral:
Don't encode it pointwise. Instead encode the Literal con tag + LitNumberType in a single tag
byte. Followed by the actual value if we deal with number literals.
This saves a byte per literal for small numbers.
`IfaceApp`: There is no real benefit to avoid collapsing chains of
applications. So we add a explicit constructor for n-ary applications.
We could do this just in the Binary instance. But in this case I felt
there is no real downside to express this in the type itself. So I
added:
IfaceApps IfaceExpr [IfaceExpr]
Of course we use a small trick. We use parts of the IFaceExpr tag space
to encode arity of the application. So we don't have to store the length
of the list in the common case.
Saves ~1 byte per argument. Exactly one for small applications. If we
serialize the list length slightly less.
`IfaceAlt`: Improve the encoding
We avoid storing the length for the always-empty lists on _DEFAULT and
literal alternatives by dispatching on the alt type.
`IfaceCase`: Add a special case for single default alts, encoded via
one of the tag bits from `IfaceExpr`.
- - - - -
13 changed files:
- + changelog.d/T27808-iface-encoding-improvements
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Rename.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Utils/Binary.hs
- + testsuite/tests/utils/should_run/Binary_Literal.hs
- + testsuite/tests/utils/should_run/Binary_Literal.stdout
- testsuite/tests/utils/should_run/all.T
Changes:
=====================================
changelog.d/T27808-iface-encoding-improvements
=====================================
@@ -0,0 +1,8 @@
+section: compiler
+synopsis: Improved ``.hi`` file encoding resulting in less space used on disk.
+issues: #27808
+mrs: !16683
+description: {
+ This was mostly done by moving from simple pointwise encoding to adding
+ special cases for common cases.
+}
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -651,16 +651,19 @@ toIfaceApp (Var v) as
toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
-mkIfaceApps f as = foldl' (\f a -> IfaceApp f (toIfaceExpr a)) f as
+-- `mkIfaceApp` is just a smart constructor for the IfaceApp[s] constructors.
+-- See Note [Iface applications] in GHC.Iface.Syntax
+mkIfaceApps f as = mkIfaceApp f (map toIfaceExpr as)
---------------------
toIfaceVar :: Id -> IfaceExpr
toIfaceVar v
| isBootUnfolding (idUnfolding v)
= -- See Note [Inlining and hs-boot files]
- IfaceApp (IfaceApp (IfaceExt noinline_id)
- (IfaceType (toIfaceType ty)))
- (IfaceExt name) -- don't use mkIfaceApps, or infinite loop
+ IfaceApps (IfaceExt noinline_id)
+ [IfaceType (toIfaceType ty), IfaceExt name]
+ -- don't use mkIfaceApps, or infinite loop since it ends up calling
+ -- toIfaceVar indirectly again.
| Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
-- Foreign calls have special syntax
=====================================
compiler/GHC/Iface/Binary.hs
=====================================
@@ -741,25 +741,38 @@ In more detail:
Tuples aren't included in the wired-in names map: see (ST1) below
* Serialisation is done by `putName`:
- - When we serialise a compact Name,
- we serialise it as a single 32-bit word:
- 10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy
- where xxxx is the tag, and yyyy is the payload.
- The function `wiredInNamesOkay` checks that the wired-in names all have
- uniques that fit into the `yyy` field.
+ - When we serialise a compact Name, we serialise its Unique, split by
+ `unpkUniqueGrimily` into the tag character and the payload:
+
+ yyyyyyyy yyyyyyyy yyyyyyyx xxxxxxx1
+ \________ payload _______/\_ tag _/^ marker bit
+
+ Why are we storing the marker/tag in the low rather than high bits? Because
+ we LEB128 encode the whole word when writing to disk so we want to keep as
+ many of the high bits zero as possible to allow for shorter encodings. See
+ also wrinkle ST3.
+
+ Tags are 8 bits by construction, and there is a check that the actual unique
+ part fits in 22 bits which `wiredInNamesOkay` (in GHC.Builtin) checks for all
+ known-key names.
- When we serialise a non-compact name:
- We look it up in the (stateful, growing) symbol table
- - If it not there we add it to the symbol table
- - We serialise the occurrenc to a single 32-bit word:
- 00xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
- where `xxxxx` is an index into the symbol table.
+ - If it is not there we add it to the symbol table
+ - We serialise the occurrence as
-* Deserialision is done by `getName`. We read a 32-bit word
- - If the MSB is `10` it must be a compact name, so we use
+ 0xxxxxxx xxxxxxxx xxxxxxxx xxxxxxx0
+
+ In other words we simply shift the index by a bit.
+ The high bit is currently unused. But `putSymtabNameRef`
+ asserts that `ix` fits in 30 bits.
+
+* Deserialisation is done by `getSymtabName`, which dispatches on the low bit
+ of the word it reads:
+ - If it is 1 it must be a compact name, so we reassemble the Unique and use
`lookupCompactName` to get from the Unique to the Name.
- - If the MSB is `00` it must be a non-compact Name,
- so we look it up in the symbol table.
+ - If it is 0 it must be a non-compact Name, so we look it up in the
+ symbol table.
Wrinkles:
@@ -785,6 +798,20 @@ Wrinkles:
`isCompactName` that tests for `knownUniqueTupleName` and then the
TyConRepNames would be serialised as non-compact names, and everything would
work. Fewer tests, but Typeable-heavy code might have bigger interface files.
+
+(ST3) Both kinds of Name are serialised as a single `Word32`, which is serialized to
+ disk in it's ULEB128 encoded variable-length form (see `putULEB128`).
+ This has consequences as it means we want to keep the high bits zero where possible
+ to allow for a shorter ULEB128 encoding.
+
+ This is why we put both the tag and the market but at the LSB end of the word. They
+ are always present. But by putting them at the low end we ensure LEB128 encoding
+ still works as expected, producing smaller encodings for compact names with small
+ uniques.
+
+ The downside is that we steal one bit from non-compact names for which the marker
+ bit and tag would have been zero either way. But in practice this matters far less
+ than ensuring built in (compact) names encode well.
-}
isCompactName :: Name -> Bool
@@ -803,6 +830,31 @@ lookupCompactName u
where
(tag, ix) = unpkUniqueGrimily u
+-- | Write a reference to a symbol table index.
+-- See Note [Symbol table representation of names]
+putSymtabNameRef :: WriteBinHandle -> Int -> IO ()
+{-# INLINE putSymtabNameRef #-}
+putSymtabNameRef bh ix
+ = assertPpr (ix >= 0 && ix < (1 `shiftL` 30))
+ (text "putSymtabNameRef: symbol table index out of range:" <+> int ix) $
+ -- Bit 0 == False marks a symbol table reference
+ put_ bh ((fromIntegral ix `shiftL` 1) :: Word32)
+
+-- | Write a reference to a compact (known-key) 'Name'.
+-- See Note [Symbol table representation of names]
+putCompactNameRef :: WriteBinHandle -> Unique -> IO ()
+{-# INLINE putCompactNameRef #-}
+putCompactNameRef bh uniq
+ = -- INVARIANTS:
+ -- * 8 bits tag (true by construction)
+ -- * the payload fits in 22 bits (checked for all known keys elsewhere)
+ -- Bit 0 == True marks a compact (known-key) name
+ put_ bh ( (fromIntegral payload `shiftL` 9)
+ .|. (fromIntegral (ord tag) `shiftL` 1)
+ .|. 1 :: Word32)
+ where
+ (tag, payload) = unpkUniqueGrimily uniq
+
-- See Note [Symbol table representation of names]
putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO ()
putName BinSymbolTable{
@@ -810,16 +862,12 @@ putName BinSymbolTable{
bin_symtab_next = symtab_next }
bh name
| isCompactName name
- , let (c, u) = unpkUniqueGrimily (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
- = -- assert (u < 2^(22 :: Int))
- put_ bh (0x80000000
- .|. (fromIntegral (ord c) `shiftL` 22)
- .|. (fromIntegral u :: Word32))
+ = putCompactNameRef bh (nameUnique name)
| otherwise
= do (symtab_map,symtab_tbl) <- readIORef symtab_map_ref
case lookupNameEnv symtab_map name of
- Just off -> put_ bh (fromIntegral off :: Word32)
+ Just off -> putSymtabNameRef bh off
Nothing -> do
off <- freshIndex
let mod = nameModule name
@@ -829,12 +877,11 @@ putName BinSymbolTable{
let !symtab_tbl' = extendModuleEnv symtab_tbl mod ((off,name):mod_nms)
writeIORef symtab_map_ref $! ( symtab_map', symtab_tbl' )
- put_ bh (fromIntegral off :: Word32)
+ putSymtabNameRef bh off
where
freshIndex :: IO Int
freshIndex = do
off <- readFastMutInt symtab_next
- -- massert (off < 2^(30 :: Int))
writeFastMutInt symtab_next (off+1)
return off
@@ -843,12 +890,10 @@ getSymtabName :: SymbolTable Name
-> ReadBinHandle -> IO Name
getSymtabName symtab bh = do
i :: Word32 <- get bh
- case i .&. 0xC0000000 of
- 0x00000000 -> return $! symtab ! fromIntegral i
- 0x80000000 -> return $! lookupCompactName u
- where
- tag = chr (fromIntegral ((i .&. 0x3FC00000) `shiftR` 22))
- ix = fromIntegral i .&. 0x003FFFFF
- u = mkUniqueGrimilyWithTag tag ix
-
- _ -> pprPanic "getSymtabName:unknown name tag" (ppr i)
+ if i .&. 1 == 0
+ then -- Symbol table reference, written by putSymtabNameRef
+ return $! symtab ! fromIntegral (i `shiftR` 1)
+ else -- Compact name, written by putCompactNameRef
+ let tag = chr (fromIntegral ((i `shiftR` 1) .&. 0xFF))
+ payload = fromIntegral (i `shiftR` 9) :: Word64
+ in return $! lookupCompactName (mkUniqueGrimilyWithTag tag payload)
=====================================
compiler/GHC/Iface/Rename.hs
=====================================
@@ -828,6 +828,8 @@ rnIfaceExpr (IfaceLam lam_bndr expr)
= IfaceLam <$> rnIfaceLamBndr lam_bndr <*> rnIfaceExpr expr
rnIfaceExpr (IfaceApp fun arg)
= IfaceApp <$> rnIfaceExpr fun <*> rnIfaceExpr arg
+rnIfaceExpr (IfaceApps fun args)
+ = IfaceApps <$> rnIfaceExpr fun <*> rnIfaceExprs args
rnIfaceExpr (IfaceCase scrut case_bndr alts)
= IfaceCase <$> rnIfaceExpr scrut
<*> pure case_bndr
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -10,7 +10,8 @@ module GHC.Iface.Syntax (
IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..),
IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
- IfaceExpr(..), IfaceAlt(..), IfaceLetBndr(..), IfaceBinding,
+ IfaceExpr(..), mkIfaceApp,
+ IfaceAlt(..), IfaceLetBndr(..), IfaceBinding,
IfaceBindingX(..), IfaceMaybeRhs(..), IfaceConAlt(..),
IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..),
IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
@@ -96,8 +97,8 @@ import GHC.Utils.Fingerprint
import GHC.Utils.Binary
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
-import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith,
- zipWithEqual )
+import GHC.Utils.Misc( dropList, filterByList, lengthAtLeast, notNull,
+ unzipWith, zipWithEqual )
import GHC.Data.FastString
import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue)
@@ -700,6 +701,11 @@ data IfaceExpr
| IfaceTuple TupleSort [IfaceExpr] -- Saturated; type arguments omitted
| IfaceLam IfaceLamBndr IfaceExpr
| IfaceApp IfaceExpr IfaceExpr
+ -- ^ Application to exactly one argument.
+ -- See Note [Iface applications]
+ | IfaceApps IfaceExpr [IfaceExpr]
+ -- ^ Application to two or more arguments.
+ -- See Note [Iface applications]
| IfaceCase IfaceExpr IfLclName [IfaceAlt]
| IfaceECase IfaceExpr IfaceType -- See Note [Empty case alternatives]
| IfaceLet (IfaceBinding IfaceLetBndr) IfaceExpr
@@ -710,6 +716,18 @@ data IfaceExpr
| IfaceFCall ForeignCall IfaceType
| IfaceTick IfaceTickish IfaceExpr -- from Tick tickish E
+-- | Apply an expression to a (possibly empty) list of arguments, maintaining
+-- the invariants of 'IfaceApp' and 'IfaceApps'.
+-- See Note [Iface applications].
+mkIfaceApp :: IfaceExpr -> [IfaceExpr] -> IfaceExpr
+mkIfaceApp fun args = go fun args
+ where
+ go (IfaceApp f a) as = go f (a : as)
+ go (IfaceApps f fs) as = go f (fs ++ as)
+
+ go f [] = f
+ go f [a] = IfaceApp f a
+ go f as = IfaceApps f as
data IfaceTickish
= IfaceHpcTick Module Int -- from HpcTick x
@@ -745,6 +763,30 @@ data IfaceTopBndrInfo = IfLclTopBndr IfLclName IfaceType IfaceIdInfo IfaceIdDeta
data IfaceMaybeRhs = IfUseUnfoldingRhs | IfRhs IfaceExpr
{-
+Note [Iface applications]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+A Core application chain (f a1 a2 ... an) could be represented by a chain of
+n nested IfaceApp nodes like Core does. However this is generally a worse
+representation for *serialization* which is the main purpose of the Iface type.
+
+So we keep the single argument constructor as it's fairly common, and add one
+to represent multiple arguments:
+
+ * IfaceApp f a -- exactly one argument
+ * IfaceApps f [a1,..] -- two or more arguments
+
+with two invariants:
+
+ (1) The argument list of an IfaceApps has at least two elements.
+ (A one-argument application is an IfaceApp, and a zero-argument
+ "application" is just the head itself.)
+
+ (2) The head of an IfaceApp or IfaceApps is never itself an IfaceApp or
+ IfaceApps: application chains are fully flattened.
+
+The smart constructor 'mkIfaceApp' establishes both invariants; producers
+should use it rather than building IfaceApps directly.
+
Note [Empty case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In Iface syntax an IfaceCase does not record the types of the alternatives,
@@ -1797,7 +1839,8 @@ pprIfaceExpr _ (IfaceLitRubbish tc r)
<> (case tc of { TypeLike -> empty; ConstraintLike -> text "[c]" })
<> parens (ppr r)
-pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
+pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
+pprIfaceExpr add_par app@(IfaceApps _ _) = add_par (pprIfaceApp app [])
pprIfaceExpr add_par i@(IfaceLam _ _)
= add_par (sep [char '\\' <+> sep (map pprIfaceLamBndr bndrs) <+> arrow,
@@ -1869,9 +1912,13 @@ pprIfaceTickish (IfaceBreakpoint (BreakpointId m ix) fvs)
------------------
pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
-pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $
+-- NB: IfaceApps must print exactly like the equivalent IfaceApp chain, so
+-- that --show-iface output does not depend on which one the producer emitted.
+pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $
nest 2 (pprParendIfaceExpr arg) : args
-pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
+pprIfaceApp (IfaceApps fun as) args = pprIfaceApp fun $
+ map (nest 2 . pprParendIfaceExpr) as ++ args
+pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args)
------------------
instance Outputable IfaceConAlt where
@@ -2170,6 +2217,7 @@ freeNamesIfExpr (IfaceCo co) = freeNamesIfCoercion co
freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
freeNamesIfExpr (IfaceLam (b,_) body) = freeNamesIfBndr b &&& freeNamesIfExpr body
freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
+freeNamesIfExpr (IfaceApps f as) = freeNamesIfExpr f &&& fnList freeNamesIfExpr as
freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfCoercion co
freeNamesIfExpr (IfaceTick t e) = freeNamesIfTickish t &&& freeNamesIfExpr e
freeNamesIfExpr (IfaceECase e ty) = freeNamesIfExpr e &&& freeNamesIfType ty
@@ -2830,17 +2878,46 @@ infixl 9 .<<|.
x .<<|. b = (if b then (`setBit` 0) else id) (x `shiftL` 1)
{-# INLINE (.<<|.) #-}
+-- Encoding shortcuts:
+-- Since only IfaceDataAlt can have binders
+-- we can skip the binder list for DEFAULT and Literal alternatives.
instance Binary IfaceAlt where
put_ bh (IfaceAlt a b c) = do
put_ bh a
- put_ bh b
+ case a of
+ IfaceDataAlt {} -> put_ bh b
+ _ -> assertPpr (null b) (ppr a $$ ppr b) $ return ()
put_ bh c
get bh = do
a <- get bh
- b <- get bh
+ b <- case a of
+ IfaceDataAlt {} -> get bh
+ _ -> return []
c <- get bh
return (IfaceAlt a b c)
+{- Note [IfaceExpr encoding shortcuts]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We use a full byte to encode the constructor tag for `IfaceExpr`.
+This leaves room to encode additional information. Concretely we
+use:
+
+0 .. 14: "Simple" constructor tags.
+15 .. 22: "IfaceApps", encoding the constructor *and* arity.
+ 23: "IfaceCase" for a case with a single default alternative.
+
+Note [Binary encoding of IfaceApps]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For IfaceApps we use the following scheme:
+
+ * arity 2..8: one byte encoding the arity as (15 + (n-2))
+ Which is followed by the head expression and then exactly `arity` arguments.
+
+ * arity > 8: tag 22, and we serialize the argument count as a ULEB128, followed by the
+ head expression and arguments.
+
+This saves us one byte per application with `2 <= arity <= 8`.
+-}
instance Binary IfaceExpr where
put_ bh (IfaceLcl aa) = do
putByte bh 0
@@ -2864,6 +2941,12 @@ instance Binary IfaceExpr where
putByte bh 5
put_ bh ag
put_ bh ah
+ -- See Note [IfaceExpr encoding shortcuts]
+ put_ bh (IfaceCase ai aj [IfaceAlt IfaceDefaultAlt [] ak]) = do
+ putByte bh 23
+ put_ bh ai
+ put_ bh aj
+ put_ bh ak
put_ bh (IfaceCase ai aj ak) = do
putByte bh 6
put_ bh ai
@@ -2899,6 +2982,17 @@ instance Binary IfaceExpr where
putByte bh 14
put_ bh r
put_ bh torc
+ -- See Note [Iface applications] and Note [Binary encoding of IfaceApps]
+ -- and Note [IfaceExpr encoding shortcuts]
+ put_ bh (IfaceApps fun args) = do
+ let !n = length args
+ massertPpr (n >= 2) (text "put_ IfaceApps" <+> ppr n)
+ if n <= maxIfaceAppsTagArity
+ then putByte bh (fromIntegral (ifaceAppsTag0 + n - 2))
+ else do putByte bh (fromIntegral ifaceAppsBigTag)
+ put_ bh n
+ put_ bh fun
+ mapM_ (put_ bh) args
get bh = do
h <- getByte bh
case h of
@@ -2944,7 +3038,41 @@ instance Binary IfaceExpr where
14 -> do r <- get bh
torc <- get bh
return (IfaceLitRubbish torc r)
+ -- Tags 15..21 encode an IfaceApps of arity 2..8 in the tag itself;
+ -- tag 22 is followed by an explicit (LEB128) argument count.
+ -- See Note [Binary encoding of IfaceApps]
+ 15 -> getApps 2
+ 16 -> getApps 3
+ 17 -> getApps 4
+ 18 -> getApps 5
+ 19 -> getApps 6
+ 20 -> getApps 7
+ 21 -> getApps 8
+ 22 -> do n <- get bh
+ getApps n
+ -- case scrut of bndr { DEFAULT -> rhs}
+ 23 -> do ai <- get bh
+ aj <- get bh
+ ak <- get bh
+ return (IfaceCase ai aj [IfaceAlt IfaceDefaultAlt [] ak])
_ -> panic ("get IfaceExpr " ++ show h)
+ where
+ getApps :: Int -> IO IfaceExpr
+ getApps n = do fun <- get bh
+ args <- replicateM n (get bh)
+ return (IfaceApps fun args)
+-- | Tag used for an 'IfaceApps' with exactly two arguments and start
+-- of the ifaceApps tag range.
+ifaceAppsTag0 :: Int
+ifaceAppsTag0 = 15
+
+-- | Highest arity encoded directly in tag byte.
+maxIfaceAppsTagArity :: Int
+maxIfaceAppsTagArity = 8
+
+-- | Tag for an 'IfaceApps' whose arity is serialized as ULEB128.
+ifaceAppsBigTag :: Int
+ifaceAppsBigTag = 22
instance Binary IfaceTickish where
put_ bh (IfaceHpcTick m ix) = do
@@ -3211,6 +3339,7 @@ instance NFData IfaceExpr where
IfaceTuple sort exprs -> rnf sort `seq` rnf exprs
IfaceLam bndr expr -> rnf bndr `seq` rnf expr
IfaceApp e1 e2 -> rnf e1 `seq` rnf e2
+ IfaceApps e es -> rnf e `seq` rnf es
IfaceCase e nm alts -> rnf e `seq` rnf nm `seq` rnf alts
IfaceECase e ty -> rnf e `seq` rnf ty
IfaceLet bind e -> rnf bind `seq` rnf e
=====================================
compiler/GHC/Iface/Type.hs
=====================================
@@ -1073,7 +1073,18 @@ pprIfaceTyConBinders suppress_sig = sep . map go
where
ppr_bndr = pprIfaceTvBndr bndr suppress_sig
+-- | IfaceBndr shortcuts:
+--
+-- In the vast majority of cases binder multiplicity is `Many` so storing it is
+-- a pure waste of space. Instead of storing (Many, Name, Ty) we simply store
+-- (Name,Ty) in the common case where multiplicity == Many.
instance Binary IfaceBndr where
+ put_ bh (IfaceIdBndr (mult, name, ty))
+ -- The implicit Many shortcut.
+ | mult == many_ty = do
+ putByte bh 2
+ put_ bh name
+ put_ bh ty
put_ bh (IfaceIdBndr aa) = do
putByte bh 0
put_ bh aa
@@ -1085,8 +1096,11 @@ instance Binary IfaceBndr where
case h of
0 -> do aa <- get bh
return (IfaceIdBndr aa)
- _ -> do ab <- get bh
+ 1 -> do ab <- get bh
return (IfaceTvBndr ab)
+ _ -> do name <- get bh
+ ty <- get bh
+ return (IfaceIdBndr (many_ty, name, ty))
instance Binary IfaceOneShot where
put_ bh IfaceNoOneShot =
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -1446,6 +1446,7 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
ifTopFreeName (IfaceType (IfaceTupleTy s _ ts)) = Just (tupleTyConName s (length (appArgsIfaceTypes ts)))
ifTopFreeName (IfaceApp f _) = ifTopFreeName f
+ ifTopFreeName (IfaceApps f _) = ifTopFreeName f
ifTopFreeName (IfaceExt n) = Just n
ifTopFreeName _ = Nothing
@@ -1682,6 +1683,9 @@ tcIfaceExpr (IfaceLam (bndr, os) body)
tcIfaceExpr (IfaceApp fun arg)
= App <$> tcIfaceExpr fun <*> tcIfaceExpr arg
+tcIfaceExpr (IfaceApps fun args)
+ = mkApps <$> tcIfaceExpr fun <*> mapM tcIfaceExpr args
+
tcIfaceExpr (IfaceECase scrut ty)
= do { scrut' <- tcIfaceExpr scrut
; ty' <- tcIfaceType ty
=====================================
compiler/GHC/Types/Literal.hs
=====================================
@@ -167,7 +167,7 @@ data LitNumType
| LitNumWord16 -- ^ @Word16#@ - exactly 16 bits
| LitNumWord32 -- ^ @Word32#@ - exactly 32 bits
| LitNumWord64 -- ^ @Word64#@ - exactly 64 bits
- deriving (Data,Enum,Eq,Ord)
+ deriving (Data,Enum,Eq,Ord,Bounded)
-- | Indicate if a numeric literal type supports negative numbers
litNumIsSigned :: LitNumType -> Bool
@@ -259,6 +259,38 @@ for more details.
-}
+{-
+Note [Binary Literal encoding]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Rather then write `LitNumType` into it's own tag byte we encode it in the
+surplace space of the `Literal` tag space.
+
+This means for `Literal` tage 0 .. 5 are the non-num literals.
+Literals 6 .. (maxBound LitNumType) encode the LitNumType.
+
+We could use the `LitNumType` information to slightly improve the encoding of
+the actual values too. But we just write/read them at Integer for simplicity for
+now.
+-}
+
+-- | The 'Binary' tag byte of @'LitNumber' nt _@.
+--
+-- These continue the tags of the non-numeric 'Literal' constructors. The
+-- mapping is total and part of the interface file format.
+-- See Note [Binary Literal encoding].
+litNumTypeTag :: LitNumType -> Word8
+litNumTypeTag nt =
+ -- 6 .. 16
+ 6 + (fromIntegral $ fromEnum nt)
+
+-- | The inverse of 'litNumTypeTag'. 'Nothing' for a tag which isn't the tag
+-- of a numeric literal. See Note [Binary Literal encoding].
+litNumTypeOfTag :: Word8 -> Maybe LitNumType
+litNumTypeOfTag tag
+ | tag >= 6 && tag <= 16
+ = Just (toEnum $ (fromIntegral tag) - 6)
+ | otherwise = Nothing
+
instance Binary Literal where
put_ bh (LitChar aa) = do putByte bh 0; put_ bh aa
put_ bh (LitString ab) = do putByte bh 1; put_ bh ab
@@ -269,9 +301,10 @@ instance Binary Literal where
= do putByte bh 5
put_ bh aj
put_ bh fod
+ -- The LitNumType is part of the tag byte.
+ -- See Note [Binary Literal encoding]
put_ bh (LitNumber nt i)
- = do putByte bh 6
- put_ bh nt
+ = do putByte bh (litNumTypeTag nt)
put_ bh i
put_ _ lit@(LitRubbish {}) = pprPanic "Binary LitRubbish" (ppr lit)
-- We use IfaceLitRubbish; see Note [Rubbish literals], item (6)
@@ -296,11 +329,11 @@ instance Binary Literal where
aj <- get bh
fod <- get bh
return (LitLabel aj fod)
- 6 -> do
- nt <- get bh
- i <- get bh
- return (LitNumber nt i)
- _ -> pprPanic "Binary:Literal" (int (fromIntegral h))
+ _ | Just nt <- litNumTypeOfTag h
+ -> do i <- get bh
+ return (LitNumber nt i)
+ | otherwise
+ -> pprPanic "Binary:Literal" (int (fromIntegral h))
instance NFData Literal where
rnf (LitChar c) = rnf c
=====================================
compiler/GHC/Types/Unique.hs
=====================================
@@ -393,7 +393,7 @@ unpkUnique u = case unpkUniqueGrimily u of
isValidKnownKeyUnique :: Unique -> Bool
isValidKnownKeyUnique u =
case unpkUniqueGrimily u of
- (c, x) -> ord c < 0xff && x <= (1 `shiftL` 22)
+ (c, x) -> ord c < 0xff && x < (1 `shiftL` 22)
{-
************************************************************************
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -148,7 +148,7 @@ import GHCi.FFI
import GHCi.Message
import Control.DeepSeq
-import Control.Monad ( when, (<$!>), unless, forM_, void )
+import Control.Monad ( when, unless, forM_, void )
import Foreign hiding (bit, setBit, clearBit, shiftL, shiftR, void)
import Data.Array
import Data.Array.Base (unsafeFreezeIOArray)
@@ -173,7 +173,6 @@ import Data.Proxy
import Data.Set ( Set )
import qualified Data.Set as Set
import Data.Time hiding ( Nominal )
-import Data.List (unfoldr)
import System.IO as IO
import System.IO.Error ( mkIOError, eofErrorType )
import Type.Reflection ( Typeable, SomeTypeRep(..) )
@@ -188,6 +187,7 @@ import GHC.ForeignPtr ( unsafeWithForeignPtr )
import GHC.Exts
import GHC.IO
import GHC.Word
+import GHC.Num (Integer(IS))
import Unsafe.Coerce (unsafeCoerce)
import GHC.Serialized
@@ -805,6 +805,7 @@ getULEB128 bh =
{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int64 -> IO () #-}
{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int32 -> IO () #-}
{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Int16 -> IO () #-}
+{-# SPECIALISE putSLEB128 :: WriteBinHandle -> Integer -> IO () #-}
putSLEB128 :: forall a. (Integral a, Bits a) => WriteBinHandle -> a -> IO ()
putSLEB128 bh initial = go initial
where
@@ -1123,86 +1124,91 @@ instance Binary IsBootInterface where
False -> NotBoot
{-
-Finally - a reasonable portable Integer instance.
+Note [Integer serialisation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We simply encode Integer as SLEB128 unconditionally.
-We used to encode values in the Int32 range as such,
-falling back to a string of all things. In either case
-we stored a tag byte to discriminate between the two cases.
+This is a tradeoff:
+It allows shorter encodings for the common case of small values. And we don't need
+to prefix the string with a byte carrying any information about size or sign.
-This made some sense as it's highly portable but also not very
-efficient.
+However it means large Integer values will pay some overhead. Their encoding can
+go from 9 (1 prefix, 8 value) to 10 bytes. Such values will also end up encoding
+into a `Integer` accumulator rather than a simple Word64#.
-However GHC stores a surprisingly large number of large Integer
-values. In the examples looked at between 25% and 50% of Integers
-serialized were outside of the Int32 range.
+In practice interface files have enough small values to make this tradeoff worthwhile.
+We could also restore this benefit by using one or two *bits* rather than a full
+byte for the prefix. I imagine this would be worthwhile in runtime, but I've not
+gone as for for the sake of avoiding complexity.
-Consider a value like `2724268014499746065`, some sort of hash
-actually generated by GHC.
-In the old scheme this was encoded as a list of 19 chars. This
-gave a size of 77 Bytes, one for the length of the list and 76
-since we encode chars as Word32 as well.
-We can easily do better. The new plan is:
-
-* Start with a tag byte
- * 0 => Int64 (LEB128 encoded)
- * 1 => Negative large integer
- * 2 => Positive large integer
-* Followed by the value:
- * Int64 is encoded as usual
- * Large integers are encoded as a list of bytes (Word8).
- We use Data.Bits which defines a bit order independent of the representation.
- Values are stored LSB first.
-
-This means our example value `2724268014499746065` is now only 10 bytes large.
-* One byte tag
-* One byte for the length of the [Word8] list.
-* 8 bytes for the actual date.
-
-The new scheme also does not depend in any way on
-architecture specific details.
-
-We still use this scheme even with LEB128 available,
-as it has less overhead for truly large numbers. (> maxBound :: Int64)
-
-The instance is used for in Binary Integer and Binary Rational in GHC.Types.Literal
-}
instance Binary Integer where
- put_ bh i
- | i >= lo64 && i <= hi64 = do
- putWord8 bh 0
- put_ bh (fromIntegral i :: Int64)
- | otherwise = do
- if i < 0
- then putWord8 bh 1
- else putWord8 bh 2
- put_ bh (unroll $ abs i)
+ -- See Note [Integer serialisation]
+ put_ bh (IS i)
+ = putSLEB128 bh (I# i)
+ put_ bh large_i
+ = putSLEB128 bh large_i
where
- lo64 = fromIntegral (minBound :: Int64)
- hi64 = fromIntegral (maxBound :: Int64)
- get bh = do
- int_kind <- getWord8 bh
- case int_kind of
- 0 -> fromIntegral <$!> (get bh :: IO Int64)
- -- Large integer
- 1 -> negate <$!> getInt
- 2 -> getInt
- _ -> panic "Binary Integer - Invalid byte"
- where
- getInt :: IO Integer
- getInt = roll <$!> (get bh :: IO [Word8])
-
-unroll :: Integer -> [Word8]
-unroll = unfoldr step
- where
- step 0 = Nothing
- step i = Just (fromIntegral i, i `shiftR` 8)
+ get bh = getSLEB128Integer bh
-roll :: [Word8] -> Integer
-roll = foldl' unstep 0 . reverse
+-- | Read an SLEB128 encoded 'Integer'.
+--
+-- Unlike 'getSLEB128' this doesn't require a 'FiniteBits' instance, which
+-- 'Integer' lacks. See Note [Integer serialisation].
+getSLEB128Integer :: ReadBinHandle -> IO Integer
+getSLEB128Integer bh = go_word 0 0
where
- unstep a b = a `shiftL` 8 .|. fromIntegral b
+ -- Accumulate in a Word64 for as long as possible
+ go_word :: Int -> Word64 -> IO Integer
+ go_word !shift !acc = do
+ byte <- getByte bh
+ let !byteVal = clearBit byte 7
+ let more = testBit byte 7
+ let !shift' = shift + 7 -- bits read *after* this step
+ -- Check if the payload still fits in the accumulator,
+ -- if not swap to a Integer accumulator.
+ if shift' <= 64
+ then do
+ let !acc' = acc .|. (fromIntegral byteVal `unsafeShiftL` shift)
+ if more
+ then go_word shift' acc'
+ else return $! signExtendWord shift' acc' (testBit byte 6)
+ else do
+ -- They don't, so from here on out we use Integer arithmetic.
+ let !acc' = toInteger acc .|. (toInteger byteVal `shiftL` shift)
+ if more
+ then go_big shift' acc'
+ else return $! signExtendInteger shift' acc' (testBit byte 6)
+
+ go_big :: Int -> Integer -> IO Integer
+ go_big !shift !acc = do
+ byte <- getByte bh
+ let !acc' = acc .|. (toInteger (clearBit byte 7) `shiftL` shift)
+ let !more = testBit byte 7
+ let !shift' = shift + 7
+ if more
+ then go_big shift' acc'
+ else return $! signExtendInteger shift' acc' (testBit byte 6)
+
+ -- Sign extend a value of which we read `shift` bits into a Word64.
+ -- `shift` is always <= 64 here, so the result always fits into an Int64.
+ signExtendWord :: Int -> Word64 -> Bool -> Integer
+ signExtendWord !shift !acc signed
+ | not signed
+ = toInteger acc
+ | shift < 64
+ -- set high bits not encoded in the payload
+ = toInteger (fromIntegral (acc .|. (complement 0 `unsafeShiftL` shift)) :: Int64)
+ | otherwise
+ = toInteger (fromIntegral acc :: Int64)
+
+ -- Sign extend into an Integer.
+ signExtendInteger :: Int -> Integer -> Bool -> Integer
+ signExtendInteger !shift !acc signed
+ | signed = acc - (1 `shiftL` shift)
+ | otherwise = acc
{-
=====================================
testsuite/tests/utils/should_run/Binary_Literal.hs
=====================================
@@ -0,0 +1,279 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- Property tests for the 'Binary' instance of 'Literal' in GHC.Types.Literal.
+--
+-- We check that
+-- * arbitrary literals round trip through 'put_' and 'get',
+-- * a whole batch of literals written into one buffer reads back in order,
+-- that is the reader consumes exactly the bytes the writer produced,
+-- * and, since numeric literals carry an 'Integer', that the SLEB128 based
+-- 'Binary Integer' instance agrees with a reference implementation.
+module Main (main) where
+
+import GHC.Data.FastString
+import GHC.Platform ( genericPlatform )
+import GHC.Types.Basic ( FunctionOrData(..) )
+import GHC.Types.Literal
+import GHC.Types.Literal.Floating
+import GHC.Utils.Binary
+
+import Control.Monad ( replicateM )
+import Data.Bits
+import qualified Data.ByteString as BS
+import Data.Ratio ( (%) )
+import Data.Word
+import GHC.Float ( castFloatToWord32, castWord32ToFloat
+ , castDoubleToWord64, castWord64ToDouble )
+import Numeric ( showHex )
+import System.IO.Unsafe ( unsafePerformIO )
+
+import MiniQuickCheck
+
+--------------------------------------------------------------------------------
+-- Encoding and decoding
+
+-- | 'LitLabel' contains a 'FastString', which the 'Binary' instance writes
+-- through a table in the handle's user data. Interface files fill this in with
+-- a deduplication table. We only need something that round trips, so we write
+-- the bytes of the string inline.
+withFastStringWriter :: WriteBinHandle -> WriteBinHandle
+withFastStringWriter = addWriterToUserData (BinaryWriter (\bh fs -> put_ bh (bytesFS fs)))
+
+withFastStringReader :: ReadBinHandle -> ReadBinHandle
+withFastStringReader = addReaderToUserData (BinaryReader (\bh -> mkFastStringByteString <$> get bh))
+
+-- | Serialise the values and also return the position after the last of them.
+encodeAll :: Binary a => [a] -> (BS.ByteString, Bin ())
+encodeAll xs = unsafePerformIO $ do
+ bh <- withFastStringWriter <$> openBinMem 1024
+ mapM_ (put_ bh) xs
+ end <- tellBinWriter bh
+ bs <- withBinBuffer bh (return . BS.copy)
+ return (bs, end)
+
+encode :: Binary a => a -> BS.ByteString
+encode x = fst (encodeAll [x])
+
+-- | Read back @n@ values and check that doing so consumed exactly the bytes
+-- the writer produced, no more and no less.
+decodeAll :: Binary a => Int -> (BS.ByteString, Bin ()) -> [a]
+decodeAll n (bs, end) = unsafePerformIO $ do
+ bh <- withFastStringReader <$> unsafeUnpackBinBuffer bs
+ xs <- replicateM n (get bh)
+ end' <- tellBinReader bh
+ if end' == end
+ then return xs
+ else fail $ "reader stopped at " ++ show end' ++ ", writer at " ++ show end
+
+roundTrip :: Binary a => [a] -> [a]
+roundTrip xs = decodeAll (length xs) (encodeAll xs)
+
+roundTrip1 :: Binary a => a -> a
+roundTrip1 x = case roundTrip [x] of
+ [x'] -> x'
+ _ -> error "roundTrip1"
+
+--------------------------------------------------------------------------------
+-- Literals with structural equality and a Show instance
+
+-- | 'Literal' has neither a 'Show' instance nor an 'Eq' instance which compares
+-- all fields: 'LitLabel' ignores the 'FunctionOrData' and 'LitFloating'
+-- identifies the different representations of the same value. For a
+-- serialisation test we want the stricter notion.
+newtype Lit = Lit Literal
+
+instance Show Lit where
+ show (Lit l) = showLit l
+
+instance Eq Lit where
+ Lit a == Lit b = eqLit a b
+
+eqLit :: Literal -> Literal -> Bool
+eqLit (LitLabel fs1 fod1) (LitLabel fs2 fod2)
+ = fs1 == fs2 && fod1 == fod2
+eqLit (LitFloating ty1 v1) (LitFloating ty2 v2)
+ -- 'Eq LitFloating' compares NaNs bitwise but identifies different
+ -- representations of the same value; the derived 'Show' distinguishes the
+ -- representations but not NaN payloads. Together they compare structurally.
+ = ty1 == ty2 && v1 == v2 && show v1 == show v2
+eqLit a b = a == b
+
+showLit :: Literal -> String
+showLit lit = case lit of
+ LitChar c -> "LitChar " ++ show c
+ LitNumber nt i -> "LitNumber " ++ showLitNumType nt ++ " " ++ show i
+ LitString bs -> "LitString " ++ show bs
+ LitNullAddr -> "LitNullAddr"
+ LitRubbish {} -> "LitRubbish"
+ LitFloating ty v -> "LitFloating " ++ show ty ++ " (" ++ show v ++ ") " ++ bits ty v
+ LitLabel fs fod -> "LitLabel " ++ show (bytesFS fs) ++ " " ++ showFod fod
+ where
+ -- The bit pattern is needed to tell apart NaNs.
+ bits LitFloat v = "0x" ++ showHex (castFloatToWord32 (litFloatingToHostFloat v)) ""
+ bits LitDouble v = "0x" ++ showHex (castDoubleToWord64 (litFloatingToHostDouble v)) ""
+
+ showFod IsFunction = "IsFunction"
+ showFod IsData = "IsData"
+
+showLitNumType :: LitNumType -> String
+showLitNumType nt = case nt of
+ LitNumBigNat -> "LitNumBigNat"
+ LitNumInt -> "LitNumInt"
+ LitNumInt8 -> "LitNumInt8"
+ LitNumInt16 -> "LitNumInt16"
+ LitNumInt32 -> "LitNumInt32"
+ LitNumInt64 -> "LitNumInt64"
+ LitNumWord -> "LitNumWord"
+ LitNumWord8 -> "LitNumWord8"
+ LitNumWord16 -> "LitNumWord16"
+ LitNumWord32 -> "LitNumWord32"
+ LitNumWord64 -> "LitNumWord64"
+
+--------------------------------------------------------------------------------
+-- Generators
+
+-- | A number in @[0, n)@. Uses the high bits of the LCG state, which are the
+-- more random ones.
+choose :: Int -> Gen Int
+choose n = (`mod` n) . fromIntegral . (`shiftR` 32) <$> arbitraryWord64
+
+oneOf :: [Gen a] -> Gen a
+oneOf gens = do
+ i <- choose (length gens)
+ gens !! i
+
+listOf :: Int -> Gen a -> Gen [a]
+listOf maxLen gen = do
+ n <- choose (maxLen + 1)
+ replicateM n gen
+
+-- | 'MiniQuickCheck's 'Integer' instance generates values of up to 192 bits,
+-- which rarely hit the boundaries of the SLEB128 encoding. So we mix in small
+-- values and values around powers of two.
+genInteger :: Gen Integer
+genInteger = oneOf
+ [ arbitrary
+ , fromIntegral . subtract 300 <$> choose 601
+ , do k <- choose 200
+ d <- subtract 2 <$> choose 5
+ neg <- arbitrary
+ let v = 2 ^ k + toInteger d
+ return (if neg then negate v else v)
+ ]
+
+genLitNumType :: Gen LitNumType
+genLitNumType = oneOf (map pure [LitNumBigNat ..])
+
+-- | Numeric literals are always in range for their type, see
+-- Note [Word/Int underflow/overflow] in GHC.Types.Literal. The encoding is
+-- free to rely on that, so we generate only such literals.
+genLitNumber :: Gen Literal
+genLitNumber = do
+ nt <- genLitNumType
+ i <- genInteger
+ -- 'mkLitNumberWrap' wraps into the range of the fixed width types but
+ -- refuses negative 'BigNat's.
+ let i' | LitNumBigNat <- nt = abs i
+ | otherwise = i
+ return (mkLitNumberWrap genericPlatform nt i')
+
+-- | Random bit patterns, so that we also get infinities, negative zero,
+-- subnormals and NaNs with various payloads.
+genFloat :: Gen Float
+genFloat = castWord32ToFloat <$> arbitrary
+
+genDouble :: Gen Double
+genDouble = castWord64ToDouble <$> arbitrary
+
+genRational :: Gen Rational
+genRational = do
+ n <- genInteger
+ NonZero d <- arbitrary @(NonZero Integer)
+ return (n % d)
+
+genLitFloating :: Gen LitFloating
+genLitFloating = oneOf
+ [ floatToLitFloating <$> genFloat
+ , doubleToLitFloating <$> genDouble
+ , rationalToLitFloating <$> genRational
+ ]
+
+genLitFloatingType :: Gen LitFloatingType
+genLitFloatingType = oneOf [ pure LitFloat, pure LitDouble ]
+
+genByteString :: Gen BS.ByteString
+genByteString = BS.pack <$> listOf 64 arbitrary
+
+genFunctionOrData :: Gen FunctionOrData
+genFunctionOrData = oneOf [ pure IsFunction, pure IsData ]
+
+-- | Any literal except 'LitRubbish', which has no 'Binary' encoding, see
+-- Note [Rubbish literals] in GHC.Types.Literal.
+genLiteral :: Gen Literal
+genLiteral = oneOf
+ [ LitChar <$> arbitrary
+ , genLitNumber
+ , LitString <$> genByteString
+ , pure LitNullAddr
+ , LitFloating <$> genLitFloatingType <*> genLitFloating
+ , LitLabel <$> (mkFastStringByteString <$> genByteString) <*> genFunctionOrData
+ ]
+
+instance Arbitrary Lit where
+ arbitrary = Lit <$> genLiteral
+
+newtype Lits = Lits [Lit]
+ deriving (Eq, Show)
+
+instance Arbitrary Lits where
+ arbitrary = Lits <$> listOf 32 arbitrary
+
+newtype I = I Integer
+ deriving (Eq, Show)
+
+instance Arbitrary I where
+ arbitrary = I <$> genInteger
+
+--------------------------------------------------------------------------------
+-- Properties
+
+-- | Reference implementation of the SLEB128 encoding.
+slebRef :: Integer -> [Word8]
+slebRef = go
+ where
+ go val =
+ let byte = fromIntegral (val .&. 0x7f) :: Word8
+ val' = val `shiftR` 7
+ signBit = testBit byte 6
+ done = (val' == 0 && not signBit) || (val' == -1 && signBit)
+ in if done
+ then [byte]
+ else setBit byte 7 : go val'
+
+prop_literalRoundTrip :: Lit -> PropertyCheck
+prop_literalRoundTrip (Lit l) = Lit (roundTrip1 l) === Lit l
+
+prop_literalBatchRoundTrip :: Lits -> PropertyCheck
+prop_literalBatchRoundTrip (Lits ls) = Lits (map Lit (roundTrip [ l | Lit l <- ls ])) === Lits ls
+
+prop_integerRoundTrip :: I -> PropertyCheck
+prop_integerRoundTrip (I i) = roundTrip1 i === i
+
+prop_integerEncoding :: I -> PropertyCheck
+prop_integerEncoding (I i) = BS.unpack (encode i) === slebRef i
+
+tests :: Test
+tests = Group "Binary"
+ [ Group "Literal"
+ [ Property "round trip" prop_literalRoundTrip
+ , Property "batch round trip" prop_literalBatchRoundTrip
+ ]
+ , Group "Integer"
+ [ Property "round trip" prop_integerRoundTrip
+ , Property "SLEB128 encoding" prop_integerEncoding
+ ]
+ ]
+
+main :: IO ()
+main = runTestsMain (Iterations 1000) tests
=====================================
testsuite/tests/utils/should_run/Binary_Literal.stdout
=====================================
@@ -0,0 +1,11 @@
+Group Binary
+ Group Literal
+ Running round trip
+ Passed 1000 iterations
+ Running batch round trip
+ Passed 1000 iterations
+ Group Integer
+ Running round trip
+ Passed 1000 iterations
+ Running SLEB128 encoding
+ Passed 1000 iterations
=====================================
testsuite/tests/utils/should_run/all.T
=====================================
@@ -1 +1,6 @@
test('T15953', [ignore_stdout, js_skip], makefile_test, [])
+
+# Property tests for the 'Binary Literal' instance, which also exercises
+# GHCs 'Binary Integer' instance.
+test('Binary_Literal', [mini_quickcheck], multimod_compile_and_run,
+ ['Binary_Literal', '-package ghc'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0df4842a4a4b64a20e0be97b2c5c8ac…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0df4842a4a4b64a20e0be97b2c5c8ac…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc] Pushed new branch wip/apk/expose-overloaded-unfoldings
by Andreas Klebinger (@AndreasK) 14 Sep '26
by Andreas Klebinger (@AndreasK) 14 Sep '26
14 Sep '26
Andreas Klebinger pushed new branch wip/apk/expose-overloaded-unfoldings at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/apk/expose-overloaded-unfoldi…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/jeltsch/improve-closure-property-check] Change the style of the `offenders` definition
by Wolfgang Jeltsch (@jeltsch) 14 Sep '26
by Wolfgang Jeltsch (@jeltsch) 14 Sep '26
14 Sep '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/improve-closure-property-check at Glasgow Haskell Compiler / GHC
Commits:
a82f16fe by Wolfgang Jeltsch at 2026-09-14T16:08:58+03:00
Change the style of the `offenders` definition
- - - - -
1 changed file:
- compiler/GHC/Driver/Downsweep.hs
Changes:
=====================================
compiler/GHC/Driver/Downsweep.hs
=====================================
@@ -970,8 +970,8 @@ checkHomeUnitsClosed unit_env
-- by the pair of the 'UnitId' of /u/ and the 'UnitId' of /v/.
offenders :: [(UnitId, UnitId)]
offenders
- = evalState (collect (map (homeUnitEnv_units . snd) home_unit_data)) $
- Set.empty
+ = evalState (collect (map (homeUnitEnv_units . snd) home_unit_data))
+ Set.empty
where
-- | Collects offending dependencies.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a82f16fe564fe8e5c1ce8629a003419…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a82f16fe564fe8e5c1ce8629a003419…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/jeltsch/improve-closure-property-check] Improved and correct the doc comment of `checkHomeUnitsClosed`
by Wolfgang Jeltsch (@jeltsch) 14 Sep '26
by Wolfgang Jeltsch (@jeltsch) 14 Sep '26
14 Sep '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/improve-closure-property-check at Glasgow Haskell Compiler / GHC
Commits:
53be1a6d by Wolfgang Jeltsch at 2026-09-14T16:03:38+03:00
Improved and correct the doc comment of `checkHomeUnitsClosed`
- - - - -
1 changed file:
- compiler/GHC/Driver/Downsweep.hs
Changes:
=====================================
compiler/GHC/Driver/Downsweep.hs
=====================================
@@ -942,9 +942,10 @@ rootSummariesParallel n_jobs hsc_env diag_wrapper msg get_summary = do
-- | Checks whether the given 'UnitEnv' has the closure property.
--
-- See the section “Closure Property” in @Note [Multiple Home Units]@ for the
--- definition of the closure property an @Note [Home unit closure property
--- check]@ below for a discussion of the algorithm used for this check, its
--- justification, and a potential alternative.
+-- definition of the closure property and
+-- @Note [Home unit closure property check]@ below for a discussion of the
+-- algorithm used for this check, its justification, and a potential
+-- alternative.
checkHomeUnitsClosed :: UnitEnv -> [DriverMessages]
checkHomeUnitsClosed unit_env
| null offenders = []
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53be1a6d2d8ffc541ef6b019f6cac8e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53be1a6d2d8ffc541ef6b019f6cac8e…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
14 Sep '26
Andreas Klebinger pushed new branch wip/apk/iface-encoding at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/apk/iface-encoding
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: FastString: Drop mkFastStringWith's constructor callback
by Marge Bot (@marge-bot) 14 Sep '26
by Marge Bot (@marge-bot) 14 Sep '26
14 Sep '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
7a108e43 by Simon Jakobi at 2026-09-12T18:35:59-04:00
FastString: Drop mkFastStringWith's constructor callback
All three callers passed the same callback, a partial application of
mkNewFastStringShortByteString to the string being interned. That
partial application is allocated as a closure before the table lookup,
on the common hit path too, although the callback is needed only after
a miss.
Drop the parameter and call mkNewFastStringShortByteString directly
after a miss. Since nothing is passed "with" anymore, rename the
function to internSB.
Suggested by Simon PJ in #27528:
https://gitlab.haskell.org/ghc/ghc/-/work_items/27528#note_687031
Assisted-by: Claude Fable 5
- - - - -
82c73b22 by Alan Zimmerman at 2026-09-12T18:36:38-04:00
EPA: More targeted HsDo exact print annotation
HsDo is multi-purpose, as encoded in its HsDoFlavour field. Some of
these are in a layout context (DoExpr, MDoExpr), others are not
(ListComp, MonadComp).
We are moving towards using AnnList only in layout contexts, so we
switch the HsDo TTG annotation from holding an AnnList for this, to
holding
Either (EpToken "[", EpToken "]") AnnList
This also allows us to trim down AnnListBrackets to only have braces
or None, thereby opening the door for unification with the existing
layout context data type EpLayout.
- - - - -
de75a9e9 by Luite Stegeman at 2026-09-14T10:12:51+02:00
rts: make stg_threadLabelzh return a valid pointer for unlabeled threads.
This fixes a segfault in the GC caused by stg_threadLabelzh returning
a 0 pointer in a GC pointer field.
stg_threadLabelzh returns a tuple of type (# Int#, ByteArray# #). If a
thread has no label, the second field is unused. We must still return
a valid heap object pointer.
Instead of returning 0, we now return stg_DEAD_SLOT_closure.
fixes #27618
- - - - -
3b1f7b57 by Luite Stegeman at 2026-09-14T08:19:42-04:00
rts: initialise the stack frame header for mask_frame and apply_mask_frame
We must leave the stack in consistent state before jumping to
mask_frame or apply_mask_frame because they may result. Failing
to do so could lead to a crash if there were waiting exceptions.
Fixes #27651
- - - - -
23 changed files:
- + changelog.d/fix-control0-mask-trampoline
- + changelog.d/fix-threadlabel-segfault-27618
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- rts/ContinuationOps.cmm
- rts/PrimOps.cmm
- rts/StgMiscClosures.cmm
- rts/include/stg/MiscClosures.h
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/printer/Test20297.stdout
- + testsuite/tests/rts/T27618.hs
- + testsuite/tests/rts/T27618.stdout
- testsuite/tests/rts/all.T
- + testsuite/tests/rts/continuations/T27651.hs
- + testsuite/tests/rts/continuations/T27651.stdout
- testsuite/tests/rts/continuations/all.T
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Utils.hs
Changes:
=====================================
changelog.d/fix-control0-mask-trampoline
=====================================
@@ -0,0 +1,13 @@
+section: rts
+synopsis: Fix a crash when capturing or resuming a delimited continuation that adjusts the async exception masking state
+issues: #27651
+mrs: !16484
+
+description: {
+Capturing a continuation with ``control0#`` from inside ``mask`` or
+``uninterruptibleMask`` left an uninitialised word on the stack while
+restoring the masking state. When the thread had a pending asynchronous
+exception (e.g. from ``throwTo``), raising it walked over that word and
+crashed with a segmentation fault. Resuming such a continuation had the
+same defect.
+}
=====================================
changelog.d/fix-threadlabel-segfault-27618
=====================================
@@ -0,0 +1,10 @@
+section: rts
+synopsis: Fix a segfault that could occur when querying the label of an
+ unlabeled thread.
+issues: #27618
+mrs: !16468
+description: {
+ The ``threadLabel#`` primop returned a null pointer in the ``ByteArray#``
+ field of its result for threads that have no label. This could lead to a
+ crash during garbage collection.
+}
=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -320,7 +320,7 @@ data FastStringTable = FastStringTable
-- ^ Number of computed z-encodings for all buckets.
--
-- We mark this as 'NOUNPACK' as this 'FastMutInt' is retained by a thunk
- -- in 'mkFastStringWith' and needs to be boxed any way.
+ -- in 'internSB' and needs to be boxed any way.
-- If this is unpacked, then we box this single 'FastMutInt' once for each
-- allocated FastString.
(Array# (IORef FastStringTableSegment)) -- ^ concurrent segments
@@ -474,9 +474,10 @@ The procedure goes like this:
* Otherwise, insert and return the string we created.
-}
-mkFastStringWith
- :: (Int -> FastMutInt-> IO FastString) -> ShortByteString -> IO FastString
-mkFastStringWith mk_fs sbs = do
+-- | Return the interned 'FastString' for the given bytes, creating and
+-- inserting one on a table miss.
+internSB :: ShortByteString -> IO FastString
+internSB sbs = do
FastStringTableSegment lock _ buckets# <- readIORef segmentRef
let idx# = hashToIndex# buckets# hash#
bucket <- IO $ readArray# buckets# idx#
@@ -487,7 +488,7 @@ mkFastStringWith mk_fs sbs = do
-- only run partially and putMVar is not called after takeMVar.
noDuplicate
n <- get_uid
- new_fs <- mk_fs n n_zencs
+ new_fs <- mkNewFastStringShortByteString sbs n n_zencs
withMVar lock $ \_ -> insert new_fs
where
!(FastStringTable uid n_zencs segments#) = stringTable
@@ -523,11 +524,11 @@ bucket_match fs sbs = go fs
mkFastStringBytes :: Ptr Word8 -> Int -> FastString
mkFastStringBytes !ptr !len =
- -- NB: Might as well use unsafeDupablePerformIO, since mkFastStringWith is
+ -- NB: Might as well use unsafeDupablePerformIO, since internSB is
-- idempotent.
unsafeDupablePerformIO $ do
sbs <- newSBSFromPtr ptr len
- mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
+ internSB sbs
newSBSFromPtr :: Ptr a -> Int -> IO ShortByteString
newSBSFromPtr (Ptr src#) (I# len#) =
@@ -541,14 +542,13 @@ newSBSFromPtr (Ptr src#) (I# len#) =
mkFastStringByteString :: ByteString -> FastString
mkFastStringByteString bs =
let sbs = SBS.toShort bs in
- inlinePerformIO $
- mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
+ inlinePerformIO $ internSB sbs
-- | Create a 'FastString' from an existing 'ShortByteString' without
-- copying.
mkFastStringShortByteString :: ShortByteString -> FastString
mkFastStringShortByteString sbs =
- inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
+ inlinePerformIO $ internSB sbs
-- | Create a 'FastString' from an 'HText'
mkFastStringShortText :: ShortText -> FastString
@@ -560,7 +560,7 @@ mkFastString :: String -> FastString
mkFastString str =
inlinePerformIO $ do
let !sbs = utf8EncodeShortByteString str
- mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
+ internSB sbs
-- The following rule is used to avoid polluting the non-reclaimable FastString
-- table with transient strings when we only want their encoding.
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -290,10 +290,12 @@ type instance XLet GhcPs = (EpToken "let", EpToken "in")
type instance XLet GhcRn = NoExtField
type instance XLet GhcTc = NoExtField
-type instance XDo GhcPs = (AnnList, EpaLocation)
+type instance XDo GhcPs = DoAnn
type instance XDo GhcRn = NoExtField
type instance XDo GhcTc = Type
+type DoAnn = (Either (EpToken "[", EpToken "]") AnnList, EpaLocation)
+
type instance XExplicitList GhcPs = (EpToken "[", EpToken "]")
type instance XExplicitList GhcRn = NoExtField
type instance XExplicitList GhcTc = Type
@@ -1467,7 +1469,7 @@ type instance XCmdLet GhcPs = (EpToken "let", EpToken "in")
type instance XCmdLet GhcRn = NoExtField
type instance XCmdLet GhcTc = NoExtField
-type instance XCmdDo GhcPs = (AnnList, EpaLocation)
+type instance XCmdDo GhcPs = DoAnn
type instance XCmdDo GhcRn = NoExtField
type instance XCmdDo GhcTc = Type
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -335,11 +335,10 @@ mkHsIntegral :: IntegralLit GhcPs -> HsOverLit GhcPs
mkHsFractional :: FractionalLit GhcPs -> HsOverLit GhcPs
mkHsIsString :: SourceText -> HText -> HsOverLit GhcPs
mkHsDo :: HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> HsExpr GhcPs
-mkHsDoAnns :: HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> (AnnList, EpaLocation) -> HsExpr GhcPs
+mkHsDoAnns :: HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> DoAnn -> HsExpr GhcPs
mkHsComp :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
-> HsExpr GhcPs
-mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
- -> (AnnList, EpaLocation)
+mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> DoAnn
-> HsExpr GhcPs
mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpToken "-"
=====================================
compiler/GHC/Parser.y
=====================================
@@ -3152,19 +3152,15 @@ aexp :: { ECP }
return $ ECP $
$2 >>= \ $2 ->
mkHsDoPV (comb2 $1 $2)
- (stmtlistAnns $2)
+ (Right $ stmtlistAnns $2, glR $1)
(fmap mkModuleNameFS (getDO $1))
- (stmtlistStmts $2)
- (glR $1)
- (glR $2) }
+ (stmtlistStmts $2) }
| MDO stmtlist {% hintQualifiedDo $1 >> runPV $2 >>= \ $2 ->
fmap ecpFromExp $
amsA' (L (comb2 $1 $2)
- (mkMDo (stmtlistAnns $2)
- (MDoExpr $ fmap mkModuleNameFS (getMDO $1))
- (stmtlistStmts $2)
- (glR $1)
- (glR $2))) }
+ (mkHsDoAnns (MDoExpr $ fmap mkModuleNameFS (getMDO $1))
+ (stmtlistStmts $2)
+ (Right $ stmtlistAnns $2, glR $1))) }
| 'proc' aexp '->' exp
{% (checkPattern <=< runPV) (unECP $2) >>= \ p ->
runPV (unECP $4) >>= \ $4@cmd ->
@@ -3440,7 +3436,7 @@ list :: { forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV (
{ \loc (ao,ac) ->
checkMonadComp >>= \ ctxt ->
unECP $1 >>= \ $1 -> do { t <- addTrailingVbarA $1 (epTok $2)
- ; amsA' (L loc $ mkHsCompAnns ctxt (unLoc $3) t (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [], noAnn))
+ ; amsA' (L loc $ mkHsCompAnns ctxt (unLoc $3) t (Left $ (EpTok ao, EpTok ac), noAnn))
>>= ecpFromExp' } }
lexps :: { forall b. DisambECP b => PV [LocatedA b] }
@@ -3658,11 +3654,13 @@ apat : aexp {% (checkPattern <=< runPV) (unECP $1) }
-----------------------------------------------------------------------------
-- Statement sequences
-stmtlist :: { forall b. DisambECP b => PV (LocatedA ((EpToken "{", [EpToken ";"], EpToken "}"), Located [LocatedA (Stmt GhcPs (LocatedA b))])) }
+stmtlist :: { forall b. DisambECP b => PV (LocatedA (AnnList, Located [LocatedA (Stmt GhcPs (LocatedA b))])) }
: '{' stmts '}' { $2 >>= \ $2 ->
- amsA' (sLL $1 $> ((epTok $1, fromOL $ fst $ unLoc $2, epTok $3), sL1 $2 $ reverse $ snd $ unLoc $2))}
+ amsA' (sLL $1 $> (AnnList (Just (spanAsAnchor $ stmtsLoc $2)) (ListBraces (epTok $1) (epTok $3)) (fromOL $ fst $ unLoc $2)
+ , sL1 $2 $ reverse $ snd $ unLoc $2))}
| vocurly stmts close { $2 >>= \ $2 ->
- amsA' (L (stmtsLoc $2) ((noEpTok, fromOL $ fst $ unLoc $2, noEpTok), sL1 $2 $ reverse $ snd $ unLoc $2))}
+ amsA' (L (stmtsLoc $2) (AnnList (Just (spanAsAnchor $ stmtsLoc $2)) ListNone (fromOL $ fst $ unLoc $2)
+ , sL1 $2 $ reverse $ snd $ unLoc $2))}
-- do { ;; s ; s ; ; s ;; }
-- The last Stmt should be an expression, but that's hard to enforce
@@ -3704,7 +3702,7 @@ e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) }
stmt :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) }
: qual { $1 }
| 'rec' stmtlist { $2 >>= \ $2 ->
- amsA' (sLL $1 $> $ mkRecStmt (hsDoAnn (epTok $1) (stmtlistAnns $2) $2)
+ amsA' (sLL $1 $> $ mkRecStmt (stmtlistAnns $2, epTok $1)
(stmtlistStmts $2)) }
qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) }
@@ -4724,10 +4722,6 @@ commentsPA la@(L l a) = do
!cs <- getPriorCommentsFor (getLocA la)
return (L (addCommentsToEpAnn l cs) a)
-hsDoAnn :: EpToken "rec" -> (EpToken "{", [EpToken ";"], EpToken "}") -> LocatedAn t b -> (AnnList, EpToken "rec")
-hsDoAnn rec (ob, semis, cb) (L ll _)
- = (AnnList (Just $ spanAsAnchor (locA ll)) (ListBraces ob cb) semis, rec)
-
listAsAnchorM :: [LocatedAn t a] -> Maybe EpaLocation
listAsAnchorM [] = Nothing
listAsAnchorM (L l _:_) =
@@ -4757,8 +4751,7 @@ stmtlistStmts :: LocatedA (a, Located [LocatedA (Stmt GhcPs (LocatedA b))])
stmtlistStmts (L la (_,L l stmts))
= L ((noAnnSrcSpan l) {comments = comments la}) stmts
-stmtlistAnns :: LocatedA ((EpToken "{", [EpToken ";"], EpToken "}"), a)
- -> (EpToken "{", [EpToken ";"], EpToken "}")
+stmtlistAnns :: LocatedA (AnnList, a) -> AnnList
stmtlistAnns (L _ (an,_)) = an
-- -------------------------------------
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -519,8 +519,7 @@ data AnnList
} deriving (Data,Eq)
data AnnListBrackets
- = ListBraces (EpToken "{") (EpToken "}")
- | ListSquare (EpToken "[") (EpToken "]")
+ = ListBraces (EpToken "{") (EpToken "}")
| ListNone
deriving (Data,Eq)
@@ -1093,7 +1092,6 @@ instance Outputable AnnList where
instance Outputable AnnListBrackets where
ppr (ListBraces o c) = text "ListBraces" <+> ppr o <+> ppr c
- ppr (ListSquare o c) = text "ListSquare" <+> ppr o <+> ppr c
ppr ListNone = text "ListNone"
instance Outputable AnnCType where
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -12,7 +12,7 @@ module GHC.Parser.PostProcess (
mkRdrGetField, mkRdrProjection, Fbind, -- RecordDot
mkHsOpApp,
mkHsIntegral, mkHsFractional, mkHsIsString,
- mkHsDo, mkMDo, mkSpliceDecl,
+ mkHsDo, mkSpliceDecl,
mkRoleAnnotDecl,
mkClassDecl,
mkTyData, mkDataFamInst,
@@ -435,10 +435,6 @@ mkRoleAnnotDecl loc tycon roles anns
addFatalError $ mkPlainErrorMsgEnvelope loc_role $
(PsErrIllegalRoleName role nearby)
-mkMDo :: (EpToken "{", [EpToken ";"], EpToken "}") -> HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> EpaLocation -> EpaLocation -> HsExpr GhcPs
-mkMDo (ob, semis, cb) ctxt stmts tok loc
- = mkHsDoAnns ctxt stmts (AnnList (Just loc) (ListBraces ob cb) semis, tok)
-
-- | Converts a list of 'LHsTyVarBndr's annotated with their 'Specificity' to
-- binders without annotations. Only accepts specified variables, and errors if
-- any of the provided binders has an 'InferredSpec' annotation.
@@ -1804,12 +1800,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
-> PV (LocatedA b)
-- | Disambiguate "do { ... }" (do notation)
mkHsDoPV ::
- SrcSpan ->
- (EpToken "{", [EpToken ";"], EpToken "}") ->
- Maybe ModuleName ->
- LocatedA [LStmt GhcPs (LocatedA b)] ->
- EpaLocation -> -- Token
- EpaLocation -> -- Anchor
+ SrcSpan -> DoAnn -> Maybe ModuleName -> LocatedA [LStmt GhcPs (LocatedA b)] ->
PV (LocatedA b)
-- | Disambiguate "( ... )" (parentheses)
mkHsParPV :: SrcSpan -> EpToken "(" -> LocatedA b -> EpToken ")" -> PV (LocatedA b)
@@ -1959,10 +1950,10 @@ instance DisambECP (HsCmd GhcPs) where
checkDoAndIfThenElse PsErrSemiColonsInCondCmd c semi1 a semi2 b
!cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsCmdIf c a b anns)
- mkHsDoPV l (ob,semis,cb) Nothing stmts tok_loc anc = do
+ mkHsDoPV l ann Nothing stmts = do
!cs <- getCommentsFor l
- return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo (AnnList (Just anc) (ListBraces ob cb) semis, tok_loc) stmts)
- mkHsDoPV l _ (Just m) _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo ann stmts)
+ mkHsDoPV l _ (Just m) _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m
mkHsParPV l lpar c rpar = do
!cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdPar (lpar, rpar) c)
@@ -2058,9 +2049,9 @@ instance DisambECP (HsExpr GhcPs) where
checkDoAndIfThenElse PsErrSemiColonsInCondExpr c semi1 a semi2 b
!cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsIf c a b anns)
- mkHsDoPV l (ob,semis,cb) mod stmts loc_tok anc = do
+ mkHsDoPV l ann mod stmts = do
!cs <- getCommentsFor l
- return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsDo (AnnList (Just anc) (ListBraces ob cb) semis, loc_tok) (DoExpr mod) stmts)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsDo ann (DoExpr mod) stmts)
mkHsParPV l lpar e rpar = do
!cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsPar (lpar, rpar) e)
@@ -2156,7 +2147,7 @@ instance DisambECP (PatBuilder GhcPs) where
!cs <- getCommentsFor (locA l)
return $ L (addCommentsToEpAnn l cs) (PatBuilderAppType p at (mkHsTyPat t))
mkHsIfPV l _ _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrIfThenElseInPat
- mkHsDoPV l _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat
+ mkHsDoPV l _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat
mkHsParPV l lpar p rpar = return $ L (noAnnSrcSpan l) (PatBuilderPar lpar p rpar)
mkHsVarPV v@(getLoc -> l) = return $ L (l2l l) (PatBuilderVar v)
mkHsLitPV lit@(L l a) = do
=====================================
rts/ContinuationOps.cmm
=====================================
@@ -148,6 +148,7 @@ stg_control0zh_ll // explicit stack
// and jump to the frame’s entry code.
Sp_adj(-3); // Note -3, not -2, because `mask_frame` will
// try to pop itself off the stack when it returns!
+ Sp(0) = mask_frame; // Can't be omitted, see #27651
Sp(1) = stg_ap_pv_info;
Sp(2) = cont;
R1 = f;
@@ -230,6 +231,7 @@ stg_CONTINUATION_apply // explicit stack
// Now we just set up the stack so that `apply_mask_frame` will apply `io`
// when it returns and jump to it.
Sp_adj(-2);
+ Sp(0) = apply_mask_frame; // Can't be omitted, see #27651
Sp(1) = stg_ap_v_info;
R1 = io;
jump %ENTRY_CODE(apply_mask_frame) [R1];
=====================================
rts/PrimOps.cmm
=====================================
@@ -1160,7 +1160,7 @@ stg_threadLabelzh ( gcptr tso )
W_ r;
r = StgTSO_label(tso);
if (r == 0) {
- return (0, 0);
+ return (0, stg_DEAD_SLOT_closure);
} else {
return (1, r);
}
=====================================
rts/StgMiscClosures.cmm
=====================================
@@ -726,6 +726,18 @@ INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF,"NO_FINALIZER","NO_FINALIZ
CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER);
+/* ----------------------------------------------------------------------------
+ DEAD_SLOT
+
+ A static nullary constructor for dead pointer-typed result slots
+ that must still hold a valid closure for the GC (see #27618).
+ ------------------------------------------------------------------------- */
+
+INFO_TABLE_CONSTR(stg_DEAD_SLOT,0,0,0,CONSTR_NOCAF,"DEAD_SLOT","DEAD_SLOT")
+{ ccall pbarf("DEAD_SLOT object (%p) entered!", R1 "ptr") never returns; }
+
+CLOSURE(stg_DEAD_SLOT_closure,stg_DEAD_SLOT);
+
/* ----------------------------------------------------------------------------
Stable Names are unlifted too.
------------------------------------------------------------------------- */
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -200,6 +200,7 @@ RTS_ENTRY(stg_SRT_16);
RTS_CLOSURE(stg_END_TSO_QUEUE_closure);
RTS_CLOSURE(stg_NO_FINALIZER_closure);
+RTS_CLOSURE(stg_DEAD_SLOT_closure);
RTS_CLOSURE(stg_dummy_ret_closure);
RTS_CLOSURE(stg_forceIO_closure);
RTS_CLOSURE(stg_CLOSURE_TABLE_NULL_closure);
@@ -211,6 +212,7 @@ RTS_CLOSURE(stg_END_STM_CHUNK_LIST_closure);
RTS_CLOSURE(stg_NO_TREC_closure);
RTS_ENTRY(stg_NO_FINALIZER);
+RTS_ENTRY(stg_DEAD_SLOT);
#if IN_STG_CODE
extern StgWordArray stg_CHARLIKE_closure;
=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
=====================================
@@ -289,13 +289,12 @@
{ DumpParsedAstComments.hs:14:7-8 }))]))
(HsDo
((,)
- (AnnList
- (Just
- (EpaSpan { DumpParsedAstComments.hs:16:3 }))
- (ListBraces
- (EpTok (EpaSpan { <no location info> }))
- (EpTok (EpaSpan { <no location info> })))
- [])
+ (Right
+ (AnnList
+ (Just
+ (EpaSpan { DumpParsedAstComments.hs:16:3 }))
+ (ListNone)
+ []))
(EpaSpan { DumpParsedAstComments.hs:14:7-8 }))
(DoExpr
(Nothing))
=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -331,13 +331,12 @@
[]))
(HsDo
((,)
- (AnnList
- (Just
- (EpaSpan { DumpSemis.hs:(11,3)-(12,3) }))
- (ListBraces
- (EpTok (EpaSpan { <no location info> }))
- (EpTok (EpaSpan { <no location info> })))
- [])
+ (Right
+ (AnnList
+ (Just
+ (EpaSpan { DumpSemis.hs:(11,3)-(12,3) }))
+ (ListNone)
+ []))
(EpaSpan { DumpSemis.hs:10:7-8 }))
(DoExpr
(Nothing))
@@ -363,20 +362,21 @@
[]))
(HsDo
((,)
- (AnnList
- (Just
- (EpaSpan { DumpSemis.hs:11:6-15 }))
- (ListBraces
- (EpTok (EpaSpan { DumpSemis.hs:11:6 }))
- (EpTok (EpaSpan { DumpSemis.hs:11:15 })))
- [(EpTok
- (EpaSpan { DumpSemis.hs:11:8 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:11:9 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:11:10 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:11:11 }))])
+ (Right
+ (AnnList
+ (Just
+ (EpaSpan { DumpSemis.hs:11:8-13 }))
+ (ListBraces
+ (EpTok (EpaSpan { DumpSemis.hs:11:6 }))
+ (EpTok (EpaSpan { DumpSemis.hs:11:15 })))
+ [(EpTok
+ (EpaSpan { DumpSemis.hs:11:8 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:11:9 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:11:10 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:11:11 }))]))
(EpaSpan { DumpSemis.hs:11:3-4 }))
(DoExpr
(Nothing))
@@ -625,16 +625,17 @@
[]))
(HsDo
((,)
- (AnnList
- (Just
- (EpaSpan { DumpSemis.hs:(16,3)-(19,3) }))
- (ListBraces
- (EpTok (EpaSpan { DumpSemis.hs:16:3 }))
- (EpTok (EpaSpan { DumpSemis.hs:19:3 })))
- [(EpTok
- (EpaSpan { DumpSemis.hs:16:5 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:16:8 }))])
+ (Right
+ (AnnList
+ (Just
+ (EpaSpan { DumpSemis.hs:(16,5)-(18,5) }))
+ (ListBraces
+ (EpTok (EpaSpan { DumpSemis.hs:16:3 }))
+ (EpTok (EpaSpan { DumpSemis.hs:19:3 })))
+ [(EpTok
+ (EpaSpan { DumpSemis.hs:16:5 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:16:8 }))]))
(EpaSpan { DumpSemis.hs:15:7-8 }))
(DoExpr
(Nothing))
@@ -877,16 +878,17 @@
[]))
(HsDo
((,)
- (AnnList
- (Just
- (EpaSpan { DumpSemis.hs:22:10-30 }))
- (ListBraces
- (EpTok (EpaSpan { DumpSemis.hs:22:10 }))
- (EpTok (EpaSpan { DumpSemis.hs:22:30 })))
- [(EpTok
- (EpaSpan { DumpSemis.hs:22:12 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:22:13 }))])
+ (Right
+ (AnnList
+ (Just
+ (EpaSpan { DumpSemis.hs:22:12-28 }))
+ (ListBraces
+ (EpTok (EpaSpan { DumpSemis.hs:22:10 }))
+ (EpTok (EpaSpan { DumpSemis.hs:22:30 })))
+ [(EpTok
+ (EpaSpan { DumpSemis.hs:22:12 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:22:13 }))]))
(EpaSpan { DumpSemis.hs:22:7-8 }))
(DoExpr
(Nothing))
=====================================
testsuite/tests/printer/Test20297.stdout
=====================================
@@ -394,13 +394,12 @@
[]))
(HsDo
((,)
- (AnnList
- (Just
- (EpaSpan { Test20297.hs:11:22-26 }))
- (ListBraces
- (EpTok (EpaSpan { <no location info> }))
- (EpTok (EpaSpan { <no location info> })))
- [])
+ (Right
+ (AnnList
+ (Just
+ (EpaSpan { Test20297.hs:11:22-26 }))
+ (ListNone)
+ []))
(EpaSpan { Test20297.hs:11:19-20 }))
(DoExpr
(Nothing))
@@ -820,13 +819,12 @@
[]))
(HsDo
((,)
- (AnnList
- (Just
- (EpaSpan { Test20297.ppr.hs:9:20-24 }))
- (ListBraces
- (EpTok (EpaSpan { <no location info> }))
- (EpTok (EpaSpan { <no location info> })))
- [])
+ (Right
+ (AnnList
+ (Just
+ (EpaSpan { Test20297.ppr.hs:9:20-24 }))
+ (ListNone)
+ []))
(EpaSpan { Test20297.ppr.hs:9:17-18 }))
(DoExpr
(Nothing))
=====================================
testsuite/tests/rts/T27618.hs
=====================================
@@ -0,0 +1,39 @@
+{-# LANGUAGE NumericUnderscores #-}
+
+-- Test for a major GC segfault triggered by threadLabel# returning NULL in
+-- a GC pointer field on unlabeled threads. Run with -N4 -A32k.
+
+module Main (main) where
+
+import Control.Concurrent
+import Control.Monad
+import Data.IORef
+import GHC.Conc.Sync (threadLabel)
+import System.Mem (performMajorGC)
+
+{-# NOINLINE queryLabel #-}
+queryLabel :: ThreadId -> IO (Maybe String)
+queryLabel = threadLabel
+
+main :: IO ()
+main = do
+ stop <- newIORef False
+ _ <- forkIO $ forever performMajorGC
+ targets <- replicateM 8 $ forkIO $ forever (threadDelay 1_000_000)
+ dones <- forM [1 :: Int .. 8] $ \_ -> do
+ done <- newEmptyMVar
+ _ <- forkIO $ do
+ let loop = do
+ s <- readIORef stop
+ unless s $ do
+ forM_ targets $ \t -> do
+ r <- queryLabel t
+ r `seq` pure ()
+ loop
+ loop
+ putMVar done ()
+ pure done
+ threadDelay 2_000_000
+ writeIORef stop True
+ mapM_ takeMVar dones
+ putStrLn "done"
=====================================
testsuite/tests/rts/T27618.stdout
=====================================
@@ -0,0 +1 @@
+done
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -729,3 +729,7 @@ test('T27477',
],
compile_and_run, ['-O2'])
+test('T27618',
+ [req_target_smp, omit_ghci],
+ compile_and_run, ['-O2 -threaded -with-rtsopts "-N4 -A32k"'])
+
=====================================
testsuite/tests/rts/continuations/T27651.hs
=====================================
@@ -0,0 +1,91 @@
+-- When capturing or resuming a continuation adjusts the async exception
+-- masking state, the RTS trampolines through a mask/unmask frame, and the
+-- stack must be well-formed at that point: with a blocked exception
+-- pending, the eager raise in stg_unmaskAsyncExceptionszh_ret walks the
+-- whole stack.
+--
+-- Phase 1 exercises the capture side (stg_control0zh_ll): control0# runs
+-- inside uninterruptibleMask_ while another thread has queued an
+-- exception via throwTo, so the capture unmasks with the exception
+-- pending. The frame evaluated between the unmask frame and the prompt
+-- keeps raw Int# payload live so that a stale word on the stack cannot
+-- masquerade as a valid frame by accident.
+--
+-- Phase 2 exercises the resume side (stg_CONTINUATION_apply): the
+-- continuation is captured while unmasked (inside mask/restore), so
+-- resuming it unmasks, and it is applied from a thread that is masked
+-- with an exception pending.
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+
+import ContIO
+
+data Boom = Boom deriving Show
+instance Exception Boom
+
+{-# NOINLINE useInts #-}
+useInts :: Int -> Int -> Int -> Int -> Int -> Int
+useInts a b c d e = a + b * c + d * e
+
+rounds :: Int
+rounds = 150
+
+phase1 :: Int -> IO ()
+phase1 i = do
+ mv <- newEmptyMVar
+ done <- newEmptyMVar
+ let !p = i * 7919 + 3 -- raw ints to live in the continuation frame
+ !q = i * 104729 + 7
+ !u = i * 1299709 + 11
+ !v = i * 15485863 + 13
+ a <- forkIO $
+ handle (\Boom -> void (tryPutMVar done (Left Boom))) $ do
+ tag <- newPromptTag
+ r <- prompt tag $ do
+ x <- uninterruptibleMask_ $ do
+ putMVar mv ()
+ threadDelay 2000 -- let the thrower queue its exception
+ control0 tag (\_k -> pure (42 :: Int))
+ -- continuation frame between the unmask frame and the
+ -- prompt frame, carrying raw Int# payload:
+ pure (useInts x p q u v)
+ void (tryPutMVar done (Right r))
+ takeMVar mv
+ _ <- forkIO $ throwTo a Boom
+ void (takeMVar done)
+
+phase2 :: Int -> IO ()
+phase2 i = do
+ mv <- newEmptyMVar
+ done <- newEmptyMVar
+ kvar <- newEmptyMVar
+ let !p = i * 7919 + 3
+ !q = i * 104729 + 7
+ !u = i * 1299709 + 11
+ !v = i * 15485863 + 13
+ -- Capture a continuation whose resumption unmasks: the capture happens
+ -- inside restore, so its apply_mask_frame is the unmask frame.
+ _ <- forkIO $ do
+ tag <- newPromptTag
+ _ <- prompt tag $ mask $ \restore -> do
+ x <- restore (control0 tag (\k -> putMVar kvar k >> pure 0))
+ pure (useInts x p q u v)
+ pure ()
+ k <- takeMVar kvar
+ a <- forkIO $
+ handle (\Boom -> void (tryPutMVar done (Left Boom))) $ do
+ r <- uninterruptibleMask_ $ do
+ putMVar mv ()
+ threadDelay 2000 -- let the thrower queue its exception
+ k (pure 42) -- resuming unmasks with the exception pending
+ void (tryPutMVar done (Right r))
+ takeMVar mv
+ _ <- forkIO $ throwTo a Boom
+ void (takeMVar done)
+
+main :: IO ()
+main = do
+ forM_ [1 .. rounds] phase1
+ forM_ [1 .. rounds] phase2
+ putStrLn "ok"
=====================================
testsuite/tests/rts/continuations/T27651.stdout
=====================================
@@ -0,0 +1 @@
+ok
=====================================
testsuite/tests/rts/continuations/all.T
=====================================
@@ -9,3 +9,4 @@ test('cont_nondet_handler', [extra_files(['ContIO.hs'])], multimod_compile_and_r
test('cont_stack_overflow', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['cont_stack_overflow', '-with-rtsopts "-ki1k -kc2k -kb256"'])
test('T23513', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['T23513', ''])
+test('T27651', [extra_files(['ContIO.hs'])], multimod_compile_and_run, ['T27651', ''])
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -980,9 +980,6 @@ markLensBracketsO' a l =
ListBraces o c -> do
o' <- markEpToken o
return (set l (ListBraces o' c) a)
- ListSquare o c -> do
- o' <- markEpToken o
- return (set l (ListSquare o' c) a)
ListNone -> return (set l ListNone a)
markLensBracketsC :: (Monad m, Monoid w)
@@ -996,9 +993,6 @@ markLensBracketsC' a l =
ListBraces o c -> do
c' <- markEpToken c
return (set l (ListBraces o c') a)
- ListSquare o c -> do
- c' <- markEpToken c
- return (set l (ListSquare o c') a)
ListNone -> return (set l ListNone a)
-- -------------------------------------
@@ -1468,6 +1462,19 @@ markKwT (AddDarrowAnn tok) = AddDarrowAnn <$> markEpUniToken tok
-- ---------------------------------------------------------------------
+markAnnListD :: (Monad m, Monoid w)
+ => Either (EpToken "[", EpToken "]") AnnList
+ -> EP w m a
+ -> EP w m (Either (EpToken "[", EpToken "]") AnnList, a)
+markAnnListD (Left (o,c)) action = do
+ o' <- markEpToken o
+ r <- action
+ c' <- markEpToken c
+ return (Left (o',c'), r)
+markAnnListD (Right ann) action = do
+ (ann',r) <- markAnnList' ann action
+ return (Right ann',r)
+
markAnnList :: (Monad m, Monoid w)
=> EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
markAnnList ann action = do
@@ -3115,10 +3122,10 @@ instance ExactPrint (HsExpr GhcPs) where
e' <- markAnnotated e
return (HsLet (tkLet',tkIn') binds' e')
- exact (HsDo (an,l) do_or_list_comp stmts) = do
+ exact (HsDo an do_or_list_comp stmts) = do
debugM $ "HsDo"
- (an',l',stmts') <- exactDo (an,l) do_or_list_comp stmts
- return (HsDo (an',l') do_or_list_comp stmts')
+ (an',stmts') <- exactDo an do_or_list_comp stmts
+ return (HsDo an' do_or_list_comp stmts')
exact (ExplicitList (o,c) es) = do
debugM $ "ExplicitList start"
@@ -3290,8 +3297,8 @@ instance ExactPrint (HsExpr GhcPs) where
-- ---------------------------------------------------------------------
exactDo :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))
- => (AnnList, EpaLocation) -> HsDoFlavour -> LocatedAn an a
- -> EP w m (AnnList, EpaLocation, LocatedAn an a)
+ => DoAnn -> HsDoFlavour -> LocatedAn an a
+ -> EP w m (DoAnn, LocatedAn an a)
exactDo (an,l) (DoExpr m) stmts = exactMdo l m "do" >>=
\l0 -> markMaybeDodgyStmts (an,l0) stmts
exactDo (an,l) GhciStmtCtxt stmts = printStringAtAA l "do" >>=
@@ -3310,15 +3317,23 @@ exactMdo l (Just module_name) kw = printStringAtAA l n
n = (moduleNameString module_name) ++ "." ++ kw
markMaybeDodgyStmts :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))
- => (AnnList, EpaLocation) -> LocatedAn an a -> EP w m (AnnList, EpaLocation, LocatedAn an a)
+ => DoAnn -> LocatedAn an a -> EP w m (DoAnn, LocatedAn an a)
markMaybeDodgyStmts (an,l) stmts =
if notDodgy stmts
then do
- (an0,stmts') <- markAnnListA' an $ \a -> do
- r <- markAnnotatedWithLayout stmts
- return (a, r)
- return (an0, l, stmts')
- else return (an, l, stmts)
+ (an0,stmts') <- case an of
+ Left (o,c) -> do
+ o' <- markEpToken o
+ r <- markAnnotated stmts
+ c' <- markEpToken c
+ return (Left (o',c'), r)
+ Right an' -> do
+ (an'',r') <- markAnnListA' an' $ \a -> do
+ r <- markAnnotatedWithLayout stmts
+ return (a, r)
+ return (Right an'',r')
+ return ((an0, l), stmts')
+ else return ((an, l), stmts)
notDodgy :: GenLocated (EpAnn ann) a -> Bool
notDodgy (L (EpAnn anc _ _) _) = notDodgyE anc
@@ -3601,9 +3616,7 @@ instance ExactPrint (HsCmd GhcPs) where
exact (HsCmdDo (an0,loc) es) = do
debugM $ "HsCmdDo"
loc' <- printStringAtAA loc "do"
- (an1,es') <- markAnnList' an0 $ do
- ee <- markAnnotated es
- return ee
+ (an1,es') <- markAnnListD an0 $ do markAnnotated es
return (HsCmdDo (an1,loc') es')
-- ---------------------------------------------------------------------
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -343,7 +343,6 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
annListBracketsLocs :: AnnListBrackets -> (EpaLocation,EpaLocation)
annListBracketsLocs (ListBraces o c) = (getEpTokenLoc o, getEpTokenLoc c)
-annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c)
annListBracketsLocs ListNone = (noAnn, noAnn)
data SplitWhere = Before | After
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95d56c3329adb65eb345e3f22cf8d0…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95d56c3329adb65eb345e3f22cf8d0…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/fendor/26300] 55 commits: Add `rethrowSTM` and improve STM-related documentation
by Hannes Siebenhandl (@fendor) 14 Sep '26
by Hannes Siebenhandl (@fendor) 14 Sep '26
14 Sep '26
Hannes Siebenhandl pushed to branch wip/fendor/26300 at Glasgow Haskell Compiler / GHC
Commits:
d1d01fa5 by Wolfgang Jeltsch at 2026-08-27T13:17:59+03:00
Add `rethrowSTM` and improve STM-related documentation
Adding `rethrowSTM` resolves #26758.
The implementation of `rethrowSTM` is completely analogous to the one of
`rethrowIO`.
The following is established for the documentation of `throwSTM` and
`catchSTM`:
* Both operations are directly described as analogs of their `IO`
counterparts.
* There is no reference to `throw` in the documentation of `throwSTM`,
because, although such a reference is great in the documentation of
`throwIO`, it is somewhat out of place in the documentation of
`throwSTM`.
* Instead of repeating part of `throwIO`’s documentation, the
documentation of `throwSTM` just recommends using `throwSTM` instead
of `throw` and references the corresponding arguments in the
documentation of `throwIO`.
- - - - -
06fde293 by fendor at 2026-08-28T06:06:44-04:00
GHCi: Fix order of `PackageDBFlag`s for interactive home unit
`PackageDBFlag`s are stored in reverse order of cli specification.
When sorting the `PackageDBFlag`s by longest common prefix, we need thus
to reverse the package db stacks before calculating the prefix.
We make sure to reverse the package db stack for the interactive home
unit to uphold that later specified package dbs overwrite earlier ones.
Resolved and adds regression test for #27640
- - - - -
024c4d04 by fendor at 2026-08-28T06:07:23-04:00
Reuse the UnitIndexCache after initialising multiple home units
- - - - -
55326fa0 by Alan Zimmerman at 2026-08-28T06:08:03-04:00
EPA: Some Haddock processing tweaks
These changes to the Haddock postprocessing should not change
behaviour, but just bring it more closely in line with the
original, changed at 44309cd377f
And add some haddock exactprint tests to show they work.
- - - - -
b3ddee95 by Andreas Klebinger at 2026-08-28T13:57:46-04:00
hadrian: Deprecate quickest flavour.
It was more of a trap for new users than actually beneficial so we
deprecate it and suggest quick+no_dynamic_libs to users instead.
- - - - -
a1d81390 by Andreas Klebinger at 2026-08-28T13:58:37-04:00
cmm: Always favour entry block during block deduplication.
We now always keep the first block in the CmmGraph. This way we avoid
the need to update the entry info table.
Failing to do so caused #27722.
Fixes #27722.
- - - - -
5bd65f00 by Andreas Klebinger at 2026-08-28T13:59:16-04:00
test: FamAppCachePerf - Only collect bytes allocated. Fixes 27747
- - - - -
ced53ce6 by mangoiv at 2026-08-29T07:15:24-04:00
nightlies: output yaml to file only
Previously we would just output the metadata to stdout
which risks that it's clobbered by incidental debugt output.
We now output to file only.
Fixes #27511
- - - - -
578bd185 by Andreas Klebinger at 2026-08-29T07:16:05-04:00
Specialise: Stop looping on recursive dictionaries in interestingDict
interestingDict now doesn't look through loopbreaker unfoldings.
Doing so would cause infinite loops on certain dictionaries.
Fixes #27705.
- - - - -
7bf546fc by Simon Peyton Jones at 2026-08-31T23:48:53-04:00
Never make an absent filler for a constraint type
mkAbsentFiller used isTerminatingType to decide, but that is not enough.
Consider
class Eq a => UC a where {}
let u :: UC Int -- UC Int is a "non-terminating type"
u = error "Absent"
let e :: Eq Int -- Eq Int is a "terminating type"
e = $p1UC u
We clearly must not make a filler for `e`, because we speculatively
evaluate it. But speculatively evaluating `e` forces `u`, so we must not
make one for `u` either.
Asking isDictTy instead is not enough either, because it does not catch a
constraint hidden behind an unreduced type family application:
type family F a :: Constraint
type instance F W = TC W
a :: F W => Int -> Int -- (F W) argument is absent
Oops! Entered absent arg Arg: irred
Type: F W
So play safe and use isPredTy: never make an absent filler for any
constraint-kinded type.
Fixes #27627
- - - - -
5f474953 by Zubin Duggal at 2026-08-31T23:48:53-04:00
Add tests for absent fillers at dictionary types
T27627 a unary class whose superclass is a non-unary class
T27627a ...whose superclass is a Constraint-kinded type family
T27627b ...whose superclass is a quantified constraint
T27627c a unary class applied to itself, (UC (UC (TC a)))
T27627e a (forall b. P b) dictionary that loops
- - - - -
cd5c6bcc by Zubin Duggal at 2026-08-31T23:48:53-04:00
An abstract TyCon may hide a unary class
A class declared in an hs-boot file is an AbstractTyCon inside the
module loop, and compiling the real declaration may reveal it to be a
UnaryClassTyCon.
- isTerminatingType returned True for such AbstractTyCons
- IfaceToCore set the unary flag to False in the DFunId
So we could end up speculating bottom dictionaries because inside a module
loop we see an UnaryClassTyCon as an AbstractTyCon
Use isTerminatingTyCon, which returns False for an abstract TyCon.
The Bool in DFunId is now a cache for isTerminatingTyCon, set in
mkDFunIdDetails.
Fixes #27704
- - - - -
abfc224a by Zubin Duggal at 2026-08-31T23:48:53-04:00
Specialise: don't replace dead args with absent fillers
specHeader decides an argument is dead by calling isDeadBinder on a binder of
the /optimised RHS/, then applies the filler to the /stable unfolding/
template instead. The two may differ, so the argument can be dead in
the RHS and not in the template.
The specialised function's unfolding then has an absent filler, and any call
site that inlines it evaluates the error thunk.
Dropping dead args in the specialiser is rarely worth it, to quote Simon,
"The later worker/wrapper pass will pick up the dead arg later if it is really dead. Keeps the specialiser simpler."
So instead of trying to check if the arg really is dead in the stable unfolding,
just drop the logic for dropping dead args in the specialiser altogeher.
Fixes #27703
- - - - -
1557fd1c by Zubin Duggal at 2026-08-31T23:48:53-04:00
CorePrep: don't speculate a call across an hs-boot edge
We take care not to evaluate things that might be bottom, like a
looping dictionary group, but our analysis is defeated by boot files.
We only track recursion within a module, so two dictionaries that
depend on each other across a module loop each look non-recursive, and
we might speculate them.
Any recursion we cannot see must cross an hs-boot edge, so refuse to
speculate calls that cross one.
Fixes #27717
- - - - -
4117e5ae by Wolfgang Jeltsch at 2026-08-31T23:49:35-04:00
Incorporate the `rethrowSTM` reexport into the `stm` submodule
- - - - -
4bfbf5c8 by ARATA Mizuki at 2026-09-01T18:55:08-04:00
testsuite: Fix out-of-bounds access in T3586
unsafeRead and unsafeWrite use 0-based index.
Looking at #3586, the expected output seems to be 2.8e8.
Addresses #27596
- - - - -
3f9db6d4 by ARATA Mizuki at 2026-09-01T18:55:08-04:00
testsuite: Fix out-of-bounds access in T21305
writeInt64Array# takes an index measured in units of Int64 elements.
Fixes #27596
- - - - -
44d7788f by Simon Peyton Jones at 2026-09-01T18:55:53-04:00
Fix buglet in INLINE-arity calculation for pattern synonyms
This fixes #27744.
The buglet was accidentally introduced by
commit 3a0f9a51c1dacc474c7fd128082edd8bf4081256
Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com>
Date: Sat Aug 1 00:13:02 2026 +0100
Fix three bugs related to required type args and INLINE pragmas
I failed to find all the calls to `addInlinePragArity`!
- - - - -
df058f1d by Simon Jakobi at 2026-09-02T07:18:06-04:00
testsuite: Migrate perf tests off collect_compiler_stats('all')
The 'all' metric argument applies a single tolerance to bytes
allocated, max_bytes_used and peak_megabytes_allocated, although their
noise profiles are incompatible (#27653): allocations are nearly
deterministic, residency needs 10-20%, and peak is quantized to 1 MB.
Any single tolerance is too tight for one metric or too slack for
another. This migrates the remaining users of 'all' (and of the 'all'
default) to explicit per-metric collection, ahead of removing 'all'
from the driver.
peak_megabytes_allocated is dropped everywhere: its 1 MB granularity
makes tight relative windows meaningless (#27613), and it is sensitive
to GC timing. In #27489 it drifted by -5.3% while max_bytes_used moved
by less than 0.1%. Where a test guards a memory property,
max_bytes_used covers it at byte granularity.
Where the motivating ticket was about compile-time memory
(T11545, T15304, T26425), residency remains gated via max_bytes_used,
now with a residency-appropriate tolerance.
max_bytes_used is dropped where residency was only ever an accident of
'all':
* T15630, T15630a, T20261: the underlying tickets (#15630, #20261)
contain no memory data at all. One is a simplifier-ticks blowup and
the other is stated entirely in allocation numbers, so the 20%
window never had teeth.
* T21839c: #21839's measurements show residency essentially flat
(+0.16%) while allocations moved +7%, so allocations are the
discriminating metric. They are already gated at 1% via
collect_compiler_runtime. The ghc/max gate had previously broken CI
spuriously (9fd11585eb widened it from 1% to 10% for that reason).
Allocation tolerances are tightened to the testsuite's conventional 2%
where 'all' previously left them at 10-20%.
Assisted-by: Claude Fable 5
- - - - -
72dd2432 by Simon Jakobi at 2026-09-02T07:18:06-04:00
testsuite: Remove the 'all' metric argument of collect_stats
'all' gated bytes allocated, max_bytes_used and peak_megabytes_allocated
at a single tolerance, although their noise profiles are incompatible,
making such tests either flaky or toothless (#27653).
Closes #27653.
Assisted-by: Claude Fable 5
- - - - -
2228cb30 by Simon Jakobi at 2026-09-02T07:18:06-04:00
testsuite: Make the deviation argument of collect_stats mandatory
Almost every caller passes an explicit tolerance matched to the
metric's noise profile, and the silent 20% default is far slacker than
'bytes allocated' merits. Only two tests relied on it. They now state
their tolerance explicitly:
large-project gets 10%, in line with other large compile-time tests.
T9848 gets 2%: its metric is byte-for-byte deterministic across CI
jobs and platforms of a given test_env, has drifted only about 2.5%
since 2015, and the fusion failure it guards against would show up as
a roughly +30000% jump.
Assisted-by: Claude Fable 5
- - - - -
56291fc5 by Cheng Shao at 2026-09-02T07:18:45-04:00
autoconf/ghc-toolchain: bump llvm upper bound to support llvm 23
This commit bumps llvm upper bound to support llvm 23.
- - - - -
20eb3f41 by Cheng Shao at 2026-09-02T07:18:45-04:00
rts: fix compilation issues with clang 23
clang 23 has broadened `-Wall`/`-Wextra` ranges, exposing some minor
issues in the rts when building with validate flavours:
- Unused locals
- `#pragma GCC diagnostic pop` mismatch
This commit fixes those.
- - - - -
9e7739ab by Simon Jakobi at 2026-09-03T13:45:43-04:00
Add -Wimplicit-field-strictness (#16836)
This opt-in warning fires when a data constructor field lacks an
explicit strictness annotation (`!` or `~`). It complements the
LazyFieldAnnotations extension (4762a8bf30f) from GHC proposal 752,
which makes `~` annotations available for this purpose.
Deciding which fields to report requires their levity, so the check
runs after typechecking. To keep the noise down, the diagnostic is
emitted once per data declaration, grouped by constructor.
Closes #16836.
Assisted-by: Claude Fable 5
- - - - -
6a44d591 by mangoiv at 2026-09-03T13:46:22-04:00
simplifier: remove a bogus `assert` in `rebuild_app'` in `GHC.CoreToStg.Prep.cpeApp`.
Prior to this commit
commit 08bc245be70d95801bc1138804ed1de9474fbdc0
Author: sheaf <sam.derbyshire(a)gmail.com>
Date: Sat Feb 28 16:30:43 2026 +0100
Clean up join points, casts & ticks
This commit shores up the logic dealing with casts and ticks occurring
in between a join point binding and a jump
any `PlaceRuntime` ticks we observed were profiling ticks, even though that
isn't necessary.
The more liberal rules in the above commit allow e.g. breakpoint ticks
(which are valid PlaceRuntime ticks) to legitimately appear in an argument
position.
Fixes #27556
- - - - -
eaa95a6f by Andrei Borzenkov at 2026-09-04T08:08:40-04:00
Parentheses in prefix GADT constructors (#27423)
Updated `splitLHsGadtTy` to allow looking
through the parentheses for inner binders. General example
of a code pattern that's allowed now:
data S a where
MkS :: (forall a. S a)
That should work now with any combination of nested
foralls and parentheses.
We don't perform parenthesis unwrapping for record
GADT constructors in accordance with GHC Proposal #402.
To this end `con_inner_bndrs` no longer stores plain forall
telescopes: `[HsForAllTelescope pass]` is replaced with
`[LHsGadtTelescope pass]`, a new `HsArg`-style type whose
`HsGadtForAll` holds an inner telescope and whose `HsGadtPar`
holds a pair of parentheses. The parentheses carry no meaning
for renaming or type checking; the only reason to record them
is exact-printing.
Updated `pprConDecl` to improve the `parse == parse . ppr . parse`
property of GADT pretty-printing.
The pretty printer can now output code that's similar to this:
data T a where
MkT1 :: (forall a. T a)
MkT2 :: forall . forall a. T a
These are special cases of inner forall binders
for prefix GADT constructors, when we have either
implicit or zero explicit outer binders.
- - - - -
639456a8 by Evgeny Malyshev at 2026-09-04T08:09:25-04:00
HsPat: Add spacing to unary tuple patterns
Use hsep when printing unary boxed TuplePat applications so that the
MkSolo constructor is separated from its argument. The old hcat rendered
wildcard and parenthesized arguments as MkSolo_ and MkSolo().
Add T27034 to exercise the HsPat splice-dump path with wildcard and
variable arguments, and update existing affected golden output.
Fixes #27034
Assisted-By: OpenAI Codex
- - - - -
2908ab36 by Simon Jakobi at 2026-09-05T07:22:17-04:00
X86 NCG: use btr/bts/btc for single-bit operations
Previously the Cmm patterns
x & ~(1 << i)
x | (1 << i)
x ^ (1 << i)
compiled to mov/shl/not/and-style sequences of 3-4 instructions. Now
they compile to a single btr, bts or btc, matching what C compilers
produce.
When the bit index is a literal, constant folding has already collapsed
these patterns into ones with a literal mask, such as
x & 0xfffffeffffffffff for x & ~(1 << 40). Such masks are now also
compiled to a bit-test instruction when they don't fit in an imm32 and
would otherwise have to be loaded into a register first.
For a variable bit index, this applies only when the shift is unchecked
(uncheckedShiftL#, Data.Bits.unsafeShiftL): the bounds-checked shiftL
used by e.g. the default clearBit/setBit/complementBit implementations
wraps the shift in a bounds mask that this optimisation does not see
through. With a literal index, the bounds mask is constant-folded away,
so the checked operations benefit too.
See Note [Bit-test instructions] in GHC.CmmToAsm.X86.CodeGen.
Fixes #25233.
Assisted-by: Claude Fable 5
- - - - -
c673ecf0 by Simon Peyton Jones at 2026-09-05T07:22:59-04:00
Move HsStatic free-var test to typechecker
A `static` form should have no free *term* variables, but it
can have free *type* variables. Alas, the renamer does not really know what
is a term variable and what is a type variable, because of required type
arguments. This patch moves the test to the typechecker, which does know.
Addresses #27664
- - - - -
5939ceaf by sheaf at 2026-09-05T22:06:18-04:00
Windows: enforce path convention in ./configure
As detailed in Note [MSYS paths] in Hadrian.Utilities, the standing
convention (using Windows-style paths with forward slashes) is now
enforced in ./configure instead of within Hadrian, removing the need for
'cygpath' calls within Hadrian.
Fixes #26683
- - - - -
a6061455 by sheaf at 2026-09-05T22:06:18-04:00
Hadrian: introduce ExeSpawnPath
Specific details about the filepath used to specify the executable to
spawn with CreateProcess matters on Windows: whether we use forward or
backward slashes, a leading ./, or an absolute path changes how the
executable is found.
This commit introduces 'ExeSpawnPath' which is a path that is guaranteed
to be found when spawning a process. All command invocations now go
through this type to ensure the path has been properly sanitised.
See Note [NeedCurrentDirectoryForExePath] in Hadrian.Utilities.
The same treatment is applied to hsc2hs. Updates hsc2hs submodule.
- - - - -
e28313e3 by sheaf at 2026-09-05T22:07:06-04:00
Preserve tick ordering in 'tickTickedExpr'
'GHC.Core.Utils.tickTickedExpr' tries to combine a tick 't1' into an
existing stack of ticks 't2s'. There are two situations:
1. 't1' is subsumed by a tick in 't2s': drop it.
2. A tick in 't2s' is subsumed by 't1', say 't2'.
This commit ensures that in case (2) we keep 't1' on the outside instead
of replacing 't2' at its position in the stack. This avoids re-ordering
source notes (which was the cause of #27749).
This fixes a regression introduced in 2dadf3b0d05.
Fixes #27749
- - - - -
3172f557 by sheaf at 2026-09-05T22:07:06-04:00
Consistently prefer local source note ticks
GHC.Cmm.DebugBlock.cmmDebugGen (DWARF annotations) and
GHC.Stg.Debug.quickSourcePos (-finfo-table-map) both contained logic to
prioritise source note ticks from the current module.
This commit commons up this logic and propagates it to a third consumer:
IPE stack frames, in GHC.Driver.GenerateCgIPEStub.
See the new function GHC.Types.Tickish.bestSourceNote.
- - - - -
192be0b6 by Luite Stegeman at 2026-09-07T19:43:36-04:00
rts: fix ctoi_tuple_spill_words getting out of sync
Fix a few places that were not updating ctoi_tuple_spill_words
correctly, leading to corruption/crashes when dealing with large
unboxed tuples in bytecode:
- captureContinuationAndAbort
- findRetryFrameHelper/findAtomicallyFrameHelper
- interpretBCO bci_BRK_FUN
fixes #27633
- - - - -
604eb43c by Simon Jakobi at 2026-09-07T19:44:15-04:00
Hadrian: don't capture the testsuite driver's output (#27780)
a6061455d54 switched the Testsuite RunTest case from Shake's cmd to the
cmd' wrapper. cmd' always captures stdout and stderr, and since the
caller asks for Exit, it returns without dumping what it captured. As a
result the testsuite output no longer appears in CI job logs: failures,
performance metrics and the summary were lost with the job.
Use cmdExe, the uncaptured cmd, as the other plain-cmd sites in that
commit do.
Fixes #27780.
Assisted-by: Claude Fable 5.1
- - - - -
06eee015 by Luite Stegeman at 2026-09-08T06:03:06+02:00
rts: Fix missing memory barrier in eval_thunk_selector (#27477)
unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the
indirectee, leading to segfaults and corruption during GC on
weakly-ordered architectures.
Fixes #27477
- - - - -
f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00
EPA Fix HsCmdDo exact print with comments
Exact printing of HsCmdDo was ignoring the location for the do
statements, and this is an annotation that can have comments in it.
Update it so we print the statements as a unit, including any
comments.
Also add the result of auditing that we capture comments in all needed
places, noting that the remaining Anno SrcSpan instances are benign.
- - - - -
430967ab by Duncan Coutts at 2026-09-09T11:07:01+01:00
Reorder cmm decls in HeapStackCheck for a better logical grouping
And put more section headers in to deliniate the groups.
We're about to add more here, so better to organise it first.
- - - - -
344080fd by Duncan Coutts at 2026-09-09T11:07:01+01:00
Add raisePrimIOException and add it to RTS<->ghc-internal API
The raisePrimIOException is a new helper function that I/O primops will
use to help them report I/O errors. This is implemented in Haskell
(since that's a lot easier), but has a calling convention that is
easy(ish) to use from Cmm in the I/O primops.
So we add it to the RTS API struct, and since we'll use it from Cmm we
also need a field accessor macro for cmm (in deriveConstants).
See the Note about how we cannot have nice things due to async
exceptions and thunks preventing us from using catch.
- - - - -
cfdb3399 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Add new blocking functions for I/O primops
See the Note [Thread blocking for new I/O primops],
and the Note [Calling convention for raisePrimIOException].
The point is, it will allow us to report synchronous exceptions from I/O
primops, and do so much more flexibly.
Previously the I/O managers could only report async exceptions and only
nullary exceptions. This was OK historically, but no good as we add
more I/O managers and expand the range of I/O operations we support.
- - - - -
f09c09d8 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Change the encoding of results from the I/O manager to I/O primops
Previously we just had async continue or heap overflow.
We now extend what we can report with synchronous success, and
synchronous failure with an errno.
See Note [Encoding of result of I/O manager operations]
We don't use these two new cases yet, but we will. In particular an
epoll I/O manager needs to be able to report synchronous success or
failure for waitRead#/waitWrite#.
- - - - -
30f074d9 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Switch waitRead/Write# to use new blocking return frames
and update the I/O managers to set the result before resuming the
blocked threads.
This makes it possible for I/O managers to report synchronous exceptions
from the I/O primops, but that will be done in a subsequent commit.
- - - - -
a8786ced by Duncan Coutts at 2026-09-09T11:07:01+01:00
Switch Poll and Select I/O managers to report sync exceptions
rather than using raiseAsync with blockedOnBadFD_closure.
This uses the new mechanism in the blocking frame return code to report
synchronous exceptions.
- - - - -
7a9df79a by Duncan Coutts at 2026-09-09T11:07:01+01:00
Remove now-unused blockedOnBadFD
It was previously thrown by the select and poll I/O managers, but now
they use raisePrimIOException (with an EBADF errno).
- - - - -
6b0424e3 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Improve the docs for delay# waitRead# and waitWrite#
Document that the waitRead/Write# can throw exceptions (this was true
before too), and that all of them are async exception cancellation
points.
- - - - -
afeb2c30 by Duncan Coutts at 2026-09-09T20:08:58-04:00
Enable printf warnings for trace functions and fix resulting warnings
Most of the existing printf-style functions are annotated with
attributes to enable gcc/clang warnings for the printf format string,
but several trace functions in Trace.h were missing this annotation.
Enable them, and fix the resulting warnings.
- - - - -
9a442c93 by Alan Zimmerman at 2026-09-09T20:09:36-04:00
EPA: Exact print ConDeclGADT without custom enterAnn
!16321 brought in explicit capture of parens in a ConDeclGADT.
The ExactPrint update introduced a modification of the fundamental
function in exact printing, `enterAnn`, by splitting it into a version
allowing injection of functionality normally handled by the
ExactPrint class methods.
This commit refactors that code, to restore the prior `enterAnn`
version, by following the convention in ExactPrint of introducing a
helper data structure with its own `ExactPrint` instance to achieve
the same effect.
- - - - -
4e9297ea by Simon Jakobi at 2026-09-11T08:32:45-04:00
ci: Actually pass --ignore-perf-failures to the testsuite driver
684c0018d9 changed the IGNORE_PERF_FAILURES handling to append to
RUNTEST_ARGS with bash array syntax, but the three use sites still
expand RUNTEST_ARGS as a scalar, which yields only the first array
element. The appended flag was therefore dropped in every job, so
perf improvements kept failing Marge Bot batches and master pipelines,
contrary to #19562.
Append as a string instead, matching the existing --force-colors
append in test_hadrian.
Fixes #27563.
Assisted-by: Claude Fable 5.1
- - - - -
4f78dfdf by Simon Jakobi at 2026-09-11T08:33:24-04:00
testsuite: Give T26537 a 1.5x compile timeout
Its -fregs-graph compile step tends to time out in unoptimized builds
(#27188, #27776).
Assisted-by: Claude Fable 5.1
- - - - -
130286e3 by Alan Zimmerman at 2026-09-11T08:34:08-04:00
EPA: Remove ListBanana / ListParens from AnnListBrackets
This is a step towards making AnnList only represent
lists of items which can have either braces or layout.
- - - - -
a9827d13 by Simon Jakobi at 2026-09-11T18:53:32-04:00
Reject ~, UNPACK and multiplicity annotations on type data fields
Only `!` was rejected so far. `~`, UNPACK and multiplicity annotations
were silently accepted. None of them make sense at the type level, so
restriction (R3) of Note [Type data declarations] now covers all of
them.
Fixes #27732.
Assisted-by: Claude Fable 5.1
- - - - -
c71d5e23 by Alan Zimmerman at 2026-09-11T18:54:11-04:00
EPA: Add a Note for the exact print main loop
- - - - -
7a108e43 by Simon Jakobi at 2026-09-12T18:35:59-04:00
FastString: Drop mkFastStringWith's constructor callback
All three callers passed the same callback, a partial application of
mkNewFastStringShortByteString to the string being interned. That
partial application is allocated as a closure before the table lookup,
on the common hit path too, although the callback is needed only after
a miss.
Drop the parameter and call mkNewFastStringShortByteString directly
after a miss. Since nothing is passed "with" anymore, rename the
function to internSB.
Suggested by Simon PJ in #27528:
https://gitlab.haskell.org/ghc/ghc/-/work_items/27528#note_687031
Assisted-by: Claude Fable 5
- - - - -
82c73b22 by Alan Zimmerman at 2026-09-12T18:36:38-04:00
EPA: More targeted HsDo exact print annotation
HsDo is multi-purpose, as encoded in its HsDoFlavour field. Some of
these are in a layout context (DoExpr, MDoExpr), others are not
(ListComp, MonadComp).
We are moving towards using AnnList only in layout contexts, so we
switch the HsDo TTG annotation from holding an AnnList for this, to
holding
Either (EpToken "[", EpToken "]") AnnList
This also allows us to trim down AnnListBrackets to only have braces
or None, thereby opening the door for unification with the existing
layout context data type EpLayout.
- - - - -
c3540ef1 by fendor at 2026-09-14T09:12:45+02:00
Check external dependencies and home units for duplicates
- - - - -
342 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- + changelog.d/27556
- + changelog.d/27627
- + changelog.d/27703
- + changelog.d/27704
- + changelog.d/27717
- + changelog.d/27732
- changelog.d/T27202
- + changelog.d/T27705
- + changelog.d/T27722-cbe-entry-block.md
- + changelog.d/T27744
- + changelog.d/T27749
- + changelog.d/T27764
- + changelog.d/allow-gadt-prefix-con-parens
- + changelog.d/fix-parallel-gc-selector-race-27477
- + changelog.d/implicit-field-strictness-warning
- changelog.d/lazy-field-annotations
- + changelog.d/llvm-23
- + changelog.d/ncg-x86-bit-test-instructions
- + changelog.d/rethrow-stm
- changelog.d/unit-index
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/Cmm/DebugBlock.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Main/Compile.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Driver/Session/Units.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Extension/Pass.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Errors/Types.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Type.hs
- configure.ac
- docs/users_guide/exts/gadt_syntax.rst
- docs/users_guide/exts/strict.rst
- docs/users_guide/exts/type_data.rst
- docs/users_guide/using-warnings.rst
- ghc/GHCi/UI.hs
- hadrian/README.md
- hadrian/doc/cross-compile.md
- hadrian/doc/flavours.md
- hadrian/doc/make.md
- hadrian/doc/windows.md
- hadrian/hadrian.cabal
- hadrian/src/Base.hs
- hadrian/src/Builder.hs
- hadrian/src/CommandLine.hs
- hadrian/src/Flavour.hs
- hadrian/src/Hadrian/Builder.hs
- hadrian/src/Hadrian/Builder/Ar.hs
- hadrian/src/Hadrian/Oracles/Path.hs
- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Oracles/TestSettings.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/Changelog.hs
- hadrian/src/Rules/Codes.hs
- hadrian/src/Rules/Lint.hs
- hadrian/src/Rules/Nofib.hs
- hadrian/src/Rules/Test.hs
- hadrian/src/Settings.hs
- − hadrian/src/Settings/Flavours/Quickest.hs
- libraries/base/src/GHC/Conc.hs
- libraries/base/tests/all.T
- libraries/ghc-internal/include/RtsIfaceSymbols.h
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/stm
- m4/find_python.m4
- + m4/fp_canonicalise_win_path.m4
- m4/fp_find_nm.m4
- m4/fp_find_root.m4
- m4/fp_prog_ar.m4
- m4/fp_prog_ar_args.m4
- m4/fp_prog_sh.m4
- m4/fptools_alex.m4
- m4/fptools_happy.m4
- rts/Capability.c
- rts/Continuation.c
- rts/HeapStackCheck.cmm
- rts/IOManager.c
- rts/IOManager.h
- rts/IOManagerInternals.h
- rts/Interpreter.c
- rts/Messages.c
- rts/Prelude.h
- rts/PrimOps.cmm
- rts/Printer.c
- rts/ProfHeap.c
- rts/STM.c
- rts/Schedule.c
- rts/Sparks.c
- rts/StableName.c
- rts/ThreadPaused.c
- rts/Threads.c
- rts/Trace.h
- rts/eventlog/EventLog.c
- rts/include/rts/RtsToHsIface.h
- rts/include/stg/MiscClosures.h
- rts/posix/Poll.c
- rts/posix/Poll.h
- rts/posix/Select.c
- rts/posix/Timeout.c
- rts/prim/atomic.c
- rts/sm/Compact.c
- rts/sm/Evac.c
- rts/sm/GC.c
- rts/sm/GCUtils.c
- rts/sm/MBlock.c
- rts/sm/NonMoving.c
- rts/sm/NonMovingMark.c
- rts/sm/Storage.c
- rts/sm/Sweep.c
- testsuite/driver/README.md
- testsuite/driver/testlib.py
- + testsuite/tests/bytecode/T27633/Obj.hs
- + testsuite/tests/bytecode/T27633/T27633a.hs
- + testsuite/tests/bytecode/T27633/T27633a.stdout
- + testsuite/tests/bytecode/T27633/T27633b.hs
- + testsuite/tests/bytecode/T27633/T27633b.stdout
- + testsuite/tests/bytecode/T27633/all.T
- + testsuite/tests/codeGen/should_gen_asm/T25233.asm
- + testsuite/tests/codeGen/should_gen_asm/T25233.hs
- + testsuite/tests/codeGen/should_gen_asm/T25233b.asm
- + testsuite/tests/codeGen/should_gen_asm/T25233b.cmm
- testsuite/tests/codeGen/should_gen_asm/all.T
- testsuite/tests/codeGen/should_run/all.T
- + testsuite/tests/core-to-stg/T27627/Callee.hs
- + testsuite/tests/core-to-stg/T27627/Caller.hs
- + testsuite/tests/core-to-stg/T27627/Main.hs
- + testsuite/tests/core-to-stg/T27627/T27627.stdout
- + testsuite/tests/core-to-stg/T27627/all.T
- + testsuite/tests/core-to-stg/T27627a/Callee.hs
- + testsuite/tests/core-to-stg/T27627a/Caller.hs
- + testsuite/tests/core-to-stg/T27627a/Main.hs
- + testsuite/tests/core-to-stg/T27627a/T27627a.stdout
- + testsuite/tests/core-to-stg/T27627a/all.T
- + testsuite/tests/core-to-stg/T27627b/Callee.hs
- + testsuite/tests/core-to-stg/T27627b/Caller.hs
- + testsuite/tests/core-to-stg/T27627b/Main.hs
- + testsuite/tests/core-to-stg/T27627b/T27627b.stdout
- + testsuite/tests/core-to-stg/T27627b/all.T
- + testsuite/tests/core-to-stg/T27627c/Callee.hs
- + testsuite/tests/core-to-stg/T27627c/Caller.hs
- + testsuite/tests/core-to-stg/T27627c/Main.hs
- + testsuite/tests/core-to-stg/T27627c/T27627c.stdout
- + testsuite/tests/core-to-stg/T27627c/all.T
- + testsuite/tests/core-to-stg/T27627e.hs
- + testsuite/tests/core-to-stg/T27627e.stdout
- + testsuite/tests/core-to-stg/T27627f/Callee.hs
- + testsuite/tests/core-to-stg/T27627f/Caller.hs
- + testsuite/tests/core-to-stg/T27627f/Inst.hs
- + testsuite/tests/core-to-stg/T27627f/Main.hs
- + testsuite/tests/core-to-stg/T27627f/T27627f.stdout
- + testsuite/tests/core-to-stg/T27627f/all.T
- + testsuite/tests/core-to-stg/T27704/Callee.hs
- + testsuite/tests/core-to-stg/T27704/Callee.hs-boot
- + testsuite/tests/core-to-stg/T27704/Main.hs
- + testsuite/tests/core-to-stg/T27704/Mid.hs
- + testsuite/tests/core-to-stg/T27704/T27704.stdout
- + testsuite/tests/core-to-stg/T27704/all.T
- + testsuite/tests/core-to-stg/T27704a/Callee.hs
- + testsuite/tests/core-to-stg/T27704a/Callee.hs-boot
- + testsuite/tests/core-to-stg/T27704a/Main.hs
- + testsuite/tests/core-to-stg/T27704a/Mid.hs
- + testsuite/tests/core-to-stg/T27704a/T27704a.stdout
- + testsuite/tests/core-to-stg/T27704a/all.T
- + testsuite/tests/core-to-stg/T27717/Callee.hs
- + testsuite/tests/core-to-stg/T27717/Callee.hs-boot
- + testsuite/tests/core-to-stg/T27717/Main.hs
- + testsuite/tests/core-to-stg/T27717/Mid.hs
- + testsuite/tests/core-to-stg/T27717/T27717.stdout
- + testsuite/tests/core-to-stg/T27717/Ty.hs
- + testsuite/tests/core-to-stg/T27717/all.T
- testsuite/tests/core-to-stg/all.T
- testsuite/tests/ffi/should_run/T21305.hs
- − testsuite/tests/gadt/T14320.stderr
- testsuite/tests/gadt/T18191.hs
- testsuite/tests/gadt/T18191.stderr
- + testsuite/tests/gadt/T27423a.hs
- + testsuite/tests/gadt/T27423b.hs
- + testsuite/tests/gadt/T27423b.stderr
- testsuite/tests/gadt/all.T
- testsuite/tests/ghc-api/T25121_status.stdout
- + testsuite/tests/ghci.debugger/scripts/T27633c.hs
- + testsuite/tests/ghci.debugger/scripts/T27633c.script
- + testsuite/tests/ghci.debugger/scripts/T27633c.stdout
- + testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs
- testsuite/tests/ghci.debugger/scripts/all.T
- + testsuite/tests/ghci/T26300/Makefile
- + testsuite/tests/ghci/T26300/T26300.script
- + testsuite/tests/ghci/T26300/T26300.stderr
- + testsuite/tests/ghci/T26300/T26300.stdout
- + testsuite/tests/ghci/T26300/a/Main.hs
- + testsuite/tests/ghci/T26300/all.T
- + testsuite/tests/ghci/T26300/b/Bar.hs
- + testsuite/tests/ghci/T26300/b/Data/List.hs
- + testsuite/tests/ghci/T26300/c/Bar.hs
- + testsuite/tests/ghci/T26300/unitA
- + testsuite/tests/ghci/T26300/unitB
- + testsuite/tests/ghci/T26300/unitC
- + testsuite/tests/ghci/prog-mhu007/Makefile
- + testsuite/tests/ghci/prog-mhu007/a/A.hs
- + testsuite/tests/ghci/prog-mhu007/all.T
- + testsuite/tests/ghci/prog-mhu007/b/B.hs
- + testsuite/tests/ghci/prog-mhu007/prog-mhu007.script
- + testsuite/tests/ghci/prog-mhu007/prog-mhu007.stdout
- + testsuite/tests/ghci/prog-mhu007/testpkg-bar/Bar.hs
- + testsuite/tests/ghci/prog-mhu007/testpkg-bar/testpkg-bar.pkg
- + testsuite/tests/ghci/prog-mhu007/testpkg-foo/Foo.hs
- + testsuite/tests/ghci/prog-mhu007/testpkg-foo/testpkg-foo.pkg
- + testsuite/tests/ghci/prog-mhu007/unitA
- + testsuite/tests/ghci/prog-mhu007/unitB
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- + testsuite/tests/patsyn/should_compile/T27744.hs
- testsuite/tests/patsyn/should_compile/all.T
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/perf/compiler/large-project/all.T
- testsuite/tests/perf/should_run/T3586.hs
- testsuite/tests/perf/should_run/T3586.stdout
- testsuite/tests/perf/space_leaks/all.T
- + testsuite/tests/printer/Haddock1.hs
- testsuite/tests/printer/Makefile
- + testsuite/tests/printer/T27423c.hs
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/all.T
- testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr
- testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr
- testsuite/tests/rename/should_fail/T26545.stderr
- + testsuite/tests/rts/T27477.hs
- + testsuite/tests/rts/T27477.stdout
- testsuite/tests/rts/all.T
- testsuite/tests/simplCore/should_compile/T17966.stderr
- + testsuite/tests/simplCore/should_compile/T27556.hs
- + testsuite/tests/simplCore/should_compile/T27556.script
- + testsuite/tests/simplCore/should_compile/T27749.hs
- + testsuite/tests/simplCore/should_compile/T27749.stderr
- testsuite/tests/simplCore/should_compile/T7785.stderr
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplCore/should_compile/spec004.hs
- testsuite/tests/simplCore/should_compile/spec004.stderr
- + testsuite/tests/simplCore/should_run/T27703/Lib.hs
- + testsuite/tests/simplCore/should_run/T27703/Main.hs
- + testsuite/tests/simplCore/should_run/T27703/T27703.stdout
- + testsuite/tests/simplCore/should_run/T27703/all.T
- + testsuite/tests/simplCore/should_run/T27705.hs
- + testsuite/tests/simplCore/should_run/T27705.stdout
- + testsuite/tests/simplCore/should_run/T27705_Inst.hs
- testsuite/tests/simplCore/should_run/all.T
- testsuite/tests/th/T17380.stderr
- testsuite/tests/th/T18612.stderr
- + testsuite/tests/th/T27034.hs
- + testsuite/tests/th/T27034.stderr
- testsuite/tests/th/T8761.stderr
- testsuite/tests/th/all.T
- + testsuite/tests/type-data/should_fail/T27732a.hs
- + testsuite/tests/type-data/should_fail/T27732a.stderr
- + testsuite/tests/type-data/should_fail/T27732b.hs
- + testsuite/tests/type-data/should_fail/T27732b.stderr
- + testsuite/tests/type-data/should_fail/T27732c.hs
- + testsuite/tests/type-data/should_fail/T27732c.stderr
- + testsuite/tests/type-data/should_fail/T27732d.hs
- + testsuite/tests/type-data/should_fail/T27732d.stderr
- + testsuite/tests/type-data/should_fail/T27732e.hs
- + testsuite/tests/type-data/should_fail/T27732e.stderr
- + testsuite/tests/type-data/should_fail/T27732f.hs
- + testsuite/tests/type-data/should_fail/T27732f.stderr
- testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr
- testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr
- testsuite/tests/type-data/should_fail/all.T
- + testsuite/tests/typecheck/should_compile/T27664.hs
- testsuite/tests/typecheck/should_compile/all.T
- + testsuite/tests/warnings/should_compile/T16836a.hs
- + testsuite/tests/warnings/should_compile/T16836a.stderr
- + testsuite/tests/warnings/should_compile/T16836b.hs
- + testsuite/tests/warnings/should_compile/T16836c.hs
- + testsuite/tests/warnings/should_compile/T16836c.stderr
- + testsuite/tests/warnings/should_compile/T16836d.hs
- + testsuite/tests/warnings/should_compile/T16836d.stderr
- testsuite/tests/warnings/should_compile/all.T
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Utils.hs
- utils/deriveConstants/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/hsc2hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1050936cb97c34f77c42a050d3158…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1050936cb97c34f77c42a050d3158…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0