[Git][ghc/ghc][wip/teo/hugepages] rts: Implement support for 2MB hugepages
by Teo Camarasu (@teo) 20 Jul '26
by Teo Camarasu (@teo) 20 Jul '26
20 Jul '26
Teo Camarasu pushed to branch wip/teo/hugepages at Glasgow Haskell Compiler / GHC
Commits:
86a70824 by Teo Camarasu at 2026-07-20T17:56:40+01:00
rts: Implement support for 2MB hugepages
We enable/disable it through a runtime flag (-xH).
When enabled we ensure we only (de)allocate in aligned multiples of 2MB.
This is only available under x86_64 Linux.
It isn't available under wasm and i386.
Relates to #24760
Co-authored-by: Matthew Pickering <matthewtpickering(a)gmail.com>
Co-authored-by: Ben Gamari <bgamari.foss(a)gmail.com>
- - - - -
10 changed files:
- docs/users_guide/runtime_control.rst
- hadrian/src/Flavour.hs
- rts/RtsFlags.c
- rts/configure.ac
- rts/include/rts/Constants.h
- rts/include/rts/Flags.h
- rts/posix/OSMem.c
- rts/sm/OSMem.h
- testsuite/tests/rts/all.T
- + testsuite/tests/rts/testhugepagesmblockalloc.c
Changes:
=====================================
docs/users_guide/runtime_control.rst
=====================================
@@ -378,6 +378,16 @@ Miscellaneous RTS options
If given, instruct the runtime linker to try to continue linking in the
presence of an unresolved symbol.
+.. rts-flag:: -xH
+
+ This option enables using huge pages to back memory allocations.
+ Use of huge pages can make memory lookups more efficient for applications
+ with high memory usage.
+ Currently we only support 2MB hugepages on Linux.
+
+ If huge pages aren't available to back allocations, then we fall back to
+ regular pages.
+
.. _rts-options-gc:
RTS options to control the garbage collector
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -86,6 +86,7 @@ flavourTransformers = M.fromList
, "dump_stg" =: enableDumpStg
, "hash_unit_ids" =: enableHashUnitIds
, "hie_files" =: enableHieFiles
+ , "hugepages" =: enableHugepages
]
where (=:) = (,)
@@ -316,6 +317,14 @@ enableUBSan =
builder Testsuite ? arg "--config=have_ubsan=True"
]
+enableHugepages :: Flavour -> Flavour
+enableHugepages =
+ addArgs $
+ mconcat [package rts
+ ? builder (Cabal Setup)
+ ? arg "--configure-option=--enable-hugepages"
+ ]
+
-- | Use the LLVM backend in target stages
viaLlvmBackend :: Flavour -> Flavour
viaLlvmBackend = addArgs $ staged buildingForTarget ? builder Ghc ? arg "-fllvm"
=====================================
rts/RtsFlags.c
=====================================
@@ -182,6 +182,7 @@ void initRtsFlagsDefaults(void)
RtsFlags.GcFlags.allocLimitGrace = (100*1024) / BLOCK_SIZE;
RtsFlags.GcFlags.numa = false;
RtsFlags.GcFlags.numaMask = 1;
+ RtsFlags.GcFlags.hugepages = false;
RtsFlags.GcFlags.ringBell = false;
RtsFlags.GcFlags.longGCSync = 0; /* detection turned off */
@@ -572,7 +573,10 @@ usage_text[] = {
#endif
" -xq The allocation limit given to a thread after it receives",
" an AllocationLimitExceeded exception. (default: 100k)",
+#if defined(HUGEPAGE_FLAGS)
+" -xH Try to use hugepages to allocate memory.",
"",
+#endif
#if defined(USE_LARGE_ADDRESS_SPACE)
" -xr The size of virtual memory address space reserved by the",
" two step allocator (default: 1T)",
@@ -1850,11 +1854,11 @@ error = true;
*/
case 'q':
- OPTION_UNSAFE;
- RtsFlags.GcFlags.allocLimitGrace
- = decodeSize(rts_argv[arg], 3, BLOCK_SIZE, HS_INT_MAX)
- / BLOCK_SIZE;
- break;
+ OPTION_UNSAFE;
+ RtsFlags.GcFlags.allocLimitGrace
+ = decodeSize(rts_argv[arg], 3, BLOCK_SIZE, HS_INT_MAX)
+ / BLOCK_SIZE;
+ break;
case 'r':
OPTION_UNSAFE;
@@ -1862,7 +1866,16 @@ error = true;
= decodeSize(rts_argv[arg], 3, MBLOCK_SIZE, HS_WORD64_MAX);
break;
- default:
+ case 'H':
+ OPTION_UNSAFE;
+#if defined(HUGEPAGE_FLAGS)
+ RtsFlags.GcFlags.hugepages = true;
+#else
+ errorBelch("Program not compiled with hugepages support.");
+#endif
+ break;
+
+ default:
OPTION_SAFE;
errorBelch("unknown RTS option: %s",rts_argv[arg]);
error = true;
=====================================
rts/configure.ac
=====================================
@@ -37,6 +37,17 @@ if test "$enable_asserts_all_ways" = "yes" ; then
AC_DEFINE([USE_ASSERTS_ALL_WAYS], [1], [Compile-in ASSERTs in all ways.])
fi
+AC_ARG_ENABLE(hugepages,
+[AS_HELP_STRING([--enable-hugepages],
+ [Enable hugepages and set the MBlock size to 2MB.])],
+ [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableHugepages])],
+ [EnableHugepages=NO]
+)
+if test "$enable_hugepages" = "yes" ; then
+ AC_DEFINE([USE_HUGEPAGES], [1], [Enable support for hugepages and set MBlock size to 2MB.])
+fi
+
+
# We have to run these unconditionally, but we may discard their
# results in the following code
AC_CANONICAL_BUILD
@@ -96,7 +107,7 @@ dnl off_t, because it will affect the result of that test.
AC_SYS_LARGEFILE
dnl ** check for specific header (.h) files that we are interested in
-AC_CHECK_HEADERS([ctype.h dlfcn.h errno.h fcntl.h limits.h locale.h nlist.h pthread.h signal.h sys/param.h sys/mman.h sys/resource.h sys/select.h sys/time.h sys/timeb.h sys/timerfd.h sys/timers.h sys/times.h sys/utsname.h sys/wait.h termios.h utime.h windows.h winsock.h sched.h])
+AC_CHECK_HEADERS([ctype.h dlfcn.h errno.h fcntl.h limits.h locale.h nlist.h pthread.h signal.h sys/param.h sys/mman.h linux/mman.h sys/resource.h sys/select.h sys/time.h sys/timeb.h sys/timerfd.h sys/timers.h sys/times.h sys/utsname.h sys/wait.h termios.h utime.h windows.h winsock.h sched.h])
dnl sys/cpuset.h needs sys/param.h to be included first on FreeBSD 9.1; #7708
AC_CHECK_HEADERS([sys/cpuset.h], [], [],
=====================================
rts/include/rts/Constants.h
=====================================
@@ -171,6 +171,8 @@
/* The size of a megablock (2^MBLOCK_SHIFT bytes) */
#if defined(wasm32_HOST_ARCH)
#define MBLOCK_SHIFT 16
+#elif defined(USE_HUGEPAGES)
+#define MBLOCK_SHIFT 21
#else
#define MBLOCK_SHIFT 20
#endif
=====================================
rts/include/rts/Flags.h
=====================================
@@ -91,6 +91,7 @@ typedef struct _GC_FLAGS {
StgWord numaMask;
StgWord64 addressSpaceSize; /* large address space size in bytes */
+ bool hugepages; /* Enable hugepages support */
} GC_FLAGS;
/* See Note [Synchronization of flags and base APIs] */
=====================================
rts/posix/OSMem.c
=====================================
@@ -73,6 +73,11 @@
# endif
#endif
+#if defined(HUGEPAGE_FLAGS)
+static int huge_tried = 0;
+static int huge_failed = 0;
+#endif
+
static void *next_request = 0;
void osMemInit(void)
@@ -233,12 +238,28 @@ my_mmap (void *addr, W_ size, int operation)
errorBelch("my_mmap(,,MEM_RESERVE) not supported on this platform");
# endif
} else if (operation == MEM_COMMIT) {
- flags = MAP_FIXED | MAP_ANON | MAP_PRIVATE;
+ flags = MAP_FIXED | MAP_ANONYMOUS | MAP_PRIVATE;
+#if defined(HUGEPAGE_FLAGS)
+ if ( RtsFlags.GcFlags.hugepages &&
+ (size & (HUGEPAGE_SIZE - 1)) == 0) {
+ huge_tried += 1;
+ flags |= HUGEPAGE_FLAGS;
+ }
+#endif /* defined(HUGEPAGE_FLAGS) */
} else {
flags = MAP_ANON | MAP_PRIVATE;
}
ret = mmap(addr, size, prot, flags, -1, 0);
+#if defined(HUGEPAGE_FLAGS)
+ // If the mmap failed, and we tried with HUGEPAGE_FLAGS
+ // then retry without.
+ if (ret == MAP_FAILED && flags & HUGEPAGE_FLAGS){
+ huge_failed += 1;
+ flags &= ~HUGEPAGE_FLAGS;
+ ret = mmap(addr, size, prot, flags, -1, 0);
+ }
+#endif
# if defined(linux_HOST_OS)
if (ret == MAP_FAILED && errno == EPERM) {
// Linux may return EPERM if it tried to give us
=====================================
rts/sm/OSMem.h
=====================================
@@ -8,6 +8,12 @@
#pragma once
+#if defined(HAVE_LINUX_MMAN_H) && defined(USE_HUGEPAGES)
+#include <linux/mman.h>
+#define HUGEPAGE_FLAGS (MAP_HUGETLB | MAP_HUGE_2MB)
+#define HUGEPAGE_SIZE MBLOCK_SIZE
+#endif
+
#include "BeginPrivate.h"
void osMemInit(void);
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -15,6 +15,15 @@ test('testmblockalloc',
# which will crash because the mblocks we allocate are not in a state
# the leak detector is expecting.
+# A variant of the above that tries to use hugepages
+test('testhugepagesmblockalloc',
+ [c_src, only_ways(['normal','threaded1']), extra_run_opts('+RTS -I0 -xr0.125T -xH'),
+ unless(opsys('linux'), skip), # Huge pages are only currently supported on Linux
+ when(arch('wasm32'), skip), # MBlocks can't be freed on wasm32, see Note [Megablock allocator on wasm] in rts
+ when(arch('i386'), skip), # Not available under i386
+ ],
+ compile_and_run, [''])
+
# See bug #101, test requires +RTS -c (or equivalently +RTS -M<something>)
# only GHCi triggers the bug, but we run the test all ways for completeness.
=====================================
testsuite/tests/rts/testhugepagesmblockalloc.c
=====================================
@@ -0,0 +1,75 @@
+#include "Rts.h"
+
+#include <stdio.h>
+
+// 16 * 64 == max 1GB
+const int MAXALLOC = 16;
+const int ARRSIZE = 64;
+
+const int LOOPS = 1000;
+const int SEED = 0xf00f00;
+
+extern StgWord mblocks_allocated;
+
+int main (int argc, char *argv[])
+{
+ int i, j, b;
+
+ void *a[ARRSIZE];
+ uint32_t sizes[ARRSIZE];
+
+ srand(SEED);
+
+ {
+ RtsConfig conf = defaultRtsConfig;
+ conf.rts_opts_enabled = RtsOptsAll;
+ hs_init_ghc(&argc, &argv, conf);
+ }
+
+ // repeatedly sweep though the array, allocating new random-sized
+ // objects and deallocating the old ones.
+ for (i=0; i < LOOPS; i++)
+ {
+ for (j=0; j < ARRSIZE; j++)
+ {
+ if (i > 0)
+ {
+ freeMBlocks(a[j], sizes[j]);
+ }
+ b = (rand() % MAXALLOC) + 1;
+ a[j] = getMBlocks(b);
+ sizes[j] = b;
+ }
+ }
+
+ releaseFreeMemory();
+
+ for (j=0; j < ARRSIZE; j++)
+ {
+ freeMBlocks(a[j], sizes[j]);
+ }
+
+ releaseFreeMemory();
+
+ // this time, sweep forwards allocating new blocks, and then
+ // backwards deallocating them.
+ for (i=0; i < LOOPS; i++)
+ {
+ for (j=0; j < ARRSIZE; j++)
+ {
+ b = (rand() % MAXALLOC) + 1;
+ a[j] = getMBlocks(b);
+ sizes[j] = b;
+ }
+ for (j=ARRSIZE-1; j >= 0; j--)
+ {
+ freeMBlocks(a[j], sizes[j]);
+ }
+ }
+
+ releaseFreeMemory();
+
+ hs_exit(); // will do a memory leak test
+
+ exit(0);
+}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86a70824fa5e1ebf032e256f7bde0da…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86a70824fa5e1ebf032e256f7bde0da…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
Teo Camarasu pushed new branch wip/teo/hugepages at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/teo/hugepages
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/fendor/external-unit-db-cache] 2 commits: Introduce global unit database cache
by Hannes Siebenhandl (@fendor) 20 Jul '26
by Hannes Siebenhandl (@fendor) 20 Jul '26
20 Jul '26
Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC
Commits:
5ac5416a by fendor at 2026-07-20T17:08:51+02:00
Introduce global unit database cache
As a first step for better sharing of `UnitInfo` across `UnitEnv`,
we introduce a new datatype called `ExternalUnitDatabases`.
It primarily serves as an in-memory representation of *all*
`UnitDatabase`s across `UnitEnv`. This means, if multiple `HomeUnitEnv`s
depend on the same database, one way or another, we make sure that we
don't parse from disk every time.
Instead, we store the in-memory representation in `ExternalUnitDatabases`.
`ExternalUnitDatabaseCache` is the equivalent of `ExternalUnitState` in
the `UnitEnv`. It is a mutable variable wrapping `ExternalUnitDatabases`.
The mutable `ExternalUnitDatabaseCache` is used in `initUnits` to make
sure we don't parse the same unit database multiple times.
Almost by accident, we change the semantics of `initUnits` to honour
modifications to `packageDBFlags`.
The inability to change `packageDBFlags` while also reusing the already
parsed `UnitDatabase`s was reported in #26423 as a bug.
Hence, we think this behaviour change is warranted and acceptable,
especially since it comes with a breaking change to the `initUnits` API.
Add regression test for #26423
Closes #26423
- - - - -
0643509a by fendor at 2026-07-20T17:08:51+02:00
Introduce UnitIndex for global external unit caching
`UnitInfo`s have been observed to cause a lot of memory usage in #27500.
Especially with multiple home units, as the same (external) units are
processed from scratch, even though most of the time we end up with
exactly the same `UnitInfo`.
We introduce a `UnitEnv` global cache that allows us to store external
unit information that is used across all `HomeUnitEnv`s.
The most important change in this commit is the introduction of the `UnitIndex`.
It stores a global mapping of `UnitId` -> `UnitInfo`, and `initUnits`
always uses the cached `UnitInfo` entry to populate each
`HomeUnitEnv`'s `UnitState`.
This allows us to ensure the following property:
> Each `UnitInfo` should be alive exactly once in GHC.
In addition, the `ExternalUnitDatabaseCache` may also hold a reference
to each on-disk representation of `UnitInfo`.
This means, we impose an hard upper bound on the number of `UnitInfo`s
alive in the GHC session:
> The number of alive `UnitInfo`s closure objects must be the
> sum of all loaded unit database times two.
We add performance regression tests that make sure the number of live
`UnitInfo` cannot exceed this threshold.
Closes #27500
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
mhu-perf
-------------------------
These metrics increases are especially notable, as we are not even
sharing anything big but merely the global package database with 50
entries.
It shows how careful sharing of `UnitInfo` can improve memory usage.
We expect this to be much more notable when the whole cabal package
database is shared across multiple home units.
---
Technical details
To share the `UnitInfo`s correctly, it is important that we extract
the `WireMap` into the `UnitIndex`. At the moment of writing, `WireMap`
must be globally the same for all `HomeUnitEnv`s.
This is important, as we could otherwise not cache the "fully-resolved"
`UnitInfo`.
We consider a `UnitInfo` fully-resolved, if wired-in units have been
updated, the `UnitInfo` has been validated and variables in the unit
config, such as `${pkgroot}` have been resolved.
Updating the wired-in units requires the `WireMap` to be globally the
same.
- - - - -
43 changed files:
- + changelog.d/T26423
- + changelog.d/unit-index
- compiler/GHC.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Main/Hsc.hs
- compiler/GHC/Driver/Main/Interactive.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/Driver/Session/Units.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Unit/Env.hs
- + compiler/GHC/Unit/External/Database.hs
- + compiler/GHC/Unit/External/Index.hs
- + compiler/GHC/Unit/External/ModuleOrigin.hs
- + compiler/GHC/Unit/External/Providers.hs
- + compiler/GHC/Unit/External/Query.hs
- + compiler/GHC/Unit/External/Substitution.hs
- + compiler/GHC/Unit/External/Validate.hs
- + compiler/GHC/Unit/External/Visibility.hs
- + compiler/GHC/Unit/External/Wired.hs
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/Info.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Unit/State.hs-boot
- compiler/GHC/Unit/Types.hs
- compiler/ghc.cabal.in
- ghc/GHCi/UI.hs
- hadrian/src/Rules/Generate.hs
- testsuite/tests/count-deps/CountDepsParser.stdout
- + testsuite/tests/driver/T26423/Hello.hs
- + testsuite/tests/driver/T26423/Makefile
- + testsuite/tests/driver/T26423/T26423.hs
- + testsuite/tests/driver/T26423/T26423.stderr
- + testsuite/tests/driver/T26423/T26423.stdout
- + testsuite/tests/driver/T26423/all.T
- + testsuite/tests/driver/T26423/test/Test.hs
- + testsuite/tests/driver/T26423/test/test.pkg
- + testsuite/tests/driver/TUnitInfo/Foo.hs
- + testsuite/tests/driver/TUnitInfo/Makefile
- + testsuite/tests/driver/TUnitInfo/all.T
- + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.hs
- + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.stdout
- utils/haddock/haddock-api/src/Haddock.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/445612251c72b6debac1e020780514…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/445612251c72b6debac1e020780514…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/fendor/external-unit-db-cache] 2 commits: Introduce global unit database cache
by Hannes Siebenhandl (@fendor) 20 Jul '26
by Hannes Siebenhandl (@fendor) 20 Jul '26
20 Jul '26
Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC
Commits:
fc027554 by fendor at 2026-07-20T17:02:42+02:00
Introduce global unit database cache
As a first step for better sharing of `UnitInfo` across `UnitEnv`,
we introduce a new datatype called `ExternalUnitDatabases`.
It primarily serves as an in-memory representation of *all*
`UnitDatabase`s across `UnitEnv`. This means, if multiple `HomeUnitEnv`s
depend on the same database, one way or another, we make sure that we
don't parse from disk every time.
Instead, we store the in-memory representation in `ExternalUnitDatabases`.
`ExternalUnitDatabaseCache` is the equivalent of `ExternalUnitState` in
the `UnitEnv`. It is a mutable variable wrapping `ExternalUnitDatabases`.
The mutable `ExternalUnitDatabaseCache` is used in `initUnits` to make
sure we don't parse the same unit database multiple times.
Almost by accident, we change the semantics of `initUnits` to honour
modifications to `packageDBFlags`.
The inability to change `packageDBFlags` while also reusing the already
parsed `UnitDatabase`s was reported in #26423 as a bug.
Hence, we think this behaviour change is warranted and acceptable,
especially since it comes with a breaking change to the `initUnits` API.
Add regression test for #26423
Closes #26423
- - - - -
44561225 by fendor at 2026-07-20T17:03:02+02:00
Introduce UnitIndex for global external unit caching
`UnitInfo`s have been observed to cause a lot of memory usage in #27500.
Especially with multiple home units, as the same (external) units are
processed from scratch, even though most of the time we end up with
exactly the same `UnitInfo`.
We introduce a `UnitEnv` global cache that allows us to store external
unit information that is used across all `HomeUnitEnv`s.
The most important change in this commit is the introduction of the `UnitIndex`.
It stores a global mapping of `UnitId` -> `UnitInfo`, and `initUnits`
always uses the cached `UnitInfo` entry to populate each
`HomeUnitEnv`'s `UnitState`.
This allows us to ensure the following property:
> Each `UnitInfo` should be alive exactly once in GHC.
In addition, the `ExternalUnitDatabaseCache` may also hold a reference
to each on-disk representation of `UnitInfo`.
This means, we impose an hard upper bound on the number of `UnitInfo`s
alive in the GHC session:
> The number of alive `UnitInfo`s closure objects must be the
> sum of all loaded unit database times two.
We add performance regression tests that make sure the number of live
`UnitInfo` cannot exceed this threshold.
Closes #27500
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
mhu-perf
-------------------------
These metrics increases are especially notable, as we are not even
sharing anything big but merely the global package database with 50
entries.
It shows how careful sharing of `UnitInfo` can improve memory usage.
We expect this to be much more notable when the whole cabal package
database is shared across multiple home units.
---
Technical details
To share the `UnitInfo`s correctly, it is important that we extract
the `WireMap` into the `UnitIndex`. At the moment of writing, `WireMap`
must be globally the same for all `HomeUnitEnv`s.
This is important, as we could otherwise not cache the "fully-resolved"
`UnitInfo`.
We consider a `UnitInfo` fully-resolved, if wired-in units have been
updated, the `UnitInfo` has been validated and variables in the unit
config, such as `${pkgroot}` have been resolved.
Updating the wired-in units requires the `WireMap` to be globally the
same.
- - - - -
42 changed files:
- + changelog.d/unit-index
- compiler/GHC.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Main/Hsc.hs
- compiler/GHC/Driver/Main/Interactive.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/Driver/Session/Units.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Unit/Env.hs
- + compiler/GHC/Unit/External/Database.hs
- + compiler/GHC/Unit/External/Index.hs
- + compiler/GHC/Unit/External/ModuleOrigin.hs
- + compiler/GHC/Unit/External/Providers.hs
- + compiler/GHC/Unit/External/Query.hs
- + compiler/GHC/Unit/External/Substitution.hs
- + compiler/GHC/Unit/External/Validate.hs
- + compiler/GHC/Unit/External/Visibility.hs
- + compiler/GHC/Unit/External/Wired.hs
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/Info.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Unit/State.hs-boot
- compiler/GHC/Unit/Types.hs
- compiler/ghc.cabal.in
- ghc/GHCi/UI.hs
- hadrian/src/Rules/Generate.hs
- testsuite/tests/count-deps/CountDepsParser.stdout
- + testsuite/tests/driver/T26423/Hello.hs
- + testsuite/tests/driver/T26423/Makefile
- + testsuite/tests/driver/T26423/T26423.hs
- + testsuite/tests/driver/T26423/T26423.stderr
- + testsuite/tests/driver/T26423/T26423.stdout
- + testsuite/tests/driver/T26423/all.T
- + testsuite/tests/driver/T26423/test/Test.hs
- + testsuite/tests/driver/T26423/test/test.pkg
- + testsuite/tests/driver/TUnitInfo/Foo.hs
- + testsuite/tests/driver/TUnitInfo/Makefile
- + testsuite/tests/driver/TUnitInfo/all.T
- + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.hs
- + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.stdout
- utils/haddock/haddock-api/src/Haddock.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7edaebec7e6d1499090f74ca7d0953…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7edaebec7e6d1499090f74ca7d0953…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/TTG-No-Orphans] First pass of orphan instance removal.
by recursion-ninja (@recursion-ninja) 20 Jul '26
by recursion-ninja (@recursion-ninja) 20 Jul '26
20 Jul '26
recursion-ninja pushed to branch wip/TTG-No-Orphans at Glasgow Haskell Compiler / GHC
Commits:
676256b2 by Recursion Ninja at 2026-07-20T10:50:18-04:00
First pass of orphan instance removal.
This is part of a technical debt removal effort made possible
now that seperating out the AST via TTG comes to a close.
As the AST in 'L.H.S' has been incrementally separated from the GHC internals,
there are many accumulated orphan instance of 'Binary', 'Outputable', 'Uniquable', etc.
The orphan instance of data-types from within 'L.H.S' are having thier orphan
instances moved to the module which defined the type-class; i.e. moving an orphan
'Binary' instance to 'GHC.Utils.Binary'.
Orphan instances resolved (37):
| Data-type | Resolved instance(s) | Former orphan module(s) |
| -------------------- | -------------------------- | ------------------------- |
| Role | Binary, NFData, Outputable | GHC.Core.Coercion.Axiom |
| SrcStrictness | Binary, NFData, Outputable | GHC.Core.DataCon |
| SrcUnpackedness | Binary, NFData, Outputable | GHC.Core.DataCon |
| Fixity | Binary, Outputable | GHC.Hs.Basic |
| FixityDirection | Binary, Outputable | GHC.Hs.Basic |
| LexicalFixity | Outputable | GHC.Hs.Basic |
| CCallTarget | NFData | GHC.Hs.Decls.Foreign |
| CType | NFData | GHC.Hs.Decls.Foreign |
| Header | NFData | GHC.Hs.Decls.Foreign |
| OverlapMode | Binary, NFData | GHC.Hs.Decls.Overlap |
| WithHsDocIdentifiers | NFData, Outputable | GHC.Hs.Doc |
| HsDocString | NFData | GHC.Hs.DocString |
| HsDocStringChunk | Binary, Outputable | GHC.Hs.DocString |
| HsDocStringDecorator | Binary, Outputable | GHC.Hs.DocString |
| NamespaceSpecifier | Outputable | GHC.Hs.ImpExp |
| ForAllTyFlag | Binary, NFData, Outputable | GHC.Hs.Specificity |
| Specificity | Binary, NFData | GHC.Hs.Specificity |
| PromotionFlag | Binary, Outputable | GHC.Types.Basic |
| FieldLabelString | Outputable, Uniquable | GHC.Types.FieldLabel |
| InlinePragma | Binary | GHC.Types.InlinePragma |
-------------------------
Metric Decrease:
hard_hole_fits
-------------------------
Closes #21262, #27469
- - - - -
26 changed files:
- compiler/GHC/Core/Coercion/Axiom.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Hs/Basic.hs
- compiler/GHC/Hs/Decls/Overlap.hs
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/Hs/DocString.hs
- compiler/GHC/Hs/ImpExp.hs
- − compiler/GHC/Hs/Specificity.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/FieldLabel.hs
- compiler/GHC/Types/Fixity.hs
- compiler/GHC/Types/ForeignCall.hs
- compiler/GHC/Types/InlinePragma.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/Basic.hs
- compiler/Language/Haskell/Syntax/Decls/Foreign.hs
- compiler/Language/Haskell/Syntax/Doc.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/ImpExp.hs
- compiler/Language/Haskell/Syntax/Specificity.hs
- compiler/ghc.cabal.in
- testsuite/tests/count-deps/CountDepsParser.stdout
Changes:
=====================================
compiler/GHC/Core/Coercion/Axiom.hs
=====================================
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable
-
-- (c) The University of Glasgow 2012
-- | Module for coercion axioms, used to represent type family instances
@@ -22,7 +20,7 @@ module GHC.Core.Coercion.Axiom (
coAxBranchLHS, coAxBranchRHS, coAxBranchSpan, coAxBranchIncomps,
placeHolderIncomps,
- Role(..), fsFromRole,
+ Role(..),
CoAxiomRule(..), BuiltInFamRewrite(..), BuiltInFamInjectivity(..), TypeEqn,
coAxiomRuleArgRoles, coAxiomRuleRole,
@@ -43,7 +41,6 @@ import GHC.Types.Name
import GHC.Types.Unique
import GHC.Types.Var
import GHC.Utils.Misc
-import GHC.Utils.Binary
import GHC.Utils.Panic
import GHC.Data.Pair
import GHC.Types.Basic
@@ -52,7 +49,6 @@ import GHC.Types.SrcLoc
import qualified Data.Data as Data
import Data.Array
import Data.List ( mapAccumL )
-import Control.DeepSeq
{-
Note [Coercion axiom branches]
@@ -521,44 +517,6 @@ instance Outputable CoAxBranch where
, ppUnless (null incomps) $
text "incomps:" <+> vcat (map ppr incomps) ])
-{-
-************************************************************************
-* *
- Roles
-* *
-************************************************************************
-
-Roles are defined here to avoid circular dependencies.
--}
-
--- These names are slurped into the parser code. Changing these strings
--- will change the **surface syntax** that GHC accepts! If you want to
--- change only the pretty-printing, do some replumbing. See
--- mkRoleAnnotDecl in GHC.Parser.PostProcess
-fsFromRole :: Role -> FastString
-fsFromRole Nominal = fsLit "nominal"
-fsFromRole Representational = fsLit "representational"
-fsFromRole Phantom = fsLit "phantom"
-
-instance Outputable Role where
- ppr = ftext . fsFromRole
-
-instance Binary Role where
- put_ bh Nominal = putByte bh 1
- put_ bh Representational = putByte bh 2
- put_ bh Phantom = putByte bh 3
-
- get bh = do tag <- getByte bh
- case tag of 1 -> return Nominal
- 2 -> return Representational
- 3 -> return Phantom
- _ -> panic ("get Role " ++ show tag)
-
-instance NFData Role where
- rnf Nominal = ()
- rnf Representational = ()
- rnf Phantom = ()
-
{-
************************************************************************
* *
=====================================
compiler/GHC/Core/DataCon.hs
=====================================
@@ -5,8 +5,6 @@
\section[DataCon]{@DataCon@: Data Constructors}
-}
-{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable, Binary
-
module GHC.Core.DataCon (
-- * Main data types
DataCon, DataConRep(..),
@@ -109,7 +107,6 @@ import qualified Data.ByteString.Lazy as LBS
import qualified Data.Data as Data
import Data.Char
import Data.List( find )
-import Control.DeepSeq
{-
Note [Data constructor representation]
@@ -1030,16 +1027,6 @@ instance Outputable HsImplBang where
ppr (HsUnpack (Just co)) = text "Unpacked" <> parens (ppr co)
ppr (HsStrict b) = text "StrictNotUnpacked" <> parens (ppr b)
-instance Outputable SrcStrictness where
- ppr SrcLazy = char '~'
- ppr SrcStrict = char '!'
- ppr NoSrcStrict = empty
-
-instance Outputable SrcUnpackedness where
- ppr SrcUnpack = text "{-# UNPACK #-}"
- ppr SrcNoUnpack = text "{-# NOUNPACK #-}"
- ppr NoSrcUnpack = empty
-
instance Outputable StrictnessMark where
ppr MarkedStrict = text "!"
ppr NotMarkedStrict = empty
@@ -1054,40 +1041,6 @@ instance Binary StrictnessMark where
1 -> return MarkedStrict
_ -> panic "Invalid binary format"
-instance Binary SrcStrictness where
- put_ bh SrcLazy = putByte bh 0
- put_ bh SrcStrict = putByte bh 1
- put_ bh NoSrcStrict = putByte bh 2
-
- get bh =
- do h <- getByte bh
- case h of
- 0 -> return SrcLazy
- 1 -> return SrcStrict
- _ -> return NoSrcStrict
-
-instance Binary SrcUnpackedness where
- put_ bh SrcNoUnpack = putByte bh 0
- put_ bh SrcUnpack = putByte bh 1
- put_ bh NoSrcUnpack = putByte bh 2
-
- get bh =
- do h <- getByte bh
- case h of
- 0 -> return SrcNoUnpack
- 1 -> return SrcUnpack
- _ -> return NoSrcUnpack
-
-instance NFData SrcStrictness where
- rnf SrcLazy = ()
- rnf SrcStrict = ()
- rnf NoSrcStrict = ()
-
-instance NFData SrcUnpackedness where
- rnf SrcNoUnpack = ()
- rnf SrcUnpack = ()
- rnf NoSrcUnpack = ()
-
-- | Compare strictness annotations
eqHsBang :: HsImplBang -> HsImplBang -> Bool
eqHsBang HsLazy HsLazy = True
=====================================
compiler/GHC/Hs/Basic.hs
=====================================
@@ -1,52 +1,6 @@
-{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable, Binary
-{-# LANGUAGE TypeFamilies #-}
-
-- | Fixity
module GHC.Hs.Basic
( module Language.Haskell.Syntax.Basic
) where
-import GHC.Prelude
-
-import GHC.Utils.Outputable
-import GHC.Utils.Binary
-
import Language.Haskell.Syntax.Basic
-
-instance Outputable LexicalFixity where
- ppr Prefix = text "Prefix"
- ppr Infix = text "Infix"
-
-instance Outputable FixityDirection where
- ppr InfixL = text "infixl"
- ppr InfixR = text "infixr"
- ppr InfixN = text "infix"
-
-instance Outputable Fixity where
- ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
-
-
-instance Binary Fixity where
- put_ bh (Fixity aa ab) = do
- put_ bh aa
- put_ bh ab
- get bh = do
- aa <- get bh
- ab <- get bh
- return (Fixity aa ab)
-
-------------------------
-
-instance Binary FixityDirection where
- put_ bh InfixL =
- putByte bh 0
- put_ bh InfixR =
- putByte bh 1
- put_ bh InfixN =
- putByte bh 2
- get bh = do
- h <- getByte bh
- case h of
- 0 -> return InfixL
- 1 -> return InfixR
- _ -> return InfixN
=====================================
compiler/GHC/Hs/Decls/Overlap.hs
=====================================
@@ -1,12 +1,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} -- XOverlapMode, XXOverlapMode
-
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{- Necessary for the following instances:
- * (type class): Binary OverlapMode
- * (type class): NFData OverlapMode
--}
+{-# OPTIONS_GHC -fno-warn-orphans #-} -- XOverlapMode, XXOverlapMode
{- |
Data-types describing the overlap annotations for instances as well as
@@ -74,34 +69,6 @@ type instance XOverlapMode (GhcPass _) = SourceText
type instance XXOverlapMode (GhcPass _) = DataConCantHappen
-instance NFData (OverlapMode (GhcPass p)) where
- rnf = \case
- NoOverlap s -> rnf s
- Overlappable s -> rnf s
- Overlapping s -> rnf s
- Overlaps s -> rnf s
- Incoherent s -> rnf s
- NonCanonical s -> rnf s
-
-instance Binary (OverlapMode (GhcPass p)) where
- put_ bh = \case
- NoOverlap s -> putByte bh 0 >> put_ bh s
- Overlaps s -> putByte bh 1 >> put_ bh s
- Incoherent s -> putByte bh 2 >> put_ bh s
- Overlapping s -> putByte bh 3 >> put_ bh s
- Overlappable s -> putByte bh 4 >> put_ bh s
- NonCanonical s -> putByte bh 5 >> put_ bh s
-
- get bh = do
- h <- getByte bh
- case h of
- 0 -> get bh >>= \s -> return $ NoOverlap s
- 1 -> get bh >>= \s -> return $ Overlaps s
- 2 -> get bh >>= \s -> return $ Incoherent s
- 3 -> get bh >>= \s -> return $ Overlapping s
- 4 -> get bh >>= \s -> return $ Overlappable s
- _ -> get bh >>= \s -> return $ NonCanonical s
-
pprSafeOverlap :: Bool -> SDoc
pprSafeOverlap True = text "[safe]"
pprSafeOverlap False = empty
=====================================
compiler/GHC/Hs/Doc.hs
=====================================
@@ -63,16 +63,6 @@ type instance Anno (WithHsDocIdentifiers (HsDocString (GhcPass pass)) (GhcPass p
deriving instance (Data pass, Data (LIdP pass), Data a) => Data (WithHsDocIdentifiers a pass)
deriving instance (Eq (LIdP pass), Eq a) => Eq (WithHsDocIdentifiers a pass)
-instance (UnXRec pass, NFData (IdP pass), NFData a) => NFData (WithHsDocIdentifiers a pass) where
- rnf (WithHsDocIdentifiers d i) = rnf d `seq` rnf (map (unXRec @pass) i)
-
--- | For compatibility with the existing @-ddump-parsed' output, we only show
--- the docstring.
---
--- Use 'pprHsDoc' to show `HsDoc`'s internals.
-instance Outputable a => Outputable (WithHsDocIdentifiers a pass) where
- ppr (WithHsDocIdentifiers s _ids) = ppr s
-
instance Binary a => Binary (WithHsDocIdentifiers a GhcRn) where
put_ bh (WithHsDocIdentifiers s ids) = do
put_ bh s
=====================================
compiler/GHC/Hs/DocString.hs
=====================================
@@ -5,6 +5,8 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
+-- Binary HsDocString
+-- Outputable HsDocString
module GHC.Hs.DocString
( LHsDocString
@@ -44,7 +46,6 @@ import GHC.Hs.Extension.Pass (GhcPass, GhcPs, GhcRn, GhcTc)
import Language.Haskell.Syntax.Doc
import Language.Haskell.Syntax.Extension
-import Control.DeepSeq
import Data.Data
import Data.List.NonEmpty (NonEmpty(..))
import Data.List (intercalate)
@@ -82,11 +83,6 @@ instance (Show (LHsDocStringChunk pass), XXHsDocString pass ~ DataConCantHappen)
instance Outputable (HsDocString (GhcPass p)) where
ppr = text . renderHsDocString
-instance NFData (HsDocString (GhcPass p)) where
- rnf (MultiLineDocString _ a b) = rnf a `seq` rnf b
- rnf (NestedDocString _ a b) = rnf a `seq` rnf b
- rnf (GeneratedDocString _ a) = rnf a
-
-- | Annotate a pretty printed thing with its doc.
-- The docstring comes after if it is 'HsDocStringPrevious'.
-- Otherwise it comes before.
@@ -120,37 +116,12 @@ instance Binary (HsDocString (GhcPass p)) where
2 -> GeneratedDocString noExtField <$> get bh
t -> fail $ "HsDocString: invalid tag " ++ show t
-instance Outputable HsDocStringDecorator where
- ppr = text . printDecorator
-
printDecorator :: HsDocStringDecorator -> String
printDecorator HsDocStringNext = "|"
printDecorator HsDocStringPrevious = "^"
printDecorator (HsDocStringNamed n) = '$':n
printDecorator (HsDocStringGroup n) = replicate n '*'
-instance Binary HsDocStringDecorator where
- put_ bh x = case x of
- HsDocStringNext -> putByte bh 0
- HsDocStringPrevious -> putByte bh 1
- HsDocStringNamed n -> putByte bh 2 >> put_ bh n
- HsDocStringGroup n -> putByte bh 3 >> put_ bh n
- get bh = do
- tag <- getByte bh
- case tag of
- 0 -> pure HsDocStringNext
- 1 -> pure HsDocStringPrevious
- 2 -> HsDocStringNamed <$> get bh
- 3 -> HsDocStringGroup <$> get bh
- t -> fail $ "HsDocStringDecorator: invalid tag " ++ show t
-
-instance Binary HsDocStringChunk where
- put_ bh (HsDocStringChunk bs) = put_ bh bs
- get bh = HsDocStringChunk <$> get bh
-
-instance Outputable HsDocStringChunk where
- ppr = text . unpackHDSC
-
mkGeneratedHsDocStringGhc :: String -> HsDocString (GhcPass p)
mkGeneratedHsDocStringGhc = mkGeneratedHsDocString noExtField . mkHsDocStringChunk
=====================================
compiler/GHC/Hs/ImpExp.hs
=====================================
@@ -447,8 +447,3 @@ coveredByNamespaceSpecifier DataNamespaceSpecifier{} = isValNameSpace
filterByNamespaceSpecifierGREs :: NamespaceSpecifier (GhcPass p) -> [GlobalRdrElt] -> [GlobalRdrElt]
filterByNamespaceSpecifierGREs NoNamespaceSpecifier{} = id
filterByNamespaceSpecifierGREs ns_spec = filterByNamespaceGREs (coveredByNamespaceSpecifier ns_spec)
-
-instance Outputable (NamespaceSpecifier (GhcPass p)) where
- ppr NoNamespaceSpecifier{} = empty
- ppr TypeNamespaceSpecifier{} = text "type"
- ppr DataNamespaceSpecifier{} = text "data"
=====================================
compiler/GHC/Hs/Specificity.hs deleted
=====================================
@@ -1,51 +0,0 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
-module GHC.Hs.Specificity where
-
-import Prelude
-import Control.DeepSeq (NFData(..))
-
-import GHC.Utils.Outputable
-import GHC.Utils.Binary
-
-import Language.Haskell.Syntax.Specificity
-
-{- *********************************************************************
-* *
-* ForAllTyFlag
-* *
-********************************************************************* -}
-
-instance Outputable ForAllTyFlag where
- ppr Required = text "[req]"
- ppr Specified = text "[spec]"
- ppr Inferred = text "[infrd]"
-
-instance Binary Specificity where
- put_ bh SpecifiedSpec = putByte bh 0
- put_ bh InferredSpec = putByte bh 1
-
- get bh = do
- h <- getByte bh
- case h of
- 0 -> return SpecifiedSpec
- _ -> return InferredSpec
-
-instance Binary ForAllTyFlag where
- put_ bh Required = putByte bh 0
- put_ bh Specified = putByte bh 1
- put_ bh Inferred = putByte bh 2
-
- get bh = do
- h <- getByte bh
- case h of
- 0 -> return Required
- 1 -> return Specified
- _ -> return Inferred
-
-instance NFData Specificity where
- rnf SpecifiedSpec = ()
- rnf InferredSpec = ()
-instance NFData ForAllTyFlag where
- rnf (Invisible spec) = rnf spec
- rnf Required = ()
-
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -137,7 +137,6 @@ import GHC.Hs -- Lots of it
import GHC.Core.TyCon ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )
import GHC.Core.DataCon ( DataCon, dataConTyCon, dataConName )
import GHC.Core.ConLike ( ConLike(..) )
-import GHC.Core.Coercion.Axiom ( fsFromRole )
import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Types.Basic
@@ -425,7 +424,7 @@ mkRoleAnnotDecl loc tycon roles anns
where
role_data_type = dataTypeOf (undefined :: Role)
all_roles = map fromConstr $ dataTypeConstrs role_data_type
- possible_roles = [(fsFromRole role, role) | role <- all_roles]
+ possible_roles = [(strFromRole role, role) | role <- all_roles]
parse_role (L loc_role Nothing) = return $ L (noAnnSrcSpan loc_role) Nothing
parse_role (L loc_role (Just role))
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -14,14 +14,6 @@ types that
\end{itemize}
-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-{-
-Above flag is necessary for these instances:
- * Binary Boxity
- * Binary PromotionFlag
- * Outputable Boxity
- * Outputable PromotionFlag
--}
{-# LANGUAGE DerivingVia #-}
module GHC.Types.Basic (
@@ -377,27 +369,6 @@ unSwap NotSwapped f a b = f a b
unSwap IsSwapped f a b = f b a
-{- *********************************************************************
-* *
- Promotion flag
-* *
-********************************************************************* -}
-
-instance Outputable PromotionFlag where
- ppr NotPromoted = text "NotPromoted"
- ppr IsPromoted = text "IsPromoted"
-
-instance Binary PromotionFlag where
- put_ bh NotPromoted = putByte bh 0
- put_ bh IsPromoted = putByte bh 1
-
- get bh = do
- n <- getByte bh
- case n of
- 0 -> return NotPromoted
- 1 -> return IsPromoted
- _ -> fail "Binary(IsPromoted): fail)"
-
{-
************************************************************************
* *
=====================================
compiler/GHC/Types/FieldLabel.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable FieldLabelString
{-
%
@@ -48,7 +47,6 @@ import GHC.Prelude
import {-# SOURCE #-} GHC.Types.Name
-import GHC.Types.Unique (Uniquable(..))
import GHC.Utils.Outputable
import GHC.Utils.Binary
import GHC.Data.FastString
@@ -89,12 +87,6 @@ instance Outputable FieldLabel where
<> ppr (flHasDuplicateRecordFields fl)
<> ppr (flHasFieldSelector fl))
-instance Outputable FieldLabelString where
- ppr (FieldLabelString l) = ppr l
-
-instance Uniquable FieldLabelString where
- getUnique (FieldLabelString fs) = getUnique (mkFastStringShortText fs)
-
-- | Flag to indicate whether the DuplicateRecordFields extension is enabled.
data DuplicateRecordFields
= DuplicateRecordFields -- ^ Fields may be duplicated in a single module
=====================================
compiler/GHC/Types/Fixity.hs
=====================================
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wno-dodgy-exports #-} -- For re-export of GHC.Hs.Basic instances
-
-- | Fixity
module GHC.Types.Fixity
( Fixity (..)
@@ -11,14 +9,12 @@ module GHC.Types.Fixity
, negateFixity
, funTyFixity
, compareFixity
- , module GHC.Hs.Basic
)
where
import GHC.Prelude
import Language.Haskell.Syntax.Basic (LexicalFixity(..), FixityDirection(..), Fixity(..) )
-import GHC.Hs.Basic () -- For instances only
------------------------
=====================================
compiler/GHC/Types/ForeignCall.hs
=====================================
@@ -319,13 +319,6 @@ type instance XXHeader (GhcPass p) = DataConCantHappen
deriving instance Eq (Header (GhcPass p))
-instance NFData (CType (GhcPass p)) where
- rnf (CType ext mh fs) =
- rnf ext `seq` rnf mh `seq` rnf fs
-
-instance NFData (Header (GhcPass p)) where
- rnf (Header s h) =
- rnf s `seq` rnf h
instance NFData CCallStaticTargetUnit where
rnf = \case
@@ -388,14 +381,6 @@ instance forall p. IsPass p => Eq (CCallTarget (GhcPass p)) where
GhcTc -> x1 == x2
_ -> False
-instance forall p. IsPass p => NFData (CCallTarget (GhcPass p)) where
- rnf = \case
- DynamicTarget NoExtField -> ()
- StaticTarget x a b -> rnf a `seq` rnf b `seq` case ghcPass @p of
- GhcPs -> rnf x
- GhcRn -> rnf x
- GhcTc -> rnf x
-
instance forall p. IsPass p => Binary (CCallTarget (GhcPass p)) where
put_ bh = \case
StaticTarget x a b -> do
=====================================
compiler/GHC/Types/InlinePragma.hs
=====================================
@@ -9,16 +9,8 @@
-}
{-# OPTIONS_GHC -Wno-orphans #-}
-{-
-Suppression of warnings are required for instances:
- - Binary Activation
- - Binary CompilerPhase
- - Binary InlinePragma
- - Binary InlineSaturation
- - Binary XActivation
- - Binary XInlinePragmaGhc
- - Outputable CompilerPhase
--}
+-- Required for TTG type-family definitions,
+-- There are no orphan type-class instances
module GHC.Types.InlinePragma
( -- * Inline Pragma Encoding
@@ -494,10 +486,6 @@ no harm.
always returns 'False' when its second argument is 'NeverActive'.
-}
-{- TODO: These orphan instance should be moved to the GHC.Utils.{Binary,Outputable}
-modules once TTG has progressed and the Language.Haskell.Syntax.Types module
-no longer depends on importing GHC.Hs.Doc.
--}
instance Binary XInlinePragmaGhc where
put_ bh (XInlinePragmaGhc s a) = do
put_ bh s
@@ -508,26 +496,6 @@ instance Binary XInlinePragmaGhc where
a <- get bh
return (XInlinePragmaGhc s a)
-instance forall p. IsPass p => Binary (InlinePragma (GhcPass p)) where
- put_ bh (InlinePragma s a b c) = do
- put_ bh a
- put_ bh b
- put_ bh c
- case ghcPass @p of
- GhcPs -> put_ bh s
- GhcRn -> put_ bh s
- GhcTc -> put_ bh s
-
- get bh = do
- a <- get bh
- b <- get bh
- c <- get bh
- s <- case ghcPass @p of
- GhcPs -> get bh
- GhcRn -> get bh
- GhcTc -> get bh
- return (InlinePragma s a b c)
-
instance Binary InlineSaturation where
put_ bh AnySaturation = putByte bh 0
put_ bh (AppliedToAtLeast w) = putByte bh 1 *> put_ bh w
@@ -620,5 +588,24 @@ pprInline' emptyInline (InlinePragma
AnySaturation -> empty
AppliedToAtLeast ar -> parens (text "sat-args=" <> int ar)
+{- TODO: This orphan instance should be moved to GHC.Utils.Outputable once that
+module can import 'GhcPass' without causing an import cycle.
+@
+┌──────▶ GHC.Utils.Outputable
+│ │
+│ │ Needs to access GhcPass for instance:
+│ │ Outputable (InlinePragma (GhcPass p))
+│ ▼
+│ GHC.Hs.Extension.Pass
+│ │
+│ │ For GenLocated, SrcSpan, unLoc
+│ ▼
+│ GHC.Types.SrcLoc
+│ │
+│ │ for Outputable, SDoc,
+│ │ pprFastFilePath, ppr combinators
+└───────────────┘
+@
+-}
instance forall p. IsPass p => Outputable (InlinePragma (GhcPass p)) where
ppr = pprInline
=====================================
compiler/GHC/Types/Unique.hs
=====================================
@@ -68,7 +68,8 @@ import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
import GHC.Word ( Word64 )
import Data.Char ( chr, ord, isPrint )
-import Language.Haskell.Syntax.Module.Name
+import Language.Haskell.Syntax.Basic ( FieldLabelString(..) )
+import Language.Haskell.Syntax.Module.Name ( ModuleName(..) )
{-
************************************************************************
@@ -419,6 +420,8 @@ instance Uniquable Word64 where
instance Uniquable ModuleName where
getUnique (ModuleName nm) = getUnique nm
+instance Uniquable FieldLabelString where
+ getUnique (FieldLabelString fs) = getUnique (mkFastStringShortText fs)
{-
************************************************************************
=====================================
compiler/GHC/Types/Var.hs
=====================================
@@ -129,7 +129,6 @@ import GHC.Utils.Binary
import GHC.Utils.Outputable
import GHC.Utils.Panic
-import GHC.Hs.Specificity ()
import Language.Haskell.Syntax.Specificity
import Control.DeepSeq
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -1,5 +1,8 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE DerivingVia #-}
@@ -119,8 +122,13 @@ import GHC.Prelude
import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Binds.InlinePragma
+import Language.Haskell.Syntax.Decls.Overlap
+import Language.Haskell.Syntax.Doc
+import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Module.Name (ModuleName(..))
import Language.Haskell.Syntax.ImpExp.IsBoot (IsBootInterface(..))
+import Language.Haskell.Syntax.Specificity
+import Language.Haskell.Syntax.Type (PromotionFlag(..))
import {-# SOURCE #-} GHC.Types.Name (Name)
import GHC.Data.ShortText (ShortText)
@@ -164,7 +172,7 @@ import qualified Data.Map.Strict as Map
import Data.Proxy
import Data.Set ( Set )
import qualified Data.Set as Set
-import Data.Time
+import Data.Time hiding ( Nominal )
import Data.List (unfoldr)
import System.IO as IO
import System.IO.Error ( mkIOError, eofErrorType )
@@ -1926,6 +1934,85 @@ instance Binary ModuleName where
put_ bh (ModuleName fs) = put_ bh fs
get bh = do fs <- get bh; return (ModuleName fs)
+instance Binary Specificity where
+ put_ bh SpecifiedSpec = putByte bh 0
+ put_ bh InferredSpec = putByte bh 1
+
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> return SpecifiedSpec
+ _ -> return InferredSpec
+
+instance Binary ForAllTyFlag where
+ put_ bh Required = putByte bh 0
+ put_ bh Specified = putByte bh 1
+ put_ bh Inferred = putByte bh 2
+
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> return Required
+ 1 -> return Specified
+ _ -> return Inferred
+
+instance Binary HsDocStringDecorator where
+ put_ bh x = case x of
+ HsDocStringNext -> putByte bh 0
+ HsDocStringPrevious -> putByte bh 1
+ HsDocStringNamed n -> putByte bh 2 >> put_ bh n
+ HsDocStringGroup n -> putByte bh 3 >> put_ bh n
+
+ get bh = do
+ tag <- getByte bh
+ case tag of
+ 0 -> pure HsDocStringNext
+ 1 -> pure HsDocStringPrevious
+ 2 -> HsDocStringNamed <$> get bh
+ 3 -> HsDocStringGroup <$> get bh
+ t -> fail $ "HsDocStringDecorator: invalid tag " ++ show t
+
+instance Binary HsDocStringChunk where
+ put_ bh (HsDocStringChunk bs) = put_ bh bs
+ get bh = HsDocStringChunk <$> get bh
+
+instance ( Binary (XInlinePragma p)
+ , Binary (Activation p)
+ , XXInlinePragma p ~ DataConCantHappen
+ ) => Binary (InlinePragma p) where
+ put_ bh (InlinePragma s a b c) = do
+ put_ bh a
+ put_ bh b
+ put_ bh c
+ put_ bh s
+
+ get bh = do
+ a <- get bh
+ b <- get bh
+ c <- get bh
+ s <- get bh
+ return (InlinePragma s a b c)
+
+instance ( Binary (XOverlapMode p)
+ , XXOverlapMode p ~ DataConCantHappen
+ ) => Binary (OverlapMode p) where
+ put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s
+ put_ bh (Overlaps s) = putByte bh 1 >> put_ bh s
+ put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s
+ put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s
+ put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s
+ put_ bh (NonCanonical s) = putByte bh 5 >> put_ bh s
+
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> get bh >>= \s -> return $ NoOverlap s
+ 1 -> get bh >>= \s -> return $ Overlaps s
+ 2 -> get bh >>= \s -> return $ Incoherent s
+ 3 -> get bh >>= \s -> return $ Overlapping s
+ 4 -> get bh >>= \s -> return $ Overlappable s
+ _ -> get bh >>= \s -> return $ NonCanonical s
+
newtype BinLocated a = BinLocated { unBinLocated :: Located a }
instance Binary a => Binary (BinLocated a) where
@@ -2088,6 +2175,26 @@ instance Binary Boxity where -- implemented via isBoxed-isomorphism to Bool
b <- get bh
pure $ if b then Boxed else Unboxed
+instance Binary Fixity where
+ put_ bh (Fixity aa ab) = do
+ put_ bh aa
+ put_ bh ab
+ get bh = do
+ aa <- get bh
+ ab <- get bh
+ return (Fixity aa ab)
+
+instance Binary FixityDirection where
+ put_ bh InfixL = putByte bh 0
+ put_ bh InfixR = putByte bh 1
+ put_ bh InfixN = putByte bh 2
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> return InfixL
+ 1 -> return InfixR
+ _ -> return InfixN
+
instance Binary ConInfoTable where
get bh = Binary.decode <$> get bh
@@ -2150,3 +2257,49 @@ instance Binary RuleMatchInfo where
h <- getByte bh
if h == 1 then pure ConLike
else pure FunLike
+
+instance Binary Role where
+ put_ bh Nominal = putByte bh 1
+ put_ bh Representational = putByte bh 2
+ put_ bh Phantom = putByte bh 3
+
+ get bh = do tag <- getByte bh
+ case tag of 1 -> return Nominal
+ 2 -> return Representational
+ 3 -> return Phantom
+ _ -> panic ("get Role " ++ show tag)
+
+instance Binary SrcStrictness where
+ put_ bh SrcLazy = putByte bh 0
+ put_ bh SrcStrict = putByte bh 1
+ put_ bh NoSrcStrict = putByte bh 2
+
+ get bh =
+ do h <- getByte bh
+ case h of
+ 0 -> return SrcLazy
+ 1 -> return SrcStrict
+ _ -> return NoSrcStrict
+
+instance Binary SrcUnpackedness where
+ put_ bh SrcNoUnpack = putByte bh 0
+ put_ bh SrcUnpack = putByte bh 1
+ put_ bh NoSrcUnpack = putByte bh 2
+
+ get bh =
+ do h <- getByte bh
+ case h of
+ 0 -> return SrcNoUnpack
+ 1 -> return SrcUnpack
+ _ -> return NoSrcUnpack
+
+instance Binary PromotionFlag where
+ put_ bh NotPromoted = putByte bh 0
+ put_ bh IsPromoted = putByte bh 1
+
+ get bh = do
+ n <- getByte bh
+ case n of
+ 0 -> return NotPromoted
+ 1 -> return IsPromoted
+ _ -> fail "Binary(IsPromoted): fail)"
=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -115,12 +115,17 @@ import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName )
import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Binds.InlinePragma
import Language.Haskell.Syntax.Decls.Overlap ( OverlapMode(..) )
+import Language.Haskell.Syntax.Doc
+import Language.Haskell.Syntax.ImpExp ( NamespaceSpecifier(..) )
import Language.Haskell.Syntax.Module.Name ( ModuleName(..) )
+import Language.Haskell.Syntax.Specificity
import Language.Haskell.Syntax.Text
+import Language.Haskell.Syntax.Type ( PromotionFlag(..) )
import GHC.Prelude.Basic
import GHC.Utils.BufHandle (BufHandle, bPutChar, bPutStr, bPutFS, bPutFZS)
+import GHC.Utils.Encoding ( utf8DecodeByteString )
import GHC.Data.FastString
import qualified GHC.Utils.Ppr as Pretty
import qualified GHC.Utils.Ppr.Colour as Col
@@ -1108,6 +1113,28 @@ instance Outputable Extension where
instance Outputable ModuleName where
ppr = pprModuleName
+instance Outputable FieldLabelString where
+ ppr (FieldLabelString l) = ppr l
+
+instance Outputable ForAllTyFlag where
+ ppr Required = text "[req]"
+ ppr Specified = text "[spec]"
+ ppr Inferred = text "[infrd]"
+
+instance Outputable HsDocStringDecorator where
+ ppr HsDocStringNext = text "|"
+ ppr HsDocStringPrevious = text "^"
+ ppr (HsDocStringNamed n) = char '$' <> text n
+ ppr (HsDocStringGroup n) = text (replicate n '*')
+
+instance Outputable HsDocStringChunk where
+ ppr (HsDocStringChunk bs) = text (utf8DecodeByteString bs)
+
+-- | For compatibility with the existing @-ddump-parsed@ output, we only show
+-- the docstring.
+instance Outputable a => Outputable (WithHsDocIdentifiers a pass) where
+ ppr (WithHsDocIdentifiers s _ids) = ppr s
+
instance Outputable OsPath where
ppr p = text $ either show id (decodeUtf p)
@@ -2039,6 +2066,35 @@ instance Outputable TopLevelFlag where
ppr TopLevel = text "<TopLevel>"
ppr NotTopLevel = text "<NotTopLevel>"
+instance Outputable LexicalFixity where
+ ppr Prefix = text "Prefix"
+ ppr Infix = text "Infix"
+
+instance Outputable FixityDirection where
+ ppr InfixL = text "infixl"
+ ppr InfixR = text "infixr"
+ ppr InfixN = text "infix"
+
+instance Outputable Fixity where
+ ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
+
+instance Outputable SrcStrictness where
+ ppr SrcLazy = char '~'
+ ppr SrcStrict = char '!'
+ ppr NoSrcStrict = empty
+
+instance Outputable SrcUnpackedness where
+ ppr SrcUnpack = text "{-# UNPACK #-}"
+ ppr SrcNoUnpack = text "{-# NOUNPACK #-}"
+ ppr NoSrcUnpack = empty
+
+instance Outputable PromotionFlag where
+ ppr NotPromoted = text "NotPromoted"
+ ppr IsPromoted = text "IsPromoted"
+
+instance Outputable Role where
+ ppr = ftext . strFromRole
+
instance Outputable (OverlapMode p) where
ppr (NoOverlap _) = empty
ppr (Overlappable _) = text "[overlappable]"
@@ -2047,3 +2103,9 @@ instance Outputable (OverlapMode p) where
ppr (Incoherent _) = text "[incoherent]"
ppr (NonCanonical _) = text "[noncanonical]"
ppr (XOverlapMode _) = text "[user TTG extension]"
+
+instance Outputable (NamespaceSpecifier p) where
+ ppr NoNamespaceSpecifier{} = empty
+ ppr TypeNamespaceSpecifier{} = text "type"
+ ppr DataNamespaceSpecifier{} = text "data"
+ ppr (XNamespaceSpecifier _) = text "[user TTG extension]"
=====================================
compiler/Language/Haskell/Syntax/Basic.hs
=====================================
@@ -8,6 +8,7 @@ import Data.Data (Data)
import Data.Eq
import Data.Ord
import Data.Bool
+import Data.String (IsString(..))
import Prelude
{-
@@ -93,6 +94,20 @@ Field Labels
data Role = Nominal | Representational | Phantom
deriving (Eq, Ord, Data)
+instance NFData Role where
+ rnf Nominal = ()
+ rnf Representational = ()
+ rnf Phantom = ()
+
+-- These names are slurped into the parser code. Changing these strings
+-- will change the **surface syntax** that GHC accepts! If you want to
+-- change only the pretty-printing, do some replumbing. See
+-- mkRoleAnnotDecl in GHC.Parser.PostProcess
+strFromRole :: IsString s => Role -> s
+strFromRole Nominal = fromString "nominal"
+strFromRole Representational = fromString "representational"
+strFromRole Phantom = fromString "phantom"
+
{-
************************************************************************
* *
@@ -109,6 +124,11 @@ data SrcStrictness = SrcLazy -- ^ Lazy, ie '~'
| NoSrcStrict -- ^ no strictness annotation
deriving (Eq, Data)
+instance NFData SrcStrictness where
+ rnf SrcLazy = ()
+ rnf SrcStrict = ()
+ rnf NoSrcStrict = ()
+
-- | Source Unpackedness
--
-- What unpackedness the user requested
@@ -117,6 +137,11 @@ data SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified
| NoSrcUnpack -- ^ no unpack pragma
deriving (Eq, Data)
+instance NFData SrcUnpackedness where
+ rnf SrcNoUnpack = ()
+ rnf SrcUnpack = ()
+ rnf NoSrcUnpack = ()
+
{-
************************************************************************
* *
=====================================
compiler/Language/Haskell/Syntax/Decls/Foreign.hs
=====================================
@@ -74,7 +74,7 @@ import Control.DeepSeq
import Data.Data hiding (TyCon, Fixity, Infix)
import Data.Maybe
import Data.Eq
-import Prelude (Enum, Show)
+import Prelude (Enum, Show, seq)
{-
************************************************************************
@@ -211,6 +211,12 @@ data CCallTarget pass
| DynamicTarget (XDynamicTarget pass)
| XCCallTarget !(XXCCallTarget pass)
+instance (NFData (XStaticTarget pass), NFData (XDynamicTarget pass), NFData (XXCCallTarget pass))
+ => NFData (CCallTarget pass) where
+ rnf (StaticTarget x a b) = rnf a `seq` rnf b `seq` rnf x
+ rnf (DynamicTarget x) = rnf x
+ rnf (XCCallTarget x) = rnf x
+
data CExportSpec
-- | foreign export ccall foo :: ty
= CExportStatic
@@ -228,6 +234,11 @@ data CType pass
HText
| XCType !(XXCType pass)
+instance (NFData (XCType pass), NFData (Header pass), NFData (XXCType pass))
+ => NFData (CType pass) where
+ rnf (CType ext mh fs) = rnf ext `seq` rnf mh `seq` rnf fs
+ rnf (XCType x) = rnf x
+
-- | The filename for a C header file
data Header pass
= Header
@@ -235,6 +246,10 @@ data Header pass
HText
| XHeader !(XXHeader pass)
+instance (NFData (XHeader pass), NFData (XXHeader pass)) => NFData (Header pass) where
+ rnf (Header s h) = rnf s `seq` rnf h
+ rnf (XHeader x) = rnf x
+
data Safety
= PlaySafe -- ^ Might invoke Haskell GC, or do a call back, or
-- switch threads, etc. So make sure things are
=====================================
compiler/Language/Haskell/Syntax/Doc.hs
=====================================
@@ -65,6 +65,18 @@ data HsDocString pass
| XHsDocString
!(XXHsDocString pass)
+instance
+ ( NFData (XMultiLineDocString pass)
+ , NFData (XNestedDocString pass)
+ , NFData (XGeneratedDocString pass)
+ , NFData (XXHsDocString pass)
+ , NFData (LHsDocStringChunk pass)
+ ) => NFData (HsDocString pass) where
+ rnf (MultiLineDocString x a b) = rnf x `seq` rnf a `seq` rnf b
+ rnf (NestedDocString x a b) = rnf x `seq` rnf a `seq` rnf b
+ rnf (GeneratedDocString x a) = rnf x `seq` rnf a
+ rnf (XHsDocString x) = rnf x
+
mkGeneratedHsDocString :: XGeneratedDocString p -> HsDocStringChunk -> HsDocString p
mkGeneratedHsDocString x = GeneratedDocString x
@@ -110,3 +122,6 @@ data WithHsDocIdentifiers a pass = WithHsDocIdentifiers
{ hsDocString :: !a
, hsDocIdentifiers :: ![LIdP pass]
}
+
+instance (UnXRec pass, NFData (IdP pass), NFData a) => NFData (WithHsDocIdentifiers a pass) where
+ rnf (WithHsDocIdentifiers d i) = rnf d `seq` rnf (map (unXRec @pass) i)
=====================================
compiler/Language/Haskell/Syntax/Extension.hs
=====================================
@@ -9,6 +9,7 @@ module Language.Haskell.Syntax.Extension where
-- This module captures the type families to precisely identify the extension
-- points for GHC.Hs syntax
+import Control.DeepSeq
import Data.Type.Equality (type (~))
import Data.Data hiding ( Fixity )
@@ -16,6 +17,7 @@ import Data.Kind (Type)
import Data.Eq
import Data.Ord
+import Text.Show
{-
Note [Trees That Grow]
@@ -62,6 +64,9 @@ See also Note [IsPass] and Note [NoGhcTc] in GHC.Hs.Extension.
data NoExtField = NoExtField
deriving (Data,Eq,Ord)
+instance NFData NoExtField where
+ rnf NoExtField = ()
+
-- | Used when constructing a term with an unused extension point.
noExtField :: NoExtField
noExtField = NoExtField
@@ -95,7 +100,10 @@ can only do that if the extension field was strict (#18764).
See also [DataConCantHappen and strict fields].
-}
data DataConCantHappen
- deriving (Data,Eq,Ord)
+ deriving (Data,Eq,Ord,Show)
+
+instance NFData DataConCantHappen where
+ rnf = dataConCantHappen
-- | Eliminate a 'DataConCantHappen'. See Note [Constructor cannot occur].
dataConCantHappen :: DataConCantHappen -> a
=====================================
compiler/Language/Haskell/Syntax/ImpExp.hs
=====================================
@@ -1,4 +1,6 @@
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
+ -- in module Language.Haskell.Syntax.Extension
module Language.Haskell.Syntax.ImpExp ( module Language.Haskell.Syntax.ImpExp, IsBootInterface(..) ) where
import Language.Haskell.Syntax.Doc (LHsDoc)
@@ -6,9 +8,9 @@ import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Module.Name
import Language.Haskell.Syntax.ImpExp.IsBoot ( IsBootInterface(..) )
-import Data.Eq (Eq)
+import Data.Eq (Eq(..))
import Data.Data (Data)
-import Data.Bool (Bool)
+import Data.Bool (Bool(..))
import Data.Maybe (Maybe)
import Data.String (String)
import Data.Int (Int)
=====================================
compiler/Language/Haskell/Syntax/Specificity.hs
=====================================
@@ -14,6 +14,7 @@ module Language.Haskell.Syntax.Specificity (
import Prelude
+import Control.DeepSeq (NFData(..))
import Data.Data
-- | ForAllTyFlag
@@ -27,6 +28,10 @@ data ForAllTyFlag = Invisible !Specificity
deriving (Eq, Ord, Data)
-- (<) on ForAllTyFlag means "is less visible than"
+instance NFData ForAllTyFlag where
+ rnf (Invisible spec) = rnf spec
+ rnf Required = ()
+
-- | Whether an 'Invisible' argument may appear in source Haskell.
data Specificity = InferredSpec
-- ^ the argument may not appear in source Haskell, it is
@@ -36,6 +41,10 @@ data Specificity = InferredSpec
-- required.
deriving (Eq, Ord, Data)
+instance NFData Specificity where
+ rnf SpecifiedSpec = ()
+ rnf InferredSpec = ()
+
pattern Inferred, Specified :: ForAllTyFlag
pattern Inferred = Invisible InferredSpec
pattern Specified = Invisible SpecifiedSpec
=====================================
compiler/ghc.cabal.in
=====================================
@@ -566,7 +566,6 @@ Library
GHC.Hs.Instances
GHC.Hs.Lit
GHC.Hs.Pat
- GHC.Hs.Specificity
GHC.Hs.Stats
GHC.HsToCore
GHC.HsToCore.Arrows
=====================================
testsuite/tests/count-deps/CountDepsParser.stdout
=====================================
@@ -113,7 +113,6 @@ GHC.Hs.ImpExp
GHC.Hs.Instances
GHC.Hs.Lit
GHC.Hs.Pat
-GHC.Hs.Specificity
GHC.Hs.Type
GHC.Hs.Utils
GHC.HsToCore.Breakpoints.Types
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/676256b255260fc1f41b10d8a6b69ee…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/676256b255260fc1f41b10d8a6b69ee…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/TTG-No-Orphans] Apply 1 suggestion(s) to 1 file(s)
by recursion-ninja (@recursion-ninja) 20 Jul '26
by recursion-ninja (@recursion-ninja) 20 Jul '26
20 Jul '26
recursion-ninja pushed to branch wip/TTG-No-Orphans at Glasgow Haskell Compiler / GHC
Commits:
66c9e3b4 by recursion-ninja at 2026-07-20T14:49:30+00:00
Apply 1 suggestion(s) to 1 file(s)
Co-authored-by: Rodrigo Mesquita <rodrigo.m.mesquita(a)gmail.com>
- - - - -
1 changed file:
- compiler/Language/Haskell/Syntax/Decls/Foreign.hs
Changes:
=====================================
compiler/Language/Haskell/Syntax/Decls/Foreign.hs
=====================================
@@ -213,7 +213,7 @@ data CCallTarget pass
instance (NFData (XStaticTarget pass), NFData (XDynamicTarget pass), NFData (XXCCallTarget pass))
=> NFData (CCallTarget pass) where
- rnf (StaticTarget x a b) = rnf a `seq` rnf b `seq` rnf x -- 'x' is forced last to match "legacy" GHC semantics
+ rnf (StaticTarget x a b) = rnf a `seq` rnf b `seq` rnf x
rnf (DynamicTarget x) = rnf x
rnf (XCCallTarget x) = rnf x
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66c9e3b424b69ed7fc16b6ca4a41df1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66c9e3b424b69ed7fc16b6ca4a41df1…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/fendor/external-unit-db-cache] 2 commits: Introduce global unit database cache
by Hannes Siebenhandl (@fendor) 20 Jul '26
by Hannes Siebenhandl (@fendor) 20 Jul '26
20 Jul '26
Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC
Commits:
0be85bb7 by fendor at 2026-07-20T15:30:51+02:00
Introduce global unit database cache
As a first step for better sharing of `UnitInfo` across `UnitEnv`,
we introduce a new datatype called `ExternalUnitDatabases`.
It primarily serves as an in-memory representation of *all*
`UnitDatabase`s across `UnitEnv`. This means, if multiple `HomeUnitEnv`s
depend on the same database, one way or another, we make sure that we
don't parse from disk every time.
Instead, we store the in-memory representation in `ExternalUnitDatabases`.
`ExternalUnitDatabaseCache` is the equivalent of `ExternalUnitState` in
the `UnitEnv`. It is a mutable variable wrapping `ExternalUnitDatabases`.
The mutable `ExternalUnitDatabaseCache` is used in `initUnits` to make
sure we don't parse the same unit database multiple times.
Almost by accident, we change the semantics of `initUnits` to honour
modifications to `packageDBFlags`.
The inability to change `packageDBFlags` while also reusing the already
parsed `UnitDatabase`s was reported in #26423 as a bug.
Hence, we think this behaviour change is warranted and acceptable,
especially since it comes with a breaking change to the `initUnits` API.
Add regression test for #26423
Closes #26423
- - - - -
7edaebec by fendor at 2026-07-20T16:43:40+02:00
Introduce UnitIndex for global external unit caching
`UnitInfo`s have been observed to cause a lot of memory usage in #27500.
Especially with multiple home units, as the same (external) units are
processed from scratch, even though most of the time we end up with
exactly the same `UnitInfo`.
We introduce a `UnitEnv` global cache that allows us to store external
unit information that is used across all `HomeUnitEnv`s.
The most important change in this commit is the introduction of the `UnitIndex`.
It stores a global mapping of `UnitId` -> `UnitInfo`, and `initUnits`
always uses the cached `UnitInfo` entry to populate each
`HomeUnitEnv`'s `UnitState`.
This allows us to ensure the following property:
> Each `UnitInfo` should be alive exactly once in GHC.
In addition, the `ExternalUnitDatabaseCache` may also hold a reference
to each on-disk representation of `UnitInfo`.
This means, we impose an hard upper bound on the number of `UnitInfo`s
alive in the GHC session:
> The number of alive `UnitInfo`s closure objects must be the
> sum of all loaded unit database times two.
We add performance regression tests that make sure the number of live
`UnitInfo` cannot exceed this threshold.
Closes #27500
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
mhu-perf
-------------------------
These metrics increases are especially notable, as we are not even
sharing anything big but merely the global package database with 50
entries.
It shows how careful sharing of `UnitInfo` can improve memory usage.
We expect this to be much more notable when the whole cabal package
database is shared across multiple home units.
---
Technical details
To share the `UnitInfo`s correctly, it is important that we extract
the `WireMap` into the `UnitIndex`. At the moment of writing, `WireMap`
must be globally the same for all `HomeUnitEnv`s.
This is important, as we could otherwise not cache the "fully-resolved"
`UnitInfo`.
We consider a `UnitInfo` fully-resolved, if wired-in units have been
updated, the `UnitInfo` has been validated and variables in the unit
config, such as `${pkgroot}` have been resolved.
Updating the wired-in units requires the `WireMap` to be globally the
same.
- - - - -
42 changed files:
- + changelog.d/unit-index
- compiler/GHC.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Main/Hsc.hs
- compiler/GHC/Driver/Main/Interactive.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/Driver/Session/Units.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Unit/Env.hs
- + compiler/GHC/Unit/External/Database.hs
- + compiler/GHC/Unit/External/Index.hs
- + compiler/GHC/Unit/External/ModuleOrigin.hs
- + compiler/GHC/Unit/External/Providers.hs
- + compiler/GHC/Unit/External/Query.hs
- + compiler/GHC/Unit/External/Substitution.hs
- + compiler/GHC/Unit/External/Validate.hs
- + compiler/GHC/Unit/External/Visibility.hs
- + compiler/GHC/Unit/External/Wired.hs
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/Info.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Unit/State.hs-boot
- compiler/GHC/Unit/Types.hs
- compiler/ghc.cabal.in
- ghc/GHCi/UI.hs
- hadrian/src/Rules/Generate.hs
- testsuite/tests/count-deps/CountDepsParser.stdout
- + testsuite/tests/driver/T26423/Hello.hs
- + testsuite/tests/driver/T26423/Makefile
- + testsuite/tests/driver/T26423/T26423.hs
- + testsuite/tests/driver/T26423/T26423.stderr
- + testsuite/tests/driver/T26423/T26423.stdout
- + testsuite/tests/driver/T26423/all.T
- + testsuite/tests/driver/T26423/test/Test.hs
- + testsuite/tests/driver/T26423/test/test.pkg
- + testsuite/tests/driver/TUnitInfo/Foo.hs
- + testsuite/tests/driver/TUnitInfo/Makefile
- + testsuite/tests/driver/TUnitInfo/all.T
- + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.hs
- + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.stdout
- utils/haddock/haddock-api/src/Haddock.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23ffb266adc2509e126fe741892cd4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23ffb266adc2509e126fe741892cd4…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/TTG-No-Orphans] Apply 1 suggestion(s) to 1 file(s)
by recursion-ninja (@recursion-ninja) 20 Jul '26
by recursion-ninja (@recursion-ninja) 20 Jul '26
20 Jul '26
recursion-ninja pushed to branch wip/TTG-No-Orphans at Glasgow Haskell Compiler / GHC
Commits:
9612e1c1 by recursion-ninja at 2026-07-20T14:40:28+00:00
Apply 1 suggestion(s) to 1 file(s)
Co-authored-by: Rodrigo Mesquita <rodrigo.m.mesquita(a)gmail.com>
- - - - -
1 changed file:
- compiler/GHC/Types/InlinePragma.hs
Changes:
=====================================
compiler/GHC/Types/InlinePragma.hs
=====================================
@@ -596,7 +596,7 @@ module can import 'GhcPass' without causing an import cycle.
│ │ Needs to access GhcPass for instance:
│ │ Outputable (InlinePragma (GhcPass p))
│ ▼
-│ GHC.Hs.Extension.GhcPass
+│ GHC.Hs.Extension.Pass
│ │
│ │ For GenLocated, SrcSpan, unLoc
│ ▼
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9612e1c16c86909718d13aa57c174d5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9612e1c16c86909718d13aa57c174d5…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/TTG-No-Orphans] First pass of orphan instance removal.
by recursion-ninja (@recursion-ninja) 20 Jul '26
by recursion-ninja (@recursion-ninja) 20 Jul '26
20 Jul '26
recursion-ninja pushed to branch wip/TTG-No-Orphans at Glasgow Haskell Compiler / GHC
Commits:
e6a44d21 by Recursion Ninja at 2026-07-20T09:25:15-04:00
First pass of orphan instance removal.
This is part of a technical debt removal effort made possible
now that seperating out the AST via TTG comes to a close.
As the AST in 'L.H.S' has been incrementally separated from the GHC internals,
there are many accumulated orphan instance of 'Binary', 'Outputable', 'Uniquable', etc.
The orphan instance of data-types from within 'L.H.S' are having thier orphan
instances moved to the module which defined the type-class; i.e. moving an orphan
'Binary' instance to 'GHC.Utils.Binary'.
Orphan instances resolved (37):
| Data-type | Resolved instance(s) | Former orphan module(s) |
| -------------------- | -------------------------- | ------------------------- |
| Role | Binary, NFData, Outputable | GHC.Core.Coercion.Axiom |
| SrcStrictness | Binary, NFData, Outputable | GHC.Core.DataCon |
| SrcUnpackedness | Binary, NFData, Outputable | GHC.Core.DataCon |
| Fixity | Binary, Outputable | GHC.Hs.Basic |
| FixityDirection | Binary, Outputable | GHC.Hs.Basic |
| LexicalFixity | Outputable | GHC.Hs.Basic |
| CCallTarget | NFData | GHC.Hs.Decls.Foreign |
| CType | NFData | GHC.Hs.Decls.Foreign |
| Header | NFData | GHC.Hs.Decls.Foreign |
| OverlapMode | Binary, NFData | GHC.Hs.Decls.Overlap |
| WithHsDocIdentifiers | NFData, Outputable | GHC.Hs.Doc |
| HsDocString | NFData | GHC.Hs.DocString |
| HsDocStringChunk | Binary, Outputable | GHC.Hs.DocString |
| HsDocStringDecorator | Binary, Outputable | GHC.Hs.DocString |
| NamespaceSpecifier | Outputable | GHC.Hs.ImpExp |
| ForAllTyFlag | Binary, NFData, Outputable | GHC.Hs.Specificity |
| Specificity | Binary, NFData | GHC.Hs.Specificity |
| PromotionFlag | Binary, Outputable | GHC.Types.Basic |
| FieldLabelString | Outputable, Uniquable | GHC.Types.FieldLabel |
| InlinePragma | Binary | GHC.Types.InlinePragma |
-------------------------
Metric Decrease:
hard_hole_fits
-------------------------
Closes #21262, #27469
- - - - -
26 changed files:
- compiler/GHC/Core/Coercion/Axiom.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Hs/Basic.hs
- compiler/GHC/Hs/Decls/Overlap.hs
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/Hs/DocString.hs
- compiler/GHC/Hs/ImpExp.hs
- − compiler/GHC/Hs/Specificity.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/FieldLabel.hs
- compiler/GHC/Types/Fixity.hs
- compiler/GHC/Types/ForeignCall.hs
- compiler/GHC/Types/InlinePragma.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/Basic.hs
- compiler/Language/Haskell/Syntax/Decls/Foreign.hs
- compiler/Language/Haskell/Syntax/Doc.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/ImpExp.hs
- compiler/Language/Haskell/Syntax/Specificity.hs
- compiler/ghc.cabal.in
- testsuite/tests/count-deps/CountDepsParser.stdout
Changes:
=====================================
compiler/GHC/Core/Coercion/Axiom.hs
=====================================
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable
-
-- (c) The University of Glasgow 2012
-- | Module for coercion axioms, used to represent type family instances
@@ -22,7 +20,7 @@ module GHC.Core.Coercion.Axiom (
coAxBranchLHS, coAxBranchRHS, coAxBranchSpan, coAxBranchIncomps,
placeHolderIncomps,
- Role(..), fsFromRole,
+ Role(..),
CoAxiomRule(..), BuiltInFamRewrite(..), BuiltInFamInjectivity(..), TypeEqn,
coAxiomRuleArgRoles, coAxiomRuleRole,
@@ -43,7 +41,6 @@ import GHC.Types.Name
import GHC.Types.Unique
import GHC.Types.Var
import GHC.Utils.Misc
-import GHC.Utils.Binary
import GHC.Utils.Panic
import GHC.Data.Pair
import GHC.Types.Basic
@@ -52,7 +49,6 @@ import GHC.Types.SrcLoc
import qualified Data.Data as Data
import Data.Array
import Data.List ( mapAccumL )
-import Control.DeepSeq
{-
Note [Coercion axiom branches]
@@ -521,44 +517,6 @@ instance Outputable CoAxBranch where
, ppUnless (null incomps) $
text "incomps:" <+> vcat (map ppr incomps) ])
-{-
-************************************************************************
-* *
- Roles
-* *
-************************************************************************
-
-Roles are defined here to avoid circular dependencies.
--}
-
--- These names are slurped into the parser code. Changing these strings
--- will change the **surface syntax** that GHC accepts! If you want to
--- change only the pretty-printing, do some replumbing. See
--- mkRoleAnnotDecl in GHC.Parser.PostProcess
-fsFromRole :: Role -> FastString
-fsFromRole Nominal = fsLit "nominal"
-fsFromRole Representational = fsLit "representational"
-fsFromRole Phantom = fsLit "phantom"
-
-instance Outputable Role where
- ppr = ftext . fsFromRole
-
-instance Binary Role where
- put_ bh Nominal = putByte bh 1
- put_ bh Representational = putByte bh 2
- put_ bh Phantom = putByte bh 3
-
- get bh = do tag <- getByte bh
- case tag of 1 -> return Nominal
- 2 -> return Representational
- 3 -> return Phantom
- _ -> panic ("get Role " ++ show tag)
-
-instance NFData Role where
- rnf Nominal = ()
- rnf Representational = ()
- rnf Phantom = ()
-
{-
************************************************************************
* *
=====================================
compiler/GHC/Core/DataCon.hs
=====================================
@@ -5,8 +5,6 @@
\section[DataCon]{@DataCon@: Data Constructors}
-}
-{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable, Binary
-
module GHC.Core.DataCon (
-- * Main data types
DataCon, DataConRep(..),
@@ -109,7 +107,6 @@ import qualified Data.ByteString.Lazy as LBS
import qualified Data.Data as Data
import Data.Char
import Data.List( find )
-import Control.DeepSeq
{-
Note [Data constructor representation]
@@ -1030,16 +1027,6 @@ instance Outputable HsImplBang where
ppr (HsUnpack (Just co)) = text "Unpacked" <> parens (ppr co)
ppr (HsStrict b) = text "StrictNotUnpacked" <> parens (ppr b)
-instance Outputable SrcStrictness where
- ppr SrcLazy = char '~'
- ppr SrcStrict = char '!'
- ppr NoSrcStrict = empty
-
-instance Outputable SrcUnpackedness where
- ppr SrcUnpack = text "{-# UNPACK #-}"
- ppr SrcNoUnpack = text "{-# NOUNPACK #-}"
- ppr NoSrcUnpack = empty
-
instance Outputable StrictnessMark where
ppr MarkedStrict = text "!"
ppr NotMarkedStrict = empty
@@ -1054,40 +1041,6 @@ instance Binary StrictnessMark where
1 -> return MarkedStrict
_ -> panic "Invalid binary format"
-instance Binary SrcStrictness where
- put_ bh SrcLazy = putByte bh 0
- put_ bh SrcStrict = putByte bh 1
- put_ bh NoSrcStrict = putByte bh 2
-
- get bh =
- do h <- getByte bh
- case h of
- 0 -> return SrcLazy
- 1 -> return SrcStrict
- _ -> return NoSrcStrict
-
-instance Binary SrcUnpackedness where
- put_ bh SrcNoUnpack = putByte bh 0
- put_ bh SrcUnpack = putByte bh 1
- put_ bh NoSrcUnpack = putByte bh 2
-
- get bh =
- do h <- getByte bh
- case h of
- 0 -> return SrcNoUnpack
- 1 -> return SrcUnpack
- _ -> return NoSrcUnpack
-
-instance NFData SrcStrictness where
- rnf SrcLazy = ()
- rnf SrcStrict = ()
- rnf NoSrcStrict = ()
-
-instance NFData SrcUnpackedness where
- rnf SrcNoUnpack = ()
- rnf SrcUnpack = ()
- rnf NoSrcUnpack = ()
-
-- | Compare strictness annotations
eqHsBang :: HsImplBang -> HsImplBang -> Bool
eqHsBang HsLazy HsLazy = True
=====================================
compiler/GHC/Hs/Basic.hs
=====================================
@@ -1,52 +1,6 @@
-{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable, Binary
-{-# LANGUAGE TypeFamilies #-}
-
-- | Fixity
module GHC.Hs.Basic
( module Language.Haskell.Syntax.Basic
) where
-import GHC.Prelude
-
-import GHC.Utils.Outputable
-import GHC.Utils.Binary
-
import Language.Haskell.Syntax.Basic
-
-instance Outputable LexicalFixity where
- ppr Prefix = text "Prefix"
- ppr Infix = text "Infix"
-
-instance Outputable FixityDirection where
- ppr InfixL = text "infixl"
- ppr InfixR = text "infixr"
- ppr InfixN = text "infix"
-
-instance Outputable Fixity where
- ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
-
-
-instance Binary Fixity where
- put_ bh (Fixity aa ab) = do
- put_ bh aa
- put_ bh ab
- get bh = do
- aa <- get bh
- ab <- get bh
- return (Fixity aa ab)
-
-------------------------
-
-instance Binary FixityDirection where
- put_ bh InfixL =
- putByte bh 0
- put_ bh InfixR =
- putByte bh 1
- put_ bh InfixN =
- putByte bh 2
- get bh = do
- h <- getByte bh
- case h of
- 0 -> return InfixL
- 1 -> return InfixR
- _ -> return InfixN
=====================================
compiler/GHC/Hs/Decls/Overlap.hs
=====================================
@@ -1,12 +1,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} -- XOverlapMode, XXOverlapMode
-
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{- Necessary for the following instances:
- * (type class): Binary OverlapMode
- * (type class): NFData OverlapMode
--}
+{-# OPTIONS_GHC -fno-warn-orphans #-} -- XOverlapMode, XXOverlapMode
{- |
Data-types describing the overlap annotations for instances as well as
@@ -74,34 +69,6 @@ type instance XOverlapMode (GhcPass _) = SourceText
type instance XXOverlapMode (GhcPass _) = DataConCantHappen
-instance NFData (OverlapMode (GhcPass p)) where
- rnf = \case
- NoOverlap s -> rnf s
- Overlappable s -> rnf s
- Overlapping s -> rnf s
- Overlaps s -> rnf s
- Incoherent s -> rnf s
- NonCanonical s -> rnf s
-
-instance Binary (OverlapMode (GhcPass p)) where
- put_ bh = \case
- NoOverlap s -> putByte bh 0 >> put_ bh s
- Overlaps s -> putByte bh 1 >> put_ bh s
- Incoherent s -> putByte bh 2 >> put_ bh s
- Overlapping s -> putByte bh 3 >> put_ bh s
- Overlappable s -> putByte bh 4 >> put_ bh s
- NonCanonical s -> putByte bh 5 >> put_ bh s
-
- get bh = do
- h <- getByte bh
- case h of
- 0 -> get bh >>= \s -> return $ NoOverlap s
- 1 -> get bh >>= \s -> return $ Overlaps s
- 2 -> get bh >>= \s -> return $ Incoherent s
- 3 -> get bh >>= \s -> return $ Overlapping s
- 4 -> get bh >>= \s -> return $ Overlappable s
- _ -> get bh >>= \s -> return $ NonCanonical s
-
pprSafeOverlap :: Bool -> SDoc
pprSafeOverlap True = text "[safe]"
pprSafeOverlap False = empty
=====================================
compiler/GHC/Hs/Doc.hs
=====================================
@@ -63,16 +63,6 @@ type instance Anno (WithHsDocIdentifiers (HsDocString (GhcPass pass)) (GhcPass p
deriving instance (Data pass, Data (LIdP pass), Data a) => Data (WithHsDocIdentifiers a pass)
deriving instance (Eq (LIdP pass), Eq a) => Eq (WithHsDocIdentifiers a pass)
-instance (UnXRec pass, NFData (IdP pass), NFData a) => NFData (WithHsDocIdentifiers a pass) where
- rnf (WithHsDocIdentifiers d i) = rnf d `seq` rnf (map (unXRec @pass) i)
-
--- | For compatibility with the existing @-ddump-parsed' output, we only show
--- the docstring.
---
--- Use 'pprHsDoc' to show `HsDoc`'s internals.
-instance Outputable a => Outputable (WithHsDocIdentifiers a pass) where
- ppr (WithHsDocIdentifiers s _ids) = ppr s
-
instance Binary a => Binary (WithHsDocIdentifiers a GhcRn) where
put_ bh (WithHsDocIdentifiers s ids) = do
put_ bh s
=====================================
compiler/GHC/Hs/DocString.hs
=====================================
@@ -5,6 +5,8 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
+-- Binary HsDocString
+-- Outputable HsDocString
module GHC.Hs.DocString
( LHsDocString
@@ -44,7 +46,6 @@ import GHC.Hs.Extension.Pass (GhcPass, GhcPs, GhcRn, GhcTc)
import Language.Haskell.Syntax.Doc
import Language.Haskell.Syntax.Extension
-import Control.DeepSeq
import Data.Data
import Data.List.NonEmpty (NonEmpty(..))
import Data.List (intercalate)
@@ -82,11 +83,6 @@ instance (Show (LHsDocStringChunk pass), XXHsDocString pass ~ DataConCantHappen)
instance Outputable (HsDocString (GhcPass p)) where
ppr = text . renderHsDocString
-instance NFData (HsDocString (GhcPass p)) where
- rnf (MultiLineDocString _ a b) = rnf a `seq` rnf b
- rnf (NestedDocString _ a b) = rnf a `seq` rnf b
- rnf (GeneratedDocString _ a) = rnf a
-
-- | Annotate a pretty printed thing with its doc.
-- The docstring comes after if it is 'HsDocStringPrevious'.
-- Otherwise it comes before.
@@ -120,37 +116,12 @@ instance Binary (HsDocString (GhcPass p)) where
2 -> GeneratedDocString noExtField <$> get bh
t -> fail $ "HsDocString: invalid tag " ++ show t
-instance Outputable HsDocStringDecorator where
- ppr = text . printDecorator
-
printDecorator :: HsDocStringDecorator -> String
printDecorator HsDocStringNext = "|"
printDecorator HsDocStringPrevious = "^"
printDecorator (HsDocStringNamed n) = '$':n
printDecorator (HsDocStringGroup n) = replicate n '*'
-instance Binary HsDocStringDecorator where
- put_ bh x = case x of
- HsDocStringNext -> putByte bh 0
- HsDocStringPrevious -> putByte bh 1
- HsDocStringNamed n -> putByte bh 2 >> put_ bh n
- HsDocStringGroup n -> putByte bh 3 >> put_ bh n
- get bh = do
- tag <- getByte bh
- case tag of
- 0 -> pure HsDocStringNext
- 1 -> pure HsDocStringPrevious
- 2 -> HsDocStringNamed <$> get bh
- 3 -> HsDocStringGroup <$> get bh
- t -> fail $ "HsDocStringDecorator: invalid tag " ++ show t
-
-instance Binary HsDocStringChunk where
- put_ bh (HsDocStringChunk bs) = put_ bh bs
- get bh = HsDocStringChunk <$> get bh
-
-instance Outputable HsDocStringChunk where
- ppr = text . unpackHDSC
-
mkGeneratedHsDocStringGhc :: String -> HsDocString (GhcPass p)
mkGeneratedHsDocStringGhc = mkGeneratedHsDocString noExtField . mkHsDocStringChunk
=====================================
compiler/GHC/Hs/ImpExp.hs
=====================================
@@ -447,8 +447,3 @@ coveredByNamespaceSpecifier DataNamespaceSpecifier{} = isValNameSpace
filterByNamespaceSpecifierGREs :: NamespaceSpecifier (GhcPass p) -> [GlobalRdrElt] -> [GlobalRdrElt]
filterByNamespaceSpecifierGREs NoNamespaceSpecifier{} = id
filterByNamespaceSpecifierGREs ns_spec = filterByNamespaceGREs (coveredByNamespaceSpecifier ns_spec)
-
-instance Outputable (NamespaceSpecifier (GhcPass p)) where
- ppr NoNamespaceSpecifier{} = empty
- ppr TypeNamespaceSpecifier{} = text "type"
- ppr DataNamespaceSpecifier{} = text "data"
=====================================
compiler/GHC/Hs/Specificity.hs deleted
=====================================
@@ -1,51 +0,0 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
-module GHC.Hs.Specificity where
-
-import Prelude
-import Control.DeepSeq (NFData(..))
-
-import GHC.Utils.Outputable
-import GHC.Utils.Binary
-
-import Language.Haskell.Syntax.Specificity
-
-{- *********************************************************************
-* *
-* ForAllTyFlag
-* *
-********************************************************************* -}
-
-instance Outputable ForAllTyFlag where
- ppr Required = text "[req]"
- ppr Specified = text "[spec]"
- ppr Inferred = text "[infrd]"
-
-instance Binary Specificity where
- put_ bh SpecifiedSpec = putByte bh 0
- put_ bh InferredSpec = putByte bh 1
-
- get bh = do
- h <- getByte bh
- case h of
- 0 -> return SpecifiedSpec
- _ -> return InferredSpec
-
-instance Binary ForAllTyFlag where
- put_ bh Required = putByte bh 0
- put_ bh Specified = putByte bh 1
- put_ bh Inferred = putByte bh 2
-
- get bh = do
- h <- getByte bh
- case h of
- 0 -> return Required
- 1 -> return Specified
- _ -> return Inferred
-
-instance NFData Specificity where
- rnf SpecifiedSpec = ()
- rnf InferredSpec = ()
-instance NFData ForAllTyFlag where
- rnf (Invisible spec) = rnf spec
- rnf Required = ()
-
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -137,7 +137,6 @@ import GHC.Hs -- Lots of it
import GHC.Core.TyCon ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )
import GHC.Core.DataCon ( DataCon, dataConTyCon, dataConName )
import GHC.Core.ConLike ( ConLike(..) )
-import GHC.Core.Coercion.Axiom ( fsFromRole )
import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Types.Basic
@@ -425,7 +424,7 @@ mkRoleAnnotDecl loc tycon roles anns
where
role_data_type = dataTypeOf (undefined :: Role)
all_roles = map fromConstr $ dataTypeConstrs role_data_type
- possible_roles = [(fsFromRole role, role) | role <- all_roles]
+ possible_roles = [(strFromRole role, role) | role <- all_roles]
parse_role (L loc_role Nothing) = return $ L (noAnnSrcSpan loc_role) Nothing
parse_role (L loc_role (Just role))
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -14,14 +14,6 @@ types that
\end{itemize}
-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-{-
-Above flag is necessary for these instances:
- * Binary Boxity
- * Binary PromotionFlag
- * Outputable Boxity
- * Outputable PromotionFlag
--}
{-# LANGUAGE DerivingVia #-}
module GHC.Types.Basic (
@@ -377,27 +369,6 @@ unSwap NotSwapped f a b = f a b
unSwap IsSwapped f a b = f b a
-{- *********************************************************************
-* *
- Promotion flag
-* *
-********************************************************************* -}
-
-instance Outputable PromotionFlag where
- ppr NotPromoted = text "NotPromoted"
- ppr IsPromoted = text "IsPromoted"
-
-instance Binary PromotionFlag where
- put_ bh NotPromoted = putByte bh 0
- put_ bh IsPromoted = putByte bh 1
-
- get bh = do
- n <- getByte bh
- case n of
- 0 -> return NotPromoted
- 1 -> return IsPromoted
- _ -> fail "Binary(IsPromoted): fail)"
-
{-
************************************************************************
* *
=====================================
compiler/GHC/Types/FieldLabel.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable FieldLabelString
{-
%
@@ -48,7 +47,6 @@ import GHC.Prelude
import {-# SOURCE #-} GHC.Types.Name
-import GHC.Types.Unique (Uniquable(..))
import GHC.Utils.Outputable
import GHC.Utils.Binary
import GHC.Data.FastString
@@ -89,12 +87,6 @@ instance Outputable FieldLabel where
<> ppr (flHasDuplicateRecordFields fl)
<> ppr (flHasFieldSelector fl))
-instance Outputable FieldLabelString where
- ppr (FieldLabelString l) = ppr l
-
-instance Uniquable FieldLabelString where
- getUnique (FieldLabelString fs) = getUnique (mkFastStringShortText fs)
-
-- | Flag to indicate whether the DuplicateRecordFields extension is enabled.
data DuplicateRecordFields
= DuplicateRecordFields -- ^ Fields may be duplicated in a single module
=====================================
compiler/GHC/Types/Fixity.hs
=====================================
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wno-dodgy-exports #-} -- For re-export of GHC.Hs.Basic instances
-
-- | Fixity
module GHC.Types.Fixity
( Fixity (..)
@@ -11,14 +9,12 @@ module GHC.Types.Fixity
, negateFixity
, funTyFixity
, compareFixity
- , module GHC.Hs.Basic
)
where
import GHC.Prelude
import Language.Haskell.Syntax.Basic (LexicalFixity(..), FixityDirection(..), Fixity(..) )
-import GHC.Hs.Basic () -- For instances only
------------------------
=====================================
compiler/GHC/Types/ForeignCall.hs
=====================================
@@ -319,13 +319,6 @@ type instance XXHeader (GhcPass p) = DataConCantHappen
deriving instance Eq (Header (GhcPass p))
-instance NFData (CType (GhcPass p)) where
- rnf (CType ext mh fs) =
- rnf ext `seq` rnf mh `seq` rnf fs
-
-instance NFData (Header (GhcPass p)) where
- rnf (Header s h) =
- rnf s `seq` rnf h
instance NFData CCallStaticTargetUnit where
rnf = \case
@@ -388,14 +381,6 @@ instance forall p. IsPass p => Eq (CCallTarget (GhcPass p)) where
GhcTc -> x1 == x2
_ -> False
-instance forall p. IsPass p => NFData (CCallTarget (GhcPass p)) where
- rnf = \case
- DynamicTarget NoExtField -> ()
- StaticTarget x a b -> rnf a `seq` rnf b `seq` case ghcPass @p of
- GhcPs -> rnf x
- GhcRn -> rnf x
- GhcTc -> rnf x
-
instance forall p. IsPass p => Binary (CCallTarget (GhcPass p)) where
put_ bh = \case
StaticTarget x a b -> do
=====================================
compiler/GHC/Types/InlinePragma.hs
=====================================
@@ -9,16 +9,8 @@
-}
{-# OPTIONS_GHC -Wno-orphans #-}
-{-
-Suppression of warnings are required for instances:
- - Binary Activation
- - Binary CompilerPhase
- - Binary InlinePragma
- - Binary InlineSaturation
- - Binary XActivation
- - Binary XInlinePragmaGhc
- - Outputable CompilerPhase
--}
+-- Required for TTG type-family definitions,
+-- There are no orphan type-class instances
module GHC.Types.InlinePragma
( -- * Inline Pragma Encoding
@@ -494,10 +486,6 @@ no harm.
always returns 'False' when its second argument is 'NeverActive'.
-}
-{- TODO: These orphan instance should be moved to the GHC.Utils.{Binary,Outputable}
-modules once TTG has progressed and the Language.Haskell.Syntax.Types module
-no longer depends on importing GHC.Hs.Doc.
--}
instance Binary XInlinePragmaGhc where
put_ bh (XInlinePragmaGhc s a) = do
put_ bh s
@@ -508,26 +496,6 @@ instance Binary XInlinePragmaGhc where
a <- get bh
return (XInlinePragmaGhc s a)
-instance forall p. IsPass p => Binary (InlinePragma (GhcPass p)) where
- put_ bh (InlinePragma s a b c) = do
- put_ bh a
- put_ bh b
- put_ bh c
- case ghcPass @p of
- GhcPs -> put_ bh s
- GhcRn -> put_ bh s
- GhcTc -> put_ bh s
-
- get bh = do
- a <- get bh
- b <- get bh
- c <- get bh
- s <- case ghcPass @p of
- GhcPs -> get bh
- GhcRn -> get bh
- GhcTc -> get bh
- return (InlinePragma s a b c)
-
instance Binary InlineSaturation where
put_ bh AnySaturation = putByte bh 0
put_ bh (AppliedToAtLeast w) = putByte bh 1 *> put_ bh w
@@ -620,5 +588,24 @@ pprInline' emptyInline (InlinePragma
AnySaturation -> empty
AppliedToAtLeast ar -> parens (text "sat-args=" <> int ar)
+{- TODO: This orphan instance should be moved to GHC.Utils.Outputable once that
+module can import 'GhcPass' without causing an import cycle.
+@
+┌──────▶ GHC.Utils.Outputable
+│ │
+│ │ Needs to access GhcPass for instance:
+│ │ Outputable (InlinePragma (GhcPass p))
+│ ▼
+│ GHC.Hs.Extension.GhcPass
+│ │
+│ │ For GenLocated, SrcSpan, unLoc
+│ ▼
+│ GHC.Types.SrcLoc
+│ │
+│ │ for Outputable, SDoc,
+│ │ pprFastFilePath, ppr combinators
+└───────────────┘
+@
+-}
instance forall p. IsPass p => Outputable (InlinePragma (GhcPass p)) where
ppr = pprInline
=====================================
compiler/GHC/Types/Unique.hs
=====================================
@@ -68,7 +68,8 @@ import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
import GHC.Word ( Word64 )
import Data.Char ( chr, ord, isPrint )
-import Language.Haskell.Syntax.Module.Name
+import Language.Haskell.Syntax.Basic ( FieldLabelString(..) )
+import Language.Haskell.Syntax.Module.Name ( ModuleName(..) )
{-
************************************************************************
@@ -419,6 +420,8 @@ instance Uniquable Word64 where
instance Uniquable ModuleName where
getUnique (ModuleName nm) = getUnique nm
+instance Uniquable FieldLabelString where
+ getUnique (FieldLabelString fs) = getUnique (mkFastStringShortText fs)
{-
************************************************************************
=====================================
compiler/GHC/Types/Var.hs
=====================================
@@ -129,7 +129,6 @@ import GHC.Utils.Binary
import GHC.Utils.Outputable
import GHC.Utils.Panic
-import GHC.Hs.Specificity ()
import Language.Haskell.Syntax.Specificity
import Control.DeepSeq
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -1,5 +1,8 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE DerivingVia #-}
@@ -119,8 +122,13 @@ import GHC.Prelude
import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Binds.InlinePragma
+import Language.Haskell.Syntax.Decls.Overlap
+import Language.Haskell.Syntax.Doc
+import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Module.Name (ModuleName(..))
import Language.Haskell.Syntax.ImpExp.IsBoot (IsBootInterface(..))
+import Language.Haskell.Syntax.Specificity
+import Language.Haskell.Syntax.Type (PromotionFlag(..))
import {-# SOURCE #-} GHC.Types.Name (Name)
import GHC.Data.ShortText (ShortText)
@@ -164,7 +172,7 @@ import qualified Data.Map.Strict as Map
import Data.Proxy
import Data.Set ( Set )
import qualified Data.Set as Set
-import Data.Time
+import Data.Time hiding ( Nominal )
import Data.List (unfoldr)
import System.IO as IO
import System.IO.Error ( mkIOError, eofErrorType )
@@ -1926,6 +1934,85 @@ instance Binary ModuleName where
put_ bh (ModuleName fs) = put_ bh fs
get bh = do fs <- get bh; return (ModuleName fs)
+instance Binary Specificity where
+ put_ bh SpecifiedSpec = putByte bh 0
+ put_ bh InferredSpec = putByte bh 1
+
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> return SpecifiedSpec
+ _ -> return InferredSpec
+
+instance Binary ForAllTyFlag where
+ put_ bh Required = putByte bh 0
+ put_ bh Specified = putByte bh 1
+ put_ bh Inferred = putByte bh 2
+
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> return Required
+ 1 -> return Specified
+ _ -> return Inferred
+
+instance Binary HsDocStringDecorator where
+ put_ bh x = case x of
+ HsDocStringNext -> putByte bh 0
+ HsDocStringPrevious -> putByte bh 1
+ HsDocStringNamed n -> putByte bh 2 >> put_ bh n
+ HsDocStringGroup n -> putByte bh 3 >> put_ bh n
+
+ get bh = do
+ tag <- getByte bh
+ case tag of
+ 0 -> pure HsDocStringNext
+ 1 -> pure HsDocStringPrevious
+ 2 -> HsDocStringNamed <$> get bh
+ 3 -> HsDocStringGroup <$> get bh
+ t -> fail $ "HsDocStringDecorator: invalid tag " ++ show t
+
+instance Binary HsDocStringChunk where
+ put_ bh (HsDocStringChunk bs) = put_ bh bs
+ get bh = HsDocStringChunk <$> get bh
+
+instance ( Binary (XInlinePragma p)
+ , Binary (Activation p)
+ , XXInlinePragma p ~ DataConCantHappen
+ ) => Binary (InlinePragma p) where
+ put_ bh (InlinePragma s a b c) = do
+ put_ bh a
+ put_ bh b
+ put_ bh c
+ put_ bh s
+
+ get bh = do
+ a <- get bh
+ b <- get bh
+ c <- get bh
+ s <- get bh
+ return (InlinePragma s a b c)
+
+instance ( Binary (XOverlapMode p)
+ , XXOverlapMode p ~ DataConCantHappen
+ ) => Binary (OverlapMode p) where
+ put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s
+ put_ bh (Overlaps s) = putByte bh 1 >> put_ bh s
+ put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s
+ put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s
+ put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s
+ put_ bh (NonCanonical s) = putByte bh 5 >> put_ bh s
+
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> get bh >>= \s -> return $ NoOverlap s
+ 1 -> get bh >>= \s -> return $ Overlaps s
+ 2 -> get bh >>= \s -> return $ Incoherent s
+ 3 -> get bh >>= \s -> return $ Overlapping s
+ 4 -> get bh >>= \s -> return $ Overlappable s
+ _ -> get bh >>= \s -> return $ NonCanonical s
+
newtype BinLocated a = BinLocated { unBinLocated :: Located a }
instance Binary a => Binary (BinLocated a) where
@@ -2088,6 +2175,26 @@ instance Binary Boxity where -- implemented via isBoxed-isomorphism to Bool
b <- get bh
pure $ if b then Boxed else Unboxed
+instance Binary Fixity where
+ put_ bh (Fixity aa ab) = do
+ put_ bh aa
+ put_ bh ab
+ get bh = do
+ aa <- get bh
+ ab <- get bh
+ return (Fixity aa ab)
+
+instance Binary FixityDirection where
+ put_ bh InfixL = putByte bh 0
+ put_ bh InfixR = putByte bh 1
+ put_ bh InfixN = putByte bh 2
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> return InfixL
+ 1 -> return InfixR
+ _ -> return InfixN
+
instance Binary ConInfoTable where
get bh = Binary.decode <$> get bh
@@ -2150,3 +2257,49 @@ instance Binary RuleMatchInfo where
h <- getByte bh
if h == 1 then pure ConLike
else pure FunLike
+
+instance Binary Role where
+ put_ bh Nominal = putByte bh 1
+ put_ bh Representational = putByte bh 2
+ put_ bh Phantom = putByte bh 3
+
+ get bh = do tag <- getByte bh
+ case tag of 1 -> return Nominal
+ 2 -> return Representational
+ 3 -> return Phantom
+ _ -> panic ("get Role " ++ show tag)
+
+instance Binary SrcStrictness where
+ put_ bh SrcLazy = putByte bh 0
+ put_ bh SrcStrict = putByte bh 1
+ put_ bh NoSrcStrict = putByte bh 2
+
+ get bh =
+ do h <- getByte bh
+ case h of
+ 0 -> return SrcLazy
+ 1 -> return SrcStrict
+ _ -> return NoSrcStrict
+
+instance Binary SrcUnpackedness where
+ put_ bh SrcNoUnpack = putByte bh 0
+ put_ bh SrcUnpack = putByte bh 1
+ put_ bh NoSrcUnpack = putByte bh 2
+
+ get bh =
+ do h <- getByte bh
+ case h of
+ 0 -> return SrcNoUnpack
+ 1 -> return SrcUnpack
+ _ -> return NoSrcUnpack
+
+instance Binary PromotionFlag where
+ put_ bh NotPromoted = putByte bh 0
+ put_ bh IsPromoted = putByte bh 1
+
+ get bh = do
+ n <- getByte bh
+ case n of
+ 0 -> return NotPromoted
+ 1 -> return IsPromoted
+ _ -> fail "Binary(IsPromoted): fail)"
=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -115,12 +115,17 @@ import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName )
import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Binds.InlinePragma
import Language.Haskell.Syntax.Decls.Overlap ( OverlapMode(..) )
+import Language.Haskell.Syntax.Doc
+import Language.Haskell.Syntax.ImpExp ( NamespaceSpecifier(..) )
import Language.Haskell.Syntax.Module.Name ( ModuleName(..) )
+import Language.Haskell.Syntax.Specificity
import Language.Haskell.Syntax.Text
+import Language.Haskell.Syntax.Type ( PromotionFlag(..) )
import GHC.Prelude.Basic
import GHC.Utils.BufHandle (BufHandle, bPutChar, bPutStr, bPutFS, bPutFZS)
+import GHC.Utils.Encoding ( utf8DecodeByteString )
import GHC.Data.FastString
import qualified GHC.Utils.Ppr as Pretty
import qualified GHC.Utils.Ppr.Colour as Col
@@ -1108,6 +1113,28 @@ instance Outputable Extension where
instance Outputable ModuleName where
ppr = pprModuleName
+instance Outputable FieldLabelString where
+ ppr (FieldLabelString l) = ppr l
+
+instance Outputable ForAllTyFlag where
+ ppr Required = text "[req]"
+ ppr Specified = text "[spec]"
+ ppr Inferred = text "[infrd]"
+
+instance Outputable HsDocStringDecorator where
+ ppr HsDocStringNext = text "|"
+ ppr HsDocStringPrevious = text "^"
+ ppr (HsDocStringNamed n) = char '$' <> text n
+ ppr (HsDocStringGroup n) = text (replicate n '*')
+
+instance Outputable HsDocStringChunk where
+ ppr (HsDocStringChunk bs) = text (utf8DecodeByteString bs)
+
+-- | For compatibility with the existing @-ddump-parsed@ output, we only show
+-- the docstring.
+instance Outputable a => Outputable (WithHsDocIdentifiers a pass) where
+ ppr (WithHsDocIdentifiers s _ids) = ppr s
+
instance Outputable OsPath where
ppr p = text $ either show id (decodeUtf p)
@@ -2039,6 +2066,35 @@ instance Outputable TopLevelFlag where
ppr TopLevel = text "<TopLevel>"
ppr NotTopLevel = text "<NotTopLevel>"
+instance Outputable LexicalFixity where
+ ppr Prefix = text "Prefix"
+ ppr Infix = text "Infix"
+
+instance Outputable FixityDirection where
+ ppr InfixL = text "infixl"
+ ppr InfixR = text "infixr"
+ ppr InfixN = text "infix"
+
+instance Outputable Fixity where
+ ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
+
+instance Outputable SrcStrictness where
+ ppr SrcLazy = char '~'
+ ppr SrcStrict = char '!'
+ ppr NoSrcStrict = empty
+
+instance Outputable SrcUnpackedness where
+ ppr SrcUnpack = text "{-# UNPACK #-}"
+ ppr SrcNoUnpack = text "{-# NOUNPACK #-}"
+ ppr NoSrcUnpack = empty
+
+instance Outputable PromotionFlag where
+ ppr NotPromoted = text "NotPromoted"
+ ppr IsPromoted = text "IsPromoted"
+
+instance Outputable Role where
+ ppr = ftext . strFromRole
+
instance Outputable (OverlapMode p) where
ppr (NoOverlap _) = empty
ppr (Overlappable _) = text "[overlappable]"
@@ -2047,3 +2103,9 @@ instance Outputable (OverlapMode p) where
ppr (Incoherent _) = text "[incoherent]"
ppr (NonCanonical _) = text "[noncanonical]"
ppr (XOverlapMode _) = text "[user TTG extension]"
+
+instance Outputable (NamespaceSpecifier p) where
+ ppr NoNamespaceSpecifier{} = empty
+ ppr TypeNamespaceSpecifier{} = text "type"
+ ppr DataNamespaceSpecifier{} = text "data"
+ ppr (XNamespaceSpecifier _) = text "[user TTG extension]"
=====================================
compiler/Language/Haskell/Syntax/Basic.hs
=====================================
@@ -8,6 +8,7 @@ import Data.Data (Data)
import Data.Eq
import Data.Ord
import Data.Bool
+import Data.String (IsString(..))
import Prelude
{-
@@ -93,6 +94,20 @@ Field Labels
data Role = Nominal | Representational | Phantom
deriving (Eq, Ord, Data)
+instance NFData Role where
+ rnf Nominal = ()
+ rnf Representational = ()
+ rnf Phantom = ()
+
+-- These names are slurped into the parser code. Changing these strings
+-- will change the **surface syntax** that GHC accepts! If you want to
+-- change only the pretty-printing, do some replumbing. See
+-- mkRoleAnnotDecl in GHC.Parser.PostProcess
+strFromRole :: IsString s => Role -> s
+strFromRole Nominal = fromString "nominal"
+strFromRole Representational = fromString "representational"
+strFromRole Phantom = fromString "phantom"
+
{-
************************************************************************
* *
@@ -109,6 +124,11 @@ data SrcStrictness = SrcLazy -- ^ Lazy, ie '~'
| NoSrcStrict -- ^ no strictness annotation
deriving (Eq, Data)
+instance NFData SrcStrictness where
+ rnf SrcLazy = ()
+ rnf SrcStrict = ()
+ rnf NoSrcStrict = ()
+
-- | Source Unpackedness
--
-- What unpackedness the user requested
@@ -117,6 +137,11 @@ data SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified
| NoSrcUnpack -- ^ no unpack pragma
deriving (Eq, Data)
+instance NFData SrcUnpackedness where
+ rnf SrcNoUnpack = ()
+ rnf SrcUnpack = ()
+ rnf NoSrcUnpack = ()
+
{-
************************************************************************
* *
=====================================
compiler/Language/Haskell/Syntax/Decls/Foreign.hs
=====================================
@@ -74,7 +74,7 @@ import Control.DeepSeq
import Data.Data hiding (TyCon, Fixity, Infix)
import Data.Maybe
import Data.Eq
-import Prelude (Enum, Show)
+import Prelude (Enum, Show, seq)
{-
************************************************************************
@@ -211,6 +211,12 @@ data CCallTarget pass
| DynamicTarget (XDynamicTarget pass)
| XCCallTarget !(XXCCallTarget pass)
+instance (NFData (XStaticTarget pass), NFData (XDynamicTarget pass), NFData (XXCCallTarget pass))
+ => NFData (CCallTarget pass) where
+ rnf (StaticTarget x a b) = rnf a `seq` rnf b `seq` rnf x -- 'x' is forced last to match "legacy" GHC semantics
+ rnf (DynamicTarget x) = rnf x
+ rnf (XCCallTarget x) = rnf x
+
data CExportSpec
-- | foreign export ccall foo :: ty
= CExportStatic
@@ -228,6 +234,11 @@ data CType pass
HText
| XCType !(XXCType pass)
+instance (NFData (XCType pass), NFData (Header pass), NFData (XXCType pass))
+ => NFData (CType pass) where
+ rnf (CType ext mh fs) = rnf ext `seq` rnf mh `seq` rnf fs
+ rnf (XCType x) = rnf x
+
-- | The filename for a C header file
data Header pass
= Header
@@ -235,6 +246,10 @@ data Header pass
HText
| XHeader !(XXHeader pass)
+instance (NFData (XHeader pass), NFData (XXHeader pass)) => NFData (Header pass) where
+ rnf (Header s h) = rnf s `seq` rnf h
+ rnf (XHeader x) = rnf x
+
data Safety
= PlaySafe -- ^ Might invoke Haskell GC, or do a call back, or
-- switch threads, etc. So make sure things are
=====================================
compiler/Language/Haskell/Syntax/Doc.hs
=====================================
@@ -65,6 +65,18 @@ data HsDocString pass
| XHsDocString
!(XXHsDocString pass)
+instance
+ ( NFData (XMultiLineDocString pass)
+ , NFData (XNestedDocString pass)
+ , NFData (XGeneratedDocString pass)
+ , NFData (XXHsDocString pass)
+ , NFData (LHsDocStringChunk pass)
+ ) => NFData (HsDocString pass) where
+ rnf (MultiLineDocString x a b) = rnf x `seq` rnf a `seq` rnf b
+ rnf (NestedDocString x a b) = rnf x `seq` rnf a `seq` rnf b
+ rnf (GeneratedDocString x a) = rnf x `seq` rnf a
+ rnf (XHsDocString x) = rnf x
+
mkGeneratedHsDocString :: XGeneratedDocString p -> HsDocStringChunk -> HsDocString p
mkGeneratedHsDocString x = GeneratedDocString x
@@ -110,3 +122,6 @@ data WithHsDocIdentifiers a pass = WithHsDocIdentifiers
{ hsDocString :: !a
, hsDocIdentifiers :: ![LIdP pass]
}
+
+instance (UnXRec pass, NFData (IdP pass), NFData a) => NFData (WithHsDocIdentifiers a pass) where
+ rnf (WithHsDocIdentifiers d i) = rnf d `seq` rnf (map (unXRec @pass) i)
=====================================
compiler/Language/Haskell/Syntax/Extension.hs
=====================================
@@ -9,6 +9,7 @@ module Language.Haskell.Syntax.Extension where
-- This module captures the type families to precisely identify the extension
-- points for GHC.Hs syntax
+import Control.DeepSeq
import Data.Type.Equality (type (~))
import Data.Data hiding ( Fixity )
@@ -16,6 +17,7 @@ import Data.Kind (Type)
import Data.Eq
import Data.Ord
+import Text.Show
{-
Note [Trees That Grow]
@@ -62,6 +64,9 @@ See also Note [IsPass] and Note [NoGhcTc] in GHC.Hs.Extension.
data NoExtField = NoExtField
deriving (Data,Eq,Ord)
+instance NFData NoExtField where
+ rnf NoExtField = ()
+
-- | Used when constructing a term with an unused extension point.
noExtField :: NoExtField
noExtField = NoExtField
@@ -95,7 +100,10 @@ can only do that if the extension field was strict (#18764).
See also [DataConCantHappen and strict fields].
-}
data DataConCantHappen
- deriving (Data,Eq,Ord)
+ deriving (Data,Eq,Ord,Show)
+
+instance NFData DataConCantHappen where
+ rnf = dataConCantHappen
-- | Eliminate a 'DataConCantHappen'. See Note [Constructor cannot occur].
dataConCantHappen :: DataConCantHappen -> a
=====================================
compiler/Language/Haskell/Syntax/ImpExp.hs
=====================================
@@ -1,4 +1,6 @@
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
+ -- in module Language.Haskell.Syntax.Extension
module Language.Haskell.Syntax.ImpExp ( module Language.Haskell.Syntax.ImpExp, IsBootInterface(..) ) where
import Language.Haskell.Syntax.Doc (LHsDoc)
@@ -6,9 +8,9 @@ import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Module.Name
import Language.Haskell.Syntax.ImpExp.IsBoot ( IsBootInterface(..) )
-import Data.Eq (Eq)
+import Data.Eq (Eq(..))
import Data.Data (Data)
-import Data.Bool (Bool)
+import Data.Bool (Bool(..))
import Data.Maybe (Maybe)
import Data.String (String)
import Data.Int (Int)
=====================================
compiler/Language/Haskell/Syntax/Specificity.hs
=====================================
@@ -14,6 +14,7 @@ module Language.Haskell.Syntax.Specificity (
import Prelude
+import Control.DeepSeq (NFData(..))
import Data.Data
-- | ForAllTyFlag
@@ -27,6 +28,10 @@ data ForAllTyFlag = Invisible !Specificity
deriving (Eq, Ord, Data)
-- (<) on ForAllTyFlag means "is less visible than"
+instance NFData ForAllTyFlag where
+ rnf (Invisible spec) = rnf spec
+ rnf Required = ()
+
-- | Whether an 'Invisible' argument may appear in source Haskell.
data Specificity = InferredSpec
-- ^ the argument may not appear in source Haskell, it is
@@ -36,6 +41,10 @@ data Specificity = InferredSpec
-- required.
deriving (Eq, Ord, Data)
+instance NFData Specificity where
+ rnf SpecifiedSpec = ()
+ rnf InferredSpec = ()
+
pattern Inferred, Specified :: ForAllTyFlag
pattern Inferred = Invisible InferredSpec
pattern Specified = Invisible SpecifiedSpec
=====================================
compiler/ghc.cabal.in
=====================================
@@ -566,7 +566,6 @@ Library
GHC.Hs.Instances
GHC.Hs.Lit
GHC.Hs.Pat
- GHC.Hs.Specificity
GHC.Hs.Stats
GHC.HsToCore
GHC.HsToCore.Arrows
=====================================
testsuite/tests/count-deps/CountDepsParser.stdout
=====================================
@@ -113,7 +113,6 @@ GHC.Hs.ImpExp
GHC.Hs.Instances
GHC.Hs.Lit
GHC.Hs.Pat
-GHC.Hs.Specificity
GHC.Hs.Type
GHC.Hs.Utils
GHC.HsToCore.Breakpoints.Types
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6a44d2183ac0f166b0bad93d13b8fb…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6a44d2183ac0f166b0bad93d13b8fb…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/TTG-No-Orphans] 44 commits: driver: enable -finter-module-far-jumps by default
by recursion-ninja (@recursion-ninja) 20 Jul '26
by recursion-ninja (@recursion-ninja) 20 Jul '26
20 Jul '26
recursion-ninja pushed to branch wip/TTG-No-Orphans at Glasgow Haskell Compiler / GHC
Commits:
57c0f32c by mangoiv at 2026-07-10T11:08:38-04:00
driver: enable -finter-module-far-jumps by default
this fixes a compatibility bug with certain binutils/gcc versions where
we were seeing jump offset overflow errors.
This commit can probably reverted if we stop supporting the problematic
binutils/gcc verions (2.44 and 14.2, respectively)
Reolves #26994
- - - - -
4396a6f2 by Andrea Vezzosi at 2026-07-10T11:09:25-04:00
[Fix #27287] preserve ModBreaks in ModIface
- - - - -
ed261a7e by Cheng Shao at 2026-07-14T17:59:38-04:00
hadrian: fix HLS support
This patch fixes hadrian's HLS support so one can rely on HLS when
working on the hadrian codebase. Fixes #27480.
Not building/linking shared libraries for hadrian is a severely
premature optimization; this top-level setting in `cabal.project` only
affects home packages while the dependencies in the cabal store are
built with vanilla/dynamic anyway, and even adding dynamic builds to
home packages would not be costly due to cabal's usage of
`-dynamic-too`.
- - - - -
eee8ec5b by Cheng Shao at 2026-07-14T18:00:20-04:00
compiler: fix miscompiled %load_relaxed, add missing %store_relaxed
This patch fixes the %load_relaxed cmm primop compilation logic to
correctly use relaxed memory ordering, and adds the missing
%store_relaxed primop. Parsing logic of %load/%store with explicit
ordering is covered in the AtomicFetch test case. Fixes #27483.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
1718230f by Alan Zimmerman at 2026-07-14T18:01:06-04:00
EPA: Keep binds and sigs together in HsValBindsLR
We combine them into a single list for GhcPs, wrapped in the
ValBind data type, which is the bind equivalent of ValD, having
constructors for binds and sigs.
This simplifies exact print processing, especially when using it to
update the contents of local binds, as we no longer need AnnSortKey
BindTag
- - - - -
6bd1ad2a by Andreas Klebinger at 2026-07-14T18:01:49-04:00
Bump nofib submodule to account for MonoLocalBinds.
New versions of GHC enable MonoLocalBinds by default.
This breaks some of the benchmarks. I've fixed this and
this bump pulls in that fix.
- - - - -
7eb0f1c9 by Cheng Shao at 2026-07-14T18:02:31-04:00
testsuite: fix bytecodeIPE test under +ipe flavours
This patch fixes the bytecodeIPE test under +ipe flavours. It used to
fail under +ipe because the RTS is built with IPE info, then
stg_AP_info in RTS carries IPE info, so whereFrom wouldn't return
Nothing. Now the test checks IPE info of a datacon in the ghci-loaded
module which is not affected by whether the RTS is built with IPE info
or not. Fixes #27498.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
ef038aae by cydparser at 2026-07-15T04:35:41-04:00
Reduce bytes allocated for `capabilities` in RTS (fixes #27487)
In rts/Capability.c, `capabilities` is an array of pointers, but it was allocated as if it were an
array of Capability's.
- - - - -
d377e83e by Cheng Shao at 2026-07-15T04:36:27-04:00
rts: fix missing UNTAG in stg_readTVarIOzh
This patch fixes missing UNTAG on the current value closure read from
StgTVar. UNTAG is a no-op when it's stg_TREC_HEADER_info which is word
aligned; it may be a tagged closure, and reading info table from the
tagged address is an unaligned load which may cause issues on
platforms with strict alignment requirements.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
8ed03842 by Cheng Shao at 2026-07-15T04:36:27-04:00
rts: fix missing UNTAG in stg_control0zh_ll
This patch fixes missing UNTAG on the cont closure returned by
captureContinuationAndAbort. In case it's not NULL,
captureContinuationAndAbort returns a tagged StgContinuation closure,
in which case it must be untagged before accessing the
apply_mask_frame field.
In the past it worked out of luck: when apply_mask_frame was NULL then
mask_frame_offset is also 0 so the control flow didn't diverge to a
wrong path. Still, this is horribly wrong and will crash once
StgContinuation struct is refactored and fields are shuffled around.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
5aa7000a by Cheng Shao at 2026-07-15T04:37:08-04:00
compiler: fix redundant AP thunk codegen when not using -ticky-ap-thunk
This patch fixes a double negation confusion in !7525 that results in
some redundant AP thunk code generation when not using
-ticky-ap-thunk. Now, we use `stgToCmmUseStdApThunk` to indicate
whether precomputed AP thunks in the RTS should be used, which
defaults to `True`, unless `-ticky-ap-thunk` is passed.
`-finfo-table-map` now also implies `-ticky-ap-thunk`, since when
doing IPE profiling we want the generated AP thunks to be unique.
Fixes #27502.
-------------------------
Metric Decrease:
T3064
-------------------------
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
d43a7b7a by Brian McKenna at 2026-07-15T20:10:04+02:00
Strip ticks when desugaring bool guards
The special `considerAccessible` pattern was broken when compiling
with debug info. Compiling with debug info wraps expressions with
`SourceNote` ticks, which broke the internals of the
`desugarBoolGuard` function. Ticks are now ignored within this
function.
Fixes #27360
- - - - -
ede4b17b by Ben Gamari at 2026-07-15T22:59:53-04:00
base: Display ExceptionContext in WhileHandling's textual description
As originally-implemented the implementation for
`WhileHandling(displayExceptionAnnotation)` would display the
`ExceptionContext` of the exception which it carries (as this was the
behavior of `displayException`, in terms of which
`displayExceptionAnnotation` was implemented).
However, in 284ffab3 the definition of `SomeException(displayException)`
was changed to exclude the `ExceptionContext`. This means that
`WhileHandling(displayExceptionAnnotation)` fails to describe the
provenance of the exception which it captures, greatly limiting its
utility.
Return the implementation to its originally-specified behavior by
implementing `WhileHandling(displayExceptionAnnotation)` in terms of
`displayExceptionWithInfo`.
Fixes #27456.
- - - - -
0f64f348 by Cheng Shao at 2026-07-16T15:41:08+00:00
ci: add missing docker permission workaround in abi-test job
- - - - -
660cb239 by Cheng Shao at 2026-07-16T19:37:48+00:00
bindist: Fix make install -j race condition on macos/freebsd
This patch fixes make install -j race condition on macos/freebsd. BSD
install fails with EEXIST when multiple install processes concurrently
create the same prefix directory. So we add an `install_dirs`
prerequisite job that sequentially creates the directories for
subsequent jobs to work with. Fixes #27499.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
08130257 by Cheng Shao at 2026-07-16T19:37:48+00:00
ci: run bindist make install with -j
This patch makes the ci scripts run `make install` with `-j` to reduce
wall clock time when installing the bindist, see related issue for
benchmark numbers. This only affects ghc ci logic, the user-facing
default is up to distributors and is still `-j1`. Closes #27029.
- - - - -
d5ae6906 by Adam Gundry at 2026-07-17T04:57:43-04:00
Mark various language extension flags as deprecated (see #27329)
The following language extensions are now deprecated:
- AlternativeLayoutRule
- AlternativeLayoutRuleTransitional
- ParallelArrays
- PolymorphicComponents
- Rank2Types
In addition, the warning `-Walternative-layout-rule-transitional`
has been marked as deprecated, as it is emitted only under the
deprecated extension `XAlternativeLayoutRuleTransitional`.
- - - - -
fe3b059c by Andrew Lelechenko at 2026-07-17T04:58:26-04:00
base: re-export GHC.Environment.getFullArgs from System.Environment
CLC proposal https://github.com/haskell/core-libraries-committee/issues/431
- - - - -
722236dd by sheaf at 2026-07-18T08:48:31-04:00
Coercion optimisation: avoid double-Sym for InstCo
Ticket #27374 pointed out an issue with GHC.Core.Coercion.Opt.optCoercion's
handling of InstCo: it contravened (LC2) in Note [The LiftingContext in optCoercion]
because it applied the ambient 'sym' to a coercion that was then added
to the lifting context substitution.
Fixes #27374
Co-authored-by: Simon Jakobi <simon.jakobi(a)gmail.com>
- - - - -
ff70fc75 by sheaf at 2026-07-18T08:48:31-04:00
Coercion optimisation: avoid exponential behaviour
The change to coercion optimisation of 'InstCo' in the previous commit
introduces exponential behaviour to the coercion optimiser. To avoid
this, this commit provides a way to push in 'Sym' of an already-optimised
coercion: GHC.Core.Coercion.Opt.mkDeepSymCo.
See Note [Pushing Sym without re-optimising] in GHC.Core.Coercion.Opt.
- - - - -
dfef27f0 by Duncan Coutts at 2026-07-18T08:49:12-04:00
Move THREADED_RTS-conditional struct members to end of Capability
Accessing members of the Capability struct from CMM code rely on
accessor macros. (The macros are generated by deriveConstants).
These macros have a single definition. This means that the offsets of
all struct members must *not* vary based on THREADED_RTS vs
!THREADED_RTS. This requires that any struct members that are
conditional on THREADED_RTS must occur after the unconditional struct
members. Hence we move all the ones that are conditional on
THREADED_RTS to the end.
Add a deriveConstants entry for the iomgr member of the Capability
struct, which was the motivation for this change.
Add warning messages to help our future selves. Debugging this took me
a couple hours in gdb!
- - - - -
c254e022 by Duncan Coutts at 2026-07-18T08:49:12-04:00
Make the IOManager API use CapIOManager rather than Capability
This makes the API somewhat more self-contained and more consistent.
Now the IOManager API and each of the backends takes just the I/O
manager structure. Previously we had a bit of a mixture, depending on
whether the function needed access to the Capability or just the
CapIOManager.
We still need access to the cap, so we introduce a back reference to
reach the capability, via iomgr->cap.
Convert all uses in select and poll backends, but not win32 ones.
Convert callers in the scheduler and elsewhere.
Also convert the three CMM primops that call IOManager APIs. They just
need to use Capability_iomgr(MyCapability()).
- - - - -
4f3d8f31 by Duncan Coutts at 2026-07-18T08:49:12-04:00
Split posix/MIO.c out of posix/Signals.c
The MIO I/O manager was secretly living inside the Signals file.
Now it gets its own file, like any other self-respecting I/O manager.
- - - - -
52ce04a9 by Duncan Coutts at 2026-07-18T08:49:12-04:00
Rationalise some scheduler run queue utilities
Move them all to the same place in the file.
Make some static that were used only internally.
Also remove a redundant assignment after calling truncateRunQueue that
is already done within truncateRunQueue.
- - - - -
75bbdebc by Duncan Coutts at 2026-07-18T08:49:12-04:00
Rename initIOManager{AfterFork} to {re}startIOManager
These are more accurate names, since these actions happen after
initialisation and are really about starting (or restarting) background
threads.
- - - - -
724c0517 by Duncan Coutts at 2026-07-18T08:49:12-04:00
Free per-cap I/O managers during shutdown and forkProcess
Historically this was not strictly necessary. The select and win32
legacy I/O managers did not maintain any dynamically allocated
resources. The new poll one does (an auxillary table), and so this
should be freed.
After forkProcess, all threads get deleted. This includes threads
waiting on I/O or timers. So as of this patch, resetting the I/O
manager is just about tidying things up. For example, for the poll
I/O manager this will reset the size of the AIOP table (which
otherwise grows but never shrinks).
In future however the re-initialising will become neeecessary for
functionality, since some I/O managers will need to re-initialise
wakeup fds that are set CLOEXEC.
- - - - -
c007d122 by Duncan Coutts at 2026-07-18T08:49:12-04:00
Add a TODO to the MIO I/O manager
The direction of travel is to make I/O managers per-capability and have
all their state live in the struct CapIOManager. The MIO I/O manager
however still has a number of global variables.
It's not obvious how handle these globals however.
- - - - -
b65ab7b3 by Duncan Coutts at 2026-07-18T08:49:12-04:00
Add a FIXME note in the Poll I/O manager
- - - - -
daf2bd6f by Duncan Coutts at 2026-07-18T08:49:12-04:00
Add missing updateRemembSetPushClosure in poll I/O manager
For the non-moving GC.
- - - - -
e33ca830 by Duncan Coutts at 2026-07-18T08:49:12-04:00
Minor doc improvement to struct StgAsyncIOOp member outcome
Mention the enumeration names, as well as their numeric values. The rest
of the code uses the enum names.
- - - - -
4edd2579 by Duncan Coutts at 2026-07-18T08:49:12-04:00
Minor doc improvements for StgTSOBlockInfo
Clarify that certain union members are used only by certain legacy
I/O managers. Hopefully we will be able to remove these at some point.
- - - - -
536bedbb by Duncan Coutts at 2026-07-18T08:49:12-04:00
Avoid exporting various win32-specific rts symbols
The BeginPrivate.h / EndPrivate.h scheme works perfectly well on
Windows, but all of the rts/win32/*.h files were not using it.
- - - - -
8139b5ac by Duncan Coutts at 2026-07-18T08:49:12-04:00
Remove wakeupIOManager, ioManagerWakeup and setIOManagerWakeupFd
We no longer need wakeupIOManager for the threaded RTS case, so we can
remove it and the bits only needed to support it. This includes the
pipe/eventfd fd shared between the RTS and the in-library I/O manager
used for waking up the I/O manager thread. The pipe/eventfd still
exists, but it no longer has to be communicated to the RTS, since the
RTS no longer needs to use it.
So we remove the RTS API export setIOManagerWakeupFd, and remove uses of
it within the I/O managers in ghc-internal.
- - - - -
74fe7c66 by Duncan Coutts at 2026-07-18T08:49:12-04:00
Add a new interruptIOManager API for the I/O managers
It will be used to interrupt awaitCompletedTimeoutsOrIO. Also update the
return type and docs for awaitCompletedTimeoutsOrIO to have it return
false when it gets interrupted, and have no useful post condition in
that case.
- - - - -
38792843 by Duncan Coutts at 2026-07-18T08:49:13-04:00
Add interruptIOManager support for select I/O manager
Uses the FdWakup mechanism.
- - - - -
2f3b00aa by Duncan Coutts at 2026-07-18T08:49:13-04:00
Add interruptIOManager support for poll I/O manager
Uses the FdWakup mechanism.
A quirk we have to cope with is that we now need to poll one more fd --
the wakeup_fd_r -- but this fd has no corresponding entry in the
aiop_table. This is awkward since we have set up our aiop_poll_table to
be an auxilliary table with matching indicies.
The solution this patch uses (and described in the comments) is to have
two tables: struct pollfd *aiop_poll_table, *full_poll_table;
and to have the aiop_poll_table alias the tail of the full_poll_table.
The head entry in the full_poll_table is the extra fd. So we poll the
full_poll_table, while the aiop_poll_table still has matching indicies
with the aiop_table.
Hurrah for C aliasing rules.
- - - - -
cee50131 by Duncan Coutts at 2026-07-18T08:49:13-04:00
Add interruptIOManager support for win32 legacy I/O manager
And remove unused related helper resetAbandonRequestWait. It is not
called because the event is created in auto-reset mode, so never needs
to be reset manually.
- - - - -
cf453143 by Duncan Coutts at 2026-07-18T08:49:13-04:00
Note lack of interruptIOManager support for WinIO I/O manager
Though there's a plausible design, we can't sanely test it at the moment
due to related WinIO bugs. Filed as issue #27403.
- - - - -
1b74a0ad by Duncan Coutts at 2026-07-18T08:49:13-04:00
Be more explicit about enum IOReadOrWrite values, and type within cmm
Belt and braces.
- - - - -
b388d093 by Brian McKenna at 2026-07-18T17:51:50-04:00
Ignore ticks in the pattern-match term oracle
The term-oracle in the pattern-match checker is keyed by a canonical
form of the scrutinee, computed by `makeDictsCoherent`. That canonical
form was tick-sensitive: two occurrences of an otherwise identical
expression that happened to carry different ticks were treated as
distinct values, breaking long-distance information.
This shows up in practice under `-finfo-table-map`, because the
desugarer wraps every record-selector use site in a `SourceNote`
carrying that site's span. For example:
data Box = Box { unBox :: Maybe Int }
f b = case unBox b of
Nothing -> 0
Just _ -> let Just x = unBox b in x
The two `unBox b` expressionss carry different SourceNote spans, the
pattern-match checker sees them as different, the long-distance
information from the outer `Just _` branch never reaches the
let-pattern, and `Just x = unBox b` is wrongly reported as
non-exhaustive.
We now strip all ticks in `makeDictsCoherent`. This is documented as
Wrinkle (UD1) of Note [Unique dictionaries in the TmOracle CoreMap].
Fixes #27314
- - - - -
c23e1acb by Mrjtjmn at 2026-07-18T17:52:45-04:00
Add explanations for unsolved Typeable constraints
This commit adds explanations for unsolved 'Typeable' constraints.
GHC will now provide additional explanations for an unsolved constraint
of the form 'Typeable ty', explain why GHC did not solve Typeable constraint.
e.g.:
- 'ty' is a polymorphic type (e.g. forall a. a -> a)
- 'ty' is a qualified type (e.g. Eq Int => Int)
- 'ty' is an unboxed sum type
- 'ty' is an unreduced type family application
- 'ty' whose kind is not typeable
Fixes #26532
- - - - -
cbef021e by Artem Pelenitsyn at 2026-07-19T07:49:55-04:00
ghc-internal: Lock.hs: fix typo and indentation
- - - - -
42918646 by Duncan Coutts at 2026-07-19T07:50:36-04:00
Fix failing test GcStaticPointers for non-moving GC
Minor mistake in asserting something before checking for that same
thing.
Specifically, Bdescr asserts HEAP_ALLOCED_GC, but Bdescr was being used
prior to a guard that checks HEAP_ALLOCED_GC. The solution is just to
move the use of Bdescr after the guard.
Thanks to Simon Jakobi for identifying the problem.
- - - - -
7c4258a0 by Recursion Ninja at 2026-07-20T08:47:05-04:00
First pass of orphan instance removal.
This is part of a technical debt removal effort made possible
now that seperating out the AST via TTG comes to a close.
As the AST in 'L.H.S' has been incrementally separated from the GHC internals,
there are many accumulated orphan instance of 'Binary', 'Outputable', 'Uniquable', etc.
The orphan instance of data-types from within 'L.H.S' are having thier orphan
instances moved to the module which defined the type-class; i.e. moving an orphan
'Binary' instance to 'GHC.Utils.Binary'.
Orphan instances resolved (37):
| Data-type | Resolved instance(s) | Former orphan module(s) |
| -------------------- | -------------------------- | ------------------------- |
| Role | Binary, NFData, Outputable | GHC.Core.Coercion.Axiom |
| SrcStrictness | Binary, NFData, Outputable | GHC.Core.DataCon |
| SrcUnpackedness | Binary, NFData, Outputable | GHC.Core.DataCon |
| Fixity | Binary, Outputable | GHC.Hs.Basic |
| FixityDirection | Binary, Outputable | GHC.Hs.Basic |
| LexicalFixity | Outputable | GHC.Hs.Basic |
| CCallTarget | NFData | GHC.Hs.Decls.Foreign |
| CType | NFData | GHC.Hs.Decls.Foreign |
| Header | NFData | GHC.Hs.Decls.Foreign |
| OverlapMode | Binary, NFData | GHC.Hs.Decls.Overlap |
| WithHsDocIdentifiers | NFData, Outputable | GHC.Hs.Doc |
| HsDocString | NFData | GHC.Hs.DocString |
| HsDocStringChunk | Binary, Outputable | GHC.Hs.DocString |
| HsDocStringDecorator | Binary, Outputable | GHC.Hs.DocString |
| NamespaceSpecifier | Outputable | GHC.Hs.ImpExp |
| ForAllTyFlag | Binary, NFData, Outputable | GHC.Hs.Specificity |
| Specificity | Binary, NFData | GHC.Hs.Specificity |
| PromotionFlag | Binary, Outputable | GHC.Types.Basic |
| FieldLabelString | Outputable, Uniquable | GHC.Types.FieldLabel |
| InlinePragma | Binary | GHC.Types.InlinePragma |
-------------------------
Metric Decrease:
hard_hole_fits
-------------------------
Closes #21262, #27469
- - - - -
213 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- + changelog.d/T26532
- + changelog.d/T27314.md
- + changelog.d/T27329
- + changelog.d/T27360
- + changelog.d/T27374
- + changelog.d/T27456
- + changelog.d/fix-cmm-atomic-load-store
- + changelog.d/fix-make-install-j
- + changelog.d/fix-use-std-ap-thunk
- + changelog.d/inter-module-far-jumps-aarch64-default
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Core/Coercion/Axiom.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main/Compile.hs
- compiler/GHC/Driver/Main/Hsc.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Basic.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls/Overlap.hs
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/Hs/DocString.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Hs/Instances.hs
- − compiler/GHC/Hs/Specificity.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- + compiler/GHC/HsToCore/Breakpoints/Types.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Platform/Ways.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/Config.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Tc/Types/Rank.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/FieldLabel.hs
- compiler/GHC/Types/Fixity.hs
- compiler/GHC/Types/ForeignCall.hs
- compiler/GHC/Types/InlinePragma.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- compiler/GHC/Unit/Module/ModIface.hs
- compiler/GHC/Unit/Module/WholeCoreBindings.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/Basic.hs
- compiler/Language/Haskell/Syntax/Binds.hs
- compiler/Language/Haskell/Syntax/Decls/Foreign.hs
- compiler/Language/Haskell/Syntax/Doc.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/ImpExp.hs
- compiler/Language/Haskell/Syntax/Specificity.hs
- compiler/ghc.cabal.in
- docs/users_guide/expected-undocumented-flags.txt
- docs/users_guide/exts/rank_polymorphism.rst
- docs/users_guide/exts/static_pointers.rst
- docs/users_guide/using-optimisation.rst
- ghc/GHCi/UI.hs
- hadrian/bindist/Makefile
- hadrian/cabal.project
- libraries/base/changelog.md
- libraries/base/src/System/Environment.hs
- libraries/base/tests/T15349.stderr
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Manager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock.hs
- libraries/ghc-internal/tests/backtraces/T14532b.stdout
- nofib
- rts/Capability.c
- rts/Capability.h
- rts/ContinuationOps.cmm
- rts/IOManager.c
- rts/IOManager.h
- rts/IOManagerInternals.h
- rts/PrimOps.cmm
- rts/RaiseAsync.c
- rts/RtsStartup.c
- rts/RtsSymbols.c
- rts/Schedule.c
- rts/Schedule.h
- rts/include/rts/IOInterface.h
- rts/include/rts/storage/Closures.h
- rts/include/rts/storage/TSO.h
- rts/posix/FdWakeup.h
- + rts/posix/MIO.c
- + rts/posix/MIO.h
- rts/posix/Poll.c
- rts/posix/Poll.h
- rts/posix/Select.c
- rts/posix/Select.h
- rts/posix/Signals.c
- rts/posix/Signals.h
- rts/posix/Timeout.c
- rts/posix/Timeout.h
- rts/rts.cabal
- rts/sm/NonMovingMark.c
- rts/win32/AsyncMIO.c
- rts/win32/AsyncMIO.h
- rts/win32/AsyncWinIO.h
- rts/win32/AwaitEvent.c
- rts/win32/AwaitEvent.h
- rts/win32/ConsoleHandler.h
- rts/win32/MIOManager.h
- rts/win32/ThrIOManager.h
- rts/win32/WorkQueue.h
- rts/win32/veh_excn.h
- testsuite/tests/backpack/should_compile/T13149.bkp
- testsuite/tests/cmm/should_run/AtomicFetch.hs
- testsuite/tests/cmm/should_run/AtomicFetch_cmm.cmm
- testsuite/tests/codeGen/should_run/cgrun025.stderr
- + testsuite/tests/corelint/T27374.hs
- testsuite/tests/corelint/all.T
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/determinism/determ017/A.hs
- testsuite/tests/exceptions/T26759.stderr
- testsuite/tests/ghc-e/should_fail/T18441fail7.stderr
- testsuite/tests/ghci/scripts/T12005.script
- testsuite/tests/ghci/scripts/bytecodeIPE.hs
- testsuite/tests/ghci/should_run/Makefile
- + testsuite/tests/ghci/should_run/T27287.hs
- + testsuite/tests/ghci/should_run/T27287.stdout
- testsuite/tests/ghci/should_run/all.T
- testsuite/tests/haddock/perf/Fold.hs
- testsuite/tests/indexed-types/should_fail/T7354.hs
- 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/layout/layout001.stdout
- testsuite/tests/layout/layout002.stdout
- testsuite/tests/layout/layout003.stdout
- testsuite/tests/layout/layout004.stdout
- testsuite/tests/layout/layout005.stdout
- testsuite/tests/layout/layout006.stdout
- testsuite/tests/layout/layout007.stdout
- testsuite/tests/layout/layout008.stdout
- testsuite/tests/layout/layout009.stdout
- testsuite/tests/linear/should_compile/T1735Min.hs
- testsuite/tests/mdo/should_fail/mdofail006.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- + testsuite/tests/parser/should_compile/T13087.stderr
- testsuite/tests/parser/should_fail/T8431.stderr
- testsuite/tests/parser/should_fail/readFail038.stderr
- testsuite/tests/perf/compiler/T3064.hs
- + testsuite/tests/pmcheck/should_compile/T27314.hs
- + testsuite/tests/pmcheck/should_compile/T27360.hs
- testsuite/tests/pmcheck/should_compile/all.T
- testsuite/tests/polykinds/T7594.hs
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/programs/thurston-modular-arith/Main.hs
- testsuite/tests/rts/ipe/IpeStats/Fold.hs
- testsuite/tests/runghc/T7859.stderr-mingw32
- testsuite/tests/simplCore/should_compile/T11562.hs
- testsuite/tests/simplCore/should_run/T3591.hs
- testsuite/tests/typecheck/should_compile/DeepSubsumption02.hs
- testsuite/tests/typecheck/should_compile/T12507.hs
- testsuite/tests/typecheck/should_compile/T13951.hs
- testsuite/tests/typecheck/should_compile/T18920.hs
- testsuite/tests/typecheck/should_compile/T2595.hs
- testsuite/tests/typecheck/should_compile/T7541.hs
- testsuite/tests/typecheck/should_fail/T15067.stderr
- + testsuite/tests/typecheck/should_fail/T26532.hs
- + testsuite/tests/typecheck/should_fail/T26532.stderr
- testsuite/tests/typecheck/should_fail/T6069.stderr
- testsuite/tests/typecheck/should_fail/T7368a.hs
- testsuite/tests/typecheck/should_fail/T9858b.stderr
- testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_run/T1735_Help/Basics.hs
- testsuite/tests/typecheck/should_run/T3731-short.hs
- testsuite/tests/typecheck/should_run/T3731.hs
- testsuite/tests/typecheck/should_run/church.hs
- testsuite/tests/typecheck/should_run/tcrun008.hs
- testsuite/tests/typecheck/should_run/tcrun017.hs
- testsuite/tests/typecheck/should_run/tcrun026.hs
- testsuite/tests/typecheck/should_run/tcrun035.hs
- testsuite/tests/typecheck/should_run/tcrun036.hs
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/deriveConstants/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bff295f20b167b3cd5a25a8999be8e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bff295f20b167b3cd5a25a8999be8e…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0