Cheng Shao pushed to branch wip/split-sections-scc at Glasgow Haskell Compiler / GHC
Commits:
91edd292 by Wolfgang Jeltsch at 2025-12-19T03:18:19-05:00
Remove unused known-key and name variables for generics
This removes the known-key and corresponding name variables for `K1`,
`M1`, `R`, `D`, `C`, `S`, and `URec` from `GHC.Generics`, as they are
apparently nowhere used in GHC’s source code.
- - - - -
73ee7e38 by Wolfgang Jeltsch at 2025-12-19T03:19:02-05:00
Remove unused known keys and names for generics classes
This removes the known-key and corresponding name variables for
`Datatype`, `Constructor`, and `Selector` from `GHC.Generics`, as they
are apparently nowhere used in GHC’s source code.
- - - - -
f69c5f14 by Cheng Shao at 2025-12-19T03:19:45-05:00
wasm: fix handling of ByteArray#/MutableByteArray# arguments in JSFFI imports
This patch fixes the handling of ByteArray#/MutableByteArray#
arguments in JSFFI imports, see the amended note and manual for
explanation. Also adds a test to witness the fix.
Co-authored-by: Codex
- - - - -
224446a2 by Cheng Shao at 2025-12-20T07:49:54-05:00
rts: workaround -Werror=maybe-uninitialized false positives
In some cases gcc might report -Werror=maybe-uninitialized that we
know are false positives, but need to workaround it to make validate
builds with -Werror pass.
- - - - -
251ec087 by Cheng Shao at 2025-12-20T07:49:54-05:00
hadrian: use -Og as C/C++ optimization level when debugging
This commit enables -Og as optimization level when compiling the debug
ways of rts. According to gcc documentation
(https://gcc.gnu.org/onlinedocs/gcc/Optimize-Options.html#index-Og),
-Og is a better choice than -O0 for producing debuggable code. It's
also supported by clang as well, so it makes sense to use it as a
default for debugging. Also add missing -g3 flag to C++ compilation
flags in +debug_info flavour transformer.
- - - - -
fb586c67 by Cheng Shao at 2025-12-20T07:50:36-05:00
compiler: replace DList with OrdList
This patch removes `DList` logic from the compiler and replaces it
with `OrdList` which also supports O(1) concatenation and should be
more memory efficient than the church-encoded `DList`.
- - - - -
8149c987 by Cheng Shao at 2025-12-20T17:06:51-05:00
hadrian: add with_profiled_libs flavour transformer
This patch adds a `with_profiled_libs` flavour transformer to hadrian
which is the exact opposite of `no_profiled_libs`. It adds profiling
ways to stage1+ rts/library ways, and doesn't alter other flavour
settings. It is useful when needing to test profiling logic locally
with a quick flavour.
- - - - -
746b18cd by Cheng Shao at 2025-12-20T17:06:51-05:00
hadrian: fix missing profiled dynamic libraries in profiled_ghc
This commit fixes the profiled_ghc flavour transformer to include
profiled dynamic libraries as well, since they're supported by GHC
since !12595.
- - - - -
4dd7e3b9 by Cheng Shao at 2025-12-20T17:07:33-05:00
ci: set http.postBuffer to mitigate perf notes timeout on some runners
This patch sets http.postBuffer to mitigate the timeout when fetching
perf notes on some runners with slow internet connection. Fixes #26684.
- - - - -
bc36268a by Wolfgang Jeltsch at 2025-12-21T16:23:24-05:00
Remove unused known keys and names for type representations
This removes the known-key and corresponding name variables for
`TrName`, `TrNameD`, `TypeRep`, `KindRepTypeLitD`, `TypeLitSort`, and
`mkTrType`, as they are apparently nowhere used in GHC’s source code.
- - - - -
ff5050e9 by Wolfgang Jeltsch at 2025-12-21T16:24:04-05:00
Remove unused known keys and names for natural operations
This removes the known-key and corresponding name variables for
`naturalAndNot`, `naturalLog2`, `naturalLogBaseWord`, `naturalLogBase`,
`naturalPowMod`, `naturalSizeInBase`, `naturalToFloat`, and
`naturalToDouble`, as they are apparently nowhere used in GHC’s source
code.
- - - - -
424388c2 by Wolfgang Jeltsch at 2025-12-21T16:24:45-05:00
Remove the unused known key and name for `Fingerprint`
This removes the variables for the known key and the name of the
`Fingerprint` data constructor, as they are apparently nowhere used in
GHC’s source code.
- - - - -
a1ed86fe by Wolfgang Jeltsch at 2025-12-21T16:25:26-05:00
Remove the unused known key and name for `failIO`
This removes the variables for the known key and the name of the
`failIO` operation, as they are apparently nowhere used in GHC’s source
code.
- - - - -
b8220daf by Wolfgang Jeltsch at 2025-12-21T16:26:07-05:00
Remove the unused known key and name for `liftM`
This removes the variables for the known key and the name of the `liftM`
operation, as they are apparently nowhere used in GHC’s source code.
- - - - -
eb0628b1 by Wolfgang Jeltsch at 2025-12-21T16:26:47-05:00
Fix the documentation of `hIsClosed`
- - - - -
972a2c8e by Cheng Shao at 2025-12-22T09:34:14+01:00
WIP
- - - - -
18 changed files:
- .gitlab/ci.sh
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/CmmToAsm.hs
- compiler/GHC/HsToCore/Foreign/Wasm.hs
- compiler/GHC/Parser/String.hs
- compiler/GHC/StgToCmm/InfoTableProv.hs
- docs/users_guide/wasm.rst
- hadrian/doc/flavours.md
- hadrian/src/Flavour.hs
- hadrian/src/Settings/Packages.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- rts/linker/InitFini.c
- rts/sm/Sanity.c
- testsuite/tests/jsffi/all.T
- + testsuite/tests/jsffi/bytearrayarg.hs
- + testsuite/tests/jsffi/bytearrayarg.mjs
- + testsuite/tests/jsffi/bytearrayarg.stdout
- testsuite/tests/perf/should_run/all.T
Changes:
=====================================
.gitlab/ci.sh
=====================================
@@ -265,6 +265,15 @@ function setup() {
# testsuite driver!
git config gc.auto 0
+ # Some runners still choke at the perf note fetch step, which has to
+ # do with slow internet connection, see
+ # https://docs.gitlab.com/topics/git/troubleshooting_git/#error-stream-0-was-n...
+ # for the http.postBuffer mitigation. It might seem
+ # counter-intuitive that "post buffer" helps with fetching, but git
+ # indeed issues post requests when fetching over https, it's a
+ # bidirectional negotiation with the remote.
+ git config http.postBuffer 52428800
+
info "====================================================="
info "Toolchain versions"
info "====================================================="
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -222,12 +222,11 @@ basicKnownKeyNames
-- Type representation types
trModuleTyConName, trModuleDataConName,
- trNameTyConName, trNameSDataConName, trNameDDataConName,
+ trNameSDataConName,
trTyConTyConName, trTyConDataConName,
-- Typeable
typeableClassName,
- typeRepTyConName,
someTypeRepTyConName,
someTypeRepDataConName,
kindRepTyConName,
@@ -237,13 +236,10 @@ basicKnownKeyNames
kindRepFunDataConName,
kindRepTYPEDataConName,
kindRepTypeLitSDataConName,
- kindRepTypeLitDDataConName,
- typeLitSortTyConName,
typeLitSymbolDataConName,
typeLitNatDataConName,
typeLitCharDataConName,
typeRepIdName,
- mkTrTypeName,
mkTrConName,
mkTrAppCheckedName,
mkTrFunName,
@@ -296,7 +292,7 @@ basicKnownKeyNames
fmapName,
-- Monad stuff
- thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName,
+ thenIOName, bindIOName, returnIOName, bindMName, thenMName,
returnMName, joinMName,
-- MonadFail
@@ -409,26 +405,18 @@ basicKnownKeyNames
naturalQuotName,
naturalRemName,
naturalAndName,
- naturalAndNotName,
naturalOrName,
naturalXorName,
naturalTestBitName,
naturalBitName,
naturalGcdName,
naturalLcmName,
- naturalLog2Name,
- naturalLogBaseWordName,
- naturalLogBaseName,
- naturalPowModName,
- naturalSizeInBaseName,
bignatEqName,
-- Float/Double
integerToFloatName,
integerToDoubleName,
- naturalToFloatName,
- naturalToDoubleName,
rationalToFloatName,
rationalToDoubleName,
@@ -476,11 +464,9 @@ basicKnownKeyNames
-- Generics
, genClassName, gen1ClassName
- , datatypeClassName, constructorClassName, selectorClassName
-- Monad comprehensions
, guardMName
- , liftMName
, mzipName
-- GHCi Sandbox
@@ -492,9 +478,6 @@ basicKnownKeyNames
, staticPtrDataConName, staticPtrInfoDataConName
, fromStaticPtrName
- -- Fingerprint
- , fingerprintDataConName
-
-- Custom type errors
, errorMessageTypeErrorFamName
, typeErrorTextDataConName
@@ -517,12 +500,9 @@ basicKnownKeyNames
genericTyConNames :: [Name]
genericTyConNames = [
- v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
- k1TyConName, m1TyConName, sumTyConName, prodTyConName,
- compTyConName, rTyConName, dTyConName,
- cTyConName, sTyConName, rec0TyConName,
- d1TyConName, c1TyConName, s1TyConName,
- repTyConName, rep1TyConName, uRecTyConName,
+ v1TyConName, u1TyConName, par1TyConName, rec1TyConName, sumTyConName,
+ prodTyConName, compTyConName, rec0TyConName, d1TyConName, c1TyConName,
+ s1TyConName, repTyConName, rep1TyConName,
uAddrTyConName, uCharTyConName, uDoubleTyConName,
uFloatTyConName, uIntTyConName, uWordTyConName,
prefixIDataConName, infixIDataConName, leftAssociativeDataConName,
@@ -939,11 +919,8 @@ voidTyConName = tcQual gHC_INTERNAL_BASE (fsLit "Void") voidTyConKey
-- Generics (types)
v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
- k1TyConName, m1TyConName, sumTyConName, prodTyConName,
- compTyConName, rTyConName, dTyConName,
- cTyConName, sTyConName, rec0TyConName,
- d1TyConName, c1TyConName, s1TyConName,
- repTyConName, rep1TyConName, uRecTyConName,
+ sumTyConName, prodTyConName, compTyConName, rec0TyConName, d1TyConName,
+ c1TyConName, s1TyConName, repTyConName, rep1TyConName,
uAddrTyConName, uCharTyConName, uDoubleTyConName,
uFloatTyConName, uIntTyConName, uWordTyConName,
prefixIDataConName, infixIDataConName, leftAssociativeDataConName,
@@ -958,18 +935,11 @@ v1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "V1") v1TyConKey
u1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "U1") u1TyConKey
par1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Par1") par1TyConKey
rec1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rec1") rec1TyConKey
-k1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "K1") k1TyConKey
-m1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "M1") m1TyConKey
sumTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit ":+:") sumTyConKey
prodTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit ":*:") prodTyConKey
compTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit ":.:") compTyConKey
-rTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "R") rTyConKey
-dTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "D") dTyConKey
-cTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "C") cTyConKey
-sTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "S") sTyConKey
-
rec0TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rec0") rec0TyConKey
d1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "D1") d1TyConKey
c1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "C1") c1TyConKey
@@ -978,7 +948,6 @@ s1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "S1") s1TyConKey
repTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rep") repTyConKey
rep1TyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "Rep1") rep1TyConKey
-uRecTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "URec") uRecTyConKey
uAddrTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "UAddr") uAddrTyConKey
uCharTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "UChar") uCharTyConKey
uDoubleTyConName = tcQual gHC_INTERNAL_GENERICS (fsLit "UDouble") uDoubleTyConKey
@@ -1169,18 +1138,12 @@ integerFromNaturalName
, naturalQuotName
, naturalRemName
, naturalAndName
- , naturalAndNotName
, naturalOrName
, naturalXorName
, naturalTestBitName
, naturalBitName
, naturalGcdName
, naturalLcmName
- , naturalLog2Name
- , naturalLogBaseWordName
- , naturalLogBaseName
- , naturalPowModName
- , naturalSizeInBaseName
, bignatEqName
, bignatCompareName
, bignatCompareWordName
@@ -1209,18 +1172,12 @@ naturalQuotRemName = bnnVarQual "naturalQuotRem#" naturalQuotRe
naturalQuotName = bnnVarQual "naturalQuot" naturalQuotIdKey
naturalRemName = bnnVarQual "naturalRem" naturalRemIdKey
naturalAndName = bnnVarQual "naturalAnd" naturalAndIdKey
-naturalAndNotName = bnnVarQual "naturalAndNot" naturalAndNotIdKey
naturalOrName = bnnVarQual "naturalOr" naturalOrIdKey
naturalXorName = bnnVarQual "naturalXor" naturalXorIdKey
naturalTestBitName = bnnVarQual "naturalTestBit#" naturalTestBitIdKey
naturalBitName = bnnVarQual "naturalBit#" naturalBitIdKey
naturalGcdName = bnnVarQual "naturalGcd" naturalGcdIdKey
naturalLcmName = bnnVarQual "naturalLcm" naturalLcmIdKey
-naturalLog2Name = bnnVarQual "naturalLog2#" naturalLog2IdKey
-naturalLogBaseWordName = bnnVarQual "naturalLogBaseWord#" naturalLogBaseWordIdKey
-naturalLogBaseName = bnnVarQual "naturalLogBase#" naturalLogBaseIdKey
-naturalPowModName = bnnVarQual "naturalPowMod" naturalPowModIdKey
-naturalSizeInBaseName = bnnVarQual "naturalSizeInBase#" naturalSizeInBaseIdKey
integerFromNaturalName = bniVarQual "integerFromNatural" integerFromNaturalIdKey
integerToNaturalClampName = bniVarQual "integerToNaturalClamp" integerToNaturalClampIdKey
@@ -1291,12 +1248,9 @@ realFloatClassName = clsQual gHC_INTERNAL_FLOAT (fsLit "RealFloat") realFloatCla
-- other GHC.Internal.Float functions
integerToFloatName, integerToDoubleName,
- naturalToFloatName, naturalToDoubleName,
rationalToFloatName, rationalToDoubleName :: Name
integerToFloatName = varQual gHC_INTERNAL_FLOAT (fsLit "integerToFloat#") integerToFloatIdKey
integerToDoubleName = varQual gHC_INTERNAL_FLOAT (fsLit "integerToDouble#") integerToDoubleIdKey
-naturalToFloatName = varQual gHC_INTERNAL_FLOAT (fsLit "naturalToFloat#") naturalToFloatIdKey
-naturalToDoubleName = varQual gHC_INTERNAL_FLOAT (fsLit "naturalToDouble#") naturalToDoubleIdKey
rationalToFloatName = varQual gHC_INTERNAL_FLOAT (fsLit "rationalToFloat") rationalToFloatIdKey
rationalToDoubleName = varQual gHC_INTERNAL_FLOAT (fsLit "rationalToDouble") rationalToDoubleIdKey
@@ -1307,17 +1261,13 @@ ixClassName = clsQual gHC_INTERNAL_IX (fsLit "Ix") ixClassKey
-- Typeable representation types
trModuleTyConName
, trModuleDataConName
- , trNameTyConName
, trNameSDataConName
- , trNameDDataConName
, trTyConTyConName
, trTyConDataConName
:: Name
trModuleTyConName = tcQual gHC_TYPES (fsLit "Module") trModuleTyConKey
trModuleDataConName = dcQual gHC_TYPES (fsLit "Module") trModuleDataConKey
-trNameTyConName = tcQual gHC_TYPES (fsLit "TrName") trNameTyConKey
trNameSDataConName = dcQual gHC_TYPES (fsLit "TrNameS") trNameSDataConKey
-trNameDDataConName = dcQual gHC_TYPES (fsLit "TrNameD") trNameDDataConKey
trTyConTyConName = tcQual gHC_TYPES (fsLit "TyCon") trTyConTyConKey
trTyConDataConName = dcQual gHC_TYPES (fsLit "TyCon") trTyConDataConKey
@@ -1328,7 +1278,6 @@ kindRepTyConName
, kindRepFunDataConName
, kindRepTYPEDataConName
, kindRepTypeLitSDataConName
- , kindRepTypeLitDDataConName
:: Name
kindRepTyConName = tcQual gHC_TYPES (fsLit "KindRep") kindRepTyConKey
kindRepTyConAppDataConName = dcQual gHC_TYPES (fsLit "KindRepTyConApp") kindRepTyConAppDataConKey
@@ -1337,24 +1286,19 @@ kindRepAppDataConName = dcQual gHC_TYPES (fsLit "KindRepApp") kindR
kindRepFunDataConName = dcQual gHC_TYPES (fsLit "KindRepFun") kindRepFunDataConKey
kindRepTYPEDataConName = dcQual gHC_TYPES (fsLit "KindRepTYPE") kindRepTYPEDataConKey
kindRepTypeLitSDataConName = dcQual gHC_TYPES (fsLit "KindRepTypeLitS") kindRepTypeLitSDataConKey
-kindRepTypeLitDDataConName = dcQual gHC_TYPES (fsLit "KindRepTypeLitD") kindRepTypeLitDDataConKey
-typeLitSortTyConName
- , typeLitSymbolDataConName
+typeLitSymbolDataConName
, typeLitNatDataConName
, typeLitCharDataConName
:: Name
-typeLitSortTyConName = tcQual gHC_TYPES (fsLit "TypeLitSort") typeLitSortTyConKey
typeLitSymbolDataConName = dcQual gHC_TYPES (fsLit "TypeLitSymbol") typeLitSymbolDataConKey
typeLitNatDataConName = dcQual gHC_TYPES (fsLit "TypeLitNat") typeLitNatDataConKey
typeLitCharDataConName = dcQual gHC_TYPES (fsLit "TypeLitChar") typeLitCharDataConKey
-- Class Typeable, and functions for constructing `Typeable` dictionaries
typeableClassName
- , typeRepTyConName
, someTypeRepTyConName
, someTypeRepDataConName
- , mkTrTypeName
, mkTrConName
, mkTrAppCheckedName
, mkTrFunName
@@ -1365,11 +1309,9 @@ typeableClassName
, trGhcPrimModuleName
:: Name
typeableClassName = clsQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "Typeable") typeableClassKey
-typeRepTyConName = tcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "TypeRep") typeRepTyConKey
someTypeRepTyConName = tcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepTyConKey
someTypeRepDataConName = dcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepDataConKey
typeRepIdName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeRep#") typeRepIdKey
-mkTrTypeName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrType") mkTrTypeKey
mkTrConName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrCon") mkTrConKey
mkTrAppCheckedName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrAppChecked") mkTrAppCheckedKey
mkTrFunName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrFun") mkTrFunKey
@@ -1494,15 +1436,10 @@ readClassName :: Name
readClassName = clsQual gHC_INTERNAL_READ (fsLit "Read") readClassKey
-- Classes Generic and Generic1, Datatype, Constructor and Selector
-genClassName, gen1ClassName, datatypeClassName, constructorClassName,
- selectorClassName :: Name
+genClassName, gen1ClassName :: Name
genClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Generic") genClassKey
gen1ClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Generic1") gen1ClassKey
-datatypeClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Datatype") datatypeClassKey
-constructorClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Constructor") constructorClassKey
-selectorClassName = clsQual gHC_INTERNAL_GENERICS (fsLit "Selector") selectorClassKey
-
genericClassNames :: [Name]
genericClassNames = [genClassName, gen1ClassName]
@@ -1513,13 +1450,12 @@ ghciStepIoMName = varQual gHC_INTERNAL_GHCI (fsLit "ghciStepIO") ghciStepIoMClas
-- IO things
ioTyConName, ioDataConName,
- thenIOName, bindIOName, returnIOName, failIOName :: Name
+ thenIOName, bindIOName, returnIOName :: Name
ioTyConName = tcQual gHC_TYPES (fsLit "IO") ioTyConKey
ioDataConName = dcQual gHC_TYPES (fsLit "IO") ioDataConKey
thenIOName = varQual gHC_INTERNAL_BASE (fsLit "thenIO") thenIOIdKey
bindIOName = varQual gHC_INTERNAL_BASE (fsLit "bindIO") bindIOIdKey
returnIOName = varQual gHC_INTERNAL_BASE (fsLit "returnIO") returnIOIdKey
-failIOName = varQual gHC_INTERNAL_IO (fsLit "failIO") failIOIdKey
-- IO things
printName :: Name
@@ -1564,9 +1500,8 @@ choiceAName = varQual gHC_INTERNAL_ARROW (fsLit "|||") choiceAIdKey
loopAName = varQual gHC_INTERNAL_ARROW (fsLit "loop") loopAIdKey
-- Monad comprehensions
-guardMName, liftMName, mzipName :: Name
+guardMName, mzipName :: Name
guardMName = varQual gHC_INTERNAL_MONAD (fsLit "guard") guardMIdKey
-liftMName = varQual gHC_INTERNAL_MONAD (fsLit "liftM") liftMIdKey
mzipName = varQual gHC_INTERNAL_CONTROL_MONAD_ZIP (fsLit "mzip") mzipIdKey
@@ -1654,10 +1589,6 @@ fromStaticPtrName :: Name
fromStaticPtrName =
varQual gHC_INTERNAL_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey
-fingerprintDataConName :: Name
-fingerprintDataConName =
- dcQual gHC_INTERNAL_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey
-
constPtrConName :: Name
constPtrConName =
tcQual gHC_INTERNAL_FOREIGN_C_CONSTPTR (fsLit "ConstPtr") constPtrTyConKey
@@ -1753,15 +1684,10 @@ applicativeClassKey = mkPreludeClassUnique 34
foldableClassKey = mkPreludeClassUnique 35
traversableClassKey = mkPreludeClassUnique 36
-genClassKey, gen1ClassKey, datatypeClassKey, constructorClassKey,
- selectorClassKey :: Unique
+genClassKey, gen1ClassKey :: Unique
genClassKey = mkPreludeClassUnique 37
gen1ClassKey = mkPreludeClassUnique 38
-datatypeClassKey = mkPreludeClassUnique 39
-constructorClassKey = mkPreludeClassUnique 40
-selectorClassKey = mkPreludeClassUnique 41
-
-- KnownNat: see Note [KnownNat & KnownSymbol and EvLit] in GHC.Tc.Instance.Class
knownNatClassNameKey :: Unique
knownNatClassNameKey = mkPreludeClassUnique 42
@@ -1940,21 +1866,16 @@ pluginTyConKey, frontendPluginTyConKey :: Unique
pluginTyConKey = mkPreludeTyConUnique 102
frontendPluginTyConKey = mkPreludeTyConUnique 103
-trTyConTyConKey, trModuleTyConKey, trNameTyConKey,
- kindRepTyConKey, typeLitSortTyConKey :: Unique
+trTyConTyConKey, trModuleTyConKey,
+ kindRepTyConKey :: Unique
trTyConTyConKey = mkPreludeTyConUnique 104
trModuleTyConKey = mkPreludeTyConUnique 105
-trNameTyConKey = mkPreludeTyConUnique 106
kindRepTyConKey = mkPreludeTyConUnique 107
-typeLitSortTyConKey = mkPreludeTyConUnique 108
-- Generics (Unique keys)
v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey,
- k1TyConKey, m1TyConKey, sumTyConKey, prodTyConKey,
- compTyConKey, rTyConKey, dTyConKey,
- cTyConKey, sTyConKey, rec0TyConKey,
- d1TyConKey, c1TyConKey, s1TyConKey,
- repTyConKey, rep1TyConKey, uRecTyConKey,
+ sumTyConKey, prodTyConKey, compTyConKey, rec0TyConKey,
+ d1TyConKey, c1TyConKey, s1TyConKey, repTyConKey, rep1TyConKey,
uAddrTyConKey, uCharTyConKey, uDoubleTyConKey,
uFloatTyConKey, uIntTyConKey, uWordTyConKey :: Unique
@@ -1962,18 +1883,11 @@ v1TyConKey = mkPreludeTyConUnique 135
u1TyConKey = mkPreludeTyConUnique 136
par1TyConKey = mkPreludeTyConUnique 137
rec1TyConKey = mkPreludeTyConUnique 138
-k1TyConKey = mkPreludeTyConUnique 139
-m1TyConKey = mkPreludeTyConUnique 140
sumTyConKey = mkPreludeTyConUnique 141
prodTyConKey = mkPreludeTyConUnique 142
compTyConKey = mkPreludeTyConUnique 143
-rTyConKey = mkPreludeTyConUnique 144
-dTyConKey = mkPreludeTyConUnique 146
-cTyConKey = mkPreludeTyConUnique 147
-sTyConKey = mkPreludeTyConUnique 148
-
rec0TyConKey = mkPreludeTyConUnique 149
d1TyConKey = mkPreludeTyConUnique 151
c1TyConKey = mkPreludeTyConUnique 152
@@ -1982,7 +1896,6 @@ s1TyConKey = mkPreludeTyConUnique 153
repTyConKey = mkPreludeTyConUnique 155
rep1TyConKey = mkPreludeTyConUnique 156
-uRecTyConKey = mkPreludeTyConUnique 157
uAddrTyConKey = mkPreludeTyConUnique 158
uCharTyConKey = mkPreludeTyConUnique 159
uDoubleTyConKey = mkPreludeTyConUnique 160
@@ -2026,8 +1939,7 @@ callStackTyConKey :: Unique
callStackTyConKey = mkPreludeTyConUnique 191
-- Typeables
-typeRepTyConKey, someTypeRepTyConKey, someTypeRepDataConKey :: Unique
-typeRepTyConKey = mkPreludeTyConUnique 192
+someTypeRepTyConKey, someTypeRepDataConKey :: Unique
someTypeRepTyConKey = mkPreludeTyConUnique 193
someTypeRepDataConKey = mkPreludeTyConUnique 194
@@ -2159,19 +2071,15 @@ staticPtrDataConKey = mkPreludeDataConUnique 33
staticPtrInfoDataConKey :: Unique
staticPtrInfoDataConKey = mkPreludeDataConUnique 34
-fingerprintDataConKey :: Unique
-fingerprintDataConKey = mkPreludeDataConUnique 35
-
srcLocDataConKey :: Unique
srcLocDataConKey = mkPreludeDataConUnique 37
trTyConDataConKey, trModuleDataConKey,
- trNameSDataConKey, trNameDDataConKey,
+ trNameSDataConKey,
trGhcPrimModuleKey :: Unique
trTyConDataConKey = mkPreludeDataConUnique 41
trModuleDataConKey = mkPreludeDataConUnique 43
trNameSDataConKey = mkPreludeDataConUnique 45
-trNameDDataConKey = mkPreludeDataConUnique 46
trGhcPrimModuleKey = mkPreludeDataConUnique 47
typeErrorTextDataConKey,
@@ -2246,7 +2154,7 @@ vecElemDataConKeys = map mkPreludeDataConUnique [96..105]
-- Typeable things
kindRepTyConAppDataConKey, kindRepVarDataConKey, kindRepAppDataConKey,
kindRepFunDataConKey, kindRepTYPEDataConKey,
- kindRepTypeLitSDataConKey, kindRepTypeLitDDataConKey
+ kindRepTypeLitSDataConKey
:: Unique
kindRepTyConAppDataConKey = mkPreludeDataConUnique 106
kindRepVarDataConKey = mkPreludeDataConUnique 107
@@ -2254,7 +2162,6 @@ kindRepAppDataConKey = mkPreludeDataConUnique 108
kindRepFunDataConKey = mkPreludeDataConUnique 109
kindRepTYPEDataConKey = mkPreludeDataConUnique 110
kindRepTypeLitSDataConKey = mkPreludeDataConUnique 111
-kindRepTypeLitDDataConKey = mkPreludeDataConUnique 112
typeLitSymbolDataConKey, typeLitNatDataConKey, typeLitCharDataConKey :: Unique
typeLitSymbolDataConKey = mkPreludeDataConUnique 113
@@ -2342,7 +2249,7 @@ cstringLengthIdKey = mkPreludeMiscIdUnique 28
concatIdKey, filterIdKey, zipIdKey,
bindIOIdKey, returnIOIdKey, newStablePtrIdKey,
- printIdKey, failIOIdKey, nullAddrIdKey, voidArgIdKey,
+ printIdKey, nullAddrIdKey, voidArgIdKey,
otherwiseIdKey, assertIdKey :: Unique
concatIdKey = mkPreludeMiscIdUnique 31
filterIdKey = mkPreludeMiscIdUnique 32
@@ -2351,7 +2258,6 @@ bindIOIdKey = mkPreludeMiscIdUnique 34
returnIOIdKey = mkPreludeMiscIdUnique 35
newStablePtrIdKey = mkPreludeMiscIdUnique 36
printIdKey = mkPreludeMiscIdUnique 37
-failIOIdKey = mkPreludeMiscIdUnique 38
nullAddrIdKey = mkPreludeMiscIdUnique 39
voidArgIdKey = mkPreludeMiscIdUnique 40
otherwiseIdKey = mkPreludeMiscIdUnique 43
@@ -2390,11 +2296,9 @@ considerAccessibleIdKey = mkPreludeMiscIdUnique 125
noinlineIdKey = mkPreludeMiscIdUnique 126
noinlineConstraintIdKey = mkPreludeMiscIdUnique 127
-integerToFloatIdKey, integerToDoubleIdKey, naturalToFloatIdKey, naturalToDoubleIdKey :: Unique
+integerToFloatIdKey, integerToDoubleIdKey :: Unique
integerToFloatIdKey = mkPreludeMiscIdUnique 128
integerToDoubleIdKey = mkPreludeMiscIdUnique 129
-naturalToFloatIdKey = mkPreludeMiscIdUnique 130
-naturalToDoubleIdKey = mkPreludeMiscIdUnique 131
rationalToFloatIdKey, rationalToDoubleIdKey :: Unique
rationalToFloatIdKey = mkPreludeMiscIdUnique 132
@@ -2472,9 +2376,8 @@ toIntegerClassOpKey = mkPreludeMiscIdUnique 192
toRationalClassOpKey = mkPreludeMiscIdUnique 193
-- Monad comprehensions
-guardMIdKey, liftMIdKey, mzipIdKey :: Unique
+guardMIdKey, mzipIdKey :: Unique
guardMIdKey = mkPreludeMiscIdUnique 194
-liftMIdKey = mkPreludeMiscIdUnique 195
mzipIdKey = mkPreludeMiscIdUnique 196
-- GHCi
@@ -2497,7 +2400,6 @@ proxyHashKey = mkPreludeMiscIdUnique 502
-- Used to make `Typeable` dictionaries
mkTyConKey
- , mkTrTypeKey
, mkTrConKey
, mkTrAppCheckedKey
, mkTrFunKey
@@ -2507,7 +2409,6 @@ mkTyConKey
, typeRepIdKey
:: Unique
mkTyConKey = mkPreludeMiscIdUnique 503
-mkTrTypeKey = mkPreludeMiscIdUnique 504
mkTrConKey = mkPreludeMiscIdUnique 505
mkTrAppCheckedKey = mkPreludeMiscIdUnique 506
typeNatTypeRepKey = mkPreludeMiscIdUnique 507
@@ -2620,18 +2521,12 @@ integerFromNaturalIdKey
, naturalQuotIdKey
, naturalRemIdKey
, naturalAndIdKey
- , naturalAndNotIdKey
, naturalOrIdKey
, naturalXorIdKey
, naturalTestBitIdKey
, naturalBitIdKey
, naturalGcdIdKey
, naturalLcmIdKey
- , naturalLog2IdKey
- , naturalLogBaseWordIdKey
- , naturalLogBaseIdKey
- , naturalPowModIdKey
- , naturalSizeInBaseIdKey
, bignatEqIdKey
, bignatCompareIdKey
, bignatCompareWordIdKey
@@ -2686,18 +2581,12 @@ naturalQuotRemIdKey = mkPreludeMiscIdUnique 669
naturalQuotIdKey = mkPreludeMiscIdUnique 670
naturalRemIdKey = mkPreludeMiscIdUnique 671
naturalAndIdKey = mkPreludeMiscIdUnique 672
-naturalAndNotIdKey = mkPreludeMiscIdUnique 673
naturalOrIdKey = mkPreludeMiscIdUnique 674
naturalXorIdKey = mkPreludeMiscIdUnique 675
naturalTestBitIdKey = mkPreludeMiscIdUnique 676
naturalBitIdKey = mkPreludeMiscIdUnique 677
naturalGcdIdKey = mkPreludeMiscIdUnique 678
naturalLcmIdKey = mkPreludeMiscIdUnique 679
-naturalLog2IdKey = mkPreludeMiscIdUnique 680
-naturalLogBaseWordIdKey = mkPreludeMiscIdUnique 681
-naturalLogBaseIdKey = mkPreludeMiscIdUnique 682
-naturalPowModIdKey = mkPreludeMiscIdUnique 683
-naturalSizeInBaseIdKey = mkPreludeMiscIdUnique 684
bignatEqIdKey = mkPreludeMiscIdUnique 691
bignatCompareIdKey = mkPreludeMiscIdUnique 692
=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -85,6 +85,7 @@ import GHC.CmmToAsm.BlockLayout as BlockLayout
import GHC.Settings.Config
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.PIC
+import GHC.CmmToAsm.Ppr (pprSectionHeader)
import GHC.Platform.Reg
import GHC.Platform.Reg.Class (RegClass)
import GHC.CmmToAsm.Monad
@@ -97,7 +98,9 @@ import GHC.Cmm.DebugBlock
import GHC.Cmm.BlockId
import GHC.StgToCmm.CgUtils ( fixStgRegisters )
import GHC.Cmm
+import GHC.Cmm.Dataflow.Graph (entryLabel)
import GHC.Cmm.Dataflow.Label
+import GHC.Cmm.Dataflow.Block (foldBlockNodesF)
import GHC.Cmm.GenericOpt
import GHC.Cmm.CLabel
@@ -123,13 +126,18 @@ import GHC.Data.Stream (liftIO)
import qualified GHC.Data.Stream as Stream
import GHC.Settings
-import Data.List (sortBy)
+import Data.List (sortBy, find)
import Data.List.NonEmpty (groupAllWith, head)
import Data.Maybe
import Data.Ord ( comparing )
+import Data.Char (isSpace)
import Control.Monad
import System.IO
-import System.Directory ( getCurrentDirectory )
+import System.Directory ( getCurrentDirectory, getTemporaryDirectory, removeFile )
+import qualified Data.Graph as Graph
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified Data.ByteString.Char8 as BS8
--------------------
nativeCodeGen :: forall a . Logger -> ToolSettings -> NCGConfig -> ModLocation -> Handle
@@ -139,7 +147,13 @@ nativeCodeGen logger ts config modLoc h cmms
= let platform = ncgPlatform config
nCG' :: ( OutputableP Platform statics, Outputable jumpDest, Instruction instr)
=> NcgImpl statics instr jumpDest -> UniqDSMT IO a
- nCG' ncgImpl = nativeCodeGen' logger config modLoc ncgImpl h cmms
+ nCG' ncgImpl
+ | shouldGroupSplitSections config
+ = nativeCodeGenGrouped logger config modLoc ncgImpl h cmms
+ | otherwise
+ = do
+ (a, _) <- nativeCodeGen' logger config modLoc ncgImpl False h cmms
+ return a
in case platformArch platform of
ArchX86 -> nCG' (X86.ncgX86 config)
ArchX86_64 -> nCG' (X86.ncgX86_64 config)
@@ -174,8 +188,257 @@ data NativeGenAcc statics instr
, ngs_unwinds :: !(LabelMap [UnwindPoint])
-- ^ see Note [Unwinding information in the NCG]
-- and Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock".
+ , ngs_splitSecAcc :: !(Maybe SplitSecAcc)
}
+-- -----------------------------------------------------------------------------
+-- Split sections grouping
+
+data SplitNodeKey
+ = SplitNodeKey !SectionType !CLabel
+
+data SplitSecAcc = SplitSecAcc
+ { ssOwner :: !(Map.Map CLabel SplitNodeKey)
+ , ssNodeOrder :: !(Map.Map SplitNodeKey Int)
+ , ssNodes :: ![SplitNodeKey] -- ^ first-seen order
+ , ssNextId :: !Int
+ , ssPendingRefs :: !(Map.Map SplitNodeKey (Set.Set CLabel))
+ }
+
+emptySplitSecAcc :: SplitSecAcc
+emptySplitSecAcc = SplitSecAcc
+ { ssOwner = Map.empty
+ , ssNodeOrder = Map.empty
+ , ssNodes = []
+ , ssNextId = 0
+ , ssPendingRefs = Map.empty
+ }
+
+ensureSplitNode :: SplitNodeKey -> SplitSecAcc -> SplitSecAcc
+ensureSplitNode node acc =
+ case Map.lookup node (ssNodeOrder acc) of
+ Just _ -> acc
+ Nothing ->
+ let newId = ssNextId acc
+ in acc { ssNodeOrder = Map.insert node newId (ssNodeOrder acc)
+ , ssNodes = ssNodes acc ++ [node]
+ , ssNextId = newId + 1
+ }
+
+addSplitOwner :: CLabel -> SplitNodeKey -> SplitSecAcc -> SplitSecAcc
+addSplitOwner lbl node acc =
+ let acc' = ensureSplitNode node acc
+ in acc' { ssOwner = Map.insert lbl node (ssOwner acc') }
+
+addSplitRefs :: SplitNodeKey -> Set.Set CLabel -> SplitSecAcc -> SplitSecAcc
+addSplitRefs node refs acc =
+ let acc' = ensureSplitNode node acc
+ refs' = Map.findWithDefault Set.empty node (ssPendingRefs acc')
+ refs'' = refs `Set.union` refs'
+ in acc' { ssPendingRefs = Map.insert node refs'' (ssPendingRefs acc') }
+
+sectionTypeKey :: SectionType -> Int
+sectionTypeKey t = case t of
+ Text -> 0
+ Data -> 1
+ ReadOnlyData -> 2
+ RelocatableReadOnlyData -> 3
+ UninitialisedData -> 4
+ InitArray -> 5
+ FiniArray -> 6
+ CString -> 7
+ IPE -> 8
+
+instance Eq SplitNodeKey where
+ SplitNodeKey t1 l1 == SplitNodeKey t2 l2 =
+ sectionTypeKey t1 == sectionTypeKey t2 && l1 == l2
+
+instance Ord SplitNodeKey where
+ compare (SplitNodeKey t1 l1) (SplitNodeKey t2 l2) =
+ compare (sectionTypeKey t1, l1) (sectionTypeKey t2, l2)
+
+shouldGroupSplitSections :: NCGConfig -> Bool
+shouldGroupSplitSections config =
+ ncgSplitSections config && case platformOS (ncgPlatform config) of
+ OSDarwin -> False
+ OSAIX -> False
+ _ -> True
+
+labelsOfCmmLit :: CmmLit -> Set.Set CLabel
+labelsOfCmmLit lit = case lit of
+ CmmLabel lbl -> Set.singleton lbl
+ CmmLabelOff lbl _ -> Set.singleton lbl
+ CmmLabelDiffOff lbl1 lbl2 _ _ -> Set.fromList [lbl1, lbl2]
+ _ -> Set.empty
+
+labelsOfCmmExpr :: CmmExpr -> Set.Set CLabel -> Set.Set CLabel
+labelsOfCmmExpr expr acc = case expr of
+ CmmLit lit -> labelsOfCmmLit lit `Set.union` acc
+ _ -> acc
+
+collectStaticsLabels :: [CmmStatic] -> Set.Set CLabel
+collectStaticsLabels = foldl' collect Set.empty
+ where
+ collect acc (CmmStaticLit lit) = labelsOfCmmLit lit `Set.union` acc
+ collect acc _ = acc
+
+collectGraphLabels :: CmmGraph -> Set.Set CLabel
+collectGraphLabels graph =
+ foldl' collectBlock Set.empty (toBlockList graph)
+ where
+ collectBlock acc block =
+ foldBlockNodesF (\node a -> foldExpDeep labelsOfCmmExpr node a) block acc
+
+procSectionLabelRaw :: RawCmmDecl -> CLabel
+procSectionLabelRaw (CmmProc infos entry _ graph) =
+ case mapLookup (g_entry graph) infos of
+ Just (CmmStaticsRaw info_lbl _) -> info_lbl
+ Nothing -> entry
+procSectionLabelRaw _ = panic "procSectionLabelRaw: not a CmmProc"
+
+procSectionLabelNat :: NatCmmDecl statics instr -> CLabel
+procSectionLabelNat (CmmProc infos entry _ (ListGraph blocks)) =
+ case find (\b -> blockLbl (blockId b) == entry) blocks of
+ Just b ->
+ case mapLookup (blockId b) infos of
+ Just (CmmStaticsRaw info_lbl _) -> info_lbl
+ Nothing -> entry
+ Nothing -> entry
+procSectionLabelNat _ = panic "procSectionLabelNat: not a CmmProc"
+
+collectSplitSecRawDecl :: RawCmmDecl -> SplitSecAcc -> SplitSecAcc
+collectSplitSecRawDecl decl acc = case decl of
+ CmmData (Section secTy suffix) (CmmStaticsRaw _ statics) ->
+ let node = SplitNodeKey secTy suffix
+ acc' = addSplitOwner suffix node acc
+ refs = collectStaticsLabels statics
+ in addSplitRefs node refs acc'
+ CmmProc infos entry _ graph ->
+ let procLbl = procSectionLabelRaw decl
+ procNode = SplitNodeKey Text procLbl
+ acc1 = addSplitOwner entry procNode acc
+ acc2 = addSplitOwner procLbl procNode acc1
+ acc3 = foldl' (\a b -> addSplitOwner (blockLbl (entryLabel b)) procNode a)
+ acc2 (toBlockList graph)
+ infoStatics = mapElems infos
+ acc4 = foldl' (\a (CmmStaticsRaw info_lbl _) -> addSplitOwner info_lbl procNode a)
+ acc3 infoStatics
+ infoRefs = foldl' (\s (CmmStaticsRaw _ st) -> collectStaticsLabels st `Set.union` s)
+ Set.empty infoStatics
+ graphRefs = collectGraphLabels graph
+ refs = graphRefs `Set.union` infoRefs
+ in addSplitRefs procNode refs acc4
+
+collectSplitSecJumpTables :: [NatCmmDecl statics instr] -> SplitSecAcc -> SplitSecAcc
+collectSplitSecJumpTables decls acc = go Nothing acc decls
+ where
+ go _ acc' [] = acc'
+ go mProc acc' (d:ds) = case d of
+ CmmProc _ _ _ _ ->
+ let procLbl = procSectionLabelNat d
+ procNode = SplitNodeKey Text procLbl
+ acc'' = addSplitOwner procLbl procNode acc'
+ in go (Just procLbl) acc'' ds
+ CmmData (Section secTy suffix) _ ->
+ case mProc of
+ Nothing -> go mProc acc' ds
+ Just procLbl ->
+ let procNode = SplitNodeKey Text procLbl
+ tableNode = SplitNodeKey secTy suffix
+ acc1 = addSplitOwner suffix tableNode acc'
+ acc2 = addSplitRefs procNode (Set.singleton suffix) acc1
+ acc3 = addSplitRefs tableNode (Set.singleton procLbl) acc2
+ in go mProc acc3 ds
+
+splitSectionGroups :: SplitSecAcc -> Map.Map SplitNodeKey CLabel
+splitSectionGroups acc =
+ let nodes = ssNodes acc
+ owner = ssOwner acc
+ refsMap = ssPendingRefs acc
+ nodeOrder node = Map.findWithDefault maxBound node (ssNodeOrder acc)
+ edgesFor node =
+ let refs = Map.findWithDefault Set.empty node refsMap
+ addRef s lbl =
+ case Map.lookup lbl owner of
+ Just node' -> Set.insert node' s
+ Nothing -> s
+ in Set.toList (Set.foldl' addRef Set.empty refs)
+ sccs = Graph.stronglyConnComp [ (node, node, edgesFor node) | node <- nodes ]
+ in foldl' (assignScc nodeOrder) Map.empty sccs
+ where
+ assignScc nodeOrder acc' scc =
+ let sccNodes = case scc of
+ Graph.AcyclicSCC n -> [n]
+ Graph.CyclicSCC ns -> ns
+ reps = foldl' (pickRep nodeOrder) Map.empty sccNodes
+ pickRep order repsAcc node@(SplitNodeKey secTy lbl) =
+ let secKey = sectionTypeKey secTy in
+ case Map.lookup secKey repsAcc of
+ Nothing -> Map.insert secKey lbl repsAcc
+ Just curLbl ->
+ if order node < order (SplitNodeKey secTy curLbl)
+ then Map.insert secKey lbl repsAcc
+ else repsAcc
+ addNode m node@(SplitNodeKey secTy _) =
+ case Map.lookup (sectionTypeKey secTy) reps of
+ Just repLbl -> Map.insert node repLbl m
+ Nothing -> m
+ in foldl' addNode acc' sccNodes
+
+splitSectionRewriteMap :: NCGConfig -> SplitSecAcc -> Map.Map BS8.ByteString BS8.ByteString
+splitSectionRewriteMap config acc =
+ let ctx = ncgAsmContext config
+ groups = splitSectionGroups acc
+ lineFor secTy lbl =
+ BS8.pack $ showSDocOneLine ctx (pprSectionHeader config (Section secTy lbl))
+ addEntry m (SplitNodeKey secTy oldLbl) newLbl =
+ let oldLine = lineFor secTy oldLbl
+ newLine = lineFor secTy newLbl
+ in if oldLine == newLine
+ then m
+ else case Map.lookup oldLine m of
+ Nothing -> Map.insert oldLine newLine m
+ Just _ -> m
+ in Map.foldlWithKey' addEntry Map.empty groups
+
+rewriteSplitSections :: Map.Map BS8.ByteString BS8.ByteString -> Handle -> Handle -> IO ()
+rewriteSplitSections mapping hIn hOut = loop
+ where
+ sectionPrefix = BS8.pack ".section "
+ loop = do
+ eof <- hIsEOF hIn
+ unless eof $ do
+ line <- BS8.hGetLine hIn
+ let (prefix, body) = BS8.span isSpace line
+ line' =
+ if BS8.isPrefixOf sectionPrefix body
+ then case Map.lookup body mapping of
+ Just newBody -> BS8.append prefix newBody
+ Nothing -> line
+ else line
+ BS8.hPut hOut line'
+ BS8.hPut hOut (BS8.singleton '\n')
+ loop
+
+nativeCodeGenGrouped :: (OutputableP Platform statics, Outputable jumpDest, Instruction instr)
+ => Logger
+ -> NCGConfig
+ -> ModLocation
+ -> NcgImpl statics instr jumpDest
+ -> Handle
+ -> CgStream RawCmmGroup a
+ -> UniqDSMT IO a
+nativeCodeGenGrouped logger config modLoc ncgImpl h cmms = do
+ tmpDir <- liftIO getTemporaryDirectory
+ (tmpPath, tmpHandle) <- liftIO $ openBinaryTempFile tmpDir "ghc-split-sections"
+ (a, acc) <- nativeCodeGen' logger config modLoc ncgImpl True tmpHandle cmms
+ liftIO $ hClose tmpHandle
+ let mapping = splitSectionRewriteMap config acc
+ liftIO $ withBinaryFile tmpPath ReadMode $ \hIn ->
+ rewriteSplitSections mapping hIn h
+ liftIO $ removeFile tmpPath
+ return a
+
{-
Note [Unwinding information in the NCG]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -205,19 +468,22 @@ nativeCodeGen' :: (OutputableP Platform statics, Outputable jumpDest, Instructio
-> NCGConfig
-> ModLocation
-> NcgImpl statics instr jumpDest
+ -> Bool
-> Handle
-> CgStream RawCmmGroup a
- -> UniqDSMT IO a
-nativeCodeGen' logger config modLoc ncgImpl h cmms
+ -> UniqDSMT IO (a, SplitSecAcc)
+nativeCodeGen' logger config modLoc ncgImpl collectSplit h cmms
= do
-- BufHandle is a performance hack. We could hide it inside
-- Pretty if it weren't for the fact that we do lots of little
-- printDocs here (in order to do codegen in constant space).
bufh <- liftIO $ newBufHandle h
- let ngs0 = NGS [] [] [] [] [] [] emptyUFM mapEmpty
+ let splitAcc = if collectSplit then Just emptySplitSecAcc else Nothing
+ let ngs0 = NGS [] [] [] [] [] [] emptyUFM mapEmpty splitAcc
(ngs, a) <- cmmNativeGenStream logger config modLoc ncgImpl bufh cmms ngs0
_ <- finishNativeGen logger config modLoc bufh ngs
- return a
+ let finalAcc = fromMaybe emptySplitSecAcc (ngs_splitSecAcc ngs)
+ return (a, finalAcc)
finishNativeGen :: Instruction instr
=> Logger
@@ -359,7 +625,11 @@ cmmNativeGens logger config ncgImpl h dbgMap = go
return (ngs, us)
go (cmm : cmms) ngs count us = do
- let fileIds = ngs_dwarfFiles ngs
+ let ngs1 = case ngs_splitSecAcc ngs of
+ Nothing -> ngs
+ Just acc -> ngs { ngs_splitSecAcc = Just (collectSplitSecRawDecl cmm acc) }
+
+ let fileIds = ngs_dwarfFiles ngs1
(us', fileIds', native, imports, colorStats, linearStats, unwinds, mcfg)
<- {-# SCC "cmmNativeGen" #-}
cmmNativeGen logger ncgImpl us fileIds dbgMap
@@ -399,15 +669,17 @@ cmmNativeGens logger config ncgImpl h dbgMap = go
then native : ngs_natives ngs else []
mCon = maybe id (:)
- ngs' = ngs{ ngs_imports = imports : ngs_imports ngs
- , ngs_natives = natives'
- , ngs_colorStats = colorStats `mCon` ngs_colorStats ngs
- , ngs_linearStats = linearStats `mCon` ngs_linearStats ngs
- , ngs_labels = ngs_labels ngs ++ labels'
- , ngs_dwarfFiles = fileIds'
- , ngs_unwinds = ngs_unwinds ngs `mapUnion` unwinds
- }
- go cmms ngs' (count + 1) us'
+ ngs' = ngs1{ ngs_imports = imports : ngs_imports ngs1
+ , ngs_natives = natives'
+ , ngs_colorStats = colorStats `mCon` ngs_colorStats ngs1
+ , ngs_linearStats = linearStats `mCon` ngs_linearStats ngs1
+ , ngs_labels = ngs_labels ngs1 ++ labels'
+ , ngs_dwarfFiles = fileIds'
+ , ngs_unwinds = ngs_unwinds ngs1 `mapUnion` unwinds
+ }
+ ngs'' = ngs' { ngs_splitSecAcc =
+ fmap (collectSplitSecJumpTables native) (ngs_splitSecAcc ngs') }
+ go cmms ngs'' (count + 1) us'
-- see Note [pprNatCmmDeclS and pprNatCmmDeclH] in GHC.CmmToAsm.Monad
=====================================
compiler/GHC/HsToCore/Foreign/Wasm.hs
=====================================
@@ -224,6 +224,25 @@ especially since leaving all the boxing/unboxing business to C unifies
the implementation of JSFFI imports and exports
(rts_mkJSVal/rts_getJSVal).
+We don't support unboxed FFI types like Int# etc. But we do support
+one kind of unlifted FFI type for JSFFI import arguments:
+ByteArray#/MutableByteArray#. The semantics is the same in C: the
+pointer to the ByteArray# payload is passed instead of the ByteArray#
+closure itself. This allows efficient zero-copy data exchange between
+Haskell and JavaScript using unpinned ByteArray#, and the following
+conditions must be met:
+
+- The JSFFI import itself must be a sync import marked as unsafe
+- The JavaScript code must not re-enter Haskell when a ByteArray# is
+ passed as argument
+
+There's no magic in the handling of ByteArray#/MutableByteArray#
+arguments. When generating C stub, we treat them like Ptr that points
+to the payload, just without the rts_getPtr() unboxing call. After
+lowering to C import, the backend takes care of adding the offset, see
+add_shim in GHC.StgToCmm.Foreign and
+Note [Unlifted boxed arguments to foreign calls].
+
Now, each sync import calls a generated C function with a unique
symbol. The C function uses rts_get* to unbox the arguments, call into
JavaScript, then boxes the result with rts_mk* and returns it to
@@ -517,8 +536,9 @@ importCStub sync cfun_name arg_tys res_ty js_src = CStub c_doc [] []
cfun_ret
| res_ty `eqType` unitTy = cfun_call_import <> semi
| otherwise = text "return" <+> cfun_call_import <> semi
- cfun_make_arg arg_ty arg_val =
- text ("rts_get" ++ ffiType arg_ty) <> parens arg_val
+ cfun_make_arg arg_ty arg_val
+ | isByteArrayPrimTy arg_ty = arg_val
+ | otherwise = text ("rts_get" ++ ffiType arg_ty) <> parens arg_val
cfun_make_ret ret_val
| res_ty `eqType` unitTy = ret_val
| otherwise =
@@ -543,7 +563,11 @@ importCStub sync cfun_name arg_tys res_ty js_src = CStub c_doc [] []
| res_ty `eqType` unitTy = text "void"
| otherwise = text "HaskellObj"
cfun_arg_list =
- [text "HaskellObj" <+> char 'a' <> int n | n <- [1 .. length arg_tys]]
+ [ text (if isByteArrayPrimTy arg_ty then "HsPtr" else "HaskellObj")
+ <+> char 'a'
+ <> int n
+ | (arg_ty, n) <- zip arg_tys [1 ..]
+ ]
cfun_args = case cfun_arg_list of
[] -> text "void"
_ -> hsep $ punctuate comma cfun_arg_list
@@ -746,8 +770,18 @@ lookupGhcInternalTyCon m t = do
n <- lookupOrig (mkGhcInternalModule m) (mkTcOcc t)
dsLookupTyCon n
+isByteArrayPrimTy :: Type -> Bool
+isByteArrayPrimTy ty
+ | Just tc <- tyConAppTyCon_maybe ty,
+ tc == byteArrayPrimTyCon || tc == mutableByteArrayPrimTyCon =
+ True
+ | otherwise =
+ False
+
ffiType :: Type -> String
-ffiType = occNameString . getOccName . fst . splitTyConApp
+ffiType ty
+ | isByteArrayPrimTy ty = "Ptr"
+ | otherwise = occNameString $ getOccName $ tyConAppTyCon ty
commonCDecls :: SDoc
commonCDecls =
=====================================
compiler/GHC/Parser/String.hs
=====================================
@@ -19,6 +19,7 @@ import Data.Char (chr, ord)
import qualified Data.Foldable1 as Foldable1
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (listToMaybe, mapMaybe)
+import GHC.Data.OrdList (fromOL, nilOL, snocOL)
import GHC.Data.StringBuffer (StringBuffer)
import qualified GHC.Data.StringBuffer as StringBuffer
import GHC.Parser.CharClass (
@@ -167,16 +168,16 @@ collapseGaps = go
[] -> panic "gap unexpectedly ended"
resolveEscapes :: HasChar c => [c] -> Either (c, LexErr) [c]
-resolveEscapes = go dlistEmpty
+resolveEscapes = go nilOL
where
go !acc = \case
- [] -> pure $ dlistToList acc
+ [] -> pure $ fromOL acc
Char '\\' : Char '&' : cs -> go acc cs
backslash@(Char '\\') : cs ->
case resolveEscapeChar cs of
- Right (esc, cs') -> go (acc `dlistSnoc` setChar esc backslash) cs'
+ Right (esc, cs') -> go (acc `snocOL` setChar esc backslash) cs'
Left (c, e) -> Left (c, e)
- c : cs -> go (acc `dlistSnoc` c) cs
+ c : cs -> go (acc `snocOL` c) cs
-- -----------------------------------------------------------------------------
-- Escape characters
@@ -420,17 +421,3 @@ It's more precisely defined with the following algorithm:
* Lines with only whitespace characters
3. Calculate the longest prefix of whitespace shared by all lines in the remaining list
-}
-
--- -----------------------------------------------------------------------------
--- DList
-
-newtype DList a = DList ([a] -> [a])
-
-dlistEmpty :: DList a
-dlistEmpty = DList id
-
-dlistToList :: DList a -> [a]
-dlistToList (DList f) = f []
-
-dlistSnoc :: DList a -> a -> DList a
-dlistSnoc (DList f) x = DList (f . (x :))
=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -11,6 +11,7 @@ import GHC.IO (unsafePerformIO)
#endif
import Data.Char
+import Data.Foldable
import GHC.Prelude
import GHC.Platform
import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile)
@@ -18,6 +19,7 @@ import GHC.Types.Unique.DSM
import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..))
+import GHC.Data.OrdList (OrdList, nilOL, snocOL)
import GHC.Cmm
import GHC.Cmm.CLabel
@@ -286,7 +288,7 @@ data CgInfoProvEnt = CgInfoProvEnt
, ipeSrcSpan :: !StrTabOffset
}
-data StringTable = StringTable { stStrings :: DList ShortText
+data StringTable = StringTable { stStrings :: !(OrdList ShortText)
, stLength :: !Int
, stLookup :: !(M.Map ShortText StrTabOffset)
}
@@ -295,7 +297,7 @@ type StrTabOffset = Word32
emptyStringTable :: StringTable
emptyStringTable =
- StringTable { stStrings = emptyDList
+ StringTable { stStrings = nilOL
, stLength = 0
, stLookup = M.empty
}
@@ -303,7 +305,7 @@ emptyStringTable =
getStringTableStrings :: StringTable -> BS.ByteString
getStringTableStrings st =
BSL.toStrict $ BSB.toLazyByteString
- $ foldMap f $ dlistToList (stStrings st)
+ $ foldMap' f $ stStrings st
where
f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0
@@ -312,7 +314,7 @@ lookupStringTable str = state $ \st ->
case M.lookup str (stLookup st) of
Just off -> (off, st)
Nothing ->
- let !st' = st { stStrings = stStrings st `snoc` str
+ let !st' = st { stStrings = stStrings st `snocOL` str
, stLength = stLength st + ST.byteLength str + 1
, stLookup = M.insert str res (stLookup st)
}
@@ -359,14 +361,3 @@ foreign import ccall unsafe "ZSTD_compressBound"
defaultCompressionLevel :: Int
defaultCompressionLevel = 3
-
-newtype DList a = DList ([a] -> [a])
-
-emptyDList :: DList a
-emptyDList = DList id
-
-snoc :: DList a -> a -> DList a
-snoc (DList f) x = DList (f . (x:))
-
-dlistToList :: DList a -> [a]
-dlistToList (DList f) = f []
=====================================
docs/users_guide/wasm.rst
=====================================
@@ -265,7 +265,7 @@ backend’s JavaScript FFI, which we’ll now abbreviate as JSFFI.
Marshalable types and ``JSVal``
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-JSFFI supports all boxed marshalable foreign types in C FFI:
+JSFFI supports all lifted marshalable foreign types in C FFI:
- ``Bool``
- ``Char``
@@ -298,8 +298,14 @@ types in JSFFI. Some caveats to keep in mind:
results in type errors, so keep this in mind. As for ``Int`` /
``Word``, they are 32-bit since the GHC wasm backend is based on
``wasm32`` .
-- JSFFI doesn’t support unboxed foreign types like ``Int#``,
- ``ByteArray#``, etc, even when ``UnliftedFFITypes`` is enabled.
+- JSFFI doesn’t support unboxed foreign types like ``Int#``, even
+ when ``UnliftedFFITypes`` is enabled. The only supported unlifted
+ types are ``ByteArray#`` and ``MutableByteArray#``, they may only
+ be used as JSFFI import argument types, with the same semantics in
+ C FFI: the pointer to the payload is passed to JavaScript. Be
+ careful and avoid calling back into Haskell in such cases,
+ otherwise GC may occur and the pointer may be invalidated if it's
+ unpinned!
In addition to the above types, JSFFI supports the ``JSVal`` type and
its ``newtype``\ s as argument/result types. ``JSVal`` is defined in
=====================================
hadrian/doc/flavours.md
=====================================
@@ -249,10 +249,6 @@ The supported transformers are listed below:
<tr>
<td><code>profiled_ghc</code></td>
<td>Build the GHC executable with cost-centre profiling support.
- It is recommended that you use this in conjunction with `no_dynamic_ghc` since
- GHC does not support loading of profiled libraries with the
- dynamic linker. You should use a flavour that builds profiling libs and rts,
- i.e. not <code>quick</code>. <br>
This flag adds cost centres with the -fprof-late flag.</td>
</tr>
<tr>
@@ -274,6 +270,10 @@ The supported transformers are listed below:
<td><code>text_simdutf</code></td>
<td>Enable building the <code>text</code> package with <code>simdutf</code> support.</td>
</tr>
+ <tr>
+ <td><code>with_profiled_libs</code></td>
+ <td>Enables building of stage1+ libraries and the RTS in profiled build ways (the opposite of <code>no_profiled_libs</code>).</td>
+ </tr>
<tr>
<td><code>no_profiled_libs</code></td>
<td>Disables building of libraries in profiled build ways.</td>
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -15,6 +15,7 @@ module Flavour
, enableProfiledGhc
, disableDynamicGhcPrograms
, disableDynamicLibs
+ , enableProfiledLibs
, disableProfiledLibs
, enableLinting
, enableHaddock
@@ -62,6 +63,7 @@ flavourTransformers = M.fromList
, "no_dynamic_libs" =: disableDynamicLibs
, "native_bignum" =: useNativeBignum
, "text_simdutf" =: enableTextWithSIMDUTF
+ , "with_profiled_libs" =: enableProfiledLibs
, "no_profiled_libs" =: disableProfiledLibs
, "omit_pragmas" =: omitPragmas
, "ipe" =: enableIPE
@@ -169,6 +171,7 @@ enableDebugInfo :: Flavour -> Flavour
enableDebugInfo = addArgs $ notStage0 ? mconcat
[ builder (Ghc CompileHs) ? pure ["-g3"]
, builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"]
+ , builder (Ghc CompileCppWithGhc) ? pure ["-optcxx-g3"]
, builder (Cc CompileC) ? arg "-g3"
, builder (Cabal Setup) ? arg "--disable-library-stripping"
, builder (Cabal Setup) ? arg "--disable-executable-stripping"
@@ -307,29 +310,11 @@ enableUBSan =
viaLlvmBackend :: Flavour -> Flavour
viaLlvmBackend = addArgs $ notStage0 ? builder Ghc ? arg "-fllvm"
--- | Build the GHC executable with profiling enabled in stages 2 and later. It
--- is also recommended that you use this with @'dynamicGhcPrograms' = False@
--- since GHC does not support loading of profiled libraries with the
--- dynamically-linker.
+-- | Build the GHC executable with profiling enabled in stages 2 and
+-- later.
enableProfiledGhc :: Flavour -> Flavour
enableProfiledGhc flavour =
- enableLateCCS flavour
- { rtsWays = do
- ws <- rtsWays flavour
- mconcat
- [ pure ws
- , buildingCompilerStage' (>= Stage2) ? pure (foldMap profiled_ways ws)
- ]
- , libraryWays = mconcat
- [ libraryWays flavour
- , buildingCompilerStage' (>= Stage2) ? pure (Set.singleton profiling)
- ]
- , ghcProfiled = (>= Stage2)
- }
- where
- profiled_ways w
- | wayUnit Dynamic w = Set.empty
- | otherwise = Set.singleton (w <> profiling)
+ enableLateCCS $ enableProfiledLibs flavour { ghcProfiled = (>= Stage2) }
-- | Disable 'dynamicGhcPrograms'.
disableDynamicGhcPrograms :: Flavour -> Flavour
@@ -346,6 +331,20 @@ disableDynamicLibs flavour =
prune :: Ways -> Ways
prune = fmap $ Set.filter (not . wayUnit Dynamic)
+-- | Build libraries and the RTS in profiled ways (opposite of
+-- 'disableProfiledLibs').
+enableProfiledLibs :: Flavour -> Flavour
+enableProfiledLibs flavour =
+ flavour
+ { libraryWays = addProfilingWays $ libraryWays flavour,
+ rtsWays = addProfilingWays $ rtsWays flavour
+ }
+ where
+ addProfilingWays :: Ways -> Ways
+ addProfilingWays ways = do
+ ws <- ways
+ buildProfiled <- notStage0
+ pure $ if buildProfiled then ws <> Set.map (<> profiling) ws else ws
-- | Don't build libraries in profiled 'Way's.
disableProfiledLibs :: Flavour -> Flavour
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -351,7 +351,7 @@ rtsPackageArgs = package rts ? do
, Debug `wayUnit` way ? pure [ "-DDEBUG"
, "-fno-omit-frame-pointer"
, "-g3"
- , "-O0" ]
+ , "-Og" ]
-- Set the namespace for the rts fs functions
, arg $ "-DFS_NAMESPACE=rts"
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
=====================================
@@ -480,7 +480,7 @@ hIsOpen handle =
SemiClosedHandle -> return False
_ -> return True
--- | @'hIsOpen' hdl@ returns whether the handle is closed.
+-- | @'hIsClosed' hdl@ returns whether the handle is closed.
-- If the 'haType' of @hdl@ is 'ClosedHandle' this returns 'True'
-- and 'False' otherwise.
hIsClosed :: Handle -> IO Bool
=====================================
rts/linker/InitFini.c
=====================================
@@ -75,7 +75,7 @@ static void sortInitFiniList(struct InitFiniList **slist, enum SortOrder order)
while (*last != NULL && (*last)->next != NULL) {
struct InitFiniList *s0 = *last;
struct InitFiniList *s1 = s0->next;
- bool flip;
+ bool flip = false;
switch (order) {
case INCREASING: flip = s0->priority > s1->priority; break;
case DECREASING: flip = s0->priority < s1->priority; break;
=====================================
rts/sm/Sanity.c
=====================================
@@ -692,7 +692,7 @@ checkCompactObjects(bdescr *bd)
ASSERT((W_)str == (W_)block + sizeof(StgCompactNFDataBlock));
StgWord totalW = 0;
- StgCompactNFDataBlock *last;
+ StgCompactNFDataBlock *last = block;
for ( ; block ; block = block->next) {
last = block;
ASSERT(block->owner == str);
=====================================
testsuite/tests/jsffi/all.T
=====================================
@@ -25,4 +25,6 @@ test('jsffion', [], compile_and_run, ['-optl-Wl,--export=main'])
test('jsffisleep', [], compile_and_run, ['-optl-Wl,--export=testWouldBlock,--export=testLazySleep,--export=testThreadDelay,--export=testInterruptingSleep'])
+test('bytearrayarg', [], compile_and_run, ['-optl-Wl,--export=main'])
+
test('textconv', [], compile_and_run, ['-optl-Wl,--export=main'])
=====================================
testsuite/tests/jsffi/bytearrayarg.hs
=====================================
@@ -0,0 +1,39 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+
+module Test where
+
+import GHC.Exts
+import GHC.IO
+import GHC.Word (Word8(W8#))
+
+foreign import javascript unsafe "(() => { const u8 = new Uint8Array(__exports.memory.buffer, $1, 4); return (u8[0] === 0x12 && u8[1] === 0x34 && u8[2] === 0x56 && u8[3] === 0x78) ? 1 : 0; })()"
+ js_check_mba :: MutableByteArray# RealWorld -> IO Int
+
+foreign import javascript unsafe "(() => { const u8 = new Uint8Array(__exports.memory.buffer, $1, 4); return (u8[0] === 0x12 && u8[1] === 0x34 && u8[2] === 0x56 && u8[3] === 0x78) ? 1 : 0; })()"
+ js_check_ba :: ByteArray# -> IO Int
+
+foreign export javascript "main"
+ main :: IO ()
+
+main :: IO ()
+main =
+ IO $ \s0 ->
+ case newPinnedByteArray# 4# s0 of
+ (# s1, mba# #) ->
+ case (0x12 :: Word8) of { W8# b0# ->
+ case (0x34 :: Word8) of { W8# b1# ->
+ case (0x56 :: Word8) of { W8# b2# ->
+ case (0x78 :: Word8) of { W8# b3# ->
+ let s2 = writeWord8Array# mba# 0# b0# s1
+ s3 = writeWord8Array# mba# 1# b1# s2
+ s4 = writeWord8Array# mba# 2# b2# s3
+ s5 = writeWord8Array# mba# 3# b3# s4
+ in case unIO (js_check_mba mba#) s5 of
+ (# s6, ok_mba #) -> case unsafeFreezeByteArray# mba# s6 of
+ (# s7, ba# #) -> case unIO (js_check_ba ba#) s7 of
+ (# s8, ok_ba #) -> case unIO (print ok_mba) s8 of
+ (# s9, _ #) -> case unIO (print ok_ba) s9 of
+ (# s10, _ #) -> (# s10, () #)
+ }}}}
=====================================
testsuite/tests/jsffi/bytearrayarg.mjs
=====================================
@@ -0,0 +1,4 @@
+export default async (__exports) => {
+ await __exports.main();
+ process.exit();
+}
=====================================
testsuite/tests/jsffi/bytearrayarg.stdout
=====================================
@@ -0,0 +1,2 @@
+1
+1
=====================================
testsuite/tests/perf/should_run/all.T
=====================================
@@ -420,6 +420,7 @@ test('T17949', [collect_stats('bytes allocated', 1), only_ways(['normal'])], com
test('ByteCodeAsm',
[ extra_run_opts('"' + config.libdir + '"')
, js_broken(22261)
+ , when(arch('wasm32'), run_timeout_multiplier(10))
, collect_stats('bytes allocated', 10),
],
compile_and_run,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aea3ad2d6e58f4d56ee5318bff1ead2...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aea3ad2d6e58f4d56ee5318bff1ead2...
You're receiving this email because of your account on gitlab.haskell.org.
