[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: EPA: Preserve comments in Match Pats
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Apr 30 03:50:56 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
1c2fd963 by Alan Zimmerman at 2024-04-29T23:17:00-04:00
EPA: Preserve comments in Match Pats
Closes #24708
Closes #24715
Closes #24734
- - - - -
4189d17e by Sylvain Henry at 2024-04-29T23:17:42-04:00
LLVM: better unreachable default destination in Switch (#24717)
See added note.
Co-authored-by: Siddharth Bhat <siddu.druid at gmail.com>
- - - - -
a3725c88 by Cheng Shao at 2024-04-29T23:18:20-04:00
ci: enable wasm jobs for MRs with wasm label
This patch enables wasm jobs for MRs with wasm label. Previously the
wasm label didn't actually have any effect on the CI pipeline, and
full-ci needed to be applied to run wasm jobs which was a waste of
runners when working on the wasm backend, hence the fix here.
- - - - -
702f7964 by Matthew Pickering at 2024-04-29T23:18:56-04:00
Make interface files and object files depend on inplace .conf file
A potential fix for #24737
- - - - -
51385b33 by Cheng Shao at 2024-04-29T23:50:10-04:00
utils: remove obsolete vagrant scripts
Vagrantfile has long been removed in !5288. This commit further
removes the obsolete vagrant scripts in the tree.
- - - - -
2b0c0ee4 by Cheng Shao at 2024-04-29T23:50:11-04:00
Update autoconf scripts
Scripts taken from autoconf 948ae97ca5703224bd3eada06b7a69f40dd15a02
- - - - -
0ef9a788 by Ben Gamari at 2024-04-29T23:50:12-04:00
ghcup-metadata: Drop output_name field
This is entirely redundant to the filename of the URL. There is no
compelling reason to name the downloaded file differently from its
source.
- - - - -
15 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- config.guess
- config.sub
- hadrian/src/Rules/Compile.hs
- testsuite/tests/printer/Makefile
- + testsuite/tests/printer/MatchPatComments.hs
- testsuite/tests/printer/all.T
- utils/check-exact/Main.hs
- − utils/vagrant/bootstrap-deb.sh
- − utils/vagrant/bootstrap-rhel.sh
Changes:
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -603,6 +603,7 @@ data ValidateRule =
FullCI -- ^ Run this job when the "full-ci" label is present.
| LLVMBackend -- ^ Run this job when the "LLVM backend" label is present
| JSBackend -- ^ Run this job when the "javascript" label is present
+ | WasmBackend -- ^ Run this job when the "wasm" label is present
| FreeBSDLabel -- ^ Run this job when the "FreeBSD" label is set.
| NonmovingGc -- ^ Run this job when the "non-moving GC" label is set.
| IpeData -- ^ Run this job when the "IPE" label is set
@@ -649,6 +650,7 @@ validateRuleString FullCI = or_all ([ labelString "full-ci"
validateRuleString LLVMBackend = labelString "LLVM backend"
validateRuleString JSBackend = labelString "javascript"
+validateRuleString WasmBackend = labelString "wasm"
validateRuleString FreeBSDLabel = labelString "FreeBSD"
validateRuleString NonmovingGc = labelString "non-moving GC"
validateRuleString IpeData = labelString "IPE"
@@ -1048,7 +1050,7 @@ job_groups =
. setVariable "HADRIAN_ARGS" "--docs=none"
. delVariable "INSTALL_CONFIGURE_ARGS"
)
- $ validateBuilds Amd64 (Linux AlpineWasm) cfg
+ $ addValidateRule WasmBackend $ validateBuilds Amd64 (Linux AlpineWasm) cfg
wasm_build_config =
(crossConfig "wasm32-wasi" NoEmulatorNeeded Nothing)
=====================================
.gitlab/jobs.yaml
=====================================
@@ -4502,7 +4502,7 @@
],
"rules": [
{
- "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*wasm.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -4566,7 +4566,7 @@
"rules": [
{
"allow_failure": true,
- "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*wasm.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "manual"
}
],
@@ -4630,7 +4630,7 @@
"rules": [
{
"allow_failure": true,
- "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*wasm.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "manual"
}
],
=====================================
.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
=====================================
@@ -65,7 +65,6 @@ eprint(f"Supported platforms: {job_mapping.keys()}")
class Artifact(NamedTuple):
job_name: str
download_name: str
- output_name: str
subdir: str
# Platform spec provides a specification which is agnostic to Job
@@ -75,11 +74,9 @@ class PlatformSpec(NamedTuple):
subdir: str
source_artifact = Artifact('source-tarball'
- , 'ghc-{version}-src.tar.xz'
, 'ghc-{version}-src.tar.xz'
, 'ghc-{version}' )
test_artifact = Artifact('source-tarball'
- , 'ghc-{version}-testsuite.tar.xz'
, 'ghc-{version}-testsuite.tar.xz'
, 'ghc-{version}/testsuite' )
@@ -164,11 +161,6 @@ def mk_one_metadata(release_mode, version, job_map, artifact):
, "dlSubdir": artifact.subdir.format(version=version)
, "dlHash" : h }
- # Only add dlOutput if it is inconsistent with the filename inferred from the URL
- output = artifact.output_name.format(version=version)
- if Path(urlparse(final_url).path).name != output:
- res["dlOutput"] = output
-
eprint(res)
return res
=====================================
compiler/GHC/CmmToLlvm/CodeGen.hs
=====================================
@@ -56,6 +56,7 @@ data Signage = Signed | Unsigned deriving (Eq, Show)
genLlvmProc :: RawCmmDecl -> LlvmM [LlvmCmmDecl]
genLlvmProc (CmmProc infos lbl live graph) = do
let blocks = toBlockListEntryFirstFalseFallthrough graph
+
(lmblocks, lmdata) <- basicBlocksCodeGen live blocks
let info = mapLookup (g_entry graph) infos
proc = CmmProc info lbl live (ListGraph lmblocks)
@@ -67,6 +68,11 @@ genLlvmProc _ = panic "genLlvmProc: case that shouldn't reach here!"
-- * Block code generation
--
+-- | Unreachable basic block
+--
+-- See Note [Unreachable block as default destination in Switch]
+newtype UnreachableBlockId = UnreachableBlockId BlockId
+
-- | Generate code for a list of blocks that make up a complete
-- procedure. The first block in the list is expected to be the entry
-- point.
@@ -82,20 +88,27 @@ basicBlocksCodeGen live cmmBlocks
(prologue, prologueTops) <- funPrologue live cmmBlocks
let entryBlock = BasicBlock bid (fromOL prologue)
+ -- allocate one unreachable basic block that can be used as a default
+ -- destination in exhaustive switches.
+ --
+ -- See Note [Unreachable block as default destination in Switch]
+ ubid@(UnreachableBlockId ubid') <- (UnreachableBlockId . mkBlockId) <$> getUniqueM
+ let ubblock = BasicBlock ubid' [Unreachable]
+
-- Generate code
- (blocks, topss) <- fmap unzip $ mapM basicBlockCodeGen cmmBlocks
+ (blocks, topss) <- fmap unzip $ mapM (basicBlockCodeGen ubid) cmmBlocks
-- Compose
- return (entryBlock : blocks, prologueTops ++ concat topss)
+ return (entryBlock : ubblock : blocks, prologueTops ++ concat topss)
-- | Generate code for one block
-basicBlockCodeGen :: CmmBlock -> LlvmM ( LlvmBasicBlock, [LlvmCmmDecl] )
-basicBlockCodeGen block
+basicBlockCodeGen :: UnreachableBlockId -> CmmBlock -> LlvmM ( LlvmBasicBlock, [LlvmCmmDecl] )
+basicBlockCodeGen ubid block
= do let (_, nodes, tail) = blockSplit block
id = entryLabel block
- (mid_instrs, top) <- stmtsToInstrs $ blockToList nodes
- (tail_instrs, top') <- stmtToInstrs tail
+ (mid_instrs, top) <- stmtsToInstrs ubid $ blockToList nodes
+ (tail_instrs, top') <- stmtToInstrs ubid tail
let instrs = fromOL (mid_instrs `appOL` tail_instrs)
return (BasicBlock id instrs, top' ++ top)
@@ -110,15 +123,15 @@ type StmtData = (LlvmStatements, [LlvmCmmDecl])
-- | Convert a list of CmmNode's to LlvmStatement's
-stmtsToInstrs :: [CmmNode e x] -> LlvmM StmtData
-stmtsToInstrs stmts
- = do (instrss, topss) <- fmap unzip $ mapM stmtToInstrs stmts
+stmtsToInstrs :: UnreachableBlockId -> [CmmNode e x] -> LlvmM StmtData
+stmtsToInstrs ubid stmts
+ = do (instrss, topss) <- fmap unzip $ mapM (stmtToInstrs ubid) stmts
return (concatOL instrss, concat topss)
-- | Convert a CmmStmt to a list of LlvmStatement's
-stmtToInstrs :: CmmNode e x -> LlvmM StmtData
-stmtToInstrs stmt = case stmt of
+stmtToInstrs :: UnreachableBlockId -> CmmNode e x -> LlvmM StmtData
+stmtToInstrs ubid stmt = case stmt of
CmmComment _ -> return (nilOL, []) -- nuke comments
CmmTick _ -> return (nilOL, [])
@@ -131,7 +144,7 @@ stmtToInstrs stmt = case stmt of
CmmBranch id -> genBranch id
CmmCondBranch arg true false likely
-> genCondBranch arg true false likely
- CmmSwitch arg ids -> genSwitch arg ids
+ CmmSwitch arg ids -> genSwitch ubid arg ids
-- Foreign Call
CmmUnsafeForeignCall target res args
@@ -1305,21 +1318,38 @@ For a real example of this, see ./rts/StgStdThunks.cmm
-- | Switch branch
-genSwitch :: CmmExpr -> SwitchTargets -> LlvmM StmtData
-genSwitch cond ids = do
+genSwitch :: UnreachableBlockId -> CmmExpr -> SwitchTargets -> LlvmM StmtData
+genSwitch (UnreachableBlockId ubid) cond ids = do
(vc, stmts, top) <- exprToVar cond
let ty = getVarType vc
let labels = [ (mkIntLit ty ix, blockIdToLlvm b)
| (ix, b) <- switchTargetsCases ids ]
- -- out of range is undefined, so let's just branch to first label
let defLbl | Just l <- switchTargetsDefault ids = blockIdToLlvm l
- | otherwise = snd (head labels)
+ | otherwise = blockIdToLlvm ubid
+ -- switch to an unreachable basic block for exhaustive
+ -- switches. See Note [Unreachable block as default destination
+ -- in Switch]
let s1 = Switch vc defLbl labels
return $ (stmts `snocOL` s1, top)
+-- Note [Unreachable block as default destination in Switch]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- LLVM IR requires a default destination (a block label) for its Switch
+-- operation, even if the switch is exhaustive. An LLVM switch is considered
+-- exhausitve (e.g. to omit range checks for bit tests [1]) if the default
+-- destination is unreachable.
+--
+-- When we codegen a Cmm function, we always reserve an unreachable basic block
+-- that is used as a default destination for exhaustive Cmm switches in
+-- genSwitch. See #24717
+--
+-- [1] https://reviews.llvm.org/D68131
+
+
+
-- -----------------------------------------------------------------------------
-- * CmmExpr code generation
--
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -1244,7 +1244,7 @@ transferAnnsOnlyA (EpAnn a an cs) (EpAnn a' an' cs')
-- | Transfer comments from the annotations in the
-- first 'SrcSpanAnnA' argument to those in the second.
-transferCommentsOnlyA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
+transferCommentsOnlyA :: EpAnn a -> EpAnn b -> (EpAnn a, EpAnn b)
transferCommentsOnlyA (EpAnn a an cs) (EpAnn a' an' cs')
= (EpAnn a an emptyComments, EpAnn a' an' (cs <> cs'))
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1220,19 +1220,23 @@ checkLPat e@(L l _) = checkPat l e [] []
checkPat :: SrcSpanAnnA -> LocatedA (PatBuilder GhcPs) -> [HsConPatTyArg GhcPs] -> [LPat GhcPs]
-> PV (LPat GhcPs)
checkPat loc (L l e@(PatBuilderVar (L ln c))) tyargs args
- | isRdrDataCon c = return . L loc $ ConPat
- { pat_con_ext = noAnn -- AZ: where should this come from?
- , pat_con = L ln c
- , pat_args = PrefixCon tyargs args
- }
+ | isRdrDataCon c = do
+ let (_l', loc') = transferCommentsOnlyA l loc
+ return . L loc' $ ConPat
+ { pat_con_ext = noAnn -- AZ: where should this come from?
+ , pat_con = L ln c
+ , pat_args = PrefixCon tyargs args
+ }
| (not (null args) && patIsRec c) = do
ctx <- askParseContext
patFail (locA l) . PsErrInPat e $ PEIP_RecPattern args YesPatIsRecursive ctx
-checkPat loc (L _ (PatBuilderAppType f at t)) tyargs args =
- checkPat loc f (HsConPatTyArg at t : tyargs) args
-checkPat loc (L _ (PatBuilderApp f e)) [] args = do
- p <- checkLPat e
- checkPat loc f [] (p : args)
+checkPat loc (L _ (PatBuilderAppType (L lf f) at t)) tyargs args = do
+ let (loc', lf') = transferCommentsOnlyA loc lf
+ checkPat loc' (L lf' f) (HsConPatTyArg at t : tyargs) args
+checkPat loc (L _ (PatBuilderApp f (L le e))) [] args = do
+ let (loc', le') = transferCommentsOnlyA loc le
+ p <- checkLPat (L le' e)
+ checkPat loc' f [] (p : args)
checkPat loc (L l e) [] [] = do
p <- checkAPat loc e
return (L l p)
@@ -1432,20 +1436,27 @@ isFunLhs e = go e [] [] []
where
mk = fmap ArgPatBuilderVisPat
- go (L _ (PatBuilderVar (L loc f))) es ops cps
- | not (isRdrDataCon f) = return (Just (L loc f, Prefix, es, (reverse ops) ++ cps))
- go (L _ (PatBuilderApp f e)) es ops cps = go f (mk e:es) ops cps
- go (L l (PatBuilderPar _ e _)) es@(_:_) ops cps = go e es (o:ops) (c:cps)
+ go (L l (PatBuilderVar (L loc f))) es ops cps
+ | not (isRdrDataCon f) = do
+ let (_l, loc') = transferCommentsOnlyA l loc
+ return (Just (L loc' f, Prefix, es, (reverse ops) ++ cps))
+ go (L l (PatBuilderApp (L lf f) e)) es ops cps = do
+ let (_l, lf') = transferCommentsOnlyA l lf
+ go (L lf' f) (mk e:es) ops cps
+ go (L l (PatBuilderPar _ (L le e) _)) es@(_:_) ops cps = go (L le' e) es (o:ops) (c:cps)
-- NB: es@(_:_) means that there must be an arg after the parens for the
-- LHS to be a function LHS. This corresponds to the Haskell Report's definition
-- of funlhs.
where
+ (_l, le') = transferCommentsOnlyA l le
(o,c) = mkParensEpAnn (realSrcSpan $ locA l)
- go (L loc (PatBuilderOpApp l (L loc' op) r anns)) es ops cps
+ go (L loc (PatBuilderOpApp (L ll l) (L loc' op) r anns)) es ops cps
| not (isRdrDataCon op) -- We have found the function!
- = return (Just (L loc' op, Infix, (mk l:mk r:es), (anns ++ reverse ops ++ cps)))
+ = do { let (_l, ll') = transferCommentsOnlyA loc ll
+ ; return (Just (L loc' op, Infix, (mk (L ll' l):mk r:es), (anns ++ reverse ops ++ cps))) }
| otherwise -- Infix data con; keep going
- = do { mb_l <- go l es ops cps
+ = do { let (_l, ll') = transferCommentsOnlyA loc ll
+ ; mb_l <- go (L ll' l) es ops cps
; return (reassociate =<< mb_l) }
where
reassociate (op', Infix, j : L k_loc (ArgPatBuilderVisPat k) : es', anns')
@@ -1454,12 +1465,13 @@ isFunLhs e = go e [] [] []
op_app = mk $ L loc (PatBuilderOpApp (L k_loc k)
(L loc' op) r (reverse ops ++ cps))
reassociate _other = Nothing
- go (L _ (PatBuilderAppType pat tok ty_pat@(HsTP _ (L (EpAnn anc ann cs) _)))) es ops cps
- = go pat (L (EpAnn anc' ann cs) (ArgPatBuilderArgPat invis_pat) : es) ops cps
+ go (L l (PatBuilderAppType (L lp pat) tok ty_pat@(HsTP _ (L (EpAnn anc ann cs) _)))) es ops cps
+ = go (L lp' pat) (L (EpAnn anc' ann cs) (ArgPatBuilderArgPat invis_pat) : es) ops cps
where invis_pat = InvisPat tok ty_pat
anc' = case tok of
NoEpTok -> anc
EpTok l -> widenAnchor anc [AddEpAnn AnnAnyclass l]
+ (_l, lp') = transferCommentsOnlyA l lp
go _ _ _ _ = return Nothing
data ArgPatBuilder p
=====================================
config.guess
=====================================
@@ -1,10 +1,10 @@
#! /bin/sh
# Attempt to guess a canonical system name.
-# Copyright 1992-2022 Free Software Foundation, Inc.
+# Copyright 1992-2024 Free Software Foundation, Inc.
# shellcheck disable=SC2006,SC2268 # see below for rationale
-timestamp='2022-05-25'
+timestamp='2024-01-01'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -47,7 +47,7 @@ me=`echo "$0" | sed -e 's,.*/,,'`
usage="\
Usage: $0 [OPTION]
-Output the configuration name of the system \`$me' is run on.
+Output the configuration name of the system '$me' is run on.
Options:
-h, --help print this help, then exit
@@ -60,13 +60,13 @@ version="\
GNU config.guess ($timestamp)
Originally written by Per Bothner.
-Copyright 1992-2022 Free Software Foundation, Inc.
+Copyright 1992-2024 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
help="
-Try \`$me --help' for more information."
+Try '$me --help' for more information."
# Parse command line
while test $# -gt 0 ; do
@@ -102,8 +102,8 @@ GUESS=
# temporary files to be created and, as you can see below, it is a
# headache to deal with in a portable fashion.
-# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still
-# use `HOST_CC' if defined, but it is deprecated.
+# Historically, 'CC_FOR_BUILD' used to be named 'HOST_CC'. We still
+# use 'HOST_CC' if defined, but it is deprecated.
# Portable tmp directory creation inspired by the Autoconf team.
@@ -155,6 +155,9 @@ Linux|GNU|GNU/*)
set_cc_for_build
cat <<-EOF > "$dummy.c"
+ #if defined(__ANDROID__)
+ LIBC=android
+ #else
#include <features.h>
#if defined(__UCLIBC__)
LIBC=uclibc
@@ -162,6 +165,8 @@ Linux|GNU|GNU/*)
LIBC=dietlibc
#elif defined(__GLIBC__)
LIBC=gnu
+ #elif defined(__LLVM_LIBC__)
+ LIBC=llvm
#else
#include <stdarg.h>
/* First heuristic to detect musl libc. */
@@ -169,6 +174,7 @@ Linux|GNU|GNU/*)
LIBC=musl
#endif
#endif
+ #endif
EOF
cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`
eval "$cc_set_libc"
@@ -459,7 +465,7 @@ case $UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in
UNAME_RELEASE=`uname -v`
;;
esac
- # Japanese Language versions have a version number like `4.1.3-JL'.
+ # Japanese Language versions have a version number like '4.1.3-JL'.
SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/'`
GUESS=sparc-sun-sunos$SUN_REL
;;
@@ -904,7 +910,7 @@ EOF
fi
;;
*:FreeBSD:*:*)
- UNAME_PROCESSOR=`/usr/bin/uname -p`
+ UNAME_PROCESSOR=`uname -p`
case $UNAME_PROCESSOR in
amd64)
UNAME_PROCESSOR=x86_64 ;;
@@ -966,11 +972,37 @@ EOF
GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC
;;
+ x86_64:[Mm]anagarm:*:*|i?86:[Mm]anagarm:*:*)
+ GUESS="$UNAME_MACHINE-pc-managarm-mlibc"
+ ;;
+ *:[Mm]anagarm:*:*)
+ GUESS="$UNAME_MACHINE-unknown-managarm-mlibc"
+ ;;
*:Minix:*:*)
GUESS=$UNAME_MACHINE-unknown-minix
;;
aarch64:Linux:*:*)
- GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ set_cc_for_build
+ CPU=$UNAME_MACHINE
+ LIBCABI=$LIBC
+ if test "$CC_FOR_BUILD" != no_compiler_found; then
+ ABI=64
+ sed 's/^ //' << EOF > "$dummy.c"
+ #ifdef __ARM_EABI__
+ #ifdef __ARM_PCS_VFP
+ ABI=eabihf
+ #else
+ ABI=eabi
+ #endif
+ #endif
+EOF
+ cc_set_abi=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^ABI' | sed 's, ,,g'`
+ eval "$cc_set_abi"
+ case $ABI in
+ eabi | eabihf) CPU=armv8l; LIBCABI=$LIBC$ABI ;;
+ esac
+ fi
+ GUESS=$CPU-unknown-linux-$LIBCABI
;;
aarch64_be:Linux:*:*)
UNAME_MACHINE=aarch64_be
@@ -1036,7 +1068,16 @@ EOF
k1om:Linux:*:*)
GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
;;
- loongarch32:Linux:*:* | loongarch64:Linux:*:* | loongarchx32:Linux:*:*)
+ kvx:Linux:*:*)
+ GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
+ ;;
+ kvx:cos:*:*)
+ GUESS=$UNAME_MACHINE-unknown-cos
+ ;;
+ kvx:mbr:*:*)
+ GUESS=$UNAME_MACHINE-unknown-mbr
+ ;;
+ loongarch32:Linux:*:* | loongarch64:Linux:*:*)
GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
;;
m32r*:Linux:*:*)
@@ -1191,7 +1232,7 @@ EOF
GUESS=$UNAME_MACHINE-pc-sysv4.2uw$UNAME_VERSION
;;
i*86:OS/2:*:*)
- # If we were able to find `uname', then EMX Unix compatibility
+ # If we were able to find 'uname', then EMX Unix compatibility
# is probably installed.
GUESS=$UNAME_MACHINE-pc-os2-emx
;;
@@ -1332,7 +1373,7 @@ EOF
GUESS=ns32k-sni-sysv
fi
;;
- PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
+ PENTIUM:*:4.0*:*) # Unisys 'ClearPath HMP IX 4000' SVR4/MP effort
# says <Richard.M.Bartel at ccMail.Census.GOV>
GUESS=i586-unisys-sysv4
;;
@@ -1554,6 +1595,9 @@ EOF
*:Unleashed:*:*)
GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE
;;
+ *:Ironclad:*:*)
+ GUESS=$UNAME_MACHINE-unknown-ironclad
+ ;;
esac
# Do we have a guess based on uname results?
=====================================
config.sub
=====================================
@@ -1,10 +1,10 @@
#! /bin/sh
# Configuration validation subroutine script.
-# Copyright 1992-2022 Free Software Foundation, Inc.
+# Copyright 1992-2024 Free Software Foundation, Inc.
# shellcheck disable=SC2006,SC2268 # see below for rationale
-timestamp='2022-01-03'
+timestamp='2024-01-01'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -76,13 +76,13 @@ Report bugs and patches to <config-patches at gnu.org>."
version="\
GNU config.sub ($timestamp)
-Copyright 1992-2022 Free Software Foundation, Inc.
+Copyright 1992-2024 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
help="
-Try \`$me --help' for more information."
+Try '$me --help' for more information."
# Parse command line
while test $# -gt 0 ; do
@@ -130,7 +130,7 @@ IFS=$saved_IFS
# Separate into logical components for further validation
case $1 in
*-*-*-*-*)
- echo Invalid configuration \`"$1"\': more than four components >&2
+ echo "Invalid configuration '$1': more than four components" >&2
exit 1
;;
*-*-*-*)
@@ -145,7 +145,8 @@ case $1 in
nto-qnx* | linux-* | uclinux-uclibc* \
| uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \
| netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \
- | storm-chaos* | os2-emx* | rtmk-nova*)
+ | storm-chaos* | os2-emx* | rtmk-nova* | managarm-* \
+ | windows-* )
basic_machine=$field1
basic_os=$maybe_os
;;
@@ -943,7 +944,7 @@ $basic_machine
EOF
IFS=$saved_IFS
;;
- # We use `pc' rather than `unknown'
+ # We use 'pc' rather than 'unknown'
# because (1) that's what they normally are, and
# (2) the word "unknown" tends to confuse beginning users.
i*86 | x86_64)
@@ -1075,7 +1076,7 @@ case $cpu-$vendor in
pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
cpu=i586
;;
- pentiumpro-* | p6-* | 6x86-* | athlon-* | athalon_*-*)
+ pentiumpro-* | p6-* | 6x86-* | athlon-* | athlon_*-*)
cpu=i686
;;
pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
@@ -1180,7 +1181,7 @@ case $cpu-$vendor in
case $cpu in
1750a | 580 \
| a29k \
- | aarch64 | aarch64_be \
+ | aarch64 | aarch64_be | aarch64c | arm64ec \
| abacus \
| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] \
| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] \
@@ -1190,7 +1191,7 @@ case $cpu-$vendor in
| arc | arceb | arc32 | arc64 \
| arm | arm[lb]e | arme[lb] | armv* \
| avr | avr32 \
- | asmjs | javascript \
+ | asmjs \
| ba \
| be32 | be64 \
| bfin | bpf | bs2000 \
@@ -1199,50 +1200,29 @@ case $cpu-$vendor in
| d10v | d30v | dlx | dsp16xx \
| e2k | elxsi | epiphany \
| f30[01] | f700 | fido | fr30 | frv | ft32 | fx80 \
+ | javascript \
| h8300 | h8500 \
| hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
| hexagon \
| i370 | i*86 | i860 | i960 | ia16 | ia64 \
| ip2k | iq2000 \
| k1om \
+ | kvx \
| le32 | le64 \
| lm32 \
- | loongarch32 | loongarch64 | loongarchx32 \
+ | loongarch32 | loongarch64 \
| m32c | m32r | m32rle \
| m5200 | m68000 | m680[012346]0 | m68360 | m683?2 | m68k \
| m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x \
| m88110 | m88k | maxq | mb | mcore | mep | metag \
| microblaze | microblazeel \
- | mips | mipsbe | mipseb | mipsel | mipsle \
- | mips16 \
- | mips64 | mips64eb | mips64el \
- | mips64octeon | mips64octeonel \
- | mips64orion | mips64orionel \
- | mips64r5900 | mips64r5900el \
- | mips64vr | mips64vrel \
- | mips64vr4100 | mips64vr4100el \
- | mips64vr4300 | mips64vr4300el \
- | mips64vr5000 | mips64vr5000el \
- | mips64vr5900 | mips64vr5900el \
- | mipsisa32 | mipsisa32el \
- | mipsisa32r2 | mipsisa32r2el \
- | mipsisa32r3 | mipsisa32r3el \
- | mipsisa32r5 | mipsisa32r5el \
- | mipsisa32r6 | mipsisa32r6el \
- | mipsisa64 | mipsisa64el \
- | mipsisa64r2 | mipsisa64r2el \
- | mipsisa64r3 | mipsisa64r3el \
- | mipsisa64r5 | mipsisa64r5el \
- | mipsisa64r6 | mipsisa64r6el \
- | mipsisa64sb1 | mipsisa64sb1el \
- | mipsisa64sr71k | mipsisa64sr71kel \
- | mipsr5900 | mipsr5900el \
- | mipstx39 | mipstx39el \
+ | mips* \
| mmix \
| mn10200 | mn10300 \
| moxie \
| mt \
| msp430 \
+ | nanomips* \
| nds32 | nds32le | nds32be \
| nfp \
| nios | nios2 | nios2eb | nios2el \
@@ -1274,6 +1254,7 @@ case $cpu-$vendor in
| ubicom32 \
| v70 | v850 | v850e | v850e1 | v850es | v850e2 | v850e2v3 \
| vax \
+ | vc4 \
| visium \
| w65 \
| wasm32 | wasm64 \
@@ -1285,7 +1266,7 @@ case $cpu-$vendor in
;;
*)
- echo Invalid configuration \`"$1"\': machine \`"$cpu-$vendor"\' not recognized 1>&2
+ echo "Invalid configuration '$1': machine '$cpu-$vendor' not recognized" 1>&2
exit 1
;;
esac
@@ -1306,11 +1287,12 @@ esac
# Decode manufacturer-specific aliases for certain operating systems.
-if test x$basic_os != x
+if test x"$basic_os" != x
then
# First recognize some ad-hoc cases, or perhaps split kernel-os, or else just
# set os.
+obj=
case $basic_os in
gnu/linux*)
kernel=linux
@@ -1341,6 +1323,10 @@ EOF
kernel=linux
os=`echo "$basic_os" | sed -e 's|linux|gnu|'`
;;
+ managarm*)
+ kernel=managarm
+ os=`echo "$basic_os" | sed -e 's|managarm|mlibc|'`
+ ;;
*)
kernel=
os=$basic_os
@@ -1506,10 +1492,16 @@ case $os in
os=eabi
;;
*)
- os=elf
+ os=
+ obj=elf
;;
esac
;;
+ aout* | coff* | elf* | pe*)
+ # These are machine code file formats, not OSes
+ obj=$os
+ os=
+ ;;
*)
# No normalization, but not necessarily accepted, that comes below.
;;
@@ -1528,12 +1520,15 @@ else
# system, and we'll never get to this point.
kernel=
+obj=
case $cpu-$vendor in
score-*)
- os=elf
+ os=
+ obj=elf
;;
spu-*)
- os=elf
+ os=
+ obj=elf
;;
*-acorn)
os=riscix1.2
@@ -1543,28 +1538,35 @@ case $cpu-$vendor in
os=gnu
;;
arm*-semi)
- os=aout
+ os=
+ obj=aout
;;
c4x-* | tic4x-*)
- os=coff
+ os=
+ obj=coff
;;
c8051-*)
- os=elf
+ os=
+ obj=elf
;;
clipper-intergraph)
os=clix
;;
hexagon-*)
- os=elf
+ os=
+ obj=elf
;;
tic54x-*)
- os=coff
+ os=
+ obj=coff
;;
tic55x-*)
- os=coff
+ os=
+ obj=coff
;;
tic6x-*)
- os=coff
+ os=
+ obj=coff
;;
# This must come before the *-dec entry.
pdp10-*)
@@ -1586,19 +1588,24 @@ case $cpu-$vendor in
os=sunos3
;;
m68*-cisco)
- os=aout
+ os=
+ obj=aout
;;
mep-*)
- os=elf
+ os=
+ obj=elf
;;
mips*-cisco)
- os=elf
+ os=
+ obj=elf
;;
- mips*-*)
- os=elf
+ mips*-*|nanomips*-*)
+ os=
+ obj=elf
;;
or32-*)
- os=coff
+ os=
+ obj=coff
;;
*-tti) # must be before sparc entry or we get the wrong os.
os=sysv3
@@ -1607,7 +1614,8 @@ case $cpu-$vendor in
os=sunos4.1.1
;;
pru-*)
- os=elf
+ os=
+ obj=elf
;;
*-be)
os=beos
@@ -1688,10 +1696,12 @@ case $cpu-$vendor in
os=uxpv
;;
*-rom68k)
- os=coff
+ os=
+ obj=coff
;;
*-*bug)
- os=coff
+ os=
+ obj=coff
;;
*-apple)
os=macos
@@ -1709,14 +1719,11 @@ esac
fi
-# Now, validate our (potentially fixed-up) OS.
-case $os in
- # GHC specific: added for JS backend support
- js | ghcjs)
- ;;
+# Now, validate our (potentially fixed-up) individual pieces (OS, OBJ).
- # Sometimes we do "kernel-abi", so those need to count as OSes.
- musl* | newlib* | relibc* | uclibc*)
+case $os in
+ # Sometimes we do "kernel-libc", so those need to count as OSes.
+ llvm* | musl* | newlib* | relibc* | uclibc*)
;;
# Likewise for "kernel-abi"
eabi* | gnueabi*)
@@ -1724,6 +1731,9 @@ case $os in
# VxWorks passes extra cpu info in the 4th filed.
simlinux | simwindows | spe)
;;
+ # See `case $cpu-$os` validation below
+ ghcjs)
+ ;;
# Now accept the basic system types.
# The portable systems comes first.
# Each alternative MUST end in a * to match a version number.
@@ -1732,7 +1742,7 @@ case $os in
| hpux* | unos* | osf* | luna* | dgux* | auroraux* | solaris* \
| sym* | plan9* | psp* | sim* | xray* | os68k* | v88r* \
| hiux* | abug | nacl* | netware* | windows* \
- | os9* | macos* | osx* | ios* \
+ | os9* | macos* | osx* | ios* | tvos* | watchos* \
| mpw* | magic* | mmixware* | mon960* | lnews* \
| amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \
| aos* | aros* | cloudabi* | sortix* | twizzler* \
@@ -1741,11 +1751,11 @@ case $os in
| mirbsd* | netbsd* | dicos* | openedition* | ose* \
| bitrig* | openbsd* | secbsd* | solidbsd* | libertybsd* | os108* \
| ekkobsd* | freebsd* | riscix* | lynxos* | os400* \
- | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \
- | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \
+ | bosx* | nextstep* | cxux* | oabi* \
+ | ptx* | ecoff* | winnt* | domain* | vsta* \
| udi* | lites* | ieee* | go32* | aux* | hcos* \
| chorusrdb* | cegcc* | glidix* | serenity* \
- | cygwin* | msys* | pe* | moss* | proelf* | rtems* \
+ | cygwin* | msys* | moss* | proelf* | rtems* \
| midipix* | mingw32* | mingw64* | mint* \
| uxpv* | beos* | mpeix* | udk* | moxiebox* \
| interix* | uwin* | mks* | rhapsody* | darwin* \
@@ -1758,49 +1768,116 @@ case $os in
| onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \
| midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \
| nsk* | powerunix* | genode* | zvmoe* | qnx* | emx* | zephyr* \
- | fiwix* )
+ | fiwix* | mlibc* | cos* | mbr* | ironclad* )
;;
# This one is extra strict with allowed versions
sco3.2v2 | sco3.2v[4-9]* | sco5v6*)
# Don't forget version if it is 3.2v4 or newer.
;;
+ # This refers to builds using the UEFI calling convention
+ # (which depends on the architecture) and PE file format.
+ # Note that this is both a different calling convention and
+ # different file format than that of GNU-EFI
+ # (x86_64-w64-mingw32).
+ uefi)
+ ;;
none)
;;
+ kernel* | msvc* )
+ # Restricted further below
+ ;;
+ '')
+ if test x"$obj" = x
+ then
+ echo "Invalid configuration '$1': Blank OS only allowed with explicit machine code file format" 1>&2
+ fi
+ ;;
*)
- echo Invalid configuration \`"$1"\': OS \`"$os"\' not recognized 1>&2
+ echo "Invalid configuration '$1': OS '$os' not recognized" 1>&2
+ exit 1
+ ;;
+esac
+
+case $obj in
+ aout* | coff* | elf* | pe*)
+ ;;
+ '')
+ # empty is fine
+ ;;
+ *)
+ echo "Invalid configuration '$1': Machine code format '$obj' not recognized" 1>&2
+ exit 1
+ ;;
+esac
+
+# Here we handle the constraint that a (synthetic) cpu and os are
+# valid only in combination with each other and nowhere else.
+case $cpu-$os in
+ # The "javascript-unknown-ghcjs" triple is used by GHC; we
+ # accept it here in order to tolerate that, but reject any
+ # variations.
+ javascript-ghcjs)
+ ;;
+ javascript-* | *-ghcjs)
+ echo "Invalid configuration '$1': cpu '$cpu' is not valid with os '$os$obj'" 1>&2
exit 1
;;
esac
# As a final step for OS-related things, validate the OS-kernel combination
# (given a valid OS), if there is a kernel.
-case $kernel-$os in
- linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* \
- | linux-musl* | linux-relibc* | linux-uclibc* )
+case $kernel-$os-$obj in
+ linux-gnu*- | linux-android*- | linux-dietlibc*- | linux-llvm*- \
+ | linux-mlibc*- | linux-musl*- | linux-newlib*- \
+ | linux-relibc*- | linux-uclibc*- )
+ ;;
+ uclinux-uclibc*- )
+ ;;
+ managarm-mlibc*- | managarm-kernel*- )
;;
- uclinux-uclibc* )
+ windows*-msvc*-)
;;
- -dietlibc* | -newlib* | -musl* | -relibc* | -uclibc* )
+ -dietlibc*- | -llvm*- | -mlibc*- | -musl*- | -newlib*- | -relibc*- \
+ | -uclibc*- )
# These are just libc implementations, not actual OSes, and thus
# require a kernel.
- echo "Invalid configuration \`$1': libc \`$os' needs explicit kernel." 1>&2
+ echo "Invalid configuration '$1': libc '$os' needs explicit kernel." 1>&2
exit 1
;;
- kfreebsd*-gnu* | kopensolaris*-gnu*)
+ -kernel*- )
+ echo "Invalid configuration '$1': '$os' needs explicit kernel." 1>&2
+ exit 1
;;
- vxworks-simlinux | vxworks-simwindows | vxworks-spe)
+ *-kernel*- )
+ echo "Invalid configuration '$1': '$kernel' does not support '$os'." 1>&2
+ exit 1
;;
- nto-qnx*)
+ *-msvc*- )
+ echo "Invalid configuration '$1': '$os' needs 'windows'." 1>&2
+ exit 1
;;
- os2-emx)
+ kfreebsd*-gnu*- | kopensolaris*-gnu*-)
+ ;;
+ vxworks-simlinux- | vxworks-simwindows- | vxworks-spe-)
+ ;;
+ nto-qnx*-)
+ ;;
+ os2-emx-)
;;
- *-eabi* | *-gnueabi*)
+ *-eabi*- | *-gnueabi*-)
;;
- -*)
+ none--*)
+ # None (no kernel, i.e. freestanding / bare metal),
+ # can be paired with an machine code file format
+ ;;
+ -*-)
# Blank kernel with real OS is always fine.
;;
- *-*)
- echo "Invalid configuration \`$1': Kernel \`$kernel' not known to work with OS \`$os'." 1>&2
+ --*)
+ # Blank kernel and OS with real machine code file format is always fine.
+ ;;
+ *-*-*)
+ echo "Invalid configuration '$1': Kernel '$kernel' not known to work with OS '$os'." 1>&2
exit 1
;;
esac
@@ -1883,7 +1960,7 @@ case $vendor in
;;
esac
-echo "$cpu-$vendor-${kernel:+$kernel-}$os"
+echo "$cpu-$vendor${kernel:+-$kernel}${os:+-$os}${obj:+-$obj}"
exit
# Local variables:
=====================================
hadrian/src/Rules/Compile.hs
=====================================
@@ -218,6 +218,9 @@ compileHsObjectAndHi rs objpath = do
ctxPath <- contextPath ctx
(src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath
need (src:deps)
+ -- The .conf file is needed when template-haskell is implicitly added as a dependency
+ -- when a module in the template-haskell package is compiled. (See #24737)
+ when (isLibrary (C.package ctx)) (need . (:[]) =<< pkgConfFile ctx)
-- The .dependencies file lists indicating inputs. ghc will
-- generally read more *.hi and *.hi-boot files (direct inputs).
=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -831,3 +831,8 @@ PprLetIn:
CaseAltComments:
$(CHECK_PPR) $(LIBDIR) CaseAltComments.hs
$(CHECK_EXACT) $(LIBDIR) CaseAltComments.hs
+
+.PHONY: MatchPatComments
+MatchPatComments:
+ $(CHECK_PPR) $(LIBDIR) MatchPatComments.hs
+ $(CHECK_EXACT) $(LIBDIR) MatchPatComments.hs
=====================================
testsuite/tests/printer/MatchPatComments.hs
=====================================
@@ -0,0 +1,16 @@
+module MatchPatComments where
+
+expandProcess
+ outCHAs -- c0
+ locationDescr =
+ blah
+
+next
+ ( steps -- c1
+ , ys -- c2
+ ) x -- c3
+ = (steps, x, ys)
+
+makeProjection
+ Function{funMutual = VV, -- c4
+ funAbstr = ConcreteDef} = undefined
=====================================
testsuite/tests/printer/all.T
=====================================
@@ -199,3 +199,4 @@ test('AnnotationNoListTuplePuns', [ignore_stderr, req_ppr_deps], makefile_test,
test('Test24533', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24533'])
test('PprLetIn', [ignore_stderr, req_ppr_deps], makefile_test, ['PprLetIn'])
test('CaseAltComments', [ignore_stderr, req_ppr_deps], makefile_test, ['CaseAltComments'])
+test('MatchPatComments', [ignore_stderr, req_ppr_deps], makefile_test, ['MatchPatComments'])
=====================================
utils/check-exact/Main.hs
=====================================
@@ -128,7 +128,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/
-- "../../testsuite/tests/printer/Ppr034.hs" Nothing
-- "../../testsuite/tests/printer/Ppr035.hs" Nothing
-- "../../testsuite/tests/printer/Ppr036.hs" Nothing
- "../../testsuite/tests/printer/Ppr037.hs" Nothing
+ "../../testsuite/tests/printer/MatchPatComments.hs" Nothing
-- "../../testsuite/tests/printer/Ppr038.hs" Nothing
-- "../../testsuite/tests/printer/Ppr039.hs" Nothing
-- "../../testsuite/tests/printer/Ppr040.hs" Nothing
=====================================
utils/vagrant/bootstrap-deb.sh deleted
=====================================
@@ -1,3 +0,0 @@
-#!/bin/sh
-apt-get update
-apt-get build-dep -y ghc
=====================================
utils/vagrant/bootstrap-rhel.sh deleted
=====================================
@@ -1,4 +0,0 @@
-#!/bin/sh
-yum update -y
-yum install -y glibc-devel ncurses-devel gmp-devel autoconf automake libtool \
- gcc make python ghc git
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d9a38ef82b4dc7c2ba64a21148c9d952950a15ef...0ef9a788561644ee458075c200c0d45a57c68ef6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d9a38ef82b4dc7c2ba64a21148c9d952950a15ef...0ef9a788561644ee458075c200c0d45a57c68ef6
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240429/99c16bf3/attachment-0001.html>
More information about the ghc-commits
mailing list