[Git][ghc/ghc][wip/hugepages] 24 commits: Introduce `-fimport-loaded-targets` GHCi flag
by Teo Camarasu (＠teo) 21 Mar '26
by Teo Camarasu (＠teo) 21 Mar '26
21 Mar '26
Teo Camarasu pushed to branch wip/hugepages at Glasgow Haskell Compiler / GHC
Commits:
86bd9bfc by fendor at 2026-03-17T23:46:09-04:00
Introduce `-fimport-loaded-targets` GHCi flag
This new flag automatically adds all loaded targets to the GHCi session
by adding an `InteractiveImport` for the loaded targets.
By default, this flag is disabled, as it potentially increases memory-usage.
This interacts with the flag `-fno-load-initial-targets` as follows:
* If no module is loaded, no module is added as an interactive import.
* If a reload loads up to a module, all loaded modules are added as
interactive imports.
* Unloading modules removes them from the interactive context.
Fixes #26866 by rendering the use of a `-ghci-script` to achieve the
same thing redundant.
- - - - -
e3d4c1bb by mniip at 2026-03-17T23:47:03-04:00
ghc-internal: Remove GHC.Internal.Data.Eq
It served no purpose other than being a re-export.
- - - - -
6f4f6cf0 by mniip at 2026-03-17T23:47:03-04:00
ghc-internal: Refine GHC.Internal.Base imports
Removed re-exports from GHC.Internal.Base. This reveals some modules
that don't actually use anything *defined* in GHC.Internal.Base, and
that can be pushed down a little in the import graph.
Replaced most imports of GHC.Internal.Base with non-wildcard imports
from modules where the identifiers are actually defined.
Part of #26834
Metric Decrease:
T5321FD
- - - - -
7fb51f54 by mangoiv at 2026-03-17T23:48:00-04:00
ci: clone, don't copy when creating the cabal cache
Also removed WINDOWS_HOST variable detected via uname - we now just
check whether the CI job has windows in its name. This works because we
only ever care about it if the respective job is not a cross job. We
also statically detect darwin cross jobs in the same way. We only ever have
darwin -> darwin cross jobs so this is enough to detect the host
reliably.
- - - - -
f8817879 by mangoiv at 2026-03-17T23:48:44-04:00
ci: mark size_hello_artifact fragile on darwin x86
The size of the x86_64 hello artifact is not stable which results in flaky testruns.
Resolves #26814
- - - - -
e34cb6da by Adam Gundry at 2026-03-20T12:20:00-04:00
ghci: Mention active language edition in startup banner
Per GHC proposal 632, this makes the GHCi startup banner include
the active language edition, plus an indication of whether this
was the default (as opposed to being explicitly selected via an
option such as `-XGHC2024`). For example:
```
$ ghci
GHCi, version 9.14.1: https://www.haskell.org/ghc/ :? for help
Using default language edition: GHC2024
ghci>
```
Fixes #26037.
- - - - -
52c3e6ba by sheaf at 2026-03-20T12:21:09-04:00
Improve incomplete record selector warnings
This commit stops GHC from emitting spurious incomplete record selector
warnings for bare selectors/projections such as .fld
There are two places we currently emit incomplete record selector
warnings:
1. In the desugarer, when we see a record selector or an occurrence
of 'getField'. Here, we can use pattern matching information to
ensure we don't give false positives.
2. In the typechecker, which might sometimes give false positives but
can emit warnings in cases that the pattern match checker would
otherwise miss.
This is explained in Note [Detecting incomplete record selectors]
in GHC.HsToCore.Pmc.
Now, we obviously don't want to emit the same error twice, and generally
we prefer (1), as those messages contain fewer false positives. So we
suppress (2) when we are sure we are going to emit (1); the logic for
doing so is in GHC.Tc.Instance.Class.warnIncompleteRecSel,
and works by looking at the CtOrigin.
Now, the issue was that this logic handled explicit record selectors as
well as overloaded record field selectors such as "x.r" (which turns
into a simple GetFieldOrigin CtOrigin), but it didn't properly handle
record projectors like ".fld" or ".fld1.fld2" (which result in other
CtOrigins such as 'RecordFieldProjectionOrigin').
To solve this problem, we re-use the 'isHasFieldOrigin' introduced in
fbdc623a (slightly adjusted).
On the way, we also had to update the desugarer with special handling
for the 'ExpandedThingTc' case in 'ds_app', to make sure that
'ds_app_var' sees all the type arguments to 'getField' in order for it
to indeed emit warnings like in (1).
Fixes #26686
- - - - -
309d7e87 by Cheng Shao at 2026-03-20T12:21:53-04:00
rts: opportunistically grow the MutableByteArray# in-place in resizeMutableByteArray#
Following !15234, this patch improves `resizeMutableByteArray#` memory
efficiency by growing the `MutableByteArray#` in-place if possible,
addressing an old todo comment here. Also adds a new test case
`resizeMutableByteArrayInPlace` that stresses this behavior.
- - - - -
7d4ef162 by Matthew Craven at 2026-03-20T12:22:47-04:00
Change representation of floating point literals
This commit changes the representation of floating point literals
throughough the compiler, in particular in Core and Cmm.
The Rational type is deficient for this purpose, dealing poorly
with NaN, +/-Infinity, and negative zero. Instead, the new module
GHC.Types.Literal.Floating uses the host Float/Double type to represent
NaNs, infinities and negative zero. It also contains a Rational
constructor, for the benefit of -fexcess-precision.
Other changes:
- Remove Note [negative zero] and related code
This also removes the restrictions on constant-folding of division
by zero, and should make any problems with NaN/Infinity more obvious.
- Use -0.0 as the additive identity for Core constant folding rules
for floating-point addition, fixing #21227.
- Manual worker-wrapper for GHC.Float.rationalToDouble. This is
intended to prevent the compiler's WW on this function from
interfering with constant-folding. This change means that we now
avoid allocating a box for the result of a 'realToFrac' call in
T10359.
- Combine floatDecodeOp and doubleDecodeOp.
This change also fixes a bug in doubleDecodeOp wherein it
would incorrectly produce an Int# instead of an Int64#
literal for the mantissa component with 64-bit targets.
- Use Float/Double for assembly immediates, and update the X86 and
PowerPC backends to properly handle special values such as NaN and
infinity.
- Allow 'rational_to' to handle zero denominators, fixing a
TODO in GHC.Core.Opt.ConstantFold.
Fixes #8364 #9811 #18897 #21227
Progress towards #26919
Metric Decrease:
T10359
Co-authored-by: sheaf <sam.derbyshire(a)gmail.com>
-------------------------
Metric Decrease:
T1969
T5321FD
-------------------------
- - - - -
80e2dd4f by Zubin Duggal at 2026-03-20T12:23:33-04:00
compiler/ffi: Collapse void pointer chains in capi wrappers
New gcc/clang treat -Wincompatible-pointer-types as an error by
default. Since C only allows implicit conversion from void*, not void**,
capi wrappers for functions taking e.g. abstract** would fail to compile
when the Haskell type Ptr (Ptr Abstract) was naively translated to void**.
Collapse nested void pointers to a single void* when the pointee type
has no known C representation.
Fixes #26852
- - - - -
1c50bd7b by Luite Stegeman at 2026-03-20T12:24:37-04:00
Move some functions related to pointer tagging to a separate module
- - - - -
bfd7aafd by Luite Stegeman at 2026-03-20T12:24:37-04:00
Branchless unpacking for enumeration types
Change unpacking for enumeration types to go to Word8#/Word16#/Word#
directly instead of going through an intermediate unboxed sum. This
allows us to do a branchless conversion using DataToTag and TagToEnum.
Fixes #26970
- - - - -
72b20fc0 by Luite Stegeman at 2026-03-20T12:25:30-04:00
bytecode: Carefully SLIDE off the end of a stack chunk
The SLIDE bytecode instruction was not checking for stack chunk
boundaries and could corrupt the stack underflow frame, leading
to crashes.
We add a check to use safe writes if we cross the chunk boundary
and also handle stack underflow if Sp is advanced past the underflow
frame.
fix #27001
- - - - -
2e22b43c by Cheng Shao at 2026-03-20T12:26:14-04:00
ghci: serialize BCOByteArray buffer directly when possible
This patch changes the `Binary` instances of `BCOByteArray` to
directly serialize the underlying buffer when possible, while also
taking into account the issue of host-dependent `Word` width. See
added comments and amended `Note [BCOByteArray serialization]` for
detailed explanation. Closes #27020.
- - - - -
89d9ba37 by Sylvain Henry at 2026-03-20T12:27:34-04:00
JS: replace BigInt with Number arithmetic for 32/64-bit quot/rem (#23597)
Replace BigInt-based implementations of quotWord32, remWord32,
quotRemWord32, quotRem2Word32, quotWord64, remWord64, quotInt64, and
remInt64 with pure Number (double/integer) arithmetic to avoid the
overhead of BigInt promotion.
- - - - -
ae4ddd60 by Sylvain Henry at 2026-03-20T12:28:28-04:00
Core: add constant-folding rules for Addr# eq/ne (#18032)
- - - - -
3e767f98 by Matthew Pickering at 2026-03-20T12:29:11-04:00
Use OsPath rather than FilePath in Downsweep cache
This gets us one step closure to uniformly using `OsPath` in the
compiler.
- - - - -
2c57de29 by Cheng Shao at 2026-03-20T12:29:55-04:00
hadrian: fix ghc-in-ghci flavour stage0 shared libraries
This patch fixes missing stage0 shared libraries in hadrian
ghc-in-ghci flavour, which was accidentally dropped in
669d09f950a6e88b903d9fd8a7571531774d4d5d and resulted in a regression
in HLS support on linux/macos. Fixes #27057.
- - - - -
5b1be555 by Sylvain Henry at 2026-03-20T12:30:48-04:00
JS: install rts/Types.h header file (#27033)
It was an omission, making HsFFI.h not usable with GHC using the JS
backend.
- - - - -
b883f08f by Cheng Shao at 2026-03-20T12:31:33-04:00
hadrian: don't compile RTS with -Winline
This patch removes `-Winline` from cflags when compiling the RTS,
given that:
1. It generates a huge pile of spam and hurts developer experience
2. Whether inlining happens is highly dependent on toolchains,
flavours, etc, and it's not really an issue to fix if inlining
doesn't happen; it's a hint to the C compiler anyway.
Fixes #27060.
- - - - -
333387d6 by Cheng Shao at 2026-03-20T12:31:33-04:00
hadrian: compile libffi-clib with -Wno-deprecated-declarations
This patch adds `-Wno-deprecated-declarations` to cflags of
`libffi-clib`, given that it produces noise at compile-time that
aren't really our issue to fix anyway, it's from vendored libffi
source code.
- - - - -
67c47771 by Rodrigo Mesquita at 2026-03-20T12:32:17-04:00
Expose decodeStackWithIpe from ghc-experimental
This decoding is useful to the debugger and it wasn't originally
exported as an oversight.
- - - - -
298dba41 by Teo Camarasu at 2026-03-21T01:18:18+00: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.
Relates to #24760
Co-authored-by: Matthew Pickering <matthewtpickering(a)gmail.com>
Co-authored-by: Ben Gamari <bgamari.foss(a)gmail.com>
- - - - -
fd1586ef by Teo Camarasu at 2026-03-21T01:18:18+00:00
Try disabling under i386?
- - - - -
394 changed files:
- .gitlab/ci.sh
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/Cmm/Expr.hs
- compiler/GHC/Cmm/Opt.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/Type.hs
- compiler/GHC/Cmm/Utils.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/AArch64/Regs.hs
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/LA64/Ppr.hs
- compiler/GHC/CmmToAsm/LA64/Regs.hs
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/PPC/Regs.hs
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
- compiler/GHC/CmmToAsm/RV64/Regs.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToAsm/X86/Regs.hs
- compiler/GHC/CmmToC.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- + compiler/GHC/Platform/Tag.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Closure.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToCmm/Lit.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Literal.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/Literal.hs
- + compiler/GHC/Types/Literal/Floating.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Utils/Binary.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.16.1-notes.rst
- docs/users_guide/ghci.rst
- docs/users_guide/runtime_control.rst
- ghc/GHCi/UI.hs
- ghc/Main.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- hadrian/src/Settings/Packages.hs
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Data/Char.hs
- libraries/base/src/Data/Eq.hs
- libraries/base/src/Data/Semigroup.hs
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/Weak/Finalize.hs
- libraries/base/src/Prelude.hs
- libraries/ghc-experimental/ghc-experimental.cabal.in
- libraries/ghc-experimental/src/GHC/Profiling/Eras.hs
- + libraries/ghc-experimental/src/GHC/Stack/Decode/Experimental.hs
- libraries/ghc-internal/codepages/MakeTable.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Arr.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
- libraries/ghc-internal/src/GHC/Internal/Char.hs
- libraries/ghc-internal/src/GHC/Internal/Clock.hsc
- libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Bound.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Signal.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/ConsoleHandler.hsc
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Concurrent/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/IO/Class.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Dynamic.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Either.hs
- − libraries/ghc-internal/src/GHC/Internal/Data/Eq.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Function.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Const.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Data/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/List.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Proxy.hs
- libraries/ghc-internal/src/GHC/Internal/Data/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/String.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Bool.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Coercion.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Equality.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/Enum.hs
- libraries/ghc-internal/src/GHC/Internal/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/IntVar.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Manager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/PSQ.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Poll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimeOut.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Clock.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ConsoleEvent.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/FFI.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Fingerprint/Type.hs
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs
- libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/ConstPtr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/ForeignPtr/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Alloc.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Pool.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignPtr.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- libraries/ghc-internal/src/GHC/Internal/Generics.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Buffer.hs
- libraries/ghc-internal/src/GHC/Internal/IO/BufferedIO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/API.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/Table.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Iconv.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Latin1.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF16.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF32.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Flock.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/NoOp.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Unsafe.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc
- libraries/ghc-internal/src/GHC/Internal/IOArray.hs
- libraries/ghc-internal/src/GHC/Internal/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Int.hs
- libraries/ghc-internal/src/GHC/Internal/IsList.hs
- libraries/ghc-internal/src/GHC/Internal/Ix.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal/Build.hs
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- libraries/ghc-internal/src/GHC/Internal/Lexeme.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-internal/src/GHC/Internal/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Num.hs
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- libraries/ghc-internal/src/GHC/Internal/OverloadedLabels.hs
- libraries/ghc-internal/src/GHC/Internal/Pack.hs
- libraries/ghc-internal/src/GHC/Internal/Profiling.hs
- libraries/ghc-internal/src/GHC/Internal/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs
- libraries/ghc-internal/src/GHC/Internal/ST.hs
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/src/GHC/Internal/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Show.hs
- libraries/ghc-internal/src/GHC/Internal/Stable.hs
- libraries/ghc-internal/src/GHC/Internal/StableName.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Stats.hsc
- libraries/ghc-internal/src/GHC/Internal/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
- libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO/Error.hs
- libraries/ghc-internal/src/GHC/Internal/System/Mem.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Types.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadP.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadPrec.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read/Lex.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/DerivedCoreProperties.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/GeneralCategory.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleLowerCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleTitleCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleUpperCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unsafe/Coerce.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Flag.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Weak.hs
- libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs
- libraries/ghc-internal/src/GHC/Internal/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/Word.hs
- libraries/ghc-internal/tools/ucd2haskell/exe/UCD2Haskell/ModuleGenerators.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/ResolvedBCO.hs
- rts/Interpreter.c
- rts/PrimOps.cmm
- rts/RtsFlags.c
- rts/configure.ac
- rts/include/rts/Flags.h
- rts/js/arith.js
- rts/posix/OSMem.c
- rts/rts.cabal
- rts/sm/BlockAlloc.c
- rts/sm/OSMem.h
- + testsuite/tests/bytecode/T27001.hs
- + testsuite/tests/bytecode/T27001.stdout
- testsuite/tests/bytecode/all.T
- + testsuite/tests/codeGen/should_run/T21227.hs
- + testsuite/tests/codeGen/should_run/T21227.stdout
- + testsuite/tests/codeGen/should_run/T9811.hs
- + testsuite/tests/codeGen/should_run/T9811.stdout
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- + testsuite/tests/ffi/should_compile/T26852.h
- + testsuite/tests/ffi/should_compile/T26852.hs
- + testsuite/tests/ffi/should_compile/T26852.stderr
- testsuite/tests/ffi/should_compile/all.T
- testsuite/tests/ghci/prog-mhu005/Makefile
- testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005b.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005b.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stdout
- testsuite/tests/ghci/prog022/Makefile
- testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022c.script
- + testsuite/tests/ghci/prog022/ghci.prog022c.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022c.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022d.script
- + testsuite/tests/ghci/prog022/ghci.prog022d.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022d.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022e.script
- + testsuite/tests/ghci/prog022/ghci.prog022e.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022e.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022f.script
- + testsuite/tests/ghci/prog022/ghci.prog022f.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022f.stdout
- testsuite/tests/ghci/should_run/BinaryArray.hs
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- + testsuite/tests/javascript/js-c-sources/T27033.hs
- + testsuite/tests/javascript/js-c-sources/T27033.stdout
- + testsuite/tests/javascript/js-c-sources/T27033_c.c
- + testsuite/tests/javascript/js-c-sources/T27033_js.js
- testsuite/tests/javascript/js-c-sources/all.T
- testsuite/tests/numeric/should_run/T7014.hs
- + testsuite/tests/overloadedrecflds/should_compile/T26686.hs
- + testsuite/tests/overloadedrecflds/should_compile/T26686.stderr
- testsuite/tests/overloadedrecflds/should_compile/all.T
- testsuite/tests/perf/size/all.T
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/profiling/should_run/callstack002.stderr
- testsuite/tests/profiling/should_run/callstack002.stdout
- testsuite/tests/rts/all.T
- + testsuite/tests/rts/resizeMutableByteArrayInPlace.hs
- + testsuite/tests/rts/testhugepagesmblockalloc.c
- + testsuite/tests/simplCore/should_compile/T18032.hs
- + testsuite/tests/simplCore/should_compile/T18032.stderr
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplStg/should_run/all.T
- + testsuite/tests/simplStg/should_run/unpack_enum.hs
- + testsuite/tests/simplStg/should_run/unpack_enum.stdout
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd0444c18657fcfa49671cec1d773f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd0444c18657fcfa49671cec1d773f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Teo Camarasu pushed to branch wip/abstract-q at Glasgow Haskell Compiler / GHC
Commits:
2120b748 by Teo Camarasu at 2026-03-21T00:38:10+00:00
wip
- - - - -
4 changed files:
- compiler/GHC/Tc/Gen/Splice.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
Changes:
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -1139,6 +1139,7 @@ convertAnnotationWrapper fhv = do
************************************************************************
-}
+-- TODO: rename
runQuasi :: TH.Q a -> TcM a
runQuasi (TH.Q act) = unliftIOEnv $ \runInIO -> liftIO $ act (metaHandlersTcM runInIO)
@@ -1467,7 +1468,7 @@ when showing an error message.
To call runQ in the Tc monad, we need to make TcM an instance of Quasi:
-}
-report :: Bool -> [Char] -> TcM ()
+report :: Bool -> String -> TcM ()
report True msg = seqList msg $ addErr $ TcRnTHError $ ReportCustomQuasiError True msg
report False msg = seqList msg $ addDiagnostic $ TcRnTHError $ ReportCustomQuasiError False msg
@@ -1559,7 +1560,8 @@ location = do { m <- getModule
metaHandlersTcM :: (forall x. TcM x -> IO x) -> TH.MetaHandlers IO
metaHandlersTcM runInIO = TH.MetaHandlers {
- mFail = \s -> runInIO $ fail s
+ -- We are careful to use the TcM instance not the one for IO, since that would lead to a different error.
+ mFail = \s -> runInIO $ fail @TcM s
, mNewName = \s -> runInIO $ do { u <- newUnique
; let i = toInteger (getKey u)
; return (TH.mkNameU s i) }
@@ -1578,16 +1580,17 @@ metaHandlersTcM runInIO = TH.MetaHandlers {
, mReifyRoles = runInIO . reifyRoles
, mReifyAnnotations = runInIO . reifyAnnotations
, mReifyModule = runInIO . reifyModule
- , mReifyConStrictness = \nm -> runInIO $ do { nm' <- lookupThName nm
+ , mReifyConStrictness = \nm -> runInIO $ do
+ { nm' <- lookupThName nm
; dc <- tcLookupDataCon nm'
; let bangs = dataConImplBangs dc
; return (map reifyDecidedStrictness bangs) }
- -- -- For qRecover, discard error messages if
- -- -- the recovery action is chosen. Otherwise
- -- -- we'll only fail higher up.
- -- -- NB: extremely subtle!!! TODO: write up note
- -- -- tryTcDiscardingErrs manipulates the reader env so we need to be careful we don't sneak in the outside env
+ -- For qRecover, discard error messages if
+ -- the recovery action is chosen. Otherwise
+ -- we'll only fail higher up.
+ -- NB: extremely subtle!!! TODO: write up note
+ -- tryTcDiscardingErrs manipulates the reader env so we need to be careful we don't sneak in the outside env
, mRecover = \recover main -> runInIO $ tryTcDiscardingErrs (runQuasi recover) (runQuasi main)
, mGetPackageRoot = runInIO $ do
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
=====================================
@@ -1074,7 +1074,7 @@ withDecDoc :: String -> Q Dec -> Q Dec
withDecDoc doc dec = do
dec' <- dec
case doc_loc dec' of
- Just loc -> qAddModFinalizer $ qPutDoc loc doc
+ Just loc -> addModFinalizer $ putDoc loc doc
Nothing -> pure ()
pure dec'
where
@@ -1123,7 +1123,7 @@ funD_doc :: Name -> [Q Clause]
-> [Maybe String] -- ^ Documentation to attach to arguments
-> Q Dec
funD_doc nm cs mfun_doc arg_docs = do
- qAddModFinalizer $ sequence_
+ addModFinalizer $ sequence_
[putDoc (ArgDoc nm i) s | (i, Just s) <- zip [0..] arg_docs]
let dec = funD nm cs
case mfun_doc of
@@ -1140,7 +1140,7 @@ dataD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)
-- ^ Documentation to attach to the data declaration
-> Q Dec
dataD_doc ctxt tc tvs ksig cons_with_docs derivs mdoc = do
- qAddModFinalizer $ mapM_ docCons cons_with_docs
+ addModFinalizer $ mapM_ docCons cons_with_docs
let dec = dataD ctxt tc tvs ksig (map (\(con, _, _) -> con) cons_with_docs) derivs
maybe dec (flip withDecDoc dec) mdoc
@@ -1154,7 +1154,7 @@ newtypeD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)
-- ^ Documentation to attach to the newtype declaration
-> Q Dec
newtypeD_doc ctxt tc tvs ksig con_with_docs@(con, _, _) derivs mdoc = do
- qAddModFinalizer $ docCons con_with_docs
+ addModFinalizer $ docCons con_with_docs
let dec = newtypeD ctxt tc tvs ksig con derivs
maybe dec (flip withDecDoc dec) mdoc
@@ -1167,7 +1167,7 @@ typeDataD_doc :: Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind)
-- ^ Documentation to attach to the data declaration
-> Q Dec
typeDataD_doc tc tvs ksig cons_with_docs mdoc = do
- qAddModFinalizer $ mapM_ docCons cons_with_docs
+ addModFinalizer $ mapM_ docCons cons_with_docs
let dec = typeDataD tc tvs ksig (map (\(con, _, _) -> con) cons_with_docs)
maybe dec (flip withDecDoc dec) mdoc
@@ -1181,7 +1181,7 @@ dataInstD_doc :: Q Cxt -> (Maybe [Q (TyVarBndr ())]) -> Q Type -> Maybe (Q Kind)
-- ^ Documentation to attach to the instance declaration
-> Q Dec
dataInstD_doc ctxt mb_bndrs ty ksig cons_with_docs derivs mdoc = do
- qAddModFinalizer $ mapM_ docCons cons_with_docs
+ addModFinalizer $ mapM_ docCons cons_with_docs
let dec = dataInstD ctxt mb_bndrs ty ksig (map (\(con, _, _) -> con) cons_with_docs)
derivs
maybe dec (flip withDecDoc dec) mdoc
@@ -1197,7 +1197,7 @@ newtypeInstD_doc :: Q Cxt -> (Maybe [Q (TyVarBndr ())]) -> Q Type
-- ^ Documentation to attach to the instance declaration
-> Q Dec
newtypeInstD_doc ctxt mb_bndrs ty ksig con_with_docs@(con, _, _) derivs mdoc = do
- qAddModFinalizer $ docCons con_with_docs
+ addModFinalizer $ docCons con_with_docs
let dec = newtypeInstD ctxt mb_bndrs ty ksig con derivs
maybe dec (flip withDecDoc dec) mdoc
@@ -1207,7 +1207,7 @@ patSynD_doc :: Name -> Q PatSynArgs -> Q PatSynDir -> Q Pat
-> [Maybe String] -- ^ Documentation to attach to the pattern arguments
-> Q Dec
patSynD_doc name args dir pat mdoc arg_docs = do
- qAddModFinalizer $ sequence_
+ addModFinalizer $ sequence_
[putDoc (ArgDoc name i) s | (i, Just s) <- zip [0..] arg_docs]
let dec = patSynD name args dir pat
maybe dec (flip withDecDoc dec) mdoc
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
=====================================
@@ -52,175 +52,6 @@ import GHC.Internal.ForeignSrcLang
import GHC.Internal.LanguageExtensions
import GHC.Internal.TH.Syntax
------------------------------------------------------
---
--- The Quasi class
---
------------------------------------------------------
-
-class (MonadIO m, MonadFail m) => Quasi m where
- qRunQ :: Q a -> m a
- -- | Fresh names. See 'newName'.
- qNewName :: String -> m Name
-
- ------- Error reporting and recovery -------
- -- | Report an error (True) or warning (False)
- -- ...but carry on; use 'fail' to stop. See 'report'.
- qReport :: Bool -> String -> m ()
-
- -- | See 'recover'.
- qRecover :: m a -- ^ the error handler
- -> m a -- ^ action which may fail
- -> m a -- ^ Recover from the monadic 'fail'
-
- ------- Inspect the type-checker's environment -------
- -- | True <=> type namespace, False <=> value namespace. See 'lookupName'.
- qLookupName :: Bool -> String -> m (Maybe Name)
- -- | See 'reify'.
- qReify :: Name -> m Info
- -- | See 'reifyFixity'.
- qReifyFixity :: Name -> m (Maybe Fixity)
- -- | See 'reifyType'.
- qReifyType :: Name -> m Type
- -- | Is (n tys) an instance? Returns list of matching instance Decs (with
- -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'.
- qReifyInstances :: Name -> [Type] -> m [Dec]
- -- | See 'reifyRoles'.
- qReifyRoles :: Name -> m [Role]
- -- | See 'reifyAnnotations'.
- qReifyAnnotations :: Data a => AnnLookup -> m [a]
- -- | See 'reifyModule'.
- qReifyModule :: Module -> m ModuleInfo
- -- | See 'reifyConStrictness'.
- qReifyConStrictness :: Name -> m [DecidedStrictness]
-
- -- | See 'location'.
- qLocation :: m Loc
-
- -- | Input/output (dangerous). See 'runIO'.
- qRunIO :: IO a -> m a
- qRunIO = liftIO
- -- | See 'getPackageRoot'.
- qGetPackageRoot :: m FilePath
-
- -- | See 'addDependentFile'.
- qAddDependentFile :: FilePath -> m ()
-
- -- | See 'addDependentDirectory'.
- qAddDependentDirectory :: FilePath -> m ()
-
- -- | See 'addTempFile'.
- qAddTempFile :: String -> m FilePath
-
- -- | See 'addTopDecls'.
- qAddTopDecls :: [Dec] -> m ()
-
- -- | See 'addForeignFilePath'.
- qAddForeignFilePath :: ForeignSrcLang -> String -> m ()
-
- -- | See 'addModFinalizer'.
- qAddModFinalizer :: Q () -> m ()
-
- -- | See 'addCorePlugin'.
- qAddCorePlugin :: String -> m ()
-
- -- | See 'getQ'.
- qGetQ :: Typeable a => m (Maybe a)
-
- -- | See 'putQ'.
- qPutQ :: Typeable a => a -> m ()
-
- -- | See 'isExtEnabled'.
- qIsExtEnabled :: Extension -> m Bool
- -- | See 'extsEnabled'.
- qExtsEnabled :: m [Extension]
-
- -- | See 'putDoc'.
- qPutDoc :: DocLoc -> String -> m ()
- -- | See 'getDoc'.
- qGetDoc :: DocLoc -> m (Maybe String)
-
------------------------------------------------------
--- The IO instance of Quasi
------------------------------------------------------
-
--- | This instance is used only when running a Q
--- computation in the IO monad, usually just to
--- print the result. There is no interesting
--- type environment, so reification isn't going to
--- work.
-instance Quasi IO where
- qRunQ (Q m) = m metaHandlersIO
- qNewName = newNameIO
-
- qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
- qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
-
- qLookupName _ _ = badIO "lookupName"
- qReify _ = badIO "reify"
- qReifyFixity _ = badIO "reifyFixity"
- qReifyType _ = badIO "reifyFixity"
- qReifyInstances _ _ = badIO "reifyInstances"
- qReifyRoles _ = badIO "reifyRoles"
- qReifyAnnotations _ = badIO "reifyAnnotations"
- qReifyModule _ = badIO "reifyModule"
- qReifyConStrictness _ = badIO "reifyConStrictness"
- qLocation = badIO "currentLocation"
- qRecover _ _ = badIO "recover" -- Maybe we could fix this?
- qGetPackageRoot = badIO "getProjectRoot"
- qAddDependentFile _ = badIO "addDependentFile"
- qAddTempFile _ = badIO "addTempFile"
- qAddTopDecls _ = badIO "addTopDecls"
- qAddForeignFilePath _ _ = badIO "addForeignFilePath"
- qAddModFinalizer _ = badIO "addModFinalizer"
- qAddCorePlugin _ = badIO "addCorePlugin"
- qGetQ = badIO "getQ"
- qPutQ _ = badIO "putQ"
- qIsExtEnabled _ = badIO "isExtEnabled"
- qExtsEnabled = badIO "extsEnabled"
- qPutDoc _ _ = badIO "putDoc"
- qGetDoc _ = badIO "getDoc"
- qAddDependentDirectory _ = badIO "AddDependentDirectory"
-
-metaHandlersIO :: MetaHandlers IO
-metaHandlersIO = MetaHandlers {
- mFail = fail
- , mNewName = newNameIO
- , mReport = \b msg ->
- if b then
- hPutStrLn stderr ("Template Haskell error: " ++ msg)
- else
- hPutStrLn stderr ("Template Haskell error: " ++ msg) -- TODO: should this be different from above?
- , mLookupName = \ _ _ -> badIO "lookupName"
- , mReify = \_ -> badIO "reify"
- , mReifyFixity = \_ -> badIO "reifyFixity"
- , mReifyType = \_ -> badIO "reifyFixity"
- , mReifyInstances = \_ _ -> badIO "reifyInstances"
- , mReifyRoles = \_ -> badIO "reifyRoles"
- , mReifyAnnotations = \_ -> badIO "reifyAnnotations"
- , mReifyModule = \_ -> badIO "reifyModule"
- , mReifyConStrictness = \_ -> badIO "reifyConStrictness"
- , mLocation = badIO "currentLocation"
- , mRecover = \_ _ -> badIO "recover" -- Maybe we could fix this?
- , mGetPackageRoot = badIO "getProjectRoot"
- , mAddDependentFile = \_ -> badIO "addDependentFile"
- , mAddTempFile = \_ -> badIO "addTempFile"
- , mAddTopDecls = \_ -> badIO "addTopDecls"
- , mAddForeignFilePath = \_ _ -> badIO "addForeignFilePath"
- , mAddModFinalizer = \_ -> badIO "addModFinalizer"
- , mAddCorePlugin = \_ -> badIO "addCorePlugin"
- , mGetQ = badIO "getQ"
- , mPutQ = \_ -> badIO "putQ"
- , mIsExtEnabled = \_ -> badIO "isExtEnabled"
- , mExtsEnabled = badIO "extsEnabled"
- , mPutDoc = \_ _ -> badIO "putDoc"
- , mGetDoc = \_ -> badIO "getDoc"
- , mAddDependentDirectory = \_ -> badIO "AddDependentDirectory"
- }
-
-instance Quote IO where
- newName = newNameIO
-
data MetaHandlers m = MetaHandlers {
mFail :: forall a. String -> m a
-- | Fresh names. See 'newName'.
@@ -301,15 +132,55 @@ data MetaHandlers m = MetaHandlers {
, mGetDoc :: DocLoc -> m (Maybe String)
}
+badIO :: String -> IO a
+badIO op = do { hPutStrLn stderr ("Can't do `" ++ op ++ "' in the IO monad")
+ ; fail "Template Haskell failure" }
+
+metaHandlersIO :: MetaHandlers IO
+metaHandlersIO = MetaHandlers {
+ mFail = fail
+ , mNewName = newNameIO
+ , mReport = \b msg ->
+ if b then
+ hPutStrLn stderr ("Template Haskell error: " ++ msg)
+ else
+ hPutStrLn stderr ("Template Haskell error: " ++ msg) -- TODO: should this be different from above?
+ , mLookupName = \ _ _ -> badIO "lookupName"
+ , mReify = \_ -> badIO "reify"
+ , mReifyFixity = \_ -> badIO "reifyFixity"
+ , mReifyType = \_ -> badIO "reifyFixity"
+ , mReifyInstances = \_ _ -> badIO "reifyInstances"
+ , mReifyRoles = \_ -> badIO "reifyRoles"
+ , mReifyAnnotations = \_ -> badIO "reifyAnnotations"
+ , mReifyModule = \_ -> badIO "reifyModule"
+ , mReifyConStrictness = \_ -> badIO "reifyConStrictness"
+ , mLocation = badIO "currentLocation"
+ , mRecover = \_ _ -> badIO "recover" -- Maybe we could fix this?
+ , mGetPackageRoot = badIO "getProjectRoot"
+ , mAddDependentFile = \_ -> badIO "addDependentFile"
+ , mAddTempFile = \_ -> badIO "addTempFile"
+ , mAddTopDecls = \_ -> badIO "addTopDecls"
+ , mAddForeignFilePath = \_ _ -> badIO "addForeignFilePath"
+ , mAddModFinalizer = \_ -> badIO "addModFinalizer"
+ , mAddCorePlugin = \_ -> badIO "addCorePlugin"
+ , mGetQ = badIO "getQ"
+ , mPutQ = \_ -> badIO "putQ"
+ , mIsExtEnabled = \_ -> badIO "isExtEnabled"
+ , mExtsEnabled = badIO "extsEnabled"
+ , mPutDoc = \_ _ -> badIO "putDoc"
+ , mGetDoc = \_ -> badIO "getDoc"
+ , mAddDependentDirectory = \_ -> badIO "AddDependentDirectory"
+ }
+
+instance Quote IO where
+ newName = newNameIO
+
+
newNameIO :: String -> IO Name
newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))
; pure (mkNameU s n) }
-badIO :: String -> IO a
-badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
- ; fail "Template Haskell failure" }
-
-- Global variable to generate unique symbols
counter :: IORef Uniq
{-# NOINLINE counter #-}
@@ -334,20 +205,6 @@ counter = unsafePerformIO (newIORef 0)
-- fufilled by an concrete 'Quasi' instance, internal to GHC.
newtype Q a = Q { unQ :: MetaHandlers IO -> IO a }
--- | \"Runs\" the 'Q' monad. Normal users of Template Haskell
--- should not need this function, as the splice brackets @$( ... )@
--- are the usual way of running a 'Q' computation.
---
--- This function is primarily used in GHC internals, and for debugging
--- splices by running them in 'IO'.
---
--- Note that many functions in 'Q', such as 'reify' and other compiler
--- queries, are not supported when running 'Q' in 'IO'; these operations
--- simply fail at runtime. Indeed, the only operations guaranteed to succeed
--- are 'newName', 'runIO', 'reportError' and 'reportWarning'.
-runQ :: Quasi m => Q a -> m a
-runQ = qRunQ
-
instance Monad Q where
Q m >>= k = Q $ \h -> (m h >>= \x -> unQ (k x) h)
(>>) = (*>)
@@ -430,14 +287,17 @@ class Monad m => Quote m where
-}
newName :: String -> m Name
+-- | Utility function for lifting a 0-ary method of 'MetaHandlers' into 'Q'
runHandler :: (forall m. MetaHandlers m -> m a) -> Q a
-runHandler op = Q $ \h -> (op h)
+runHandler op = Q $ \h -> op h
+-- | Utility function for lifting a 1-ary method of 'MetaHandlers' into 'Q'
runHandler1 :: (forall m. MetaHandlers m -> a -> m b) -> a -> Q b
-runHandler1 op = \x -> Q $ \h -> (op h x)
+runHandler1 op = \x -> Q $ \h -> op h x
+-- | Utility function for lifting a 2-ary method of 'MetaHandlers' into 'Q'
runHandler2 :: (forall m. MetaHandlers m -> a -> b -> m c) -> a -> b -> Q c
-runHandler2 op = \x y -> Q $ \h -> (op h x y)
+runHandler2 op = \x y -> Q $ \h -> op h x y
instance Quote Q where
newName = runHandler1 mNewName
@@ -658,15 +518,15 @@ recover rec main = Q $ \h -> mRecover h rec main
-- We don't export lookupName; the Bool isn't a great API
-- Instead we export lookupTypeName, lookupValueName
lookupName :: Bool -> String -> Q (Maybe Name)
-lookupName ns s = runHandler2 mLookupName ns s
+lookupName = runHandler2 mLookupName
-- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
lookupTypeName :: String -> Q (Maybe Name)
-lookupTypeName s = runHandler2 mLookupName True s
+lookupTypeName = runHandler2 mLookupName True
-- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
lookupValueName :: String -> Q (Maybe Name)
-lookupValueName s = runHandler2 mLookupName False s
+lookupValueName = runHandler2 mLookupName False
{-
Note [Name lookup]
@@ -850,7 +710,7 @@ has some discussion around this.
-}
reifyInstances :: Name -> [Type] -> Q [InstanceDec]
-reifyInstances cls tys = runHandler2 mReifyInstances cls tys
+reifyInstances = runHandler2 mReifyInstances
{- | @reifyRoles nm@ returns the list of roles associated with the parameters
(both visible and invisible) of
@@ -869,20 +729,20 @@ and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' i
the role of the invisible @k@ parameter. Kind parameters are always nominal.
-}
reifyRoles :: Name -> Q [Role]
-reifyRoles nm = runHandler1 mReifyRoles nm
+reifyRoles = runHandler1 mReifyRoles
-- | @reifyAnnotations target@ returns the list of annotations
-- associated with @target@. Only the annotations that are
-- appropriately typed is returned. So if you have @Int@ and @String@
-- annotations for the same target, you have to call this function twice.
reifyAnnotations :: Data a => AnnLookup -> Q [a]
-reifyAnnotations an = runHandler1 mReifyAnnotations an
+reifyAnnotations = runHandler1 mReifyAnnotations
-- | @reifyModule mod@ looks up information about module @mod@. To
-- look up the current module, call this function with the return
-- value of 'Language.Haskell.TH.Lib.thisModule'.
reifyModule :: Module -> Q ModuleInfo
-reifyModule m = runHandler1 mReifyModule m
+reifyModule = runHandler1 mReifyModule
-- | @reifyConStrictness nm@ looks up the strictness information for the fields
-- of the constructor with the name @nm@. Note that the strictness information
@@ -897,7 +757,7 @@ reifyModule m = runHandler1 mReifyModule m
-- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the
-- @-XStrictData@ language extension was enabled.
reifyConStrictness :: Name -> Q [DecidedStrictness]
-reifyConStrictness n = runHandler1 mReifyConStrictness n
+reifyConStrictness = runHandler1 mReifyConStrictness
-- | Is the list of instances returned by 'reifyInstances' nonempty?
--
@@ -951,7 +811,7 @@ getPackageRoot = runHandler mGetPackageRoot
-- * The state of the directory is read at the interface generation time,
-- not at the time of the function call.
addDependentDirectory :: FilePath -> Q ()
-addDependentDirectory dp = runHandler1 mAddDependentDirectory dp
+addDependentDirectory = runHandler1 mAddDependentDirectory
-- | Record external files that runIO is using (dependent upon).
-- The compiler can then recognize that it should re-compile the Haskell file
@@ -965,17 +825,17 @@ addDependentDirectory dp = runHandler1 mAddDependentDirectory dp
--
-- * The dependency is based on file content, not a modification time
addDependentFile :: FilePath -> Q ()
-addDependentFile fp = runHandler1 mAddDependentFile fp
+addDependentFile = runHandler1 mAddDependentFile
-- | Obtain a temporary file path with the given suffix. The compiler will
-- delete this file after compilation.
addTempFile :: String -> Q FilePath
-addTempFile suffix = runHandler1 mAddTempFile suffix
+addTempFile = runHandler1 mAddTempFile
-- | Add additional top-level declarations. The added declarations will be type
-- checked along with the current declaration group.
addTopDecls :: [Dec] -> Q ()
-addTopDecls ds = runHandler1 mAddTopDecls ds
+addTopDecls = runHandler1 mAddTopDecls
-- | Same as 'addForeignSource', but expects to receive a path pointing to the
-- foreign file instead of a 'String' of its contents. Consider using this in
@@ -984,7 +844,7 @@ addTopDecls ds = runHandler1 mAddTopDecls ds
-- This is a good alternative to 'addForeignSource' when you are trying to
-- directly link in an object file.
addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()
-addForeignFilePath lang fp = runHandler2 mAddForeignFilePath lang fp
+addForeignFilePath = runHandler2 mAddForeignFilePath
-- | Add a finalizer that will run in the Q monad after the current module has
-- been type checked. This only makes sense when run within a top-level splice.
@@ -993,7 +853,7 @@ addForeignFilePath lang fp = runHandler2 mAddForeignFilePath lang fp
-- 'reify' is able to find the local definitions when executed inside the
-- finalizer.
addModFinalizer :: Q () -> Q ()
-addModFinalizer act = runHandler1 mAddModFinalizer act
+addModFinalizer = runHandler1 mAddModFinalizer
-- | Adds a core plugin to the compilation pipeline.
--
@@ -1003,7 +863,7 @@ addModFinalizer act = runHandler1 mAddModFinalizer act
-- to tell the compiler that we needed to compile first a plugin module in the
-- current package.
addCorePlugin :: String -> Q ()
-addCorePlugin plugin = runHandler1 mAddCorePlugin plugin
+addCorePlugin = runHandler1 mAddCorePlugin
-- | Get state from the 'Q' monad. The state maintained by 'Q' is isomorphic to
-- a type-indexed finite map. That is,
@@ -1022,11 +882,11 @@ getQ = runHandler mGetQ
-- | Replace the state in the 'Q' monad. Note that the state is local to the
-- Haskell module in which the Template Haskell expression is executed.
putQ :: Typeable a => a -> Q ()
-putQ x = runHandler1 mPutQ x
+putQ = runHandler1 mPutQ
-- | Determine whether the given language extension is enabled in the 'Q' monad.
isExtEnabled :: Extension -> Q Bool
-isExtEnabled ext = runHandler1 mIsExtEnabled ext
+isExtEnabled = runHandler1 mIsExtEnabled
-- | List all enabled language extensions.
extsEnabled :: Q [Extension]
@@ -1049,49 +909,18 @@ extsEnabled = runHandler mExtsEnabled
-- Adding documentation to anything outside of the current module will cause an
-- error.
putDoc :: DocLoc -> String -> Q ()
-putDoc t s = runHandler2 mPutDoc t s
+putDoc = runHandler2 mPutDoc
-- | Retrieves the Haddock documentation at the specified location, if one
-- exists.
-- It can be used to read documentation on things defined outside of the current
-- module, provided that those modules were compiled with the @-haddock@ flag.
getDoc :: DocLoc -> Q (Maybe String)
-getDoc n = runHandler1 mGetDoc n
+getDoc = runHandler1 mGetDoc
instance MonadIO Q where
liftIO = runIO
-instance Quasi Q where
- qRunQ = id
- qNewName = newName
- qReport = report
- qRecover = recover
- qReify = reify
- qReifyFixity = reifyFixity
- qReifyType = reifyType
- qReifyInstances = reifyInstances
- qReifyRoles = reifyRoles
- qReifyAnnotations = reifyAnnotations
- qReifyModule = reifyModule
- qReifyConStrictness = reifyConStrictness
- qLookupName = lookupName
- qLocation = location
- qGetPackageRoot = getPackageRoot
- qAddDependentFile = addDependentFile
- qAddDependentDirectory = addDependentDirectory
- qAddTempFile = addTempFile
- qAddTopDecls = addTopDecls
- qAddForeignFilePath = addForeignFilePath
- qAddModFinalizer = addModFinalizer
- qAddCorePlugin = addCorePlugin
- qGetQ = getQ
- qPutQ = putQ
- qIsExtEnabled = isExtEnabled
- qExtsEnabled = extsEnabled
- qPutDoc = putDoc
- qGetDoc = getDoc
-
-
----------------------------------------------------
-- The following operations are used solely in GHC.HsToCore.Quote when
-- desugaring brackets. They are not necessary for the user, who can use
=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -504,3 +504,181 @@ pattern SpecialiseP nm ty inl phases = SpecialiseEP Nothing [] (SigE (VarE nm) t
unQ :: Q a -> (forall m. Quasi m => m a)
unQ m = runQ m
+
+-----------------------------------------------------
+--
+-- The Quasi class
+--
+-----------------------------------------------------
+
+class (MonadIO m, MonadFail m) => Quasi m where
+ qRunQ :: Q a -> m a
+ -- | Fresh names. See 'newName'.
+ qNewName :: String -> m Name
+
+ ------- Error reporting and recovery -------
+ -- | Report an error (True) or warning (False)
+ -- ...but carry on; use 'fail' to stop. See 'report'.
+ qReport :: Bool -> String -> m ()
+
+ -- | See 'recover'.
+ qRecover :: m a -- ^ the error handler
+ -> m a -- ^ action which may fail
+ -> m a -- ^ Recover from the monadic 'fail'
+
+ ------- Inspect the type-checker's environment -------
+ -- | True <=> type namespace, False <=> value namespace. See 'lookupName'.
+ qLookupName :: Bool -> String -> m (Maybe Name)
+ -- | See 'reify'.
+ qReify :: Name -> m Info
+ -- | See 'reifyFixity'.
+ qReifyFixity :: Name -> m (Maybe Fixity)
+ -- | See 'reifyType'.
+ qReifyType :: Name -> m Type
+ -- | Is (n tys) an instance? Returns list of matching instance Decs (with
+ -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'.
+ qReifyInstances :: Name -> [Type] -> m [Dec]
+ -- | See 'reifyRoles'.
+ qReifyRoles :: Name -> m [Role]
+ -- | See 'reifyAnnotations'.
+ qReifyAnnotations :: Data a => AnnLookup -> m [a]
+ -- | See 'reifyModule'.
+ qReifyModule :: Module -> m ModuleInfo
+ -- | See 'reifyConStrictness'.
+ qReifyConStrictness :: Name -> m [DecidedStrictness]
+
+ -- | See 'location'.
+ qLocation :: m Loc
+
+ -- | Input/output (dangerous). See 'runIO'.
+ qRunIO :: IO a -> m a
+ qRunIO = liftIO
+ -- | See 'getPackageRoot'.
+ qGetPackageRoot :: m FilePath
+
+ -- | See 'addDependentFile'.
+ qAddDependentFile :: FilePath -> m ()
+
+ -- | See 'addDependentDirectory'.
+ qAddDependentDirectory :: FilePath -> m ()
+
+ -- | See 'addTempFile'.
+ qAddTempFile :: String -> m FilePath
+
+ -- | See 'addTopDecls'.
+ qAddTopDecls :: [Dec] -> m ()
+
+ -- | See 'addForeignFilePath'.
+ qAddForeignFilePath :: ForeignSrcLang -> String -> m ()
+
+ -- | See 'addModFinalizer'.
+ qAddModFinalizer :: Q () -> m ()
+
+ -- | See 'addCorePlugin'.
+ qAddCorePlugin :: String -> m ()
+
+ -- | See 'getQ'.
+ qGetQ :: Typeable a => m (Maybe a)
+
+ -- | See 'putQ'.
+ qPutQ :: Typeable a => a -> m ()
+
+ -- | See 'isExtEnabled'.
+ qIsExtEnabled :: Extension -> m Bool
+ -- | See 'extsEnabled'.
+ qExtsEnabled :: m [Extension]
+
+ -- | See 'putDoc'.
+ qPutDoc :: DocLoc -> String -> m ()
+ -- | See 'getDoc'.
+ qGetDoc :: DocLoc -> m (Maybe String)
+
+-- | \"Runs\" the 'Q' monad. Normal users of Template Haskell
+-- should not need this function, as the splice brackets @$( ... )@
+-- are the usual way of running a 'Q' computation.
+--
+-- This function is primarily used in GHC internals, and for debugging
+-- splices by running them in 'IO'.
+--
+-- Note that many functions in 'Q', such as 'reify' and other compiler
+-- queries, are not supported when running 'Q' in 'IO'; these operations
+-- simply fail at runtime. Indeed, the only operations guaranteed to succeed
+-- are 'newName', 'runIO', 'reportError' and 'reportWarning'.
+runQ :: Quasi m => Q a -> m a
+runQ = qRunQ
+
+-----------------------------------------------------
+-- The IO instance of Quasi
+-----------------------------------------------------
+
+-- | This instance is used only when running a Q
+-- computation in the IO monad, usually just to
+-- print the result. There is no interesting
+-- type environment, so reification isn't going to
+-- work.
+instance Quasi IO where
+ qRunQ (Q m) = m metaHandlersIO
+ qNewName = newNameIO
+
+ qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
+ qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
+
+ qLookupName _ _ = badIO "lookupName"
+ qReify _ = badIO "reify"
+ qReifyFixity _ = badIO "reifyFixity"
+ qReifyType _ = badIO "reifyFixity"
+ qReifyInstances _ _ = badIO "reifyInstances"
+ qReifyRoles _ = badIO "reifyRoles"
+ qReifyAnnotations _ = badIO "reifyAnnotations"
+ qReifyModule _ = badIO "reifyModule"
+ qReifyConStrictness _ = badIO "reifyConStrictness"
+ qLocation = badIO "currentLocation"
+ qRecover _ _ = badIO "recover" -- Maybe we could fix this?
+ qGetPackageRoot = badIO "getProjectRoot"
+ qAddDependentFile _ = badIO "addDependentFile"
+ qAddTempFile _ = badIO "addTempFile"
+ qAddTopDecls _ = badIO "addTopDecls"
+ qAddForeignFilePath _ _ = badIO "addForeignFilePath"
+ qAddModFinalizer _ = badIO "addModFinalizer"
+ qAddCorePlugin _ = badIO "addCorePlugin"
+ qGetQ = badIO "getQ"
+ qPutQ _ = badIO "putQ"
+ qIsExtEnabled _ = badIO "isExtEnabled"
+ qExtsEnabled = badIO "extsEnabled"
+ qPutDoc _ _ = badIO "putDoc"
+ qGetDoc _ = badIO "getDoc"
+ qAddDependentDirectory _ = badIO "AddDependentDirectory"
+
+badIO :: String -> IO a
+badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
+ ; fail "Template Haskell failure" }
+
+instance Quasi Q where
+ qRunQ = id
+ qNewName = newName
+ qReport = report
+ qRecover = recover
+ qReify = reify
+ qReifyFixity = reifyFixity
+ qReifyType = reifyType
+ qReifyInstances = reifyInstances
+ qReifyRoles = reifyRoles
+ qReifyAnnotations = reifyAnnotations
+ qReifyModule = reifyModule
+ qReifyConStrictness = reifyConStrictness
+ qLookupName = lookupName
+ qLocation = location
+ qGetPackageRoot = getPackageRoot
+ qAddDependentFile = addDependentFile
+ qAddDependentDirectory = addDependentDirectory
+ qAddTempFile = addTempFile
+ qAddTopDecls = addTopDecls
+ qAddForeignFilePath = addForeignFilePath
+ qAddModFinalizer = addModFinalizer
+ qAddCorePlugin = addCorePlugin
+ qGetQ = getQ
+ qPutQ = putQ
+ qIsExtEnabled = isExtEnabled
+ qExtsEnabled = extsEnabled
+ qPutDoc = putDoc
+ qGetDoc = getDoc
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2120b748420b75023cdfc06b05b80fd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2120b748420b75023cdfc06b05b80fd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/faster-linkBCO] 25 commits: Introduce `-fimport-loaded-targets` GHCi flag
by Cheng Shao (＠TerrorJack) 21 Mar '26
by Cheng Shao (＠TerrorJack) 21 Mar '26
21 Mar '26
Cheng Shao pushed to branch wip/faster-linkBCO at Glasgow Haskell Compiler / GHC
Commits:
86bd9bfc by fendor at 2026-03-17T23:46:09-04:00
Introduce `-fimport-loaded-targets` GHCi flag
This new flag automatically adds all loaded targets to the GHCi session
by adding an `InteractiveImport` for the loaded targets.
By default, this flag is disabled, as it potentially increases memory-usage.
This interacts with the flag `-fno-load-initial-targets` as follows:
* If no module is loaded, no module is added as an interactive import.
* If a reload loads up to a module, all loaded modules are added as
interactive imports.
* Unloading modules removes them from the interactive context.
Fixes #26866 by rendering the use of a `-ghci-script` to achieve the
same thing redundant.
- - - - -
e3d4c1bb by mniip at 2026-03-17T23:47:03-04:00
ghc-internal: Remove GHC.Internal.Data.Eq
It served no purpose other than being a re-export.
- - - - -
6f4f6cf0 by mniip at 2026-03-17T23:47:03-04:00
ghc-internal: Refine GHC.Internal.Base imports
Removed re-exports from GHC.Internal.Base. This reveals some modules
that don't actually use anything *defined* in GHC.Internal.Base, and
that can be pushed down a little in the import graph.
Replaced most imports of GHC.Internal.Base with non-wildcard imports
from modules where the identifiers are actually defined.
Part of #26834
Metric Decrease:
T5321FD
- - - - -
7fb51f54 by mangoiv at 2026-03-17T23:48:00-04:00
ci: clone, don't copy when creating the cabal cache
Also removed WINDOWS_HOST variable detected via uname - we now just
check whether the CI job has windows in its name. This works because we
only ever care about it if the respective job is not a cross job. We
also statically detect darwin cross jobs in the same way. We only ever have
darwin -> darwin cross jobs so this is enough to detect the host
reliably.
- - - - -
f8817879 by mangoiv at 2026-03-17T23:48:44-04:00
ci: mark size_hello_artifact fragile on darwin x86
The size of the x86_64 hello artifact is not stable which results in flaky testruns.
Resolves #26814
- - - - -
e34cb6da by Adam Gundry at 2026-03-20T12:20:00-04:00
ghci: Mention active language edition in startup banner
Per GHC proposal 632, this makes the GHCi startup banner include
the active language edition, plus an indication of whether this
was the default (as opposed to being explicitly selected via an
option such as `-XGHC2024`). For example:
```
$ ghci
GHCi, version 9.14.1: https://www.haskell.org/ghc/ :? for help
Using default language edition: GHC2024
ghci>
```
Fixes #26037.
- - - - -
52c3e6ba by sheaf at 2026-03-20T12:21:09-04:00
Improve incomplete record selector warnings
This commit stops GHC from emitting spurious incomplete record selector
warnings for bare selectors/projections such as .fld
There are two places we currently emit incomplete record selector
warnings:
1. In the desugarer, when we see a record selector or an occurrence
of 'getField'. Here, we can use pattern matching information to
ensure we don't give false positives.
2. In the typechecker, which might sometimes give false positives but
can emit warnings in cases that the pattern match checker would
otherwise miss.
This is explained in Note [Detecting incomplete record selectors]
in GHC.HsToCore.Pmc.
Now, we obviously don't want to emit the same error twice, and generally
we prefer (1), as those messages contain fewer false positives. So we
suppress (2) when we are sure we are going to emit (1); the logic for
doing so is in GHC.Tc.Instance.Class.warnIncompleteRecSel,
and works by looking at the CtOrigin.
Now, the issue was that this logic handled explicit record selectors as
well as overloaded record field selectors such as "x.r" (which turns
into a simple GetFieldOrigin CtOrigin), but it didn't properly handle
record projectors like ".fld" or ".fld1.fld2" (which result in other
CtOrigins such as 'RecordFieldProjectionOrigin').
To solve this problem, we re-use the 'isHasFieldOrigin' introduced in
fbdc623a (slightly adjusted).
On the way, we also had to update the desugarer with special handling
for the 'ExpandedThingTc' case in 'ds_app', to make sure that
'ds_app_var' sees all the type arguments to 'getField' in order for it
to indeed emit warnings like in (1).
Fixes #26686
- - - - -
309d7e87 by Cheng Shao at 2026-03-20T12:21:53-04:00
rts: opportunistically grow the MutableByteArray# in-place in resizeMutableByteArray#
Following !15234, this patch improves `resizeMutableByteArray#` memory
efficiency by growing the `MutableByteArray#` in-place if possible,
addressing an old todo comment here. Also adds a new test case
`resizeMutableByteArrayInPlace` that stresses this behavior.
- - - - -
7d4ef162 by Matthew Craven at 2026-03-20T12:22:47-04:00
Change representation of floating point literals
This commit changes the representation of floating point literals
throughough the compiler, in particular in Core and Cmm.
The Rational type is deficient for this purpose, dealing poorly
with NaN, +/-Infinity, and negative zero. Instead, the new module
GHC.Types.Literal.Floating uses the host Float/Double type to represent
NaNs, infinities and negative zero. It also contains a Rational
constructor, for the benefit of -fexcess-precision.
Other changes:
- Remove Note [negative zero] and related code
This also removes the restrictions on constant-folding of division
by zero, and should make any problems with NaN/Infinity more obvious.
- Use -0.0 as the additive identity for Core constant folding rules
for floating-point addition, fixing #21227.
- Manual worker-wrapper for GHC.Float.rationalToDouble. This is
intended to prevent the compiler's WW on this function from
interfering with constant-folding. This change means that we now
avoid allocating a box for the result of a 'realToFrac' call in
T10359.
- Combine floatDecodeOp and doubleDecodeOp.
This change also fixes a bug in doubleDecodeOp wherein it
would incorrectly produce an Int# instead of an Int64#
literal for the mantissa component with 64-bit targets.
- Use Float/Double for assembly immediates, and update the X86 and
PowerPC backends to properly handle special values such as NaN and
infinity.
- Allow 'rational_to' to handle zero denominators, fixing a
TODO in GHC.Core.Opt.ConstantFold.
Fixes #8364 #9811 #18897 #21227
Progress towards #26919
Metric Decrease:
T10359
Co-authored-by: sheaf <sam.derbyshire(a)gmail.com>
-------------------------
Metric Decrease:
T1969
T5321FD
-------------------------
- - - - -
80e2dd4f by Zubin Duggal at 2026-03-20T12:23:33-04:00
compiler/ffi: Collapse void pointer chains in capi wrappers
New gcc/clang treat -Wincompatible-pointer-types as an error by
default. Since C only allows implicit conversion from void*, not void**,
capi wrappers for functions taking e.g. abstract** would fail to compile
when the Haskell type Ptr (Ptr Abstract) was naively translated to void**.
Collapse nested void pointers to a single void* when the pointee type
has no known C representation.
Fixes #26852
- - - - -
1c50bd7b by Luite Stegeman at 2026-03-20T12:24:37-04:00
Move some functions related to pointer tagging to a separate module
- - - - -
bfd7aafd by Luite Stegeman at 2026-03-20T12:24:37-04:00
Branchless unpacking for enumeration types
Change unpacking for enumeration types to go to Word8#/Word16#/Word#
directly instead of going through an intermediate unboxed sum. This
allows us to do a branchless conversion using DataToTag and TagToEnum.
Fixes #26970
- - - - -
72b20fc0 by Luite Stegeman at 2026-03-20T12:25:30-04:00
bytecode: Carefully SLIDE off the end of a stack chunk
The SLIDE bytecode instruction was not checking for stack chunk
boundaries and could corrupt the stack underflow frame, leading
to crashes.
We add a check to use safe writes if we cross the chunk boundary
and also handle stack underflow if Sp is advanced past the underflow
frame.
fix #27001
- - - - -
2e22b43c by Cheng Shao at 2026-03-20T12:26:14-04:00
ghci: serialize BCOByteArray buffer directly when possible
This patch changes the `Binary` instances of `BCOByteArray` to
directly serialize the underlying buffer when possible, while also
taking into account the issue of host-dependent `Word` width. See
added comments and amended `Note [BCOByteArray serialization]` for
detailed explanation. Closes #27020.
- - - - -
89d9ba37 by Sylvain Henry at 2026-03-20T12:27:34-04:00
JS: replace BigInt with Number arithmetic for 32/64-bit quot/rem (#23597)
Replace BigInt-based implementations of quotWord32, remWord32,
quotRemWord32, quotRem2Word32, quotWord64, remWord64, quotInt64, and
remInt64 with pure Number (double/integer) arithmetic to avoid the
overhead of BigInt promotion.
- - - - -
ae4ddd60 by Sylvain Henry at 2026-03-20T12:28:28-04:00
Core: add constant-folding rules for Addr# eq/ne (#18032)
- - - - -
3e767f98 by Matthew Pickering at 2026-03-20T12:29:11-04:00
Use OsPath rather than FilePath in Downsweep cache
This gets us one step closure to uniformly using `OsPath` in the
compiler.
- - - - -
2c57de29 by Cheng Shao at 2026-03-20T12:29:55-04:00
hadrian: fix ghc-in-ghci flavour stage0 shared libraries
This patch fixes missing stage0 shared libraries in hadrian
ghc-in-ghci flavour, which was accidentally dropped in
669d09f950a6e88b903d9fd8a7571531774d4d5d and resulted in a regression
in HLS support on linux/macos. Fixes #27057.
- - - - -
5b1be555 by Sylvain Henry at 2026-03-20T12:30:48-04:00
JS: install rts/Types.h header file (#27033)
It was an omission, making HsFFI.h not usable with GHC using the JS
backend.
- - - - -
b883f08f by Cheng Shao at 2026-03-20T12:31:33-04:00
hadrian: don't compile RTS with -Winline
This patch removes `-Winline` from cflags when compiling the RTS,
given that:
1. It generates a huge pile of spam and hurts developer experience
2. Whether inlining happens is highly dependent on toolchains,
flavours, etc, and it's not really an issue to fix if inlining
doesn't happen; it's a hint to the C compiler anyway.
Fixes #27060.
- - - - -
333387d6 by Cheng Shao at 2026-03-20T12:31:33-04:00
hadrian: compile libffi-clib with -Wno-deprecated-declarations
This patch adds `-Wno-deprecated-declarations` to cflags of
`libffi-clib`, given that it produces noise at compile-time that
aren't really our issue to fix anyway, it's from vendored libffi
source code.
- - - - -
67c47771 by Rodrigo Mesquita at 2026-03-20T12:32:17-04:00
Expose decodeStackWithIpe from ghc-experimental
This decoding is useful to the debugger and it wasn't originally
exported as an oversight.
- - - - -
45a295f5 by Cheng Shao at 2026-03-21T00:37:07+01:00
ghc-boot: move GHC.Data.SmallArray to ghc-boot
This commit moves `GHC.Data.SmallArray` from the `ghc` library to
`ghc-boot`, so that it can be used by `ghci` as well:
- The `Binary` (from `ghc`) instance of `SmallArray` is moved to
`GHC.Utils.Binary`
- Util functions `replicateSmallArrayIO`, `mapSmallArrayIO`,
`mapSmallArrayM_`, `imapSmallArrayM_` , `smallArrayFromList` and
`smallArrayToList` are added
- The `Show` instance is added
- The `Binary` (from `binary`) instance is added
- - - - -
d2a87c05 by Cheng Shao at 2026-03-21T00:00:51+00:00
compiler: use `Binary` instance of `BCOByteArray` for bytecode objects
This commit defines `Binary` (from `compiler`) instance of
`BCOByteArray` which serializes the underlying buffer directly, and
uses it directly in bytecode object serialization. Previously we reuse
the `Binary` (from `binary`) instance, and this change allows us to
avoid double-copying via an intermediate `ByteString` when using
`put`/`get` in `binnary`. Also see added comment for explanation.
- - - - -
8a2ee362 by Cheng Shao at 2026-03-21T00:09:15+00:00
ghci: use SmallArray directly in ResolvedBCO/UnlinkedBCO
This patch makes ghci use `SmallArray` directly in `ResolvedBCO` and
`UnlinkedBCO` when applicable, making the memory representation more
compact and reducing marshaling overhead. Closes #27058.
- - - - -
391 changed files:
- .gitlab/ci.sh
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/Cmm/Expr.hs
- compiler/GHC/Cmm/Opt.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/Type.hs
- compiler/GHC/Cmm/Utils.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/AArch64/Regs.hs
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/LA64/Ppr.hs
- compiler/GHC/CmmToAsm/LA64/Regs.hs
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/PPC/Regs.hs
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
- compiler/GHC/CmmToAsm/RV64/Regs.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToAsm/X86/Regs.hs
- compiler/GHC/CmmToC.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- + compiler/GHC/Platform/Tag.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Closure.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToCmm/Lit.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Literal.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/Literal.hs
- + compiler/GHC/Types/Literal/Floating.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Utils/Binary.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.16.1-notes.rst
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- ghc/Main.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- hadrian/src/Settings/Packages.hs
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Data/Char.hs
- libraries/base/src/Data/Eq.hs
- libraries/base/src/Data/Semigroup.hs
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/Weak/Finalize.hs
- libraries/base/src/Prelude.hs
- compiler/GHC/Data/SmallArray.hs → libraries/ghc-boot/GHC/Data/SmallArray.hs
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-experimental/ghc-experimental.cabal.in
- libraries/ghc-experimental/src/GHC/Profiling/Eras.hs
- + libraries/ghc-experimental/src/GHC/Stack/Decode/Experimental.hs
- libraries/ghc-internal/codepages/MakeTable.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Arr.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
- libraries/ghc-internal/src/GHC/Internal/Char.hs
- libraries/ghc-internal/src/GHC/Internal/Clock.hsc
- libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Bound.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Signal.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/ConsoleHandler.hsc
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Concurrent/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/IO/Class.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Dynamic.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Either.hs
- − libraries/ghc-internal/src/GHC/Internal/Data/Eq.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Function.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Const.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Data/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/List.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Proxy.hs
- libraries/ghc-internal/src/GHC/Internal/Data/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/String.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Bool.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Coercion.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Equality.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/Enum.hs
- libraries/ghc-internal/src/GHC/Internal/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/IntVar.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Manager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/PSQ.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Poll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimeOut.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Clock.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ConsoleEvent.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/FFI.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Fingerprint/Type.hs
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs
- libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/ConstPtr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/ForeignPtr/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Alloc.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Pool.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignPtr.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- libraries/ghc-internal/src/GHC/Internal/Generics.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Buffer.hs
- libraries/ghc-internal/src/GHC/Internal/IO/BufferedIO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/API.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/Table.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Iconv.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Latin1.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF16.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF32.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Flock.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/NoOp.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Unsafe.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc
- libraries/ghc-internal/src/GHC/Internal/IOArray.hs
- libraries/ghc-internal/src/GHC/Internal/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Int.hs
- libraries/ghc-internal/src/GHC/Internal/IsList.hs
- libraries/ghc-internal/src/GHC/Internal/Ix.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal/Build.hs
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- libraries/ghc-internal/src/GHC/Internal/Lexeme.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-internal/src/GHC/Internal/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Num.hs
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- libraries/ghc-internal/src/GHC/Internal/OverloadedLabels.hs
- libraries/ghc-internal/src/GHC/Internal/Pack.hs
- libraries/ghc-internal/src/GHC/Internal/Profiling.hs
- libraries/ghc-internal/src/GHC/Internal/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs
- libraries/ghc-internal/src/GHC/Internal/ST.hs
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/src/GHC/Internal/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Show.hs
- libraries/ghc-internal/src/GHC/Internal/Stable.hs
- libraries/ghc-internal/src/GHC/Internal/StableName.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Stats.hsc
- libraries/ghc-internal/src/GHC/Internal/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
- libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO/Error.hs
- libraries/ghc-internal/src/GHC/Internal/System/Mem.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Types.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadP.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadPrec.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read/Lex.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/DerivedCoreProperties.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/GeneralCategory.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleLowerCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleTitleCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleUpperCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unsafe/Coerce.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Flag.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Weak.hs
- libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs
- libraries/ghc-internal/src/GHC/Internal/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/Word.hs
- libraries/ghc-internal/tools/ucd2haskell/exe/UCD2Haskell/ModuleGenerators.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/ResolvedBCO.hs
- rts/Interpreter.c
- rts/PrimOps.cmm
- rts/js/arith.js
- rts/rts.cabal
- + testsuite/tests/bytecode/T27001.hs
- + testsuite/tests/bytecode/T27001.stdout
- testsuite/tests/bytecode/all.T
- + testsuite/tests/codeGen/should_run/T21227.hs
- + testsuite/tests/codeGen/should_run/T21227.stdout
- + testsuite/tests/codeGen/should_run/T9811.hs
- + testsuite/tests/codeGen/should_run/T9811.stdout
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- + testsuite/tests/ffi/should_compile/T26852.h
- + testsuite/tests/ffi/should_compile/T26852.hs
- + testsuite/tests/ffi/should_compile/T26852.stderr
- testsuite/tests/ffi/should_compile/all.T
- testsuite/tests/ghci/prog-mhu005/Makefile
- testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005b.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005b.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005c.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005d.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005e.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005f.stdout
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005g.stdout
- testsuite/tests/ghci/prog022/Makefile
- testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022c.script
- + testsuite/tests/ghci/prog022/ghci.prog022c.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022c.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022d.script
- + testsuite/tests/ghci/prog022/ghci.prog022d.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022d.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022e.script
- + testsuite/tests/ghci/prog022/ghci.prog022e.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022e.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022f.script
- + testsuite/tests/ghci/prog022/ghci.prog022f.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022f.stdout
- testsuite/tests/ghci/should_run/BinaryArray.hs
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- + testsuite/tests/javascript/js-c-sources/T27033.hs
- + testsuite/tests/javascript/js-c-sources/T27033.stdout
- + testsuite/tests/javascript/js-c-sources/T27033_c.c
- + testsuite/tests/javascript/js-c-sources/T27033_js.js
- testsuite/tests/javascript/js-c-sources/all.T
- testsuite/tests/numeric/should_run/T7014.hs
- + testsuite/tests/overloadedrecflds/should_compile/T26686.hs
- + testsuite/tests/overloadedrecflds/should_compile/T26686.stderr
- testsuite/tests/overloadedrecflds/should_compile/all.T
- testsuite/tests/perf/size/all.T
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/profiling/should_run/callstack002.stderr
- testsuite/tests/profiling/should_run/callstack002.stdout
- testsuite/tests/rts/all.T
- + testsuite/tests/rts/resizeMutableByteArrayInPlace.hs
- + testsuite/tests/simplCore/should_compile/T18032.hs
- + testsuite/tests/simplCore/should_compile/T18032.stderr
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplStg/should_run/all.T
- + testsuite/tests/simplStg/should_run/unpack_enum.hs
- + testsuite/tests/simplStg/should_run/unpack_enum.stdout
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14d690c857ba8d7783c2e8f31c1212…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14d690c857ba8d7783c2e8f31c1212…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Teo Camarasu pushed to branch wip/abstract-q at Glasgow Haskell Compiler / GHC
Commits:
816917e1 by Teo Camarasu at 2026-03-20T23:36:22+00:00
wip
- - - - -
3 changed files:
- compiler/GHC/Tc/Gen/Splice.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
Changes:
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -1139,6 +1139,7 @@ convertAnnotationWrapper fhv = do
************************************************************************
-}
+-- TODO: rename
runQuasi :: TH.Q a -> TcM a
runQuasi (TH.Q act) = unliftIOEnv $ \runInIO -> liftIO $ act (metaHandlersTcM runInIO)
@@ -1467,7 +1468,7 @@ when showing an error message.
To call runQ in the Tc monad, we need to make TcM an instance of Quasi:
-}
-report :: Bool -> [Char] -> TcM ()
+report :: Bool -> String -> TcM ()
report True msg = seqList msg $ addErr $ TcRnTHError $ ReportCustomQuasiError True msg
report False msg = seqList msg $ addDiagnostic $ TcRnTHError $ ReportCustomQuasiError False msg
@@ -1559,7 +1560,8 @@ location = do { m <- getModule
metaHandlersTcM :: (forall x. TcM x -> IO x) -> TH.MetaHandlers IO
metaHandlersTcM runInIO = TH.MetaHandlers {
- mFail = \s -> runInIO $ fail s
+ -- We are careful to use the TcM instance not the one for IO, since that would lead to a different error.
+ mFail = \s -> runInIO $ fail @TcM s
, mNewName = \s -> runInIO $ do { u <- newUnique
; let i = toInteger (getKey u)
; return (TH.mkNameU s i) }
@@ -1578,16 +1580,17 @@ metaHandlersTcM runInIO = TH.MetaHandlers {
, mReifyRoles = runInIO . reifyRoles
, mReifyAnnotations = runInIO . reifyAnnotations
, mReifyModule = runInIO . reifyModule
- , mReifyConStrictness = \nm -> runInIO $ do { nm' <- lookupThName nm
+ , mReifyConStrictness = \nm -> runInIO $ do
+ { nm' <- lookupThName nm
; dc <- tcLookupDataCon nm'
; let bangs = dataConImplBangs dc
; return (map reifyDecidedStrictness bangs) }
- -- -- For qRecover, discard error messages if
- -- -- the recovery action is chosen. Otherwise
- -- -- we'll only fail higher up.
- -- -- NB: extremely subtle!!! TODO: write up note
- -- -- tryTcDiscardingErrs manipulates the reader env so we need to be careful we don't sneak in the outside env
+ -- For qRecover, discard error messages if
+ -- the recovery action is chosen. Otherwise
+ -- we'll only fail higher up.
+ -- NB: extremely subtle!!! TODO: write up note
+ -- tryTcDiscardingErrs manipulates the reader env so we need to be careful we don't sneak in the outside env
, mRecover = \recover main -> runInIO $ tryTcDiscardingErrs (runQuasi recover) (runQuasi main)
, mGetPackageRoot = runInIO $ do
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
=====================================
@@ -52,175 +52,6 @@ import GHC.Internal.ForeignSrcLang
import GHC.Internal.LanguageExtensions
import GHC.Internal.TH.Syntax
------------------------------------------------------
---
--- The Quasi class
---
------------------------------------------------------
-
-class (MonadIO m, MonadFail m) => Quasi m where
- qRunQ :: Q a -> m a
- -- | Fresh names. See 'newName'.
- qNewName :: String -> m Name
-
- ------- Error reporting and recovery -------
- -- | Report an error (True) or warning (False)
- -- ...but carry on; use 'fail' to stop. See 'report'.
- qReport :: Bool -> String -> m ()
-
- -- | See 'recover'.
- qRecover :: m a -- ^ the error handler
- -> m a -- ^ action which may fail
- -> m a -- ^ Recover from the monadic 'fail'
-
- ------- Inspect the type-checker's environment -------
- -- | True <=> type namespace, False <=> value namespace. See 'lookupName'.
- qLookupName :: Bool -> String -> m (Maybe Name)
- -- | See 'reify'.
- qReify :: Name -> m Info
- -- | See 'reifyFixity'.
- qReifyFixity :: Name -> m (Maybe Fixity)
- -- | See 'reifyType'.
- qReifyType :: Name -> m Type
- -- | Is (n tys) an instance? Returns list of matching instance Decs (with
- -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'.
- qReifyInstances :: Name -> [Type] -> m [Dec]
- -- | See 'reifyRoles'.
- qReifyRoles :: Name -> m [Role]
- -- | See 'reifyAnnotations'.
- qReifyAnnotations :: Data a => AnnLookup -> m [a]
- -- | See 'reifyModule'.
- qReifyModule :: Module -> m ModuleInfo
- -- | See 'reifyConStrictness'.
- qReifyConStrictness :: Name -> m [DecidedStrictness]
-
- -- | See 'location'.
- qLocation :: m Loc
-
- -- | Input/output (dangerous). See 'runIO'.
- qRunIO :: IO a -> m a
- qRunIO = liftIO
- -- | See 'getPackageRoot'.
- qGetPackageRoot :: m FilePath
-
- -- | See 'addDependentFile'.
- qAddDependentFile :: FilePath -> m ()
-
- -- | See 'addDependentDirectory'.
- qAddDependentDirectory :: FilePath -> m ()
-
- -- | See 'addTempFile'.
- qAddTempFile :: String -> m FilePath
-
- -- | See 'addTopDecls'.
- qAddTopDecls :: [Dec] -> m ()
-
- -- | See 'addForeignFilePath'.
- qAddForeignFilePath :: ForeignSrcLang -> String -> m ()
-
- -- | See 'addModFinalizer'.
- qAddModFinalizer :: Q () -> m ()
-
- -- | See 'addCorePlugin'.
- qAddCorePlugin :: String -> m ()
-
- -- | See 'getQ'.
- qGetQ :: Typeable a => m (Maybe a)
-
- -- | See 'putQ'.
- qPutQ :: Typeable a => a -> m ()
-
- -- | See 'isExtEnabled'.
- qIsExtEnabled :: Extension -> m Bool
- -- | See 'extsEnabled'.
- qExtsEnabled :: m [Extension]
-
- -- | See 'putDoc'.
- qPutDoc :: DocLoc -> String -> m ()
- -- | See 'getDoc'.
- qGetDoc :: DocLoc -> m (Maybe String)
-
------------------------------------------------------
--- The IO instance of Quasi
------------------------------------------------------
-
--- | This instance is used only when running a Q
--- computation in the IO monad, usually just to
--- print the result. There is no interesting
--- type environment, so reification isn't going to
--- work.
-instance Quasi IO where
- qRunQ (Q m) = m metaHandlersIO
- qNewName = newNameIO
-
- qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
- qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
-
- qLookupName _ _ = badIO "lookupName"
- qReify _ = badIO "reify"
- qReifyFixity _ = badIO "reifyFixity"
- qReifyType _ = badIO "reifyFixity"
- qReifyInstances _ _ = badIO "reifyInstances"
- qReifyRoles _ = badIO "reifyRoles"
- qReifyAnnotations _ = badIO "reifyAnnotations"
- qReifyModule _ = badIO "reifyModule"
- qReifyConStrictness _ = badIO "reifyConStrictness"
- qLocation = badIO "currentLocation"
- qRecover _ _ = badIO "recover" -- Maybe we could fix this?
- qGetPackageRoot = badIO "getProjectRoot"
- qAddDependentFile _ = badIO "addDependentFile"
- qAddTempFile _ = badIO "addTempFile"
- qAddTopDecls _ = badIO "addTopDecls"
- qAddForeignFilePath _ _ = badIO "addForeignFilePath"
- qAddModFinalizer _ = badIO "addModFinalizer"
- qAddCorePlugin _ = badIO "addCorePlugin"
- qGetQ = badIO "getQ"
- qPutQ _ = badIO "putQ"
- qIsExtEnabled _ = badIO "isExtEnabled"
- qExtsEnabled = badIO "extsEnabled"
- qPutDoc _ _ = badIO "putDoc"
- qGetDoc _ = badIO "getDoc"
- qAddDependentDirectory _ = badIO "AddDependentDirectory"
-
-metaHandlersIO :: MetaHandlers IO
-metaHandlersIO = MetaHandlers {
- mFail = fail
- , mNewName = newNameIO
- , mReport = \b msg ->
- if b then
- hPutStrLn stderr ("Template Haskell error: " ++ msg)
- else
- hPutStrLn stderr ("Template Haskell error: " ++ msg) -- TODO: should this be different from above?
- , mLookupName = \ _ _ -> badIO "lookupName"
- , mReify = \_ -> badIO "reify"
- , mReifyFixity = \_ -> badIO "reifyFixity"
- , mReifyType = \_ -> badIO "reifyFixity"
- , mReifyInstances = \_ _ -> badIO "reifyInstances"
- , mReifyRoles = \_ -> badIO "reifyRoles"
- , mReifyAnnotations = \_ -> badIO "reifyAnnotations"
- , mReifyModule = \_ -> badIO "reifyModule"
- , mReifyConStrictness = \_ -> badIO "reifyConStrictness"
- , mLocation = badIO "currentLocation"
- , mRecover = \_ _ -> badIO "recover" -- Maybe we could fix this?
- , mGetPackageRoot = badIO "getProjectRoot"
- , mAddDependentFile = \_ -> badIO "addDependentFile"
- , mAddTempFile = \_ -> badIO "addTempFile"
- , mAddTopDecls = \_ -> badIO "addTopDecls"
- , mAddForeignFilePath = \_ _ -> badIO "addForeignFilePath"
- , mAddModFinalizer = \_ -> badIO "addModFinalizer"
- , mAddCorePlugin = \_ -> badIO "addCorePlugin"
- , mGetQ = badIO "getQ"
- , mPutQ = \_ -> badIO "putQ"
- , mIsExtEnabled = \_ -> badIO "isExtEnabled"
- , mExtsEnabled = badIO "extsEnabled"
- , mPutDoc = \_ _ -> badIO "putDoc"
- , mGetDoc = \_ -> badIO "getDoc"
- , mAddDependentDirectory = \_ -> badIO "AddDependentDirectory"
- }
-
-instance Quote IO where
- newName = newNameIO
-
data MetaHandlers m = MetaHandlers {
mFail :: forall a. String -> m a
-- | Fresh names. See 'newName'.
@@ -301,15 +132,51 @@ data MetaHandlers m = MetaHandlers {
, mGetDoc :: DocLoc -> m (Maybe String)
}
+metaHandlersIO :: MetaHandlers IO
+metaHandlersIO = MetaHandlers {
+ mFail = fail
+ , mNewName = newNameIO
+ , mReport = \b msg ->
+ if b then
+ hPutStrLn stderr ("Template Haskell error: " ++ msg)
+ else
+ hPutStrLn stderr ("Template Haskell error: " ++ msg) -- TODO: should this be different from above?
+ , mLookupName = \ _ _ -> badIO "lookupName"
+ , mReify = \_ -> badIO "reify"
+ , mReifyFixity = \_ -> badIO "reifyFixity"
+ , mReifyType = \_ -> badIO "reifyFixity"
+ , mReifyInstances = \_ _ -> badIO "reifyInstances"
+ , mReifyRoles = \_ -> badIO "reifyRoles"
+ , mReifyAnnotations = \_ -> badIO "reifyAnnotations"
+ , mReifyModule = \_ -> badIO "reifyModule"
+ , mReifyConStrictness = \_ -> badIO "reifyConStrictness"
+ , mLocation = badIO "currentLocation"
+ , mRecover = \_ _ -> badIO "recover" -- Maybe we could fix this?
+ , mGetPackageRoot = badIO "getProjectRoot"
+ , mAddDependentFile = \_ -> badIO "addDependentFile"
+ , mAddTempFile = \_ -> badIO "addTempFile"
+ , mAddTopDecls = \_ -> badIO "addTopDecls"
+ , mAddForeignFilePath = \_ _ -> badIO "addForeignFilePath"
+ , mAddModFinalizer = \_ -> badIO "addModFinalizer"
+ , mAddCorePlugin = \_ -> badIO "addCorePlugin"
+ , mGetQ = badIO "getQ"
+ , mPutQ = \_ -> badIO "putQ"
+ , mIsExtEnabled = \_ -> badIO "isExtEnabled"
+ , mExtsEnabled = badIO "extsEnabled"
+ , mPutDoc = \_ _ -> badIO "putDoc"
+ , mGetDoc = \_ -> badIO "getDoc"
+ , mAddDependentDirectory = \_ -> badIO "AddDependentDirectory"
+ }
+
+instance Quote IO where
+ newName = newNameIO
+
+
newNameIO :: String -> IO Name
newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))
; pure (mkNameU s n) }
-badIO :: String -> IO a
-badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
- ; fail "Template Haskell failure" }
-
-- Global variable to generate unique symbols
counter :: IORef Uniq
{-# NOINLINE counter #-}
@@ -430,14 +297,17 @@ class Monad m => Quote m where
-}
newName :: String -> m Name
+-- | Utility function for lifting a 0-ary method of 'MetaHandlers' into 'Q'
runHandler :: (forall m. MetaHandlers m -> m a) -> Q a
-runHandler op = Q $ \h -> (op h)
+runHandler op = Q $ \h -> op h
+-- | Utility function for lifting a 1-ary method of 'MetaHandlers' into 'Q'
runHandler1 :: (forall m. MetaHandlers m -> a -> m b) -> a -> Q b
-runHandler1 op = \x -> Q $ \h -> (op h x)
+runHandler1 op = \x -> Q $ \h -> op h x
+-- | Utility function for lifting a 2-ary method of 'MetaHandlers' into 'Q'
runHandler2 :: (forall m. MetaHandlers m -> a -> b -> m c) -> a -> b -> Q c
-runHandler2 op = \x y -> Q $ \h -> (op h x y)
+runHandler2 op = \x y -> Q $ \h -> op h x y
instance Quote Q where
newName = runHandler1 mNewName
@@ -658,15 +528,15 @@ recover rec main = Q $ \h -> mRecover h rec main
-- We don't export lookupName; the Bool isn't a great API
-- Instead we export lookupTypeName, lookupValueName
lookupName :: Bool -> String -> Q (Maybe Name)
-lookupName ns s = runHandler2 mLookupName ns s
+lookupName = runHandler2 mLookupName
-- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
lookupTypeName :: String -> Q (Maybe Name)
-lookupTypeName s = runHandler2 mLookupName True s
+lookupTypeName = runHandler2 mLookupName True
-- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
lookupValueName :: String -> Q (Maybe Name)
-lookupValueName s = runHandler2 mLookupName False s
+lookupValueName = runHandler2 mLookupName False
{-
Note [Name lookup]
@@ -850,7 +720,7 @@ has some discussion around this.
-}
reifyInstances :: Name -> [Type] -> Q [InstanceDec]
-reifyInstances cls tys = runHandler2 mReifyInstances cls tys
+reifyInstances = runHandler2 mReifyInstances
{- | @reifyRoles nm@ returns the list of roles associated with the parameters
(both visible and invisible) of
@@ -869,20 +739,20 @@ and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' i
the role of the invisible @k@ parameter. Kind parameters are always nominal.
-}
reifyRoles :: Name -> Q [Role]
-reifyRoles nm = runHandler1 mReifyRoles nm
+reifyRoles = runHandler1 mReifyRoles
-- | @reifyAnnotations target@ returns the list of annotations
-- associated with @target@. Only the annotations that are
-- appropriately typed is returned. So if you have @Int@ and @String@
-- annotations for the same target, you have to call this function twice.
reifyAnnotations :: Data a => AnnLookup -> Q [a]
-reifyAnnotations an = runHandler1 mReifyAnnotations an
+reifyAnnotations = runHandler1 mReifyAnnotations
-- | @reifyModule mod@ looks up information about module @mod@. To
-- look up the current module, call this function with the return
-- value of 'Language.Haskell.TH.Lib.thisModule'.
reifyModule :: Module -> Q ModuleInfo
-reifyModule m = runHandler1 mReifyModule m
+reifyModule = runHandler1 mReifyModule
-- | @reifyConStrictness nm@ looks up the strictness information for the fields
-- of the constructor with the name @nm@. Note that the strictness information
@@ -897,7 +767,7 @@ reifyModule m = runHandler1 mReifyModule m
-- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the
-- @-XStrictData@ language extension was enabled.
reifyConStrictness :: Name -> Q [DecidedStrictness]
-reifyConStrictness n = runHandler1 mReifyConStrictness n
+reifyConStrictness = runHandler1 mReifyConStrictness
-- | Is the list of instances returned by 'reifyInstances' nonempty?
--
@@ -951,7 +821,7 @@ getPackageRoot = runHandler mGetPackageRoot
-- * The state of the directory is read at the interface generation time,
-- not at the time of the function call.
addDependentDirectory :: FilePath -> Q ()
-addDependentDirectory dp = runHandler1 mAddDependentDirectory dp
+addDependentDirectory = runHandler1 mAddDependentDirectory
-- | Record external files that runIO is using (dependent upon).
-- The compiler can then recognize that it should re-compile the Haskell file
@@ -965,17 +835,17 @@ addDependentDirectory dp = runHandler1 mAddDependentDirectory dp
--
-- * The dependency is based on file content, not a modification time
addDependentFile :: FilePath -> Q ()
-addDependentFile fp = runHandler1 mAddDependentFile fp
+addDependentFile = runHandler1 mAddDependentFile
-- | Obtain a temporary file path with the given suffix. The compiler will
-- delete this file after compilation.
addTempFile :: String -> Q FilePath
-addTempFile suffix = runHandler1 mAddTempFile suffix
+addTempFile = runHandler1 mAddTempFile
-- | Add additional top-level declarations. The added declarations will be type
-- checked along with the current declaration group.
addTopDecls :: [Dec] -> Q ()
-addTopDecls ds = runHandler1 mAddTopDecls ds
+addTopDecls = runHandler1 mAddTopDecls
-- | Same as 'addForeignSource', but expects to receive a path pointing to the
-- foreign file instead of a 'String' of its contents. Consider using this in
@@ -984,7 +854,7 @@ addTopDecls ds = runHandler1 mAddTopDecls ds
-- This is a good alternative to 'addForeignSource' when you are trying to
-- directly link in an object file.
addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()
-addForeignFilePath lang fp = runHandler2 mAddForeignFilePath lang fp
+addForeignFilePath = runHandler2 mAddForeignFilePath
-- | Add a finalizer that will run in the Q monad after the current module has
-- been type checked. This only makes sense when run within a top-level splice.
@@ -993,7 +863,7 @@ addForeignFilePath lang fp = runHandler2 mAddForeignFilePath lang fp
-- 'reify' is able to find the local definitions when executed inside the
-- finalizer.
addModFinalizer :: Q () -> Q ()
-addModFinalizer act = runHandler1 mAddModFinalizer act
+addModFinalizer = runHandler1 mAddModFinalizer
-- | Adds a core plugin to the compilation pipeline.
--
@@ -1003,7 +873,7 @@ addModFinalizer act = runHandler1 mAddModFinalizer act
-- to tell the compiler that we needed to compile first a plugin module in the
-- current package.
addCorePlugin :: String -> Q ()
-addCorePlugin plugin = runHandler1 mAddCorePlugin plugin
+addCorePlugin = runHandler1 mAddCorePlugin
-- | Get state from the 'Q' monad. The state maintained by 'Q' is isomorphic to
-- a type-indexed finite map. That is,
@@ -1022,11 +892,11 @@ getQ = runHandler mGetQ
-- | Replace the state in the 'Q' monad. Note that the state is local to the
-- Haskell module in which the Template Haskell expression is executed.
putQ :: Typeable a => a -> Q ()
-putQ x = runHandler1 mPutQ x
+putQ = runHandler1 mPutQ
-- | Determine whether the given language extension is enabled in the 'Q' monad.
isExtEnabled :: Extension -> Q Bool
-isExtEnabled ext = runHandler1 mIsExtEnabled ext
+isExtEnabled = runHandler1 mIsExtEnabled
-- | List all enabled language extensions.
extsEnabled :: Q [Extension]
@@ -1049,49 +919,18 @@ extsEnabled = runHandler mExtsEnabled
-- Adding documentation to anything outside of the current module will cause an
-- error.
putDoc :: DocLoc -> String -> Q ()
-putDoc t s = runHandler2 mPutDoc t s
+putDoc = runHandler2 mPutDoc
-- | Retrieves the Haddock documentation at the specified location, if one
-- exists.
-- It can be used to read documentation on things defined outside of the current
-- module, provided that those modules were compiled with the @-haddock@ flag.
getDoc :: DocLoc -> Q (Maybe String)
-getDoc n = runHandler1 mGetDoc n
+getDoc = runHandler1 mGetDoc
instance MonadIO Q where
liftIO = runIO
-instance Quasi Q where
- qRunQ = id
- qNewName = newName
- qReport = report
- qRecover = recover
- qReify = reify
- qReifyFixity = reifyFixity
- qReifyType = reifyType
- qReifyInstances = reifyInstances
- qReifyRoles = reifyRoles
- qReifyAnnotations = reifyAnnotations
- qReifyModule = reifyModule
- qReifyConStrictness = reifyConStrictness
- qLookupName = lookupName
- qLocation = location
- qGetPackageRoot = getPackageRoot
- qAddDependentFile = addDependentFile
- qAddDependentDirectory = addDependentDirectory
- qAddTempFile = addTempFile
- qAddTopDecls = addTopDecls
- qAddForeignFilePath = addForeignFilePath
- qAddModFinalizer = addModFinalizer
- qAddCorePlugin = addCorePlugin
- qGetQ = getQ
- qPutQ = putQ
- qIsExtEnabled = isExtEnabled
- qExtsEnabled = extsEnabled
- qPutDoc = putDoc
- qGetDoc = getDoc
-
-
----------------------------------------------------
-- The following operations are used solely in GHC.HsToCore.Quote when
-- desugaring brackets. They are not necessary for the user, who can use
=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -504,3 +504,167 @@ pattern SpecialiseP nm ty inl phases = SpecialiseEP Nothing [] (SigE (VarE nm) t
unQ :: Q a -> (forall m. Quasi m => m a)
unQ m = runQ m
+
+-----------------------------------------------------
+--
+-- The Quasi class
+--
+-----------------------------------------------------
+
+class (MonadIO m, MonadFail m) => Quasi m where
+ qRunQ :: Q a -> m a
+ -- | Fresh names. See 'newName'.
+ qNewName :: String -> m Name
+
+ ------- Error reporting and recovery -------
+ -- | Report an error (True) or warning (False)
+ -- ...but carry on; use 'fail' to stop. See 'report'.
+ qReport :: Bool -> String -> m ()
+
+ -- | See 'recover'.
+ qRecover :: m a -- ^ the error handler
+ -> m a -- ^ action which may fail
+ -> m a -- ^ Recover from the monadic 'fail'
+
+ ------- Inspect the type-checker's environment -------
+ -- | True <=> type namespace, False <=> value namespace. See 'lookupName'.
+ qLookupName :: Bool -> String -> m (Maybe Name)
+ -- | See 'reify'.
+ qReify :: Name -> m Info
+ -- | See 'reifyFixity'.
+ qReifyFixity :: Name -> m (Maybe Fixity)
+ -- | See 'reifyType'.
+ qReifyType :: Name -> m Type
+ -- | Is (n tys) an instance? Returns list of matching instance Decs (with
+ -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'.
+ qReifyInstances :: Name -> [Type] -> m [Dec]
+ -- | See 'reifyRoles'.
+ qReifyRoles :: Name -> m [Role]
+ -- | See 'reifyAnnotations'.
+ qReifyAnnotations :: Data a => AnnLookup -> m [a]
+ -- | See 'reifyModule'.
+ qReifyModule :: Module -> m ModuleInfo
+ -- | See 'reifyConStrictness'.
+ qReifyConStrictness :: Name -> m [DecidedStrictness]
+
+ -- | See 'location'.
+ qLocation :: m Loc
+
+ -- | Input/output (dangerous). See 'runIO'.
+ qRunIO :: IO a -> m a
+ qRunIO = liftIO
+ -- | See 'getPackageRoot'.
+ qGetPackageRoot :: m FilePath
+
+ -- | See 'addDependentFile'.
+ qAddDependentFile :: FilePath -> m ()
+
+ -- | See 'addDependentDirectory'.
+ qAddDependentDirectory :: FilePath -> m ()
+
+ -- | See 'addTempFile'.
+ qAddTempFile :: String -> m FilePath
+
+ -- | See 'addTopDecls'.
+ qAddTopDecls :: [Dec] -> m ()
+
+ -- | See 'addForeignFilePath'.
+ qAddForeignFilePath :: ForeignSrcLang -> String -> m ()
+
+ -- | See 'addModFinalizer'.
+ qAddModFinalizer :: Q () -> m ()
+
+ -- | See 'addCorePlugin'.
+ qAddCorePlugin :: String -> m ()
+
+ -- | See 'getQ'.
+ qGetQ :: Typeable a => m (Maybe a)
+
+ -- | See 'putQ'.
+ qPutQ :: Typeable a => a -> m ()
+
+ -- | See 'isExtEnabled'.
+ qIsExtEnabled :: Extension -> m Bool
+ -- | See 'extsEnabled'.
+ qExtsEnabled :: m [Extension]
+
+ -- | See 'putDoc'.
+ qPutDoc :: DocLoc -> String -> m ()
+ -- | See 'getDoc'.
+ qGetDoc :: DocLoc -> m (Maybe String)
+
+-----------------------------------------------------
+-- The IO instance of Quasi
+-----------------------------------------------------
+
+-- | This instance is used only when running a Q
+-- computation in the IO monad, usually just to
+-- print the result. There is no interesting
+-- type environment, so reification isn't going to
+-- work.
+instance Quasi IO where
+ qRunQ (Q m) = m metaHandlersIO
+ qNewName = newNameIO
+
+ qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
+ qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
+
+ qLookupName _ _ = badIO "lookupName"
+ qReify _ = badIO "reify"
+ qReifyFixity _ = badIO "reifyFixity"
+ qReifyType _ = badIO "reifyFixity"
+ qReifyInstances _ _ = badIO "reifyInstances"
+ qReifyRoles _ = badIO "reifyRoles"
+ qReifyAnnotations _ = badIO "reifyAnnotations"
+ qReifyModule _ = badIO "reifyModule"
+ qReifyConStrictness _ = badIO "reifyConStrictness"
+ qLocation = badIO "currentLocation"
+ qRecover _ _ = badIO "recover" -- Maybe we could fix this?
+ qGetPackageRoot = badIO "getProjectRoot"
+ qAddDependentFile _ = badIO "addDependentFile"
+ qAddTempFile _ = badIO "addTempFile"
+ qAddTopDecls _ = badIO "addTopDecls"
+ qAddForeignFilePath _ _ = badIO "addForeignFilePath"
+ qAddModFinalizer _ = badIO "addModFinalizer"
+ qAddCorePlugin _ = badIO "addCorePlugin"
+ qGetQ = badIO "getQ"
+ qPutQ _ = badIO "putQ"
+ qIsExtEnabled _ = badIO "isExtEnabled"
+ qExtsEnabled = badIO "extsEnabled"
+ qPutDoc _ _ = badIO "putDoc"
+ qGetDoc _ = badIO "getDoc"
+ qAddDependentDirectory _ = badIO "AddDependentDirectory"
+
+badIO :: String -> IO a
+badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
+ ; fail "Template Haskell failure" }
+
+instance Quasi Q where
+ qRunQ = id
+ qNewName = newName
+ qReport = report
+ qRecover = recover
+ qReify = reify
+ qReifyFixity = reifyFixity
+ qReifyType = reifyType
+ qReifyInstances = reifyInstances
+ qReifyRoles = reifyRoles
+ qReifyAnnotations = reifyAnnotations
+ qReifyModule = reifyModule
+ qReifyConStrictness = reifyConStrictness
+ qLookupName = lookupName
+ qLocation = location
+ qGetPackageRoot = getPackageRoot
+ qAddDependentFile = addDependentFile
+ qAddDependentDirectory = addDependentDirectory
+ qAddTempFile = addTempFile
+ qAddTopDecls = addTopDecls
+ qAddForeignFilePath = addForeignFilePath
+ qAddModFinalizer = addModFinalizer
+ qAddCorePlugin = addCorePlugin
+ qGetQ = getQ
+ qPutQ = putQ
+ qIsExtEnabled = isExtEnabled
+ qExtsEnabled = extsEnabled
+ qPutDoc = putDoc
+ qGetDoc = getDoc
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/816917e10de7308c997be645e7ebbaa…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/816917e10de7308c997be645e7ebbaa…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/validate-fix-werror] 3 commits: ghc-internal: fix unused imports
by Cheng Shao (＠TerrorJack) 20 Mar '26
by Cheng Shao (＠TerrorJack) 20 Mar '26
20 Mar '26
Cheng Shao pushed to branch wip/validate-fix-werror at Glasgow Haskell Compiler / GHC
Commits:
e4b9a189 by Cheng Shao at 2026-03-21T00:31:34+01:00
ghc-internal: fix unused imports
This commit fixes unused imports in `ghc-internal` which should have
been caught by the `validate` flavour but was warnings in CI due to
the recent `+werror` regression. Fixes #26987 #27059.
- - - - -
6d1798de by Cheng Shao at 2026-03-21T00:31:40+01:00
compiler: fix unused imports in GHC.Tc.Types.Origin
This commit fixes unused imports in `GHC.Tc.Types.Origin` which should
have been caught by the `validate` flavour but was warnings in CI due
to the recent `+werror` regression. Fixes #27059.
- - - - -
c2130e19 by Cheng Shao at 2026-03-21T00:31:40+01:00
hadrian: fix missing +werror in validate flavour
This patch fixes missing `+werror` in validate flavour, which was an
oversight in bb3a2ba1eefadf0b2ef4f39b31337a23eec67f29. Fixes #27066.
- - - - -
16 changed files:
- compiler/GHC/Tc/Types/Origin.hs
- hadrian/src/Settings/Flavours/Validate.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/Int.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
Changes:
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -83,7 +83,6 @@ import qualified Data.Kind as Hs
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (isNothing)
import qualified Data.Semigroup as Semi
-import GHC.Generics
{- *********************************************************************
* *
=====================================
hadrian/src/Settings/Flavours/Validate.hs
=====================================
@@ -8,7 +8,7 @@ import {-# SOURCE #-} Settings.Default
-- Please update doc/flavours.md when changing this file.
validateFlavour :: Flavour
-validateFlavour = enableLinting $ quickValidateFlavour
+validateFlavour = enableLinting $ werror $ quickValidateFlavour
{ name = "validate"
, extraArgs = validateArgs <> defaultHaddockExtraArgs
, ghcDebugAssertions = (<= Stage1)
=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
=====================================
@@ -58,7 +58,7 @@ module GHC.Internal.Conc.IO
#endif
) where
-import GHC.Internal.Base (otherwise, pure, return, ($))
+import GHC.Internal.Base (otherwise, return, ($))
import GHC.Internal.Conc.Sync as Sync
import GHC.Internal.Err (errorWithoutStackTrace)
import GHC.Internal.STM as STM
@@ -82,6 +82,10 @@ import qualified GHC.Internal.Wasm.Prim.Conc as Wasm
import qualified GHC.Internal.Wasm.Prim.Flag as Wasm
#endif
+#if defined(javascript_HOST_ARCH)
+import GHC.Internal.Base (pure)
+#endif
+
ensureIOManagerIsRunning :: IO ()
#if defined(javascript_HOST_ARCH)
ensureIOManagerIsRunning = pure ()
=====================================
libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
=====================================
@@ -29,7 +29,7 @@ module GHC.Internal.Event.Control
#include <ghcplatform.h>
#include "EventConfig.h"
-import GHC.Internal.Base (fmap, otherwise, pure, return, when, ($), (.))
+import GHC.Internal.Base (fmap, otherwise, return, when, ($), (.))
import GHC.Internal.Classes (Eq(..), (&&))
import GHC.Internal.IORef
import GHC.Internal.Conc.Signal (Signal)
@@ -56,6 +56,10 @@ import GHC.Internal.Foreign.C.Types (CULLong(..))
import GHC.Internal.Foreign.C.Error (eAGAIN, eWOULDBLOCK, eBADF)
#endif
+#if defined(wasm32_HOST_ARCH)
+import GHC.Internal.Base (pure)
+#endif
+
data ControlMessage = CMsgWakeup
| CMsgDie
| CMsgSignal {-# UNPACK #-} !(ForeignPtr Word8)
=====================================
libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc
=====================================
@@ -33,7 +33,7 @@ import GHC.Internal.Data.Bits (Bits(..), FiniteBits(..))
import GHC.Internal.Err (errorWithoutStackTrace, undefined)
import GHC.Internal.Int
import GHC.Internal.Data.Maybe (Maybe(..), catMaybes)
-import GHC.Internal.Types (Bool(..), Int, IO)
+import GHC.Internal.Types (Bool(..), IO)
import GHC.Internal.Word (Word16, Word32)
import GHC.Internal.Foreign.C.Error (throwErrnoIfMinus1, eINTR, eINVAL,
eNOTSUP, getErrno, throwErrno)
=====================================
libraries/ghc-internal/src/GHC/Internal/Float.hs
=====================================
@@ -185,12 +185,12 @@ import GHC.Internal.Prim (
decodeFloat_Int#, divideFloat#, double2Float#, eqWord#, expDouble#,
expFloat#, expm1Double#, expm1Float#, fabsDouble#, fabsFloat#,
float2Double#, geFloat#, gtFloat#, gtWord#, int2Float#, int2Double#,
- int2Word#, int64ToInt#, leFloat#, log1pDouble#, log1pFloat#, logDouble#,
+ int2Word#, leFloat#, log1pDouble#, log1pFloat#, logDouble#,
logFloat#, ltFloat#, ltWord#, minusFloat#, minusWord#, negateDouble#,
negateFloat#, negateInt#, plusFloat#, powerFloat#, sinDouble#, sinFloat#,
sinhDouble#, sinhFloat#, sqrtDouble#, sqrtFloat#, tanDouble#, tanFloat#,
tanhDouble#, tanhFloat#, timesFloat#, uncheckedIShiftRA#, uncheckedShiftL#,
- word2Float#, word2Double#, word2Int#, word64ToWord#,
+ word2Float#, word2Double#, word2Int#,
(+#), (+##), (-#), (-##), (*##), (**##), (/##), (<#), (<##), (<=#), (<=##),
(>#), (>##), (>=#), (>=##),
)
@@ -206,6 +206,13 @@ import GHC.Internal.Float.RealFracMethods
import GHC.Internal.Float.ConversionUtils
import GHC.Internal.Bignum.BigNat
+#if WORD_SIZE_IN_BITS == 64
+import GHC.Internal.Prim (
+ int64ToInt#,
+ word64ToWord#,
+ )
+#endif
+
infixr 8 **
-- $setup
=====================================
libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
=====================================
@@ -66,7 +66,7 @@ import GHC.Internal.Classes (Ord(..))
import GHC.Internal.Num () -- instance Num Integer
-- (We could remove uses with a little effort)
import GHC.Internal.Prim (
- Int#, eqFloat#, decodeFloat_Int#, double2Int#, float2Int#, int2Float#,
+ eqFloat#, decodeFloat_Int#, double2Int#, float2Int#, int2Float#,
int2Double#, int2Word#, ltFloat#, minusFloat#, negateFloat#, negateDouble#,
negateInt#, uncheckedIShiftL#, uncheckedIShiftRA#, uncheckedIShiftRL#,
(+#), (-#), (<#), (>#), (-##), (==##), (<##),
@@ -86,6 +86,10 @@ import GHC.Internal.Prim (
#else
+import GHC.Internal.Prim (
+ Int#,
+ )
+
#define TO64 integerToInt#
#define FROM64 IS
#define MINUS64 ( -# )
@@ -355,4 +359,3 @@ foreign import ccall unsafe "rintDouble"
foreign import ccall unsafe "rintFloat"
c_rintFloat :: Float -> Float
-
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
=====================================
@@ -30,7 +30,7 @@ module GHC.Internal.IO.FD (
) where
import GHC.Internal.Base (
- String, fmap, id, otherwise, pure, return, when, ($), (.), (++), (>>=),
+ String, fmap, otherwise, pure, return, when, ($), (.), (++), (>>=),
)
import GHC.Internal.Bits
import GHC.Internal.Classes (Eq(..), Ord(..), not, (&&), (||))
@@ -58,6 +58,10 @@ import GHC.Internal.Err (error)
import GHC.Internal.Windows
import GHC.Internal.IO.SubSystem ((<!>))
import GHC.Internal.Foreign.Storable
+#else
+import GHC.Internal.Base (
+ id,
+ )
#endif
import GHC.Internal.Foreign.C.Types
=====================================
libraries/ghc-internal/src/GHC/Internal/Int.hs
=====================================
@@ -51,7 +51,7 @@ import GHC.Internal.Classes (
Eq(..), Ord(..),
eqInt, neInt, gtInt, geInt, ltInt, leInt,
divInt8#, divInt16#, divInt32#,
- divModInt8#, divModInt16#, divModInt32#, divModInt#,
+ divModInt8#, divModInt16#, divModInt32#,
modInt8#, modInt16#, modInt32#,
(&&), (||),
)
@@ -63,6 +63,12 @@ import GHC.Internal.Arr
import GHC.Internal.Show
import GHC.Internal.Types (Bool(..), Float, Double, Int(..), isTrue#)
+#if WORD_SIZE_IN_BITS == 64
+import GHC.Internal.Classes (
+ divModInt#,
+ )
+#endif
+
------------------------------------------------------------------------
-- type Int8
------------------------------------------------------------------------
=====================================
libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
=====================================
@@ -66,7 +66,7 @@ import GHC.Internal.Ptr
import GHC.Internal.Types (Bool(..), Double, Int)
import GHC.Internal.Word
import GHC.Internal.Base (
- String, otherwise, pure, return, (.), (++), (<*>), (=<<),
+ String, otherwise, return, (.), (++), (<*>), (=<<),
)
import GHC.Internal.Enum
import GHC.Internal.Generics (Generic)
@@ -74,6 +74,10 @@ import GHC.Internal.IO
import GHC.Internal.Real
import GHC.Internal.Show
+#if defined(javascript_HOST_ARCH)
+import GHC.Internal.Base (pure)
+#endif
+
-- | 'RtsTime' is defined as a @StgWord64@ in @stg/Types.h@
--
-- @since base-4.8.2.0
=====================================
libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
=====================================
@@ -8,16 +8,20 @@ module GHC.Internal.RTS.Flags.Test
)
where
-import GHC.Internal.Base (pure)
import GHC.Internal.Ptr
-import GHC.Internal.Foreign.C.Types
-import GHC.Internal.Foreign.Marshal.Utils
import GHC.Internal.Foreign.Storable
import GHC.Internal.Data.Functor ((<$>))
import GHC.Internal.Types (Bool(..), Int, IO)
import GHC.Internal.Word (Word32)
import GHC.Internal.Real (fromIntegral)
+#if defined(javascript_HOST_ARCH)
+import GHC.Internal.Base (pure)
+#else
+import GHC.Internal.Foreign.C.Types
+import GHC.Internal.Foreign.Marshal.Utils
+#endif
+
#include "Rts.h"
#include "rts/Flags.h"
=====================================
libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
=====================================
@@ -49,9 +49,13 @@ import GHC.Internal.Base (fmap)
import GHC.Internal.Classes (Ord(..))
import GHC.Internal.Control.Exception.Base (bracket)
import GHC.Internal.Err (undefined)
+#else
+import GHC.Internal.Base (
+ map, (++),
+ )
#endif
import GHC.Internal.Base (
- String, liftM, map, mapM, otherwise, return, ($), (.), (++), (>>=),
+ String, liftM, mapM, otherwise, return, ($), (.), (>>=),
)
import GHC.Internal.List (null, elem, takeWhile, break)
import GHC.Internal.Maybe (Maybe(..))
=====================================
libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
=====================================
@@ -43,7 +43,7 @@ import GHC.Internal.Classes (Eq(..))
import GHC.Internal.Data.Functor
import GHC.Internal.Data.List (elem, null, takeWhile)
import GHC.Internal.Foreign.C.String
-import GHC.Internal.Base (String, otherwise, return, ($))
+import GHC.Internal.Base (String, otherwise, ($))
#if defined(mingw32_HOST_OS)
import GHC.Internal.Base ((.))
import GHC.Internal.Foreign.Ptr
@@ -51,6 +51,7 @@ import GHC.Internal.Windows
import GHC.Internal.Control.Monad
import GHC.Internal.Data.List (lookup)
#else
+import GHC.Internal.Base (return)
import GHC.Internal.Foreign.C.Error
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Real (fromIntegral)
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO.hs
=====================================
@@ -249,6 +249,7 @@ import GHC.Internal.Base (String, failIO, otherwise, return, ($), (.), (>>=))
import GHC.Internal.List
#if !defined(mingw32_HOST_OS)
import GHC.Internal.IORef
+import GHC.Internal.Types (Int)
#endif
import GHC.Internal.Num
import GHC.Internal.IO hiding ( bracket, onException )
@@ -262,7 +263,7 @@ import GHC.Internal.IO.Encoding
import GHC.Internal.Text.Read
import GHC.Internal.IO.StdHandles
import GHC.Internal.Show
-import GHC.Internal.Types (Bool(..), Char, Int)
+import GHC.Internal.Types (Bool(..), Char)
-----------------------------------------------------------------------------
-- Standard IO
=====================================
libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
=====================================
@@ -46,19 +46,20 @@ import GHC.Internal.Data.Maybe
#if !defined(HTYPE_TCFLAG_T)
import GHC.Internal.System.IO.Error
+#if !defined(mingw32_HOST_OS)
+import GHC.Internal.Err (errorWithoutStackTrace)
+#endif
#endif
import GHC.Internal.Base (
String, otherwise, pure, return, when, ($), (++), (>>=),
)
import GHC.Internal.Bits
-import GHC.Internal.Classes (Eq(..), Ord(..), not, (&&), (||))
-import GHC.Internal.CString (cstringLength#)
-import GHC.Internal.Err (errorWithoutStackTrace)
+import GHC.Internal.Classes (Eq(..), not, (&&), (||))
import GHC.Internal.Num
import GHC.Internal.Prim (yield#)
import GHC.Internal.Real
-import GHC.Internal.Types (Bool(..), Int(..))
+import GHC.Internal.Types (Bool(..))
import GHC.Internal.Word
import GHC.Internal.IO
import GHC.Internal.IO.IOMode
@@ -71,10 +72,13 @@ import GHC.Internal.Int (Int64)
#endif
#if !defined(mingw32_HOST_OS)
+import GHC.Internal.CString (cstringLength#)
+import GHC.Internal.Classes (Ord(..))
import {-# SOURCE #-} GHC.Internal.IO.Encoding (getFileSystemEncoding)
import GHC.Internal.Foreign.Marshal.Utils
import GHC.Internal.Foreign.Storable
import qualified GHC.Internal.Foreign.C.String.Encoding as GHC
+import GHC.Internal.Types (Int(..))
#else
import GHC.Internal.Int
import GHC.Internal.Data.OldList (elem)
=====================================
libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
=====================================
@@ -39,12 +39,12 @@ module GHC.Internal.TopHandler (
import GHC.Internal.Control.Exception
import GHC.Internal.Data.Maybe
-import GHC.Internal.Classes (Eq(..), Ord(..), (&&))
+import GHC.Internal.Classes (Eq(..))
import GHC.Internal.Foreign.C.Error
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Foreign.C.String
import GHC.Internal.Base (
- String, const, failIO, otherwise, pure, return, ($), (++), (>>),
+ String, failIO, return, ($), (++), (>>),
)
import GHC.Internal.Conc.Sync hiding (throwTo)
import GHC.Internal.Prim (Weak#, seq)
@@ -67,6 +67,17 @@ import GHC.Internal.Conc.Signal
import GHC.Internal.Data.Dynamic (toDyn)
#endif
+#if !defined(HAVE_SIGNAL_H)
+import GHC.Internal.Base (pure)
+#endif
+
+#if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
+import GHC.Internal.Base (
+ const, otherwise,
+ )
+import GHC.Internal.Classes (Ord(..), (&&))
+#endif
+
-- Note [rts_setMainThread must be called unsafely]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- rts_setMainThread must be called as unsafe, because it
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d9d15deeb76375e87e3567f9b7437c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d9d15deeb76375e87e3567f9b7437c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
20 Mar '26
Cheng Shao deleted branch wip/hadrian-rts-quiet at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org.
1
0
20 Mar '26
Cheng Shao pushed new branch wip/fix-cabal-cache at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-cabal-cache
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/text-read-uncovering] 6 commits: Move most of the `System.IO` implementation into `base`
by Wolfgang Jeltsch (＠jeltsch) 20 Mar '26
by Wolfgang Jeltsch (＠jeltsch) 20 Mar '26
20 Mar '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/text-read-uncovering at Glasgow Haskell Compiler / GHC
Commits:
6d359508 by Wolfgang Jeltsch at 2026-03-21T00:09:34+02:00
Move most of the `System.IO` implementation into `base`
Metric Increase:
T12227
T12707
T5642
- - - - -
a03cd88a by Wolfgang Jeltsch at 2026-03-21T00:10:07+02:00
Move I/O-related `Read` instances into `base`
Metric Increase:
T12425
T13035
- - - - -
faf4c5f8 by Wolfgang Jeltsch at 2026-03-21T00:10:07+02:00
Move most of the `Numeric` implementation into `base`
The `showHex` operation and the `showIntAtBase` operation, which
underlies it, are kept in `GHC.Internal.Numeric`, because `showHex` is
used in a few places in `ghc-internal`; everything else is moved.
- - - - -
f8547ac7 by Wolfgang Jeltsch at 2026-03-21T00:10:07+02:00
Move the instance `Read ByteOrder` into `base`
- - - - -
7cf884ec by Wolfgang Jeltsch at 2026-03-21T00:10:08+02:00
Move the implementation of version parsing into `base`
- - - - -
98f7ebad by Wolfgang Jeltsch at 2026-03-21T00:10:08+02:00
Move the implementation of `readConstr` into `base`
- - - - -
42 changed files:
- libraries/base/src/Control/Concurrent.hs
- libraries/base/src/Data/Data.hs
- libraries/base/src/Data/Version.hs
- libraries/base/src/GHC/ByteOrder.hs
- libraries/base/src/GHC/IO/Handle.hs
- libraries/base/src/Numeric.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/Text/Printf.hs
- libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.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/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/plugins/plugins09.stdout
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/plugins/plugins11.stdout
- testsuite/tests/plugins/static-plugins.stdout
- testsuite/tests/typecheck/should_compile/T9497a.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T9497d.stderr
- testsuite/tests/typecheck/should_run/T9497a-run.stderr
- testsuite/tests/typecheck/should_run/T9497b-run.stderr
- testsuite/tests/typecheck/should_run/T9497c-run.stderr
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug973.html
- utils/haddock/html-test/ref/ConstructorPatternExport.html
- utils/haddock/html-test/ref/DefaultSignatures.html
- utils/haddock/html-test/ref/Hash.html
- utils/haddock/html-test/ref/PatternSyns.html
- utils/haddock/html-test/ref/PatternSyns2.html
- utils/haddock/html-test/ref/QuasiExpr.html
- utils/haddock/html-test/ref/Test.html
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7abb041f4dc36090509740612fdb59…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7abb041f4dc36090509740612fdb59…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/system-io-implementation-into-base] Move most of the `System.IO` implementation into `base`
by Wolfgang Jeltsch (＠jeltsch) 20 Mar '26
by Wolfgang Jeltsch (＠jeltsch) 20 Mar '26
20 Mar '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/system-io-implementation-into-base at Glasgow Haskell Compiler / GHC
Commits:
6d359508 by Wolfgang Jeltsch at 2026-03-21T00:09:34+02:00
Move most of the `System.IO` implementation into `base`
Metric Increase:
T12227
T12707
T5642
- - - - -
27 changed files:
- libraries/base/src/Control/Concurrent.hs
- libraries/base/src/GHC/IO/Handle.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/Text/Printf.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.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/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/typecheck/should_compile/T9497a.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T9497d.stderr
- testsuite/tests/typecheck/should_run/T9497a-run.stderr
- testsuite/tests/typecheck/should_run/T9497b-run.stderr
- testsuite/tests/typecheck/should_run/T9497c-run.stderr
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug973.html
- utils/haddock/html-test/ref/ConstructorPatternExport.html
- utils/haddock/html-test/ref/DefaultSignatures.html
- utils/haddock/html-test/ref/Hash.html
- utils/haddock/html-test/ref/PatternSyns.html
- utils/haddock/html-test/ref/PatternSyns2.html
- utils/haddock/html-test/ref/QuasiExpr.html
- utils/haddock/html-test/ref/Test.html
Changes:
=====================================
libraries/base/src/Control/Concurrent.hs
=====================================
@@ -120,7 +120,7 @@ import GHC.Internal.System.Posix.Types ( Fd )
#if defined(mingw32_HOST_OS)
import GHC.Internal.Foreign.C.Error
import GHC.Internal.Foreign.C.Types
-import GHC.Internal.System.IO
+import System.IO
import GHC.Internal.Data.Functor ( void )
import GHC.Internal.Int ( Int64 )
#else
=====================================
libraries/base/src/GHC/IO/Handle.hs
=====================================
@@ -53,6 +53,7 @@ module GHC.IO.Handle
hGetEcho,
hIsTerminalDevice,
hSetNewlineMode,
+ hGetNewlineMode,
Newline(..),
NewlineMode(..),
nativeNewline,
=====================================
libraries/base/src/Prelude.hs
=====================================
@@ -165,7 +165,7 @@ module Prelude (
) where
import GHC.Internal.Control.Monad
-import GHC.Internal.System.IO
+import System.IO
import GHC.Internal.System.IO.Error
import qualified GHC.Internal.Data.List as List
import GHC.Internal.Data.Either
=====================================
libraries/base/src/System/IO.hs
=====================================
@@ -1,4 +1,5 @@
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP #-}
-- |
--
@@ -184,8 +185,672 @@ module System.IO
nativeNewlineMode
) where
-import GHC.Internal.System.IO
+import GHC.Internal.System.IO (putStrLn, print)
+
+import GHC.Base (Bool (False, True), otherwise, failIO)
+import GHC.Err (errorWithoutStackTrace)
+import GHC.List (null, elem, last, (++), reverse, break)
+import GHC.Num ((+))
+import GHC.IO (IO, FilePath)
+import GHC.IO.IOMode (IOMode (ReadMode, WriteMode, ReadWriteMode, AppendMode))
+import qualified GHC.Internal.IO.FD as FD
+import GHC.IO.Encoding
+ (
+ TextEncoding,
+ mkTextEncoding,
+ getLocaleEncoding,
+ initLocaleEncoding,
+ utf8,
+ utf8_bom,
+ utf16,
+ utf16be,
+ utf16le,
+ utf32,
+ utf32be,
+ utf32le,
+ latin1,
+ char8
+ )
+import GHC.IO.Handle
+ (
+ Handle,
+ hLookAhead,
+ hFlush,
+ hClose,
+ hSetBinaryMode,
+ hSetEncoding,
+ hSetNewlineMode,
+ hSetEcho,
+ hSetFileSize,
+ hGetEncoding,
+ hGetNewlineMode,
+ hGetEcho,
+ hFileSize,
+ hIsOpen,
+ hIsReadable,
+ hIsSeekable,
+ hIsWritable,
+ hIsTerminalDevice,
+ hIsEOF,
+ hIsClosed,
+ hShow,
+ BufferMode (NoBuffering, LineBuffering, BlockBuffering),
+ hSetBuffering,
+ hGetBuffering,
+ HandlePosn,
+ hSetPosn,
+ hGetPosn,
+ SeekMode (AbsoluteSeek, RelativeSeek, SeekFromEnd),
+ hSeek,
+ hTell,
+ Newline (LF, CRLF),
+ nativeNewline,
+ NewlineMode (NewlineMode, inputNL, outputNL),
+ noNewlineTranslation,
+ nativeNewlineMode,
+ universalNewlineMode,
+ isEOF
+ )
+import GHC.IO.Handle.Text
+ (
+ hPutChar,
+ hPutStr,
+ hPutStrLn,
+ hPutBuf,
+ hPutBufNonBlocking,
+ hGetChar,
+ hGetContents,
+ hGetContents',
+ hGetLine,
+ hGetBuf,
+ hGetBufNonBlocking,
+ hGetBufSome,
+ hWaitForInput
+ )
+import qualified GHC.Internal.IO.Handle.FD as POSIX
+import GHC.IO.StdHandles
+ (
+ openBinaryFile,
+ withBinaryFile,
+ openFile,
+ withFile,
+ stdin,
+ stdout,
+ stderr
+ )
+import GHC.IORef (atomicModifyIORef'_)
import GHC.Internal.Control.Monad.Fix (fixIO)
+import Control.Monad (return, (>>=))
+import Control.Exception (ioError)
+import Data.Eq ((==))
+import Data.Ord ((<))
+import Data.Bits ((.|.))
+import Data.Function (($), (.))
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.Char (Char)
+import Data.String (String)
+import Data.Int (Int)
+import Data.IORef (IORef, newIORef)
+import System.IO.Error (userError)
+import System.IO.Unsafe (unsafePerformIO)
+import System.Posix.Internals
+ (
+ c_getpid,
+ c_open,
+ o_CREAT,
+ o_EXCL,
+ o_BINARY,
+ o_NONBLOCK,
+ o_RDWR,
+ o_NOCTTY,
+ withFilePath
+ )
+import System.Posix.Types (CMode)
+import Text.Read (lex, Read, reads)
+import Text.Show (Show, show)
+import Foreign.C.Types (CInt)
+import Foreign.C.Error (Errno, eEXIST, getErrno, errnoToIOError)
+
+#if defined(mingw32_HOST_OS)
+import GHC.Base (undefined, not, (||), fmap)
+import GHC.List (any)
+import GHC.Num ((*))
+import GHC.IO (onException)
+import GHC.IO.SubSystem
+import GHC.IO.Windows.Handle (openFileAsTemp)
+import GHC.IO.Handle.Windows (mkHandleFromHANDLE)
+import GHC.IO.Device as IODevice
+import GHC.Internal.Real (fromIntegral)
+import Data.Bits ((.&.))
+import Foreign.C.Types (CUInt (CUInt), CWchar)
+import Foreign.C.String
+import Foreign.Ptr
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils (with)
+import Foreign.Storable
+#endif
+
+-----------------------------------------------------------------------------
+-- Standard IO
+
+-- | Write a character to the standard output device
+--
+-- 'putChar' is implemented as @'hPutChar' 'stdout'@.
+--
+-- This operation may fail with the same errors as 'hPutChar'.
+--
+-- ==== __Examples__
+--
+-- Note that the following do not put a newline.
+--
+-- >>> putChar 'x'
+-- x
+--
+-- >>> putChar '\0042'
+-- *
+putChar :: Char -> IO ()
+putChar c = hPutChar stdout c
+
+-- | Write a string to the standard output device
+--
+-- 'putStr' is implemented as @'hPutStr' 'stdout'@.
+--
+-- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
+--
+-- ==== __Examples__
+--
+-- Note that the following do not put a newline.
+--
+-- >>> putStr "Hello, World!"
+-- Hello, World!
+--
+-- >>> putStr "\0052\0042\0050"
+-- 4*2
+--
+putStr :: String -> IO ()
+putStr s = hPutStr stdout s
+
+-- | Read a single character from the standard input device.
+--
+-- 'getChar' is implemented as @'hGetChar' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetChar'.
+--
+-- ==== __Examples__
+--
+-- >>> getChar
+-- a'a'
+--
+-- >>> getChar
+-- >
+-- '\n'
+getChar :: IO Char
+getChar = hGetChar stdin
+
+-- | Read a line from the standard input device.
+--
+-- 'getLine' is implemented as @'hGetLine' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetLine'.
+--
+-- ==== __Examples__
+--
+-- >>> getLine
+-- > Hello World!
+-- "Hello World!"
+--
+-- >>> getLine
+-- >
+-- ""
+getLine :: IO String
+getLine = hGetLine stdin
+
+-- | The 'getContents' operation returns all user input as a single string,
+-- which is read lazily as it is needed.
+--
+-- 'getContents' is implemented as @'hGetContents' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetContents'.
+--
+-- ==== __Examples__
+--
+-- >>> getContents >>= putStr
+-- > aaabbbccc :D
+-- aaabbbccc :D
+-- > I hope you have a great day
+-- I hope you have a great day
+-- > ^D
+--
+-- >>> getContents >>= print . length
+-- > abc
+-- > <3
+-- > def ^D
+-- 11
+getContents :: IO String
+getContents = hGetContents stdin
+
+-- | The 'getContents'' operation returns all user input as a single string,
+-- which is fully read before being returned
+--
+-- 'getContents'' is implemented as @'hGetContents'' 'stdin'@.
+--
+-- This operation may fail with the same errors as 'hGetContents''.
+--
+-- ==== __Examples__
+--
+-- >>> getContents' >>= putStr
+-- > aaabbbccc :D
+-- > I hope you have a great day
+-- aaabbbccc :D
+-- I hope you have a great day
+--
+-- >>> getContents' >>= print . length
+-- > abc
+-- > <3
+-- > def ^D
+-- 11
+--
+-- @since base-4.15.0.0
+getContents' :: IO String
+getContents' = hGetContents' stdin
+
+-- | @'interact' f@ takes the entire input from 'stdin' and applies @f@ to it.
+-- The resulting string is written to the 'stdout' device.
+--
+-- Note that this operation is lazy, which allows to produce output
+-- even before all input has been consumed.
+--
+-- This operation may fail with the same errors as 'getContents' and 'putStr'.
+--
+-- If it doesn't produce output the buffering settings may not be
+-- correct, use ^D (ctrl+D) to close stdin which forces
+-- the buffer to be consumed.
+--
+-- You may wish to set the buffering style appropriate to your program's
+-- needs before using this function, for example:
+--
+-- @
+-- main :: IO ()
+-- main = do
+-- hSetBuffering stdin LineBuffering
+-- hSetBuffering stdout NoBuffering
+-- interact (concatMap (\str -> str ++ str) . L.lines)
+-- @
+--
+-- ==== __Examples__
+--
+-- >>> interact (\str -> str ++ str)
+-- > hi :)
+-- hi :)
+-- > ^D
+-- hi :)
+--
+-- >>> interact (const ":D")
+-- :D
+--
+-- >>> interact (show . words)
+-- > hello world!
+-- > I hope you have a great day
+-- > ^D
+-- ["hello","world!","I","hope","you","have","a","great","day"]
+interact :: (String -> String) -> IO ()
+interact f = do s <- getContents
+ putStr (f s)
+
+-- | The 'readFile' function reads a file and
+-- returns the contents of the file as a string.
+--
+-- The file is read lazily, on demand, as with 'getContents'.
+--
+-- This operation may fail with the same errors as 'hGetContents' and 'openFile'.
+--
+-- ==== __Examples__
+--
+-- >>> readFile "~/hello_world"
+-- "Greetings!"
+--
+-- >>> take 5 <$> readFile "/dev/zero"
+-- "\NUL\NUL\NUL\NUL\NUL"
+readFile :: FilePath -> IO String
+readFile name = openFile name ReadMode >>= hGetContents
+
+-- | The 'readFile'' function reads a file and
+-- returns the contents of the file as a string.
+--
+-- This is identical to 'readFile', but the file is fully read before being returned,
+-- as with 'getContents''.
+--
+-- @since base-4.15.0.0
+readFile' :: FilePath -> IO String
+-- There's a bit of overkill here—both withFile and
+-- hGetContents' will close the file in the end.
+readFile' name = withFile name ReadMode hGetContents'
+
+-- | The computation @'writeFile' file str@ function writes the string @str@,
+-- to the file @file@.
+--
+-- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
+--
+-- ==== __Examples__
+--
+-- >>> writeFile "hello" "world" >> readFile "hello"
+-- "world"
+--
+-- >>> writeFile "~/" "D:"
+-- *** Exception: ~/: withFile: inappropriate type (Is a directory)
+writeFile :: FilePath -> String -> IO ()
+writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt)
+
+-- | The computation @'appendFile' file str@ function appends the string @str@,
+-- to the file @file@.
+--
+-- Note that 'writeFile' and 'appendFile' write a literal string
+-- to a file. To write a value of any printable type, as with 'print',
+-- use the 'show' function to convert the value to a string first.
+--
+-- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
+--
+-- ==== __Examples__
+--
+-- The following example could be more efficently written by acquiring a handle
+-- instead with 'openFile' and using the computations capable of writing to handles
+-- such as 'hPutStr'.
+--
+-- >>> let fn = "hello_world"
+-- >>> in writeFile fn "hello" >> appendFile fn " world!" >> (readFile fn >>= putStrLn)
+-- "hello world!"
+--
+-- >>> let fn = "foo"; output = readFile' fn >>= putStrLn
+-- >>> in output >> appendFile fn (show [1,2,3]) >> output
+-- this is what's in the file
+-- this is what's in the file[1,2,3]
+appendFile :: FilePath -> String -> IO ()
+appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt)
+
+-- | The 'readLn' function combines 'getLine' and 'readIO'.
+--
+-- This operation may fail with the same errors as 'getLine' and 'readIO'.
+--
+-- ==== __Examples__
+--
+-- >>> fmap (+ 5) readLn
+-- > 25
+-- 30
+--
+-- >>> readLn :: IO String
+-- > this is not a string literal
+-- *** Exception: user error (Prelude.readIO: no parse)
+readLn :: Read a => IO a
+readLn = getLine >>= readIO
+
+-- | The 'readIO' function is similar to 'read' except that it signals
+-- parse failure to the 'IO' monad instead of terminating the program.
+--
+-- This operation may fail with:
+--
+-- * 'GHC.Internal.System.IO.Error.isUserError' if there is no unambiguous parse.
+--
+-- ==== __Examples__
+--
+-- >>> fmap (+ 1) (readIO "1")
+-- 2
+--
+-- >>> readIO "not quite ()" :: IO ()
+-- *** Exception: user error (Prelude.readIO: no parse)
+readIO :: Read a => String -> IO a
+readIO s = case (do { (x,t) <- reads s ;
+ ("","") <- lex t ;
+ return x }) of
+ [x] -> return x
+ [] -> ioError (userError "Prelude.readIO: no parse")
+ _ -> ioError (userError "Prelude.readIO: ambiguous parse")
+
+-- | The encoding of the current locale.
+--
+-- This is the initial locale encoding: if it has been subsequently changed by
+-- 'GHC.Internal.IO.Encoding.setLocaleEncoding' this value will not reflect that change.
+localeEncoding :: TextEncoding
+localeEncoding = initLocaleEncoding
+
+-- | Computation 'hReady' @hdl@ indicates whether at least one item is
+-- available for input from handle @hdl@.
+--
+-- This operation may fail with:
+--
+-- * 'GHC.Internal.System.IO.Error.isEOFError' if the end of file has been reached.
+hReady :: Handle -> IO Bool
+hReady h = hWaitForInput h 0
+
+-- | Computation 'hPrint' @hdl t@ writes the string representation of @t@
+-- given by the 'show' function to the file or channel managed by @hdl@
+-- and appends a newline.
+--
+-- This operation may fail with the same errors as 'hPutStrLn'
+--
+-- ==== __Examples__
+--
+-- >>> hPrint stdout [1,2,3]
+-- [1,2,3]
+--
+-- >>> hPrint stdin [4,5,6]
+-- *** Exception: <stdin>: hPutStr: illegal operation (handle is not open for writing)
+hPrint :: Show a => Handle -> a -> IO ()
+hPrint hdl = hPutStrLn hdl . show
+
+-- | The function creates a temporary file in ReadWrite mode.
+-- The created file isn\'t deleted automatically, so you need to delete it manually.
+--
+-- The file is created with permissions such that only the current
+-- user can read\/write it.
+--
+-- With some exceptions (see below), the file will be created securely
+-- in the sense that an attacker should not be able to cause
+-- openTempFile to overwrite another file on the filesystem using your
+-- credentials, by putting symbolic links (on Unix) in the place where
+-- the temporary file is to be created. On Unix the @O_CREAT@ and
+-- @O_EXCL@ flags are used to prevent this attack, but note that
+-- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you
+-- rely on this behaviour it is best to use local filesystems only.
+openTempFile :: FilePath -- ^ Directory in which to create the file
+ -> String -- ^ File name template. If the template is \"foo.ext\" then
+ -- the created file will be \"fooXXX.ext\" where XXX is some
+ -- random number. Note that this should not contain any path
+ -- separator characters. On Windows, the template prefix may
+ -- be truncated to 3 chars, e.g. \"foobar.ext\" will be
+ -- \"fooXXX.ext\".
+ -> IO (FilePath, Handle)
+openTempFile tmp_dir template
+ = openTempFile' "openTempFile" tmp_dir template False 0o600
+
+-- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
+openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
+openBinaryTempFile tmp_dir template
+ = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600
+
+-- | Like 'openTempFile', but uses the default file permissions
+openTempFileWithDefaultPermissions :: FilePath -> String
+ -> IO (FilePath, Handle)
+openTempFileWithDefaultPermissions tmp_dir template
+ = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666
+
+-- | Like 'openBinaryTempFile', but uses the default file permissions
+openBinaryTempFileWithDefaultPermissions :: FilePath -> String
+ -> IO (FilePath, Handle)
+openBinaryTempFileWithDefaultPermissions tmp_dir template
+ = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666
+
+openTempFile' :: String -> FilePath -> String -> Bool -> CMode
+ -> IO (FilePath, Handle)
+openTempFile' loc tmp_dir template binary mode
+ | pathSeparator template
+ = failIO $ "openTempFile': Template string must not contain path separator characters: "++template
+ | otherwise = findTempName
+ where
+ -- We split off the last extension, so we can use .foo.ext files
+ -- for temporary files (hidden on Unix OSes). Unfortunately we're
+ -- below filepath in the hierarchy here.
+ (prefix, suffix) =
+ case break (== '.') $ reverse template of
+ -- First case: template contains no '.'s. Just re-reverse it.
+ (rev_suffix, "") -> (reverse rev_suffix, "")
+ -- Second case: template contains at least one '.'. Strip the
+ -- dot from the prefix and prepend it to the suffix (if we don't
+ -- do this, the unique number will get added after the '.' and
+ -- thus be part of the extension, which is wrong.)
+ (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)
+ -- Otherwise, something is wrong, because (break (== '.')) should
+ -- always return a pair with either the empty string or a string
+ -- beginning with '.' as the second component.
+ _ -> errorWithoutStackTrace "bug in GHC.Internal.System.IO.openTempFile"
+#if defined(mingw32_HOST_OS)
+ findTempName = findTempNamePosix <!> findTempNameWinIO
+
+ findTempNameWinIO = do
+ let label = if null prefix then "ghc" else prefix
+ withCWString tmp_dir $ \c_tmp_dir ->
+ withCWString label $ \c_template ->
+ withCWString suffix $ \c_suffix ->
+ with nullPtr $ \c_ptr -> do
+ res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr
+ if not res
+ then do errno <- getErrno
+ ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ else do c_p <- peek c_ptr
+ filename <- peekCWString c_p
+ free c_p
+ let flags = fromIntegral mode .&. o_EXCL
+ handleResultsWinIO filename (flags == o_EXCL)
+
+ findTempNamePosix = do
+ let label = if null prefix then "ghc" else prefix
+ withCWString tmp_dir $ \c_tmp_dir ->
+ withCWString label $ \c_template ->
+ withCWString suffix $ \c_suffix ->
+ allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do
+ res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0
+ c_str
+ if not res
+ then do errno <- getErrno
+ ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ else do filename <- peekCWString c_str
+ handleResultsPosix filename
+
+ handleResultsPosix filename = do
+ let oflags1 = rw_flags .|. o_EXCL
+ binary_flags
+ | binary = o_BINARY
+ | otherwise = 0
+ oflags = oflags1 .|. binary_flags
+ fd <- withFilePath filename $ \ f -> c_open f oflags mode
+ case fd < 0 of
+ True -> do errno <- getErrno
+ ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ False ->
+ do (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
+ False{-is_socket-}
+ True{-is_nonblock-}
+
+ enc <- getLocaleEncoding
+ h <- POSIX.mkHandleFromFD fD fd_type filename ReadWriteMode
+ False{-set non-block-} (Just enc)
+
+ return (filename, h)
+
+ handleResultsWinIO filename excl = do
+ (hwnd, hwnd_type) <- openFileAsTemp filename True excl
+ mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding
+
+ -- then use it to make a Handle
+ h <- mkHandleFromHANDLE hwnd hwnd_type filename ReadWriteMode mb_codec
+ `onException` IODevice.close hwnd
+ return (filename, h)
+
+foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo
+ :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool
+
+foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo
+ :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool
+
+pathSeparator :: String -> Bool
+pathSeparator template = any (\x-> x == '/' || x == '\\') template
+
+output_flags = std_flags
+#else /* else mingw32_HOST_OS */
+ findTempName = do
+ rs <- rand_string
+ let filename = prefix ++ rs ++ suffix
+ filepath = tmp_dir `combine` filename
+ r <- openNewFile filepath binary mode
+ case r of
+ FileExists -> findTempName
+ OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+ NewFileCreated fd -> do
+ (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
+ False{-is_socket-}
+ True{-is_nonblock-}
+
+ enc <- getLocaleEncoding
+ h <- POSIX.mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
+
+ return (filepath, h)
+
+ where
+ -- XXX bits copied from System.FilePath, since that's not available here
+ combine a b
+ | null b = a
+ | null a = b
+ | pathSeparator [last a] = a ++ b
+ | otherwise = a ++ [pathSeparatorChar] ++ b
+
+tempCounter :: IORef Int
+tempCounter = unsafePerformIO $ newIORef 0
+{-# NOINLINE tempCounter #-}
+
+-- build large digit-alike number
+rand_string :: IO String
+rand_string = do
+ r1 <- c_getpid
+ (r2, _) <- atomicModifyIORef'_ tempCounter (+1)
+ return $ show r1 ++ "-" ++ show r2
+
+data OpenNewFileResult
+ = NewFileCreated CInt
+ | FileExists
+ | OpenNewError Errno
+
+openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
+openNewFile filepath binary mode = do
+ let oflags1 = rw_flags .|. o_EXCL
+
+ binary_flags
+ | binary = o_BINARY
+ | otherwise = 0
+
+ oflags = oflags1 .|. binary_flags
+ fd <- withFilePath filepath $ \ f ->
+ c_open f oflags mode
+ if fd < 0
+ then do
+ errno <- getErrno
+ case errno of
+ _ | errno == eEXIST -> return FileExists
+ _ -> return (OpenNewError errno)
+ else return (NewFileCreated fd)
+
+-- XXX Should use filepath library
+pathSeparatorChar :: Char
+pathSeparatorChar = '/'
+
+pathSeparator :: String -> Bool
+pathSeparator template = pathSeparatorChar `elem` template
+
+output_flags = std_flags .|. o_CREAT
+#endif /* mingw32_HOST_OS */
+
+-- XXX Copied from GHC.Handle
+std_flags, output_flags, rw_flags :: CInt
+std_flags = o_NONBLOCK .|. o_NOCTTY
+rw_flags = output_flags .|. o_RDWR
-- $locking
-- Implementations should enforce as far as possible, at least locally to the
=====================================
libraries/base/src/Text/Printf.hs
=====================================
@@ -99,7 +99,7 @@ import GHC.Internal.Data.List (stripPrefix)
import GHC.Internal.Word
import GHC.Internal.Numeric
import GHC.Internal.Numeric.Natural
-import GHC.Internal.System.IO
+import System.IO
-- $setup
-- >>> import Prelude
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO.hs
=====================================
@@ -1,6 +1,4 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}
-{-# OPTIONS_GHC -Wno-x-partial #-}
-----------------------------------------------------------------------------
-- |
@@ -16,292 +14,13 @@
--
-----------------------------------------------------------------------------
-module GHC.Internal.System.IO (
- -- * The IO monad
+module GHC.Internal.System.IO (putStrLn, print) where
- IO,
-
- -- * Files and handles
-
- FilePath,
-
- Handle, -- abstract, instance of: Eq, Show.
-
- -- | GHC note: a 'Handle' will be automatically closed when the garbage
- -- collector detects that it has become unreferenced by the program.
- -- However, relying on this behaviour is not generally recommended:
- -- the garbage collector is unpredictable. If possible, use
- -- an explicit 'hClose' to close 'Handle's when they are no longer
- -- required. GHC does not currently attempt to free up file
- -- descriptors when they have run out, it is your responsibility to
- -- ensure that this doesn't happen.
-
- -- ** Standard handles
-
- -- | Three handles are allocated during program initialisation,
- -- and are initially open.
-
- stdin, stdout, stderr,
-
- -- * Opening and closing files
-
- -- ** Opening files
-
- withFile,
- openFile,
- IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
-
- -- ** Closing files
-
- hClose,
-
- -- ** Special cases
-
- -- | These functions are also exported by the "Prelude".
-
- readFile,
- readFile',
- writeFile,
- appendFile,
-
- -- * Operations on handles
-
- -- ** Determining and changing the size of a file
-
- hFileSize,
- hSetFileSize,
-
- -- ** Detecting the end of input
-
- hIsEOF,
- isEOF,
-
- -- ** Buffering operations
-
- BufferMode(NoBuffering,LineBuffering,BlockBuffering),
- hSetBuffering,
- hGetBuffering,
- hFlush,
-
- -- ** Repositioning handles
-
- hGetPosn,
- hSetPosn,
- HandlePosn, -- abstract, instance of: Eq, Show.
-
- hSeek,
- SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
- hTell,
-
- -- ** Handle properties
-
- hIsOpen, hIsClosed,
- hIsReadable, hIsWritable,
- hIsSeekable,
-
- -- ** Terminal operations (not portable: GHC only)
-
- hIsTerminalDevice,
-
- hSetEcho,
- hGetEcho,
-
- -- ** Showing handle state (not portable: GHC only)
-
- hShow,
-
- -- * Text input and output
-
- -- ** Text input
-
- hWaitForInput,
- hReady,
- hGetChar,
- hGetLine,
- hLookAhead,
- hGetContents,
- hGetContents',
-
- -- ** Text output
-
- hPutChar,
- hPutStr,
- hPutStrLn,
- hPrint,
-
- -- ** Special cases for standard input and output
-
- -- | These functions are also exported by the "Prelude".
-
- interact,
- putChar,
- putStr,
- putStrLn,
- print,
- getChar,
- getLine,
- getContents,
- getContents',
- readIO,
- readLn,
-
- -- * Binary input and output
-
- withBinaryFile,
- openBinaryFile,
- hSetBinaryMode,
- hPutBuf,
- hGetBuf,
- hGetBufSome,
- hPutBufNonBlocking,
- hGetBufNonBlocking,
-
- -- * Temporary files
-
- openTempFile,
- openBinaryTempFile,
- openTempFileWithDefaultPermissions,
- openBinaryTempFileWithDefaultPermissions,
-
- -- * Unicode encoding\/decoding
-
- -- | A text-mode 'Handle' has an associated 'TextEncoding', which
- -- is used to decode bytes into Unicode characters when reading,
- -- and encode Unicode characters into bytes when writing.
- --
- -- The default 'TextEncoding' is the same as the default encoding
- -- on your system, which is also available as 'localeEncoding'.
- -- (GHC note: on Windows, we currently do not support double-byte
- -- encodings; if the console\'s code page is unsupported, then
- -- 'localeEncoding' will be 'latin1'.)
- --
- -- Encoding and decoding errors are always detected and reported,
- -- except during lazy I/O ('hGetContents', 'getContents', and
- -- 'readFile'), where a decoding error merely results in
- -- termination of the character stream, as with other I/O errors.
-
- hSetEncoding,
- hGetEncoding,
-
- -- ** Unicode encodings
- TextEncoding,
- latin1,
- utf8, utf8_bom,
- utf16, utf16le, utf16be,
- utf32, utf32le, utf32be,
- localeEncoding,
- char8,
- mkTextEncoding,
-
- -- * Newline conversion
-
- -- | In Haskell, a newline is always represented by the character
- -- @\'\\n\'@. However, in files and external character streams, a
- -- newline may be represented by another character sequence, such
- -- as @\'\\r\\n\'@.
- --
- -- A text-mode 'Handle' has an associated 'NewlineMode' that
- -- specifies how to translate newline characters. The
- -- 'NewlineMode' specifies the input and output translation
- -- separately, so that for instance you can translate @\'\\r\\n\'@
- -- to @\'\\n\'@ on input, but leave newlines as @\'\\n\'@ on output.
- --
- -- The default 'NewlineMode' for a 'Handle' is
- -- 'nativeNewlineMode', which does no translation on Unix systems,
- -- but translates @\'\\r\\n\'@ to @\'\\n\'@ and back on Windows.
- --
- -- Binary-mode 'Handle's do no newline translation at all.
- --
- hSetNewlineMode,
- hGetNewlineMode,
- Newline(..), nativeNewline,
- NewlineMode(..),
- noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
- ) where
-
-import GHC.Internal.Control.Exception.Base
-
-import GHC.Internal.Classes (Eq(..), Ord(..))
-import GHC.Internal.Data.Bits
-import GHC.Internal.Data.Maybe
-import GHC.Internal.Err (errorWithoutStackTrace)
-import GHC.Internal.Foreign.C.Error
-#if defined(mingw32_HOST_OS)
-import GHC.Internal.Base (fmap)
-import GHC.Internal.Classes (not, (||))
-import GHC.Internal.Err (undefined)
-import GHC.Internal.Foreign.C.String
-import GHC.Internal.Foreign.Ptr
-import GHC.Internal.Foreign.Marshal.Alloc
-import GHC.Internal.Foreign.Marshal.Utils (with)
-import GHC.Internal.Foreign.Storable
-import GHC.Internal.IO.SubSystem
-import GHC.Internal.IO.Windows.Handle (openFileAsTemp)
-import GHC.Internal.IO.Handle.Windows (mkHandleFromHANDLE)
-import GHC.Internal.IO.Device as IODevice
-import GHC.Internal.Real (fromIntegral)
-#endif
-import GHC.Internal.Foreign.C.Types
-import GHC.Internal.System.Posix.Internals
-import GHC.Internal.System.Posix.Types
-
-import GHC.Internal.Base (String, failIO, otherwise, return, ($), (.), (>>=))
-import GHC.Internal.List
-#if !defined(mingw32_HOST_OS)
-import GHC.Internal.IORef
-#endif
-import GHC.Internal.Num
-import GHC.Internal.IO hiding ( bracket, onException )
-import GHC.Internal.IO.IOMode
-import qualified GHC.Internal.IO.FD as FD
-import GHC.Internal.IO.Handle
-import qualified GHC.Internal.IO.Handle.FD as POSIX
-import GHC.Internal.IO.Handle.Text ( hGetBufSome, hPutStrLn )
-import GHC.Internal.IO.Exception ( userError )
-import GHC.Internal.IO.Encoding
-import GHC.Internal.Text.Read
-import GHC.Internal.IO.StdHandles
-import GHC.Internal.Show
-import GHC.Internal.Types (Bool(..), Char, Int)
------------------------------------------------------------------------------
--- Standard IO
-
--- | Write a character to the standard output device
---
--- 'putChar' is implemented as @'hPutChar' 'stdout'@.
---
--- This operation may fail with the same errors as 'hPutChar'.
---
--- ==== __Examples__
---
--- Note that the following do not put a newline.
---
--- >>> putChar 'x'
--- x
---
--- >>> putChar '\0042'
--- *
-putChar :: Char -> IO ()
-putChar c = hPutChar stdout c
-
--- | Write a string to the standard output device
---
--- 'putStr' is implemented as @'hPutStr' 'stdout'@.
---
--- This operation may fail with the same errors, and has the same issues with concurrency, as 'hPutStr'!
---
--- ==== __Examples__
---
--- Note that the following do not put a newline.
---
--- >>> putStr "Hello, World!"
--- Hello, World!
---
--- >>> putStr "\0052\0042\0050"
--- 4*2
---
-putStr :: String -> IO ()
-putStr s = hPutStr stdout s
+import GHC.Internal.Base (String)
+import GHC.Internal.IO (IO)
+import GHC.Internal.IO.Handle.Text (hPutStrLn)
+import GHC.Internal.IO.StdHandles (stdout)
+import GHC.Internal.Show (Show, show)
-- | The same as 'putStr', but adds a newline character.
--
@@ -338,485 +57,3 @@ putStrLn s = hPutStrLn stdout s
-- [(0,1),(1,2),(2,4),(3,8),(4,16),(5,32),(6,64),(7,128),(8,256)]
print :: Show a => a -> IO ()
print x = putStrLn (show x)
-
--- | Read a single character from the standard input device.
---
--- 'getChar' is implemented as @'hGetChar' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetChar'.
---
--- ==== __Examples__
---
--- >>> getChar
--- a'a'
---
--- >>> getChar
--- >
--- '\n'
-getChar :: IO Char
-getChar = hGetChar stdin
-
--- | Read a line from the standard input device.
---
--- 'getLine' is implemented as @'hGetLine' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetLine'.
---
--- ==== __Examples__
---
--- >>> getLine
--- > Hello World!
--- "Hello World!"
---
--- >>> getLine
--- >
--- ""
-getLine :: IO String
-getLine = hGetLine stdin
-
--- | The 'getContents' operation returns all user input as a single string,
--- which is read lazily as it is needed.
---
--- 'getContents' is implemented as @'hGetContents' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetContents'.
---
--- ==== __Examples__
---
--- >>> getContents >>= putStr
--- > aaabbbccc :D
--- aaabbbccc :D
--- > I hope you have a great day
--- I hope you have a great day
--- > ^D
---
--- >>> getContents >>= print . length
--- > abc
--- > <3
--- > def ^D
--- 11
-getContents :: IO String
-getContents = hGetContents stdin
-
--- | The 'getContents'' operation returns all user input as a single string,
--- which is fully read before being returned
---
--- 'getContents'' is implemented as @'hGetContents'' 'stdin'@.
---
--- This operation may fail with the same errors as 'hGetContents''.
---
--- ==== __Examples__
---
--- >>> getContents' >>= putStr
--- > aaabbbccc :D
--- > I hope you have a great day
--- aaabbbccc :D
--- I hope you have a great day
---
--- >>> getContents' >>= print . length
--- > abc
--- > <3
--- > def ^D
--- 11
---
--- @since base-4.15.0.0
-getContents' :: IO String
-getContents' = hGetContents' stdin
-
--- | @'interact' f@ takes the entire input from 'stdin' and applies @f@ to it.
--- The resulting string is written to the 'stdout' device.
---
--- Note that this operation is lazy, which allows to produce output
--- even before all input has been consumed.
---
--- This operation may fail with the same errors as 'getContents' and 'putStr'.
---
--- If it doesn't produce output the buffering settings may not be
--- correct, use ^D (ctrl+D) to close stdin which forces
--- the buffer to be consumed.
---
--- You may wish to set the buffering style appropriate to your program's
--- needs before using this function, for example:
---
--- @
--- main :: IO ()
--- main = do
--- hSetBuffering stdin LineBuffering
--- hSetBuffering stdout NoBuffering
--- interact (concatMap (\str -> str ++ str) . L.lines)
--- @
---
--- ==== __Examples__
---
--- >>> interact (\str -> str ++ str)
--- > hi :)
--- hi :)
--- > ^D
--- hi :)
---
--- >>> interact (const ":D")
--- :D
---
--- >>> interact (show . words)
--- > hello world!
--- > I hope you have a great day
--- > ^D
--- ["hello","world!","I","hope","you","have","a","great","day"]
-interact :: (String -> String) -> IO ()
-interact f = do s <- getContents
- putStr (f s)
-
--- | The 'readFile' function reads a file and
--- returns the contents of the file as a string.
---
--- The file is read lazily, on demand, as with 'getContents'.
---
--- This operation may fail with the same errors as 'hGetContents' and 'openFile'.
---
--- ==== __Examples__
---
--- >>> readFile "~/hello_world"
--- "Greetings!"
---
--- >>> take 5 <$> readFile "/dev/zero"
--- "\NUL\NUL\NUL\NUL\NUL"
-readFile :: FilePath -> IO String
-readFile name = openFile name ReadMode >>= hGetContents
-
--- | The 'readFile'' function reads a file and
--- returns the contents of the file as a string.
---
--- This is identical to 'readFile', but the file is fully read before being returned,
--- as with 'getContents''.
---
--- @since base-4.15.0.0
-readFile' :: FilePath -> IO String
--- There's a bit of overkill here—both withFile and
--- hGetContents' will close the file in the end.
-readFile' name = withFile name ReadMode hGetContents'
-
--- | The computation @'writeFile' file str@ function writes the string @str@,
--- to the file @file@.
---
--- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
---
--- ==== __Examples__
---
--- >>> writeFile "hello" "world" >> readFile "hello"
--- "world"
---
--- >>> writeFile "~/" "D:"
--- *** Exception: ~/: withFile: inappropriate type (Is a directory)
-writeFile :: FilePath -> String -> IO ()
-writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt)
-
--- | The computation @'appendFile' file str@ function appends the string @str@,
--- to the file @file@.
---
--- Note that 'writeFile' and 'appendFile' write a literal string
--- to a file. To write a value of any printable type, as with 'print',
--- use the 'show' function to convert the value to a string first.
---
--- This operation may fail with the same errors as 'hPutStr' and 'withFile'.
---
--- ==== __Examples__
---
--- The following example could be more efficently written by acquiring a handle
--- instead with 'openFile' and using the computations capable of writing to handles
--- such as 'hPutStr'.
---
--- >>> let fn = "hello_world"
--- >>> in writeFile fn "hello" >> appendFile fn " world!" >> (readFile fn >>= putStrLn)
--- "hello world!"
---
--- >>> let fn = "foo"; output = readFile' fn >>= putStrLn
--- >>> in output >> appendFile fn (show [1,2,3]) >> output
--- this is what's in the file
--- this is what's in the file[1,2,3]
-appendFile :: FilePath -> String -> IO ()
-appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt)
-
--- | The 'readLn' function combines 'getLine' and 'readIO'.
---
--- This operation may fail with the same errors as 'getLine' and 'readIO'.
---
--- ==== __Examples__
---
--- >>> fmap (+ 5) readLn
--- > 25
--- 30
---
--- >>> readLn :: IO String
--- > this is not a string literal
--- *** Exception: user error (Prelude.readIO: no parse)
-readLn :: Read a => IO a
-readLn = getLine >>= readIO
-
--- | The 'readIO' function is similar to 'read' except that it signals
--- parse failure to the 'IO' monad instead of terminating the program.
---
--- This operation may fail with:
---
--- * 'GHC.Internal.System.IO.Error.isUserError' if there is no unambiguous parse.
---
--- ==== __Examples__
---
--- >>> fmap (+ 1) (readIO "1")
--- 2
---
--- >>> readIO "not quite ()" :: IO ()
--- *** Exception: user error (Prelude.readIO: no parse)
-readIO :: Read a => String -> IO a
-readIO s = case (do { (x,t) <- reads s ;
- ("","") <- lex t ;
- return x }) of
- [x] -> return x
- [] -> ioError (userError "Prelude.readIO: no parse")
- _ -> ioError (userError "Prelude.readIO: ambiguous parse")
-
--- | The encoding of the current locale.
---
--- This is the initial locale encoding: if it has been subsequently changed by
--- 'GHC.Internal.IO.Encoding.setLocaleEncoding' this value will not reflect that change.
-localeEncoding :: TextEncoding
-localeEncoding = initLocaleEncoding
-
--- | Computation 'hReady' @hdl@ indicates whether at least one item is
--- available for input from handle @hdl@.
---
--- This operation may fail with:
---
--- * 'GHC.Internal.System.IO.Error.isEOFError' if the end of file has been reached.
-hReady :: Handle -> IO Bool
-hReady h = hWaitForInput h 0
-
--- | Computation 'hPrint' @hdl t@ writes the string representation of @t@
--- given by the 'show' function to the file or channel managed by @hdl@
--- and appends a newline.
---
--- This operation may fail with the same errors as 'hPutStrLn'
---
--- ==== __Examples__
---
--- >>> hPrint stdout [1,2,3]
--- [1,2,3]
---
--- >>> hPrint stdin [4,5,6]
--- *** Exception: <stdin>: hPutStr: illegal operation (handle is not open for writing)
-hPrint :: Show a => Handle -> a -> IO ()
-hPrint hdl = hPutStrLn hdl . show
-
--- | The function creates a temporary file in ReadWrite mode.
--- The created file isn\'t deleted automatically, so you need to delete it manually.
---
--- The file is created with permissions such that only the current
--- user can read\/write it.
---
--- With some exceptions (see below), the file will be created securely
--- in the sense that an attacker should not be able to cause
--- openTempFile to overwrite another file on the filesystem using your
--- credentials, by putting symbolic links (on Unix) in the place where
--- the temporary file is to be created. On Unix the @O_CREAT@ and
--- @O_EXCL@ flags are used to prevent this attack, but note that
--- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you
--- rely on this behaviour it is best to use local filesystems only.
-openTempFile :: FilePath -- ^ Directory in which to create the file
- -> String -- ^ File name template. If the template is \"foo.ext\" then
- -- the created file will be \"fooXXX.ext\" where XXX is some
- -- random number. Note that this should not contain any path
- -- separator characters. On Windows, the template prefix may
- -- be truncated to 3 chars, e.g. \"foobar.ext\" will be
- -- \"fooXXX.ext\".
- -> IO (FilePath, Handle)
-openTempFile tmp_dir template
- = openTempFile' "openTempFile" tmp_dir template False 0o600
-
--- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
-openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
-openBinaryTempFile tmp_dir template
- = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600
-
--- | Like 'openTempFile', but uses the default file permissions
-openTempFileWithDefaultPermissions :: FilePath -> String
- -> IO (FilePath, Handle)
-openTempFileWithDefaultPermissions tmp_dir template
- = openTempFile' "openTempFileWithDefaultPermissions" tmp_dir template False 0o666
-
--- | Like 'openBinaryTempFile', but uses the default file permissions
-openBinaryTempFileWithDefaultPermissions :: FilePath -> String
- -> IO (FilePath, Handle)
-openBinaryTempFileWithDefaultPermissions tmp_dir template
- = openTempFile' "openBinaryTempFileWithDefaultPermissions" tmp_dir template True 0o666
-
-openTempFile' :: String -> FilePath -> String -> Bool -> CMode
- -> IO (FilePath, Handle)
-openTempFile' loc tmp_dir template binary mode
- | pathSeparator template
- = failIO $ "openTempFile': Template string must not contain path separator characters: "++template
- | otherwise = findTempName
- where
- -- We split off the last extension, so we can use .foo.ext files
- -- for temporary files (hidden on Unix OSes). Unfortunately we're
- -- below filepath in the hierarchy here.
- (prefix, suffix) =
- case break (== '.') $ reverse template of
- -- First case: template contains no '.'s. Just re-reverse it.
- (rev_suffix, "") -> (reverse rev_suffix, "")
- -- Second case: template contains at least one '.'. Strip the
- -- dot from the prefix and prepend it to the suffix (if we don't
- -- do this, the unique number will get added after the '.' and
- -- thus be part of the extension, which is wrong.)
- (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)
- -- Otherwise, something is wrong, because (break (== '.')) should
- -- always return a pair with either the empty string or a string
- -- beginning with '.' as the second component.
- _ -> errorWithoutStackTrace "bug in GHC.Internal.System.IO.openTempFile"
-#if defined(mingw32_HOST_OS)
- findTempName = findTempNamePosix <!> findTempNameWinIO
-
- findTempNameWinIO = do
- let label = if null prefix then "ghc" else prefix
- withCWString tmp_dir $ \c_tmp_dir ->
- withCWString label $ \c_template ->
- withCWString suffix $ \c_suffix ->
- with nullPtr $ \c_ptr -> do
- res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr
- if not res
- then do errno <- getErrno
- ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- else do c_p <- peek c_ptr
- filename <- peekCWString c_p
- free c_p
- let flags = fromIntegral mode .&. o_EXCL
- handleResultsWinIO filename (flags == o_EXCL)
-
- findTempNamePosix = do
- let label = if null prefix then "ghc" else prefix
- withCWString tmp_dir $ \c_tmp_dir ->
- withCWString label $ \c_template ->
- withCWString suffix $ \c_suffix ->
- allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do
- res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0
- c_str
- if not res
- then do errno <- getErrno
- ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- else do filename <- peekCWString c_str
- handleResultsPosix filename
-
- handleResultsPosix filename = do
- let oflags1 = rw_flags .|. o_EXCL
- binary_flags
- | binary = o_BINARY
- | otherwise = 0
- oflags = oflags1 .|. binary_flags
- fd <- withFilePath filename $ \ f -> c_open f oflags mode
- case fd < 0 of
- True -> do errno <- getErrno
- ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- False ->
- do (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
- False{-is_socket-}
- True{-is_nonblock-}
-
- enc <- getLocaleEncoding
- h <- POSIX.mkHandleFromFD fD fd_type filename ReadWriteMode
- False{-set non-block-} (Just enc)
-
- return (filename, h)
-
- handleResultsWinIO filename excl = do
- (hwnd, hwnd_type) <- openFileAsTemp filename True excl
- mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding
-
- -- then use it to make a Handle
- h <- mkHandleFromHANDLE hwnd hwnd_type filename ReadWriteMode mb_codec
- `onException` IODevice.close hwnd
- return (filename, h)
-
-foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo
- :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool
-
-foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo
- :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool
-
-pathSeparator :: String -> Bool
-pathSeparator template = any (\x-> x == '/' || x == '\\') template
-
-output_flags = std_flags
-#else /* else mingw32_HOST_OS */
- findTempName = do
- rs <- rand_string
- let filename = prefix ++ rs ++ suffix
- filepath = tmp_dir `combine` filename
- r <- openNewFile filepath binary mode
- case r of
- FileExists -> findTempName
- OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
- NewFileCreated fd -> do
- (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
- False{-is_socket-}
- True{-is_nonblock-}
-
- enc <- getLocaleEncoding
- h <- POSIX.mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
-
- return (filepath, h)
-
- where
- -- XXX bits copied from System.FilePath, since that's not available here
- combine a b
- | null b = a
- | null a = b
- | pathSeparator [last a] = a ++ b
- | otherwise = a ++ [pathSeparatorChar] ++ b
-
-tempCounter :: IORef Int
-tempCounter = unsafePerformIO $ newIORef 0
-{-# NOINLINE tempCounter #-}
-
--- build large digit-alike number
-rand_string :: IO String
-rand_string = do
- r1 <- c_getpid
- (r2, _) <- atomicModifyIORef'_ tempCounter (+1)
- return $ show r1 ++ "-" ++ show r2
-
-data OpenNewFileResult
- = NewFileCreated CInt
- | FileExists
- | OpenNewError Errno
-
-openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
-openNewFile filepath binary mode = do
- let oflags1 = rw_flags .|. o_EXCL
-
- binary_flags
- | binary = o_BINARY
- | otherwise = 0
-
- oflags = oflags1 .|. binary_flags
- fd <- withFilePath filepath $ \ f ->
- c_open f oflags mode
- if fd < 0
- then do
- errno <- getErrno
- case errno of
- _ | errno == eEXIST -> return FileExists
- _ -> return (OpenNewError errno)
- else return (NewFileCreated fd)
-
--- XXX Should use filepath library
-pathSeparatorChar :: Char
-pathSeparatorChar = '/'
-
-pathSeparator :: String -> Bool
-pathSeparator template = pathSeparatorChar `elem` template
-
-output_flags = std_flags .|. o_CREAT
-#endif /* mingw32_HOST_OS */
-
--- XXX Copied from GHC.Handle
-std_flags, output_flags, rw_flags :: CInt
-std_flags = o_NONBLOCK .|. o_NOCTTY
-rw_flags = output_flags .|. o_RDWR
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -7848,6 +7848,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -9883,7 +9884,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -7820,6 +7820,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -9921,7 +9922,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -8012,6 +8012,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -10163,7 +10164,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -7848,6 +7848,7 @@ module GHC.IO.Handle where
hGetEcho :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Encoding.Types.TextEncoding)
hGetLine :: Handle -> GHC.Internal.Types.IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> GHC.Internal.Types.IO NewlineMode
hGetPosn :: Handle -> GHC.Internal.Types.IO HandlePosn
hIsClosed :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
@@ -9883,7 +9884,7 @@ module System.Exit where
exitWith :: forall a. ExitCode -> GHC.Internal.Types.IO a
module System.IO where
- -- Safety: Safe
+ -- Safety: Trustworthy
type BufferMode :: *
data BufferMode = NoBuffering | LineBuffering | BlockBuffering (GHC.Internal.Maybe.Maybe GHC.Internal.Types.Int)
type FilePath :: *
=====================================
testsuite/tests/typecheck/should_compile/T9497a.stderr
=====================================
@@ -1,4 +1,3 @@
-
T9497a.hs:2:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _main :: IO ()
Or perhaps ‘_main’ is mis-spelled, or not in scope
@@ -8,8 +7,7 @@ T9497a.hs:2:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
main :: IO () (bound at T9497a.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_compile/holes.stderr
=====================================
@@ -45,6 +45,15 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
y :: [a]
z :: [a] -> [a]
f :: forall {p}. p
+ appendFile :: FilePath -> String -> IO ()
+ getChar :: IO Char
+ getContents :: IO String
+ getLine :: IO String
+ interact :: (String -> String) -> IO ()
+ putChar :: Char -> IO ()
+ putStr :: String -> IO ()
+ readFile :: FilePath -> IO String
+ writeFile :: FilePath -> String -> IO ()
otherwise :: Bool
(&&) :: Bool -> Bool -> Bool
not :: Bool -> Bool
@@ -58,16 +67,7 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
showChar :: Char -> ShowS
showParen :: Bool -> ShowS -> ShowS
showString :: String -> ShowS
- appendFile :: FilePath -> String -> IO ()
- getChar :: IO Char
- getContents :: IO String
- getLine :: IO String
- interact :: (String -> String) -> IO ()
- putChar :: Char -> IO ()
- putStr :: String -> IO ()
putStrLn :: String -> IO ()
- readFile :: FilePath -> IO String
- writeFile :: FilePath -> String -> IO ()
EQ :: Ordering
GT :: Ordering
LT :: Ordering
=====================================
testsuite/tests/typecheck/should_compile/holes3.stderr
=====================================
@@ -48,6 +48,15 @@ holes3.hs:11:15: error: [GHC-88464]
y :: [a]
z :: [a] -> [a]
f :: forall {p}. p
+ appendFile :: FilePath -> String -> IO ()
+ getChar :: IO Char
+ getContents :: IO String
+ getLine :: IO String
+ interact :: (String -> String) -> IO ()
+ putChar :: Char -> IO ()
+ putStr :: String -> IO ()
+ readFile :: FilePath -> IO String
+ writeFile :: FilePath -> String -> IO ()
otherwise :: Bool
(&&) :: Bool -> Bool -> Bool
not :: Bool -> Bool
@@ -61,16 +70,7 @@ holes3.hs:11:15: error: [GHC-88464]
showChar :: Char -> ShowS
showParen :: Bool -> ShowS -> ShowS
showString :: String -> ShowS
- appendFile :: FilePath -> String -> IO ()
- getChar :: IO Char
- getContents :: IO String
- getLine :: IO String
- interact :: (String -> String) -> IO ()
- putChar :: Char -> IO ()
- putStr :: String -> IO ()
putStrLn :: String -> IO ()
- readFile :: FilePath -> IO String
- writeFile :: FilePath -> String -> IO ()
EQ :: Ordering
GT :: Ordering
LT :: Ordering
=====================================
testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
=====================================
@@ -234,15 +234,14 @@ valid_hole_fits.hs:41:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
Valid hole fits include
ps :: String -> IO () (defined at valid_hole_fits.hs:9:1)
System.IO.putStr :: String -> IO ()
- (imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:29-34
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:29-34)
System.IO.putStrLn :: String -> IO ()
(imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:37-44
(and originally defined in ‘GHC.Internal.System.IO’))
readIO :: forall a. Read a => String -> IO a
with readIO @()
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (and originally defined in ‘System.IO’))
fail :: forall (m :: * -> *) a.
(MonadFail m, GHC.Internal.Stack.Types.HasCallStack) =>
String -> m a
=====================================
testsuite/tests/typecheck/should_fail/T9497d.stderr
=====================================
@@ -8,8 +8,7 @@ T9497d.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497d.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_run/T9497a-run.stderr
=====================================
@@ -10,8 +10,7 @@ T9497a-run.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497a-run.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_run/T9497b-run.stderr
=====================================
@@ -10,8 +10,7 @@ T9497b-run.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497b-run.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_run/T9497c-run.stderr
=====================================
@@ -10,8 +10,7 @@ T9497c-run.hs:2:8: error: [GHC-88464]
main :: IO () (bound at T9497c-run.hs:2:1)
readLn :: forall a. Read a => IO a
with readLn @()
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.System.IO’))
+ (imported from ‘Prelude’ (and originally defined in ‘System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(IO ())
(imported from ‘Prelude’
=====================================
utils/haddock/html-test/ref/Bug1004.html
=====================================
@@ -627,13 +627,13 @@
>liftReadsPrec</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
- > a) -> <a href="#" title="Prelude"
+ > a) -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> [a] -> <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -645,11 +645,11 @@
>liftReadList</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
- > a) -> <a href="#" title="Prelude"
+ > a) -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
- > [a] -> <a href="#" title="Prelude"
+ > [a] -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> [<a href="#" title="Bug1004"
>Product</a
@@ -735,15 +735,15 @@
>liftShowsPrec</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> a -> <a href="#" title="Prelude"
+ > -> a -> <a href="#" title="Text.Show"
>ShowS</a
- >) -> ([a] -> <a href="#" title="Prelude"
+ >) -> ([a] -> <a href="#" title="Text.Show"
>ShowS</a
>) -> <a href="#" title="Data.Int"
>Int</a
> -> <a href="#" title="Bug1004"
>Product</a
- > f g a -> <a href="#" title="Prelude"
+ > f g a -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -753,13 +753,13 @@
>liftShowList</a
> :: (<a href="#" title="Data.Int"
>Int</a
- > -> a -> <a href="#" title="Prelude"
+ > -> a -> <a href="#" title="Text.Show"
>ShowS</a
- >) -> ([a] -> <a href="#" title="Prelude"
+ >) -> ([a] -> <a href="#" title="Text.Show"
>ShowS</a
>) -> [<a href="#" title="Bug1004"
>Product</a
- > f g a] -> <a href="#" title="Prelude"
+ > f g a] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -2563,15 +2563,15 @@
></span
> <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> (f a)</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> (g a)</span
>)</span
- > => <a href="#" title="Prelude"
+ > => <a href="#" title="Text.Read"
>Read</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -2603,7 +2603,7 @@
>readsPrec</a
> :: <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -2613,7 +2613,7 @@
><p class="src"
><a href="#"
>readList</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="Text.ParserCombinators.ReadP"
>ReadS</a
> [<a href="#" title="Bug1004"
>Product</a
@@ -2651,15 +2651,15 @@
></span
> <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> (f a)</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> (g a)</span
>)</span
- > => <a href="#" title="Prelude"
+ > => <a href="#" title="Text.Show"
>Show</a
> (<a href="#" title="Bug1004"
>Product</a
@@ -2693,7 +2693,7 @@
>Int</a
> -> <a href="#" title="Bug1004"
>Product</a
- > f g a -> <a href="#" title="Prelude"
+ > f g a -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -2713,7 +2713,7 @@
>showList</a
> :: [<a href="#" title="Bug1004"
>Product</a
- > f g a] -> <a href="#" title="Prelude"
+ > f g a] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
=====================================
utils/haddock/html-test/ref/Bug973.html
=====================================
@@ -58,11 +58,11 @@
>showRead</a
> :: <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
@@ -74,11 +74,11 @@
>forall</span
> b a. <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
@@ -104,11 +104,11 @@
><td class="src"
>:: <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
@@ -152,11 +152,11 @@
>forall</span
> b a. <span class="breakable"
>(<span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> a</span
>, <span class="unbreakable"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Read"
>Read</a
> b</span
>)</span
=====================================
utils/haddock/html-test/ref/ConstructorPatternExport.html
=====================================
@@ -95,7 +95,7 @@
>pattern</span
> <a id="v:BlubCons" class="def"
>BlubCons</a
- > :: () => <a href="#" title="Prelude"
+ > :: () => <a href="#" title="Text.Show"
>Show</a
> b => b -> Blub <a href="#" class="selflink"
>#</a
=====================================
utils/haddock/html-test/ref/DefaultSignatures.html
=====================================
@@ -133,7 +133,7 @@
>default</span
> <a id="v:bar" class="def"
>bar</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="Text.Show"
>Show</a
> a => a -> <a href="#" title="Data.String"
>String</a
@@ -177,7 +177,7 @@
>default</span
> <a id="v:baz-39-" class="def"
>baz'</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="Text.Read"
>Read</a
> a => <a href="#" title="Data.String"
>String</a
=====================================
utils/haddock/html-test/ref/Hash.html
=====================================
@@ -111,7 +111,7 @@
>)</span
> => <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Hash"
>HashTable</a
@@ -129,7 +129,7 @@
>Hash</a
> key</span
>)</span
- > => key -> val -> <a href="#" title="Prelude"
+ > => key -> val -> <a href="#" title="System.IO"
>IO</a
> ()</li
><li class="src short"
@@ -137,7 +137,7 @@
>lookup</a
> :: <a href="#" title="Hash"
>Hash</a
- > key => key -> <a href="#" title="Prelude"
+ > key => key -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Data.Maybe"
>Maybe</a
@@ -215,7 +215,7 @@
>)</span
> => <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Hash"
>HashTable</a
@@ -241,7 +241,7 @@
>Hash</a
> key</span
>)</span
- > => key -> val -> <a href="#" title="Prelude"
+ > => key -> val -> <a href="#" title="System.IO"
>IO</a
> () <a href="#" class="selflink"
>#</a
@@ -257,7 +257,7 @@
>lookup</a
> :: <a href="#" title="Hash"
>Hash</a
- > key => key -> <a href="#" title="Prelude"
+ > key => key -> <a href="#" title="System.IO"
>IO</a
> (<a href="#" title="Data.Maybe"
>Maybe</a
=====================================
utils/haddock/html-test/ref/PatternSyns.html
=====================================
@@ -104,7 +104,7 @@
>data</span
> <a href="#"
>BlubType</a
- > = <a href="#" title="Prelude"
+ > = <a href="#" title="Text.Show"
>Show</a
> x => <a href="#"
>BlubCtor</a
@@ -114,7 +114,7 @@
>pattern</span
> <a href="#"
>Blub</a
- > :: () => <a href="#" title="Prelude"
+ > :: () => <a href="#" title="Text.Show"
>Show</a
> x => x -> <a href="#" title="PatternSyns"
>BlubType</a
@@ -266,7 +266,7 @@
><table
><tr
><td class="src"
- ><a href="#" title="Prelude"
+ ><a href="#" title="Text.Show"
>Show</a
> x => <a id="v:BlubCtor" class="def"
>BlubCtor</a
@@ -283,7 +283,7 @@
>pattern</span
> <a id="v:Blub" class="def"
>Blub</a
- > :: () => <a href="#" title="Prelude"
+ > :: () => <a href="#" title="Text.Show"
>Show</a
> x => x -> <a href="#" title="PatternSyns"
>BlubType</a
=====================================
utils/haddock/html-test/ref/PatternSyns2.html
=====================================
@@ -145,7 +145,7 @@
>P</a
> :: () => <span class="keyword"
>forall</span
- > k (a :: k) b. <a href="#" title="Prelude"
+ > k (a :: k) b. <a href="#" title="Text.Show"
>Show</a
> b => <a href="#" title="Data.Proxy"
>Proxy</a
=====================================
utils/haddock/html-test/ref/QuasiExpr.html
=====================================
@@ -122,7 +122,7 @@
><span class="inst-left"
><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Expr:Show:1"
></span
- > <a href="#" title="Prelude"
+ > <a href="#" title="Text.Show"
>Show</a
> <a href="#" title="QuasiExpr"
>Expr</a
@@ -152,7 +152,7 @@
>Int</a
> -> <a href="#" title="QuasiExpr"
>Expr</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -172,7 +172,7 @@
>showList</a
> :: [<a href="#" title="QuasiExpr"
>Expr</a
- >] -> <a href="#" title="Prelude"
+ >] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -244,7 +244,7 @@
><span class="inst-left"
><span class="instance details-toggle-control details-toggle" data-details-id="i:id:BinOp:Show:1"
></span
- > <a href="#" title="Prelude"
+ > <a href="#" title="Text.Show"
>Show</a
> <a href="#" title="QuasiExpr"
>BinOp</a
@@ -274,7 +274,7 @@
>Int</a
> -> <a href="#" title="QuasiExpr"
>BinOp</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
@@ -294,7 +294,7 @@
>showList</a
> :: [<a href="#" title="QuasiExpr"
>BinOp</a
- >] -> <a href="#" title="Prelude"
+ >] -> <a href="#" title="Text.Show"
>ShowS</a
> <a href="#" class="selflink"
>#</a
=====================================
utils/haddock/html-test/ref/Test.html
=====================================
@@ -521,7 +521,7 @@
><li
><a href="#"
>a</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="System.IO"
>IO</a
> a</li
><li
@@ -575,7 +575,7 @@
>a</a
> :: <a href="#" title="Test"
>C</a
- > a => <a href="#" title="Prelude"
+ > a => <a href="#" title="System.IO"
>IO</a
> a</li
><li class="src short"
@@ -591,7 +591,7 @@
>g</a
> :: <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> CInt</li
><li class="src short"
@@ -661,7 +661,7 @@
>Float</a
>) -> <a href="#" title="Test"
>T5</a
- > () () -> <a href="#" title="Prelude"
+ > () () -> <a href="#" title="System.IO"
>IO</a
> ()</li
><li class="src short"
@@ -683,7 +683,7 @@
>R</a
> -> <a href="#" title="Test"
>N1</a
- > () -> <a href="#" title="Prelude"
+ > () -> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Data.Int"
>Int</a
@@ -693,7 +693,7 @@
>o</a
> :: <a href="#" title="Prelude"
>Float</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Prelude"
>Float</a
@@ -1674,7 +1674,7 @@
><p class="src"
><a id="v:a" class="def"
>a</a
- > :: <a href="#" title="Prelude"
+ > :: <a href="#" title="System.IO"
>IO</a
> a <a href="#" class="selflink"
>#</a
@@ -1903,7 +1903,7 @@
>a</a
> :: <a href="#" title="Test"
>C</a
- > a => <a href="#" title="Prelude"
+ > a => <a href="#" title="System.IO"
>IO</a
> a <a href="#" class="selflink"
>#</a
@@ -1991,7 +1991,7 @@ using double quotes: <a href="#"
>g</a
> :: <a href="#" title="Data.Int"
>Int</a
- > -> <a href="#" title="Prelude"
+ > -> <a href="#" title="System.IO"
>IO</a
> CInt <a href="#" class="selflink"
>#</a
@@ -2267,7 +2267,7 @@ is at the beginning of the line).</pre
></tr
><tr
><td class="src"
- >-> <a href="#" title="Prelude"
+ >-> <a href="#" title="System.IO"
>IO</a
> ()</td
><td class="doc"
@@ -2355,7 +2355,7 @@ is at the beginning of the line).</pre
></tr
><tr
><td class="src"
- >-> <a href="#" title="Prelude"
+ >-> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Data.Int"
>Int</a
@@ -2395,7 +2395,7 @@ is at the beginning of the line).</pre
></tr
><tr
><td class="src"
- >-> <a href="#" title="Prelude"
+ >-> <a href="#" title="System.IO"
>IO</a
> <a href="#" title="Prelude"
>Float</a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d3595085a9fefd276a18d8f7c537ca…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d3595085a9fefd276a18d8f7c537ca…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/validate-fix-werror] 3 commits: ghc-internal: fix unused imports
by Cheng Shao (＠TerrorJack) 20 Mar '26
by Cheng Shao (＠TerrorJack) 20 Mar '26
20 Mar '26
Cheng Shao pushed to branch wip/validate-fix-werror at Glasgow Haskell Compiler / GHC
Commits:
b5dd4c1d by Cheng Shao at 2026-03-20T21:54:43+00:00
ghc-internal: fix unused imports
This commit fixes unused imports in `ghc-internal` which should have
been caught by the `validate` flavour but was warnings in CI due to
the recent `+werror` regression. Fixes #26987 #27059.
- - - - -
86696b84 by Cheng Shao at 2026-03-20T21:55:00+00:00
compiler: fix unused imports in GHC.Tc.Types.Origin
This commit fixes unused imports in `GHC.Tc.Types.Origin` which should
have been caught by the `validate` flavour but was warnings in CI due
to the recent `+werror` regression. Fixes #27059.
- - - - -
d9d15dee by Cheng Shao at 2026-03-20T21:55:05+00:00
hadrian: fix missing +werror in validate flavour
This patch fixes missing `+werror` in validate flavour, which was an
oversight in bb3a2ba1eefadf0b2ef4f39b31337a23eec67f29. Fixes #27066.
- - - - -
15 changed files:
- compiler/GHC/Tc/Types/Origin.hs
- hadrian/src/Settings/Flavours/Validate.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/Int.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
Changes:
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -83,7 +83,6 @@ import qualified Data.Kind as Hs
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (isNothing)
import qualified Data.Semigroup as Semi
-import GHC.Generics
{- *********************************************************************
* *
=====================================
hadrian/src/Settings/Flavours/Validate.hs
=====================================
@@ -8,7 +8,7 @@ import {-# SOURCE #-} Settings.Default
-- Please update doc/flavours.md when changing this file.
validateFlavour :: Flavour
-validateFlavour = enableLinting $ quickValidateFlavour
+validateFlavour = enableLinting $ werror $ quickValidateFlavour
{ name = "validate"
, extraArgs = validateArgs <> defaultHaddockExtraArgs
, ghcDebugAssertions = (<= Stage1)
=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
=====================================
@@ -58,7 +58,7 @@ module GHC.Internal.Conc.IO
#endif
) where
-import GHC.Internal.Base (otherwise, pure, return, ($))
+import GHC.Internal.Base (otherwise, return, ($))
import GHC.Internal.Conc.Sync as Sync
import GHC.Internal.Err (errorWithoutStackTrace)
import GHC.Internal.STM as STM
@@ -82,6 +82,10 @@ import qualified GHC.Internal.Wasm.Prim.Conc as Wasm
import qualified GHC.Internal.Wasm.Prim.Flag as Wasm
#endif
+#if defined(javascript_HOST_ARCH)
+import GHC.Internal.Base (pure)
+#endif
+
ensureIOManagerIsRunning :: IO ()
#if defined(javascript_HOST_ARCH)
ensureIOManagerIsRunning = pure ()
=====================================
libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
=====================================
@@ -29,7 +29,7 @@ module GHC.Internal.Event.Control
#include <ghcplatform.h>
#include "EventConfig.h"
-import GHC.Internal.Base (fmap, otherwise, pure, return, when, ($), (.))
+import GHC.Internal.Base (fmap, otherwise, return, when, ($), (.))
import GHC.Internal.Classes (Eq(..), (&&))
import GHC.Internal.IORef
import GHC.Internal.Conc.Signal (Signal)
@@ -56,6 +56,10 @@ import GHC.Internal.Foreign.C.Types (CULLong(..))
import GHC.Internal.Foreign.C.Error (eAGAIN, eWOULDBLOCK, eBADF)
#endif
+#if defined(wasm32_HOST_ARCH)
+import GHC.Internal.Base (pure)
+#endif
+
data ControlMessage = CMsgWakeup
| CMsgDie
| CMsgSignal {-# UNPACK #-} !(ForeignPtr Word8)
=====================================
libraries/ghc-internal/src/GHC/Internal/Float.hs
=====================================
@@ -185,12 +185,12 @@ import GHC.Internal.Prim (
decodeFloat_Int#, divideFloat#, double2Float#, eqWord#, expDouble#,
expFloat#, expm1Double#, expm1Float#, fabsDouble#, fabsFloat#,
float2Double#, geFloat#, gtFloat#, gtWord#, int2Float#, int2Double#,
- int2Word#, int64ToInt#, leFloat#, log1pDouble#, log1pFloat#, logDouble#,
+ int2Word#, leFloat#, log1pDouble#, log1pFloat#, logDouble#,
logFloat#, ltFloat#, ltWord#, minusFloat#, minusWord#, negateDouble#,
negateFloat#, negateInt#, plusFloat#, powerFloat#, sinDouble#, sinFloat#,
sinhDouble#, sinhFloat#, sqrtDouble#, sqrtFloat#, tanDouble#, tanFloat#,
tanhDouble#, tanhFloat#, timesFloat#, uncheckedIShiftRA#, uncheckedShiftL#,
- word2Float#, word2Double#, word2Int#, word64ToWord#,
+ word2Float#, word2Double#, word2Int#,
(+#), (+##), (-#), (-##), (*##), (**##), (/##), (<#), (<##), (<=#), (<=##),
(>#), (>##), (>=#), (>=##),
)
@@ -206,6 +206,13 @@ import GHC.Internal.Float.RealFracMethods
import GHC.Internal.Float.ConversionUtils
import GHC.Internal.Bignum.BigNat
+#if WORD_SIZE_IN_BITS == 64
+import GHC.Internal.Prim (
+ int64ToInt#,
+ word64ToWord#,
+ )
+#endif
+
infixr 8 **
-- $setup
=====================================
libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
=====================================
@@ -66,7 +66,7 @@ import GHC.Internal.Classes (Ord(..))
import GHC.Internal.Num () -- instance Num Integer
-- (We could remove uses with a little effort)
import GHC.Internal.Prim (
- Int#, eqFloat#, decodeFloat_Int#, double2Int#, float2Int#, int2Float#,
+ eqFloat#, decodeFloat_Int#, double2Int#, float2Int#, int2Float#,
int2Double#, int2Word#, ltFloat#, minusFloat#, negateFloat#, negateDouble#,
negateInt#, uncheckedIShiftL#, uncheckedIShiftRA#, uncheckedIShiftRL#,
(+#), (-#), (<#), (>#), (-##), (==##), (<##),
@@ -86,6 +86,10 @@ import GHC.Internal.Prim (
#else
+import GHC.Internal.Prim (
+ Int#,
+ )
+
#define TO64 integerToInt#
#define FROM64 IS
#define MINUS64 ( -# )
@@ -355,4 +359,3 @@ foreign import ccall unsafe "rintDouble"
foreign import ccall unsafe "rintFloat"
c_rintFloat :: Float -> Float
-
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
=====================================
@@ -30,7 +30,7 @@ module GHC.Internal.IO.FD (
) where
import GHC.Internal.Base (
- String, fmap, id, otherwise, pure, return, when, ($), (.), (++), (>>=),
+ String, fmap, otherwise, pure, return, when, ($), (.), (++), (>>=),
)
import GHC.Internal.Bits
import GHC.Internal.Classes (Eq(..), Ord(..), not, (&&), (||))
@@ -58,6 +58,10 @@ import GHC.Internal.Err (error)
import GHC.Internal.Windows
import GHC.Internal.IO.SubSystem ((<!>))
import GHC.Internal.Foreign.Storable
+#else
+import GHC.Internal.Base (
+ id,
+ )
#endif
import GHC.Internal.Foreign.C.Types
=====================================
libraries/ghc-internal/src/GHC/Internal/Int.hs
=====================================
@@ -51,7 +51,7 @@ import GHC.Internal.Classes (
Eq(..), Ord(..),
eqInt, neInt, gtInt, geInt, ltInt, leInt,
divInt8#, divInt16#, divInt32#,
- divModInt8#, divModInt16#, divModInt32#, divModInt#,
+ divModInt8#, divModInt16#, divModInt32#,
modInt8#, modInt16#, modInt32#,
(&&), (||),
)
@@ -63,6 +63,12 @@ import GHC.Internal.Arr
import GHC.Internal.Show
import GHC.Internal.Types (Bool(..), Float, Double, Int(..), isTrue#)
+#if WORD_SIZE_IN_BITS == 64
+import GHC.Internal.Classes (
+ divModInt#,
+ )
+#endif
+
------------------------------------------------------------------------
-- type Int8
------------------------------------------------------------------------
=====================================
libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
=====================================
@@ -66,7 +66,7 @@ import GHC.Internal.Ptr
import GHC.Internal.Types (Bool(..), Double, Int)
import GHC.Internal.Word
import GHC.Internal.Base (
- String, otherwise, pure, return, (.), (++), (<*>), (=<<),
+ String, otherwise, return, (.), (++), (<*>), (=<<),
)
import GHC.Internal.Enum
import GHC.Internal.Generics (Generic)
@@ -74,6 +74,10 @@ import GHC.Internal.IO
import GHC.Internal.Real
import GHC.Internal.Show
+#if defined(javascript_HOST_ARCH)
+import GHC.Internal.Base (pure)
+#endif
+
-- | 'RtsTime' is defined as a @StgWord64@ in @stg/Types.h@
--
-- @since base-4.8.2.0
=====================================
libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
=====================================
@@ -8,16 +8,20 @@ module GHC.Internal.RTS.Flags.Test
)
where
-import GHC.Internal.Base (pure)
import GHC.Internal.Ptr
-import GHC.Internal.Foreign.C.Types
-import GHC.Internal.Foreign.Marshal.Utils
import GHC.Internal.Foreign.Storable
import GHC.Internal.Data.Functor ((<$>))
import GHC.Internal.Types (Bool(..), Int, IO)
import GHC.Internal.Word (Word32)
import GHC.Internal.Real (fromIntegral)
+#if defined(javascript_HOST_ARCH)
+import GHC.Internal.Base (pure)
+#else
+import GHC.Internal.Foreign.C.Types
+import GHC.Internal.Foreign.Marshal.Utils
+#endif
+
#include "Rts.h"
#include "rts/Flags.h"
=====================================
libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
=====================================
@@ -49,9 +49,13 @@ import GHC.Internal.Base (fmap)
import GHC.Internal.Classes (Ord(..))
import GHC.Internal.Control.Exception.Base (bracket)
import GHC.Internal.Err (undefined)
+#else
+import GHC.Internal.Base (
+ map, (++),
+ )
#endif
import GHC.Internal.Base (
- String, liftM, map, mapM, otherwise, return, ($), (.), (++), (>>=),
+ String, liftM, mapM, otherwise, return, ($), (.), (>>=),
)
import GHC.Internal.List (null, elem, takeWhile, break)
import GHC.Internal.Maybe (Maybe(..))
=====================================
libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
=====================================
@@ -43,7 +43,7 @@ import GHC.Internal.Classes (Eq(..))
import GHC.Internal.Data.Functor
import GHC.Internal.Data.List (elem, null, takeWhile)
import GHC.Internal.Foreign.C.String
-import GHC.Internal.Base (String, otherwise, return, ($))
+import GHC.Internal.Base (String, otherwise, ($))
#if defined(mingw32_HOST_OS)
import GHC.Internal.Base ((.))
import GHC.Internal.Foreign.Ptr
@@ -51,6 +51,7 @@ import GHC.Internal.Windows
import GHC.Internal.Control.Monad
import GHC.Internal.Data.List (lookup)
#else
+import GHC.Internal.Base (return)
import GHC.Internal.Foreign.C.Error
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Real (fromIntegral)
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO.hs
=====================================
@@ -249,6 +249,7 @@ import GHC.Internal.Base (String, failIO, otherwise, return, ($), (.), (>>=))
import GHC.Internal.List
#if !defined(mingw32_HOST_OS)
import GHC.Internal.IORef
+import GHC.Internal.Types (Int)
#endif
import GHC.Internal.Num
import GHC.Internal.IO hiding ( bracket, onException )
@@ -262,7 +263,7 @@ import GHC.Internal.IO.Encoding
import GHC.Internal.Text.Read
import GHC.Internal.IO.StdHandles
import GHC.Internal.Show
-import GHC.Internal.Types (Bool(..), Char, Int)
+import GHC.Internal.Types (Bool(..), Char)
-----------------------------------------------------------------------------
-- Standard IO
=====================================
libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
=====================================
@@ -46,19 +46,20 @@ import GHC.Internal.Data.Maybe
#if !defined(HTYPE_TCFLAG_T)
import GHC.Internal.System.IO.Error
+#if !defined(mingw32_HOST_OS)
+import GHC.Internal.Err (errorWithoutStackTrace)
+#endif
#endif
import GHC.Internal.Base (
String, otherwise, pure, return, when, ($), (++), (>>=),
)
import GHC.Internal.Bits
-import GHC.Internal.Classes (Eq(..), Ord(..), not, (&&), (||))
-import GHC.Internal.CString (cstringLength#)
-import GHC.Internal.Err (errorWithoutStackTrace)
+import GHC.Internal.Classes (Eq(..), not, (&&), (||))
import GHC.Internal.Num
import GHC.Internal.Prim (yield#)
import GHC.Internal.Real
-import GHC.Internal.Types (Bool(..), Int(..))
+import GHC.Internal.Types (Bool(..))
import GHC.Internal.Word
import GHC.Internal.IO
import GHC.Internal.IO.IOMode
@@ -71,10 +72,13 @@ import GHC.Internal.Int (Int64)
#endif
#if !defined(mingw32_HOST_OS)
+import GHC.Internal.CString (cstringLength#)
+import GHC.Internal.Classes (Ord(..))
import {-# SOURCE #-} GHC.Internal.IO.Encoding (getFileSystemEncoding)
import GHC.Internal.Foreign.Marshal.Utils
import GHC.Internal.Foreign.Storable
import qualified GHC.Internal.Foreign.C.String.Encoding as GHC
+import GHC.Internal.Types (Int(..))
#else
import GHC.Internal.Int
import GHC.Internal.Data.OldList (elem)
=====================================
libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
=====================================
@@ -39,12 +39,12 @@ module GHC.Internal.TopHandler (
import GHC.Internal.Control.Exception
import GHC.Internal.Data.Maybe
-import GHC.Internal.Classes (Eq(..), Ord(..), (&&))
+import GHC.Internal.Classes (Eq(..),)
import GHC.Internal.Foreign.C.Error
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Foreign.C.String
import GHC.Internal.Base (
- String, const, failIO, otherwise, pure, return, ($), (++), (>>),
+ String, failIO, return, ($), (++), (>>),
)
import GHC.Internal.Conc.Sync hiding (throwTo)
import GHC.Internal.Prim (Weak#, seq)
@@ -67,6 +67,17 @@ import GHC.Internal.Conc.Signal
import GHC.Internal.Data.Dynamic (toDyn)
#endif
+#if !defined(HAVE_SIGNAL_H)
+import GHC.Internal.Base (pure)
+#endif
+
+#if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
+import GHC.Internal.Base (
+ const, otherwise,
+ )
+import GHC.Internal.Classes (Ord(..), (&&),)
+#endif
+
-- Note [rts_setMainThread must be called unsafely]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- rts_setMainThread must be called as unsafe, because it
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3cb8d4324e64c29382aee8efea6727…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3cb8d4324e64c29382aee8efea6727…
You're receiving this email because of your account on gitlab.haskell.org.
1
0