[Git][ghc/ghc][master] 3 commits: StgToByteCode: Don't assume that data con workers are nullary
by Marge Bot (＠marge-bot) 19 Sep '25
by Marge Bot (＠marge-bot) 19 Sep '25
19 Sep '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d1d9e39e by Ben Gamari at 2025-09-19T18:24:52-04:00
StgToByteCode: Don't assume that data con workers are nullary
Previously StgToByteCode assumed that all data-con workers were of a
nullary representation. This is not a valid assumption, as seen
in #23210, where an unsaturated application of a unary data
constructor's worker resulted in invalid bytecode. Sadly, I have not yet
been able to reduce a minimal testcase for this.
Fixes #23210.
- - - - -
3eeecd50 by Ben Gamari at 2025-09-19T18:24:53-04:00
testsuite: Mark T23146* as unbroken
- - - - -
2e73f342 by sheaf at 2025-09-19T18:24:53-04:00
Add test for #26216
- - - - -
8 changed files:
- compiler/GHC/StgToByteCode.hs
- rts/Interpreter.c
- + testsuite/tests/bytecode/T26216.hs
- + testsuite/tests/bytecode/T26216.script
- + testsuite/tests/bytecode/T26216.stdout
- + testsuite/tests/bytecode/T26216_aux.hs
- testsuite/tests/bytecode/all.T
- testsuite/tests/codeGen/should_run/T23146/all.T
Changes:
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -2331,11 +2331,12 @@ pushAtom d p (StgVarArg var)
-- PUSH_G doesn't tag constructors. So we use PACK here
-- if we are dealing with nullary constructor.
case isDataConWorkId_maybe var of
- Just con -> do
- massert (isNullaryRepDataCon con)
- return (unitOL (PACK con 0), szb)
+ Just con
+ -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make.
+ | isNullaryRepDataCon con ->
+ return (unitOL (PACK con 0), szb)
- Nothing
+ _
-- see Note [Generating code for top-level string literal bindings]
| idType var `eqType` addrPrimTy ->
return (unitOL (PUSH_ADDR (getName var)), szb)
=====================================
rts/Interpreter.c
=====================================
@@ -2227,7 +2227,6 @@ run_BCO:
// n_nptrs=1, n_ptrs=0.
ASSERT(n_ptrs + n_nptrs == n_words || (n_nptrs == 1 && n_ptrs == 0));
ASSERT(n_ptrs + n_nptrs > 0);
- //ASSERT(n_words > 0); // We shouldn't ever need to allocate nullary constructors
for (W_ i = 0; i < n_words; i++) {
con->payload[i] = (StgClosure*)ReadSpW(i);
}
=====================================
testsuite/tests/bytecode/T26216.hs
=====================================
@@ -0,0 +1,28 @@
+{-# LANGUAGE GHC2024, BlockArguments, MagicHash #-}
+
+module T26216 (main) where
+
+import Data.Kind (Type, Constraint)
+import GHC.TypeNats
+import GHC.Exts (proxy#)
+
+import T26216_aux
+
+getN :: forall (n :: Nat). SNat n -> Natural
+getN s = withKnownNat s (natVal s)
+
+type C :: forall {k}. (k -> Constraint) -> k -> Type
+data C c a where { C :: c a => C c a }
+
+know :: forall (n :: Nat). SNat n -> C KnownNat n
+know s = withKnownNat s C
+
+getC :: forall (n :: Nat). C KnownNat n -> Natural
+getC C = natVal' (proxy# @n)
+
+main :: IO ()
+main = do
+ let !s = mkSome $ natSing @42
+ !c = withSome s $ mkSome . know
+ print $ withSome s getN
+ print $ withSome c getC
=====================================
testsuite/tests/bytecode/T26216.script
=====================================
@@ -0,0 +1,2 @@
+:l T26216
+main
=====================================
testsuite/tests/bytecode/T26216.stdout
=====================================
@@ -0,0 +1,2 @@
+42
+42
=====================================
testsuite/tests/bytecode/T26216_aux.hs
=====================================
@@ -0,0 +1,25 @@
+{-# LANGUAGE GHC2024 #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PolyKinds #-}
+
+module T26216_aux (Some, data Some, mkSome, withSome) where
+import Data.Kind (Type)
+import GHC.Exts (Any)
+import Unsafe.Coerce (unsafeCoerce)
+
+type Some :: (k -> Type) -> Type
+newtype Some tag = UnsafeSome (tag Any)
+type role Some representational
+
+{-# COMPLETE Some #-}
+pattern Some :: tag a -> Some tag
+pattern Some x <- UnsafeSome x
+ where Some x = UnsafeSome ((unsafeCoerce :: tag a -> tag Any) x)
+
+-- | Constructor.
+mkSome :: tag a -> Some tag
+mkSome = \x -> UnsafeSome (unsafeCoerce x)
+
+-- | Eliminator.
+withSome :: Some tag -> (forall a. tag a -> b) -> b
+withSome (UnsafeSome thing) some = some (unsafeCoerce thing)
=====================================
testsuite/tests/bytecode/all.T
=====================================
@@ -5,3 +5,7 @@ test('T23068', ghci_dump_bcos + [filter_stdout_lines(r'.*bitmap: .*')], ghci_scr
test('T25975', extra_ways(ghci_ways), compile_and_run,
# Some of the examples work more robustly with these flags
['-fno-break-points -fno-full-laziness'])
+
+# Nullary data constructors
+test('T26216', extra_files(["T26216_aux.hs"]), ghci_script, ['T26216.script'])
+
=====================================
testsuite/tests/codeGen/should_run/T23146/all.T
=====================================
@@ -1,4 +1,4 @@
test('T23146', normal, compile_and_run, [''])
test('T23146_lifted', normal, compile_and_run, [''])
-test('T23146_liftedeq', expect_broken_for(23060, ghci_ways), compile_and_run, [''])
+test('T23146_liftedeq', normal, compile_and_run, [''])
test('T23146_lifted_unlifted', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1480872af6b80db1b035a444091884…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1480872af6b80db1b035a444091884…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
19 Sep '25
Cheng Shao pushed new branch wip/wasm-dyld-fix-got-func at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/wasm-dyld-fix-got-func
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: Fix output of T14999 (#23685)
by Marge Bot (＠marge-bot) 19 Sep '25
by Marge Bot (＠marge-bot) 19 Sep '25
19 Sep '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
0a9d9ffc by Sylvain Henry at 2025-09-19T13:12:14-04:00
Fix output of T14999 (#23685)
Fix output of T14999 to:
- take into account the +1 offset to DW_AT_low_pc (see Note [Info Offset])
- always use Intel's syntax to force consistency: it was reported that
sometimes GDB prints `jmpq` instead of `jmp` with the AT&T syntax
- - - - -
1480872a by Vladislav Zavialov at 2025-09-19T13:12:54-04:00
Fix PREP_MAYBE_LIBRARY in prep_target_file.m4
This change fixes a configure error introduced in:
commit 8235dd8c4945db9cb03e3be3c388d729d576ed1e
ghc-toolchain: Move UseLibdw to per-Target file
Now the build no longer fails with:
acghc-toolchain: Failed to read a valid Target value from hadrian/cfg/default.target
- - - - -
1a24ffae by Ben Gamari at 2025-09-19T13:44:24-04:00
StgToByteCode: Don't assume that data con workers are nullary
Previously StgToByteCode assumed that all data-con workers were of a
nullary representation. This is not a valid assumption, as seen
in #23210, where an unsaturated application of a unary data
constructor's worker resulted in invalid bytecode. Sadly, I have not yet
been able to reduce a minimal testcase for this.
Fixes #23210.
- - - - -
edc5f887 by Ben Gamari at 2025-09-19T13:44:24-04:00
testsuite: Mark T23146* as unbroken
- - - - -
5a55ada5 by sheaf at 2025-09-19T13:44:24-04:00
Add test for #26216
- - - - -
d80e9302 by Sven Tennie at 2025-09-19T13:44:25-04:00
Generate correct test header
This increases convenience when copying & pasting...
- - - - -
6f72a6cb by Sven Tennie at 2025-09-19T13:44:25-04:00
foundation test: Fix shift amount (#26248)
Shift primops' results are only defined for shift amounts of 0 to word
size - 1. The approach is similar to testing div-like operations (which
have a constraint regarding zero operands.)
This was partly vibe coded (https://github.com/supersven/ghc/pull/1) but
then heavily refactored.
- - - - -
a5a197bb by Andreas Klebinger at 2025-09-19T13:44:26-04:00
Tweak jspace test
I've given it a longer timeout, and tweaked the test file generation
to speed it up a bit. Hopefully that is enough to make it constentily pass.
Last but not least it now also always uses three threads.
- - - - -
5ddac836 by Cheng Shao at 2025-09-19T13:44:27-04:00
rts: remove obsolete CC_SUPPORTS_TLS logic
This patch removes obsolete CC_SUPPORTS_TLS logic throughout the rts,
given __thread is now uniformly supported by C toolchains of all
platforms we currently support.
- - - - -
6d2a9a17 by Cheng Shao at 2025-09-19T13:44:27-04:00
rts: remove obsolete HAS_VISIBILITY_HIDDEN logic
This patch removes obsolete HAS_VISIBILITY_HIDDEN logic throughout the
rts, given __attribute__((visibility("hidden"))) is uniformly
supported by C toolchains of all platforms we currently support.
- - - - -
c6a1f69a by Cheng Shao at 2025-09-19T13:44:28-04:00
rts: remove -O3 pragma hack in Hash.c
This patch removes an obsolete gcc pragma to specify -O3 in Hash.c.
Hadrian already passes the right flag.
- - - - -
e1748a38 by Cheng Shao at 2025-09-19T13:44:29-04:00
rts: remove obsolete COMPILING_WINDOWS_DLL logic
This patch removes obsolete COMPILING_WINDOWS_DLL logic throughout the
rts. They were once used for compiling to win32 DLLs, but we haven't
been able to compile Haskell units to win32 DLLs for many years now,
due to PE format's restriction of no more than 65536 exported symbols
in a single DLL.
- - - - -
72d6dabe by Cheng Shao at 2025-09-19T13:44:30-04:00
wasm: bump browser_wasi_shim to 0.4.2
This patch bumps the browser_wasi_shim dependency of wasm dyld script
to 0.4.2.
- - - - -
41 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/StgToByteCode.hs
- − m4/fp_visibility_hidden.m4
- m4/prep_target_file.m4
- rts/BeginPrivate.h
- rts/EndPrivate.h
- rts/Hash.c
- rts/Interpreter.c
- − rts/RtsDllMain.c
- − rts/RtsDllMain.h
- rts/RtsSymbols.c
- rts/StgMiscClosures.cmm
- rts/Task.c
- rts/Task.h
- rts/configure.ac
- rts/include/Rts.h
- rts/include/RtsAPI.h
- rts/include/rts/OSThreads.h
- rts/include/stg/DLL.h
- rts/posix/OSThreads.c
- rts/rts.cabal
- rts/sm/Evac.c
- rts/sm/GCTDecl.h
- rts/sm/GCThread.h
- rts/sm/Storage.c
- rts/win32/OSThreads.c
- + testsuite/tests/bytecode/T26216.hs
- + testsuite/tests/bytecode/T26216.script
- + testsuite/tests/bytecode/T26216.stdout
- + testsuite/tests/bytecode/T26216_aux.hs
- testsuite/tests/bytecode/all.T
- testsuite/tests/codeGen/should_compile/Makefile
- testsuite/tests/codeGen/should_compile/T14999.stdout
- testsuite/tests/codeGen/should_run/T23146/all.T
- testsuite/tests/driver/j-space/Makefile
- testsuite/tests/driver/j-space/all.T
- testsuite/tests/driver/j-space/genJspace
- testsuite/tests/numeric/should_run/foundation.hs
- utils/genprimopcode/Main.hs
- utils/genprimopcode/Syntax.hs
- utils/jsffi/dyld.mjs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e8564870f7b65ed8145c0aa6a2ac5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e8564870f7b65ed8145c0aa6a2ac5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Fix PREP_MAYBE_LIBRARY in prep_target_file.m4
by Marge Bot (＠marge-bot) 19 Sep '25
by Marge Bot (＠marge-bot) 19 Sep '25
19 Sep '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
1480872a by Vladislav Zavialov at 2025-09-19T13:12:54-04:00
Fix PREP_MAYBE_LIBRARY in prep_target_file.m4
This change fixes a configure error introduced in:
commit 8235dd8c4945db9cb03e3be3c388d729d576ed1e
ghc-toolchain: Move UseLibdw to per-Target file
Now the build no longer fails with:
acghc-toolchain: Failed to read a valid Target value from hadrian/cfg/default.target
- - - - -
1 changed file:
- m4/prep_target_file.m4
Changes:
=====================================
m4/prep_target_file.m4
=====================================
@@ -78,22 +78,6 @@ AC_DEFUN([PREP_MAYBE_PROGRAM],[
AC_SUBST([$1MaybeProg])
])
-# PREP_MAYBE_LIBRARY
-# =========================
-#
-# Introduce a substitution [$1MaybeProg] with
-# * Nothing, if $$1 is empty or "NO"
-# * Just the library otherwise
-AC_DEFUN([PREP_MAYBE_LIBRARY],[
- if test -z "$$1" || test "$$1" = "NO"; then
- $1MaybeLibrary=Nothing
- else
- PREP_LIST([$2])
- $1MaybeLibrary="Just (Library { libName = \"$2\", includePath = \"$3\", libraryPath = \"$4\" })"
- fi
- AC_SUBST([$1MaybeLibrary])
-])
-
# PREP_MAYBE_STRING
# =========================
#
@@ -111,6 +95,24 @@ AC_DEFUN([PREP_MAYBE_STRING],[
AC_SUBST([$1MaybeStr])
])
+# PREP_MAYBE_LIBRARY
+# =========================
+#
+# Introduce a substitution [$1MaybeProg] with
+# * Nothing, if $$1 is empty or "NO"
+# * Just the library otherwise
+AC_DEFUN([PREP_MAYBE_LIBRARY],[
+ if test -z "$$1" || test "$$1" = "NO"; then
+ $1MaybeLibrary=Nothing
+ else
+ PREP_LIST([$2])
+ PREP_MAYBE_STRING([$3])
+ PREP_MAYBE_STRING([$4])
+ $1MaybeLibrary="Just Library { libName = \"$2\", includePath = $$3MaybeStr, libraryPath = $$4MaybeStr }"
+ fi
+ AC_SUBST([$1MaybeLibrary])
+])
+
# PREP_BOOLEAN
# ============
#
@@ -195,10 +197,7 @@ AC_DEFUN([PREP_TARGET_FILE],[
PREP_LIST([CONF_CPP_OPTS_STAGE2])
PREP_LIST([CONF_CXX_OPTS_STAGE2])
PREP_LIST([CONF_CC_OPTS_STAGE2])
-
- PREP_MAYBE_STRING([LibdwIncludeDir])
- PREP_MAYBE_STRING([LibdwLibDir])
- PREP_MAYBE_LIBRARY([UseLibdw], [dw], [$LibdwIncludeDirMaybeStr], [$LibdwLibDirMaybeStr])
+ PREP_MAYBE_LIBRARY([UseLibdw], [dw], [LibdwIncludeDir], [LibdwLibDir])
dnl Host target
PREP_BOOLEAN([ArSupportsAtFile_STAGE0])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1480872af6b80db1b035a4440918841…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1480872af6b80db1b035a4440918841…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
19 Sep '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
0a9d9ffc by Sylvain Henry at 2025-09-19T13:12:14-04:00
Fix output of T14999 (#23685)
Fix output of T14999 to:
- take into account the +1 offset to DW_AT_low_pc (see Note [Info Offset])
- always use Intel's syntax to force consistency: it was reported that
sometimes GDB prints `jmpq` instead of `jmp` with the AT&T syntax
- - - - -
2 changed files:
- testsuite/tests/codeGen/should_compile/Makefile
- testsuite/tests/codeGen/should_compile/T14999.stdout
Changes:
=====================================
testsuite/tests/codeGen/should_compile/Makefile
=====================================
@@ -36,7 +36,7 @@ T13233_orig:
T14999:
'$(TEST_HC)' $(TEST_HC_OPTS) -O2 -g -c T14999.cmm -o T14999.o
- gdb --batch -ex 'file T14999.o' -ex 'disassemble stg_catch_frame_info' --nx | tr -s '[[:blank:]\n]'
+ gdb --batch -ex 'set disassembly-flavor intel' -ex 'file T14999.o' -ex 'disassemble stg_catch_frame_info' --nx | tr -s '[[:blank:]\n]'
LANG=C readelf --debug-dump=frames-interp T14999.o | tr -s '[[:blank:]\n]'
T15196:
=====================================
testsuite/tests/codeGen/should_compile/T14999.stdout
=====================================
@@ -1,6 +1,6 @@
Dump of assembler code for function stg_catch_frame_info:
- 0x0000000000000010 <+0>: add $0x18,%rbp
- 0x0000000000000014 <+4>: jmpq *0x0(%rbp)
+ 0x0000000000000010 <+1>: add rbp,0x18
+ 0x0000000000000014 <+5>: jmp QWORD PTR [rbp+0x0]
End of assembler dump.
Contents of the .debug_frame section:
00000000 0000000000000014 ffffffff CIE "" cf=1 df=-8 ra=16
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a9d9ffc7a8a62db177bfd3b2fbb7fc…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a9d9ffc7a8a62db177bfd3b2fbb7fc…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/int-index/t26418] Fix keyword in ExplicitNamespaces error message (#26418)
by Vladislav Zavialov (＠int-index) 19 Sep '25
by Vladislav Zavialov (＠int-index) 19 Sep '25
19 Sep '25
Vladislav Zavialov pushed to branch wip/int-index/t26418 at Glasgow Haskell Compiler / GHC
Commits:
116a6a9e by Vladislav Zavialov at 2025-09-19T15:19:24+03:00
Fix keyword in ExplicitNamespaces error message (#26418)
Consider this module header and the resulting error:
{-# LANGUAGE NoExplicitNamespaces #-}
module T26418 (data HeadC) where
-- error: [GHC-47007]
-- Illegal keyword 'type'
Previously, the error message would mention 'type' (as shown above),
even though the user wrote 'data'. This has now been fixed.
The error location has also been corrected: it is now reported at the
keyword position rather than at the position of the associated
import/export item.
- - - - -
9 changed files:
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/Types.hs
- testsuite/tests/parser/should_fail/T16270h.stderr
- + testsuite/tests/parser/should_fail/T26418.hs
- + testsuite/tests/parser/should_fail/T26418.stderr
- testsuite/tests/parser/should_fail/all.T
Changes:
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1078,11 +1078,11 @@ qcname_ext_w_wildcard :: { LocatedA ImpExpQcSpec }
| '..' { sL1a $1 (ImpExpQcWildcard (epTok $1) NoEpTok) }
qcname_ext :: { LocatedA ImpExpQcSpec }
- : qcname { sL1a $1 (ImpExpQcName $1) }
- | 'type' oqtycon {% do { n <- mkTypeImpExp $2
- ; return $ sLLa $1 $> (ImpExpQcType (epTok $1) n) }}
- | 'data' qvarcon {% do { n <- mkDataImpExp $2
- ; return $ sLLa $1 $> (ImpExpQcData (epTok $1) n) }}
+ : qcname { sL1a $1 (mkPlainImpExp $1) }
+ | 'type' oqtycon {% do { imp_exp <- mkTypeImpExp (epTok $1) $2
+ ; return $ sLLa $1 $> imp_exp }}
+ | 'data' qvarcon {% do { imp_exp <- mkDataImpExp (epTok $1) $2
+ ; return $ sLLa $1 $> imp_exp }}
qcname :: { LocatedN RdrName } -- Variable or type constructor
: qvar { $1 } -- Things which look like functions
=====================================
compiler/GHC/Parser/Errors/Ppr.hs
=====================================
@@ -273,9 +273,14 @@ instance Diagnostic PsMessage where
2 (pprWithCommas ppr vs)
, text "See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details."
]
- PsErrIllegalExplicitNamespace
+ PsErrIllegalExplicitNamespace kw
-> mkSimpleDecorated $
- text "Illegal keyword 'type'"
+ text "Illegal keyword" <+> quotes kw_doc
+ where
+ kw_doc = case kw of
+ ExplicitTypeNamespace{} -> text "type"
+ ExplicitDataNamespace{} -> text "data"
+
PsErrUnallowedPragma prag
-> mkSimpleDecorated $
@@ -619,7 +624,7 @@ instance Diagnostic PsMessage where
PsErrNoSingleWhereBindInPatSynDecl{} -> ErrorWithoutFlag
PsErrDeclSpliceNotAtTopLevel{} -> ErrorWithoutFlag
PsErrMultipleNamesInStandaloneKindSignature{} -> ErrorWithoutFlag
- PsErrIllegalExplicitNamespace -> ErrorWithoutFlag
+ PsErrIllegalExplicitNamespace{} -> ErrorWithoutFlag
PsErrUnallowedPragma{} -> ErrorWithoutFlag
PsErrImportPostQualified -> ErrorWithoutFlag
PsErrImportQualifiedTwice -> ErrorWithoutFlag
@@ -759,7 +764,7 @@ instance Diagnostic PsMessage where
PsErrNoSingleWhereBindInPatSynDecl{} -> noHints
PsErrDeclSpliceNotAtTopLevel{} -> noHints
PsErrMultipleNamesInStandaloneKindSignature{} -> noHints
- PsErrIllegalExplicitNamespace -> [suggestExtension LangExt.ExplicitNamespaces]
+ PsErrIllegalExplicitNamespace{} -> [suggestExtension LangExt.ExplicitNamespaces]
PsErrUnallowedPragma{} -> noHints
PsErrImportPostQualified -> [suggestExtension LangExt.ImportQualifiedPost]
PsErrImportQualifiedTwice -> noHints
=====================================
compiler/GHC/Parser/Errors/Types.hs
=====================================
@@ -214,7 +214,7 @@ data PsMessage
| PsErrImportPostQualified
-- | Explicit namespace keyword without 'ExplicitNamespaces'
- | PsErrIllegalExplicitNamespace
+ | PsErrIllegalExplicitNamespace !ExplicitNamespaceKeyword
-- | Expecting a type constructor but found a variable
| PsErrVarForTyCon !RdrName
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -79,6 +79,7 @@ module GHC.Parser.PostProcess (
ImpExpSubSpec(..),
ImpExpQcSpec(..),
mkModuleImpExp,
+ mkPlainImpExp,
mkTypeImpExp,
mkDataImpExp,
mkImpExpSubSpec,
@@ -3241,9 +3242,7 @@ data ImpExpSubSpec = ImpExpAbs
| ImpExpList [LocatedA ImpExpQcSpec]
| ImpExpAllWith [LocatedA ImpExpQcSpec]
-data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName)
- | ImpExpQcType (EpToken "type") (LocatedN RdrName)
- | ImpExpQcData (EpToken "data") (LocatedN RdrName)
+data ImpExpQcSpec = ImpExpQcName (Maybe ExplicitNamespaceKeyword) (LocatedN RdrName)
| ImpExpQcWildcard (EpToken "..") (EpToken ",")
mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> (EpToken "(", EpToken ")") -> LocatedA ImpExpQcSpec
@@ -3287,30 +3286,37 @@ mkModuleImpExp warning (top, tcp) (L l specname) subs = do
(PsErrVarForTyCon name)
else return $ ieNameFromSpec specname
- ieNameVal (ImpExpQcName ln) = unLoc ln
- ieNameVal (ImpExpQcType _ ln) = unLoc ln
- ieNameVal (ImpExpQcData _ ln) = unLoc ln
+ ieNameVal (ImpExpQcName _ ln) = unLoc ln
ieNameVal ImpExpQcWildcard{} = panic "ieNameVal got wildcard"
ieNameFromSpec :: ImpExpQcSpec -> IEWrappedName GhcPs
- ieNameFromSpec (ImpExpQcName (L l n)) = IEName noExtField (L l n)
- ieNameFromSpec (ImpExpQcType r (L l n)) = IEType r (L l n)
- ieNameFromSpec (ImpExpQcData r (L l n)) = IEData r (L l n)
- ieNameFromSpec ImpExpQcWildcard{} = panic "ieName got wildcard"
+ ieNameFromSpec (ImpExpQcName m_kw name) = case m_kw of
+ Nothing -> IEName noExtField name
+ Just (ExplicitTypeNamespace tok) -> IEType tok name
+ Just (ExplicitDataNamespace tok) -> IEData tok name
+ ieNameFromSpec ImpExpQcWildcard{} = panic "ieNameFromSpec got wildcard"
wrapped = map (fmap ieNameFromSpec)
-mkTypeImpExp :: LocatedN RdrName -- TcCls or Var name space
- -> P (LocatedN RdrName)
-mkTypeImpExp name =
- do requireExplicitNamespaces (getLocA name)
- return (fmap (`setRdrNameSpace` tcClsName) name)
+mkPlainImpExp :: LocatedN RdrName -> ImpExpQcSpec
+mkPlainImpExp name = ImpExpQcName Nothing name
-mkDataImpExp :: LocatedN RdrName
- -> P (LocatedN RdrName)
-mkDataImpExp name =
- do requireExplicitNamespaces (getLocA name)
- return name
+mkTypeImpExp :: EpToken "type"
+ -> LocatedN RdrName -- TcCls or Var name space
+ -> P ImpExpQcSpec
+mkTypeImpExp tok name = do
+ let name' = fmap (`setRdrNameSpace` tcClsName) name
+ ns_kw = ExplicitTypeNamespace tok
+ requireExplicitNamespaces ns_kw
+ return (ImpExpQcName (Just ns_kw) name')
+
+mkDataImpExp :: EpToken "data"
+ -> LocatedN RdrName
+ -> P ImpExpQcSpec
+mkDataImpExp tok name = do
+ let ns_kw = ExplicitDataNamespace tok
+ requireExplicitNamespaces ns_kw
+ return (ImpExpQcName (Just ns_kw) name)
checkImportSpec :: LocatedLI [LIE GhcPs] -> P (LocatedLI [LIE GhcPs])
checkImportSpec ie@(L _ specs) =
@@ -3368,11 +3374,15 @@ failOpFewArgs (L loc op) =
; addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $
(PsErrOpFewArgs is_star_type op) }
-requireExplicitNamespaces :: MonadP m => SrcSpan -> m ()
-requireExplicitNamespaces l = do
+requireExplicitNamespaces :: MonadP m => ExplicitNamespaceKeyword -> m ()
+requireExplicitNamespaces kw = do
allowed <- getBit ExplicitNamespacesBit
unless allowed $
- addError $ mkPlainErrorMsgEnvelope l PsErrIllegalExplicitNamespace
+ addError $ mkPlainErrorMsgEnvelope loc $ PsErrIllegalExplicitNamespace kw
+ where
+ loc = case kw of
+ ExplicitTypeNamespace tok -> getEpTokenSrcSpan tok
+ ExplicitDataNamespace tok -> getEpTokenSrcSpan tok
warnPatternNamespaceSpecifier :: MonadP m => SrcSpan -> m ()
warnPatternNamespaceSpecifier l = do
=====================================
compiler/GHC/Parser/Types.hs
=====================================
@@ -8,6 +8,7 @@ module GHC.Parser.Types
, pprSumOrTuple
, PatBuilder(..)
, DataConBuilder(..)
+ , ExplicitNamespaceKeyword(..)
)
where
@@ -111,3 +112,7 @@ instance Outputable DataConBuilder where
ppr lhs <+> ppr data_con <+> ppr rhs
type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnLW
+
+data ExplicitNamespaceKeyword
+ = ExplicitTypeNamespace !(EpToken "type")
+ | ExplicitDataNamespace !(EpToken "data")
\ No newline at end of file
=====================================
testsuite/tests/parser/should_fail/T16270h.stderr
=====================================
@@ -1,6 +1,5 @@
-
-T16270h.hs:8:22: error: [GHC-47007]
- Illegal keyword 'type'
+T16270h.hs:8:17: error: [GHC-47007]
+ Illegal keyword ‘type’
Suggested fix:
Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’)
@@ -11,3 +10,4 @@ T16270h.hs:10:8: error: [GHC-21926]
T16270h.hs:11:8: error: [GHC-21926]
Parse error: ‘pkg!’
Version number or non-alphanumeric character in package name
+
=====================================
testsuite/tests/parser/should_fail/T26418.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE NoExplicitNamespaces #-}
+
+module T26418 (data HeadC) where
+
+pattern HeadC :: forall a. a -> [a]
+pattern HeadC x <- x:_xs where
+ HeadC x = [x]
+
=====================================
testsuite/tests/parser/should_fail/T26418.stderr
=====================================
@@ -0,0 +1,5 @@
+T26418.hs:4:16: error: [GHC-47007]
+ Illegal keyword ‘data’
+ Suggested fix:
+ Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’)
+
=====================================
testsuite/tests/parser/should_fail/all.T
=====================================
@@ -241,3 +241,4 @@ test('T25258a', normal, compile_fail, [''])
test('T25258b', normal, compile_fail, [''])
test('T25258c', normal, compile_fail, [''])
test('T25530', normal, compile_fail, [''])
+test('T26418', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/116a6a9e4bf6ab113fa17acea156c52…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/116a6a9e4bf6ab113fa17acea156c52…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26330] Use Outputable.ellipsis rather than text "..."
by Simon Peyton Jones (＠simonpj) 19 Sep '25
by Simon Peyton Jones (＠simonpj) 19 Sep '25
19 Sep '25
Simon Peyton Jones pushed to branch wip/T26330 at Glasgow Haskell Compiler / GHC
Commits:
fc907ec7 by Simon Peyton Jones at 2025-09-19T13:13:25+01:00
Use Outputable.ellipsis rather than text "..."
- - - - -
13 changed files:
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Pmc/Ppr.hs
- compiler/GHC/HsToCore/Pmc/Types.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Llvm/Ppr.hs
- compiler/GHC/Llvm/Types.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/GHC/Utils/Ppr.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Env.hs
=====================================
@@ -309,7 +309,7 @@ data SimplPhase
instance Outputable SimplPhase where
ppr (SimplPhase p) = ppr p
- ppr (SimplPhaseRange s e) = brackets $ ppr s <> text "..." <> ppr e
+ ppr (SimplPhaseRange s e) = brackets $ ppr s <> ellipsis <> ppr e
-- | Is this activation active in this simplifier phase?
--
=====================================
compiler/GHC/Core/Ppr.hs
=====================================
@@ -175,7 +175,7 @@ pprOptCo co = sdocOption sdocSuppressCoercions $ \case
False -> parens $ sep [ppr co, dcolon <+> co_type]
where
co_type = sdocOption sdocSuppressCoercionTypes $ \case
- True -> text "..."
+ True -> ellipsis
False -> ppr (coercionType co)
ppr_id_occ :: (SDoc -> SDoc) -> Id -> SDoc
=====================================
compiler/GHC/HsToCore/Errors/Ppr.hs
=====================================
@@ -246,7 +246,7 @@ instance Diagnostic DsMessage where
<+> text "may fail for the following constructors:")
2
(hsep $ punctuate comma $
- map ppr (take maxCons cons) ++ [ text "..." | lengthExceeds cons maxCons ])
+ map ppr (take maxCons cons) ++ [ ellipsis | lengthExceeds cons maxCons ])
diagnosticReason = \case
DsUnknownMessage m -> diagnosticReason m
@@ -338,7 +338,7 @@ badMonadBind elt_ty
-- Print a single clause (for redundant/with-inaccessible-rhs)
pprEqn :: HsMatchContextRn -> SDoc -> String -> SDoc
pprEqn ctx q txt = pprContext True ctx (text txt) $ \f ->
- f (q <+> matchSeparator ctx <+> text "...")
+ f (q <+> matchSeparator ctx <+> ellipsis)
pprContext :: Bool -> HsMatchContextRn -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc
pprContext singular kind msg rest_of_msg_fun
@@ -357,5 +357,5 @@ pprContext singular kind msg rest_of_msg_fun
dots :: Int -> [a] -> SDoc
dots maxPatterns qs
- | qs `lengthExceeds` maxPatterns = text "..."
+ | qs `lengthExceeds` maxPatterns = ellipsis
| otherwise = empty
=====================================
compiler/GHC/HsToCore/Pmc/Ppr.hs
=====================================
@@ -62,7 +62,7 @@ pprRefutableShapes (var, alts)
= var <+> text "is not one of" <+> format_alts alts
where
format_alts = braces . fsep . punctuate comma . shorten . map ppr_alt
- shorten (a:b:c:_:_) = a:b:c:[text "..."]
+ shorten (a:b:c:_:_) = a:b:c:[ellipsis]
shorten xs = xs
ppr_alt (PmAltConLike cl) = ppr cl
ppr_alt (PmAltLit lit) = ppr lit
=====================================
compiler/GHC/HsToCore/Pmc/Types.hs
=====================================
@@ -217,7 +217,7 @@ instance Outputable p => Outputable (PmGRHS p) where
instance Outputable p => Outputable (PmPatBind p) where
ppr (PmPatBind PmGRHS { pg_grds = grds, pg_rhs = bind }) =
- ppr bind <+> ppr grds <+> text "=" <+> text "..."
+ ppr bind <+> ppr grds <+> text "=" <+> ellipsis
instance Outputable PmEmptyCase where
ppr (PmEmptyCase { pe_var = var }) =
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -941,7 +941,7 @@ ppr_trim xs
where
go (Just doc) (_, so_far) = (False, doc : so_far)
go Nothing (True, so_far) = (True, so_far)
- go Nothing (False, so_far) = (True, text "..." : so_far)
+ go Nothing (False, so_far) = (True, ellipsis : so_far)
isIfaceDataInstance :: IfaceTyConParent -> Bool
isIfaceDataInstance IfNoParent = False
=====================================
compiler/GHC/Llvm/Ppr.hs
=====================================
@@ -199,10 +199,7 @@ ppLlvmFunctionDecls decs = vcat $ map ppLlvmFunctionDecl decs
-- the function.
ppLlvmFunctionDecl :: IsDoc doc => LlvmFunctionDecl -> doc
ppLlvmFunctionDecl (LlvmFunctionDecl n l c r varg p a)
- = let varg' = case varg of
- VarArgs | null p -> text "..."
- | otherwise -> text ", ..."
- _otherwise -> text ""
+ = let varg' = ppVarArgsEllipsis varg p
align = case a of
Just a' -> text " align" <+> int a'
Nothing -> empty
=====================================
compiler/GHC/Llvm/Types.hs
=====================================
@@ -100,15 +100,17 @@ ppLlvmTypeShort t = case t of
LMVector l t -> "v" ++ show l ++ ppLlvmTypeShort t
_ -> pprPanic "ppLlvmTypeShort" (ppLlvmType t)
+ppVarArgsEllipsis :: IsLine doc => LlvmParameterListType -> [LlvmParameter] -> doc
+ppVarArgsEllipsis list_type args
+ = case list_type of
+ FixedArgs -> text ""
+ VarArgs | null args -> text "..." -- Can't use ellipsis, comma here,
+ | otherwise -> text ", ..." -- because they aren't methods of IsLine
+
ppParams :: IsLine doc => LlvmParameterListType -> [LlvmParameter] -> doc
ppParams varg p
- = let varg' = case varg of
- VarArgs | null args -> text "..."
- | otherwise -> text ", ..."
- _otherwise -> text ""
- -- by default we don't print param attributes
- args = map fst p
- in ppCommaJoin ppLlvmType args <> varg'
+ = ppCommaJoin ppLlvmType (map fst p) <> ppVarArgsEllipsis varg p
+
{-# SPECIALIZE ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc #-}
{-# SPECIALIZE ppParams :: LlvmParameterListType -> [LlvmParameter] -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
=====================================
compiler/GHC/Runtime/Loader.hs
=====================================
@@ -317,7 +317,7 @@ getHValueSafely interp hsc_env val_name expected_type = do
lessUnsafeCoerce :: Logger -> String -> a -> IO b
lessUnsafeCoerce logger context what = do
debugTraceMsg logger 3 $
- (text "Coercing a value in") <+> (text context) <> (text "...")
+ (text "Coercing a value in") <+> text context <> ellipsis
output <- evaluate (unsafeCoerce what)
debugTraceMsg logger 3 (text "Successfully evaluated coercion")
return output
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -1399,7 +1399,7 @@ instance Diagnostic TcRnMessage where
EmptyCaseForall tvb ->
vcat [ text "Empty list of alternatives in" <+> pp_ctxt
, hang (text "checked against a forall-type:")
- 2 (pprForAll [tvb] <+> text "...")
+ 2 (pprForAll [tvb] <+> ellipsis)
]
where
pp_ctxt = case ctxt of
@@ -1591,7 +1591,7 @@ instance Diagnostic TcRnMessage where
<+> text "may fail for the following constructors:")
2
(hsep $ punctuate comma $
- map ppr (take maxCons cons) ++ [ text "..." | lengthExceeds cons maxCons ])
+ map ppr (take maxCons cons) ++ [ ellipsis | lengthExceeds cons maxCons ])
TcRnBadFieldAnnotation n con reason -> mkSimpleDecorated $
hang (pprBadFieldAnnotationReason reason)
2 (text "on the" <+> speakNth n
@@ -3759,7 +3759,7 @@ derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving pprHerald = \cas
DerivErrNotWellKinded tc cls_kind _
-> sep [ hang (text "Cannot derive well-kinded instance of form"
<+> quotes (pprClassPred cls cls_tys
- <+> parens (ppr tc <+> text "...")))
+ <+> parens (ppr tc <+> ellipsis)))
2 empty
, nest 2 (text "Class" <+> quotes (ppr cls)
<+> text "expects an argument of kind"
@@ -6819,7 +6819,7 @@ pprInvalidAssocDefault = \case
ppr_eqn :: SDoc
ppr_eqn =
quotes (text "type" <+> ppr (mkTyConApp fam_tc pat_tys)
- <+> equals <+> text "...")
+ <+> equals <+> ellipsis)
suggestion :: SDoc
suggestion = text "The arguments to" <+> quotes (ppr fam_tc)
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -227,7 +227,7 @@ instance Outputable GhcHint where
<+> text "pattern synonym, e.g.")
2 (hang (text "pattern" <+> pp_name <+> pp_args <+> larrow
<+> ppr pat <+> text "where")
- 2 (pp_name <+> pp_args <+> equals <+> text "..."))
+ 2 (pp_name <+> pp_args <+> equals <+> ellipsis))
where
pp_name = ppr name
pp_args = hsep (map ppr args)
=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -46,7 +46,7 @@ module GHC.Utils.Outputable (
arrow, lollipop, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt,
lambda,
lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
- blankLine, forAllLit, bullet,
+ blankLine, forAllLit, bullet, ellipsis,
($+$),
cat, fcat,
hang, hangNotEmpty, punctuate, punctuateFinal,
@@ -521,7 +521,7 @@ withPprStyle sty d = SDoc $ \ctxt -> runSDoc d ctxt{sdocStyle=sty}
pprDeeper :: SDoc -> SDoc
pprDeeper d = SDoc $ \ctx -> case sdocStyle ctx of
PprUser q depth c ->
- let deeper 0 = Pretty.text "..."
+ let deeper 0 = Pretty.ellipsis
deeper n = runSDoc d ctx{sdocStyle = PprUser q (PartWay (n-1)) c}
in case depth of
DefaultDepth -> deeper (sdocDefaultDepth ctx)
@@ -551,7 +551,7 @@ pprDeeperList f ds
trim :: Int -> [SDoc] -> [SDoc]
trim _ [] = []
-trim 0 _ = [text "..."]
+trim 0 _ = [ellipsis]
trim n (d:ds) = d : trim (n-1) ds
pprSetDepth :: Depth -> SDoc -> SDoc
@@ -773,7 +773,7 @@ quotes d = sdocOption sdocCanUseUnicode $ \case
| otherwise -> Pretty.quotes pp_d
blankLine, dcolon, arrow, lollipop, larrow, darrow, arrowt, larrowt, arrowtt,
- larrowtt, lambda :: SDoc
+ larrowtt, lambda, ellipsis :: SDoc
blankLine = docToSDoc Pretty.emptyText
dcolon = unicodeSyntax (char '∷') (text "::")
@@ -786,6 +786,7 @@ larrowt = unicodeSyntax (char '⤙') (text "-<")
arrowtt = unicodeSyntax (char '⤜') (text ">>-")
larrowtt = unicodeSyntax (char '⤛') (text "-<<")
lambda = unicodeSyntax (char 'λ') (char '\\')
+ellipsis = docToSDoc Pretty.ellipsis
semi, comma, colon, equals, space, underscore, dot, vbar :: IsLine doc => doc
lparen, rparen, lbrack, rbrack, lbrace, rbrace :: IsLine doc => doc
=====================================
compiler/GHC/Utils/Ppr.hs
=====================================
@@ -74,7 +74,7 @@ module GHC.Utils.Ppr (
int, integer, float, double, rational, hex,
-- ** Simple derived documents
- semi, comma, colon, space, equals,
+ semi, comma, colon, space, equals, ellipsis,
lparen, rparen, lbrack, rbrack, lbrace, rbrace,
-- ** Wrapping documents in delimiters
@@ -424,6 +424,7 @@ lbrack :: Doc -- ^ A '[' character
rbrack :: Doc -- ^ A ']' character
lbrace :: Doc -- ^ A '{' character
rbrace :: Doc -- ^ A '}' character
+ellipsis :: Doc -- ^ A '...' ellipsis
semi = char ';'
comma = char ','
colon = char ':'
@@ -435,6 +436,7 @@ lbrack = char '['
rbrack = char ']'
lbrace = char '{'
rbrace = char '}'
+ellipsis = text "..."
spaceText, nlText :: TextDetails
spaceText = Chr ' '
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc907ec7df0766b0e84c4ea41e73b46…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc907ec7df0766b0e84c4ea41e73b46…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
sheaf pushed new branch wip/inlinable-optimisation at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/inlinable-optimisation
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Enable TcM plugins in initTc
by Marge Bot (＠marge-bot) 19 Sep '25
by Marge Bot (＠marge-bot) 19 Sep '25
19 Sep '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
de44e69e by sheaf at 2025-09-19T05:16:51-04:00
Enable TcM plugins in initTc
This commit ensures that we run typechecker plugins and defaulting
plugins whenever we call initTc.
In particular, this ensures that the pattern-match checker, which calls
'initTcDsForSolver' which calls 'initTc', runs with typechecker plugins
enabled. This matters for situations like:
merge :: Vec n a -> Vec n a -> Vec (2 * n) a
merge Nil Nil = Nil
merge (a <: as) (b <: bs) = a :< (b <: merge as bs)
in which we need the typechecker plugin to run in order to tell us that
the Givens would be inconsistent in the additional equation
merge (_ <: _) Nil
and thus that the equation is not needed.
Fixes #26395
- - - - -
2c378ad2 by Cheng Shao at 2025-09-19T05:17:33-04:00
rel-eng: update fedora image to 42
This patch is a part of #25876 and updates fedora image to 42.
- - - - -
c0344aa2 by Sylvain Henry at 2025-09-19T05:50:44-04:00
Fix output of T14999 (#23685)
Fix output of T14999 to:
- take into account the +1 offset to DW_AT_low_pc (see Note [Info Offset])
- always use Intel's syntax to force consistency: it was reported that
sometimes GDB prints `jmpq` instead of `jmp` with the AT&T syntax
- - - - -
7e856487 by Vladislav Zavialov at 2025-09-19T05:50:44-04:00
Fix PREP_MAYBE_LIBRARY in prep_target_file.m4
This change fixes a configure error introduced in:
commit 8235dd8c4945db9cb03e3be3c388d729d576ed1e
ghc-toolchain: Move UseLibdw to per-Target file
Now the build no longer fails with:
acghc-toolchain: Failed to read a valid Target value from hadrian/cfg/default.target
- - - - -
15 changed files:
- .gitlab-ci.yml
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Utils/Monad.hs
- m4/prep_target_file.m4
- testsuite/tests/codeGen/should_compile/Makefile
- testsuite/tests/codeGen/should_compile/T14999.stdout
- + testsuite/tests/tcplugins/T26395.hs
- + testsuite/tests/tcplugins/T26395.stderr
- + testsuite/tests/tcplugins/T26395_Plugin.hs
- testsuite/tests/tcplugins/all.T
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -2,7 +2,7 @@ variables:
GIT_SSL_NO_VERIFY: "1"
# Commit of ghc/ci-images repository from which to pull Docker images
- DOCKER_REV: be4ac2cd18f38e63b263e2a27c76a7c279385796
+ DOCKER_REV: a97d5c67d803c6b3811c6cccdf33dc8e9d7eafe3
# Sequential version number of all cached things.
# Bump to invalidate GitLab CI cache.
@@ -433,14 +433,14 @@ hadrian-ghc-in-ghci:
hadrian-multi:
stage: testing
needs:
- - job: x86_64-linux-fedora33-release
+ - job: x86_64-linux-fedora42-release
optional: true
- - job: nightly-x86_64-linux-fedora33-release
+ - job: nightly-x86_64-linux-fedora42-release
optional: true
- - job: release-x86_64-linux-fedora33-release
+ - job: release-x86_64-linux-fedora42-release
optional: true
dependencies: null
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV"
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV"
before_script:
# workaround for docker permissions
- sudo chown ghc:ghc -R .
@@ -460,7 +460,7 @@ hadrian-multi:
- ls
- |
mkdir tmp
- tar -xf ghc-x86_64-linux-fedora33-release.tar.xz -C tmp
+ tar -xf ghc-x86_64-linux-fedora42-release.tar.xz -C tmp
pushd tmp/ghc-*/
./configure --prefix=$root
make install
@@ -522,17 +522,17 @@ test-cabal-reinstall-x86_64-linux-deb10:
abi-test-nightly:
stage: full-build
needs:
- - job: nightly-x86_64-linux-fedora33-release-hackage
- - job: nightly-x86_64-linux-fedora33-release
+ - job: nightly-x86_64-linux-fedora42-release-hackage
+ - job: nightly-x86_64-linux-fedora42-release
tags:
- x86_64-linux
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV"
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV"
dependencies: null
before_script:
- mkdir -p normal
- mkdir -p hackage
- - tar -xf ghc-x86_64-linux-fedora33-release.tar.xz -C normal/
- - tar -xf ghc-x86_64-linux-fedora33-release-hackage_docs.tar.xz -C hackage/
+ - tar -xf ghc-x86_64-linux-fedora42-release.tar.xz -C normal/
+ - tar -xf ghc-x86_64-linux-fedora42-release-hackage_docs.tar.xz -C hackage/
script:
- .gitlab/ci.sh compare_interfaces_of "normal/ghc-*" "hackage/ghc-*"
artifacts:
@@ -609,9 +609,9 @@ doc-tarball:
hackage-doc-tarball:
stage: packaging
needs:
- - job: nightly-x86_64-linux-fedora33-release-hackage
+ - job: nightly-x86_64-linux-fedora42-release-hackage
optional: true
- - job: release-x86_64-linux-fedora33-release-hackage
+ - job: release-x86_64-linux-fedora42-release-hackage
optional: true
- job: source-tarball
tags:
@@ -628,7 +628,7 @@ hackage-doc-tarball:
- hackage_docs
before_script:
- tar -xf ghc-*[0-9]-src.tar.xz
- - tar -xf ghc-x86_64-linux-fedora33-release.tar.xz -C ghc*/
+ - tar -xf ghc-x86_64-linux-fedora42-release.tar.xz -C ghc*/
script:
- cd ghc*/
- mv .gitlab/rel_eng/upload_ghc_libs.py .
@@ -754,7 +754,7 @@ test-bootstrap:
# Triggering jobs in the ghc/head.hackage project requires that we have a job
# token for that repository. Furthermore the head.hackage CI job must have
# access to an unprivileged access token with the ability to query the ghc/ghc
-# project such that it can find the job ID of the fedora33 job for the current
+# project such that it can find the job ID of the fedora42 job for the current
# pipeline.
#
# hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build.
@@ -841,7 +841,7 @@ nightly-hackage-lint:
nightly-hackage-perf:
needs:
- - job: nightly-x86_64-linux-fedora33-release
+ - job: nightly-x86_64-linux-fedora42-release
optional: true
artifacts: false
- job: nightly-aarch64-linux-deb12-validate
@@ -860,7 +860,7 @@ nightly-hackage-perf:
release-hackage-lint:
needs:
- - job: release-x86_64-linux-fedora33-release
+ - job: release-x86_64-linux-fedora42-release
optional: true
artifacts: false
- job: release-aarch64-linux-deb12-release+no_split_sections
@@ -946,13 +946,13 @@ perf-nofib:
allow_failure: true
stage: testing
needs:
- - job: x86_64-linux-fedora33-release
+ - job: x86_64-linux-fedora42-release
optional: true
- - job: nightly-x86_64-linux-fedora33-release
+ - job: nightly-x86_64-linux-fedora42-release
optional: true
- - job: release-x86_64-linux-fedora33-release
+ - job: release-x86_64-linux-fedora42-release
optional: true
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV"
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV"
rules:
- when: never
- *full-ci
@@ -965,7 +965,7 @@ perf-nofib:
- root=$(pwd)/ghc
- |
mkdir tmp
- tar -xf ../ghc-x86_64-linux-fedora33-release.tar.xz -C tmp
+ tar -xf ../ghc-x86_64-linux-fedora42-release.tar.xz -C tmp
pushd tmp/ghc-*/
./configure --prefix=$root
make install
@@ -989,21 +989,24 @@ perf-nofib:
perf:
stage: testing
needs:
- - job: x86_64-linux-fedora33-release
+ - job: x86_64-linux-fedora42-release
optional: true
- - job: nightly-x86_64-linux-fedora33-release
+ - job: nightly-x86_64-linux-fedora42-release
optional: true
- - job: release-x86_64-linux-fedora33-release
+ - job: release-x86_64-linux-fedora42-release
optional: true
dependencies: null
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV"
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV"
tags:
- x86_64-linux-perf
+ before_script:
+ # workaround for docker permissions
+ - sudo chown ghc:ghc -R .
script:
- root=$(pwd)/ghc
- |
mkdir tmp
- tar -xf ghc-x86_64-linux-fedora33-release.tar.xz -C tmp
+ tar -xf ghc-x86_64-linux-fedora42-release.tar.xz -C tmp
pushd tmp/ghc-*/
./configure --prefix=$root
make install
@@ -1027,14 +1030,14 @@ perf:
abi-test:
stage: testing
needs:
- - job: x86_64-linux-fedora33-release
+ - job: x86_64-linux-fedora42-release
optional: true
- - job: nightly-x86_64-linux-fedora33-release
+ - job: nightly-x86_64-linux-fedora42-release
optional: true
- - job: release-x86_64-linux-fedora33-release
+ - job: release-x86_64-linux-fedora42-release
optional: true
dependencies: null
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV"
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV"
rules:
- if: $CI_MERGE_REQUEST_ID
- if: '$CI_COMMIT_BRANCH == "master"'
@@ -1045,7 +1048,7 @@ abi-test:
- root=$(pwd)/ghc
- |
mkdir tmp
- tar -xf ghc-x86_64-linux-fedora33-release.tar.xz -C tmp
+ tar -xf ghc-x86_64-linux-fedora42-release.tar.xz -C tmp
pushd tmp/ghc-*/
./configure --prefix=$root
make install
@@ -1200,7 +1203,7 @@ ghcup-metadata-nightly:
extends: .ghcup-metadata
# Explicit needs for validate pipeline because we only need certain bindists
needs:
- - job: nightly-x86_64-linux-fedora33-release
+ - job: nightly-x86_64-linux-fedora42-release
artifacts: false
- job: nightly-x86_64-linux-ubuntu24_04-validate
artifacts: false
@@ -1251,7 +1254,7 @@ ghcup-metadata-nightly:
# Update the ghcup metadata with information about this nightly pipeline
ghcup-metadata-nightly-push:
stage: deploy
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV"
+ image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV"
dependencies: null
tags:
- x86_64-linux
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -82,7 +82,7 @@ The generated names for the jobs is important as there are a few downstream cons
of the jobs artifacts. Therefore some care should be taken if changing the generated
names of jobs to update these other places.
-1. Fedora33 jobs are required by head.hackage
+1. fedora42 jobs are required by head.hackage
2. The fetch-gitlab release utility pulls release artifacts from the
3. The ghc-head-from script downloads release artifacts based on a pipeline change.
4. Some subsequent CI jobs have explicit dependencies (for example docs-tarball, perf, perf-nofib)
@@ -118,8 +118,7 @@ data LinuxDistro
| Debian11Js
| Debian10
| Debian9
- | Fedora33
- | Fedora38
+ | Fedora42
| Ubuntu2404LoongArch64
| Ubuntu2404
| Ubuntu2204
@@ -319,8 +318,7 @@ distroName Debian12Riscv = "deb12-riscv"
distroName Debian12Wine = "deb12-wine"
distroName Debian10 = "deb10"
distroName Debian9 = "deb9"
-distroName Fedora33 = "fedora33"
-distroName Fedora38 = "fedora38"
+distroName Fedora42 = "fedora42"
distroName Ubuntu2404LoongArch64 = "ubuntu24_04-loongarch"
distroName Ubuntu1804 = "ubuntu18_04"
distroName Ubuntu2004 = "ubuntu20_04"
@@ -501,14 +499,6 @@ alpineVariables arch = mconcat $
distroVariables :: Arch -> LinuxDistro -> Variables
distroVariables arch Alpine312 = alpineVariables arch
distroVariables arch Alpine322 = alpineVariables arch
-distroVariables _ Fedora33 = mconcat
- -- LLC/OPT do not work for some reason in our fedora images
- -- These tests fail with this error: T11649 T5681 T7571 T8131b
- -- +/opt/llvm/bin/opt: /lib64/libtinfo.so.5: no version information available (required by /opt/llvm/bin/opt)
- -- +/opt/llvm/bin/llc: /lib64/libtinfo.so.5: no version information available (required by /opt/llvm/bin/llc)
- [ "LLC" =: "/bin/false"
- , "OPT" =: "/bin/false"
- ]
distroVariables _ _ = mempty
-----------------------------------------------------------------------------
@@ -1207,13 +1197,13 @@ rhel_x86 =
fedora_x86 :: [JobGroup Job]
fedora_x86 =
- [ -- Fedora33 job is always built with perf so there's one job in the normal
+ [ -- Fedora42 job is always built with perf so there's one job in the normal
-- validate pipeline which is built with perf.
- fastCI (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)
+ fastCI (standardBuildsWithConfig Amd64 (Linux Fedora42) releaseConfig)
-- This job is only for generating head.hackage docs
- , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig))
- , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf)
- , disableValidate (standardBuilds Amd64 (Linux Fedora38))
+ , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora42) releaseConfig))
+ , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora42) dwarf)
+ , disableValidate (standardBuilds Amd64 (Linux Fedora42))
]
where
hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-for-hackage")
@@ -1375,7 +1365,7 @@ platform_mapping = Map.map go combined_result
, "x86_64-linux-deb11-validate"
, "x86_64-linux-deb12-validate"
, "x86_64-linux-deb10-validate+debug_info"
- , "x86_64-linux-fedora33-release"
+ , "x86_64-linux-fedora42-release"
, "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate"
, "x86_64-windows-validate"
, "aarch64-linux-deb12-validate"
@@ -1390,13 +1380,13 @@ platform_mapping = Map.map go combined_result
, "nightly-aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate"
, "nightly-x86_64-linux-alpine3_12-validate+fully_static"
, "nightly-x86_64-linux-deb10-validate"
- , "nightly-x86_64-linux-fedora33-release"
+ , "nightly-x86_64-linux-fedora42-release"
, "nightly-x86_64-windows-validate"
, "release-x86_64-linux-alpine3_12-release+fully_static+no_split_sections"
, "release-x86_64-linux-deb10-release"
, "release-x86_64-linux-deb11-release"
, "release-x86_64-linux-deb12-release"
- , "release-x86_64-linux-fedora33-release"
+ , "release-x86_64-linux-fedora42-release"
, "release-x86_64-windows-release"
]
=====================================
.gitlab/jobs.yaml
=====================================
@@ -2942,7 +2942,7 @@
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora33-release": {
+ "nightly-x86_64-linux-fedora42-release": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -2953,7 +2953,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora33-release.tar.xz",
+ "ghc-x86_64-linux-fedora42-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -2963,14 +2963,14 @@
"when": "always"
},
"cache": {
- "key": "x86_64-linux-fedora33-$CACHE_REV",
+ "key": "x86_64-linux-fedora42-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV",
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV",
"needs": [
{
"artifacts": false,
@@ -2996,18 +2996,16 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "LLC": "/bin/false",
- "OPT": "/bin/false",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora33-release",
+ "TEST_ENV": "x86_64-linux-fedora42-release",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora33-release-hackage": {
+ "nightly-x86_64-linux-fedora42-release-hackage": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3018,7 +3016,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora33-release.tar.xz",
+ "ghc-x86_64-linux-fedora42-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3028,14 +3026,14 @@
"when": "always"
},
"cache": {
- "key": "x86_64-linux-fedora33-$CACHE_REV",
+ "key": "x86_64-linux-fedora42-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV",
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV",
"needs": [
{
"artifacts": false,
@@ -3061,19 +3059,17 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "LLC": "/bin/false",
- "OPT": "/bin/false",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora33-release",
+ "TEST_ENV": "x86_64-linux-fedora42-release",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora33-validate+debug_info": {
+ "nightly-x86_64-linux-fedora42-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3084,7 +3080,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz",
+ "ghc-x86_64-linux-fedora42-validate.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3094,14 +3090,14 @@
"when": "always"
},
"cache": {
- "key": "x86_64-linux-fedora33-$CACHE_REV",
+ "key": "x86_64-linux-fedora42-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV",
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV",
"needs": [
{
"artifacts": false,
@@ -3127,18 +3123,16 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-validate+debug_info",
- "BUILD_FLAVOUR": "validate+debug_info",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-validate",
+ "BUILD_FLAVOUR": "validate",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "LLC": "/bin/false",
- "OPT": "/bin/false",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info",
+ "TEST_ENV": "x86_64-linux-fedora42-validate",
"XZ_OPT": "-9"
}
},
- "nightly-x86_64-linux-fedora38-validate": {
+ "nightly-x86_64-linux-fedora42-validate+debug_info": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -3149,7 +3143,7 @@
"artifacts": {
"expire_in": "8 weeks",
"paths": [
- "ghc-x86_64-linux-fedora38-validate.tar.xz",
+ "ghc-x86_64-linux-fedora42-validate+debug_info.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -3159,14 +3153,14 @@
"when": "always"
},
"cache": {
- "key": "x86_64-linux-fedora38-$CACHE_REV",
+ "key": "x86_64-linux-fedora42-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora38:$DOCKER_REV",
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV",
"needs": [
{
"artifacts": false,
@@ -3192,12 +3186,12 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora38-validate",
- "BUILD_FLAVOUR": "validate",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-validate+debug_info",
+ "BUILD_FLAVOUR": "validate+debug_info",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora38-validate",
+ "TEST_ENV": "x86_64-linux-fedora42-validate+debug_info",
"XZ_OPT": "-9"
}
},
@@ -4814,7 +4808,7 @@
"XZ_OPT": "-9"
}
},
- "release-x86_64-linux-fedora33-release": {
+ "release-x86_64-linux-fedora42-release": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -4825,7 +4819,7 @@
"artifacts": {
"expire_in": "1 year",
"paths": [
- "ghc-x86_64-linux-fedora33-release.tar.xz",
+ "ghc-x86_64-linux-fedora42-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -4835,14 +4829,14 @@
"when": "always"
},
"cache": {
- "key": "x86_64-linux-fedora33-$CACHE_REV",
+ "key": "x86_64-linux-fedora42-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV",
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV",
"needs": [
{
"artifacts": false,
@@ -4868,19 +4862,17 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"IGNORE_PERF_FAILURES": "all",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "LLC": "/bin/false",
- "OPT": "/bin/false",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora33-release",
+ "TEST_ENV": "x86_64-linux-fedora42-release",
"XZ_OPT": "-9"
}
},
- "release-x86_64-linux-fedora33-release+debug_info": {
+ "release-x86_64-linux-fedora42-release+debug_info": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -4891,7 +4883,7 @@
"artifacts": {
"expire_in": "1 year",
"paths": [
- "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz",
+ "ghc-x86_64-linux-fedora42-release+debug_info.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -4901,14 +4893,14 @@
"when": "always"
},
"cache": {
- "key": "x86_64-linux-fedora33-$CACHE_REV",
+ "key": "x86_64-linux-fedora42-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV",
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV",
"needs": [
{
"artifacts": false,
@@ -4934,19 +4926,17 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release+debug_info",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release+debug_info",
"BUILD_FLAVOUR": "release+debug_info",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"IGNORE_PERF_FAILURES": "all",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "LLC": "/bin/false",
- "OPT": "/bin/false",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora33-release+debug_info",
+ "TEST_ENV": "x86_64-linux-fedora42-release+debug_info",
"XZ_OPT": "-9"
}
},
- "release-x86_64-linux-fedora33-release-hackage": {
+ "release-x86_64-linux-fedora42-release-hackage": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -4957,7 +4947,7 @@
"artifacts": {
"expire_in": "1 year",
"paths": [
- "ghc-x86_64-linux-fedora33-release.tar.xz",
+ "ghc-x86_64-linux-fedora42-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -4967,14 +4957,14 @@
"when": "always"
},
"cache": {
- "key": "x86_64-linux-fedora33-$CACHE_REV",
+ "key": "x86_64-linux-fedora42-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV",
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV",
"needs": [
{
"artifacts": false,
@@ -5000,80 +4990,14 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"HADRIAN_ARGS": "--haddock-for-hackage",
"IGNORE_PERF_FAILURES": "all",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "LLC": "/bin/false",
- "OPT": "/bin/false",
- "RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora33-release",
- "XZ_OPT": "-9"
- }
- },
- "release-x86_64-linux-fedora38-release": {
- "after_script": [
- ".gitlab/ci.sh save_cache",
- ".gitlab/ci.sh save_test_output",
- ".gitlab/ci.sh clean",
- "cat ci_timings.txt"
- ],
- "allow_failure": false,
- "artifacts": {
- "expire_in": "1 year",
- "paths": [
- "ghc-x86_64-linux-fedora38-release.tar.xz",
- "junit.xml",
- "unexpected-test-output.tar.gz"
- ],
- "reports": {
- "junit": "junit.xml"
- },
- "when": "always"
- },
- "cache": {
- "key": "x86_64-linux-fedora38-$CACHE_REV",
- "paths": [
- "cabal-cache",
- "toolchain"
- ]
- },
- "dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora38:$DOCKER_REV",
- "needs": [
- {
- "artifacts": false,
- "job": "hadrian-ghc-in-ghci"
- }
- ],
- "rules": [
- {
- "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)",
- "when": "on_success"
- }
- ],
- "script": [
- "sudo chown ghc:ghc -R .",
- ".gitlab/ci.sh setup",
- ".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian",
- ".gitlab/ci.sh test_hadrian"
- ],
- "stage": "full-build",
- "tags": [
- "x86_64-linux"
- ],
- "variables": {
- "BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora38-release",
- "BUILD_FLAVOUR": "release",
- "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "IGNORE_PERF_FAILURES": "all",
- "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora38-release",
+ "TEST_ENV": "x86_64-linux-fedora42-release",
"XZ_OPT": "-9"
}
},
@@ -7108,7 +7032,7 @@
"TEST_ENV": "x86_64-linux-deb9-validate"
}
},
- "x86_64-linux-fedora33-release": {
+ "x86_64-linux-fedora42-release": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7119,7 +7043,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora33-release.tar.xz",
+ "ghc-x86_64-linux-fedora42-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7129,14 +7053,14 @@
"when": "always"
},
"cache": {
- "key": "x86_64-linux-fedora33-$CACHE_REV",
+ "key": "x86_64-linux-fedora42-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV",
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV",
"needs": [
{
"artifacts": false,
@@ -7145,7 +7069,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora33-release(\\s|$).*/)) || (($ONLY_JOBS == null) && ((\"true\" == \"true\")))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora42-release(\\s|$).*/)) || (($ONLY_JOBS == null) && ((\"true\" == \"true\")))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7162,17 +7086,15 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "LLC": "/bin/false",
- "OPT": "/bin/false",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora33-release"
+ "TEST_ENV": "x86_64-linux-fedora42-release"
}
},
- "x86_64-linux-fedora33-release-hackage": {
+ "x86_64-linux-fedora42-release-hackage": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7183,7 +7105,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora33-release.tar.xz",
+ "ghc-x86_64-linux-fedora42-release.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7193,14 +7115,14 @@
"when": "always"
},
"cache": {
- "key": "x86_64-linux-fedora33-$CACHE_REV",
+ "key": "x86_64-linux-fedora42-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV",
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV",
"needs": [
{
"artifacts": false,
@@ -7209,7 +7131,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora33-release(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora42-release(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7226,18 +7148,16 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"HADRIAN_ARGS": "--haddock-for-hackage",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "LLC": "/bin/false",
- "OPT": "/bin/false",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora33-release"
+ "TEST_ENV": "x86_64-linux-fedora42-release"
}
},
- "x86_64-linux-fedora33-validate+debug_info": {
+ "x86_64-linux-fedora42-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7248,7 +7168,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz",
+ "ghc-x86_64-linux-fedora42-validate.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7258,14 +7178,14 @@
"when": "always"
},
"cache": {
- "key": "x86_64-linux-fedora33-$CACHE_REV",
+ "key": "x86_64-linux-fedora42-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV",
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV",
"needs": [
{
"artifacts": false,
@@ -7274,7 +7194,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora33-validate\\+debug_info(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora42-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7291,17 +7211,15 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-validate+debug_info",
- "BUILD_FLAVOUR": "validate+debug_info",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-validate",
+ "BUILD_FLAVOUR": "validate",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "LLC": "/bin/false",
- "OPT": "/bin/false",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info"
+ "TEST_ENV": "x86_64-linux-fedora42-validate"
}
},
- "x86_64-linux-fedora38-validate": {
+ "x86_64-linux-fedora42-validate+debug_info": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
@@ -7312,7 +7230,7 @@
"artifacts": {
"expire_in": "2 weeks",
"paths": [
- "ghc-x86_64-linux-fedora38-validate.tar.xz",
+ "ghc-x86_64-linux-fedora42-validate+debug_info.tar.xz",
"junit.xml",
"unexpected-test-output.tar.gz"
],
@@ -7322,14 +7240,14 @@
"when": "always"
},
"cache": {
- "key": "x86_64-linux-fedora38-$CACHE_REV",
+ "key": "x86_64-linux-fedora42-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
- "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora38:$DOCKER_REV",
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV",
"needs": [
{
"artifacts": false,
@@ -7338,7 +7256,7 @@
],
"rules": [
{
- "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora38-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora42-validate\\+debug_info(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
"when": "on_success"
}
],
@@ -7355,12 +7273,12 @@
],
"variables": {
"BIGNUM_BACKEND": "gmp",
- "BIN_DIST_NAME": "ghc-x86_64-linux-fedora38-validate",
- "BUILD_FLAVOUR": "validate",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-validate+debug_info",
+ "BUILD_FLAVOUR": "validate+debug_info",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"RUNTEST_ARGS": "",
- "TEST_ENV": "x86_64-linux-fedora38-validate"
+ "TEST_ENV": "x86_64-linux-fedora42-validate+debug_info"
}
},
"x86_64-linux-rocky8-validate": {
=====================================
.gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
=====================================
@@ -23,10 +23,8 @@ def job_triple(job_name):
'release-x86_64-linux-ubuntu22_04-release': 'x86_64-ubuntu22_04-linux',
'release-x86_64-linux-ubuntu20_04-release': 'x86_64-ubuntu20_04-linux',
'release-x86_64-linux-ubuntu18_04-release': 'x86_64-ubuntu18_04-linux',
- 'release-x86_64-linux-fedora38-release': 'x86_64-fedora38-linux',
- 'release-x86_64-linux-fedora33-release+debug_info': 'x86_64-fedora33-linux-dwarf',
- 'release-x86_64-linux-fedora33-release': 'x86_64-fedora33-linux',
- 'release-x86_64-linux-fedora27-release': 'x86_64-fedora27-linux',
+ 'release-x86_64-linux-fedora42-release': 'x86_64-fedora42-linux',
+ 'release-x86_64-linux-fedora42-release+debug_info': 'x86_64-fedora42-linux-dwarf',
'release-x86_64-linux-deb12-release': 'x86_64-deb12-linux',
'release-x86_64-linux-deb11-release': 'x86_64-deb11-linux',
'release-x86_64-linux-deb10-release+debug_info': 'x86_64-deb10-linux-dwarf',
=====================================
.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
=====================================
@@ -200,7 +200,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
ubuntu2204 = mk(ubuntu("22_04"))
ubuntu2404 = mk(ubuntu("24_04"))
rocky8 = mk(rocky("8"))
- fedora33 = mk(fedora(33))
+ fedora42 = mk(fedora(42))
darwin_x86 = mk(darwin("x86_64"))
darwin_arm64 = mk(darwin("aarch64"))
windows = mk(windowsArtifact)
@@ -239,11 +239,9 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
, "unknown_versioning": ubuntu2004 }
, "Linux_CentOS" : { "( >= 8 && < 9 )" : rocky8
, "unknown_versioning" : rocky8 }
- , "Linux_Fedora" : { ">= 33": fedora33
+ , "Linux_Fedora" : { ">= 42": fedora42
, "unknown_versioning": rocky8 }
- , "Linux_RedHat" : { "< 9": rocky8
- , ">= 9": fedora33
- , "unknown_versioning": fedora33 }
+ , "Linux_RedHat" : { "unknown_versioning": rocky8 }
, "Linux_UnknownLinux" : { "unknown_versioning": rocky8 }
, "Darwin" : { "unknown_versioning" : darwin_x86 }
, "Windows" : { "unknown_versioning" : windows }
=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -58,6 +58,7 @@ module GHC.HsToCore.Monad (
import GHC.Prelude
import GHC.Driver.Env
+import GHC.Driver.Env.KnotVars
import GHC.Driver.DynFlags
import GHC.Driver.Ppr
import GHC.Driver.Config.Diagnostic
@@ -117,7 +118,7 @@ import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
import Data.IORef
-import GHC.Driver.Env.KnotVars
+
import GHC.IO.Unsafe (unsafeInterleaveIO)
{-
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -26,6 +26,7 @@ module GHC.Tc.Module (
runTcInteractive, -- Used by GHC API clients (#8878)
withTcPlugins, -- Used by GHC API clients (#20499)
withHoleFitPlugins, -- Used by GHC API clients (#20499)
+ withDefaultingPlugins,
tcRnLookupName,
tcRnGetInfo,
tcRnModule, tcRnModuleTcRnM,
@@ -53,7 +54,6 @@ import GHC.Driver.DynFlags
import GHC.Driver.Config.Diagnostic
import GHC.IO.Unsafe ( unsafeInterleaveIO )
-import GHC.Tc.Errors.Hole.Plugin ( HoleFitPluginR (..) )
import GHC.Tc.Errors.Types
import {-# SOURCE #-} GHC.Tc.Gen.Splice ( finishTH, runRemoteModFinalizers )
import GHC.Tc.Gen.HsType
@@ -141,7 +141,6 @@ import GHC.Types.Id as Id
import GHC.Types.Id.Info( IdDetails(..) )
import GHC.Types.Var.Env
import GHC.Types.TypeEnv
-import GHC.Types.Unique.FM
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
@@ -212,10 +211,6 @@ tcRnModule hsc_env mod_sum save_rn_syntax
(text "Renamer/typechecker"<+>brackets (ppr this_mod))
(const ()) $
initTc hsc_env hsc_src save_rn_syntax this_mod real_loc $
- withTcPlugins hsc_env $
- withDefaultingPlugins hsc_env $
- withHoleFitPlugins hsc_env $
-
tcRnModuleTcRnM hsc_env mod_sum parsedModule this_mod
| otherwise
@@ -3182,72 +3177,11 @@ hasTopUserName x
{-
********************************************************************************
-Type Checker Plugins
+ Running plugins
********************************************************************************
-}
-withTcPlugins :: HscEnv -> TcM a -> TcM a
-withTcPlugins hsc_env m =
- case catMaybes $ mapPlugins (hsc_plugins hsc_env) tcPlugin of
- [] -> m -- Common fast case
- plugins -> do
- (solvers, rewriters, stops) <-
- unzip3 `fmap` mapM start_plugin plugins
- let
- rewritersUniqFM :: UniqFM TyCon [TcPluginRewriter]
- !rewritersUniqFM = sequenceUFMList rewriters
- -- The following ensures that tcPluginStop is called even if a type
- -- error occurs during compilation (Fix of #10078)
- eitherRes <- tryM $
- updGblEnv (\e -> e { tcg_tc_plugin_solvers = solvers
- , tcg_tc_plugin_rewriters = rewritersUniqFM }) m
- mapM_ runTcPluginM stops
- case eitherRes of
- Left _ -> failM
- Right res -> return res
- where
- start_plugin (TcPlugin start solve rewrite stop) =
- do s <- runTcPluginM start
- return (solve s, rewrite s, stop s)
-
-withDefaultingPlugins :: HscEnv -> TcM a -> TcM a
-withDefaultingPlugins hsc_env m =
- do case catMaybes $ mapPlugins (hsc_plugins hsc_env) defaultingPlugin of
- [] -> m -- Common fast case
- plugins -> do (plugins,stops) <- mapAndUnzipM start_plugin plugins
- -- This ensures that dePluginStop is called even if a type
- -- error occurs during compilation
- eitherRes <- tryM $ do
- updGblEnv (\e -> e { tcg_defaulting_plugins = plugins }) m
- mapM_ runTcPluginM stops
- case eitherRes of
- Left _ -> failM
- Right res -> return res
- where
- start_plugin (DefaultingPlugin start fill stop) =
- do s <- runTcPluginM start
- return (fill s, stop s)
-
-withHoleFitPlugins :: HscEnv -> TcM a -> TcM a
-withHoleFitPlugins hsc_env m =
- case catMaybes $ mapPlugins (hsc_plugins hsc_env) holeFitPlugin of
- [] -> m -- Common fast case
- plugins -> do (plugins,stops) <- mapAndUnzipM start_plugin plugins
- -- This ensures that hfPluginStop is called even if a type
- -- error occurs during compilation.
- eitherRes <- tryM $
- updGblEnv (\e -> e { tcg_hf_plugins = plugins }) m
- sequence_ stops
- case eitherRes of
- Left _ -> failM
- Right res -> return res
- where
- start_plugin (HoleFitPluginR init plugin stop) =
- do ref <- init
- return (plugin ref, stop ref)
-
-
runRenamerPlugin :: TcGblEnv
-> HsGroup GhcRn
-> TcM (TcGblEnv, HsGroup GhcRn)
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -31,6 +31,9 @@ module GHC.Tc.Utils.Monad(
updateEps, updateEps_,
getHpt, getEpsAndHug,
+ -- * Initialising TcM plugins
+ withTcPlugins, withDefaultingPlugins, withHoleFitPlugins,
+
-- * Arrow scopes
newArrowScope, escapeArrowScope,
@@ -163,6 +166,7 @@ import GHC.Builtin.Names
import GHC.Builtin.Types( zonkAnyTyCon )
import GHC.Tc.Errors.Types
+import GHC.Tc.Errors.Hole.Plugin ( HoleFitPluginR (..) )
import GHC.Tc.Types -- Re-export all
import GHC.Tc.Types.Constraint
import GHC.Tc.Types.CtLoc
@@ -183,13 +187,17 @@ import GHC.Unit.Module.Warnings
import GHC.Unit.Home.PackageTable
import GHC.Core.UsageEnv
+
+import GHC.Core.Coercion ( isReflCo )
import GHC.Core.Multiplicity
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Core.Type( mkNumLitTy )
+import GHC.Core.TyCon ( TyCon )
import GHC.Driver.Env
import GHC.Driver.Env.KnotVars
+import GHC.Driver.Plugins ( Plugin(..), mapPlugins )
import GHC.Driver.Session
import GHC.Driver.Config.Diagnostic
@@ -226,7 +234,7 @@ import GHC.Types.SrcLoc
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.Name.Ppr
-import GHC.Types.Unique.FM ( emptyUFM )
+import GHC.Types.Unique.FM ( UniqFM, emptyUFM, sequenceUFMList )
import GHC.Types.Unique.DFM
import GHC.Types.Unique.Supply
import GHC.Types.Annotations
@@ -240,8 +248,6 @@ import Data.IORef
import Control.Monad
import qualified Data.Map as Map
-import GHC.Core.Coercion (isReflCo)
-
{-
************************************************************************
@@ -263,129 +269,139 @@ initTc :: HscEnv
-- (error messages should have been printed already)
initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
- = do { keep_var <- newIORef emptyNameSet ;
- used_gre_var <- newIORef [] ;
- th_var <- newIORef False ;
- infer_var <- newIORef True ;
- infer_reasons_var <- newIORef emptyMessages ;
- dfun_n_var <- newIORef emptyOccSet ;
- zany_n_var <- newIORef 0 ;
- let { type_env_var = hsc_type_env_vars hsc_env };
-
- dependent_files_var <- newIORef [] ;
- dependent_dirs_var <- newIORef [] ;
- static_wc_var <- newIORef emptyWC ;
- cc_st_var <- newIORef newCostCentreState ;
- th_topdecls_var <- newIORef [] ;
- th_foreign_files_var <- newIORef [] ;
- th_topnames_var <- newIORef emptyNameSet ;
- th_modfinalizers_var <- newIORef [] ;
- th_coreplugins_var <- newIORef [] ;
- th_state_var <- newIORef Map.empty ;
- th_remote_state_var <- newIORef Nothing ;
- th_docs_var <- newIORef Map.empty ;
- th_needed_deps_var <- newIORef ([], emptyUDFM) ;
- next_wrapper_num <- newIORef emptyModuleEnv ;
- let {
- -- bangs to avoid leaking the env (#19356)
- !dflags = hsc_dflags hsc_env ;
- !mhome_unit = hsc_home_unit_maybe hsc_env;
- !logger = hsc_logger hsc_env ;
-
- maybe_rn_syntax :: forall a. a -> Maybe a ;
- maybe_rn_syntax empty_val
- | logHasDumpFlag logger Opt_D_dump_rn_ast = Just empty_val
-
- | gopt Opt_WriteHie dflags = Just empty_val
-
- -- We want to serialize the documentation in the .hi-files,
- -- and need to extract it from the renamed syntax first.
- -- See 'GHC.HsToCore.Docs.extractDocs'.
- | gopt Opt_Haddock dflags = Just empty_val
-
- | keep_rn_syntax = Just empty_val
- | otherwise = Nothing ;
-
- gbl_env = TcGblEnv {
- tcg_th_topdecls = th_topdecls_var,
- tcg_th_foreign_files = th_foreign_files_var,
- tcg_th_topnames = th_topnames_var,
- tcg_th_modfinalizers = th_modfinalizers_var,
- tcg_th_coreplugins = th_coreplugins_var,
- tcg_th_state = th_state_var,
- tcg_th_remote_state = th_remote_state_var,
- tcg_th_docs = th_docs_var,
-
- tcg_mod = mod,
- tcg_semantic_mod = homeModuleInstantiation mhome_unit mod,
- tcg_src = hsc_src,
- tcg_rdr_env = emptyGlobalRdrEnv,
- tcg_fix_env = emptyNameEnv,
- tcg_default = emptyDefaultEnv,
- tcg_default_exports = emptyDefaultEnv,
- tcg_type_env = emptyNameEnv,
- tcg_type_env_var = type_env_var,
- tcg_inst_env = emptyInstEnv,
- tcg_fam_inst_env = emptyFamInstEnv,
- tcg_ann_env = emptyAnnEnv,
- tcg_complete_match_env = [],
- tcg_th_used = th_var,
- tcg_th_needed_deps = th_needed_deps_var,
- tcg_exports = [],
- tcg_imports = emptyImportAvails,
- tcg_import_decls = [],
- tcg_used_gres = used_gre_var,
- tcg_dus = emptyDUs,
-
- tcg_rn_imports = [],
- tcg_rn_exports =
- if hsc_src == HsigFile
- -- Always retain renamed syntax, so that we can give
- -- better errors. (TODO: how?)
- then Just []
- else maybe_rn_syntax [],
- tcg_rn_decls = maybe_rn_syntax emptyRnGroup,
- tcg_tr_module = Nothing,
- tcg_binds = emptyLHsBinds,
- tcg_imp_specs = [],
- tcg_sigs = emptyNameSet,
- tcg_ksigs = emptyNameSet,
- tcg_ev_binds = emptyBag,
- tcg_warns = emptyWarn,
- tcg_anns = [],
- tcg_tcs = [],
- tcg_insts = [],
- tcg_fam_insts = [],
- tcg_rules = [],
- tcg_fords = [],
- tcg_patsyns = [],
- tcg_merged = [],
- tcg_dfun_n = dfun_n_var,
- tcg_zany_n = zany_n_var,
- tcg_keep = keep_var,
- tcg_hdr_info = (Nothing,Nothing),
- tcg_main = Nothing,
- tcg_self_boot = NoSelfBoot,
- tcg_safe_infer = infer_var,
- tcg_safe_infer_reasons = infer_reasons_var,
- tcg_dependent_files = dependent_files_var,
- tcg_dependent_dirs = dependent_dirs_var,
- tcg_tc_plugin_solvers = [],
- tcg_tc_plugin_rewriters = emptyUFM,
- tcg_defaulting_plugins = [],
- tcg_hf_plugins = [],
- tcg_top_loc = loc,
- tcg_static_wc = static_wc_var,
- tcg_complete_matches = [],
- tcg_cc_st = cc_st_var,
- tcg_next_wrapper_num = next_wrapper_num
- } ;
- } ;
+ = do { gbl_env <- initTcGblEnv hsc_env hsc_src keep_rn_syntax mod loc
-- OK, here's the business end!
- initTcWithGbl hsc_env gbl_env loc do_this
+ ; initTcWithGbl hsc_env gbl_env loc $
+
+ -- Make sure to initialise all TcM plugins from the ambient HscEnv.
+ --
+ -- This ensures that all callers of 'initTc' enable plugins (#26395).
+ withTcPlugins hsc_env $
+ withDefaultingPlugins hsc_env $
+ withHoleFitPlugins hsc_env $
+
+ do_this
}
+-- | Create an empty 'TcGblEnv'.
+initTcGblEnv :: HscEnv -> HscSource -> Bool -> Module -> RealSrcSpan -> IO TcGblEnv
+initTcGblEnv hsc_env hsc_src keep_rn_syntax mod loc =
+ do { keep_var <- newIORef emptyNameSet
+ ; used_gre_var <- newIORef []
+ ; th_var <- newIORef False
+ ; infer_var <- newIORef True
+ ; infer_reasons_var <- newIORef emptyMessages
+ ; dfun_n_var <- newIORef emptyOccSet
+ ; zany_n_var <- newIORef 0
+ ; dependent_files_var <- newIORef []
+ ; dependent_dirs_var <- newIORef []
+ ; static_wc_var <- newIORef emptyWC
+ ; cc_st_var <- newIORef newCostCentreState
+ ; th_topdecls_var <- newIORef []
+ ; th_foreign_files_var <- newIORef []
+ ; th_topnames_var <- newIORef emptyNameSet
+ ; th_modfinalizers_var <- newIORef []
+ ; th_coreplugins_var <- newIORef []
+ ; th_state_var <- newIORef Map.empty
+ ; th_remote_state_var <- newIORef Nothing
+ ; th_docs_var <- newIORef Map.empty
+ ; th_needed_deps_var <- newIORef ([], emptyUDFM)
+ ; next_wrapper_num <- newIORef emptyModuleEnv
+ ; let
+ -- bangs to avoid leaking the env (#19356)
+ !dflags = hsc_dflags hsc_env
+ !mhome_unit = hsc_home_unit_maybe hsc_env
+ !logger = hsc_logger hsc_env
+
+ maybe_rn_syntax :: forall a. a -> Maybe a ;
+ maybe_rn_syntax empty_val
+ | logHasDumpFlag logger Opt_D_dump_rn_ast = Just empty_val
+
+ | gopt Opt_WriteHie dflags = Just empty_val
+
+ -- We want to serialize the documentation in the .hi-files,
+ -- and need to extract it from the renamed syntax first.
+ -- See 'GHC.HsToCore.Docs.extractDocs'.
+ | gopt Opt_Haddock dflags = Just empty_val
+
+ | keep_rn_syntax = Just empty_val
+ | otherwise = Nothing ;
+
+ ; return $ TcGblEnv
+ { tcg_th_topdecls = th_topdecls_var
+ , tcg_th_foreign_files = th_foreign_files_var
+ , tcg_th_topnames = th_topnames_var
+ , tcg_th_modfinalizers = th_modfinalizers_var
+ , tcg_th_coreplugins = th_coreplugins_var
+ , tcg_th_state = th_state_var
+ , tcg_th_remote_state = th_remote_state_var
+ , tcg_th_docs = th_docs_var
+
+ , tcg_mod = mod
+ , tcg_semantic_mod = homeModuleInstantiation mhome_unit mod
+ , tcg_src = hsc_src
+ , tcg_rdr_env = emptyGlobalRdrEnv
+ , tcg_fix_env = emptyNameEnv
+ , tcg_default = emptyDefaultEnv
+ , tcg_default_exports = emptyDefaultEnv
+ , tcg_type_env = emptyNameEnv
+ , tcg_type_env_var = hsc_type_env_vars hsc_env
+ , tcg_inst_env = emptyInstEnv
+ , tcg_fam_inst_env = emptyFamInstEnv
+ , tcg_ann_env = emptyAnnEnv
+ , tcg_complete_match_env = []
+ , tcg_th_used = th_var
+ , tcg_th_needed_deps = th_needed_deps_var
+ , tcg_exports = []
+ , tcg_imports = emptyImportAvails
+ , tcg_import_decls = []
+ , tcg_used_gres = used_gre_var
+ , tcg_dus = emptyDUs
+
+ , tcg_rn_imports = []
+ , tcg_rn_exports = if hsc_src == HsigFile
+ -- Always retain renamed syntax, so that we can give
+ -- better errors. (TODO: how?)
+ then Just []
+ else maybe_rn_syntax []
+ , tcg_rn_decls = maybe_rn_syntax emptyRnGroup
+ , tcg_tr_module = Nothing
+ , tcg_binds = emptyLHsBinds
+ , tcg_imp_specs = []
+ , tcg_sigs = emptyNameSet
+ , tcg_ksigs = emptyNameSet
+ , tcg_ev_binds = emptyBag
+ , tcg_warns = emptyWarn
+ , tcg_anns = []
+ , tcg_tcs = []
+ , tcg_insts = []
+ , tcg_fam_insts = []
+ , tcg_rules = []
+ , tcg_fords = []
+ , tcg_patsyns = []
+ , tcg_merged = []
+ , tcg_dfun_n = dfun_n_var
+ , tcg_zany_n = zany_n_var
+ , tcg_keep = keep_var
+ , tcg_hdr_info = (Nothing,Nothing)
+ , tcg_main = Nothing
+ , tcg_self_boot = NoSelfBoot
+ , tcg_safe_infer = infer_var
+ , tcg_safe_infer_reasons = infer_reasons_var
+ , tcg_dependent_files = dependent_files_var
+ , tcg_dependent_dirs = dependent_dirs_var
+ , tcg_tc_plugin_solvers = []
+ , tcg_tc_plugin_rewriters = emptyUFM
+ , tcg_defaulting_plugins = []
+ , tcg_hf_plugins = []
+ , tcg_top_loc = loc
+ , tcg_static_wc = static_wc_var
+ , tcg_complete_matches = []
+ , tcg_cc_st = cc_st_var
+ , tcg_next_wrapper_num = next_wrapper_num
+ } }
+
-- | Run a 'TcM' action in the context of an existing 'GblEnv'.
initTcWithGbl :: HscEnv
-> TcGblEnv
@@ -686,6 +702,83 @@ withIfaceErr ctx do_this = do
liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx msg))
Succeeded result -> return result
+{-
+************************************************************************
+* *
+ Initialising plugins for TcM
+* *
+************************************************************************
+-}
+
+-- | Initialise typechecker plugins, run the inner action, then stop
+-- the typechecker plugins.
+withTcPlugins :: HscEnv -> TcM a -> TcM a
+withTcPlugins hsc_env m =
+ case catMaybes $ mapPlugins (hsc_plugins hsc_env) tcPlugin of
+ [] -> m -- Common fast case
+ plugins -> do
+ (solvers, rewriters, stops) <-
+ unzip3 `fmap` mapM start_plugin plugins
+ let
+ rewritersUniqFM :: UniqFM TyCon [TcPluginRewriter]
+ !rewritersUniqFM = sequenceUFMList rewriters
+ -- The following ensures that tcPluginStop is called even if a type
+ -- error occurs during compilation (Fix of #10078)
+ eitherRes <- tryM $
+ updGblEnv (\e -> e { tcg_tc_plugin_solvers = solvers
+ , tcg_tc_plugin_rewriters = rewritersUniqFM })
+ m
+ mapM_ runTcPluginM stops
+ case eitherRes of
+ Left _ -> failM
+ Right res -> return res
+ where
+ start_plugin (TcPlugin start solve rewrite stop) =
+ do s <- runTcPluginM start
+ return (solve s, rewrite s, stop s)
+
+-- | Initialise defaulting plugins, run the inner action, then stop
+-- the defaulting plugins.
+withDefaultingPlugins :: HscEnv -> TcM a -> TcM a
+withDefaultingPlugins hsc_env m =
+ do case catMaybes $ mapPlugins (hsc_plugins hsc_env) defaultingPlugin of
+ [] -> m -- Common fast case
+ plugins -> do (plugins,stops) <- mapAndUnzipM start_plugin plugins
+ -- This ensures that dePluginStop is called even if a type
+ -- error occurs during compilation
+ eitherRes <- tryM $ do
+ updGblEnv (\e -> e { tcg_defaulting_plugins = plugins })
+ m
+ mapM_ runTcPluginM stops
+ case eitherRes of
+ Left _ -> failM
+ Right res -> return res
+ where
+ start_plugin (DefaultingPlugin start fill stop) =
+ do s <- runTcPluginM start
+ return (fill s, stop s)
+
+-- | Initialise hole fit plugins, run the inner action, then stop
+-- the hole fit plugins.
+withHoleFitPlugins :: HscEnv -> TcM a -> TcM a
+withHoleFitPlugins hsc_env m =
+ case catMaybes $ mapPlugins (hsc_plugins hsc_env) holeFitPlugin of
+ [] -> m -- Common fast case
+ plugins -> do (plugins,stops) <- mapAndUnzipM start_plugin plugins
+ -- This ensures that hfPluginStop is called even if a type
+ -- error occurs during compilation.
+ eitherRes <- tryM $
+ updGblEnv (\e -> e { tcg_hf_plugins = plugins })
+ m
+ sequence_ stops
+ case eitherRes of
+ Left _ -> failM
+ Right res -> return res
+ where
+ start_plugin (HoleFitPluginR init plugin stop) =
+ do ref <- init
+ return (plugin ref, stop ref)
+
{-
************************************************************************
* *
=====================================
m4/prep_target_file.m4
=====================================
@@ -78,22 +78,6 @@ AC_DEFUN([PREP_MAYBE_PROGRAM],[
AC_SUBST([$1MaybeProg])
])
-# PREP_MAYBE_LIBRARY
-# =========================
-#
-# Introduce a substitution [$1MaybeProg] with
-# * Nothing, if $$1 is empty or "NO"
-# * Just the library otherwise
-AC_DEFUN([PREP_MAYBE_LIBRARY],[
- if test -z "$$1" || test "$$1" = "NO"; then
- $1MaybeLibrary=Nothing
- else
- PREP_LIST([$2])
- $1MaybeLibrary="Just (Library { libName = \"$2\", includePath = \"$3\", libraryPath = \"$4\" })"
- fi
- AC_SUBST([$1MaybeLibrary])
-])
-
# PREP_MAYBE_STRING
# =========================
#
@@ -111,6 +95,24 @@ AC_DEFUN([PREP_MAYBE_STRING],[
AC_SUBST([$1MaybeStr])
])
+# PREP_MAYBE_LIBRARY
+# =========================
+#
+# Introduce a substitution [$1MaybeProg] with
+# * Nothing, if $$1 is empty or "NO"
+# * Just the library otherwise
+AC_DEFUN([PREP_MAYBE_LIBRARY],[
+ if test -z "$$1" || test "$$1" = "NO"; then
+ $1MaybeLibrary=Nothing
+ else
+ PREP_LIST([$2])
+ PREP_MAYBE_STRING([$3])
+ PREP_MAYBE_STRING([$4])
+ $1MaybeLibrary="Just Library { libName = \"$2\", includePath = $$3MaybeStr, libraryPath = $$4MaybeStr }"
+ fi
+ AC_SUBST([$1MaybeLibrary])
+])
+
# PREP_BOOLEAN
# ============
#
@@ -195,10 +197,7 @@ AC_DEFUN([PREP_TARGET_FILE],[
PREP_LIST([CONF_CPP_OPTS_STAGE2])
PREP_LIST([CONF_CXX_OPTS_STAGE2])
PREP_LIST([CONF_CC_OPTS_STAGE2])
-
- PREP_MAYBE_STRING([LibdwIncludeDir])
- PREP_MAYBE_STRING([LibdwLibDir])
- PREP_MAYBE_LIBRARY([UseLibdw], [dw], [$LibdwIncludeDirMaybeStr], [$LibdwLibDirMaybeStr])
+ PREP_MAYBE_LIBRARY([UseLibdw], [dw], [LibdwIncludeDir], [LibdwLibDir])
dnl Host target
PREP_BOOLEAN([ArSupportsAtFile_STAGE0])
=====================================
testsuite/tests/codeGen/should_compile/Makefile
=====================================
@@ -36,7 +36,7 @@ T13233_orig:
T14999:
'$(TEST_HC)' $(TEST_HC_OPTS) -O2 -g -c T14999.cmm -o T14999.o
- gdb --batch -ex 'file T14999.o' -ex 'disassemble stg_catch_frame_info' --nx | tr -s '[[:blank:]\n]'
+ gdb --batch -ex 'set disassembly-flavor intel' -ex 'file T14999.o' -ex 'disassemble stg_catch_frame_info' --nx | tr -s '[[:blank:]\n]'
LANG=C readelf --debug-dump=frames-interp T14999.o | tr -s '[[:blank:]\n]'
T15196:
=====================================
testsuite/tests/codeGen/should_compile/T14999.stdout
=====================================
@@ -1,6 +1,6 @@
Dump of assembler code for function stg_catch_frame_info:
- 0x0000000000000010 <+0>: add $0x18,%rbp
- 0x0000000000000014 <+4>: jmpq *0x0(%rbp)
+ 0x0000000000000010 <+1>: add rbp,0x18
+ 0x0000000000000014 <+5>: jmp QWORD PTR [rbp+0x0]
End of assembler dump.
Contents of the .debug_frame section:
00000000 0000000000000014 ffffffff CIE "" cf=1 df=-8 ra=16
=====================================
testsuite/tests/tcplugins/T26395.hs
=====================================
@@ -0,0 +1,51 @@
+
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UnliftedDatatypes #-}
+
+{-# OPTIONS_GHC -fplugin=T26395_Plugin #-}
+
+{-# OPTIONS_GHC -Wincomplete-patterns #-}
+{-# OPTIONS_GHC -Winaccessible-code #-}
+{-# OPTIONS_GHC -Woverlapping-patterns #-}
+
+module T26395 where
+
+import Data.Kind
+import GHC.TypeNats
+import GHC.Exts ( UnliftedType )
+
+-- This test verifies that typechecker plugins are enabled
+-- when we run the solver for pattern-match checking.
+
+type Peano :: Nat -> UnliftedType
+data Peano n where
+ Z :: Peano 0
+ S :: Peano n -> Peano (1 + n)
+
+test1 :: Peano n -> Peano n -> Int
+test1 Z Z = 0
+test1 (S n) (S m) = 1 + test1 n m
+
+{-
+The following test doesn't work properly due to #26401:
+the pattern-match checker reports a missing equation
+
+ Z (S _) _
+
+but there is no invocation of the solver of the form
+
+ [G] n ~ 0
+ [G] m ~ 1 + m1
+ [G] (n-m) ~ m2
+
+for which we could report the Givens as contradictory.
+
+test2 :: Peano n -> Peano m -> Peano (n - m) -> Int
+test2 Z Z Z = 0
+test2 (S _) (S _) _ = 1
+test2 (S _) Z (S _) = 2
+-}
=====================================
testsuite/tests/tcplugins/T26395.stderr
=====================================
@@ -0,0 +1,2 @@
+[1 of 2] Compiling T26395_Plugin ( T26395_Plugin.hs, T26395_Plugin.o )
+[2 of 2] Compiling T26395 ( T26395.hs, T26395.o )
=====================================
testsuite/tests/tcplugins/T26395_Plugin.hs
=====================================
@@ -0,0 +1,208 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE ViewPatterns #-}
+
+{-# OPTIONS_GHC -Wall -Wno-orphans #-}
+
+module T26395_Plugin where
+
+-- base
+import Prelude hiding ( (<>) )
+import qualified Data.Semigroup as S
+import Data.List ( partition )
+import Data.Maybe
+import GHC.TypeNats
+
+-- ghc
+import GHC.Builtin.Types.Literals
+import GHC.Core.Predicate
+import GHC.Core.TyCo.Rep
+import GHC.Plugins
+import GHC.Tc.Plugin
+import GHC.Tc.Types
+import GHC.Tc.Types.Constraint
+import GHC.Tc.Types.Evidence
+import GHC.Tc.Utils.TcType
+import GHC.Types.Unique.Map
+
+--------------------------------------------------------------------------------
+
+plugin :: Plugin
+plugin =
+ defaultPlugin
+ { pluginRecompile = purePlugin
+ , tcPlugin = \ _-> Just $
+ TcPlugin
+ { tcPluginInit = pure ()
+ , tcPluginSolve = \ _ -> solve
+ , tcPluginRewrite = \ _ -> emptyUFM
+ , tcPluginStop = \ _ -> pure ()
+ }
+ }
+
+solve :: EvBindsVar -> [Ct] -> [Ct] -> TcPluginM TcPluginSolveResult
+solve _ givens wanteds
+ -- This plugin only reports inconsistencies among Given constraints.
+ | not $ null wanteds
+ = pure $ TcPluginOk [] []
+ | otherwise
+ = do { let givenLinearExprs = mapMaybe linearExprCt_maybe givens
+ sols = solutions givenLinearExprs
+
+ ; tcPluginTrace "solveLinearExprs" $
+ vcat [ text "givens:" <+> ppr givens
+ , text "linExprs:" <+> ppr givenLinearExprs
+ , text "sols:" <+> ppr (take 1 sols)
+ ]
+ ; return $
+ if null sols
+ then TcPluginContradiction givens
+ else TcPluginOk [] []
+ }
+
+data LinearExpr =
+ LinearExpr
+ { constant :: Integer
+ , coeffs :: UniqMap TyVar Integer
+ }
+instance Semigroup LinearExpr where
+ LinearExpr c xs <> LinearExpr d ys =
+ LinearExpr ( c + d ) ( plusMaybeUniqMap_C comb xs ys )
+ where
+ comb a1 a2 =
+ let a = a1 + a2
+ in if a == 0
+ then Nothing
+ else Just a
+
+instance Monoid LinearExpr where
+ mempty = LinearExpr 0 emptyUniqMap
+
+mapLinearExpr :: (Integer -> Integer) -> LinearExpr -> LinearExpr
+mapLinearExpr f (LinearExpr c xs) = LinearExpr (f c) (mapUniqMap f xs)
+
+minusLinearExpr :: LinearExpr -> LinearExpr -> LinearExpr
+minusLinearExpr a b = a S.<> mapLinearExpr negate b
+
+instance Outputable LinearExpr where
+ ppr ( LinearExpr c xs ) =
+ hcat $ punctuate ( text " + " ) $
+ ( ppr c : map ppr_var ( nonDetUniqMapToList xs ) )
+ where
+ ppr_var ( tv, i )
+ | i == 1
+ = ppr tv
+ | i < 0
+ = parens ( text "-" <> ppr (abs i) ) <> text "*" <> ppr tv
+ | otherwise
+ = ppr i <> text "*" <> ppr tv
+
+maxCoeff :: LinearExpr -> Double
+maxCoeff ( LinearExpr c xs ) =
+ maximum ( map fromInteger ( c : nonDetEltsUniqMap xs ) )
+
+
+linearExprCt_maybe :: Ct -> Maybe LinearExpr
+linearExprCt_maybe ct =
+ case classifyPredType (ctPred ct) of
+ EqPred NomEq lhs rhs
+ | all isNaturalTy [ typeKind lhs, typeKind rhs ]
+ , Just e1 <- linearExprTy_maybe lhs
+ , Just e2 <- linearExprTy_maybe rhs
+ -> Just $ e1 `minusLinearExpr` e2
+ _ -> Nothing
+
+isNat :: Type -> Maybe Integer
+isNat ty
+ | Just (NumTyLit n) <- isLitTy ty
+ = Just n
+ | otherwise
+ = Nothing
+
+linearExprTy_maybe :: Type -> Maybe LinearExpr
+linearExprTy_maybe ty
+ | Just n <- isNat ty
+ = Just $ LinearExpr n emptyUniqMap
+ | Just (tc, args) <- splitTyConApp_maybe ty
+ = if | tc == typeNatAddTyCon
+ , [x, y] <- args
+ , Just e1 <- linearExprTy_maybe x
+ , Just e2 <- linearExprTy_maybe y
+ -> Just $ e1 S.<> e2
+ | tc == typeNatSubTyCon
+ , [x,y] <- args
+ , Just e1 <- linearExprTy_maybe x
+ , Just e2 <- linearExprTy_maybe y
+ -> Just $ e1 `minusLinearExpr` e2
+ | tc == typeNatMulTyCon
+ , [x, y] <- args
+ ->
+ if | Just ( LinearExpr n xs ) <- linearExprTy_maybe x
+ , isNullUniqMap xs
+ , Just e <- linearExprTy_maybe y
+ -> Just $
+ if n == 0
+ then mempty
+ else mapLinearExpr (n *) e
+ | Just ( LinearExpr n ys ) <- linearExprTy_maybe y
+ , isNullUniqMap ys
+ , Just e <- linearExprTy_maybe x
+ -> Just $
+ if n == 0
+ then mempty
+ else mapLinearExpr (fromIntegral n *) e
+ | otherwise
+ -> Nothing
+ | otherwise
+ -> Nothing
+ | Just tv <- getTyVar_maybe ty
+ = Just $ LinearExpr 0 ( unitUniqMap tv 1 )
+ | otherwise
+ = Nothing
+
+-- Brute force algorithm to check whether a system of Diophantine
+-- linear equations is solvable in natural numbers.
+solutions :: [ LinearExpr ] -> [ UniqMap TyVar Natural ]
+solutions eqs =
+ let
+ (constEqs, realEqs) = partition (isNullUniqMap . coeffs) eqs
+ d = length realEqs
+ fvs = nonDetKeysUniqMap $ plusUniqMapList ( map coeffs realEqs )
+ in
+ if | any ( ( /= 0 ) . evalLinearExpr emptyUniqMap ) constEqs
+ -> []
+ | d == 0
+ -> [ emptyUniqMap ]
+ | otherwise
+ ->
+ let
+ m = maximum $ map maxCoeff realEqs
+ hadamardBound = sqrt ( fromIntegral $ d ^ d ) * m ^ d
+ tests = mkAssignments ( floor hadamardBound ) fvs
+ in
+ filter ( \ test -> isSolution test realEqs ) tests
+
+
+mkAssignments :: Natural -> [ TyVar ] -> [ UniqMap TyVar Natural ]
+mkAssignments _ [] = [ emptyUniqMap ]
+mkAssignments b (v : vs) =
+ [ addToUniqMap rest v n
+ | n <- [ 0 .. b ]
+ , rest <- mkAssignments b vs
+ ]
+
+isSolution :: UniqMap TyVar Natural -> [ LinearExpr ] -> Bool
+isSolution assig =
+ all ( \ expr -> evalLinearExpr assig expr == 0 )
+
+evalLinearExpr :: UniqMap TyVar Natural -> LinearExpr -> Integer
+evalLinearExpr vals ( LinearExpr c xs ) = nonDetFoldUniqMap aux c xs
+ where
+ aux ( tv, coeff ) !acc = acc + coeff * val
+ where
+ val :: Integer
+ val = case lookupUniqMap vals tv of
+ Nothing -> pprPanic "evalLinearExpr: missing tv" (ppr tv)
+ Just v -> fromIntegral v
=====================================
testsuite/tests/tcplugins/all.T
=====================================
@@ -110,6 +110,19 @@ test('TcPlugin_CtId'
, '-dynamic -package ghc' if have_dynamic() else '-package ghc' ]
)
+# Checks that we run type-checker plugins for pattern-match warnings.
+test('T26395'
+ , [ extra_files(
+ [ 'T26395_Plugin.hs'
+ , 'T26395.hs'
+ ])
+ , req_th
+ ]
+ , multimod_compile
+ , [ 'T26395.hs'
+ , '-dynamic -package ghc' if have_dynamic() else '-package ghc' ]
+ )
+
test('T11462', [js_broken(22261), req_th, req_plugins], multi_compile,
[None, [('T11462_Plugin.hs', '-package ghc'), ('T11462.hs', '')],
'-dynamic' if have_dynamic() else ''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a35b4ee765a3f8189beb9a9ffe0775…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a35b4ee765a3f8189beb9a9ffe0775…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/24985] 2 commits: Don't use build CFLAGS and friends as target settings
by Rodrigo Mesquita (＠alt-romes) 19 Sep '25
by Rodrigo Mesquita (＠alt-romes) 19 Sep '25
19 Sep '25
Rodrigo Mesquita pushed to branch wip/romes/24985 at Glasgow Haskell Compiler / GHC
Commits:
670f28fb by Rodrigo Mesquita at 2025-09-19T10:23:26+01:00
Don't use build CFLAGS and friends as target settings
In the GHC in tree configure, `CFLAGS`, `CXXFLAGS`, and similar tool
configuration flags apply to the BUILD phase of the compiler, i.e. to
the tools run to compile GHC itself.
Notably, they should /not/ be carried over to the Target settings, i.e.
these flags should /not/ apply to the tool which GHC invokes at runtime.
Fixes #25637
- - - - -
0b6d63ea by Rodrigo Mesquita at 2025-09-19T10:24:10+01:00
ghc-toolchain: Linker search on target archOS
Instead of using CPP of the host platform to determine whether to find linker
This mimics the logic in `m4/find_ld.m4`
- - - - -
5 changed files:
- configure.ac
- m4/fp_setup_windows_toolchain.m4
- m4/ghc_toolchain.m4
- utils/ghc-toolchain/exe/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
Changes:
=====================================
configure.ac
=====================================
@@ -43,12 +43,6 @@ dnl interprets build/host/target and how this interacts with $CC tests
test -n "$target_alias" && ac_tool_prefix=$target_alias-
dnl ----------------------------------------------------------
-dnl ** Store USER specified environment variables to pass them on to
-dnl ** ghc-toolchain (in m4/ghc-toolchain.m4)
-USER_CFLAGS="$CFLAGS"
-USER_LDFLAGS="$LDFLAGS"
-USER_LIBS="$LIBS"
-USER_CXXFLAGS="$CXXFLAGS"
dnl The lower-level/not user-facing environment variables that may still be set
dnl by developers such as in ghc-wasm-meta
USER_CONF_CC_OPTS_STAGE2="$CONF_CC_OPTS_STAGE2"
=====================================
m4/fp_setup_windows_toolchain.m4
=====================================
@@ -146,11 +146,11 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[
dnl We override the USER_* flags here since the user delegated
dnl configuration to the bundled windows toolchain, and these are the
dnl options required by the bundled windows toolchain.
- USER_CFLAGS="$CFLAGS"
USER_CPP_ARGS="$CONF_CPP_OPTS_STAGE2"
- USER_CXXFLAGS="$CXXFLAGS"
USER_HS_CPP_ARGS="$HaskellCPPArgs"
- USER_LDFLAGS="$CONF_GCC_LINKER_OPTS_STAGE2"
+ USER_CONF_CC_OPTS_STAGE2="$CONF_CC_OPTS_STAGE2"
+ USER_CONF_CXX_OPTS_STAGE2="$CONF_CXX_OPTS_STAGE2"
+ USER_CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2"
USER_JS_CPP_ARGS="$JavaScriptCPPArgs"
USER_CMM_CPP_ARGS="$CmmCPPArgs"
])
=====================================
m4/ghc_toolchain.m4
=====================================
@@ -8,18 +8,6 @@ AC_DEFUN([ADD_GHC_TOOLCHAIN_ARG],
done
])
-dnl $1 argument name
-dnl $2 first variable to try
-dnl $3 variable to add if the first variable is empty
-AC_DEFUN([ADD_GHC_TOOLCHAIN_ARG_CHOOSE],
-[
- if test -z "$2"; then
- ADD_GHC_TOOLCHAIN_ARG([$1],[$3])
- else
- ADD_GHC_TOOLCHAIN_ARG([$1],[$2])
- fi
-])
-
AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG],
[
if test "$2" = "YES"; then
@@ -123,10 +111,9 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN],
ENABLE_GHC_TOOLCHAIN_ARG([dwarf-unwind], [$enable_dwarf_unwind])
dnl We store USER_* variants of all user-specified flags to pass them over to ghc-toolchain.
- ADD_GHC_TOOLCHAIN_ARG_CHOOSE([cc-opt], [$USER_CONF_CC_OPTS_STAGE2], [$USER_CFLAGS])
- ADD_GHC_TOOLCHAIN_ARG_CHOOSE([cc-link-opt], [$USER_CONF_GCC_LINKER_OPTS_STAGE2], [$USER_LDFLAGS])
- ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$USER_LIBS])
- ADD_GHC_TOOLCHAIN_ARG_CHOOSE([cxx-opt], [$USER_CONF_CXX_OPTS_STAGE2], [$USER_CXXFLAGS])
+ ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$USER_CONF_CC_OPTS_STAGE2])
+ ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$USER_CONF_GCC_LINKER_OPTS_STAGE2])
+ ADD_GHC_TOOLCHAIN_ARG([cxx-opt], [$USER_CONF_CXX_OPTS_STAGE2])
ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$USER_CPP_ARGS])
ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$USER_HS_CPP_ARGS])
ADD_GHC_TOOLCHAIN_ARG([js-cpp-opt], [$USER_JS_CPP_ARGS])
=====================================
utils/ghc-toolchain/exe/Main.hs
=====================================
@@ -428,17 +428,21 @@ archHasNativeAdjustors = \case
ArchJavaScript -> True
_ -> False
-
--- | The platforms which we attempt to override ld
+-- | The platforms which we attempt to override ld:
+-- Should we attempt to find a more efficient linker on this platform?
ldOverrideWhitelist :: ArchOS -> Bool
ldOverrideWhitelist a =
case archOS_OS a of
+ -- N.B. On Darwin it is quite important that we use the system linker
+ -- unchanged as it is very easy to run into broken setups (e.g. unholy mixtures
+ -- of Homebrew and the Apple toolchain).
+ --
+ -- See #21712.
+ OSDarwin -> False
OSLinux -> True
OSMinGW32 -> True
_ -> False
-
-
mkTarget :: Opts -> M Target
mkTarget opts = do
normalised_triple <- normaliseTriple (fromMaybe (error "missing --triple") (optTriple opts))
@@ -459,7 +463,8 @@ mkTarget opts = do
cmmCpp <- findCmmCpp (optCmmCpp opts) cc0
cc <- addPlatformDepCcFlags archOs cc0
readelf <- optional $ findReadelf (optReadelf opts)
- ccLink <- findCcLink tgtLlvmTarget (optLd opts) (optCcLink opts) (ldOverrideWhitelist archOs && fromMaybe True (optLdOverride opts)) archOs cc readelf
+ ccLink <- findCcLink tgtLlvmTarget (optLd opts) (optCcLink opts)
+ (ldOverrideWhitelist archOs && fromMaybe True (optLdOverride opts)) archOs cc readelf
ar <- findAr tgtVendor (optAr opts)
-- TODO: We could have
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
=====================================
@@ -83,7 +83,7 @@ findCcLink target ld progOpt ldOverride archOs cc readelf = checking "for C comp
-- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@
findLinkFlags :: Bool -> Cc -> Program -> M Program
findLinkFlags enableOverride cc ccLink
- | enableOverride && doLinkerSearch =
+ | enableOverride =
oneOf "this can't happen"
[ -- Annoyingly, gcc silently falls back to vanilla ld (typically bfd
-- ld) if @-fuse-ld@ is given with a non-existent linker.
@@ -105,20 +105,6 @@ linkSupportsTarget archOs cc target link =
checking "whether cc linker supports --target" $
supportsTarget archOs (Lens id const) (checkLinkWorks cc) target link
--- | Should we attempt to find a more efficient linker on this platform?
---
--- N.B. On Darwin it is quite important that we use the system linker
--- unchanged as it is very easy to run into broken setups (e.g. unholy mixtures
--- of Homebrew and the Apple toolchain).
---
--- See #21712.
-doLinkerSearch :: Bool
-#if defined(linux_HOST_OS)
-doLinkerSearch = True
-#else
-doLinkerSearch = False
-#endif
-
-- | See Note [No PIE when linking] in GHC.Driver.Session
checkSupportsNoPie :: Cc -> Program -> M Bool
checkSupportsNoPie cc ccLink = checking "whether the cc linker supports -no-pie" $
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04926a38edb58b4f460b34a19e7296…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04926a38edb58b4f460b34a19e7296…
You're receiving this email because of your account on gitlab.haskell.org.
1
0