[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Don't build GHC with -Wcompat
by Marge Bot (@marge-bot) 21 Jan '26
by Marge Bot (@marge-bot) 21 Jan '26
21 Jan '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
fd45fc02 by Andreas Klebinger at 2026-01-21T07:04:45-05:00
Don't build GHC with -Wcompat
Without bumping the boot compiler the warnings it produces are often not
actionable leading to pointless noise.
Fixes #26800
- - - - -
1307d1d7 by Torsten Schmits at 2026-01-21T07:04:48-05:00
Use the correct field of ModOrigin when formatting error message listing hidden reexports
- - - - -
8dd7ff46 by Cheng Shao at 2026-01-21T07:04:49-05:00
Revert "hadrian: handle findExecutable "" gracefully"
This reverts commit 1e5752f64a522c4025365856d92f78073a7b3bba. The
underlying issue has been fixed in
https://github.com/haskell/directory/commit/75828696e7145adc09179111a0d631b…
and present since 1.3.9.0, and hadrian directory lower bound is
1.3.9.0, so we can revert our own in house hack now.
- - - - -
e306178b by Cheng Shao at 2026-01-21T07:04:50-05:00
rts: fix typo in TICK_ALLOC_RTS
This patch fixes a typo in the `TICK_ALLOC_RTS` macro, the original
`bytes` argument was silently dropped. The Cmm code has its own
version of `TICK_ALLOC_RTS` not affected by this typo, it affected the
C RTS, and went unnoticed because the variable `n` happened to also be
available at its call site. But the number was incorrect. Also fixes
its call site since `WDS()` is not available in C.
- - - - -
176a0d8a by Cheng Shao at 2026-01-21T07:04:50-05:00
rts: remove broken & unused ALLOC_P_TICKY
This patch removes the `ALLOC_P_TICKY` macro from the rts, it's
unused, and its expanded code is already broken.
- - - - -
9bb921e7 by Simon Peyton Jones at 2026-01-21T07:04:51-05:00
Make the implicit-parameter class have representational role
This MR addresses #26737, by making the built-in class IP
have a representational role for its second parameter.
See Note [IP: implicit parameter class] in
ghc-internal:GHC.Internal.Classes.IP
In fact, IP is (unfortunately, currently) exposed by
base:GHC.Base, so we ran a quick CLC proposal to
agree the change:
https://github.com/haskell/core-libraries-committee/issues/385
Some (small) compilations get faster because they only need to
load (small) interface file GHC.Internal.Classes.IP.hi,
rather than (large) GHC.Internal.Classes.hi.
Metric Decrease:
T10421
T12150
T12425
T24582
T5837
T5030
- - - - -
852def01 by Cheng Shao at 2026-01-21T07:04:52-05:00
testsuite: avoid re.sub in favor of simple string replacements
This patch refactors the testsuite driver and avoids the usage of
re.sub in favor of simple string replacements when possible. The
changes are not comprehensive, and there are still a lot of re.sub
usages lingering around the tree, but this already addresses a major
performance bottleneck in the testsuite driver that might has to do
with quadratic or worse slowdown in cpython's regular expression
engine when handling certain regex patterns with large strings.
Especially on i386, and i386 jobs are the bottlenecks of all full-ci
validate pipelines!
Here are the elapsed times of testing x86_64/i386 with -j48 before
this patch:
x86_64: `Build completed in 6m06s`
i386: `Build completed in 1h36m`
And with this patch:
x86_64: `Build completed in 4m55s`
i386: `Build completed in 4m23s`
Fixes #26786.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
9f30c975 by Zubin Duggal at 2026-01-21T07:04:53-05:00
ghc-toolchain: Also configure windres on non-windows platforms.
It may be needed for cross compilation.
Fixes #24588
- - - - -
1e30763b by Cheng Shao at 2026-01-21T07:04:54-05:00
ghci: print external interpreter trace messages to stderr instead of stdout
This patch makes ghci print external interpreter trace messages to
stderr instead of stdout, which is a much saner choice for diagnostic
information. Closes #26807.
- - - - -
29 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Unit/State.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.16.1-notes.rst
- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Rules/Docspec.hs
- hadrian/src/Rules/Lint.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Builders/RunTest.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Classes.hs
- + libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs
- libraries/ghci/GHCi/Server.hs
- rts/include/Cmm.h
- rts/include/stg/Ticky.h
- rts/sm/Storage.c
- testsuite/driver/runtests.py
- testsuite/driver/testlib.py
- testsuite/driver/testutil.py
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- testsuite/tests/th/TH_implicitParams.stdout
- + testsuite/tests/typecheck/should_compile/T26737.hs
- testsuite/tests/typecheck/should_compile/all.T
- utils/ghc-toolchain/exe/Main.hs
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -526,7 +526,7 @@ genericTyConNames = [
gHC_PRIM, gHC_PRIM_PANIC,
gHC_TYPES, gHC_INTERNAL_DATA_DATA, gHC_MAGIC, gHC_MAGIC_DICT,
- gHC_CLASSES, gHC_PRIMOPWRAPPERS :: Module
+ gHC_CLASSES, gHC_CLASSES_IP, gHC_PRIMOPWRAPPERS :: Module
gHC_PRIM = mkGhcInternalModule (fsLit "GHC.Internal.Prim") -- Primitive types and values
gHC_PRIM_PANIC = mkGhcInternalModule (fsLit "GHC.Internal.Prim.Panic")
gHC_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Types")
@@ -534,6 +534,7 @@ gHC_MAGIC = mkGhcInternalModule (fsLit "GHC.Internal.Magic")
gHC_MAGIC_DICT = mkGhcInternalModule (fsLit "GHC.Internal.Magic.Dict")
gHC_CSTRING = mkGhcInternalModule (fsLit "GHC.Internal.CString")
gHC_CLASSES = mkGhcInternalModule (fsLit "GHC.Internal.Classes")
+gHC_CLASSES_IP = mkGhcInternalModule (fsLit "GHC.Internal.Classes.IP")
gHC_PRIMOPWRAPPERS = mkGhcInternalModule (fsLit "GHC.Internal.PrimopWrappers")
gHC_INTERNAL_TUPLE = mkGhcInternalModule (fsLit "GHC.Internal.Tuple")
@@ -1521,7 +1522,7 @@ fromLabelClassOpName
-- Implicit Parameters
ipClassName :: Name
ipClassName
- = clsQual gHC_CLASSES (fsLit "IP") ipClassKey
+ = clsQual gHC_CLASSES_IP (fsLit "IP") ipClassKey
-- Overloaded record fields
hasFieldClassName :: Name
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -215,7 +215,7 @@ instance Outputable ModuleOrigin where
(if null rhs
then []
else [text "hidden reexport by" <+>
- sep (map (ppr . mkUnit) res)]) ++
+ sep (map (ppr . mkUnit) rhs)]) ++
(if f then [text "package flag"] else [])
))
=====================================
compiler/ghc.cabal.in
=====================================
@@ -149,6 +149,7 @@ Library
else
Build-Depends: unix >= 2.7 && < 2.9
+ -- Hadrian further set some warnings in its Settings.Warnings module.
GHC-Options: -Wall
-Wno-name-shadowing
-Wnoncanonical-monad-instances
=====================================
docs/users_guide/9.16.1-notes.rst
=====================================
@@ -30,6 +30,18 @@ Language
- The extension :extension:`ExplicitNamespaces` now allows namespace-specified
wildcards ``type ..`` and ``data ..`` in import and export lists.
+- Implicit parameters and ``ImpredicativeTypes``. GHC now knows
+ that if ``?foo::S`` is coecible to ``?foo::T`` only if ``S`` is coercible to ``T``.
+ Example (from :ghc-ticket:`#26737`)::
+
+ {-# LANGUAGE ImplicitParams, ImpredicativeTypes #-}
+ newtype N = MkN Int
+ test :: ((?foo::N) => Bool) -> ((?foo::Int) => Bool)
+ test = coerce
+
+ This is achieved by arranging that ``?foo :: T`` has a representational
+ role for ``T``.
+
Compiler
~~~~~~~~
=====================================
hadrian/src/Hadrian/Utilities.hs
=====================================
@@ -19,7 +19,6 @@ module Hadrian.Utilities (
copyFile, copyFileUntracked, createFileLink, fixFile,
makeExecutable, moveFile, removeFile, createDirectory, copyDirectory,
moveDirectory, removeDirectory, removeFile_, writeFileChangedBS,
- findExecutable,
-- * Diagnostic info
Colour (..), ANSIColour (..), putColoured, shouldUseColor,
@@ -691,7 +690,3 @@ renderUnicorn ls =
ponyPadding = " "
boxLines :: [String]
boxLines = ["", "", ""] ++ (lines . renderBox $ ls)
-
--- Workaround for https://github.com/haskell/directory/issues/180
-findExecutable :: String -> IO (Maybe FilePath)
-findExecutable exe = IO.catch (IO.findExecutable exe) $ \(_ :: IO.IOException) -> pure Nothing
=====================================
hadrian/src/Rules/Docspec.hs
=====================================
@@ -2,6 +2,8 @@ module Rules.Docspec
( docspecRules
) where
+import System.Directory (findExecutable)
+
import Base
import Context.Path
import Settings.Builders.Common
=====================================
hadrian/src/Rules/Lint.hs
=====================================
@@ -4,6 +4,7 @@ module Rules.Lint
import Base
import Settings.Builders.Common
+import System.Directory (findExecutable)
import System.Exit (exitFailure)
lintRules :: Rules ()
=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -38,7 +38,6 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
stage <- getStage
hie_path <- getHieBuildPath
mconcat [ arg "-Wall"
- , arg "-Wcompat"
, not useColor ? builder (Ghc CompileHs) ?
-- N.B. Target.trackArgument ignores this argument from the
-- input hash to avoid superfluous recompilation, avoiding
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -16,6 +16,7 @@ import Settings.Builders.Common
import qualified Data.Set as Set
import Flavour
import qualified Context.Type as C
+import System.Directory (findExecutable)
import Settings.Program
import qualified Context.Type
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -343,6 +343,7 @@ Library
GHC.Internal.CString
GHC.Internal.Classes
+ GHC.Internal.Classes.IP
GHC.Internal.Debug
GHC.Internal.Magic
GHC.Internal.Magic.Dict
=====================================
libraries/ghc-internal/src/GHC/Internal/Classes.hs
=====================================
@@ -1,10 +1,9 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns,
KindSignatures, DataKinds, ConstraintKinds,
- MultiParamTypeClasses, FunctionalDependencies #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}
- -- ip :: IP x a => a is strictly speaking ambiguous, but IP is magic
+ MultiParamTypeClasses, FunctionalDependencies,
+ UnboxedTuples #-}
+
{-# LANGUAGE UndecidableSuperClasses #-}
-- Because of the type-variable superclasses for tuples
@@ -142,6 +141,7 @@ import GHC.Internal.Prim
import GHC.Internal.Tuple
import GHC.Internal.CString (unpackCString#)
import GHC.Internal.Types
+import GHC.Internal.Classes.IP
infix 4 ==, /=, <, <=, >=, >
infixr 3 &&
@@ -149,12 +149,6 @@ infixr 2 ||
default () -- Double isn't available yet
--- | The syntax @?x :: a@ is desugared into @IP "x" a@
--- IP is declared very early, so that libraries can take
--- advantage of the implicit-call-stack feature
-class IP (x :: Symbol) a | x -> a where
- ip :: a
-
{- $matching_overloaded_methods_in_rules
Matching on class methods (e.g. @(==)@) in rewrite rules tends to be a bit
=====================================
libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs
=====================================
@@ -0,0 +1,87 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns,
+ KindSignatures, DataKinds, ConstraintKinds,
+ MultiParamTypeClasses, FunctionalDependencies #-}
+
+{-# LANGUAGE AllowAmbiguousTypes, RoleAnnotations, IncoherentInstances #-}
+ -- LANGUAGE pragmas: see Note [IP: implicit parameter class]
+
+{-# OPTIONS_HADDOCK not-home #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : GHC.Internal.Classes.IP
+-- Copyright : (c) The University of Glasgow, 1992-2002
+-- License : see libraries/base/LICENSE
+--
+-- Maintainer : ghc-devs(a)haskell.org
+-- Stability : internal
+-- Portability : non-portable (GHC extensions)
+--
+-- Basic classes.
+-- Do not import this module directly. It is an GHC internal only
+-- module. Some of its contents are instead available from @Prelude@
+-- and @GHC.Int@.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Internal.Classes.IP( IP(..)) where
+
+import GHC.Internal.Types
+
+
+default () -- Double isn't available yet
+
+-- | The syntax @?x :: a@ is desugared into @IP "x" a@
+-- IP is declared very early, so that libraries can take
+-- advantage of the implicit-call-stack feature
+type role IP nominal representational -- See (IPRoles)
+class IP (x :: Symbol) a | x -> a where
+ ip :: a
+
+{- Note [IP: implicit parameter class]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+An implicit parameter constraint (?foo::ty) is just short for
+
+ IP "foo" ty
+
+where ghc-internal:GHC.Internal.Classes.IP is a special class that
+GHC knows about, defined in this module.
+
+* It is a unary type class, with one method `ip`, so it has no cost.
+ For example, (?foo::Int) is represented just by an Int.
+
+* Criticially, it has a functional dependency:
+ class IP (x :: Symbol) a | x -> a where ...
+ So if we have
+ [G] IP "foo" Int
+ [W] IP "foo" alpha
+ the fundep wil lgive us alpha ~ Int, as desired.
+
+* The solver has a number of special cases for implicit parameters,
+ mainly because a binding (let ?foo::Int = rhs in body)
+ is like a local instance declaration for IP. Search for uses
+ of `isIPClass`.
+
+Wrinkles
+
+(IPAmbiguity) The single method of IP has an ambiguous type
+ ip :: forall a. IP s a => a
+ Hence the LANGUAGE pragama AllowAmbiguousTypes.
+ The method `ip` is never called by the user, so ambiguity doesn't matter.
+
+(IPRoles) IP has a role annotation. Why? See #26737. We want
+ [W] IP "foo" t1 ~R# IP "foo" t2
+ to decompose to give [W] IP t1 ~R# t2, using /representational/
+ equality for (t1 ~R# t2) not nominal.
+
+ This usually gives a complaint about incoherence, because in general
+ (t1 ~R# t2) does NOT imply (C t1) ~R# (C t2) for any normal class.
+ But it does for IP, because instance selection is controlled by the Symbol,
+ not the type of the payload. Hence LANGUAGE pragma IncoherentInstances.
+ (It is unfortunate that we need a module-wide IncoherentInstances here;
+ see #17167.)
+
+ Side note: arguably this treatment could be applied to any class
+ with a functional dependency; but for now we restrict it to IP.
+-}
+
=====================================
libraries/ghci/GHCi/Server.hs
=====================================
@@ -32,11 +32,12 @@ import Data.Binary
import Text.Printf
import System.Environment (getProgName, getArgs)
import System.Exit
+import System.IO
type MessageHook = Msg -> IO Msg
trace :: String -> IO ()
-trace s = getProgName >>= \name -> printf "[%20s] %s\n" name s
+trace s = getProgName >>= \name -> hPrintf stderr "[%20s] %s\n" name s
serv :: Bool -> MessageHook -> Pipe -> (forall a .IO a -> IO a) -> IO ()
serv verbose hook pipe restore = loop
=====================================
rts/include/Cmm.h
=====================================
@@ -441,12 +441,6 @@
#define HP_CHK_P(bytes, fun, arg) \
HEAP_CHECK(bytes, GC_PRIM_P(fun,arg))
-// TODO I'm not seeing where ALLOC_P_TICKY is used; can it be removed?
-// -NSF March 2013
-#define ALLOC_P_TICKY(bytes, fun, arg) \
- HP_CHK_P(bytes); \
- TICK_ALLOC_RTS(bytes);
-
// Load a field out of structure with relaxed ordering.
#define RELAXED_LOAD_FIELD(fld, ptr) \
REP_##fld![(ptr) + OFFSET_##fld]
=====================================
rts/include/stg/Ticky.h
=====================================
@@ -246,7 +246,7 @@ EXTERN StgInt RET_UNBOXED_TUP_hst[TICKY_BIN_COUNT] INIT({0});
TICK_BUMP_BY(ALLOC_THK_gds,g);\
TICK_BUMP_BY(ALLOC_THK_slp,s);\
-#define TICK_ALLOC_RTS(bytes)\
+#define TICK_ALLOC_RTS(n)\
TICK_BUMP(ALLOC_RTS_ctr);\
TICK_BUMP_BY(ALLOC_RTS_tot,n);
#endif
=====================================
rts/sm/Storage.c
=====================================
@@ -990,7 +990,7 @@ move_STACK (StgStack *src, StgStack *dest)
void
accountAllocation(Capability *cap, W_ n)
{
- TICK_ALLOC_RTS(WDS(n));
+ TICK_ALLOC_RTS(n*sizeof(W_));
CCS_ALLOC(cap->r.rCCCS,n);
if (cap->r.rCurrentTSO != NULL) {
// cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_)
=====================================
testsuite/driver/runtests.py
=====================================
@@ -28,7 +28,7 @@ import subprocess
import asyncio
-from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name
+from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name, str_removeprefix
from testglobals import getConfig, ghc_env, TestConfig, t, \
TestOptions, brokens, PerfMetric
from my_typing import TestName
@@ -291,7 +291,7 @@ if windows:
for line in pkginfo.split('\n'):
if line.startswith('library-dirs:'):
path = line.rstrip()
- path = re.sub('^library-dirs: ', '', path)
+ path = str_removeprefix(path, 'library-dirs: ')
# Use string.replace instead of re.sub, because re.sub
# interprets backslashes in the replacement string as
# escape sequences.
=====================================
testsuite/driver/testlib.py
=====================================
@@ -25,7 +25,7 @@ from testglobals import config, ghc_env, default_testopts, brokens, t, \
from testutil import strip_quotes, lndir, link_or_copy_file, passed, \
failBecause, testing_metrics, residency_testing_metrics, \
stable_perf_counters, \
- PassFail, badResult, memoize
+ PassFail, badResult, memoize, str_removeprefix
from term_color import Color, colored
import testutil
from cpu_features import have_cpu_feature
@@ -1792,7 +1792,7 @@ async def do_test(name: TestName,
if opts.expect not in ['pass', 'fail', 'missing-lib']:
framework_fail(name, way, 'bad expected ' + opts.expect)
- directory = re.sub(r'^\.[/\\]', '', str(opts.testdir))
+ directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
if way in opts.fragile_ways:
if_verbose(1, '*** fragile test %s resulted in %s' % (full_name, 'pass' if result.passed else 'fail'))
@@ -1830,7 +1830,7 @@ async def do_test(name: TestName,
# if found and instead have the testsuite decide on what to do
# with the output.
def override_options(pre_cmd):
- if config.verbose >= 5 and bool(re.match(r'\$make', pre_cmd, re.I)):
+ if config.verbose >= 5 and pre_cmd.lower().startswith('$make'):
return pre_cmd.replace(' -s' , '') \
.replace('--silent', '') \
.replace('--quiet' , '')
@@ -1843,7 +1843,7 @@ def framework_fail(name: Optional[TestName], way: Optional[WayName], reason: str
# so we need to take care not to blow up with the wrong way
# and report the actual reason for the failure.
try:
- directory = re.sub(r'^\.[/\\]', '', str(opts.testdir))
+ directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
except:
directory = ''
full_name = '%s(%s)' % (name, way)
@@ -1856,7 +1856,7 @@ def framework_fail(name: Optional[TestName], way: Optional[WayName], reason: str
def framework_warn(name: TestName, way: WayName, reason: str) -> None:
opts = getTestOpts()
- directory = re.sub(r'^\.[/\\]', '', str(opts.testdir))
+ directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
full_name = name + '(' + way + ')'
if_verbose(1, '*** framework warning for %s %s ' % (full_name, reason))
t.framework_warnings.append(TestResult(directory, name, reason, way))
@@ -2550,7 +2550,7 @@ def split_file(in_fn: Path, delimiter: str, out1_fn: Path, out2_fn: Path):
with out1_fn.open('w', encoding='utf8', newline='') as out1:
with out2_fn.open('w', encoding='utf8', newline='') as out2:
line = infile.readline()
- while re.sub(r'^\s*','',line) != delimiter and line != '':
+ while line.lstrip() != delimiter and line != '':
out1.write(line)
line = infile.readline()
@@ -2933,6 +2933,14 @@ def normalise_callstacks(s: str) -> str:
tyCon_re = re.compile(r'TyCon\s*\d+\#\#\d?\d?\s*\d+\#\#\d?\d?\s*', flags=re.MULTILINE)
+def drop_lines_containing(s: str, needle: str) -> str:
+ """
+ Drop lines from `s` which contain `needle`.
+ """
+ if needle not in s:
+ return s
+ return ''.join(line for line in s.splitlines(keepends=True) if needle not in line)
+
def normalise_type_reps(s: str) -> str:
""" Normalise out fingerprints from Typeable TyCon representations """
return re.sub(tyCon_re, 'TyCon FINGERPRINT FINGERPRINT ', s)
@@ -2944,8 +2952,8 @@ def normalise_errmsg(s: str) -> str:
s = s.replace('ld: 0706-027 The -x flag is ignored.\n', '')
# remove " error:" and lower-case " Warning:" to make patch for
# trac issue #10021 smaller
- s = modify_lines(s, lambda l: re.sub(' error:', '', l))
- s = modify_lines(s, lambda l: re.sub(' Warning:', ' warning:', l))
+ s = modify_lines(s, lambda l: l.replace(' error:', ''))
+ s = modify_lines(s, lambda l: l.replace(' Warning:', ' warning:'))
s = normalise_callstacks(s)
s = normalise_type_reps(s)
@@ -2960,7 +2968,7 @@ def normalise_errmsg(s: str) -> str:
# a target prefix (e.g. `aarch64-linux-gnu-ghc`)
# * On Windows the executable name may mention the
# versioned name (e.g. `ghc-9.2.1`)
- s = re.sub(Path(config.compiler).name + ':', 'ghc:', s)
+ s = s.replace(Path(config.compiler).name + ':', 'ghc:')
# If somefile ends in ".exe" or ".exe:", zap ".exe" (for Windows)
# the colon is there because it appears in error messages; this
@@ -2973,11 +2981,13 @@ def normalise_errmsg(s: str) -> str:
s = re.sub(r'([^\s])\.jsexe', r'\1', s)
# hpc executable is given ghc suffix
- s = re.sub('hpc-ghc', 'hpc', s)
+ s = s.replace('hpc-ghc', 'hpc')
# The inplace ghc's are called ghc-stage[123] to avoid filename
# collisions, so we need to normalise that to just "ghc"
- s = re.sub('ghc-stage[123]', 'ghc', s)
+ s = (s.replace('ghc-stage1', 'ghc')
+ .replace('ghc-stage2', 'ghc')
+ .replace('ghc-stage3', 'ghc'))
# Remove platform prefix (e.g. javascript-unknown-ghcjs) for cross-compiled tools
# (ghc, ghc-pkg, unlit, etc.)
s = re.sub(r'\w+(-\w+)*-ghc', 'ghc', s)
@@ -3000,7 +3010,7 @@ def normalise_errmsg(s: str) -> str:
# Also filter out bullet characters. This is because bullets are used to
# separate error sections, and tests shouldn't be sensitive to how the
# the division happens.
- bullet = '•'.encode('utf8') if isinstance(s, bytes) else '•'
+ bullet = '•'
s = s.replace(bullet, '')
# Windows only, this is a bug in hsc2hs but it is preventing
@@ -3015,19 +3025,19 @@ def normalise_errmsg(s: str) -> str:
s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE (?:\(5\) )?type: 0xc000000(.*)$', '', l))
s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
- s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s)
+ s = s.replace('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version', '')
# ignore superfluous dylibs passed to the linker.
- s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s)
+ s = drop_lines_containing(s, 'ignoring unexpected dylib file')
# ignore LLVM Version mismatch garbage; this will just break tests.
- s = re.sub('You are using an unsupported version of LLVM!.*\n','',s)
- s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s)
- s = re.sub('We will try though\\.\\.\\..*\n','',s)
+ s = drop_lines_containing(s, 'You are using an unsupported version of LLVM!')
+ s = drop_lines_containing(s, 'System LLVM version:')
+ s = drop_lines_containing(s, 'We will try though...')
# ignore warning about strip invalidating signatures
- s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s)
+ s = drop_lines_containing(s, 'strip: changes being made to the file will invalidate the code signature in')
# clang may warn about unused argument when used as assembler
- s = re.sub('.*warning: argument unused during compilation:.*\n', '', s)
+ s = drop_lines_containing(s, 'warning: argument unused during compilation:')
# Emscripten displays cache info and old emcc doesn't support EMCC_LOGGING=0
- s = re.sub('cache:INFO: .*\n', '', s)
+ s = drop_lines_containing(s, 'cache:INFO:')
# Old emcc warns when we export HEAP8 but new one requires it (see #26290)
s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nwarning: invalid item in EXPORTED_RUNTIME_METHODS: HEAPU8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','')
@@ -3050,7 +3060,7 @@ def normalise_prof (s: str) -> str:
# The next step assumes none of the fields have no spaces in, which is broke
# when the src = <no location info>
- s = re.sub('no location info','no-location-info', s)
+ s = s.replace('no location info', 'no-location-info')
# Source locations from internal libraries, remove the source location
# > libraries/ghc-internal/src/path/Foo.hs:204:1-18
@@ -3103,21 +3113,21 @@ def normalise_prof (s: str) -> str:
return s
def normalise_slashes_( s: str ) -> str:
- s = re.sub(r'\\', '/', s)
- s = re.sub(r'//', '/', s)
+ s = s.replace('\\', '/')
+ s = s.replace('//', '/')
return s
def normalise_exe_( s: str ) -> str:
- s = re.sub(r'\.exe', '', s)
- s = re.sub(r'\.wasm', '', s)
- s = re.sub(r'\.jsexe', '', s)
+ s = s.replace('.exe', '')
+ s = s.replace('.wasm', '')
+ s = s.replace('.jsexe', '')
return s
def normalise_output( s: str ) -> str:
# remove " error:" and lower-case " Warning:" to make patch for
# trac issue #10021 smaller
- s = modify_lines(s, lambda l: re.sub(' error:', '', l))
- s = modify_lines(s, lambda l: re.sub(' Warning:', ' warning:', l))
+ s = modify_lines(s, lambda l: l.replace(' error:', ''))
+ s = modify_lines(s, lambda l: l.replace(' Warning:', ' warning:'))
# Remove a .exe extension (for Windows)
# and .wasm extension (for the Wasm backend)
# and .jsexe extension (for the JS backend)
@@ -3129,19 +3139,19 @@ def normalise_output( s: str ) -> str:
s = normalise_type_reps(s)
# ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is
# requires for -fPIC
- s = re.sub(' -fexternal-dynamic-refs\n','',s)
+ s = s.replace(' -fexternal-dynamic-refs\n', '')
s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
- s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s)
+ s = s.replace('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version', '')
# ignore superfluous dylibs passed to the linker.
- s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s)
+ s = drop_lines_containing(s, 'ignoring unexpected dylib file')
# ignore LLVM Version mismatch garbage; this will just break tests.
- s = re.sub('You are using an unsupported version of LLVM!.*\n','',s)
- s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s)
- s = re.sub('We will try though\\.\\.\\..*\n','',s)
+ s = drop_lines_containing(s, 'You are using an unsupported version of LLVM!')
+ s = drop_lines_containing(s, 'System LLVM version:')
+ s = drop_lines_containing(s, 'We will try though...')
# ignore warning about strip invalidating signatures
- s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s)
+ s = drop_lines_containing(s, 'strip: changes being made to the file will invalidate the code signature in')
# clang may warn about unused argument when used as assembler
- s = re.sub('.*warning: argument unused during compilation:.*\n', '', s)
+ s = drop_lines_containing(s, 'warning: argument unused during compilation:')
# strip the cross prefix if any
s = re.sub(r'\w+(-\w+)*-ghc', 'ghc', s)
=====================================
testsuite/driver/testutil.py
=====================================
@@ -40,6 +40,12 @@ def strip_quotes(s: str) -> str:
# Don't wrap commands to subprocess.call/Popen in quotes.
return s.strip('\'"')
+# Python 3.7 compatibility shim for str.removeprefix (added in Python 3.9).
+def str_removeprefix(s: str, prefix: str) -> str:
+ if s.startswith(prefix):
+ return s.replace(prefix, '', 1)
+ return s
+
def str_warn(s: str) -> str:
return colored(Color.YELLOW, s)
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -3293,6 +3293,7 @@ module GHC.Base where
{-# MINIMAL fmap #-}
type IO :: * -> *
newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
+ type role IP nominal representational
type IP :: Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -3293,6 +3293,7 @@ module GHC.Base where
{-# MINIMAL fmap #-}
type IO :: * -> *
newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
+ type role IP nominal representational
type IP :: Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -3293,6 +3293,7 @@ module GHC.Base where
{-# MINIMAL fmap #-}
type IO :: * -> *
newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
+ type role IP nominal representational
type IP :: Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -3293,6 +3293,7 @@ module GHC.Base where
{-# MINIMAL fmap #-}
type IO :: * -> *
newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
+ type role IP nominal representational
type IP :: Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/interface-stability/ghc-prim-exports.stdout
=====================================
@@ -1171,6 +1171,7 @@ module GHC.Classes where
(==) :: a -> a -> GHC.Internal.Types.Bool
(/=) :: a -> a -> GHC.Internal.Types.Bool
{-# MINIMAL (==) | (/=) #-}
+ type role IP nominal representational
type IP :: GHC.Internal.Types.Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
=====================================
@@ -1171,6 +1171,7 @@ module GHC.Classes where
(==) :: a -> a -> GHC.Internal.Types.Bool
(/=) :: a -> a -> GHC.Internal.Types.Bool
{-# MINIMAL (==) | (/=) #-}
+ type role IP nominal representational
type IP :: GHC.Internal.Types.Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/th/TH_implicitParams.stdout
=====================================
@@ -1,5 +1,5 @@
-Main.funcToReify :: GHC.Internal.Classes.IP "z"
- GHC.Internal.Types.Int =>
+Main.funcToReify :: GHC.Internal.Classes.IP.IP "z"
+ GHC.Internal.Types.Int =>
GHC.Internal.Types.Int
5
1
=====================================
testsuite/tests/typecheck/should_compile/T26737.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE ImpredicativeTypes, ImplicitParams #-}
+
+module T26737 where
+
+import Data.Coerce
+
+newtype Foo = MkFoo Int
+
+b :: ((?foo :: Foo) => Int) -> ((?foo :: Int) => Int)
+b = coerce @(((?foo :: Foo) => Int)) @(((?foo :: Int) => Int))
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -958,3 +958,4 @@ test('T14745', normal, compile, [''])
test('T26451', normal, compile, [''])
test('T26582', normal, compile, [''])
test('T26746', normal, compile, [''])
+test('T26737', normal, compile, [''])
=====================================
utils/ghc-toolchain/exe/Main.hs
=====================================
@@ -480,13 +480,8 @@ mkTarget opts = do
opt <- optional $ findProgram "opt" (optOpt opts) ["opt"]
llvmAs <- optional $ findProgram "llvm assembler" (optLlvmAs opts) ["clang"]
- -- Windows-specific utilities
- windres <-
- case archOS_OS archOs of
- OSMinGW32 -> do
- windres <- findProgram "windres" (optWindres opts) ["windres"]
- return (Just windres)
- _ -> return Nothing
+ -- for windows, also used for cross compiling
+ windres <- optional $ findProgram "windres" (optWindres opts) ["windres"]
-- Darwin-specific utilities
(otool, installNameTool) <-
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ec3f9fbabe119a71fd09e97a21fd5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ec3f9fbabe119a71fd09e97a21fd5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/stack-annotation-ty] Add optional `SrcLoc` to `StackAnnotation` class
by Hannes Siebenhandl (@fendor) 21 Jan '26
by Hannes Siebenhandl (@fendor) 21 Jan '26
21 Jan '26
Hannes Siebenhandl pushed to branch wip/fendor/stack-annotation-ty at Glasgow Haskell Compiler / GHC
Commits:
90df50b2 by fendor at 2026-01-21T09:52:22+01:00
Add optional `SrcLoc` to `StackAnnotation` class
`StackAnnotation` give access to an optional `SrcLoc` field that
stack annotations can use to provide better backtraces in both error
messages and when decoding the callstack.
We update builtin stack annotations such as `StringAnnotation` and
`ShowAnnotation` to also capture the `SrcLoc` of the current `CallStack`
to improve backtraces by default (if stack annotations are used).
This change is backwards compatible with GHC 9.14.1.
- - - - -
10 changed files:
- libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- libraries/ghc-experimental/tests/backtraces/T26806a.stderr
- libraries/ghc-experimental/tests/backtraces/T26806b.stderr
- libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
Changes:
=====================================
libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
=====================================
@@ -133,20 +133,32 @@ import GHC.Internal.Stack.Annotation
-- Annotations
-- ----------------------------------------------------------------------------
+
+-- | A 'String' only annotation with an optional source location.
data StringAnnotation where
- StringAnnotation :: String -> StringAnnotation
+ StringAnnotation :: !(Maybe SrcLoc) -> String -> StringAnnotation
instance StackAnnotation StringAnnotation where
- displayStackAnnotation (StringAnnotation str) = str
+ displayStackAnnotationShort (StringAnnotation _srcLoc str) =
+ str
+
+ sourceLocationOfStackAnnotation (StringAnnotation srcLoc _str) =
+ srcLoc
-- | Use the 'Show' instance of a type to display as the 'StackAnnotation'.
data ShowAnnotation where
- ShowAnnotation :: forall a . Show a => a -> ShowAnnotation
+ ShowAnnotation :: forall a . Show a => !(Maybe SrcLoc) -> a -> ShowAnnotation
instance StackAnnotation ShowAnnotation where
- displayStackAnnotation (ShowAnnotation showAnno) = show showAnno
+ displayStackAnnotationShort (ShowAnnotation _srcLoc showAnno) =
+ show showAnno
+
+ sourceLocationOfStackAnnotation (ShowAnnotation srcLoc _showAnno) =
+ srcLoc
-- | A 'CallStack' stack annotation.
+--
+-- Captures the whole 'CallStack'.
newtype CallStackAnnotation = CallStackAnnotation CallStack
instance Show CallStackAnnotation where
@@ -154,9 +166,23 @@ instance Show CallStackAnnotation where
-- | Displays the first entry of the 'CallStack'
instance StackAnnotation CallStackAnnotation where
- displayStackAnnotation (CallStackAnnotation cs) = case getCallStack cs of
+ sourceLocationOfStackAnnotation (CallStackAnnotation cs) =
+ callStackHeadSrcLoc cs
+
+ displayStackAnnotationShort (CallStackAnnotation cs) =
+ callStackHeadFunctionName cs
+
+callStackHeadSrcLoc :: CallStack -> Maybe SrcLoc
+callStackHeadSrcLoc cs =
+ case getCallStack cs of
+ [] -> Nothing
+ (_, srcLoc):_ -> Just srcLoc
+
+callStackHeadFunctionName :: CallStack -> String
+callStackHeadFunctionName cs =
+ case getCallStack cs of
[] -> "<unknown source location>"
- ((fnName,srcLoc):_) -> fnName ++ ", called at " ++ prettySrcLoc srcLoc
+ (fnName, _):_ -> fnName
-- ----------------------------------------------------------------------------
-- Annotate the CallStack with custom data
@@ -172,7 +198,7 @@ instance StackAnnotation CallStackAnnotation where
--
-- WARNING: forces the evaluation of @b@ to WHNF.
{-# NOINLINE annotateStack #-}
-annotateStack :: forall a b. (Typeable a, StackAnnotation a) => a -> b -> b
+annotateStack :: forall a b. (HasCallStack, Typeable a, StackAnnotation a) => a -> b -> b
annotateStack ann b = unsafePerformIO $
annotateStackIO ann (evaluate b)
@@ -196,9 +222,9 @@ annotateCallStack b = unsafePerformIO $ withFrozenCallStack $
-- information to stack traces.
--
-- WARNING: forces the evaluation of @b@ to WHNF.
-annotateStackString :: forall b . String -> b -> b
+annotateStackString :: forall b . HasCallStack => String -> b -> b
annotateStackString ann =
- annotateStack (StringAnnotation ann)
+ annotateStack (StringAnnotation (callStackHeadSrcLoc ?callStack) ann)
-- | @'annotateStackShow' showable b@ annotates the evaluation stack of @b@
-- with the value @showable@.
@@ -207,16 +233,16 @@ annotateStackString ann =
-- information to stack traces.
--
-- WARNING: forces the evaluation of @b@ to WHNF.
-annotateStackShow :: forall a b . (Typeable a, Show a) => a -> b -> b
+annotateStackShow :: forall a b . (HasCallStack, Typeable a, Show a) => a -> b -> b
annotateStackShow ann =
- annotateStack (ShowAnnotation ann)
+ annotateStack (ShowAnnotation (callStackHeadSrcLoc ?callStack) ann)
-- | @'annotateStackIO' showable b@ annotates the evaluation stack of @b@
-- with the value @showable@.
--
-- When decoding the call stack, the annotation frames can be used to add more
-- information to stack traces.
-annotateStackIO :: forall a b . (Typeable a, StackAnnotation a) => a -> IO b -> IO b
+annotateStackIO :: forall a b . (HasCallStack, Typeable a, StackAnnotation a) => a -> IO b -> IO b
annotateStackIO ann (IO act) =
IO $ \s -> annotateStack# (SomeStackAnnotation ann) act s
{-# NOINLINE annotateStackIO #-}
@@ -226,18 +252,18 @@ annotateStackIO ann (IO act) =
--
-- When decoding the call stack, the annotation frames can be used to add more
-- information to stack traces.
-annotateStackStringIO :: forall b . String -> IO b -> IO b
+annotateStackStringIO :: forall b . HasCallStack => String -> IO b -> IO b
annotateStackStringIO ann =
- annotateStackIO (StringAnnotation ann)
+ annotateStackIO (StringAnnotation (callStackHeadSrcLoc ?callStack) ann)
-- | @'annotateStackShowIO' msg b@ annotates the evaluation stack of @b@
-- with the value @msg@.
--
-- When decoding the call stack, the annotation frames can be used to add more
-- information to stack traces.
-annotateStackShowIO :: forall a b . (Show a) => a -> IO b -> IO b
+annotateStackShowIO :: forall a b . (HasCallStack, Show a) => a -> IO b -> IO b
annotateStackShowIO ann =
- annotateStackIO (ShowAnnotation ann)
+ annotateStackIO (ShowAnnotation (callStackHeadSrcLoc ?callStack) ann)
-- | @'annotateCallStackIO' b@ annotates the evaluation stack of @b@ with the
-- current 'callstack'.
=====================================
libraries/ghc-experimental/tests/backtraces/T26806a.stderr
=====================================
@@ -3,8 +3,8 @@ T26806a: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
Backtrace Test
IPE backtrace:
- Lovely annotation
- [1,2,3,4]
+ Lovely annotation, called at T26806a.hs:12:7 in main:Main
+ [1,2,3,4], called at T26806a.hs:11:5 in main:Main
annotateCallStackIO, called at T26806a.hs:10:3 in main:Main
HasCallStack backtrace:
throwIO, called at T26806a.hs:13:9 in main:Main
=====================================
libraries/ghc-experimental/tests/backtraces/T26806b.stderr
=====================================
@@ -3,8 +3,8 @@ T26806b: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
Backtrace Test: 125000000
IPE backtrace:
- Lovely annotation
- [1,2,3,4]
+ Lovely annotation, called at T26806b.hs:16:7 in main:Main
+ [1,2,3,4], called at T26806b.hs:15:5 in main:Main
annotateCallStack, called at T26806b.hs:14:3 in main:Main
HasCallStack backtrace:
collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception
=====================================
libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
=====================================
@@ -4,6 +4,7 @@ module GHC.Internal.Stack.Annotation where
import GHC.Internal.Base
import GHC.Internal.Data.Typeable
+import GHC.Internal.Stack (SrcLoc, prettySrcLoc)
-- ----------------------------------------------------------------------------
-- StackAnnotation
@@ -13,8 +14,36 @@ import GHC.Internal.Data.Typeable
-- as the payload of 'AnnFrame' stack frames.
--
class StackAnnotation a where
+ -- | Display a human readable string for the 'StackAnnotation'.
+ --
+ -- This is supposed to be the long version of 'displayStackAnnotationShort'
+ -- and may contain a source location.
+ --
+ -- If not provided, 'displayStackAnnotation' is derived from 'sourceLocationOfStackAnnotation'
+ -- and 'displayStackAnnotationShort'.
displayStackAnnotation :: a -> String
+ -- | Get the 'SrcLoc' of the given 'StackAnnotation'.
+ --
+ -- This is optional, 'SrcLoc' are not strictly required for 'StackAnnotation', but
+ -- it is still heavily encouarged to provide a 'SrcLoc' for better IPE backtraces.
+ sourceLocationOfStackAnnotation :: a -> Maybe SrcLoc
+
+ -- | The description of the StackAnnotation without any metadata such as source locations.
+ --
+ -- Pefer implementing 'displayStackAnnotationShort' over 'displayStackAnnotation'.
+ displayStackAnnotationShort :: a -> String
+
+ {-# MINIMAL displayStackAnnotation | displayStackAnnotationShort #-}
+
+ displayStackAnnotation ann =
+ displayStackAnnotationShort ann
+ ++ case sourceLocationOfStackAnnotation ann of
+ Nothing -> ""
+ Just srcLoc -> ", called at " ++ prettySrcLoc srcLoc
+ sourceLocationOfStackAnnotation _ann = Nothing
+ displayStackAnnotationShort = displayStackAnnotation
+
-- ----------------------------------------------------------------------------
-- Annotations
-- ----------------------------------------------------------------------------
@@ -29,3 +58,5 @@ data SomeStackAnnotation where
instance StackAnnotation SomeStackAnnotation where
displayStackAnnotation (SomeStackAnnotation a) = displayStackAnnotation a
+ sourceLocationOfStackAnnotation (SomeStackAnnotation a) = sourceLocationOfStackAnnotation a
+ displayStackAnnotationShort (SomeStackAnnotation a) = displayStackAnnotationShort a
=====================================
libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout
=====================================
@@ -1,12 +1,12 @@
Stack annotations:
-- (2,3)
+- (2,3), called at ann_frame001.hs:5:13 in main:Main
47
Stack annotations:
-- "bar"
-- "foo"
-- "tailCallEx"
+- "bar", called at ann_frame001.hs:23:9 in main:Main
+- "foo", called at ann_frame001.hs:21:11 in main:Main
+- "tailCallEx", called at ann_frame001.hs:17:18 in main:Main
Stack annotations:
-- "bar"
-- "foo"
-- "tailCallEx"
+- "bar", called at ann_frame001.hs:23:9 in main:Main
+- "foo", called at ann_frame001.hs:21:11 in main:Main
+- "tailCallEx", called at ann_frame001.hs:17:18 in main:Main
40
=====================================
libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout
=====================================
@@ -7,5 +7,5 @@ Finish some work
Some more work in bar
17711
Stack annotations:
-- bar
+- bar, called at ann_frame002.hs:23:29 in main:Main
- annotateCallStackIO, called at ann_frame002.hs:23:7 in main:Main
=====================================
libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout
=====================================
@@ -1,6 +1,6 @@
47
Stack annotations:
-- "bar"
-- "foo"
-- "tailCallEx"
+- "bar", called at ann_frame003.hs:25:9 in main:Main
+- "foo", called at ann_frame003.hs:21:11 in main:Main
+- "tailCallEx", called at ann_frame003.hs:16:18 in main:Main
40
=====================================
libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout
=====================================
@@ -13,5 +13,5 @@ Stack annotations:
- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
- annotateCallStack, called at ann_frame004.hs:13:10 in main:Main
-- bar
+- bar, called at ann_frame004.hs:12:29 in main:Main
- annotateCallStackIO, called at ann_frame004.hs:12:7 in main:Main
=====================================
testsuite/tests/interface-stability/ghc-experimental-exports.stdout
=====================================
@@ -6482,25 +6482,27 @@ module GHC.Stack.Annotation.Experimental where
newtype CallStackAnnotation = CallStackAnnotation GHC.Internal.Stack.Types.CallStack
type ShowAnnotation :: *
data ShowAnnotation where
- ShowAnnotation :: forall a. GHC.Internal.Show.Show a => a -> ShowAnnotation
+ ShowAnnotation :: forall a. GHC.Internal.Show.Show a => !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> a -> ShowAnnotation
type SomeStackAnnotation :: *
data SomeStackAnnotation where
SomeStackAnnotation :: forall a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> SomeStackAnnotation
type StackAnnotation :: * -> Constraint
class StackAnnotation a where
displayStackAnnotation :: a -> GHC.Internal.Base.String
- {-# MINIMAL displayStackAnnotation #-}
+ sourceLocationOfStackAnnotation :: a -> GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc
+ displayStackAnnotationShort :: a -> GHC.Internal.Base.String
+ {-# MINIMAL displayStackAnnotation | displayStackAnnotationShort #-}
type StringAnnotation :: *
data StringAnnotation where
- StringAnnotation :: GHC.Internal.Base.String -> StringAnnotation
+ StringAnnotation :: !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> GHC.Internal.Base.String -> StringAnnotation
annotateCallStack :: forall b. GHC.Internal.Stack.Types.HasCallStack => b -> b
annotateCallStackIO :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a -> GHC.Internal.Types.IO a
- annotateStack :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b
- annotateStackIO :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
- annotateStackShow :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b
- annotateStackShowIO :: forall a b. GHC.Internal.Show.Show a => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
- annotateStackString :: forall b. GHC.Internal.Base.String -> b -> b
- annotateStackStringIO :: forall b. GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
+ annotateStack :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b
+ annotateStackIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
+ annotateStackShow :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b
+ annotateStackShowIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Show.Show a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
+ annotateStackString :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> b -> b
+ annotateStackStringIO :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
module GHC.Stats.Experimental where
-- Safety: Safe
=====================================
testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
=====================================
@@ -6485,25 +6485,27 @@ module GHC.Stack.Annotation.Experimental where
newtype CallStackAnnotation = CallStackAnnotation GHC.Internal.Stack.Types.CallStack
type ShowAnnotation :: *
data ShowAnnotation where
- ShowAnnotation :: forall a. GHC.Internal.Show.Show a => a -> ShowAnnotation
+ ShowAnnotation :: forall a. GHC.Internal.Show.Show a => !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> a -> ShowAnnotation
type SomeStackAnnotation :: *
data SomeStackAnnotation where
SomeStackAnnotation :: forall a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> SomeStackAnnotation
type StackAnnotation :: * -> Constraint
class StackAnnotation a where
displayStackAnnotation :: a -> GHC.Internal.Base.String
- {-# MINIMAL displayStackAnnotation #-}
+ sourceLocationOfStackAnnotation :: a -> GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc
+ displayStackAnnotationShort :: a -> GHC.Internal.Base.String
+ {-# MINIMAL displayStackAnnotation | displayStackAnnotationShort #-}
type StringAnnotation :: *
data StringAnnotation where
- StringAnnotation :: GHC.Internal.Base.String -> StringAnnotation
+ StringAnnotation :: !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> GHC.Internal.Base.String -> StringAnnotation
annotateCallStack :: forall b. GHC.Internal.Stack.Types.HasCallStack => b -> b
annotateCallStackIO :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a -> GHC.Internal.Types.IO a
- annotateStack :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b
- annotateStackIO :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
- annotateStackShow :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b
- annotateStackShowIO :: forall a b. GHC.Internal.Show.Show a => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
- annotateStackString :: forall b. GHC.Internal.Base.String -> b -> b
- annotateStackStringIO :: forall b. GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
+ annotateStack :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b
+ annotateStackIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
+ annotateStackShow :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b
+ annotateStackShowIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Show.Show a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
+ annotateStackString :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> b -> b
+ annotateStackStringIO :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b
module GHC.Stats.Experimental where
-- Safety: Safe
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90df50b276e4aed704a32679a9d2dff…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90df50b276e4aed704a32679a9d2dff…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/stack-annotation-ty] Add optional `SrcLoc` to `StackAnnotation` class
by Hannes Siebenhandl (@fendor) 21 Jan '26
by Hannes Siebenhandl (@fendor) 21 Jan '26
21 Jan '26
Hannes Siebenhandl pushed to branch wip/fendor/stack-annotation-ty at Glasgow Haskell Compiler / GHC
Commits:
b2407a32 by fendor at 2026-01-21T09:48:57+01:00
Add optional `SrcLoc` to `StackAnnotation` class
`StackAnnotation` give access to an optional `SrcLoc` field that
stack annotations can use to provide better backtraces in both error
messages and when decoding the callstack.
We update builtin stack annotations such as `StringAnnotation` and
`ShowAnnotation` to also capture the `SrcLoc` of the current `CallStack`
to improve backtraces by default (if stack annotations are used).
This change is backwards compatible with GHC 9.14.1.
- - - - -
8 changed files:
- libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- libraries/ghc-experimental/tests/backtraces/T26806a.stderr
- libraries/ghc-experimental/tests/backtraces/T26806b.stderr
- libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout
Changes:
=====================================
libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
=====================================
@@ -133,20 +133,32 @@ import GHC.Internal.Stack.Annotation
-- Annotations
-- ----------------------------------------------------------------------------
+
+-- | A 'String' only annotation with an optional source location.
data StringAnnotation where
- StringAnnotation :: String -> StringAnnotation
+ StringAnnotation :: !(Maybe SrcLoc) -> String -> StringAnnotation
instance StackAnnotation StringAnnotation where
- displayStackAnnotation (StringAnnotation str) = str
+ displayStackAnnotationShort (StringAnnotation _srcLoc str) =
+ str
+
+ sourceLocationOfStackAnnotation (StringAnnotation srcLoc _str) =
+ srcLoc
-- | Use the 'Show' instance of a type to display as the 'StackAnnotation'.
data ShowAnnotation where
- ShowAnnotation :: forall a . Show a => a -> ShowAnnotation
+ ShowAnnotation :: forall a . Show a => !(Maybe SrcLoc) -> a -> ShowAnnotation
instance StackAnnotation ShowAnnotation where
- displayStackAnnotation (ShowAnnotation showAnno) = show showAnno
+ displayStackAnnotationShort (ShowAnnotation _srcLoc showAnno) =
+ show showAnno
+
+ sourceLocationOfStackAnnotation (ShowAnnotation srcLoc _showAnno) =
+ srcLoc
-- | A 'CallStack' stack annotation.
+--
+-- Captures the whole 'CallStack'.
newtype CallStackAnnotation = CallStackAnnotation CallStack
instance Show CallStackAnnotation where
@@ -154,9 +166,23 @@ instance Show CallStackAnnotation where
-- | Displays the first entry of the 'CallStack'
instance StackAnnotation CallStackAnnotation where
- displayStackAnnotation (CallStackAnnotation cs) = case getCallStack cs of
+ sourceLocationOfStackAnnotation (CallStackAnnotation cs) =
+ callStackHeadSrcLoc cs
+
+ displayStackAnnotationShort (CallStackAnnotation cs) =
+ callStackHeadFunctionName cs
+
+callStackHeadSrcLoc :: CallStack -> Maybe SrcLoc
+callStackHeadSrcLoc cs =
+ case getCallStack cs of
+ [] -> Nothing
+ (_, srcLoc):_ -> Just srcLoc
+
+callStackHeadFunctionName :: CallStack -> String
+callStackHeadFunctionName cs =
+ case getCallStack cs of
[] -> "<unknown source location>"
- ((fnName,srcLoc):_) -> fnName ++ ", called at " ++ prettySrcLoc srcLoc
+ (fnName, _):_ -> fnName
-- ----------------------------------------------------------------------------
-- Annotate the CallStack with custom data
@@ -172,7 +198,7 @@ instance StackAnnotation CallStackAnnotation where
--
-- WARNING: forces the evaluation of @b@ to WHNF.
{-# NOINLINE annotateStack #-}
-annotateStack :: forall a b. (Typeable a, StackAnnotation a) => a -> b -> b
+annotateStack :: forall a b. (HasCallStack, Typeable a, StackAnnotation a) => a -> b -> b
annotateStack ann b = unsafePerformIO $
annotateStackIO ann (evaluate b)
@@ -196,9 +222,9 @@ annotateCallStack b = unsafePerformIO $ withFrozenCallStack $
-- information to stack traces.
--
-- WARNING: forces the evaluation of @b@ to WHNF.
-annotateStackString :: forall b . String -> b -> b
+annotateStackString :: forall b . HasCallStack => String -> b -> b
annotateStackString ann =
- annotateStack (StringAnnotation ann)
+ annotateStack (StringAnnotation (callStackHeadSrcLoc ?callStack) ann)
-- | @'annotateStackShow' showable b@ annotates the evaluation stack of @b@
-- with the value @showable@.
@@ -207,16 +233,16 @@ annotateStackString ann =
-- information to stack traces.
--
-- WARNING: forces the evaluation of @b@ to WHNF.
-annotateStackShow :: forall a b . (Typeable a, Show a) => a -> b -> b
+annotateStackShow :: forall a b . (HasCallStack, Typeable a, Show a) => a -> b -> b
annotateStackShow ann =
- annotateStack (ShowAnnotation ann)
+ annotateStack (ShowAnnotation (callStackHeadSrcLoc ?callStack) ann)
-- | @'annotateStackIO' showable b@ annotates the evaluation stack of @b@
-- with the value @showable@.
--
-- When decoding the call stack, the annotation frames can be used to add more
-- information to stack traces.
-annotateStackIO :: forall a b . (Typeable a, StackAnnotation a) => a -> IO b -> IO b
+annotateStackIO :: forall a b . (HasCallStack, Typeable a, StackAnnotation a) => a -> IO b -> IO b
annotateStackIO ann (IO act) =
IO $ \s -> annotateStack# (SomeStackAnnotation ann) act s
{-# NOINLINE annotateStackIO #-}
@@ -226,18 +252,18 @@ annotateStackIO ann (IO act) =
--
-- When decoding the call stack, the annotation frames can be used to add more
-- information to stack traces.
-annotateStackStringIO :: forall b . String -> IO b -> IO b
+annotateStackStringIO :: forall b . HasCallStack => String -> IO b -> IO b
annotateStackStringIO ann =
- annotateStackIO (StringAnnotation ann)
+ annotateStackIO (StringAnnotation (callStackHeadSrcLoc ?callStack) ann)
-- | @'annotateStackShowIO' msg b@ annotates the evaluation stack of @b@
-- with the value @msg@.
--
-- When decoding the call stack, the annotation frames can be used to add more
-- information to stack traces.
-annotateStackShowIO :: forall a b . (Show a) => a -> IO b -> IO b
+annotateStackShowIO :: forall a b . (HasCallStack, Show a) => a -> IO b -> IO b
annotateStackShowIO ann =
- annotateStackIO (ShowAnnotation ann)
+ annotateStackIO (ShowAnnotation (callStackHeadSrcLoc ?callStack) ann)
-- | @'annotateCallStackIO' b@ annotates the evaluation stack of @b@ with the
-- current 'callstack'.
=====================================
libraries/ghc-experimental/tests/backtraces/T26806a.stderr
=====================================
@@ -3,8 +3,8 @@ T26806a: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
Backtrace Test
IPE backtrace:
- Lovely annotation
- [1,2,3,4]
+ Lovely annotation, called at T26806a.hs:12:7 in main:Main
+ [1,2,3,4], called at T26806a.hs:11:5 in main:Main
annotateCallStackIO, called at T26806a.hs:10:3 in main:Main
HasCallStack backtrace:
throwIO, called at T26806a.hs:13:9 in main:Main
=====================================
libraries/ghc-experimental/tests/backtraces/T26806b.stderr
=====================================
@@ -3,8 +3,8 @@ T26806b: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
Backtrace Test: 125000000
IPE backtrace:
- Lovely annotation
- [1,2,3,4]
+ Lovely annotation, called at T26806b.hs:16:7 in main:Main
+ [1,2,3,4], called at T26806b.hs:15:5 in main:Main
annotateCallStack, called at T26806b.hs:14:3 in main:Main
HasCallStack backtrace:
collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception
=====================================
libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
=====================================
@@ -4,6 +4,7 @@ module GHC.Internal.Stack.Annotation where
import GHC.Internal.Base
import GHC.Internal.Data.Typeable
+import GHC.Internal.Stack (SrcLoc, prettySrcLoc)
-- ----------------------------------------------------------------------------
-- StackAnnotation
@@ -13,8 +14,36 @@ import GHC.Internal.Data.Typeable
-- as the payload of 'AnnFrame' stack frames.
--
class StackAnnotation a where
+ -- | Display a human readable string for the 'StackAnnotation'.
+ --
+ -- This is supposed to be the long version of 'displayStackAnnotationShort'
+ -- and may contain a source location.
+ --
+ -- If not provided, 'displayStackAnnotation' is derived from 'sourceLocationOfStackAnnotation'
+ -- and 'displayStackAnnotationShort'.
displayStackAnnotation :: a -> String
+ -- | Get the 'SrcLoc' of the given 'StackAnnotation'.
+ --
+ -- This is optional, 'SrcLoc' are not strictly required for 'StackAnnotation', but
+ -- it is still heavily encouarged to provide a 'SrcLoc' for better IPE backtraces.
+ sourceLocationOfStackAnnotation :: a -> Maybe SrcLoc
+
+ -- | The description of the StackAnnotation without any metadata such as source locations.
+ --
+ -- Pefer implementing 'displayStackAnnotationShort' over 'displayStackAnnotation'.
+ displayStackAnnotationShort :: a -> String
+
+ {-# MINIMAL displayStackAnnotation | displayStackAnnotationShort #-}
+
+ displayStackAnnotation ann =
+ displayStackAnnotationShort ann
+ ++ case sourceLocationOfStackAnnotation ann of
+ Nothing -> ""
+ Just srcLoc -> ", called at " ++ prettySrcLoc srcLoc
+ sourceLocationOfStackAnnotation _ann = Nothing
+ displayStackAnnotationShort = displayStackAnnotation
+
-- ----------------------------------------------------------------------------
-- Annotations
-- ----------------------------------------------------------------------------
@@ -29,3 +58,5 @@ data SomeStackAnnotation where
instance StackAnnotation SomeStackAnnotation where
displayStackAnnotation (SomeStackAnnotation a) = displayStackAnnotation a
+ sourceLocationOfStackAnnotation (SomeStackAnnotation a) = sourceLocationOfStackAnnotation a
+ displayStackAnnotationShort (SomeStackAnnotation a) = displayStackAnnotationShort a
=====================================
libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout
=====================================
@@ -1,12 +1,12 @@
Stack annotations:
-- (2,3)
+- (2,3), called at ann_frame001.hs:5:13 in main:Main
47
Stack annotations:
-- "bar"
-- "foo"
-- "tailCallEx"
+- "bar", called at ann_frame001.hs:23:9 in main:Main
+- "foo", called at ann_frame001.hs:21:11 in main:Main
+- "tailCallEx", called at ann_frame001.hs:17:18 in main:Main
Stack annotations:
-- "bar"
-- "foo"
-- "tailCallEx"
+- "bar", called at ann_frame001.hs:23:9 in main:Main
+- "foo", called at ann_frame001.hs:21:11 in main:Main
+- "tailCallEx", called at ann_frame001.hs:17:18 in main:Main
40
=====================================
libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout
=====================================
@@ -7,5 +7,5 @@ Finish some work
Some more work in bar
17711
Stack annotations:
-- bar
+- bar, called at ann_frame002.hs:23:29 in main:Main
- annotateCallStackIO, called at ann_frame002.hs:23:7 in main:Main
=====================================
libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout
=====================================
@@ -1,6 +1,6 @@
47
Stack annotations:
-- "bar"
-- "foo"
-- "tailCallEx"
+- "bar", called at ann_frame003.hs:25:9 in main:Main
+- "foo", called at ann_frame003.hs:21:11 in main:Main
+- "tailCallEx", called at ann_frame003.hs:16:18 in main:Main
40
=====================================
libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout
=====================================
@@ -13,5 +13,5 @@ Stack annotations:
- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
- annotateCallStack, called at ann_frame004.hs:21:17 in main:Main
- annotateCallStack, called at ann_frame004.hs:13:10 in main:Main
-- bar
+- bar, called at ann_frame004.hs:12:29 in main:Main
- annotateCallStackIO, called at ann_frame004.hs:12:7 in main:Main
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2407a32cd4d87a93935654abb7a102…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2407a32cd4d87a93935654abb7a102…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/freeze-throw] 2 commits: Hide implementation details of `throw`
by Hannes Siebenhandl (@fendor) 21 Jan '26
by Hannes Siebenhandl (@fendor) 21 Jan '26
21 Jan '26
Hannes Siebenhandl pushed to branch wip/fendor/freeze-throw at Glasgow Haskell Compiler / GHC
Commits:
a876dbd2 by fendor at 2026-01-21T09:09:09+01:00
Hide implementation details of `throw`
`throw` exposed implementation details as it doesn't freeze the
`CallStack`:
```
HasCallStack backtrace:
collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception
toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:90:42 in ghc-internal:GHC.Internal.Exception
throw, called at T26806b.hs:17:9 in main:Main
```
The functions `collectExceptionAnnotation` and `toExceptionWithBacktrace`
are implementation details of `throw` that are noise to the end user.
Thus, we freeze the `CallStack`, no longer exposing these details.
Then the backtrace looks like:
```
HasCallStack backtrace:
throw, called at T26806b.hs:17:9 in main:Main
```
- - - - -
55262387 by fendor at 2026-01-21T09:09:09+01:00
Hide implementation details of `throwSTM`
`throwSTM` exposed implementation details as it doesn't freeze the
`CallStack`:
```
HasCallStack backtrace:
collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:175:37 in ghc-internal:GHC.Internal.Exception
toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/STM.hs:190:26 in ghc-internal:GHC.Internal.STM
throwSTM, called at T15395c.hs:8:5 in main:Main
```
The functions `collectExceptionAnnotation` and `toExceptionWithBacktrace`
are implementation details of `throwSTM` that are noise to the end user.
Thus, we freeze the `CallStack`, no longer exposing these details.
Then the backtrace looks like:
```
HasCallStack backtrace:
throwSTM, called at T15395c.hs:8:5 in main:Main
```
- - - - -
24 changed files:
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/tests/backtraces/T15395a.stderr
- libraries/ghc-internal/tests/backtraces/T15395c.stderr
- testsuite/tests/arrows/should_compile/T21301.stderr
- testsuite/tests/deSugar/should_fail/DsStrictFail.stderr
- testsuite/tests/deSugar/should_run/T20024.stderr
- testsuite/tests/deSugar/should_run/dsrun005.stderr
- testsuite/tests/deSugar/should_run/dsrun007.stderr
- testsuite/tests/deSugar/should_run/dsrun008.stderr
- testsuite/tests/deriving/should_run/T9576.stderr
- testsuite/tests/ghci/scripts/Defer02.stderr
- testsuite/tests/ghci/scripts/T15325.stderr
- testsuite/tests/patsyn/should_run/ghci.stderr
- testsuite/tests/quotes/LiftErrMsgDefer.stderr
- testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
- testsuite/tests/type-data/should_run/T22332a.stderr
- testsuite/tests/typecheck/should_run/T10284.stderr
- testsuite/tests/typecheck/should_run/T13838.stderr
- testsuite/tests/typecheck/should_run/T9497a-run.stderr
- testsuite/tests/typecheck/should_run/T9497b-run.stderr
- testsuite/tests/typecheck/should_run/T9497c-run.stderr
- testsuite/tests/unsatisfiable/T23816.stderr
- testsuite/tests/unsatisfiable/UnsatDefer.stderr
Changes:
=====================================
libraries/ghc-internal/src/GHC/Internal/Exception.hs
=====================================
@@ -87,7 +87,7 @@ throw e =
-- Note also the absolutely crucial `noinine` in the RHS!
-- See Note [Hiding precise exception signature in throw]
let se :: SomeException
- !se = noinline (unsafePerformIO (toExceptionWithBacktrace e))
+ !se = noinline (unsafePerformIO (withFrozenCallStack $ toExceptionWithBacktrace e))
in raise# se
-- Note [Capturing the backtrace in throw]
@@ -162,7 +162,12 @@ throw e =
-- primops which allow more precise guidance of the demand analyser's heuristic
-- (e.g. #23847).
--- | @since base-4.20.0.0
+-- | Collect a Backtrace and attach it to the 'Exception'.
+--
+-- It is recommended to use 'withFrozenCallStack' when calling this function
+-- in order to avoid leaking implementation details of 'toExceptionWithBacktrace'.
+--
+-- @since base-4.20.0.0
toExceptionWithBacktrace :: (HasCallStack, Exception e)
=> e -> IO SomeException
toExceptionWithBacktrace e
=====================================
libraries/ghc-internal/src/GHC/Internal/STM.hs
=====================================
@@ -28,7 +28,7 @@ import GHC.Internal.Base
import GHC.Internal.Exception (Exception, toExceptionWithBacktrace, fromException, addExceptionContext)
import GHC.Internal.Exception.Context (ExceptionAnnotation)
import GHC.Internal.Exception.Type (WhileHandling(..))
-import GHC.Internal.Stack (HasCallStack)
+import GHC.Internal.Stack (HasCallStack, withFrozenCallStack)
-- TVars are shared memory locations which support atomic memory
-- transactions.
@@ -187,7 +187,7 @@ throwSTM e = do
-- N.B. Typically use of unsafeIOToSTM is very much frowned upon as this
-- is an easy way to end up with nested transactions. However, we can be
-- certain that toExceptionWithBacktrace will not initiate a transaction.
- se <- unsafeIOToSTM (toExceptionWithBacktrace e)
+ se <- unsafeIOToSTM (withFrozenCallStack $ toExceptionWithBacktrace e)
STM $ raiseIO# se
-- | Exception handling within STM actions.
=====================================
libraries/ghc-internal/tests/backtraces/T15395a.stderr
=====================================
@@ -3,7 +3,5 @@ T15395a: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
throw error
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:90:42 in ghc-internal:GHC.Internal.Exception
throw, called at T15395a.hs:5:3 in main:Main
=====================================
libraries/ghc-internal/tests/backtraces/T15395c.stderr
=====================================
@@ -3,7 +3,5 @@ T15395c: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
STM error
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:175:37 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/STM.hs:190:26 in ghc-internal:GHC.Internal.STM
throwSTM, called at T15395c.hs:8:5 in main:Main
=====================================
testsuite/tests/arrows/should_compile/T21301.stderr
=====================================
@@ -4,7 +4,5 @@ T21301.hs:(8,7)-(10,6): Non-exhaustive patterns in case
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/deSugar/should_fail/DsStrictFail.stderr
=====================================
@@ -4,7 +4,5 @@ DsStrictFail.hs:4:12-23: Non-exhaustive patterns in False
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/deSugar/should_run/T20024.stderr
=====================================
@@ -4,7 +4,5 @@ T20024.hs:2:12-32: Non-exhaustive guards in pattern binding
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:431:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/deSugar/should_run/dsrun005.stderr
=====================================
@@ -4,7 +4,5 @@ dsrun005.hs:42:1-18: Non-exhaustive patterns in function f
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/deSugar/should_run/dsrun007.stderr
=====================================
@@ -4,7 +4,5 @@ dsrun007.hs:5:23-25: Missing field in record construction
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:432:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/deSugar/should_run/dsrun008.stderr
=====================================
@@ -4,7 +4,5 @@ dsrun008.hs:2:32-36: Non-exhaustive patterns in (2, x)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/deriving/should_run/T9576.stderr
=====================================
@@ -13,7 +13,5 @@ T9576.hs:6:31: error: [GHC-39999]
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/ghci/scripts/Defer02.stderr
=====================================
@@ -71,8 +71,6 @@ Defer01.hs:49:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
*** Exception: Defer01.hs:13:5: error: [GHC-83865]
@@ -82,8 +80,6 @@ HasCallStack backtrace:
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
*** Exception: Defer01.hs:17:9: error: [GHC-39999]
@@ -93,8 +89,6 @@ HasCallStack backtrace:
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
<interactive>:10:11: error: [GHC-83865]
@@ -107,14 +101,12 @@ HasCallStack backtrace:
*** Exception: Defer01.hs:27:5: error: [GHC-39999]
• No instance for ‘Num (a -> a)’ arising from the literal ‘1’
- (maybe you haven't applied a function to enough arguments?)
+ (maybe you haven't applied a function to enough arguments?)
• In the expression: 1
In an equation for ‘d’: d = 1
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
*** Exception: Defer01.hs:30:5: error: [GHC-83865]
@@ -127,8 +119,6 @@ HasCallStack backtrace:
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
*** Exception: Defer01.hs:33:8: error: [GHC-25897]
@@ -146,8 +136,6 @@ HasCallStack backtrace:
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
*** Exception: Defer01.hs:38:17: error: [GHC-83865]
@@ -161,8 +149,6 @@ HasCallStack backtrace:
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
*** Exception: Defer01.hs:42:5: error: [GHC-39999]
@@ -172,8 +158,6 @@ HasCallStack backtrace:
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
<interactive>:16:8: error: [GHC-18872]
@@ -192,7 +176,5 @@ HasCallStack backtrace:
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/ghci/scripts/T15325.stderr
=====================================
@@ -24,7 +24,5 @@ T15325.hs:11:9: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)]
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/patsyn/should_run/ghci.stderr
=====================================
@@ -2,7 +2,5 @@
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/quotes/LiftErrMsgDefer.stderr
=====================================
@@ -11,7 +11,5 @@ LiftErrMsgDefer.hs:14:12: warning: [GHC-28914] [-Wdeferred-type-errors (in -Wdef
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
=====================================
@@ -4,7 +4,5 @@ SafeLang15.hs:22:9-37: Non-exhaustive patterns in Just p'
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/type-data/should_run/T22332a.stderr
=====================================
@@ -4,7 +4,5 @@ T22332a.hs:18:1-35: Non-exhaustive patterns in Just eq
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/typecheck/should_run/T10284.stderr
=====================================
@@ -7,7 +7,5 @@ T10284.hs:7:5: error: [GHC-83865]
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/typecheck/should_run/T13838.stderr
=====================================
@@ -9,7 +9,5 @@ T13838.hs:6:1: error: [GHC-83865]
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/typecheck/should_run/T9497a-run.stderr
=====================================
@@ -19,7 +19,5 @@ T9497a-run.hs:2:8: error: [GHC-88464]
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/typecheck/should_run/T9497b-run.stderr
=====================================
@@ -19,7 +19,5 @@ T9497b-run.hs:2:8: error: [GHC-88464]
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/typecheck/should_run/T9497c-run.stderr
=====================================
@@ -19,7 +19,5 @@ T9497c-run.hs:2:8: error: [GHC-88464]
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/unsatisfiable/T23816.stderr
=====================================
@@ -8,7 +8,5 @@ T23816.hs:18:15: error: [GHC-22250]
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/unsatisfiable/UnsatDefer.stderr
=====================================
@@ -7,7 +7,5 @@ UnsatDefer.hs:20:7: error: [GHC-22250]
(deferred type error)
HasCallStack backtrace:
- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/721afc8e04d764dd4e6eb185abadf1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/721afc8e04d764dd4e6eb185abadf1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/gitignore-submodules] Apply 1 suggestion(s) to 1 file(s)
by Hannes Siebenhandl (@fendor) 21 Jan '26
by Hannes Siebenhandl (@fendor) 21 Jan '26
21 Jan '26
Hannes Siebenhandl pushed to branch wip/fendor/gitignore-submodules at Glasgow Haskell Compiler / GHC
Commits:
2636a24c by Hannes Siebenhandl at 2026-01-21T08:59:52+01:00
Apply 1 suggestion(s) to 1 file(s)
Co-authored-by: Sven Tennie <sven.tennie(a)gmail.com>
- - - - -
1 changed file:
- .gitignore
Changes:
=====================================
.gitignore
=====================================
@@ -261,6 +261,7 @@ dist-newstyle/
# CI
# Windows CI
-toolchain/
-inplace/
-tmp/
+/toolchain/
+/ghc-*/
+/inplace/
+/tmp/
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2636a24cd9c32fe1891fe086deefccf…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2636a24cd9c32fe1891fe086deefccf…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
21 Jan '26
Simon Hengel pushed new branch wip/sol/MultiWayIf-docs at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sol/MultiWayIf-docs
You're receiving this email because of your account on gitlab.haskell.org.
1
0
21 Jan '26
Brandon Chinn pushed to branch wip/T26503 at Glasgow Haskell Compiler / GHC
Commits:
6dfed3a3 by Brandon Chinn at 2026-01-20T21:36:48-08:00
Address feedback
- - - - -
12 changed files:
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Pat.hs
- + testsuite/tests/qualified-strings/should_fail/Example/Length.hs
- testsuite/tests/qualified-strings/should_fail/all.T
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.stderr
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.stderr
- + testsuite/tests/qualified-strings/should_fail/qstrings_redundant_pattern.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_redundant_pattern.stderr
Changes:
=====================================
compiler/GHC/Hs/Lit.hs
=====================================
@@ -35,6 +35,7 @@ import GHC.Hs.Extension
import Language.Haskell.Syntax.Expr ( HsExpr )
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Lit
+import Language.Haskell.Syntax.Module.Name (moduleNameString)
{-
************************************************************************
@@ -211,14 +212,18 @@ Equivalently it's True if
instance IsPass p => Outputable (HsLit (GhcPass p)) where
ppr (HsChar st c) = pprWithSourceText st (pprHsChar c)
ppr (HsCharPrim st c) = pprWithSourceText st (pprPrimChar c)
- ppr (HsString StringMeta{..} s)
- -- multiline strings
- | strMetaMultiline =
+ ppr (HsString StringMeta{..} s) =
+ handleQualified $ if strMetaMultiline then renderMultiline else renderNormal
+ where
+ handleQualified =
+ case strMetaQualified of
+ Nothing -> id
+ Just modName -> (text (moduleNameString modName ++ ".") <>)
+ renderMultiline =
case strMetaSrc of
NoSourceText -> pprHsString s
- SourceText src -> vcat $ map text $ split '\n' (unpackFS src)
- -- normal strings
- | otherwise = pprWithSourceText strMetaSrc (pprHsString s)
+ SourceText src -> vcat . map text . split '\n' . unpackFS $ src
+ renderNormal = pprWithSourceText strMetaSrc (pprHsString s)
ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
ppr (HsInt _ i)
= pprWithSourceText (il_text i) (integer (il_value i))
=====================================
compiler/GHC/HsToCore/Pmc/Desugar.hs
=====================================
@@ -39,6 +39,7 @@ import GHC.Core.TyCo.Compare( eqType )
import GHC.Core.Type
import GHC.Data.Maybe
import GHC.Types.SourceText (FractionalLit(..))
+import GHC.Types.StringMeta (StringMeta(..))
import Control.Monad (zipWithM, replicateM)
import Data.List (elemIndex)
import Data.List.NonEmpty ( NonEmpty(..) )
@@ -137,6 +138,11 @@ desugarPat x pat = case pat of
, is_to_list (unLoc lrhs)
-> desugarLPat x pat
+ -- Desugar qualified string literals the same as RebindableSyntax
+ LitPat _ (HsString StringMeta{strMetaQualified = Just _} s)
+ | ViewPat ty _ _ <- expansion
+ -> mkPmLitGrds x $ PmLit ty (PmLitOverString s)
+
_ -> desugarPat x expansion
-- See Note [Desugar CoPats]
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -359,7 +359,8 @@ rnExpr (HsLit x lit) | Just (meta, s) <- stringLike lit
| StringMeta{strMetaQualified = Just modName} <- meta -> do
(qualifiedFromString, fvs) <- first genHsVar <$> lookupNameWithQualifier fromStringName modName
let hsLit = HsLit x (convertLit lit)
- return (HsApp noExtField (noLocA qualifiedFromString) (noLocA hsLit), fvs)
+ let expr = HsApp noExtField (noLocA qualifiedFromString) (noLocA hsLit)
+ return (mkExpandedExpr hsLit expr, fvs)
| opt_OverloadedStrings ->
rnExpr (HsOverLit x (mkHsIsString (strMetaSrc meta) s))
| otherwise -> do {
=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -567,13 +567,14 @@ rnPatAndThen mk (LitPat x lit)
-- M."asdf" => ((M.fromString "asdf" ==) -> True)
eqExpr <- liftCpsFV $ lookupSyntaxExpr eqName
fromStringExpr <- fmap genHsVar $ liftCpsFV $ lookupNameWithQualifier fromStringName modName
- let lit = noLocA $ HsLit noExtField (mkHsStringFS s)
- let trueExpr = noLocA $
+ let litExpr = noLocA $ HsLit noExtField (convertLit lit)
+ truePat = noLocA $
ConPat
noExtField
(noLocA $ noUserRdr trueDataConName)
(PrefixCon [])
- return $ ViewPat Nothing (genLHsApp eqExpr (genLHsApp fromStringExpr lit)) trueExpr
+ return . mkExpandedPat (LitPat x (convertLit lit)) $
+ ViewPat Nothing (genLHsApp eqExpr (genLHsApp fromStringExpr litExpr)) truePat
| opt_OverloadedStrings ->
rnPatAndThen mk
(mkNPat (noLocA (mkHsIsString (strMetaSrc meta) s))
=====================================
testsuite/tests/qualified-strings/should_fail/Example/Length.hs
=====================================
@@ -0,0 +1,4 @@
+module Example.Length where
+
+fromString :: String -> Int
+fromString = length
=====================================
testsuite/tests/qualified-strings/should_fail/all.T
=====================================
@@ -1,3 +1,8 @@
setTestOpts(only_ways(['normal']));
+qextra_files = extra_files(['Example'])
+
test('qstrings_multiline_no_ext', normal, compile_fail, [''])
+test('qstrings_bad_expr', [qextra_files], multimod_compile_fail, ['qstrings_bad_expr', ''])
+test('qstrings_bad_pat', [qextra_files], multimod_compile_fail, ['qstrings_bad_pat', ''])
+test('qstrings_redundant_pattern', [qextra_files], multimod_compile_fail, ['qstrings_redundant_pattern', ''])
=====================================
testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.hs
=====================================
@@ -0,0 +1,6 @@
+{-# LANGUAGE QualifiedStrings #-}
+
+import qualified Example.Length as Length
+
+main :: IO ()
+main = putStrLn Length."this fails after being converted into an Int"
=====================================
testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.stderr
=====================================
@@ -0,0 +1,15 @@
+[1 of 3] Compiling Example.Length ( Example/Length.hs, Example/Length.o )
+[2 of 3] Compiling Main ( qstrings_bad_expr.hs, qstrings_bad_expr.o )
+qstrings_bad_expr.hs:6:17: error: [GHC-83865]
+ • Couldn't match type ‘Int’ with ‘[Char]’
+ Expected: String
+ Actual: Int
+ • In the first argument of ‘putStrLn’, namely
+ ‘Length."this fails after being converted into an Int"’
+ In the expression:
+ putStrLn
+ Length."this fails after being converted into an Int"
+ In an equation for ‘main’:
+ main
+ = putStrLn
+ Length."this fails after being converted into an Int"
=====================================
testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE QualifiedStrings #-}
+
+import qualified Example.Length as Length
+
+main :: IO ()
+main =
+ case "" of
+ Length."this fails after being converted into an Int" -> pure ()
+ _ -> pure ()
=====================================
testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.stderr
=====================================
@@ -0,0 +1,15 @@
+[1 of 3] Compiling Example.Length ( Example/Length.hs, Example/Length.o )
+[2 of 3] Compiling Main ( qstrings_bad_pat.hs, qstrings_bad_pat.o )
+qstrings_bad_pat.hs:8:5: error: [GHC-83865]
+ • Couldn't match type ‘[Char]’ with ‘Int’
+ Expected: String
+ Actual: Int
+ • In the pattern:
+ Length."this fails after being converted into an Int"
+ In a case alternative:
+ Length."this fails after being converted into an Int"
+ -> pure ()
+ In the expression:
+ case "" of
+ Length."this fails after being converted into an Int" -> pure ()
+ _ -> pure ()
=====================================
testsuite/tests/qualified-strings/should_fail/qstrings_redundant_pattern.hs
=====================================
@@ -0,0 +1,15 @@
+{-# LANGUAGE QualifiedStrings #-}
+{-# OPTIONS_GHC -Wall -Werror #-}
+
+import qualified Example.Length as Length
+
+main :: IO ()
+main = print $ foo Length."abc"
+
+foo :: Int -> ()
+foo Length."abc" = ()
+foo other =
+ case other of
+ Length."abc" -> ()
+ Length."def" -> ()
+ _ -> ()
=====================================
testsuite/tests/qualified-strings/should_fail/qstrings_redundant_pattern.stderr
=====================================
@@ -0,0 +1,6 @@
+[1 of 3] Compiling Example.Length ( Example/Length.hs, Example/Length.o )
+[2 of 3] Compiling Main ( qstrings_redundant_pattern.hs, qstrings_redundant_pattern.o )
+qstrings_redundant_pattern.hs:13:5: error: [GHC-53633] [-Woverlapping-patterns (in -Wdefault), Werror=overlapping-patterns]
+ Pattern match is redundant
+ In a case alternative: Length."abc" -> ...
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6dfed3a3d0b444bc6b971a6e32ba9ef…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6dfed3a3d0b444bc6b971a6e32ba9ef…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Don't build GHC with -Wcompat
by Marge Bot (@marge-bot) 21 Jan '26
by Marge Bot (@marge-bot) 21 Jan '26
21 Jan '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
8d2bf083 by Andreas Klebinger at 2026-01-21T00:22:53-05:00
Don't build GHC with -Wcompat
Without bumping the boot compiler the warnings it produces are often not
actionable leading to pointless noise.
Fixes #26800
- - - - -
e177aa8b by Torsten Schmits at 2026-01-21T00:22:55-05:00
Use the correct field of ModOrigin when formatting error message listing hidden reexports
- - - - -
250b8045 by Cheng Shao at 2026-01-21T00:22:56-05:00
Revert "hadrian: handle findExecutable "" gracefully"
This reverts commit 1e5752f64a522c4025365856d92f78073a7b3bba. The
underlying issue has been fixed in
https://github.com/haskell/directory/commit/75828696e7145adc09179111a0d631b…
and present since 1.3.9.0, and hadrian directory lower bound is
1.3.9.0, so we can revert our own in house hack now.
- - - - -
34b822c1 by Cheng Shao at 2026-01-21T00:22:57-05:00
rts: fix typo in TICK_ALLOC_RTS
This patch fixes a typo in the `TICK_ALLOC_RTS` macro, the original
`bytes` argument was silently dropped. The Cmm code has its own
version of `TICK_ALLOC_RTS` not affected by this typo, it affected the
C RTS, and went unnoticed because the variable `n` happened to also be
available at its call site. But the number was incorrect. Also fixes
its call site since `WDS()` is not available in C.
- - - - -
18ce2b53 by Cheng Shao at 2026-01-21T00:22:57-05:00
rts: remove broken & unused ALLOC_P_TICKY
This patch removes the `ALLOC_P_TICKY` macro from the rts, it's
unused, and its expanded code is already broken.
- - - - -
0964ffc3 by Simon Peyton Jones at 2026-01-21T00:22:59-05:00
Make the implicit-parameter class have representational role
This MR addresses #26737, by making the built-in class IP
have a representational role for its second parameter.
See Note [IP: implicit parameter class] in
ghc-internal:GHC.Internal.Classes.IP
In fact, IP is (unfortunately, currently) exposed by
base:GHC.Base, so we ran a quick CLC proposal to
agree the change:
https://github.com/haskell/core-libraries-committee/issues/385
Some (small) compilations get faster because they only need to
load (small) interface file GHC.Internal.Classes.IP.hi,
rather than (large) GHC.Internal.Classes.hi.
Metric Decrease:
T10421
T12150
T12425
T24582
T5837
T5030
- - - - -
1e7496ae by Cheng Shao at 2026-01-21T00:23:00-05:00
testsuite: avoid re.sub in favor of simple string replacements
This patch refactors the testsuite driver and avoids the usage of
re.sub in favor of simple string replacements when possible. The
changes are not comprehensive, and there are still a lot of re.sub
usages lingering around the tree, but this already addresses a major
performance bottleneck in the testsuite driver that might has to do
with quadratic or worse slowdown in cpython's regular expression
engine when handling certain regex patterns with large strings.
Especially on i386, and i386 jobs are the bottlenecks of all full-ci
validate pipelines!
Here are the elapsed times of testing x86_64/i386 with -j48 before
this patch:
x86_64: `Build completed in 6m06s`
i386: `Build completed in 1h36m`
And with this patch:
x86_64: `Build completed in 4m55s`
i386: `Build completed in 4m23s`
Fixes #26786.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
79e8ef89 by Zubin Duggal at 2026-01-21T00:23:01-05:00
ghc-toolchain: Also configure windres on non-windows platforms.
It may be needed for cross compilation.
Fixes #24588
- - - - -
6ec3f9fb by Cheng Shao at 2026-01-21T00:23:01-05:00
ghci: print external interpreter trace messages to stderr instead of stdout
This patch makes ghci print external interpreter trace messages to
stderr instead of stdout, which is a much saner choice for diagnostic
information. Closes #26807.
- - - - -
29 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Unit/State.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.16.1-notes.rst
- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Rules/Docspec.hs
- hadrian/src/Rules/Lint.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Builders/RunTest.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Classes.hs
- + libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs
- libraries/ghci/GHCi/Server.hs
- rts/include/Cmm.h
- rts/include/stg/Ticky.h
- rts/sm/Storage.c
- testsuite/driver/runtests.py
- testsuite/driver/testlib.py
- testsuite/driver/testutil.py
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- testsuite/tests/th/TH_implicitParams.stdout
- + testsuite/tests/typecheck/should_compile/T26737.hs
- testsuite/tests/typecheck/should_compile/all.T
- utils/ghc-toolchain/exe/Main.hs
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -526,7 +526,7 @@ genericTyConNames = [
gHC_PRIM, gHC_PRIM_PANIC,
gHC_TYPES, gHC_INTERNAL_DATA_DATA, gHC_MAGIC, gHC_MAGIC_DICT,
- gHC_CLASSES, gHC_PRIMOPWRAPPERS :: Module
+ gHC_CLASSES, gHC_CLASSES_IP, gHC_PRIMOPWRAPPERS :: Module
gHC_PRIM = mkGhcInternalModule (fsLit "GHC.Internal.Prim") -- Primitive types and values
gHC_PRIM_PANIC = mkGhcInternalModule (fsLit "GHC.Internal.Prim.Panic")
gHC_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Types")
@@ -534,6 +534,7 @@ gHC_MAGIC = mkGhcInternalModule (fsLit "GHC.Internal.Magic")
gHC_MAGIC_DICT = mkGhcInternalModule (fsLit "GHC.Internal.Magic.Dict")
gHC_CSTRING = mkGhcInternalModule (fsLit "GHC.Internal.CString")
gHC_CLASSES = mkGhcInternalModule (fsLit "GHC.Internal.Classes")
+gHC_CLASSES_IP = mkGhcInternalModule (fsLit "GHC.Internal.Classes.IP")
gHC_PRIMOPWRAPPERS = mkGhcInternalModule (fsLit "GHC.Internal.PrimopWrappers")
gHC_INTERNAL_TUPLE = mkGhcInternalModule (fsLit "GHC.Internal.Tuple")
@@ -1521,7 +1522,7 @@ fromLabelClassOpName
-- Implicit Parameters
ipClassName :: Name
ipClassName
- = clsQual gHC_CLASSES (fsLit "IP") ipClassKey
+ = clsQual gHC_CLASSES_IP (fsLit "IP") ipClassKey
-- Overloaded record fields
hasFieldClassName :: Name
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -215,7 +215,7 @@ instance Outputable ModuleOrigin where
(if null rhs
then []
else [text "hidden reexport by" <+>
- sep (map (ppr . mkUnit) res)]) ++
+ sep (map (ppr . mkUnit) rhs)]) ++
(if f then [text "package flag"] else [])
))
=====================================
compiler/ghc.cabal.in
=====================================
@@ -149,6 +149,7 @@ Library
else
Build-Depends: unix >= 2.7 && < 2.9
+ -- Hadrian further set some warnings in its Settings.Warnings module.
GHC-Options: -Wall
-Wno-name-shadowing
-Wnoncanonical-monad-instances
=====================================
docs/users_guide/9.16.1-notes.rst
=====================================
@@ -30,6 +30,18 @@ Language
- The extension :extension:`ExplicitNamespaces` now allows namespace-specified
wildcards ``type ..`` and ``data ..`` in import and export lists.
+- Implicit parameters and ``ImpredicativeTypes``. GHC now knows
+ that if ``?foo::S`` is coecible to ``?foo::T`` only if ``S`` is coercible to ``T``.
+ Example (from :ghc-ticket:`#26737`)::
+
+ {-# LANGUAGE ImplicitParams, ImpredicativeTypes #-}
+ newtype N = MkN Int
+ test :: ((?foo::N) => Bool) -> ((?foo::Int) => Bool)
+ test = coerce
+
+ This is achieved by arranging that ``?foo :: T`` has a representational
+ role for ``T``.
+
Compiler
~~~~~~~~
=====================================
hadrian/src/Hadrian/Utilities.hs
=====================================
@@ -19,7 +19,6 @@ module Hadrian.Utilities (
copyFile, copyFileUntracked, createFileLink, fixFile,
makeExecutable, moveFile, removeFile, createDirectory, copyDirectory,
moveDirectory, removeDirectory, removeFile_, writeFileChangedBS,
- findExecutable,
-- * Diagnostic info
Colour (..), ANSIColour (..), putColoured, shouldUseColor,
@@ -691,7 +690,3 @@ renderUnicorn ls =
ponyPadding = " "
boxLines :: [String]
boxLines = ["", "", ""] ++ (lines . renderBox $ ls)
-
--- Workaround for https://github.com/haskell/directory/issues/180
-findExecutable :: String -> IO (Maybe FilePath)
-findExecutable exe = IO.catch (IO.findExecutable exe) $ \(_ :: IO.IOException) -> pure Nothing
=====================================
hadrian/src/Rules/Docspec.hs
=====================================
@@ -2,6 +2,8 @@ module Rules.Docspec
( docspecRules
) where
+import System.Directory (findExecutable)
+
import Base
import Context.Path
import Settings.Builders.Common
=====================================
hadrian/src/Rules/Lint.hs
=====================================
@@ -4,6 +4,7 @@ module Rules.Lint
import Base
import Settings.Builders.Common
+import System.Directory (findExecutable)
import System.Exit (exitFailure)
lintRules :: Rules ()
=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -38,7 +38,6 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
stage <- getStage
hie_path <- getHieBuildPath
mconcat [ arg "-Wall"
- , arg "-Wcompat"
, not useColor ? builder (Ghc CompileHs) ?
-- N.B. Target.trackArgument ignores this argument from the
-- input hash to avoid superfluous recompilation, avoiding
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -16,6 +16,7 @@ import Settings.Builders.Common
import qualified Data.Set as Set
import Flavour
import qualified Context.Type as C
+import System.Directory (findExecutable)
import Settings.Program
import qualified Context.Type
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -343,6 +343,7 @@ Library
GHC.Internal.CString
GHC.Internal.Classes
+ GHC.Internal.Classes.IP
GHC.Internal.Debug
GHC.Internal.Magic
GHC.Internal.Magic.Dict
=====================================
libraries/ghc-internal/src/GHC/Internal/Classes.hs
=====================================
@@ -1,10 +1,9 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns,
KindSignatures, DataKinds, ConstraintKinds,
- MultiParamTypeClasses, FunctionalDependencies #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}
- -- ip :: IP x a => a is strictly speaking ambiguous, but IP is magic
+ MultiParamTypeClasses, FunctionalDependencies,
+ UnboxedTuples #-}
+
{-# LANGUAGE UndecidableSuperClasses #-}
-- Because of the type-variable superclasses for tuples
@@ -142,6 +141,7 @@ import GHC.Internal.Prim
import GHC.Internal.Tuple
import GHC.Internal.CString (unpackCString#)
import GHC.Internal.Types
+import GHC.Internal.Classes.IP
infix 4 ==, /=, <, <=, >=, >
infixr 3 &&
@@ -149,12 +149,6 @@ infixr 2 ||
default () -- Double isn't available yet
--- | The syntax @?x :: a@ is desugared into @IP "x" a@
--- IP is declared very early, so that libraries can take
--- advantage of the implicit-call-stack feature
-class IP (x :: Symbol) a | x -> a where
- ip :: a
-
{- $matching_overloaded_methods_in_rules
Matching on class methods (e.g. @(==)@) in rewrite rules tends to be a bit
=====================================
libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs
=====================================
@@ -0,0 +1,87 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns,
+ KindSignatures, DataKinds, ConstraintKinds,
+ MultiParamTypeClasses, FunctionalDependencies #-}
+
+{-# LANGUAGE AllowAmbiguousTypes, RoleAnnotations, IncoherentInstances #-}
+ -- LANGUAGE pragmas: see Note [IP: implicit parameter class]
+
+{-# OPTIONS_HADDOCK not-home #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : GHC.Internal.Classes.IP
+-- Copyright : (c) The University of Glasgow, 1992-2002
+-- License : see libraries/base/LICENSE
+--
+-- Maintainer : ghc-devs(a)haskell.org
+-- Stability : internal
+-- Portability : non-portable (GHC extensions)
+--
+-- Basic classes.
+-- Do not import this module directly. It is an GHC internal only
+-- module. Some of its contents are instead available from @Prelude@
+-- and @GHC.Int@.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Internal.Classes.IP( IP(..)) where
+
+import GHC.Internal.Types
+
+
+default () -- Double isn't available yet
+
+-- | The syntax @?x :: a@ is desugared into @IP "x" a@
+-- IP is declared very early, so that libraries can take
+-- advantage of the implicit-call-stack feature
+type role IP nominal representational -- See (IPRoles)
+class IP (x :: Symbol) a | x -> a where
+ ip :: a
+
+{- Note [IP: implicit parameter class]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+An implicit parameter constraint (?foo::ty) is just short for
+
+ IP "foo" ty
+
+where ghc-internal:GHC.Internal.Classes.IP is a special class that
+GHC knows about, defined in this module.
+
+* It is a unary type class, with one method `ip`, so it has no cost.
+ For example, (?foo::Int) is represented just by an Int.
+
+* Criticially, it has a functional dependency:
+ class IP (x :: Symbol) a | x -> a where ...
+ So if we have
+ [G] IP "foo" Int
+ [W] IP "foo" alpha
+ the fundep wil lgive us alpha ~ Int, as desired.
+
+* The solver has a number of special cases for implicit parameters,
+ mainly because a binding (let ?foo::Int = rhs in body)
+ is like a local instance declaration for IP. Search for uses
+ of `isIPClass`.
+
+Wrinkles
+
+(IPAmbiguity) The single method of IP has an ambiguous type
+ ip :: forall a. IP s a => a
+ Hence the LANGUAGE pragama AllowAmbiguousTypes.
+ The method `ip` is never called by the user, so ambiguity doesn't matter.
+
+(IPRoles) IP has a role annotation. Why? See #26737. We want
+ [W] IP "foo" t1 ~R# IP "foo" t2
+ to decompose to give [W] IP t1 ~R# t2, using /representational/
+ equality for (t1 ~R# t2) not nominal.
+
+ This usually gives a complaint about incoherence, because in general
+ (t1 ~R# t2) does NOT imply (C t1) ~R# (C t2) for any normal class.
+ But it does for IP, because instance selection is controlled by the Symbol,
+ not the type of the payload. Hence LANGUAGE pragma IncoherentInstances.
+ (It is unfortunate that we need a module-wide IncoherentInstances here;
+ see #17167.)
+
+ Side note: arguably this treatment could be applied to any class
+ with a functional dependency; but for now we restrict it to IP.
+-}
+
=====================================
libraries/ghci/GHCi/Server.hs
=====================================
@@ -32,11 +32,12 @@ import Data.Binary
import Text.Printf
import System.Environment (getProgName, getArgs)
import System.Exit
+import System.IO
type MessageHook = Msg -> IO Msg
trace :: String -> IO ()
-trace s = getProgName >>= \name -> printf "[%20s] %s\n" name s
+trace s = getProgName >>= \name -> hPrintf stderr "[%20s] %s\n" name s
serv :: Bool -> MessageHook -> Pipe -> (forall a .IO a -> IO a) -> IO ()
serv verbose hook pipe restore = loop
=====================================
rts/include/Cmm.h
=====================================
@@ -441,12 +441,6 @@
#define HP_CHK_P(bytes, fun, arg) \
HEAP_CHECK(bytes, GC_PRIM_P(fun,arg))
-// TODO I'm not seeing where ALLOC_P_TICKY is used; can it be removed?
-// -NSF March 2013
-#define ALLOC_P_TICKY(bytes, fun, arg) \
- HP_CHK_P(bytes); \
- TICK_ALLOC_RTS(bytes);
-
// Load a field out of structure with relaxed ordering.
#define RELAXED_LOAD_FIELD(fld, ptr) \
REP_##fld![(ptr) + OFFSET_##fld]
=====================================
rts/include/stg/Ticky.h
=====================================
@@ -246,7 +246,7 @@ EXTERN StgInt RET_UNBOXED_TUP_hst[TICKY_BIN_COUNT] INIT({0});
TICK_BUMP_BY(ALLOC_THK_gds,g);\
TICK_BUMP_BY(ALLOC_THK_slp,s);\
-#define TICK_ALLOC_RTS(bytes)\
+#define TICK_ALLOC_RTS(n)\
TICK_BUMP(ALLOC_RTS_ctr);\
TICK_BUMP_BY(ALLOC_RTS_tot,n);
#endif
=====================================
rts/sm/Storage.c
=====================================
@@ -990,7 +990,7 @@ move_STACK (StgStack *src, StgStack *dest)
void
accountAllocation(Capability *cap, W_ n)
{
- TICK_ALLOC_RTS(WDS(n));
+ TICK_ALLOC_RTS(n*sizeof(W_));
CCS_ALLOC(cap->r.rCCCS,n);
if (cap->r.rCurrentTSO != NULL) {
// cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_)
=====================================
testsuite/driver/runtests.py
=====================================
@@ -28,7 +28,7 @@ import subprocess
import asyncio
-from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name
+from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name, str_removeprefix
from testglobals import getConfig, ghc_env, TestConfig, t, \
TestOptions, brokens, PerfMetric
from my_typing import TestName
@@ -291,7 +291,7 @@ if windows:
for line in pkginfo.split('\n'):
if line.startswith('library-dirs:'):
path = line.rstrip()
- path = re.sub('^library-dirs: ', '', path)
+ path = str_removeprefix(path, 'library-dirs: ')
# Use string.replace instead of re.sub, because re.sub
# interprets backslashes in the replacement string as
# escape sequences.
=====================================
testsuite/driver/testlib.py
=====================================
@@ -25,7 +25,7 @@ from testglobals import config, ghc_env, default_testopts, brokens, t, \
from testutil import strip_quotes, lndir, link_or_copy_file, passed, \
failBecause, testing_metrics, residency_testing_metrics, \
stable_perf_counters, \
- PassFail, badResult, memoize
+ PassFail, badResult, memoize, str_removeprefix
from term_color import Color, colored
import testutil
from cpu_features import have_cpu_feature
@@ -1792,7 +1792,7 @@ async def do_test(name: TestName,
if opts.expect not in ['pass', 'fail', 'missing-lib']:
framework_fail(name, way, 'bad expected ' + opts.expect)
- directory = re.sub(r'^\.[/\\]', '', str(opts.testdir))
+ directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
if way in opts.fragile_ways:
if_verbose(1, '*** fragile test %s resulted in %s' % (full_name, 'pass' if result.passed else 'fail'))
@@ -1830,7 +1830,7 @@ async def do_test(name: TestName,
# if found and instead have the testsuite decide on what to do
# with the output.
def override_options(pre_cmd):
- if config.verbose >= 5 and bool(re.match(r'\$make', pre_cmd, re.I)):
+ if config.verbose >= 5 and pre_cmd.lower().startswith('$make'):
return pre_cmd.replace(' -s' , '') \
.replace('--silent', '') \
.replace('--quiet' , '')
@@ -1843,7 +1843,7 @@ def framework_fail(name: Optional[TestName], way: Optional[WayName], reason: str
# so we need to take care not to blow up with the wrong way
# and report the actual reason for the failure.
try:
- directory = re.sub(r'^\.[/\\]', '', str(opts.testdir))
+ directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
except:
directory = ''
full_name = '%s(%s)' % (name, way)
@@ -1856,7 +1856,7 @@ def framework_fail(name: Optional[TestName], way: Optional[WayName], reason: str
def framework_warn(name: TestName, way: WayName, reason: str) -> None:
opts = getTestOpts()
- directory = re.sub(r'^\.[/\\]', '', str(opts.testdir))
+ directory = str_removeprefix(str_removeprefix(str(opts.testdir), './'), '.\\')
full_name = name + '(' + way + ')'
if_verbose(1, '*** framework warning for %s %s ' % (full_name, reason))
t.framework_warnings.append(TestResult(directory, name, reason, way))
@@ -2550,7 +2550,7 @@ def split_file(in_fn: Path, delimiter: str, out1_fn: Path, out2_fn: Path):
with out1_fn.open('w', encoding='utf8', newline='') as out1:
with out2_fn.open('w', encoding='utf8', newline='') as out2:
line = infile.readline()
- while re.sub(r'^\s*','',line) != delimiter and line != '':
+ while line.lstrip() != delimiter and line != '':
out1.write(line)
line = infile.readline()
@@ -2933,6 +2933,14 @@ def normalise_callstacks(s: str) -> str:
tyCon_re = re.compile(r'TyCon\s*\d+\#\#\d?\d?\s*\d+\#\#\d?\d?\s*', flags=re.MULTILINE)
+def drop_lines_containing(s: str, needle: str) -> str:
+ """
+ Drop lines from `s` which contain `needle`.
+ """
+ if needle not in s:
+ return s
+ return ''.join(line for line in s.splitlines(keepends=True) if needle not in line)
+
def normalise_type_reps(s: str) -> str:
""" Normalise out fingerprints from Typeable TyCon representations """
return re.sub(tyCon_re, 'TyCon FINGERPRINT FINGERPRINT ', s)
@@ -2944,8 +2952,8 @@ def normalise_errmsg(s: str) -> str:
s = s.replace('ld: 0706-027 The -x flag is ignored.\n', '')
# remove " error:" and lower-case " Warning:" to make patch for
# trac issue #10021 smaller
- s = modify_lines(s, lambda l: re.sub(' error:', '', l))
- s = modify_lines(s, lambda l: re.sub(' Warning:', ' warning:', l))
+ s = modify_lines(s, lambda l: l.replace(' error:', ''))
+ s = modify_lines(s, lambda l: l.replace(' Warning:', ' warning:'))
s = normalise_callstacks(s)
s = normalise_type_reps(s)
@@ -2960,7 +2968,7 @@ def normalise_errmsg(s: str) -> str:
# a target prefix (e.g. `aarch64-linux-gnu-ghc`)
# * On Windows the executable name may mention the
# versioned name (e.g. `ghc-9.2.1`)
- s = re.sub(Path(config.compiler).name + ':', 'ghc:', s)
+ s = s.replace(Path(config.compiler).name + ':', 'ghc:')
# If somefile ends in ".exe" or ".exe:", zap ".exe" (for Windows)
# the colon is there because it appears in error messages; this
@@ -2973,11 +2981,13 @@ def normalise_errmsg(s: str) -> str:
s = re.sub(r'([^\s])\.jsexe', r'\1', s)
# hpc executable is given ghc suffix
- s = re.sub('hpc-ghc', 'hpc', s)
+ s = s.replace('hpc-ghc', 'hpc')
# The inplace ghc's are called ghc-stage[123] to avoid filename
# collisions, so we need to normalise that to just "ghc"
- s = re.sub('ghc-stage[123]', 'ghc', s)
+ s = (s.replace('ghc-stage1', 'ghc')
+ .replace('ghc-stage2', 'ghc')
+ .replace('ghc-stage3', 'ghc'))
# Remove platform prefix (e.g. javascript-unknown-ghcjs) for cross-compiled tools
# (ghc, ghc-pkg, unlit, etc.)
s = re.sub(r'\w+(-\w+)*-ghc', 'ghc', s)
@@ -3000,7 +3010,7 @@ def normalise_errmsg(s: str) -> str:
# Also filter out bullet characters. This is because bullets are used to
# separate error sections, and tests shouldn't be sensitive to how the
# the division happens.
- bullet = '•'.encode('utf8') if isinstance(s, bytes) else '•'
+ bullet = '•'
s = s.replace(bullet, '')
# Windows only, this is a bug in hsc2hs but it is preventing
@@ -3015,19 +3025,19 @@ def normalise_errmsg(s: str) -> str:
s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE (?:\(5\) )?type: 0xc000000(.*)$', '', l))
s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
- s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s)
+ s = s.replace('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version', '')
# ignore superfluous dylibs passed to the linker.
- s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s)
+ s = drop_lines_containing(s, 'ignoring unexpected dylib file')
# ignore LLVM Version mismatch garbage; this will just break tests.
- s = re.sub('You are using an unsupported version of LLVM!.*\n','',s)
- s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s)
- s = re.sub('We will try though\\.\\.\\..*\n','',s)
+ s = drop_lines_containing(s, 'You are using an unsupported version of LLVM!')
+ s = drop_lines_containing(s, 'System LLVM version:')
+ s = drop_lines_containing(s, 'We will try though...')
# ignore warning about strip invalidating signatures
- s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s)
+ s = drop_lines_containing(s, 'strip: changes being made to the file will invalidate the code signature in')
# clang may warn about unused argument when used as assembler
- s = re.sub('.*warning: argument unused during compilation:.*\n', '', s)
+ s = drop_lines_containing(s, 'warning: argument unused during compilation:')
# Emscripten displays cache info and old emcc doesn't support EMCC_LOGGING=0
- s = re.sub('cache:INFO: .*\n', '', s)
+ s = drop_lines_containing(s, 'cache:INFO:')
# Old emcc warns when we export HEAP8 but new one requires it (see #26290)
s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nwarning: invalid item in EXPORTED_RUNTIME_METHODS: HEAPU8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','')
@@ -3050,7 +3060,7 @@ def normalise_prof (s: str) -> str:
# The next step assumes none of the fields have no spaces in, which is broke
# when the src = <no location info>
- s = re.sub('no location info','no-location-info', s)
+ s = s.replace('no location info', 'no-location-info')
# Source locations from internal libraries, remove the source location
# > libraries/ghc-internal/src/path/Foo.hs:204:1-18
@@ -3103,21 +3113,21 @@ def normalise_prof (s: str) -> str:
return s
def normalise_slashes_( s: str ) -> str:
- s = re.sub(r'\\', '/', s)
- s = re.sub(r'//', '/', s)
+ s = s.replace('\\', '/')
+ s = s.replace('//', '/')
return s
def normalise_exe_( s: str ) -> str:
- s = re.sub(r'\.exe', '', s)
- s = re.sub(r'\.wasm', '', s)
- s = re.sub(r'\.jsexe', '', s)
+ s = s.replace('.exe', '')
+ s = s.replace('.wasm', '')
+ s = s.replace('.jsexe', '')
return s
def normalise_output( s: str ) -> str:
# remove " error:" and lower-case " Warning:" to make patch for
# trac issue #10021 smaller
- s = modify_lines(s, lambda l: re.sub(' error:', '', l))
- s = modify_lines(s, lambda l: re.sub(' Warning:', ' warning:', l))
+ s = modify_lines(s, lambda l: l.replace(' error:', ''))
+ s = modify_lines(s, lambda l: l.replace(' Warning:', ' warning:'))
# Remove a .exe extension (for Windows)
# and .wasm extension (for the Wasm backend)
# and .jsexe extension (for the JS backend)
@@ -3129,19 +3139,19 @@ def normalise_output( s: str ) -> str:
s = normalise_type_reps(s)
# ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is
# requires for -fPIC
- s = re.sub(' -fexternal-dynamic-refs\n','',s)
+ s = s.replace(' -fexternal-dynamic-refs\n', '')
s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
- s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s)
+ s = s.replace('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version', '')
# ignore superfluous dylibs passed to the linker.
- s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s)
+ s = drop_lines_containing(s, 'ignoring unexpected dylib file')
# ignore LLVM Version mismatch garbage; this will just break tests.
- s = re.sub('You are using an unsupported version of LLVM!.*\n','',s)
- s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s)
- s = re.sub('We will try though\\.\\.\\..*\n','',s)
+ s = drop_lines_containing(s, 'You are using an unsupported version of LLVM!')
+ s = drop_lines_containing(s, 'System LLVM version:')
+ s = drop_lines_containing(s, 'We will try though...')
# ignore warning about strip invalidating signatures
- s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s)
+ s = drop_lines_containing(s, 'strip: changes being made to the file will invalidate the code signature in')
# clang may warn about unused argument when used as assembler
- s = re.sub('.*warning: argument unused during compilation:.*\n', '', s)
+ s = drop_lines_containing(s, 'warning: argument unused during compilation:')
# strip the cross prefix if any
s = re.sub(r'\w+(-\w+)*-ghc', 'ghc', s)
=====================================
testsuite/driver/testutil.py
=====================================
@@ -40,6 +40,12 @@ def strip_quotes(s: str) -> str:
# Don't wrap commands to subprocess.call/Popen in quotes.
return s.strip('\'"')
+# Python 3.7 compatibility shim for str.removeprefix (added in Python 3.9).
+def str_removeprefix(s: str, prefix: str) -> str:
+ if s.startswith(prefix):
+ return s.replace(prefix, '', 1)
+ return s
+
def str_warn(s: str) -> str:
return colored(Color.YELLOW, s)
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -3293,6 +3293,7 @@ module GHC.Base where
{-# MINIMAL fmap #-}
type IO :: * -> *
newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
+ type role IP nominal representational
type IP :: Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -3293,6 +3293,7 @@ module GHC.Base where
{-# MINIMAL fmap #-}
type IO :: * -> *
newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
+ type role IP nominal representational
type IP :: Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -3293,6 +3293,7 @@ module GHC.Base where
{-# MINIMAL fmap #-}
type IO :: * -> *
newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
+ type role IP nominal representational
type IP :: Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -3293,6 +3293,7 @@ module GHC.Base where
{-# MINIMAL fmap #-}
type IO :: * -> *
newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
+ type role IP nominal representational
type IP :: Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/interface-stability/ghc-prim-exports.stdout
=====================================
@@ -1171,6 +1171,7 @@ module GHC.Classes where
(==) :: a -> a -> GHC.Internal.Types.Bool
(/=) :: a -> a -> GHC.Internal.Types.Bool
{-# MINIMAL (==) | (/=) #-}
+ type role IP nominal representational
type IP :: GHC.Internal.Types.Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
=====================================
@@ -1171,6 +1171,7 @@ module GHC.Classes where
(==) :: a -> a -> GHC.Internal.Types.Bool
(/=) :: a -> a -> GHC.Internal.Types.Bool
{-# MINIMAL (==) | (/=) #-}
+ type role IP nominal representational
type IP :: GHC.Internal.Types.Symbol -> * -> Constraint
class IP x a | x -> a where
ip :: a
=====================================
testsuite/tests/th/TH_implicitParams.stdout
=====================================
@@ -1,5 +1,5 @@
-Main.funcToReify :: GHC.Internal.Classes.IP "z"
- GHC.Internal.Types.Int =>
+Main.funcToReify :: GHC.Internal.Classes.IP.IP "z"
+ GHC.Internal.Types.Int =>
GHC.Internal.Types.Int
5
1
=====================================
testsuite/tests/typecheck/should_compile/T26737.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE ImpredicativeTypes, ImplicitParams #-}
+
+module T26737 where
+
+import Data.Coerce
+
+newtype Foo = MkFoo Int
+
+b :: ((?foo :: Foo) => Int) -> ((?foo :: Int) => Int)
+b = coerce @(((?foo :: Foo) => Int)) @(((?foo :: Int) => Int))
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -958,3 +958,4 @@ test('T14745', normal, compile, [''])
test('T26451', normal, compile, [''])
test('T26582', normal, compile, [''])
test('T26746', normal, compile, [''])
+test('T26737', normal, compile, [''])
=====================================
utils/ghc-toolchain/exe/Main.hs
=====================================
@@ -480,13 +480,8 @@ mkTarget opts = do
opt <- optional $ findProgram "opt" (optOpt opts) ["opt"]
llvmAs <- optional $ findProgram "llvm assembler" (optLlvmAs opts) ["clang"]
- -- Windows-specific utilities
- windres <-
- case archOS_OS archOs of
- OSMinGW32 -> do
- windres <- findProgram "windres" (optWindres opts) ["windres"]
- return (Just windres)
- _ -> return Nothing
+ -- for windows, also used for cross compiling
+ windres <- optional $ findProgram "windres" (optWindres opts) ["windres"]
-- Darwin-specific utilities
(otool, installNameTool) <-
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/814b833d04b068722b7b1ca7149960…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/814b833d04b068722b7b1ca7149960…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
20 Jan '26
Simon Peyton Jones pushed to branch wip/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC
Commits:
3f5a6599 by Simon Peyton Jones at 2026-01-20T23:30:57+00:00
Wibble
- - - - -
1 changed file:
- compiler/GHC/Core/SimpleOpt.hs
Changes:
=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -26,6 +26,7 @@ import GHC.Core.Subst
import GHC.Core.Utils
import GHC.Core.FVs
import GHC.Core.Unfold
+import GHC.Core.TyCo.Compare( eqTypeIgnoringMultiplicity )
import GHC.Core.Unfold.Make
import GHC.Core.Make ( FloatBind(..), mkWildValBinder )
import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm, zapLambdaBndrs )
@@ -215,11 +216,15 @@ simpleOptPgm opts this_mod binds rules =
----------------------
type SimpleClo = (SimpleOptEnv, InExpr)
-data SimpleContItem = ApplyToArg SimpleClo | CastIt OutCoercion
+data SimpleContItem
+ = ApplyToArg SimpleClo
+ | CastIt OutCoercion OutType
+ -- The OutType is the corecionRKind of the coercion
+ -- Used to make reflexivity checking more efficient
instance Outputable SimpleContItem where
ppr (ApplyToArg (_, arg)) = text "ARG" <+> ppr arg
- ppr (CastIt co) = text "CAST" <+> ppr co
+ ppr (CastIt co _) = text "CAST" <+> ppr co
data SimpleOptEnv
= SOE { soe_opts :: {-# UNPACK #-} !SimpleOpts
@@ -392,7 +397,7 @@ simple_app env e0@(Lam {}) as0@(_:_)
where (env', b') = subst_opt_bndr env b
-- See Note [Eliminate casts in function position]
- do_beta env e@(Lam b _) as@(CastIt out_co:rest)
+ do_beta env e@(Lam b _) as@(CastIt out_co _ : rest)
| isNonCoVarId b
-- Optimise the inner lambda to make it an 'OutExpr', which makes it
-- possible to call 'pushCoercionIntoLambda' with the 'OutCoercion' 'co'.
@@ -467,8 +472,11 @@ add_cast env co1 as
= as
| otherwise
= case as of
- CastIt co2:rest -> CastIt (co1' `mkTransCo` co2):rest
- _ -> CastIt co1':as
+ CastIt co2 ty2 : rest
+ | ty2 `eqTypeIgnoringMultiplicity` coercionLKind co1'
+ -> rest
+ | otherwise -> CastIt (co1' `mkTransCo` co2) ty2 : rest
+ _ -> CastIt co1' (coercionRKind co1') : as
where
co1' = simple_opt_co env co1
@@ -479,7 +487,7 @@ rebuild_app env fun args = foldl mk_app fun args
in_scope = soeInScope env
mk_app out_fun = \case
ApplyToArg arg -> App out_fun (simple_opt_clo in_scope arg)
- CastIt co -> mkCast out_fun co
+ CastIt co _ -> mkCast out_fun co
{- Note [Desugaring unlifted newtypes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f5a659933e23e9f876e5dad130fa38…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f5a659933e23e9f876e5dad130fa38…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: base: don't expose GHC.Num.{BigNat, Integer, Natural}
by Marge Bot (@marge-bot) 20 Jan '26
by Marge Bot (@marge-bot) 20 Jan '26
20 Jan '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
30f442a9 by Teo Camarasu at 2026-01-20T13:57:26-05:00
base: don't expose GHC.Num.{BigNat, Integer, Natural}
We no longer expose GHC.Num.{BigNat, Integer, Natural} from base instead users should get these modules from ghc-bignum.
We make this change to insulate end users from changes to GHC's implementation of big numbers.
Implements CLC proposal 359: https://github.com/haskell/core-libraries-committee/issues/359
- - - - -
75a9053d by Teo Camarasu at 2026-01-20T13:58:07-05:00
base: deprecate GHC internals in GHC.Num
Implements CLC proposal: https://github.com/haskell/core-libraries-committee/issues/360
- - - - -
9534b032 by Andreas Klebinger at 2026-01-20T13:58:50-05:00
ghc-experimental: Update Changelog
I tried to reconstruct a high level overview of the changes and when
they were made since we introduced it.
Fixes #26506
Co-authored-by: Teo Camarasu <teofilcamarasu(a)gmail.com>
- - - - -
346f2f5a by Cheng Shao at 2026-01-20T13:59:30-05:00
hadrian: remove RTS options in ghc-in-ghci flavour
This patch removes the RTS options passed to ghc in ghc-in-ghci
flavour, to workaround command line argument handling issue in
hls/hie-boot that results in `-O64M` instead of `+RTS -O64M -RTS`
being passed to ghc. It's not a hadrian bug per se, since ghc's own
ghc-in-ghci multi repl works fine, but we should still make sure HLS
works. Closes #26801.
- - - - -
4017d3d4 by Andreas Klebinger at 2026-01-20T14:32:17-05:00
Don't build GHC with -Wcompat
Without bumping the boot compiler the warnings it produces are often not
actionable leading to pointless noise.
Fixes #26800
- - - - -
0f662cd5 by Torsten Schmits at 2026-01-20T14:32:19-05:00
Use the correct field of ModOrigin when formatting error message listing hidden reexports
- - - - -
8f949346 by Simon Peyton Jones at 2026-01-20T14:32:20-05:00
Make the implicit-parameter class have representational role
This MR addresses #26737, by making the built-in class IP
have a representational role for its second parameter.
See Note [IP: implicit parameter class] in
ghc-internal:GHC.Internal.Classes.IP
In fact, IP is (unfortunately, currently) exposed by
base:GHC.Base, so we ran a quick CLC proposal to
agree the change:
https://github.com/haskell/core-libraries-committee/issues/385
Some (small) compilations get faster because they only need to
load (small) interface file GHC.Internal.Classes.IP.hi,
rather than (large) GHC.Internal.Classes.hi.
Metric Decrease:
T10421
T12150
T12425
T24582
T5837
T5030
- - - - -
814b833d by Cheng Shao at 2026-01-20T14:32:21-05:00
testsuite: avoid re.sub in favor of simple string replacements
This patch refactors the testsuite driver and avoids the usage of
re.sub in favor of simple string replacements when possible. The
changes are not comprehensive, and there are still a lot of re.sub
usages lingering around the tree, but this already addresses a major
performance bottleneck in the testsuite driver that might has to do
with quadratic or worse slowdown in cpython's regular expression
engine when handling certain regex patterns with large strings.
Especially on i386, and i386 jobs are the bottlenecks of all full-ci
validate pipelines!
Here are the elapsed times of testing x86_64/i386 with -j48 before
this patch:
x86_64: `Build completed in 6m06s`
i386: `Build completed in 1h36m`
And with this patch:
x86_64: `Build completed in 4m55s`
i386: `Build completed in 4m23s`
Fixes #26786.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
33 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Unit/State.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.16.1-notes.rst
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- libraries/base/src/Data/Array/Byte.hs
- libraries/base/src/GHC/Num.hs
- − libraries/base/src/GHC/Num/BigNat.hs
- − libraries/base/src/GHC/Num/Integer.hs
- − libraries/base/src/GHC/Num/Natural.hs
- libraries/base/src/System/CPUTime/Utils.hs
- libraries/ghc-bignum/ghc-bignum.cabal
- libraries/ghc-experimental/CHANGELOG.md
- libraries/ghc-experimental/ghc-experimental.cabal.in
- libraries/ghc-experimental/src/GHC/TypeNats/Experimental.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Classes.hs
- + libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs
- testsuite/driver/runtests.py
- testsuite/driver/testlib.py
- testsuite/driver/testutil.py
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- testsuite/tests/th/TH_implicitParams.stdout
- + testsuite/tests/typecheck/should_compile/T26737.hs
- testsuite/tests/typecheck/should_compile/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/058bd9dc164d1ab3fa41bfc330ba11…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/058bd9dc164d1ab3fa41bfc330ba11…
You're receiving this email because of your account on gitlab.haskell.org.
1
0