[Git][ghc/ghc][master] Add an operation `System.IO.hGetNewlineMode`
by Marge Bot (＠marge-bot) 23 Dec '25
by Marge Bot (＠marge-bot) 23 Dec '25
23 Dec '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
a2d52b3b by Wolfgang Jeltsch at 2025-12-23T04:47:33-05:00
Add an operation `System.IO.hGetNewlineMode`
This commit also contains some small code and documentation changes for
related operations, for the sake of consistency.
- - - - -
8 changed files:
- libraries/base/changelog.md
- libraries/base/src/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.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
Changes:
=====================================
libraries/base/changelog.md
=====================================
@@ -1,6 +1,7 @@
# Changelog for [`base` package](http://hackage.haskell.org/package/base)
## 4.23.0.0 *TBA*
+ * Add `System.IO.hGetNewlineMode`. ([CLC proposal #370](https://github.com/haskell/core-libraries-committee/issues/370))
* Add `{-# WARNING in "x-partial" #-}` to `Data.List.{init,last}`.
Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it.
([CLC proposal #87](https://github.com/haskell/core-libraries-committee/issues/292))
=====================================
libraries/base/src/System/IO.hs
=====================================
@@ -175,6 +175,7 @@ module System.IO
-- Binary-mode 'Handle's do no newline translation at all.
hSetNewlineMode,
+ hGetNewlineMode,
Newline(..),
nativeNewline,
NewlineMode(..),
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
=====================================
@@ -40,7 +40,7 @@ module GHC.Internal.IO.Handle (
hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
hSetEcho, hGetEcho, hIsTerminalDevice,
- hSetNewlineMode, Newline(..), NewlineMode(..), nativeNewline,
+ hSetNewlineMode, hGetNewlineMode, Newline(..), NewlineMode(..), nativeNewline,
noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
hShow,
@@ -238,7 +238,7 @@ hSetBuffering handle mode =
return Handle__{ haBufferMode = mode,.. }
-- -----------------------------------------------------------------------------
--- hSetEncoding
+-- Setting and getting the text encoding
-- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding
-- for the handle @hdl@ to @encoding@. The default encoding when a 'Handle' is
@@ -624,16 +624,24 @@ hSetBinaryMode handle bin =
haOutputNL = outputNL nl, .. }
-- -----------------------------------------------------------------------------
--- hSetNewlineMode
+-- Setting and getting the newline mode
--- | Set the 'NewlineMode' on the specified 'Handle'. All buffered
+-- | Set the 'NewlineMode' for the specified 'Handle'. All buffered
-- data is flushed first.
hSetNewlineMode :: Handle -> NewlineMode -> IO ()
-hSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } =
+hSetNewlineMode handle NewlineMode{..} =
withAllHandles__ "hSetNewlineMode" handle $ \h_@Handle__{} ->
do
flushBuffer h_
- return h_{ haInputNL=i, haOutputNL=o }
+ return h_{ haInputNL = inputNL, haOutputNL = outputNL }
+
+-- | Return the current 'NewlineMode' for the specified 'Handle'.
+--
+-- @since 4.23.0.0
+hGetNewlineMode :: Handle -> IO NewlineMode
+hGetNewlineMode hdl =
+ withHandle_ "hGetNewlineMode" hdl $ \h_@Handle__{..} ->
+ return NewlineMode{ inputNL = haInputNL, outputNL = haOutputNL }
-- -----------------------------------------------------------------------------
-- Duplicating a Handle
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO.hs
=====================================
@@ -214,6 +214,7 @@ module GHC.Internal.System.IO (
-- Binary-mode 'Handle's do no newline translation at all.
--
hSetNewlineMode,
+ hGetNewlineMode,
Newline(..), nativeNewline,
NewlineMode(..),
noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -10263,6 +10263,7 @@ module System.IO where
hGetEcho :: Handle -> IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding)
hGetLine :: Handle -> IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> IO NewlineMode
hGetPosn :: Handle -> IO HandlePosn
hIsClosed :: Handle -> IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -13309,6 +13309,7 @@ module System.IO where
hGetEcho :: Handle -> IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding)
hGetLine :: Handle -> IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> IO NewlineMode
hGetPosn :: Handle -> IO HandlePosn
hIsClosed :: Handle -> IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -10543,6 +10543,7 @@ module System.IO where
hGetEcho :: Handle -> IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding)
hGetLine :: Handle -> IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> IO NewlineMode
hGetPosn :: Handle -> IO HandlePosn
hIsClosed :: Handle -> IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -10263,6 +10263,7 @@ module System.IO where
hGetEcho :: Handle -> IO GHC.Internal.Types.Bool
hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding)
hGetLine :: Handle -> IO GHC.Internal.Base.String
+ hGetNewlineMode :: Handle -> IO NewlineMode
hGetPosn :: Handle -> IO HandlePosn
hIsClosed :: Handle -> IO GHC.Internal.Types.Bool
hIsEOF :: Handle -> IO GHC.Internal.Types.Bool
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2d52b3b385aaadb9941f53928de275…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2d52b3b385aaadb9941f53928de275…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/iface-patch-9.10-backport
by Matthew Pickering (＠mpickering) 23 Dec '25
by Matthew Pickering (＠mpickering) 23 Dec '25
23 Dec '25
Matthew Pickering pushed new branch wip/iface-patch-9.10-backport at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/iface-patch-9.10-backport
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fix-26670] 4 commits: Do deep subsumption when computing valid hole fits
by recursion-ninja (＠recursion-ninja) 23 Dec '25
by recursion-ninja (＠recursion-ninja) 23 Dec '25
23 Dec '25
recursion-ninja pushed to branch wip/fix-26670 at Glasgow Haskell Compiler / GHC
Commits:
db1ce858 by sheaf at 2025-12-22T17:11:17-05:00
Do deep subsumption when computing valid hole fits
This commit makes a couple of improvements to the code that
computes "valid hole fits":
1. It uses deep subsumption for data constructors.
This matches up the multiplicities, as per
Note [Typechecking data constructors].
This fixes #26338 (test: LinearHoleFits).
2. It now suggests (non-unidirectional) pattern synonyms as valid
hole fits. This fixes #26339 (test: PatSynHoleFit).
3. It uses 'stableNameCmp', to make the hole fit output deterministic.
-------------------------
Metric Increase:
hard_hole_fits
-------------------------
- - - - -
72ee9100 by sheaf at 2025-12-22T17:11:17-05:00
Speed up hole fits with a quick pre-test
This speeds up the machinery for valid hole fits by doing a small
check to rule out obviously wrong hole fits, such as:
1. A hole fit identifier whose type has a different TyCon at the head,
after looking through foralls and (=>) arrows, e.g.:
hole_ty = Int
cand_ty = Maybe a
or
hole_ty = forall a b. a -> b
cand_ty = forall x y. Either x y
2. A hole fit identifier that is not polymorphic when the hole type
is polymorphic, e.g.
hole_ty = forall a. a -> a
cand_ty = Int -> Int
-------------------------
Metric Decrease:
hard_hole_fits
-------------------------
- - - - -
30e513ba by Cheng Shao at 2025-12-22T17:12:00-05:00
configure: remove unused win32-tarballs.md5sum
This patch removes the unused `win32-tarballs.md5sum` file from the
tree. The current mingw tarball download logic in
`mk/get-win32-tarballs.py` fetches and checks against `SHA256SUM` from
the same location where the tarballs are fetched, and this file has
been unused for a few years.
- - - - -
16b3dfb9 by Recursion Ninja at 2025-12-22T21:52:56-05:00
Decoupling Language.Haskell.Syntax.Binds from GHC.Types.Basic by transfering InlinePragma types between the modules.
* Moved InlinePragma data-types to Language.Haskell.Syntax.Binds.InlinePragma
* Partitioned of Arity type synonyms to GHC.Types.Arity
* InlinePragma is now extensible via Trees That Grow
* Activation is now extensible via Trees That Grow
* Maybe Arity change to more descriptive InlineSaturation data-type
* InlineSaturation information removed from InlinePragma during GHS parsing pass
* Cleaned up the exposed module interfaces of the new modules
- - - - -
94 changed files:
- .gitattributes
- compiler/GHC/Builtin/PrimOps/Ids.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/CSE.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/Pipeline/Types.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Foreign/JavaScript.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Tc/Deriv/Generics.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Errors/Hole/FitTypes.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/ThToHs.hs
- + compiler/GHC/Types/Arity.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/Id/Make.hs
- + compiler/GHC/Types/InlinePragma.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/Binds.hs
- + compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.16.1-notes.rst
- libraries/exceptions
- − mk/win32-tarballs.md5sum
- testsuite/tests/ghci/scripts/T8353.stderr
- testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr
- testsuite/tests/perf/compiler/hard_hole_fits.stderr
- testsuite/tests/plugins/test-hole-plugin.stderr
- testsuite/tests/th/T15321.stderr
- testsuite/tests/typecheck/should_compile/T13050.stderr
- testsuite/tests/typecheck/should_compile/T14273.stderr
- testsuite/tests/typecheck/should_compile/T14590.stderr
- testsuite/tests/typecheck/should_compile/T25180.stderr
- testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/hole_constraints.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes2.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr
- testsuite/tests/typecheck/should_fail/T14884.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a5b0700cebe06a8bd3c813409eb74…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a5b0700cebe06a8bd3c813409eb74…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Do deep subsumption when computing valid hole fits
by Marge Bot (＠marge-bot) 23 Dec '25
by Marge Bot (＠marge-bot) 23 Dec '25
23 Dec '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
db1ce858 by sheaf at 2025-12-22T17:11:17-05:00
Do deep subsumption when computing valid hole fits
This commit makes a couple of improvements to the code that
computes "valid hole fits":
1. It uses deep subsumption for data constructors.
This matches up the multiplicities, as per
Note [Typechecking data constructors].
This fixes #26338 (test: LinearHoleFits).
2. It now suggests (non-unidirectional) pattern synonyms as valid
hole fits. This fixes #26339 (test: PatSynHoleFit).
3. It uses 'stableNameCmp', to make the hole fit output deterministic.
-------------------------
Metric Increase:
hard_hole_fits
-------------------------
- - - - -
72ee9100 by sheaf at 2025-12-22T17:11:17-05:00
Speed up hole fits with a quick pre-test
This speeds up the machinery for valid hole fits by doing a small
check to rule out obviously wrong hole fits, such as:
1. A hole fit identifier whose type has a different TyCon at the head,
after looking through foralls and (=>) arrows, e.g.:
hole_ty = Int
cand_ty = Maybe a
or
hole_ty = forall a b. a -> b
cand_ty = forall x y. Either x y
2. A hole fit identifier that is not polymorphic when the hole type
is polymorphic, e.g.
hole_ty = forall a. a -> a
cand_ty = Int -> Int
-------------------------
Metric Decrease:
hard_hole_fits
-------------------------
- - - - -
30e513ba by Cheng Shao at 2025-12-22T17:12:00-05:00
configure: remove unused win32-tarballs.md5sum
This patch removes the unused `win32-tarballs.md5sum` file from the
tree. The current mingw tarball download logic in
`mk/get-win32-tarballs.py` fetches and checks against `SHA256SUM` from
the same location where the tarballs are fetched, and this file has
been unused for a few years.
- - - - -
aba46b88 by Wolfgang Jeltsch at 2025-12-22T20:17:02-05:00
Add an operation `System.IO.hGetNewlineMode`
This commit also contains some small code and documentation changes for
related operations, for the sake of consistency.
- - - - -
988619c7 by Cheng Shao at 2025-12-22T20:17:03-05:00
rts: opportunistically reclaim slop space in shrinkMutableByteArray#
Previously, `shrinkMutableByteArray#` shrinks a `MutableByteArray#`
in-place by assigning the new size to it, and zeroing the extra slop
space. That slop space is not reclaimed and wasted. But it's often the
case that we allocate a `MutableByteArray#` upfront, then shrink it
shortly after, so the `MutableByteArray#` closure sits right at the
end of a nursery block; this patch identifies such chances, and also
shrink `bd->free` if possible, reducing heap space fragmentation.
Co-authored-by: Codex <codex(a)openai.com>
-------------------------
Metric Decrease:
T10678
-------------------------
- - - - -
41 changed files:
- .gitattributes
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Errors/Hole/FitTypes.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Utils/Unify.hs
- docs/users_guide/9.16.1-notes.rst
- libraries/base/changelog.md
- libraries/base/src/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- − mk/win32-tarballs.md5sum
- rts/PrimOps.cmm
- testsuite/tests/ghci/scripts/T8353.stderr
- 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/overloadedrecflds/should_fail/DRFHoleFits.stderr
- testsuite/tests/perf/compiler/hard_hole_fits.stderr
- testsuite/tests/plugins/test-hole-plugin.stderr
- testsuite/tests/th/T15321.stderr
- testsuite/tests/typecheck/should_compile/T13050.stderr
- testsuite/tests/typecheck/should_compile/T14273.stderr
- testsuite/tests/typecheck/should_compile/T14590.stderr
- testsuite/tests/typecheck/should_compile/T25180.stderr
- testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/hole_constraints.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes2.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr
- testsuite/tests/typecheck/should_fail/T14884.stderr
- utils/deriveConstants/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f969370e57afc59bcb1c2a987f7818…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f969370e57afc59bcb1c2a987f7818…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fix-26670] Removing TTG pass parameters in Core/Info/IFace code
by recursion-ninja (＠recursion-ninja) 23 Dec '25
by recursion-ninja (＠recursion-ninja) 23 Dec '25
23 Dec '25
recursion-ninja pushed to branch wip/fix-26670 at Glasgow Haskell Compiler / GHC
Commits:
7a5b0700 by Recursion Ninja at 2025-12-22T20:06:56-05:00
Removing TTG pass parameters in Core/Info/IFace code
- - - - -
15 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/InlinePragma.hs
- compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs
- compiler/Language/Haskell/Syntax/Extension.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -655,32 +655,19 @@ tryCastWorkerWrapper env _ _ bndr rhs -- All other bindings
, text "rhs:" <+> ppr rhs ])
; return (mkFloatBind env (NonRec bndr rhs)) }
-mkCastWrapperInlinePrag :: InlinePragma GhcRn -> InlinePragma GhcRn
+mkCastWrapperInlinePrag :: InlinePragma GhcTc -> InlinePragma GhcTc
-- See Note [Cast worker/wrapper]
mkCastWrapperInlinePrag prag = prag
- -- Consider each field of the 'InlinePragma' constructor
- -- and deterimine what is the appropriate definition for the
- -- corresponding value used within a worker/wrapper.
- --
- -- 1. 'inl_ext': Overwrite with defaults
- -- > Changes <SOME>
`setInlinePragmaSource` src_txt
- `setInlinePragmaSaturation` AnySaturation
- --
- -- 2. 'inl_inline': *Preserve*
- -- See Note [Worker/wrapper for INLINABLE functions]
+ `setInlinePragmaSaturation` AnySaturation
+ `setInlinePragmaActivation` wrap_act
+ -- 1. 'Activation' is conditionally updated
+ -- See Note [Wrapper activation]
-- in GHC.Core.Opt.WorkWrap
- -- > Changes <NONE>
- --
- -- 3. 'inl_act': Conditionally Update
- -- See Note [Wrapper activation]
+ -- 2. 'InlineSpec' is also preserved
+ -- See Note [Worker/wrapper for INLINABLE functions]
-- in GHC.Core.Opt.WorkWrap
- -- > Changes <SOME>
- `setInlinePragmaActivation` wrap_act
- --
- -- 4. 'inl_rule': *Preserve*
- -- RuleMatchInfo is (and must be) unaffected
- -- > Changes <NONE>
+ -- 3. 'RuleMatchInfo' is (and must be) unaffected
where
-- See Note [Wrapper activation] in GHC.Core.Opt.WorkWrap
-- But simpler, because we don't need to disable during InitialPhase
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -44,7 +44,7 @@ import GHC.Data.Bag
import GHC.Data.OrdList
import GHC.Data.List.SetOps
-import GHC.Hs.Extension ( GhcPass, GhcRn )
+import GHC.Hs.Extension ( GhcPass )
import GHC.Types.Basic
import GHC.Types.Unique.Supply
@@ -1641,7 +1641,6 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
-- Copy InlinePragma information from the parent Id.
-- So if f has INLINE[1] so does spec_fn
- spec_inl_prag :: InlinePragma GhcRn
spec_inl_prag
| not is_local -- See Note [Specialising imported functions]
, isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal
=====================================
compiler/GHC/Core/Opt/WorkWrap.hs
=====================================
@@ -22,7 +22,7 @@ import GHC.Core.SimpleOpt
import GHC.Data.FastString
-import GHC.Hs.Extension (GhcPass, GhcRn)
+import GHC.Hs.Extension (GhcPass, GhcTc)
import GHC.Types.Var
import GHC.Types.Id
@@ -897,7 +897,7 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div
fn_unfolding = realUnfoldingInfo fn_info
fn_rules = ruleInfoRules (ruleInfo fn_info)
-mkStrWrapperInlinePrag :: InlinePragma (GhcPass p) -> [CoreRule] -> InlinePragma GhcRn
+mkStrWrapperInlinePrag :: InlinePragma (GhcPass p) -> [CoreRule] -> InlinePragma GhcTc
mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl
, inl_act = fn_act
, inl_rule = rule_info }) rules
=====================================
compiler/GHC/Core/Rules.hs
=====================================
@@ -67,7 +67,7 @@ import GHC.Core.Make ( mkCoreLams )
import GHC.Core.Opt.OccurAnal( occurAnalyseExpr )
import GHC.Core.Rules.Config (roBuiltinRules)
-import GHC.Hs.Extension ( GhcPass, GhcRn )
+import GHC.Hs.Extension ( GhcPass, GhcTc )
import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe )
import GHC.Builtin.Types ( anyTypeOfKind )
@@ -1930,7 +1930,7 @@ ruleCheckProgram ropts curr_phase rule_pat rules binds
in ds `unionBags` go env' binds
data RuleCheckEnv = RuleCheckEnv
- { rc_is_active :: Activation GhcRn -> Bool
+ { rc_is_active :: Activation GhcTc -> Bool
, rc_id_unf :: IdUnfoldingFun
, rc_pattern :: String
, rc_rules :: Id -> [CoreRule]
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -87,7 +87,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
-import GHC.Hs.Extension (GhcRn)
+import GHC.Hs.Extension ( GhcRn )
import Data.Maybe ( isNothing, catMaybes )
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -1020,7 +1020,7 @@ dsSpec_help poly_nm poly_id poly_rhs spec_inl orig_bndrs ds_call
fn_unf = realIdUnfolding poly_id
spec_unf = specUnfolding simpl_opts spec_bndrs mk_spec_body rule_lhs_args fn_unf
spec_info = vanillaIdInfo
- `setInlinePragInfo` specFunInlinePrag poly_id id_inl (demoteInlinePragmaTc spec_inl)
+ `setInlinePragInfo` specFunInlinePrag poly_id id_inl spec_inl
`setUnfoldingInfo` spec_unf
spec_id = mkLocalVar (idDetails poly_id) spec_name ManyTy spec_ty spec_info
-- Specialised binding is toplevel, hence Many.
@@ -1191,7 +1191,7 @@ getCastedVar (Var v) = Just (v, MRefl)
getCastedVar (Cast (Var v) co) = Just (v, MCo co)
getCastedVar _ = Nothing
-specFunInlinePrag :: Id -> InlinePragma GhcRn -> InlinePragma GhcRn -> InlinePragma GhcRn
+specFunInlinePrag :: Id -> InlinePragma GhcTc -> InlinePragma GhcTc -> InlinePragma GhcTc
-- See Note [Activation pragmas for SPECIALISE]
specFunInlinePrag poly_id id_inl spec_inl
| not (isDefaultInlinePragma spec_inl) = spec_inl
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -84,7 +84,7 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
import GHC.Builtin.Types ( constraintKindTyConName )
import GHC.Stg.EnforceEpt.TagSig
import GHC.Parser.Annotation (noLocA)
-import GHC.Hs.Extension ( GhcRn )
+import GHC.Hs.Extension ( GhcRn, GhcTc )
import GHC.Hs.Doc ( WithHsDocIdentifiers(..) )
import GHC.Utils.Lexeme (isLexSym)
@@ -460,7 +460,7 @@ data IfaceInfoItem
= HsArity Arity
| HsDmdSig DmdSig
| HsCprSig CprSig
- | HsInline (InlinePragma GhcRn)
+ | HsInline (InlinePragma GhcTc)
| HsUnfold Bool -- True <=> isStrongLoopBreaker is true
IfaceUnfolding -- See Note [Expose recursive functions]
| HsNoCafRefs
=====================================
compiler/GHC/Tc/Gen/Sig.hs
=====================================
@@ -620,11 +620,11 @@ addInlinePrags poly_id prags_for_me
| inl@(L _ prag) : inls <- inl_prags
= do { traceTc "addInlinePrag" (ppr poly_id $$ ppr prag)
; unless (null inls) (warn_multiple_inlines inl inls)
- ; return (poly_id `setInlinePragma` demoteInlinePragmaTc prag) }
+ ; return (poly_id `setInlinePragma` prag) }
| otherwise
= return poly_id
where
- inl_prags = [L loc (promoteInlinePragmaRn prag) | L loc (InlineSig _ _ prag) <- prags_for_me]
+ inl_prags = [L loc (witnessInlinePragmaPass prag) | L loc (InlineSig _ _ prag) <- prags_for_me]
warn_multiple_inlines _ [] = return ()
@@ -987,7 +987,7 @@ tcSpecPrag poly_id prag@(SpecSig _ fun_name hs_tys inl)
tc_one hs_ty
= do { spec_ty <- tcHsSigType (FunSigCtxt name NoRRC) hs_ty
; wrap <- tcSpecWrapper (FunSigCtxt name (lhsSigTypeContextSpan hs_ty)) poly_ty spec_ty
- ; return (SpecPrag poly_id wrap (promoteInlinePragmaRn inl)) }
+ ; return (SpecPrag poly_id wrap (witnessInlinePragmaPass inl)) }
tcSpecPrag poly_id (SpecSigE nm rule_bndrs spec_e inl)
-- For running commentary, see Note [Handling new-form SPECIALISE pragmas]
@@ -1050,7 +1050,7 @@ tcSpecPrag poly_id (SpecSigE nm rule_bndrs spec_e inl)
, spe_bndrs = qevs ++ rule_bndrs' -- Dependency order
-- does not matter
, spe_call = lhs_call
- , spe_inl = promoteInlinePragmaRn inl }] }
+ , spe_inl = witnessInlinePragmaPass inl }] }
tcSpecPrag _ prag = pprPanic "tcSpecPrag" (ppr prag)
=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -2264,7 +2264,7 @@ mkDefMethBind :: SrcSpan -> DFunId -> Class -> Id -> Name
mkDefMethBind loc dfun_id clas sel_id dm_name dm_spec
= do { logger <- getLogger
; dm_id <- tcLookupId dm_name
- ; let inline_prag = idInlinePragma dm_id
+ ; let inline_prag = witnessInlinePragmaPass $ idInlinePragma dm_id
inline_prags | isAnyInlinePragma inline_prag
= [noLocA (InlineSig noAnn fn inline_prag)]
| otherwise
=====================================
compiler/GHC/Types/Id.hs
=====================================
@@ -150,7 +150,7 @@ import GHC.Core.DataCon
import GHC.Core.Class
import GHC.Core.Multiplicity
-import GHC.Hs.Extension (GhcRn)
+import GHC.Hs.Extension (GhcTc)
import GHC.Types.RepType
import GHC.Types.Demand
@@ -796,7 +796,7 @@ alwaysActiveUnfoldingFun id
-- | Returns an unfolding only if
-- (a) not a strong loop breaker and
-- (b) active in according to is_active
-whenActiveUnfoldingFun :: (Activation GhcRn -> Bool) -> IdUnfoldingFun
+whenActiveUnfoldingFun :: (Activation GhcTc -> Bool) -> IdUnfoldingFun
whenActiveUnfoldingFun is_active id
| is_active (idInlineActivation id) = idUnfolding id
| otherwise = NoUnfolding
@@ -944,19 +944,19 @@ The inline pragma tells us to be very keen to inline this Id, but it's still
OK not to if optimisation is switched off.
-}
-idInlinePragma :: Id -> InlinePragma GhcRn
+idInlinePragma :: Id -> InlinePragma GhcTc
idInlinePragma id = inlinePragInfo (idInfo id)
-setInlinePragma :: Id -> InlinePragma GhcRn -> Id
+setInlinePragma :: Id -> InlinePragma GhcTc -> Id
setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
-modifyInlinePragma :: Id -> (InlinePragma GhcRn -> InlinePragma GhcRn) -> Id
+modifyInlinePragma :: Id -> (InlinePragma GhcTc -> InlinePragma GhcTc) -> Id
modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
-idInlineActivation :: Id -> Activation GhcRn
+idInlineActivation :: Id -> Activation GhcTc
idInlineActivation id = inlinePragmaActivation (idInlinePragma id)
-setInlineActivation :: Id -> Activation GhcRn -> Id
+setInlineActivation :: Id -> Activation GhcTc -> Id
setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
idRuleMatchInfo :: Id -> RuleMatchInfo
=====================================
compiler/GHC/Types/Id/Info.hs
=====================================
@@ -52,7 +52,7 @@ module GHC.Types.Id.Info (
realUnfoldingInfo, unfoldingInfo, setUnfoldingInfo, hasInlineUnfolding,
-- ** The InlinePragInfo type
- InlinePragInfo,
+ InlinePragmaInfo,
inlinePragInfo, setInlinePragInfo,
-- ** The OccInfo type
@@ -100,7 +100,6 @@ import GHC.Core.TyCon
import GHC.Core.Type (mkTyConApp)
import GHC.Core.PatSyn
import GHC.Core.ConLike
-import GHC.Hs.Extension
import GHC.Types.ForeignCall
import GHC.Unit.Module
import GHC.Types.Demand
@@ -439,7 +438,7 @@ data IdInfo
-- See Note [Specialisations and RULES in IdInfo]
realUnfoldingInfo :: Unfolding,
-- ^ The 'Id's unfolding
- inlinePragInfo :: InlinePragma GhcRn,
+ inlinePragInfo :: InlinePragmaInfo,
-- ^ Any inline pragma attached to the 'Id'
occInfo :: OccInfo,
-- ^ How the 'Id' occurs in the program
@@ -553,7 +552,7 @@ tagSigInfo = tagSig
setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
setRuleInfo info sp = sp `seq` info { ruleInfo = sp }
-setInlinePragInfo :: IdInfo -> InlinePragma GhcRn -> IdInfo
+setInlinePragInfo :: IdInfo -> InlinePragmaInfo -> IdInfo
setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
setOccInfo :: IdInfo -> OccInfo -> IdInfo
@@ -704,27 +703,6 @@ ppArityInfo :: Int -> SDoc
ppArityInfo 0 = empty
ppArityInfo n = hsep [text "Arity", int n]
-{-
-************************************************************************
-* *
-\subsection{Inline-pragma information}
-* *
-************************************************************************
--}
-
--- | Inline Pragma Information
---
--- Tells when the inlining is active.
--- When it is active the thing may be inlined, depending on how
--- big it is.
---
--- If there was an @INLINE@ pragma, then as a separate matter, the
--- RHS will have been made to look small with a Core inline 'Note'
---
--- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
--- entirely as a way to inhibit inlining until we want it
-type InlinePragInfo = InlinePragma
-
{-
************************************************************************
* *
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -65,8 +65,6 @@ import GHC.Core.TyCon
import GHC.Core.Class
import GHC.Core.DataCon
-import GHC.Hs.Extension (GhcRn)
-
import GHC.Types.Literal
import GHC.Types.RepType ( countFunRepArgs, typePrimRep )
import GHC.Types.Name.Set
@@ -608,7 +606,7 @@ mkDataConWorkId wkr_name data_con
-- See Note [Strict fields in Core]
`setLFInfo` wkr_lf_info
- wkr_inline_prag :: InlinePragma GhcRn
+ wkr_inline_prag :: InlinePragmaInfo
wkr_inline_prag = alwaysInlineConLikePragma
wkr_arity = dataConRepArity data_con
@@ -989,7 +987,7 @@ mkDataConRep dc_bang_opts fam_envs wrap_name data_con
; return (unbox_fn expr) }
-dataConWrapperInlinePragma :: InlinePragma GhcRn
+dataConWrapperInlinePragma :: InlinePragmaInfo
-- See Note [DataCon wrappers are conlike]
dataConWrapperInlinePragma = alwaysInlineConLikePragma
=====================================
compiler/GHC/Types/InlinePragma.hs
=====================================
@@ -24,6 +24,7 @@ module GHC.Types.InlinePragma
-- ** InlinePragma
-- *** Data-type
InlinePragma(..)
+ , InlinePragmaInfo
-- *** Constants
, defaultInlinePragma
, alwaysInlinePragma
@@ -51,8 +52,7 @@ module GHC.Types.InlinePragma
, setInlinePragmaSpec
, setInlinePragmaRuleMatchInfo
-- *** GHC pass conversions
- , demoteInlinePragmaTc
- , promoteInlinePragmaRn
+ , witnessInlinePragmaPass
-- *** Pretty-printing
, pprInline
, pprInlineDebug
@@ -148,6 +148,28 @@ instance NFData InlineSaturation where
rnf (AppliedToAtLeast !w) = rnf w `seq` ()
rnf !AnySaturation = ()
+
+{-
+************************************************************************
+* *
+\subsection{Inline-pragma information}
+* *
+************************************************************************
+-}
+
+-- | Inline Pragma Information
+--
+-- Tells when the inlining is active.
+-- When it is active the thing may be inlined, depending on how
+-- big it is.
+--
+-- If there was an @INLINE@ pragma, then as a separate matter, the
+-- RHS will have been made to look small with a Core inline 'Note'
+--
+-- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
+-- entirely as a way to inhibit inlining until we want it
+type InlinePragmaInfo = InlinePragma GhcTc
+
data XInlinePragmaGhc = XInlinePragmaGhc
{ xinl_src :: SourceText
-- ^ See Note [Pragma source text]
@@ -181,6 +203,14 @@ type instance XInlinePragma GhcTc = XInlinePragmaGhc
type instance XXInlinePragma (GhcPass _) = DataConCantHappen
type instance XXActivation (GhcPass _) = XXActivationGhc
+witnessInlinePragmaPass :: forall p q.
+ (XInlinePragma (GhcPass p) ~ XInlinePragmaGhc, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc)
+ => InlinePragma (GhcPass p) -> InlinePragma (GhcPass q)
+witnessInlinePragmaPass prag@(InlinePragma { inl_ext = src }) =
+ prag { inl_ext = src
+ , inl_act = coerceActivation $ inl_act prag
+ }
+
-- | The default 'InlinePragma' definition for GHC.
-- The type and value of 'inl_ext' provided will differ
-- between the passes of GHC. Consequently, it may be
@@ -235,18 +265,6 @@ inlinePragmaSaturation :: forall p. (XInlinePragma (GhcPass p) ~ XInlinePragmaGh
=> InlinePragma (GhcPass p) -> InlineSaturation
inlinePragmaSaturation = xinl_sat . inl_ext
-promoteInlinePragmaRn :: InlinePragma GhcRn -> InlinePragma GhcTc
-promoteInlinePragmaRn prag@(InlinePragma { inl_ext = src }) =
- prag { inl_ext = src
- , inl_act = coerceActivation $ inl_act prag
- }
-
-demoteInlinePragmaTc :: InlinePragma GhcTc -> InlinePragma GhcRn
-demoteInlinePragmaTc prag@(InlinePragma { inl_ext = src }) =
- prag { inl_ext = src
- , inl_act = coerceActivation $ inl_act prag
- }
-
inlinePragmaSpec :: InlinePragma p -> InlineSpec
inlinePragmaSpec = inl_inline
@@ -339,6 +357,26 @@ coerceActivation = \case
AlwaysActive -> AlwaysActive
NeverActive -> NeverActive
+activeInPhase :: PhaseNum -> Activation (GhcPass p) -> Bool
+activeInPhase _ AlwaysActive = True
+activeInPhase _ NeverActive = False
+activeInPhase _ ActiveFinal = False
+activeInPhase p (ActiveAfter n) = p <= n
+activeInPhase p (ActiveBefore n) = p > n
+
+activeInFinalPhase :: Activation (GhcPass p) -> Bool
+activeInFinalPhase AlwaysActive = True
+activeInFinalPhase ActiveFinal = True
+activeInFinalPhase (ActiveAfter {}) = True
+activeInFinalPhase _ = False
+
+isNeverActive, isAlwaysActive :: Activation p -> Bool
+isNeverActive NeverActive = True
+isNeverActive _ = False
+
+isAlwaysActive AlwaysActive = True
+isAlwaysActive _ = False
+
activateAfterInitial :: Activation (GhcPass p)
-- ^ Active in the first phase after the initial phase
activateAfterInitial = activeAfter (nextPhase InitialPhase)
=====================================
compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs
=====================================
@@ -43,11 +43,6 @@ module Language.Haskell.Syntax.Binds.InlinePragma
-- *** Data-type
, Activation(..)
, PhaseNum
- -- *** Queries
- , activeInPhase
- , activeInFinalPhase
- , isAlwaysActive
- , isNeverActive
) where
import Language.Haskell.Syntax.Extension
@@ -310,23 +305,3 @@ instance NFData (XXActivation p) => NFData (Activation p) where
ActiveBefore aa -> rnf aa
ActiveAfter ab -> rnf ab
XActivation x -> rnf x `seq` ()
-
-activeInPhase :: PhaseNum -> Activation p -> Bool
-activeInPhase _ AlwaysActive = True
-activeInPhase _ NeverActive = False
-activeInPhase _ (XActivation _) = False
-activeInPhase p (ActiveAfter n) = p <= n
-activeInPhase p (ActiveBefore n) = p > n
-
-activeInFinalPhase :: Activation p -> Bool
-activeInFinalPhase AlwaysActive = True
-activeInFinalPhase (XActivation {}) = True
-activeInFinalPhase (ActiveAfter {}) = True
-activeInFinalPhase _ = False
-
-isNeverActive, isAlwaysActive :: Activation p -> Bool
-isNeverActive NeverActive = True
-isNeverActive _ = False
-
-isAlwaysActive AlwaysActive = True
-isAlwaysActive _ = False
=====================================
compiler/Language/Haskell/Syntax/Extension.hs
=====================================
@@ -241,8 +241,8 @@ type family XCompleteMatchSig x
type family XXSig x
-- Inline Pragma families
-type family XInlinePragma x
-type family XXInlinePragma x
+type family XInlinePragma x
+type family XXInlinePragma x
-- Inline Activation family
type family XXActivation x
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a5b0700cebe06a8bd3c813409eb748…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a5b0700cebe06a8bd3c813409eb748…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/hie-spans] - Make a new variant `GeneratedSrcSpan` in `SrcSpan` for HIEAst Nodes
by Apoorv Ingle (＠ani) 22 Dec '25
by Apoorv Ingle (＠ani) 22 Dec '25
22 Dec '25
Apoorv Ingle pushed to branch wip/ani/hie-spans at Glasgow Haskell Compiler / GHC
Commits:
1d977793 by Apoorv Ingle at 2025-12-22T17:40:52-06:00
- Make a new variant `GeneratedSrcSpan` in `SrcSpan` for HIEAst Nodes
- Fixes T23540
- - - - -
27 changed files:
- compiler/GHC.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Types/CtLoc.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/SrcLoc.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Logger.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -1617,6 +1617,7 @@ addSourceToTokens _ _ [] = []
addSourceToTokens loc buf (t@(L span _) : ts)
= case span of
UnhelpfulSpan _ -> (t,"") : addSourceToTokens loc buf ts
+ GeneratedSrcSpan _ -> (t,"") : addSourceToTokens loc buf ts
RealSrcSpan s _ -> (t,str) : addSourceToTokens newLoc newBuf ts
where
(newLoc, newBuf, str) = go "" loc buf
@@ -1637,12 +1638,14 @@ showRichTokenStream ts = go startLoc ts ""
where sourceFile = getFile $ map (getLoc . fst) ts
getFile [] = panic "showRichTokenStream: No source file found"
getFile (UnhelpfulSpan _ : xs) = getFile xs
+ getFile (GeneratedSrcSpan _ : xs) = getFile xs
getFile (RealSrcSpan s _ : _) = srcSpanFile s
startLoc = mkRealSrcLoc sourceFile 1 1
go _ [] = id
go loc ((L span _, str):ts)
= case span of
UnhelpfulSpan _ -> go loc ts
+ GeneratedSrcSpan _ -> go loc ts
RealSrcSpan s _
| locLine == tokLine -> ((replicate (tokCol - locCol) ' ') ++)
. (str ++)
=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -486,10 +486,10 @@ getSrcSpanDs = do { env <- getLclEnv
; return (RealSrcSpan (dsl_loc env) Strict.Nothing) }
putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
-putSrcSpanDs (UnhelpfulSpan {}) thing_inside
- = thing_inside
putSrcSpanDs (RealSrcSpan real_span _) thing_inside
= updLclEnv (\ env -> env {dsl_loc = real_span}) thing_inside
+putSrcSpanDs _ thing_inside
+ = thing_inside
putSrcSpanDsA :: EpAnn ann -> DsM a -> DsM a
putSrcSpanDsA loc = putSrcSpanDs (locA loc)
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -120,7 +120,7 @@ addTicksToBinds logger cfg
, blackList = Set.fromList $
mapMaybe (\tyCon -> case getSrcSpan (tyConName tyCon) of
RealSrcSpan l _ -> Just l
- UnhelpfulSpan _ -> Nothing)
+ _ -> Nothing)
tyCons
, density = mkDensity tickish $ ticks_profAuto cfg
, this_mod = mod
@@ -1191,7 +1191,7 @@ getFileName = fileName `liftM` getEnv
isGoodSrcSpan' :: SrcSpan -> Bool
isGoodSrcSpan' pos@(RealSrcSpan _ _) = srcSpanStart pos /= srcSpanEnd pos
-isGoodSrcSpan' (UnhelpfulSpan _) = False
+isGoodSrcSpan' _ = False
isGoodTickSrcSpan :: SrcSpan -> TM Bool
isGoodTickSrcSpan pos = do
@@ -1217,11 +1217,11 @@ bindLocals from (TM m) = TM $ \env st ->
withBlackListed :: SrcSpan -> TM a -> TM a
withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) })
-withBlackListed (UnhelpfulSpan _) = id
+withBlackListed _ = id
isBlackListed :: SrcSpan -> TM Bool
isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st)
-isBlackListed (UnhelpfulSpan _) = return False
+isBlackListed _ = return False
-- the tick application inherits the source position of its
-- expression argument to support nested box allocations
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -251,6 +251,11 @@ getUnlocatedEvBinds file = do
let node = Node (mkSourcedNodeInfo org ni) spn []
ni = NodeInfo mempty [] $ M.fromList [mkNodeInfo e]
in (xs,node:ys)
+ GeneratedSrcSpan spn
+ | srcSpanFile spn == file ->
+ let node = Node (mkSourcedNodeInfo org ni) spn []
+ ni = NodeInfo mempty [] $ M.fromList [mkNodeInfo e]
+ in (xs,node:ys)
_ -> (mkNodeInfo e : xs,ys)
(nis,asts) = foldr go ([],[]) elts
@@ -419,6 +424,7 @@ getRealSpanA la = getRealSpan (locA la)
getRealSpan :: SrcSpan -> Maybe Span
getRealSpan (RealSrcSpan sp _) = Just sp
+getRealSpan (GeneratedSrcSpan sp) = Just sp
getRealSpan _ = Nothing
grhss_span :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns)
@@ -606,36 +612,39 @@ instance ToHie (Context (Located a)) => ToHie (Context (LocatedN a)) where
instance ToHie (Context (Located a)) => ToHie (Context (LocatedA a)) where
toHie (C c (L l a)) = toHie (C c (L (locA l) a))
-instance ToHie (Context (Located Var)) where
- toHie c = case c of
- C context (L (RealSrcSpan span _) name')
- | varUnique name' == mkBuiltinUnique 1 -> pure []
- -- `mkOneRecordSelector` makes a field var using this unique, which we ignore
- | otherwise -> do
- m <- lift $ gets name_remapping
- org <- ask
- let name = case lookupNameEnv m (varName name') of
- Just var -> var
- Nothing-> name'
- ty = case isDataConId_maybe name' of
+toHieCtxLocVar :: ContextInfo -> RealSrcSpan -> Var -> HieM [HieAST Type]
+toHieCtxLocVar context span name'
+ | varUnique name' == mkBuiltinUnique 1 = pure []
+ -- `mkOneRecordSelector` makes a field var using this unique, which we ignore
+ | otherwise = do
+ m <- lift $ gets name_remapping
+ org <- ask
+ let name = case lookupNameEnv m (varName name') of
+ Just var -> var
+ Nothing-> name'
+ ty = case isDataConId_maybe name' of
Nothing -> varType name'
Just dc -> dataConWrapperType dc
-- insert the entity info for the name into the entity_infos map
- insertEntityInfo (varName name) $ idEntityInfo name
- insertEntityInfo (varName name') $ idEntityInfo name'
- pure
- [Node
- (mkSourcedNodeInfo org $ NodeInfo S.empty [] $
- M.singleton (Right $ varName name)
+ insertEntityInfo (varName name) $ idEntityInfo name
+ insertEntityInfo (varName name') $ idEntityInfo name'
+ pure [Node (mkSourcedNodeInfo org $ NodeInfo S.empty [] $
+ M.singleton (Right $ varName name)
(IdentifierDetails (Just ty)
(S.singleton context)))
- span
- []]
+ span
+ []]
+
+instance ToHie (Context (Located Var)) where
+ toHie c = case c of
+ C context (L (RealSrcSpan span _) name') -> toHieCtxLocVar context span name'
+ C context (L (GeneratedSrcSpan span) name') -> toHieCtxLocVar context span name'
C (EvidenceVarBind i _ sp) (L _ name) -> do
addUnlocatedEvBind name (EvidenceVarBind i ModuleScope sp)
pure []
_ -> pure []
+
instance ToHie (Context (Located Name)) where
toHie c = case c of
C context (L (RealSrcSpan span _) name')
=====================================
compiler/GHC/Iface/Ext/Utils.hs
=====================================
@@ -322,6 +322,16 @@ getNameScopeAndBinding n asts = case nameSrcSpan n of
scopes <- maybeToList $ foldMap getScopeFromContext (identInfo dets)
let binding = foldMap (First . getBindSiteFromContext) (identInfo dets)
return $ Just (scopes, getFirst binding)
+ GeneratedSrcSpan sp -> do -- @Maybe
+ ast <- M.lookup (HiePath (srcSpanFile sp)) asts
+ defNode <- selectLargestContainedBy sp ast
+ getFirst $ foldMap First $ do -- @[]
+ node <- flattenAst defNode
+ dets <- maybeToList
+ $ M.lookup (Right n) $ sourcedNodeIdents $ sourcedNodeInfo node
+ scopes <- maybeToList $ foldMap getScopeFromContext (identInfo dets)
+ let binding = foldMap (First . getBindSiteFromContext) (identInfo dets)
+ return $ Just (scopes, getFirst binding)
_ -> Nothing
getScopeFromContext :: ContextInfo -> Maybe [Scope]
@@ -377,6 +387,7 @@ selectSmallestContaining sp node
definedInAsts :: M.Map HiePath (HieAST a) -> Name -> Bool
definedInAsts asts n = case nameSrcSpan n of
RealSrcSpan sp _ -> M.member (HiePath (srcSpanFile sp)) asts
+ GeneratedSrcSpan sp -> M.member (HiePath (srcSpanFile sp)) asts
_ -> False
getEvidenceBindDeps :: ContextInfo -> [Name]
@@ -527,6 +538,10 @@ locOnly (RealSrcSpan span _) = do
org <- ask
let e = mkSourcedNodeInfo org $ emptyNodeInfo
pure [Node e span []]
+locOnly (GeneratedSrcSpan span) = do
+ org <- ask
+ let e = mkSourcedNodeInfo org $ emptyNodeInfo
+ pure [Node e span []]
locOnly _ = pure []
locOnlyE :: Monad m => EpaLocation -> ReaderT NodeOrigin m [HieAST a]
@@ -536,6 +551,7 @@ locOnlyE _ = pure []
mkScope :: (HasLoc a) => a -> Scope
mkScope a = case getHasLoc a of
(RealSrcSpan sp _) -> LocalScope sp
+ (GeneratedSrcSpan sp) -> LocalScope sp
_ -> NoScope
combineScopes :: Scope -> Scope -> Scope
@@ -567,6 +583,7 @@ makeNode x spn = do
org <- ask
pure $ case spn of
RealSrcSpan span _ -> [Node (mkSourcedNodeInfo org $ simpleNodeInfo cons typ) span []]
+ GeneratedSrcSpan span -> [Node (mkSourcedNodeInfo org $ simpleNodeInfo cons typ) span []]
_ -> []
where
cons = mkFastString . show . toConstr $ x
@@ -593,6 +610,8 @@ makeTypeNode x spn etyp = do
pure $ case spn of
RealSrcSpan span _ ->
[Node (mkSourcedNodeInfo org $ NodeInfo (S.singleton (NodeAnnotation cons typ)) [etyp] M.empty) span []]
+ GeneratedSrcSpan span ->
+ [Node (mkSourcedNodeInfo org $ NodeInfo (S.singleton (NodeAnnotation cons typ)) [etyp] M.empty) span []]
_ -> []
where
cons = mkFastString . show . toConstr $ x
=====================================
compiler/GHC/Parser/HaddockLex.x
=====================================
@@ -145,6 +145,7 @@ lexStringLiteral identParser (L l sl@(StringLiteral _ fs _))
plausibleIdents = case l of
RealSrcSpan span _ -> [(RealSrcSpan span' Strict.Nothing, tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) bs]
UnhelpfulSpan reason -> [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc bs]
+ GeneratedSrcSpan span -> [(GeneratedSrcSpan span, tok) | (_, tok) <- alexScanTokens fakeLoc bs]
fakeLoc = mkRealSrcLoc nilFS 0 0
@@ -166,6 +167,8 @@ lexHsDoc identParser doc =
= [(RealSrcSpan span' Strict.Nothing, tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) s]
plausibleIdents (L (UnhelpfulSpan reason) (HsDocStringChunk s))
= [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc s] -- preserve the original reason
+ plausibleIdents (L (GeneratedSrcSpan span) (HsDocStringChunk s))
+ = [(GeneratedSrcSpan span, tok) | (_, tok) <- alexScanTokens fakeLoc s] -- preserve the original reason
fakeLoc = mkRealSrcLoc nilFS 0 0
@@ -181,11 +184,12 @@ validateIdentWith identParser mloc str0 =
buffer = stringBufferFromByteString str0
realSrcLc = case mloc of
RealSrcSpan loc _ -> realSrcSpanStart loc
+ GeneratedSrcSpan{} -> mkRealSrcLoc nilFS 0 0
UnhelpfulSpan _ -> mkRealSrcLoc nilFS 0 0
pstate = initParserState pflags buffer realSrcLc
in case unP identParser pstate of
POk _ name -> Just $ case mloc of
RealSrcSpan _ _ -> reLoc name
- UnhelpfulSpan _ -> L mloc (unLoc name) -- Preserve the original reason
+ _ -> L mloc (unLoc name) -- Preserve the original reason
_ -> Nothing
}
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -502,11 +502,11 @@ rnExpr (ExplicitList _ exps)
then return (ExplicitList noExtField exps', fvs)
else
do { (from_list_n_name, fvs') <- lookupSyntaxName fromListNName
- --; loc <- getSrcSpanM -- See Note [Source locations for implicit function calls]
+ ; loc <- getRealSrcSpanM -- See Note [Source locations for implicit function calls]
; let rn_list = ExplicitList noExtField exps'
lit_n = mkIntegralLit (length exps)
hs_lit = genHsIntegralLit lit_n
- exp_list = genHsApps' (wrapGenSpan from_list_n_name) [hs_lit, wrapGenSpan rn_list]
+ exp_list = genHsApps' (wrapGenSpan' loc from_list_n_name) [hs_lit, wrapGenSpan rn_list]
; return ( mkExpandedExpr rn_list exp_list
, fvs `plusFV` fvs') } }
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -17,7 +17,7 @@ module GHC.Rename.Utils (
DeprecationWarnings(..), warnIfDeprecated,
checkUnusedRecordWildcard,
badQualBndrErr, typeAppErr, badFieldConErr,
- wrapGenSpan, wrapNoSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps', genHsExpApps,
+ wrapGenSpan, wrapGenSpan', wrapNoSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps', genHsExpApps,
genLHsApp, genAppType,
genLHsLit, genHsIntegralLit, genHsTyLit, genSimpleConPat,
genVarPat, genWildPat,
@@ -701,6 +701,9 @@ wrapGenSpan :: (HasAnnotation an) => a -> GenLocated an a
-- See Note [Rebindable syntax and XXExprGhcRn]
wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x
+wrapGenSpan' :: (HasAnnotation an) => RealSrcSpan -> a -> GenLocated an a
+wrapGenSpan' s x = L (noAnnSrcSpan $ GeneratedSrcSpan s) x
+
wrapNoSpan :: (HasAnnotation an) => a -> GenLocated an a
-- Wrap something in a "noSrcSpan"
-- See Note [Rebindable syntax and XXExprGhcRn]
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -1,4 +1,3 @@
-
-- | GHC API debugger module for finding and setting breakpoints.
--
-- This module is user facing and is at least used by `GHCi` and `ghc-debugger`
@@ -86,6 +85,7 @@ leftmostLargestRealSrcSpan = on compare realSrcSpanStart S.<> on (flip compare)
-- | Returns the span of the largest tick containing the srcspan given
enclosingTickSpan :: TickArray -> SrcSpan -> RealSrcSpan
enclosingTickSpan _ (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan"
+enclosingTickSpan _ (GeneratedSrcSpan _) = panic "generatedSrcSpan UnhelpfulSpan"
enclosingTickSpan ticks (RealSrcSpan src _) =
assert (inRange (bounds ticks) line) $
List.minimumBy leftmostLargestRealSrcSpan $ enclosing_spans
@@ -295,4 +295,3 @@ getCurrentBreakModule = do
return $ Just $ getBreakSourceMod ibi brks
ix ->
Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
-
=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -114,18 +114,17 @@ expand_do_stmts doFlavour (stmt@(L loc (BindStmt xbsrn pat e)): lstmts)
| otherwise
= pprPanic "expand_do_stmts: The impossible happened, missing bind operator from renamer" (text "stmt" <+> ppr stmt)
-expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ (L _e_lspan e) (SyntaxExprRn then_op) _)) : lstmts) =
+expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ (L _ e) (SyntaxExprRn then_op) _)) : lstmts) =
-- See Note [BodyStmt] in Language.Haskell.Syntax.Expr
-- See Note [Expanding HsDo with XXExprGhcRn] Equation (1) below
-- stmts ~~> stmts'
-- ----------------------------------------------
-- e ; stmts ~~> (>>) e stmts'
- do expand_stmts_expr <- expand_do_stmts doFlavour lstmts
- let expansion = genHsExpApps then_op -- (>>)
- [ -- L e_lspan (mkExpandedStmt stmt doFlavour e)
- wrapGenSpan e
- , expand_stmts_expr ]
- return $ L loc (mkExpandedStmt stmt doFlavour expansion)
+ do expand_stmts_expr <- expand_do_stmts doFlavour lstmts
+ let expansion = genHsExpApps then_op -- (>>)
+ [ wrapGenSpan e
+ , expand_stmts_expr ]
+ return $ L loc (mkExpandedStmt stmt doFlavour expansion)
expand_do_stmts doFlavour
((L loc (RecStmt { recS_stmts = L stmts_loc rec_stmts
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -1480,9 +1480,11 @@ instance TH.Quasi TcM where
qLocation = do { m <- getModule
; l <- getSrcSpanM
; r <- case l of
+ RealSrcSpan s _ -> return s
+ GeneratedSrcSpan l -> pprPanic "qLocation: generatedSrcSpan"
+ (ppr l)
UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location"
(ppr l)
- RealSrcSpan s _ -> return s
; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r)
, TH.loc_module = moduleNameString (moduleName m)
, TH.loc_package = unitString (moduleUnit m)
=====================================
compiler/GHC/Tc/Types/CtLoc.hs
=====================================
@@ -253,8 +253,7 @@ setCtLocEnvLoc :: CtLocEnv -> SrcSpan -> CtLocEnv
-- for the ctl_in_gen_code manipulation
setCtLocEnvLoc env (RealSrcSpan loc _)
= env { ctl_loc = loc, ctl_in_gen_code = False }
-
-setCtLocEnvLoc env loc@(UnhelpfulSpan _)
+setCtLocEnvLoc env loc
| isGeneratedSrcSpan loc
= env { ctl_in_gen_code = True }
| otherwise
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -62,7 +62,7 @@ module GHC.Tc.Utils.Monad(
-- * Error management
getSrcCodeOrigin,
- getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,
+ getSrcSpanM, getRealSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,
inGeneratedCode,
wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,
wrapLocMA_,wrapLocMA,
@@ -1070,6 +1070,11 @@ getSrcSpanM :: TcRn SrcSpan
-- Avoid clash with Name.getSrcLoc
getSrcSpanM = do { env <- getLclEnv; return (RealSrcSpan (getLclEnvLoc env) Strict.Nothing) }
+getRealSrcSpanM :: TcRn RealSrcSpan
+ -- Avoid clash with Name.getSrcLoc
+getRealSrcSpanM = do { env <- getLclEnv; return $ getLclEnvLoc env }
+
+
-- See Note [Error contexts in generated code]
inGeneratedCode :: TcRn Bool
inGeneratedCode = lclEnvInGeneratedCode <$> getLclEnv
@@ -1079,7 +1084,7 @@ setSrcSpan :: SrcSpan -> TcRn a -> TcRn a
setSrcSpan (RealSrcSpan loc _) thing_inside
= updLclCtxt (\env -> env { tcl_loc = loc }) thing_inside
-setSrcSpan (UnhelpfulSpan _) thing_inside
+setSrcSpan _ thing_inside
= thing_inside
getSrcCodeOrigin :: TcRn (Maybe SrcCodeOrigin)
=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -787,7 +787,6 @@ getSeverityColour severity = case severity of
SevIgnore -> const mempty
getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc
-getCaretDiagnostic _ (UnhelpfulSpan _) = pure empty
getCaretDiagnostic msg_class (RealSrcSpan span _) =
caretDiagnostic <$> getSrcLine (srcSpanFile span) row
where
@@ -861,7 +860,7 @@ getCaretDiagnostic msg_class (RealSrcSpan span _) =
caretEllipsis | multiline = "..."
| otherwise = ""
caretLine = replicate start ' ' ++ replicate width '^' ++ caretEllipsis
-
+getCaretDiagnostic _ _ = pure empty
--
-- Queries
--
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -19,7 +19,7 @@ import GHC.Hs.Expr () -- instance Outputable
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Reader (RdrName,ImpDeclSpec (..), rdrNameOcc, rdrNameSpace)
-import GHC.Types.SrcLoc (SrcSpan(..), srcSpanStartLine)
+import GHC.Types.SrcLoc (SrcSpan(..), srcSpanStartLine, UnhelpfulSpanReason(..))
import GHC.Unit.Module.Imported (ImportedModsVal(..))
import GHC.Unit.Types
import GHC.Utils.Outputable
@@ -424,6 +424,7 @@ pprSimilarName mb_tried_ns (SimilarRdrName rdr_name _gre_info how_in_scope)
LocallyBoundAt loc ->
case loc of
UnhelpfulSpan l -> parens (ppr l)
+ GeneratedSrcSpan{} -> parens (ppr UnhelpfulGenerated)
RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
ImportedBy is ->
parens (text "imported from" <+> ppr (moduleName $ is_mod is))
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -2077,9 +2077,12 @@ bestImport iss = NE.head $ NE.sortBy best iss
-- False < True, so if e1 is explicit and e2 is not, we get GT
compareGenerated UnhelpfulSpan{} UnhelpfulSpan{} = EQ
- compareGenerated UnhelpfulSpan{} RealSrcSpan{} = LT
- compareGenerated RealSrcSpan{} UnhelpfulSpan{} = GT
+ compareGenerated UnhelpfulSpan{} _ = LT
+ compareGenerated GeneratedSrcSpan{} UnhelpfulSpan{} = GT
+ compareGenerated GeneratedSrcSpan{} GeneratedSrcSpan{} = EQ
+ compareGenerated GeneratedSrcSpan{} _ = LT
compareGenerated RealSrcSpan{} RealSrcSpan{} = EQ
+ compareGenerated RealSrcSpan{} _ = GT
{- Note [Choosing the best import declaration]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2212,6 +2215,7 @@ instance Outputable ImportSpec where
pprLoc :: SrcSpan -> SDoc
pprLoc (RealSrcSpan s _) = text "at" <+> ppr s
pprLoc (UnhelpfulSpan {}) = empty
+pprLoc (GeneratedSrcSpan {}) = empty
-- | Indicate if the given name is the "@" operator
opIsAt :: RdrName -> Bool
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -306,7 +306,7 @@ lookupSrcLoc (UnhelpfulLoc _) = const Nothing
lookupSrcSpan :: SrcSpan -> Map.Map RealSrcSpan a -> Maybe a
lookupSrcSpan (RealSrcSpan l _) = Map.lookup l
-lookupSrcSpan (UnhelpfulSpan _) = const Nothing
+lookupSrcSpan _ = const Nothing
instance Outputable RealSrcLoc where
ppr (SrcLoc (LexicalFastString src_path) src_line src_col)
@@ -387,6 +387,7 @@ instance Semigroup BufSpan where
-- or a human-readable description of a location.
data SrcSpan =
RealSrcSpan !RealSrcSpan !(Strict.Maybe BufSpan) -- See Note [Why Maybe BufPos]
+ | GeneratedSrcSpan !RealSrcSpan -- Needed for HIE
| UnhelpfulSpan !UnhelpfulSpanReason
deriving (Eq, Show) -- Show is used by GHC.Parser.Lexer, because we
@@ -426,6 +427,7 @@ messages, constructing a SrcSpan without a BufSpan.
instance ToJson SrcSpan where
json (UnhelpfulSpan {} ) = JSNull --JSObject [( "type", "unhelpful")]
+ json (GeneratedSrcSpan {}) = JSNull
json (RealSrcSpan rss _) = json rss
instance ToJson RealSrcSpan where
@@ -444,6 +446,7 @@ instance NFData RealSrcSpan where
instance NFData SrcSpan where
rnf (RealSrcSpan a1 a2) = rnf a1 `seq` rnf a2
rnf (UnhelpfulSpan a1) = rnf a1
+ rnf (GeneratedSrcSpan {}) = rnf UnhelpfulGenerated
instance NFData UnhelpfulSpanReason where
rnf (UnhelpfulNoLocationInfo) = ()
@@ -454,7 +457,8 @@ instance NFData UnhelpfulSpanReason where
getBufSpan :: SrcSpan -> Strict.Maybe BufSpan
getBufSpan (RealSrcSpan _ mbspan) = mbspan
-getBufSpan (UnhelpfulSpan _) = Strict.Nothing
+getBufSpan _ = Strict.Nothing
+
-- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
noSrcSpan, generatedSrcSpan, wiredInSrcSpan, interactiveSrcSpan :: SrcSpan
@@ -465,6 +469,7 @@ generatedSrcSpan = UnhelpfulSpan UnhelpfulGenerated
isGeneratedSrcSpan :: SrcSpan -> Bool
isGeneratedSrcSpan (UnhelpfulSpan UnhelpfulGenerated) = True
+isGeneratedSrcSpan (GeneratedSrcSpan{}) = True
isGeneratedSrcSpan _ = False
isNoSrcSpan :: SrcSpan -> Bool
@@ -515,6 +520,8 @@ mkSrcSpan (RealSrcLoc loc1 mbpos1) (RealSrcLoc loc2 mbpos2)
combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
combineSrcSpans l (UnhelpfulSpan _) = l
+combineSrcSpans (GeneratedSrcSpan _) r = r -- this seems more useful
+combineSrcSpans l (GeneratedSrcSpan _) = l
combineSrcSpans (RealSrcSpan span1 mbspan1) (RealSrcSpan span2 mbspan2)
| srcSpanFile span1 == srcSpanFile span2
= RealSrcSpan (combineRealSrcSpans span1 span2) (liftA2 combineBufSpans mbspan1 mbspan2)
@@ -543,6 +550,7 @@ combineBufSpans span1 span2 = BufSpan start end
-- | Convert a SrcSpan into one that represents only its first character
srcSpanFirstCharacter :: SrcSpan -> SrcSpan
srcSpanFirstCharacter l@(UnhelpfulSpan {}) = l
+srcSpanFirstCharacter l@(GeneratedSrcSpan {}) = l
srcSpanFirstCharacter (RealSrcSpan span mbspan) =
RealSrcSpan (mkRealSrcSpan loc1 loc2) (fmap mkBufSpan mbspan)
where
@@ -564,13 +572,13 @@ srcSpanFirstCharacter (RealSrcSpan span mbspan) =
-- | Test if a 'SrcSpan' is "good", i.e. has precise location information
isGoodSrcSpan :: SrcSpan -> Bool
isGoodSrcSpan (RealSrcSpan _ _) = True
-isGoodSrcSpan (UnhelpfulSpan _) = False
+isGoodSrcSpan _ = False
isOneLineSpan :: SrcSpan -> Bool
-- ^ True if the span is known to straddle only one line.
-- For "bad" 'SrcSpan', it returns False
isOneLineSpan (RealSrcSpan s _) = srcSpanStartLine s == srcSpanEndLine s
-isOneLineSpan (UnhelpfulSpan _) = False
+isOneLineSpan _ = False
isZeroWidthSpan :: SrcSpan -> Bool
-- ^ True if the span has a width of zero, as returned for "virtual"
@@ -578,7 +586,7 @@ isZeroWidthSpan :: SrcSpan -> Bool
-- For "bad" 'SrcSpan', it returns False
isZeroWidthSpan (RealSrcSpan s _) = srcSpanStartLine s == srcSpanEndLine s
&& srcSpanStartCol s == srcSpanEndCol s
-isZeroWidthSpan (UnhelpfulSpan _) = False
+isZeroWidthSpan _ = False
-- | Tests whether the first span "contains" the other span, meaning
-- that it covers at least as much source code. True where spans are equal.
@@ -620,11 +628,13 @@ srcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c
-- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanStart :: SrcSpan -> SrcLoc
srcSpanStart (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
+srcSpanStart (GeneratedSrcSpan{}) = UnhelpfulLoc (unhelpfulSpanFS UnhelpfulGenerated)
srcSpanStart (RealSrcSpan s b) = RealSrcLoc (realSrcSpanStart s) (fmap bufSpanStart b)
-- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanEnd :: SrcSpan -> SrcLoc
srcSpanEnd (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
+srcSpanEnd (GeneratedSrcSpan{}) = UnhelpfulLoc (unhelpfulSpanFS UnhelpfulGenerated)
srcSpanEnd (RealSrcSpan s b) = RealSrcLoc (realSrcSpanEnd s) (fmap bufSpanEnd b)
realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
@@ -640,7 +650,7 @@ realSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s)
-- | Obtains the filename for a 'SrcSpan' if it is "good"
srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
srcSpanFileName_maybe (RealSrcSpan s _) = Just (srcSpanFile s)
-srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing
+srcSpanFileName_maybe _ = Nothing
srcSpanToRealSrcSpan :: SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan (RealSrcSpan ss _) = Just ss
@@ -717,6 +727,7 @@ pprUnhelpfulSpanReason r = ftext (unhelpfulSpanFS r)
pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan _ (UnhelpfulSpan r) = pprUnhelpfulSpanReason r
+pprUserSpan _ (GeneratedSrcSpan{}) = pprUnhelpfulSpanReason UnhelpfulGenerated
pprUserSpan show_path (RealSrcSpan s _) = pprUserRealSpan show_path s
pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
@@ -843,15 +854,19 @@ leftmost_largest = compareSrcSpanBy $
compareSrcSpanBy :: (RealSrcSpan -> RealSrcSpan -> Ordering) -> SrcSpan -> SrcSpan -> Ordering
compareSrcSpanBy cmp (RealSrcSpan a _) (RealSrcSpan b _) = cmp a b
-compareSrcSpanBy _ (RealSrcSpan _ _) (UnhelpfulSpan _) = LT
+compareSrcSpanBy _ (RealSrcSpan _ _) _ = LT
compareSrcSpanBy _ (UnhelpfulSpan _) (RealSrcSpan _ _) = GT
-compareSrcSpanBy _ (UnhelpfulSpan _) (UnhelpfulSpan _) = EQ
+compareSrcSpanBy _ (UnhelpfulSpan _) _ = EQ
+compareSrcSpanBy _ (GeneratedSrcSpan _) (RealSrcSpan _ _) = GT
+compareSrcSpanBy _ (GeneratedSrcSpan _) _ = EQ
+
-- | Determines whether a span encloses a given line and column index
spans :: SrcSpan -> (Int, Int) -> Bool
-spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"
spans (RealSrcSpan span _) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span
where loc = mkRealSrcLoc (srcSpanFile span) l c
+spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"
+spans (GeneratedSrcSpan _) _ = panic "spans GeneratedSrcSpan"
-- | Determines whether a span is enclosed by another one
isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -1952,13 +1952,19 @@ instance Binary BinSrcSpan where
putByte bh 1
put_ bh s
+ put_ bh (BinSrcSpan (GeneratedSrcSpan ss)) = do
+ putByte bh 2
+ put_ bh $ BinSpan ss
+
get bh = do
h <- getByte bh
case h of
0 -> do BinSpan ss <- get bh
return $ BinSrcSpan (RealSrcSpan ss Strict.Nothing)
- _ -> do s <- get bh
+ 1 -> do s <- get bh
return $ BinSrcSpan (UnhelpfulSpan s)
+ _ -> do BinSpan ss <- get bh
+ return $ BinSrcSpan (GeneratedSrcSpan ss)
{-
=====================================
compiler/GHC/Utils/Logger.hs
=====================================
@@ -398,7 +398,7 @@ jsonLogActionWithHandle out logflags msg_class srcSpan msg
, ("endCol", json $ srcSpanEndCol rss)
]
where file = unpackFS $ srcSpanFile rss
- UnhelpfulSpan _ -> JSNull
+ _ -> JSNull
-- | The default 'LogAction' prints to 'stdout' and 'stderr'.
--
@@ -707,4 +707,3 @@ class HasLogger m where
class ContainsLogger t where
extractLogger :: t -> Logger
-
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -2692,8 +2692,9 @@ parseSpanArg s = do
-- @<filename>:(<line>,<col>)-(<line-end>,<col-end>)@
-- while simply unpacking 'UnhelpfulSpan's
showSrcSpan :: SrcSpan -> String
-showSrcSpan (UnhelpfulSpan s) = unpackFS (unhelpfulSpanFS s)
-showSrcSpan (RealSrcSpan spn _) = showRealSrcSpan spn
+showSrcSpan (UnhelpfulSpan s) = unpackFS (unhelpfulSpanFS s)
+showSrcSpan (GeneratedSrcSpan _) = unpackFS (unhelpfulSpanFS UnhelpfulGenerated)
+showSrcSpan (RealSrcSpan spn _) = showRealSrcSpan spn
-- | Variant of 'showSrcSpan' for 'RealSrcSpan's
showRealSrcSpan :: RealSrcSpan -> String
@@ -4235,14 +4236,14 @@ stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg
mb_span <- getCurrentBreakSpan
case mb_span of
Nothing -> stepCmd []
- Just (UnhelpfulSpan _) -> liftIO $ putStrLn ( -- #14690
- ":steplocal is not possible." ++
- "\nCannot determine current top-level binding after " ++
- "a break on error / exception.\nUse :stepmodule.")
- Just loc -> do
+ Just loc@(RealSrcSpan{}) -> do
md <- fromMaybe (panic "stepLocalCmd") <$> getCurrentBreakModule
current_toplevel_decl <- flip enclosingTickSpan loc <$> getTickArray md
doContinue (GHC.LocalStep (RealSrcSpan current_toplevel_decl Strict.Nothing))
+ Just _ -> liftIO $ putStrLn ( -- #14690
+ ":steplocal is not possible." ++
+ "\nCannot determine current top-level binding after " ++
+ "a break on error / exception.\nUse :stepmodule.")
stepModuleCmd :: GhciMonad m => String -> m ()
stepModuleCmd arg = withSandboxOnly ":stepmodule" $ step arg
@@ -4580,7 +4581,7 @@ listCmd "" = do
printForUser $ text "Not stopped at a breakpoint; nothing to list"
Just (RealSrcSpan pan _) ->
listAround pan True
- Just pan@(UnhelpfulSpan _) ->
+ Just pan@_ ->
do resumes <- GHC.getResumeContext
case resumes of
[] -> panic "No resumes"
=====================================
ghc/GHCi/UI/Info.hs
=====================================
@@ -168,6 +168,7 @@ findName infos span0 mi string =
Just name ->
case getSrcSpan name of
UnhelpfulSpan {} -> tryExternalModuleResolution
+ GeneratedSrcSpan {} -> tryExternalModuleResolution
RealSrcSpan {} -> return (getName name)
where
rdrs = modInfo_rdrs mi
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -477,6 +477,7 @@ enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
dp = adjustDeltaForOffset
off (ss2delta priorEndAfterComments r)
Just (EpaSpan (UnhelpfulSpan r)) -> panic $ "enterAnn: UnhelpfulSpan:" ++ show r
+ Just (EpaSpan (GeneratedSrcSpan r)) -> panic $ "enterAnn: UnhelpfulSpan:" ++ show r
when (isJust med) $ debugM $ "enterAnn:(med,edp)=" ++ showAst (med,edp)
when (isJust medr) $ setExtraDPReturn medr
-- ---------------------------------------------
@@ -737,7 +738,7 @@ printStringAtNC el str = do
printStringAtAAC :: (Monad m, Monoid w)
=> CaptureComments -> EpaLocation -> String -> EP w m EpaLocation
printStringAtAAC capture (EpaSpan (RealSrcSpan r _)) s = printStringAtRsC capture r s
-printStringAtAAC _capture (EpaSpan ss@(UnhelpfulSpan _)) _s = error $ "printStringAtAAC:ss=" ++ show ss
+printStringAtAAC _capture (EpaSpan ss) _s = error $ "printStringAtAAC:ss=" ++ show ss
printStringAtAAC capture (EpaDelta ss d cs) s = do
mapM_ printOneComment $ concatMap tokComment cs
pe1 <- getPriorEndD
@@ -1356,7 +1357,7 @@ printOneComment c@(Comment _str loc _r _mo) = do
let dp = ss2delta pe r
debugM $ "printOneComment:(dp,pe,loc)=" ++ showGhc (dp,pe,loc)
adjustDeltaForOffsetM dp
- EpaSpan (UnhelpfulSpan _) -> return (SameLine 0)
+ EpaSpan _ -> return (SameLine 0)
mep <- getExtraDP
dp' <- case mep of
Just (EpaDelta _ edp _) -> do
=====================================
utils/check-exact/Parsers.hs
=====================================
@@ -305,8 +305,6 @@ fixModuleHeaderComments (GHC.L l p) = GHC.L l p'
where
moveComments :: GHC.EpaLocation -> GHC.LHsDecl GHC.GhcPs -> GHC.EpAnnComments
-> (GHC.LHsDecl GHC.GhcPs, GHC.EpAnnComments)
- moveComments GHC.EpaDelta{} dd cs = (dd,cs)
- moveComments (GHC.EpaSpan (GHC.UnhelpfulSpan _)) dd cs = (dd,cs)
moveComments (GHC.EpaSpan (GHC.RealSrcSpan r _)) (GHC.L (GHC.EpAnn anc an csd) a) cs = (dd,css)
where
-- Move any comments on the decl that occur prior to the location
@@ -318,12 +316,14 @@ fixModuleHeaderComments (GHC.L l p) = GHC.L l p'
dd = GHC.L (GHC.EpAnn anc an csd') a
css = cs <> GHC.EpaComments move
+ moveComments _ dd cs = (dd,cs)
(ds',an') = rebalance (GHC.hsmodDecls p, GHC.hsmodAnn $ GHC.hsmodExt p)
p' = p { GHC.hsmodExt = (GHC.hsmodExt p){ GHC.hsmodAnn = an' },
GHC.hsmodDecls = ds'
}
+
rebalance :: ([GHC.LHsDecl GHC.GhcPs], GHC.EpAnn GHC.AnnsModule)
-> ([GHC.LHsDecl GHC.GhcPs], GHC.EpAnn GHC.AnnsModule)
rebalance (ds, GHC.EpAnn a an cs) = (ds1, GHC.EpAnn a an cs')
=====================================
utils/check-exact/Transform.hs
=====================================
@@ -255,6 +255,8 @@ setEntryDPDecl d dp = setEntryDP d dp
setEntryDP :: LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP (L (EpAnn (EpaSpan ss@(UnhelpfulSpan _)) an cs) a) dp
= L (EpAnn (EpaDelta ss dp []) an cs) a
+setEntryDP (L (EpAnn (EpaSpan ss@(GeneratedSrcSpan _)) an cs) a) dp
+ = L (EpAnn (EpaDelta ss dp []) an cs) a
setEntryDP (L (EpAnn (EpaSpan ss) an (EpaComments [])) a) dp
= L (EpAnn (EpaDelta ss dp []) an (EpaComments [])) a
setEntryDP (L (EpAnn (EpaDelta ss d csd) an cs) a) dp
@@ -320,14 +322,12 @@ getEntryDP _ = SameLine 1
addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta _off _anc (EpaDelta ss d cs) = EpaDelta ss d cs
-addEpaLocationDelta _off _anc (EpaSpan ss@(UnhelpfulSpan _)) = EpaDelta ss (SameLine 0) []
addEpaLocationDelta off anc (EpaSpan ss@(RealSrcSpan r _))
= EpaDelta ss (adjustDeltaForOffset off (ss2deltaEnd anc r)) []
+addEpaLocationDelta _off _anc (EpaSpan ss) = EpaDelta ss (SameLine 0) []
-- Set the entry DP for an element coming after an existing keyword annotation
setEntryDPFromAnchor :: LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t
-setEntryDPFromAnchor _off (EpaDelta _ _ _) (L la a) = L la a
-setEntryDPFromAnchor _off (EpaSpan (UnhelpfulSpan _)) (L la a) = L la a
setEntryDPFromAnchor off (EpaSpan (RealSrcSpan anc _)) ll@(L la _) = setEntryDP ll dp'
where
dp' = case la of
@@ -335,6 +335,8 @@ setEntryDPFromAnchor off (EpaSpan (RealSrcSpan anc _)) ll@(L la _) = setEntryDP
(EpAnn (EpaSpan _) _ _) -> adjustDeltaForOffset off (SameLine 0)
(EpAnn (EpaDelta _ dp _) _ _) -> adjustDeltaForOffset off dp
+setEntryDPFromAnchor _off _ ll = ll
+
-- ---------------------------------------------------------------------
-- |Take the annEntryDelta associated with the first item and
@@ -902,7 +904,7 @@ instance HasDecls (LocatedA (HsExpr GhcPs)) where
let
off = case l of
(EpaSpan (RealSrcSpan r _)) -> LayoutStartCol $ snd $ ss2pos r
- (EpaSpan (UnhelpfulSpan _)) -> LayoutStartCol 0
+ (EpaSpan _) -> LayoutStartCol 0
(EpaDelta _ (SameLine _) _) -> LayoutStartCol 0
(EpaDelta _ (DifferentLine _ c) _) -> LayoutStartCol c
ex'' = setEntryDPFromAnchor off i ex
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -530,9 +530,10 @@ sortEpaComments cs = sortBy cmp cs
-- | Makes a comment which originates from a specific keyword.
mkKWComment :: String -> NoCommentsLocation -> Comment
-mkKWComment kw (EpaSpan (RealSrcSpan ss mb)) = Comment kw (EpaSpan (RealSrcSpan ss mb)) ss (Just kw)
-mkKWComment kw (EpaSpan (UnhelpfulSpan _)) = Comment kw (EpaDelta noSrcSpan (SameLine 0) NoComments) placeholderRealSpan (Just kw)
mkKWComment kw (EpaDelta ss dp cs) = Comment kw (EpaDelta ss dp cs) placeholderRealSpan (Just kw)
+mkKWComment kw (EpaSpan (RealSrcSpan ss mb)) = Comment kw (EpaSpan (RealSrcSpan ss mb)) ss (Just kw)
+mkKWComment kw (EpaSpan _) = Comment kw (EpaDelta noSrcSpan (SameLine 0) NoComments) placeholderRealSpan (Just kw)
+
sortAnchorLocated :: [GenLocated EpaLocation a] -> [GenLocated EpaLocation a]
sortAnchorLocated = sortBy (compare `on` (epaLocationRealSrcSpan . getLoc))
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
=====================================
@@ -155,6 +155,53 @@ parse parserOpts sDocContext fpath bs = case unP (go False []) initState of
pure (plainTok : [spaceTok | not (BS.null spaceBStr)], inPrag')
+ GeneratedSrcSpan rsp -> do
+ let typ = if inPrag then TkPragma else classify tok
+ RealSrcLoc lStart _ = srcSpanStart sp -- safe since @sp@ is real
+ (spaceBStr, bStart) = spanPosition lInit lStart bInit
+ inPragDef = inPragma inPrag tok
+
+ (bEnd', inPrag') <- case tok of
+ -- Update internal line + file position if this is a LINE pragma
+ ITline_prag _ -> tryOrElse (bEnd, inPragDef) $ do
+ L _ (ITinteger (IL{il_value = line})) <- tryP wrappedLexer
+ L _ (ITstring _ file) <- tryP wrappedLexer
+ L spF ITclose_prag <- tryP wrappedLexer
+
+ let newLoc = mkRealSrcLoc file (fromIntegral line - 1) (srcSpanEndCol spF)
+ (bEnd'', _) <- lift getInput
+ lift $ setInput (bEnd'', newLoc)
+
+ pure (bEnd'', False)
+
+ -- Update internal column position if this is a COLUMN pragma
+ ITcolumn_prag _ -> tryOrElse (bEnd, inPragDef) $ do
+ L _ (ITinteger (IL{il_value = col})) <- tryP wrappedLexer
+ L spF ITclose_prag <- tryP wrappedLexer
+
+ let newLoc = mkRealSrcLoc (srcSpanFile spF) (srcSpanEndLine spF) (fromIntegral col)
+ (bEnd'', _) <- lift getInput
+ lift $ setInput (bEnd'', newLoc)
+
+ pure (bEnd'', False)
+ _ -> pure (bEnd, inPragDef)
+
+ let tokBStr = splitStringBuffer bStart bEnd'
+ plainTok =
+ T.Token
+ { tkType = typ
+ , tkValue = tokBStr
+ , tkSpan = rsp
+ }
+ spaceTok =
+ T.Token
+ { tkType = TkSpace
+ , tkValue = spaceBStr
+ , tkSpan = mkRealSrcSpan lInit lStart
+ }
+
+ pure (plainTok : [spaceTok | not (BS.null spaceBStr)], inPrag')
+
-- \| Parse whatever remains of the line as an unknown token (can't fail)
unknownLine :: P ([T.Token], Bool)
unknownLine = do
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
=====================================
@@ -103,6 +103,8 @@ spliceURL' maybe_mod maybe_name maybe_loc = run
case span_ of
RealSrcSpan span__ _ ->
show $ srcSpanStartLine span__
+ GeneratedSrcSpan span__ ->
+ show $ srcSpanStartLine span__
UnhelpfulSpan _ -> ""
run "" = ""
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d97779331b62b7813ea859753c5335…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d97779331b62b7813ea859753c5335…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/hie-spans] - Make a new variant `GeneratedSrcSpan` in `SrcSpan` for HIEAst Nodes
by Apoorv Ingle (＠ani) 22 Dec '25
by Apoorv Ingle (＠ani) 22 Dec '25
22 Dec '25
Apoorv Ingle pushed to branch wip/ani/hie-spans at Glasgow Haskell Compiler / GHC
Commits:
8b97de5b by Apoorv Ingle at 2025-12-22T16:55:56-06:00
- Make a new variant `GeneratedSrcSpan` in `SrcSpan` for HIEAst Nodes
- Fixes T23540
- - - - -
27 changed files:
- compiler/GHC.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Types/CtLoc.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/SrcLoc.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Logger.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -1617,6 +1617,7 @@ addSourceToTokens _ _ [] = []
addSourceToTokens loc buf (t@(L span _) : ts)
= case span of
UnhelpfulSpan _ -> (t,"") : addSourceToTokens loc buf ts
+ GeneratedSrcSpan _ -> (t,"") : addSourceToTokens loc buf ts
RealSrcSpan s _ -> (t,str) : addSourceToTokens newLoc newBuf ts
where
(newLoc, newBuf, str) = go "" loc buf
@@ -1637,12 +1638,14 @@ showRichTokenStream ts = go startLoc ts ""
where sourceFile = getFile $ map (getLoc . fst) ts
getFile [] = panic "showRichTokenStream: No source file found"
getFile (UnhelpfulSpan _ : xs) = getFile xs
+ getFile (GeneratedSrcSpan _ : xs) = getFile xs
getFile (RealSrcSpan s _ : _) = srcSpanFile s
startLoc = mkRealSrcLoc sourceFile 1 1
go _ [] = id
go loc ((L span _, str):ts)
= case span of
UnhelpfulSpan _ -> go loc ts
+ GeneratedSrcSpan _ -> go loc ts
RealSrcSpan s _
| locLine == tokLine -> ((replicate (tokCol - locCol) ' ') ++)
. (str ++)
=====================================
compiler/GHC/HsToCore/Monad.hs
=====================================
@@ -486,10 +486,10 @@ getSrcSpanDs = do { env <- getLclEnv
; return (RealSrcSpan (dsl_loc env) Strict.Nothing) }
putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
-putSrcSpanDs (UnhelpfulSpan {}) thing_inside
- = thing_inside
putSrcSpanDs (RealSrcSpan real_span _) thing_inside
= updLclEnv (\ env -> env {dsl_loc = real_span}) thing_inside
+putSrcSpanDs _ thing_inside
+ = thing_inside
putSrcSpanDsA :: EpAnn ann -> DsM a -> DsM a
putSrcSpanDsA loc = putSrcSpanDs (locA loc)
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -120,7 +120,7 @@ addTicksToBinds logger cfg
, blackList = Set.fromList $
mapMaybe (\tyCon -> case getSrcSpan (tyConName tyCon) of
RealSrcSpan l _ -> Just l
- UnhelpfulSpan _ -> Nothing)
+ _ -> Nothing)
tyCons
, density = mkDensity tickish $ ticks_profAuto cfg
, this_mod = mod
@@ -1191,7 +1191,7 @@ getFileName = fileName `liftM` getEnv
isGoodSrcSpan' :: SrcSpan -> Bool
isGoodSrcSpan' pos@(RealSrcSpan _ _) = srcSpanStart pos /= srcSpanEnd pos
-isGoodSrcSpan' (UnhelpfulSpan _) = False
+isGoodSrcSpan' _ = False
isGoodTickSrcSpan :: SrcSpan -> TM Bool
isGoodTickSrcSpan pos = do
@@ -1217,11 +1217,11 @@ bindLocals from (TM m) = TM $ \env st ->
withBlackListed :: SrcSpan -> TM a -> TM a
withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) })
-withBlackListed (UnhelpfulSpan _) = id
+withBlackListed _ = id
isBlackListed :: SrcSpan -> TM Bool
isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st)
-isBlackListed (UnhelpfulSpan _) = return False
+isBlackListed _ = return False
-- the tick application inherits the source position of its
-- expression argument to support nested box allocations
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -251,6 +251,11 @@ getUnlocatedEvBinds file = do
let node = Node (mkSourcedNodeInfo org ni) spn []
ni = NodeInfo mempty [] $ M.fromList [mkNodeInfo e]
in (xs,node:ys)
+ GeneratedSrcSpan spn
+ | srcSpanFile spn == file ->
+ let node = Node (mkSourcedNodeInfo org ni) spn []
+ ni = NodeInfo mempty [] $ M.fromList [mkNodeInfo e]
+ in (xs,node:ys)
_ -> (mkNodeInfo e : xs,ys)
(nis,asts) = foldr go ([],[]) elts
@@ -419,6 +424,7 @@ getRealSpanA la = getRealSpan (locA la)
getRealSpan :: SrcSpan -> Maybe Span
getRealSpan (RealSrcSpan sp _) = Just sp
+getRealSpan (GeneratedSrcSpan sp) = Just sp
getRealSpan _ = Nothing
grhss_span :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns)
@@ -606,36 +612,39 @@ instance ToHie (Context (Located a)) => ToHie (Context (LocatedN a)) where
instance ToHie (Context (Located a)) => ToHie (Context (LocatedA a)) where
toHie (C c (L l a)) = toHie (C c (L (locA l) a))
-instance ToHie (Context (Located Var)) where
- toHie c = case c of
- C context (L (RealSrcSpan span _) name')
- | varUnique name' == mkBuiltinUnique 1 -> pure []
- -- `mkOneRecordSelector` makes a field var using this unique, which we ignore
- | otherwise -> do
- m <- lift $ gets name_remapping
- org <- ask
- let name = case lookupNameEnv m (varName name') of
- Just var -> var
- Nothing-> name'
- ty = case isDataConId_maybe name' of
+toHieCtxLocVar :: ContextInfo -> RealSrcSpan -> Var -> HieM [HieAST Type]
+toHieCtxLocVar context span name'
+ | varUnique name' == mkBuiltinUnique 1 = pure []
+ -- `mkOneRecordSelector` makes a field var using this unique, which we ignore
+ | otherwise = do
+ m <- lift $ gets name_remapping
+ org <- ask
+ let name = case lookupNameEnv m (varName name') of
+ Just var -> var
+ Nothing-> name'
+ ty = case isDataConId_maybe name' of
Nothing -> varType name'
Just dc -> dataConWrapperType dc
-- insert the entity info for the name into the entity_infos map
- insertEntityInfo (varName name) $ idEntityInfo name
- insertEntityInfo (varName name') $ idEntityInfo name'
- pure
- [Node
- (mkSourcedNodeInfo org $ NodeInfo S.empty [] $
- M.singleton (Right $ varName name)
+ insertEntityInfo (varName name) $ idEntityInfo name
+ insertEntityInfo (varName name') $ idEntityInfo name'
+ pure [Node (mkSourcedNodeInfo org $ NodeInfo S.empty [] $
+ M.singleton (Right $ varName name)
(IdentifierDetails (Just ty)
(S.singleton context)))
- span
- []]
+ span
+ []]
+
+instance ToHie (Context (Located Var)) where
+ toHie c = case c of
+ C context (L (RealSrcSpan span _) name') -> toHieCtxLocVar context span name'
+ C context (L (GeneratedSrcSpan span) name') -> toHieCtxLocVar context span name'
C (EvidenceVarBind i _ sp) (L _ name) -> do
addUnlocatedEvBind name (EvidenceVarBind i ModuleScope sp)
pure []
_ -> pure []
+
instance ToHie (Context (Located Name)) where
toHie c = case c of
C context (L (RealSrcSpan span _) name')
=====================================
compiler/GHC/Iface/Ext/Utils.hs
=====================================
@@ -322,6 +322,16 @@ getNameScopeAndBinding n asts = case nameSrcSpan n of
scopes <- maybeToList $ foldMap getScopeFromContext (identInfo dets)
let binding = foldMap (First . getBindSiteFromContext) (identInfo dets)
return $ Just (scopes, getFirst binding)
+ GeneratedSrcSpan sp -> do -- @Maybe
+ ast <- M.lookup (HiePath (srcSpanFile sp)) asts
+ defNode <- selectLargestContainedBy sp ast
+ getFirst $ foldMap First $ do -- @[]
+ node <- flattenAst defNode
+ dets <- maybeToList
+ $ M.lookup (Right n) $ sourcedNodeIdents $ sourcedNodeInfo node
+ scopes <- maybeToList $ foldMap getScopeFromContext (identInfo dets)
+ let binding = foldMap (First . getBindSiteFromContext) (identInfo dets)
+ return $ Just (scopes, getFirst binding)
_ -> Nothing
getScopeFromContext :: ContextInfo -> Maybe [Scope]
@@ -377,6 +387,7 @@ selectSmallestContaining sp node
definedInAsts :: M.Map HiePath (HieAST a) -> Name -> Bool
definedInAsts asts n = case nameSrcSpan n of
RealSrcSpan sp _ -> M.member (HiePath (srcSpanFile sp)) asts
+ GeneratedSrcSpan sp -> M.member (HiePath (srcSpanFile sp)) asts
_ -> False
getEvidenceBindDeps :: ContextInfo -> [Name]
@@ -527,6 +538,10 @@ locOnly (RealSrcSpan span _) = do
org <- ask
let e = mkSourcedNodeInfo org $ emptyNodeInfo
pure [Node e span []]
+locOnly (GeneratedSrcSpan span) = do
+ org <- ask
+ let e = mkSourcedNodeInfo org $ emptyNodeInfo
+ pure [Node e span []]
locOnly _ = pure []
locOnlyE :: Monad m => EpaLocation -> ReaderT NodeOrigin m [HieAST a]
@@ -536,6 +551,7 @@ locOnlyE _ = pure []
mkScope :: (HasLoc a) => a -> Scope
mkScope a = case getHasLoc a of
(RealSrcSpan sp _) -> LocalScope sp
+ (GeneratedSrcSpan sp) -> LocalScope sp
_ -> NoScope
combineScopes :: Scope -> Scope -> Scope
@@ -567,6 +583,7 @@ makeNode x spn = do
org <- ask
pure $ case spn of
RealSrcSpan span _ -> [Node (mkSourcedNodeInfo org $ simpleNodeInfo cons typ) span []]
+ GeneratedSrcSpan span -> [Node (mkSourcedNodeInfo org $ simpleNodeInfo cons typ) span []]
_ -> []
where
cons = mkFastString . show . toConstr $ x
@@ -593,6 +610,8 @@ makeTypeNode x spn etyp = do
pure $ case spn of
RealSrcSpan span _ ->
[Node (mkSourcedNodeInfo org $ NodeInfo (S.singleton (NodeAnnotation cons typ)) [etyp] M.empty) span []]
+ GeneratedSrcSpan span ->
+ [Node (mkSourcedNodeInfo org $ NodeInfo (S.singleton (NodeAnnotation cons typ)) [etyp] M.empty) span []]
_ -> []
where
cons = mkFastString . show . toConstr $ x
=====================================
compiler/GHC/Parser/HaddockLex.x
=====================================
@@ -145,6 +145,7 @@ lexStringLiteral identParser (L l sl@(StringLiteral _ fs _))
plausibleIdents = case l of
RealSrcSpan span _ -> [(RealSrcSpan span' Strict.Nothing, tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) bs]
UnhelpfulSpan reason -> [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc bs]
+ GeneratedSrcSpan span -> [(GeneratedSrcSpan span, tok) | (_, tok) <- alexScanTokens fakeLoc bs]
fakeLoc = mkRealSrcLoc nilFS 0 0
@@ -166,6 +167,8 @@ lexHsDoc identParser doc =
= [(RealSrcSpan span' Strict.Nothing, tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) s]
plausibleIdents (L (UnhelpfulSpan reason) (HsDocStringChunk s))
= [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc s] -- preserve the original reason
+ plausibleIdents (L (GeneratedSrcSpan span) (HsDocStringChunk s))
+ = [(GeneratedSrcSpan span, tok) | (_, tok) <- alexScanTokens fakeLoc s] -- preserve the original reason
fakeLoc = mkRealSrcLoc nilFS 0 0
@@ -181,11 +184,12 @@ validateIdentWith identParser mloc str0 =
buffer = stringBufferFromByteString str0
realSrcLc = case mloc of
RealSrcSpan loc _ -> realSrcSpanStart loc
+ GeneratedSrcSpan{} -> mkRealSrcLoc nilFS 0 0
UnhelpfulSpan _ -> mkRealSrcLoc nilFS 0 0
pstate = initParserState pflags buffer realSrcLc
in case unP identParser pstate of
POk _ name -> Just $ case mloc of
RealSrcSpan _ _ -> reLoc name
- UnhelpfulSpan _ -> L mloc (unLoc name) -- Preserve the original reason
+ _ -> L mloc (unLoc name) -- Preserve the original reason
_ -> Nothing
}
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -502,11 +502,11 @@ rnExpr (ExplicitList _ exps)
then return (ExplicitList noExtField exps', fvs)
else
do { (from_list_n_name, fvs') <- lookupSyntaxName fromListNName
- --; loc <- getSrcSpanM -- See Note [Source locations for implicit function calls]
+ ; loc <- getRealSrcSpanM -- See Note [Source locations for implicit function calls]
; let rn_list = ExplicitList noExtField exps'
lit_n = mkIntegralLit (length exps)
hs_lit = genHsIntegralLit lit_n
- exp_list = genHsApps' (wrapGenSpan from_list_n_name) [hs_lit, wrapGenSpan rn_list]
+ exp_list = genHsApps' (wrapGenSpan' loc from_list_n_name) [hs_lit, wrapGenSpan rn_list]
; return ( mkExpandedExpr rn_list exp_list
, fvs `plusFV` fvs') } }
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -17,7 +17,7 @@ module GHC.Rename.Utils (
DeprecationWarnings(..), warnIfDeprecated,
checkUnusedRecordWildcard,
badQualBndrErr, typeAppErr, badFieldConErr,
- wrapGenSpan, wrapNoSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps', genHsExpApps,
+ wrapGenSpan, wrapGenSpan', wrapNoSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps', genHsExpApps,
genLHsApp, genAppType,
genLHsLit, genHsIntegralLit, genHsTyLit, genSimpleConPat,
genVarPat, genWildPat,
@@ -701,6 +701,9 @@ wrapGenSpan :: (HasAnnotation an) => a -> GenLocated an a
-- See Note [Rebindable syntax and XXExprGhcRn]
wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x
+wrapGenSpan' :: (HasAnnotation an) => RealSrcSpan -> a -> GenLocated an a
+wrapGenSpan' s x = L (noAnnSrcSpan $ GeneratedSrcSpan s) x
+
wrapNoSpan :: (HasAnnotation an) => a -> GenLocated an a
-- Wrap something in a "noSrcSpan"
-- See Note [Rebindable syntax and XXExprGhcRn]
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -1,4 +1,3 @@
-
-- | GHC API debugger module for finding and setting breakpoints.
--
-- This module is user facing and is at least used by `GHCi` and `ghc-debugger`
@@ -86,6 +85,7 @@ leftmostLargestRealSrcSpan = on compare realSrcSpanStart S.<> on (flip compare)
-- | Returns the span of the largest tick containing the srcspan given
enclosingTickSpan :: TickArray -> SrcSpan -> RealSrcSpan
enclosingTickSpan _ (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan"
+enclosingTickSpan _ (GeneratedSrcSpan _) = panic "generatedSrcSpan UnhelpfulSpan"
enclosingTickSpan ticks (RealSrcSpan src _) =
assert (inRange (bounds ticks) line) $
List.minimumBy leftmostLargestRealSrcSpan $ enclosing_spans
@@ -295,4 +295,3 @@ getCurrentBreakModule = do
return $ Just $ getBreakSourceMod ibi brks
ix ->
Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
-
=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -14,7 +14,7 @@ module GHC.Tc.Gen.Do (expandDoStmts) where
import GHC.Prelude
-import GHC.Rename.Utils ( wrapGenSpan, genHsExpApps, genHsApp, genHsLet,
+import GHC.Rename.Utils ( wrapGenSpan, wrapGenSpan', genHsExpApps, genHsApp, genHsLet,
genHsLamDoExp, genHsCaseAltDoExp, genWildPat )
import GHC.Rename.Env ( irrefutableConLikeRn )
@@ -114,18 +114,17 @@ expand_do_stmts doFlavour (stmt@(L loc (BindStmt xbsrn pat e)): lstmts)
| otherwise
= pprPanic "expand_do_stmts: The impossible happened, missing bind operator from renamer" (text "stmt" <+> ppr stmt)
-expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ (L _e_lspan e) (SyntaxExprRn then_op) _)) : lstmts) =
+expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ (L _ e) (SyntaxExprRn then_op) _)) : lstmts) =
-- See Note [BodyStmt] in Language.Haskell.Syntax.Expr
-- See Note [Expanding HsDo with XXExprGhcRn] Equation (1) below
-- stmts ~~> stmts'
-- ----------------------------------------------
-- e ; stmts ~~> (>>) e stmts'
- do expand_stmts_expr <- expand_do_stmts doFlavour lstmts
- let expansion = genHsExpApps then_op -- (>>)
- [ -- L e_lspan (mkExpandedStmt stmt doFlavour e)
- wrapGenSpan e
- , expand_stmts_expr ]
- return $ L loc (mkExpandedStmt stmt doFlavour expansion)
+ do expand_stmts_expr <- expand_do_stmts doFlavour lstmts
+ let expansion = genHsExpApps then_op -- (>>)
+ [ wrapGenSpan e
+ , expand_stmts_expr ]
+ return $ L loc (mkExpandedStmt stmt doFlavour expansion)
expand_do_stmts doFlavour
((L loc (RecStmt { recS_stmts = L stmts_loc rec_stmts
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -1480,9 +1480,11 @@ instance TH.Quasi TcM where
qLocation = do { m <- getModule
; l <- getSrcSpanM
; r <- case l of
+ RealSrcSpan s _ -> return s
+ GeneratedSrcSpan l -> pprPanic "qLocation: generatedSrcSpan"
+ (ppr l)
UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location"
(ppr l)
- RealSrcSpan s _ -> return s
; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r)
, TH.loc_module = moduleNameString (moduleName m)
, TH.loc_package = unitString (moduleUnit m)
=====================================
compiler/GHC/Tc/Types/CtLoc.hs
=====================================
@@ -253,8 +253,7 @@ setCtLocEnvLoc :: CtLocEnv -> SrcSpan -> CtLocEnv
-- for the ctl_in_gen_code manipulation
setCtLocEnvLoc env (RealSrcSpan loc _)
= env { ctl_loc = loc, ctl_in_gen_code = False }
-
-setCtLocEnvLoc env loc@(UnhelpfulSpan _)
+setCtLocEnvLoc env loc
| isGeneratedSrcSpan loc
= env { ctl_in_gen_code = True }
| otherwise
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -62,7 +62,7 @@ module GHC.Tc.Utils.Monad(
-- * Error management
getSrcCodeOrigin,
- getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,
+ getSrcSpanM, getRealSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,
inGeneratedCode,
wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,
wrapLocMA_,wrapLocMA,
@@ -1070,6 +1070,11 @@ getSrcSpanM :: TcRn SrcSpan
-- Avoid clash with Name.getSrcLoc
getSrcSpanM = do { env <- getLclEnv; return (RealSrcSpan (getLclEnvLoc env) Strict.Nothing) }
+getRealSrcSpanM :: TcRn RealSrcSpan
+ -- Avoid clash with Name.getSrcLoc
+getRealSrcSpanM = do { env <- getLclEnv; return $ getLclEnvLoc env }
+
+
-- See Note [Error contexts in generated code]
inGeneratedCode :: TcRn Bool
inGeneratedCode = lclEnvInGeneratedCode <$> getLclEnv
@@ -1079,7 +1084,7 @@ setSrcSpan :: SrcSpan -> TcRn a -> TcRn a
setSrcSpan (RealSrcSpan loc _) thing_inside
= updLclCtxt (\env -> env { tcl_loc = loc }) thing_inside
-setSrcSpan (UnhelpfulSpan _) thing_inside
+setSrcSpan _ thing_inside
= thing_inside
getSrcCodeOrigin :: TcRn (Maybe SrcCodeOrigin)
=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -787,7 +787,6 @@ getSeverityColour severity = case severity of
SevIgnore -> const mempty
getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc
-getCaretDiagnostic _ (UnhelpfulSpan _) = pure empty
getCaretDiagnostic msg_class (RealSrcSpan span _) =
caretDiagnostic <$> getSrcLine (srcSpanFile span) row
where
@@ -861,7 +860,7 @@ getCaretDiagnostic msg_class (RealSrcSpan span _) =
caretEllipsis | multiline = "..."
| otherwise = ""
caretLine = replicate start ' ' ++ replicate width '^' ++ caretEllipsis
-
+getCaretDiagnostic _ _ = pure empty
--
-- Queries
--
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -19,7 +19,7 @@ import GHC.Hs.Expr () -- instance Outputable
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Reader (RdrName,ImpDeclSpec (..), rdrNameOcc, rdrNameSpace)
-import GHC.Types.SrcLoc (SrcSpan(..), srcSpanStartLine)
+import GHC.Types.SrcLoc (SrcSpan(..), srcSpanStartLine, UnhelpfulSpanReason(..))
import GHC.Unit.Module.Imported (ImportedModsVal(..))
import GHC.Unit.Types
import GHC.Utils.Outputable
@@ -424,6 +424,7 @@ pprSimilarName mb_tried_ns (SimilarRdrName rdr_name _gre_info how_in_scope)
LocallyBoundAt loc ->
case loc of
UnhelpfulSpan l -> parens (ppr l)
+ GeneratedSrcSpan{} -> parens (ppr UnhelpfulGenerated)
RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l))
ImportedBy is ->
parens (text "imported from" <+> ppr (moduleName $ is_mod is))
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -2077,9 +2077,12 @@ bestImport iss = NE.head $ NE.sortBy best iss
-- False < True, so if e1 is explicit and e2 is not, we get GT
compareGenerated UnhelpfulSpan{} UnhelpfulSpan{} = EQ
- compareGenerated UnhelpfulSpan{} RealSrcSpan{} = LT
- compareGenerated RealSrcSpan{} UnhelpfulSpan{} = GT
+ compareGenerated UnhelpfulSpan{} _ = LT
+ compareGenerated GeneratedSrcSpan{} UnhelpfulSpan{} = GT
+ compareGenerated GeneratedSrcSpan{} GeneratedSrcSpan{} = EQ
+ compareGenerated GeneratedSrcSpan{} _ = LT
compareGenerated RealSrcSpan{} RealSrcSpan{} = EQ
+ compareGenerated RealSrcSpan{} _ = GT
{- Note [Choosing the best import declaration]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2212,6 +2215,7 @@ instance Outputable ImportSpec where
pprLoc :: SrcSpan -> SDoc
pprLoc (RealSrcSpan s _) = text "at" <+> ppr s
pprLoc (UnhelpfulSpan {}) = empty
+pprLoc (GeneratedSrcSpan {}) = empty
-- | Indicate if the given name is the "@" operator
opIsAt :: RdrName -> Bool
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -306,7 +306,7 @@ lookupSrcLoc (UnhelpfulLoc _) = const Nothing
lookupSrcSpan :: SrcSpan -> Map.Map RealSrcSpan a -> Maybe a
lookupSrcSpan (RealSrcSpan l _) = Map.lookup l
-lookupSrcSpan (UnhelpfulSpan _) = const Nothing
+lookupSrcSpan _ = const Nothing
instance Outputable RealSrcLoc where
ppr (SrcLoc (LexicalFastString src_path) src_line src_col)
@@ -387,6 +387,7 @@ instance Semigroup BufSpan where
-- or a human-readable description of a location.
data SrcSpan =
RealSrcSpan !RealSrcSpan !(Strict.Maybe BufSpan) -- See Note [Why Maybe BufPos]
+ | GeneratedSrcSpan !RealSrcSpan -- Needed for HIE
| UnhelpfulSpan !UnhelpfulSpanReason
deriving (Eq, Show) -- Show is used by GHC.Parser.Lexer, because we
@@ -426,6 +427,7 @@ messages, constructing a SrcSpan without a BufSpan.
instance ToJson SrcSpan where
json (UnhelpfulSpan {} ) = JSNull --JSObject [( "type", "unhelpful")]
+ json (GeneratedSrcSpan {}) = JSNull
json (RealSrcSpan rss _) = json rss
instance ToJson RealSrcSpan where
@@ -444,6 +446,7 @@ instance NFData RealSrcSpan where
instance NFData SrcSpan where
rnf (RealSrcSpan a1 a2) = rnf a1 `seq` rnf a2
rnf (UnhelpfulSpan a1) = rnf a1
+ rnf (GeneratedSrcSpan {}) = rnf UnhelpfulGenerated
instance NFData UnhelpfulSpanReason where
rnf (UnhelpfulNoLocationInfo) = ()
@@ -454,7 +457,8 @@ instance NFData UnhelpfulSpanReason where
getBufSpan :: SrcSpan -> Strict.Maybe BufSpan
getBufSpan (RealSrcSpan _ mbspan) = mbspan
-getBufSpan (UnhelpfulSpan _) = Strict.Nothing
+getBufSpan _ = Strict.Nothing
+
-- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
noSrcSpan, generatedSrcSpan, wiredInSrcSpan, interactiveSrcSpan :: SrcSpan
@@ -465,6 +469,7 @@ generatedSrcSpan = UnhelpfulSpan UnhelpfulGenerated
isGeneratedSrcSpan :: SrcSpan -> Bool
isGeneratedSrcSpan (UnhelpfulSpan UnhelpfulGenerated) = True
+isGeneratedSrcSpan (GeneratedSrcSpan{}) = True
isGeneratedSrcSpan _ = False
isNoSrcSpan :: SrcSpan -> Bool
@@ -515,6 +520,8 @@ mkSrcSpan (RealSrcLoc loc1 mbpos1) (RealSrcLoc loc2 mbpos2)
combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
combineSrcSpans l (UnhelpfulSpan _) = l
+combineSrcSpans (GeneratedSrcSpan _) r = r -- this seems more useful
+combineSrcSpans l (GeneratedSrcSpan _) = l
combineSrcSpans (RealSrcSpan span1 mbspan1) (RealSrcSpan span2 mbspan2)
| srcSpanFile span1 == srcSpanFile span2
= RealSrcSpan (combineRealSrcSpans span1 span2) (liftA2 combineBufSpans mbspan1 mbspan2)
@@ -543,6 +550,7 @@ combineBufSpans span1 span2 = BufSpan start end
-- | Convert a SrcSpan into one that represents only its first character
srcSpanFirstCharacter :: SrcSpan -> SrcSpan
srcSpanFirstCharacter l@(UnhelpfulSpan {}) = l
+srcSpanFirstCharacter l@(GeneratedSrcSpan {}) = l
srcSpanFirstCharacter (RealSrcSpan span mbspan) =
RealSrcSpan (mkRealSrcSpan loc1 loc2) (fmap mkBufSpan mbspan)
where
@@ -564,13 +572,13 @@ srcSpanFirstCharacter (RealSrcSpan span mbspan) =
-- | Test if a 'SrcSpan' is "good", i.e. has precise location information
isGoodSrcSpan :: SrcSpan -> Bool
isGoodSrcSpan (RealSrcSpan _ _) = True
-isGoodSrcSpan (UnhelpfulSpan _) = False
+isGoodSrcSpan _ = False
isOneLineSpan :: SrcSpan -> Bool
-- ^ True if the span is known to straddle only one line.
-- For "bad" 'SrcSpan', it returns False
isOneLineSpan (RealSrcSpan s _) = srcSpanStartLine s == srcSpanEndLine s
-isOneLineSpan (UnhelpfulSpan _) = False
+isOneLineSpan _ = False
isZeroWidthSpan :: SrcSpan -> Bool
-- ^ True if the span has a width of zero, as returned for "virtual"
@@ -578,7 +586,7 @@ isZeroWidthSpan :: SrcSpan -> Bool
-- For "bad" 'SrcSpan', it returns False
isZeroWidthSpan (RealSrcSpan s _) = srcSpanStartLine s == srcSpanEndLine s
&& srcSpanStartCol s == srcSpanEndCol s
-isZeroWidthSpan (UnhelpfulSpan _) = False
+isZeroWidthSpan _ = False
-- | Tests whether the first span "contains" the other span, meaning
-- that it covers at least as much source code. True where spans are equal.
@@ -620,11 +628,13 @@ srcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c
-- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanStart :: SrcSpan -> SrcLoc
srcSpanStart (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
+srcSpanStart (GeneratedSrcSpan{}) = UnhelpfulLoc (unhelpfulSpanFS UnhelpfulGenerated)
srcSpanStart (RealSrcSpan s b) = RealSrcLoc (realSrcSpanStart s) (fmap bufSpanStart b)
-- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanEnd :: SrcSpan -> SrcLoc
srcSpanEnd (UnhelpfulSpan r) = UnhelpfulLoc (unhelpfulSpanFS r)
+srcSpanEnd (GeneratedSrcSpan{}) = UnhelpfulLoc (unhelpfulSpanFS UnhelpfulGenerated)
srcSpanEnd (RealSrcSpan s b) = RealSrcLoc (realSrcSpanEnd s) (fmap bufSpanEnd b)
realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
@@ -640,7 +650,7 @@ realSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s)
-- | Obtains the filename for a 'SrcSpan' if it is "good"
srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
srcSpanFileName_maybe (RealSrcSpan s _) = Just (srcSpanFile s)
-srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing
+srcSpanFileName_maybe _ = Nothing
srcSpanToRealSrcSpan :: SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan (RealSrcSpan ss _) = Just ss
@@ -717,6 +727,7 @@ pprUnhelpfulSpanReason r = ftext (unhelpfulSpanFS r)
pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan _ (UnhelpfulSpan r) = pprUnhelpfulSpanReason r
+pprUserSpan _ (GeneratedSrcSpan{}) = pprUnhelpfulSpanReason UnhelpfulGenerated
pprUserSpan show_path (RealSrcSpan s _) = pprUserRealSpan show_path s
pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
@@ -843,15 +854,19 @@ leftmost_largest = compareSrcSpanBy $
compareSrcSpanBy :: (RealSrcSpan -> RealSrcSpan -> Ordering) -> SrcSpan -> SrcSpan -> Ordering
compareSrcSpanBy cmp (RealSrcSpan a _) (RealSrcSpan b _) = cmp a b
-compareSrcSpanBy _ (RealSrcSpan _ _) (UnhelpfulSpan _) = LT
+compareSrcSpanBy _ (RealSrcSpan _ _) _ = LT
compareSrcSpanBy _ (UnhelpfulSpan _) (RealSrcSpan _ _) = GT
-compareSrcSpanBy _ (UnhelpfulSpan _) (UnhelpfulSpan _) = EQ
+compareSrcSpanBy _ (UnhelpfulSpan _) _ = EQ
+compareSrcSpanBy _ (GeneratedSrcSpan _) (RealSrcSpan _ _) = GT
+compareSrcSpanBy _ (GeneratedSrcSpan _) _ = EQ
+
-- | Determines whether a span encloses a given line and column index
spans :: SrcSpan -> (Int, Int) -> Bool
-spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"
spans (RealSrcSpan span _) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span
where loc = mkRealSrcLoc (srcSpanFile span) l c
+spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"
+spans (GeneratedSrcSpan _) _ = panic "spans GeneratedSrcSpan"
-- | Determines whether a span is enclosed by another one
isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -1952,13 +1952,19 @@ instance Binary BinSrcSpan where
putByte bh 1
put_ bh s
+ put_ bh (BinSrcSpan (GeneratedSrcSpan ss)) = do
+ putByte bh 2
+ put_ bh $ BinSpan ss
+
get bh = do
h <- getByte bh
case h of
0 -> do BinSpan ss <- get bh
return $ BinSrcSpan (RealSrcSpan ss Strict.Nothing)
- _ -> do s <- get bh
+ 1 -> do s <- get bh
return $ BinSrcSpan (UnhelpfulSpan s)
+ _ -> do BinSpan ss <- get bh
+ return $ BinSrcSpan (GeneratedSrcSpan ss)
{-
=====================================
compiler/GHC/Utils/Logger.hs
=====================================
@@ -398,7 +398,7 @@ jsonLogActionWithHandle out logflags msg_class srcSpan msg
, ("endCol", json $ srcSpanEndCol rss)
]
where file = unpackFS $ srcSpanFile rss
- UnhelpfulSpan _ -> JSNull
+ _ -> JSNull
-- | The default 'LogAction' prints to 'stdout' and 'stderr'.
--
@@ -707,4 +707,3 @@ class HasLogger m where
class ContainsLogger t where
extractLogger :: t -> Logger
-
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -2692,8 +2692,9 @@ parseSpanArg s = do
-- @<filename>:(<line>,<col>)-(<line-end>,<col-end>)@
-- while simply unpacking 'UnhelpfulSpan's
showSrcSpan :: SrcSpan -> String
-showSrcSpan (UnhelpfulSpan s) = unpackFS (unhelpfulSpanFS s)
-showSrcSpan (RealSrcSpan spn _) = showRealSrcSpan spn
+showSrcSpan (UnhelpfulSpan s) = unpackFS (unhelpfulSpanFS s)
+showSrcSpan (GeneratedSrcSpan _) = unpackFS (unhelpfulSpanFS UnhelpfulGenerated)
+showSrcSpan (RealSrcSpan spn _) = showRealSrcSpan spn
-- | Variant of 'showSrcSpan' for 'RealSrcSpan's
showRealSrcSpan :: RealSrcSpan -> String
@@ -4235,14 +4236,14 @@ stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg
mb_span <- getCurrentBreakSpan
case mb_span of
Nothing -> stepCmd []
- Just (UnhelpfulSpan _) -> liftIO $ putStrLn ( -- #14690
- ":steplocal is not possible." ++
- "\nCannot determine current top-level binding after " ++
- "a break on error / exception.\nUse :stepmodule.")
- Just loc -> do
+ Just loc@(RealSrcSpan{}) -> do
md <- fromMaybe (panic "stepLocalCmd") <$> getCurrentBreakModule
current_toplevel_decl <- flip enclosingTickSpan loc <$> getTickArray md
doContinue (GHC.LocalStep (RealSrcSpan current_toplevel_decl Strict.Nothing))
+ Just _ -> liftIO $ putStrLn ( -- #14690
+ ":steplocal is not possible." ++
+ "\nCannot determine current top-level binding after " ++
+ "a break on error / exception.\nUse :stepmodule.")
stepModuleCmd :: GhciMonad m => String -> m ()
stepModuleCmd arg = withSandboxOnly ":stepmodule" $ step arg
@@ -4580,7 +4581,7 @@ listCmd "" = do
printForUser $ text "Not stopped at a breakpoint; nothing to list"
Just (RealSrcSpan pan _) ->
listAround pan True
- Just pan@(UnhelpfulSpan _) ->
+ Just pan@_ ->
do resumes <- GHC.getResumeContext
case resumes of
[] -> panic "No resumes"
=====================================
ghc/GHCi/UI/Info.hs
=====================================
@@ -168,6 +168,7 @@ findName infos span0 mi string =
Just name ->
case getSrcSpan name of
UnhelpfulSpan {} -> tryExternalModuleResolution
+ GeneratedSrcSpan {} -> tryExternalModuleResolution
RealSrcSpan {} -> return (getName name)
where
rdrs = modInfo_rdrs mi
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -477,6 +477,7 @@ enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
dp = adjustDeltaForOffset
off (ss2delta priorEndAfterComments r)
Just (EpaSpan (UnhelpfulSpan r)) -> panic $ "enterAnn: UnhelpfulSpan:" ++ show r
+ Just (EpaSpan (GeneratedSrcSpan r)) -> panic $ "enterAnn: UnhelpfulSpan:" ++ show r
when (isJust med) $ debugM $ "enterAnn:(med,edp)=" ++ showAst (med,edp)
when (isJust medr) $ setExtraDPReturn medr
-- ---------------------------------------------
@@ -737,7 +738,7 @@ printStringAtNC el str = do
printStringAtAAC :: (Monad m, Monoid w)
=> CaptureComments -> EpaLocation -> String -> EP w m EpaLocation
printStringAtAAC capture (EpaSpan (RealSrcSpan r _)) s = printStringAtRsC capture r s
-printStringAtAAC _capture (EpaSpan ss@(UnhelpfulSpan _)) _s = error $ "printStringAtAAC:ss=" ++ show ss
+printStringAtAAC _capture (EpaSpan ss) _s = error $ "printStringAtAAC:ss=" ++ show ss
printStringAtAAC capture (EpaDelta ss d cs) s = do
mapM_ printOneComment $ concatMap tokComment cs
pe1 <- getPriorEndD
@@ -1356,7 +1357,7 @@ printOneComment c@(Comment _str loc _r _mo) = do
let dp = ss2delta pe r
debugM $ "printOneComment:(dp,pe,loc)=" ++ showGhc (dp,pe,loc)
adjustDeltaForOffsetM dp
- EpaSpan (UnhelpfulSpan _) -> return (SameLine 0)
+ EpaSpan _ -> return (SameLine 0)
mep <- getExtraDP
dp' <- case mep of
Just (EpaDelta _ edp _) -> do
=====================================
utils/check-exact/Parsers.hs
=====================================
@@ -305,8 +305,6 @@ fixModuleHeaderComments (GHC.L l p) = GHC.L l p'
where
moveComments :: GHC.EpaLocation -> GHC.LHsDecl GHC.GhcPs -> GHC.EpAnnComments
-> (GHC.LHsDecl GHC.GhcPs, GHC.EpAnnComments)
- moveComments GHC.EpaDelta{} dd cs = (dd,cs)
- moveComments (GHC.EpaSpan (GHC.UnhelpfulSpan _)) dd cs = (dd,cs)
moveComments (GHC.EpaSpan (GHC.RealSrcSpan r _)) (GHC.L (GHC.EpAnn anc an csd) a) cs = (dd,css)
where
-- Move any comments on the decl that occur prior to the location
@@ -318,12 +316,14 @@ fixModuleHeaderComments (GHC.L l p) = GHC.L l p'
dd = GHC.L (GHC.EpAnn anc an csd') a
css = cs <> GHC.EpaComments move
+ moveComments _ dd cs = (dd,cs)
(ds',an') = rebalance (GHC.hsmodDecls p, GHC.hsmodAnn $ GHC.hsmodExt p)
p' = p { GHC.hsmodExt = (GHC.hsmodExt p){ GHC.hsmodAnn = an' },
GHC.hsmodDecls = ds'
}
+
rebalance :: ([GHC.LHsDecl GHC.GhcPs], GHC.EpAnn GHC.AnnsModule)
-> ([GHC.LHsDecl GHC.GhcPs], GHC.EpAnn GHC.AnnsModule)
rebalance (ds, GHC.EpAnn a an cs) = (ds1, GHC.EpAnn a an cs')
=====================================
utils/check-exact/Transform.hs
=====================================
@@ -255,6 +255,8 @@ setEntryDPDecl d dp = setEntryDP d dp
setEntryDP :: LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP (L (EpAnn (EpaSpan ss@(UnhelpfulSpan _)) an cs) a) dp
= L (EpAnn (EpaDelta ss dp []) an cs) a
+setEntryDP (L (EpAnn (EpaSpan ss@(GeneratedSrcSpan _)) an cs) a) dp
+ = L (EpAnn (EpaDelta ss dp []) an cs) a
setEntryDP (L (EpAnn (EpaSpan ss) an (EpaComments [])) a) dp
= L (EpAnn (EpaDelta ss dp []) an (EpaComments [])) a
setEntryDP (L (EpAnn (EpaDelta ss d csd) an cs) a) dp
@@ -320,14 +322,12 @@ getEntryDP _ = SameLine 1
addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta _off _anc (EpaDelta ss d cs) = EpaDelta ss d cs
-addEpaLocationDelta _off _anc (EpaSpan ss@(UnhelpfulSpan _)) = EpaDelta ss (SameLine 0) []
addEpaLocationDelta off anc (EpaSpan ss@(RealSrcSpan r _))
= EpaDelta ss (adjustDeltaForOffset off (ss2deltaEnd anc r)) []
+addEpaLocationDelta _off _anc (EpaSpan ss) = EpaDelta ss (SameLine 0) []
-- Set the entry DP for an element coming after an existing keyword annotation
setEntryDPFromAnchor :: LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t
-setEntryDPFromAnchor _off (EpaDelta _ _ _) (L la a) = L la a
-setEntryDPFromAnchor _off (EpaSpan (UnhelpfulSpan _)) (L la a) = L la a
setEntryDPFromAnchor off (EpaSpan (RealSrcSpan anc _)) ll@(L la _) = setEntryDP ll dp'
where
dp' = case la of
@@ -335,6 +335,8 @@ setEntryDPFromAnchor off (EpaSpan (RealSrcSpan anc _)) ll@(L la _) = setEntryDP
(EpAnn (EpaSpan _) _ _) -> adjustDeltaForOffset off (SameLine 0)
(EpAnn (EpaDelta _ dp _) _ _) -> adjustDeltaForOffset off dp
+setEntryDPFromAnchor _off _ ll = ll
+
-- ---------------------------------------------------------------------
-- |Take the annEntryDelta associated with the first item and
@@ -902,7 +904,7 @@ instance HasDecls (LocatedA (HsExpr GhcPs)) where
let
off = case l of
(EpaSpan (RealSrcSpan r _)) -> LayoutStartCol $ snd $ ss2pos r
- (EpaSpan (UnhelpfulSpan _)) -> LayoutStartCol 0
+ (EpaSpan _) -> LayoutStartCol 0
(EpaDelta _ (SameLine _) _) -> LayoutStartCol 0
(EpaDelta _ (DifferentLine _ c) _) -> LayoutStartCol c
ex'' = setEntryDPFromAnchor off i ex
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -530,9 +530,10 @@ sortEpaComments cs = sortBy cmp cs
-- | Makes a comment which originates from a specific keyword.
mkKWComment :: String -> NoCommentsLocation -> Comment
-mkKWComment kw (EpaSpan (RealSrcSpan ss mb)) = Comment kw (EpaSpan (RealSrcSpan ss mb)) ss (Just kw)
-mkKWComment kw (EpaSpan (UnhelpfulSpan _)) = Comment kw (EpaDelta noSrcSpan (SameLine 0) NoComments) placeholderRealSpan (Just kw)
mkKWComment kw (EpaDelta ss dp cs) = Comment kw (EpaDelta ss dp cs) placeholderRealSpan (Just kw)
+mkKWComment kw (EpaSpan (RealSrcSpan ss mb)) = Comment kw (EpaSpan (RealSrcSpan ss mb)) ss (Just kw)
+mkKWComment kw (EpaSpan _) = Comment kw (EpaDelta noSrcSpan (SameLine 0) NoComments) placeholderRealSpan (Just kw)
+
sortAnchorLocated :: [GenLocated EpaLocation a] -> [GenLocated EpaLocation a]
sortAnchorLocated = sortBy (compare `on` (epaLocationRealSrcSpan . getLoc))
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
=====================================
@@ -155,6 +155,53 @@ parse parserOpts sDocContext fpath bs = case unP (go False []) initState of
pure (plainTok : [spaceTok | not (BS.null spaceBStr)], inPrag')
+ GeneratedSrcSpan rsp -> do
+ let typ = if inPrag then TkPragma else classify tok
+ RealSrcLoc lStart _ = srcSpanStart sp -- safe since @sp@ is real
+ (spaceBStr, bStart) = spanPosition lInit lStart bInit
+ inPragDef = inPragma inPrag tok
+
+ (bEnd', inPrag') <- case tok of
+ -- Update internal line + file position if this is a LINE pragma
+ ITline_prag _ -> tryOrElse (bEnd, inPragDef) $ do
+ L _ (ITinteger (IL{il_value = line})) <- tryP wrappedLexer
+ L _ (ITstring _ file) <- tryP wrappedLexer
+ L spF ITclose_prag <- tryP wrappedLexer
+
+ let newLoc = mkRealSrcLoc file (fromIntegral line - 1) (srcSpanEndCol spF)
+ (bEnd'', _) <- lift getInput
+ lift $ setInput (bEnd'', newLoc)
+
+ pure (bEnd'', False)
+
+ -- Update internal column position if this is a COLUMN pragma
+ ITcolumn_prag _ -> tryOrElse (bEnd, inPragDef) $ do
+ L _ (ITinteger (IL{il_value = col})) <- tryP wrappedLexer
+ L spF ITclose_prag <- tryP wrappedLexer
+
+ let newLoc = mkRealSrcLoc (srcSpanFile spF) (srcSpanEndLine spF) (fromIntegral col)
+ (bEnd'', _) <- lift getInput
+ lift $ setInput (bEnd'', newLoc)
+
+ pure (bEnd'', False)
+ _ -> pure (bEnd, inPragDef)
+
+ let tokBStr = splitStringBuffer bStart bEnd'
+ plainTok =
+ T.Token
+ { tkType = typ
+ , tkValue = tokBStr
+ , tkSpan = rsp
+ }
+ spaceTok =
+ T.Token
+ { tkType = TkSpace
+ , tkValue = spaceBStr
+ , tkSpan = mkRealSrcSpan lInit lStart
+ }
+
+ pure (plainTok : [spaceTok | not (BS.null spaceBStr)], inPrag')
+
-- \| Parse whatever remains of the line as an unknown token (can't fail)
unknownLine :: P ([T.Token], Bool)
unknownLine = do
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
=====================================
@@ -103,6 +103,8 @@ spliceURL' maybe_mod maybe_name maybe_loc = run
case span_ of
RealSrcSpan span__ _ ->
show $ srcSpanStartLine span__
+ GeneratedSrcSpan span__ ->
+ show $ srcSpanStartLine span__
UnhelpfulSpan _ -> ""
run "" = ""
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b97de5bd2cfdeed11c36347a4a0b6d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b97de5bd2cfdeed11c36347a4a0b6d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
22 Dec '25
Apoorv Ingle pushed to branch wip/ani/hie-spans at Glasgow Haskell Compiler / GHC
Commits:
22ebe332 by Apoorv Ingle at 2025-12-22T16:35:40-06:00
fixes for check-exact
- - - - -
5 changed files:
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Tc/Gen/Do.hs
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Transform.hs
Changes:
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -612,59 +612,39 @@ instance ToHie (Context (Located a)) => ToHie (Context (LocatedN a)) where
instance ToHie (Context (Located a)) => ToHie (Context (LocatedA a)) where
toHie (C c (L l a)) = toHie (C c (L (locA l) a))
-instance ToHie (Context (Located Var)) where
- toHie c = case c of
- C context (L (RealSrcSpan span _) name')
- | varUnique name' == mkBuiltinUnique 1 -> pure []
- -- `mkOneRecordSelector` makes a field var using this unique, which we ignore
- | otherwise -> do
- m <- lift $ gets name_remapping
- org <- ask
- let name = case lookupNameEnv m (varName name') of
- Just var -> var
- Nothing-> name'
- ty = case isDataConId_maybe name' of
- Nothing -> varType name'
- Just dc -> dataConWrapperType dc
- -- insert the entity info for the name into the entity_infos map
- insertEntityInfo (varName name) $ idEntityInfo name
- insertEntityInfo (varName name') $ idEntityInfo name'
- pure
- [Node
- (mkSourcedNodeInfo org $ NodeInfo S.empty [] $
- M.singleton (Right $ varName name)
- (IdentifierDetails (Just ty)
- (S.singleton context)))
- span
- []]
- C context (L (GeneratedSrcSpan span) name')
- | varUnique name' == mkBuiltinUnique 1 -> pure []
- -- `mkOneRecordSelector` makes a field var using this unique, which we ignore
- | otherwise -> do
- m <- lift $ gets name_remapping
- org <- ask
- let name = case lookupNameEnv m (varName name') of
- Just var -> var
- Nothing-> name'
- ty = case isDataConId_maybe name' of
+toHieCtxLocVar :: ContextInfo -> RealSrcSpan -> Var -> HieM [HieAST Type]
+toHieCtxLocVar context span name'
+ | varUnique name' == mkBuiltinUnique 1 = pure []
+ -- `mkOneRecordSelector` makes a field var using this unique, which we ignore
+ | otherwise = do
+ m <- lift $ gets name_remapping
+ org <- ask
+ let name = case lookupNameEnv m (varName name') of
+ Just var -> var
+ Nothing-> name'
+ ty = case isDataConId_maybe name' of
Nothing -> varType name'
Just dc -> dataConWrapperType dc
-- insert the entity info for the name into the entity_infos map
- insertEntityInfo (varName name) $ idEntityInfo name
- insertEntityInfo (varName name') $ idEntityInfo name'
- pure
- [Node
- (mkSourcedNodeInfo org $ NodeInfo S.empty [] $
- M.singleton (Right $ varName name)
+ insertEntityInfo (varName name) $ idEntityInfo name
+ insertEntityInfo (varName name') $ idEntityInfo name'
+ pure [Node (mkSourcedNodeInfo org $ NodeInfo S.empty [] $
+ M.singleton (Right $ varName name)
(IdentifierDetails (Just ty)
(S.singleton context)))
- span
- []]
+ span
+ []]
+
+instance ToHie (Context (Located Var)) where
+ toHie c = case c of
+ C context (L (RealSrcSpan span _) name') -> toHieCtxLocVar context span name'
+ C context (L (GeneratedSrcSpan span) name') -> toHieCtxLocVar context span name'
C (EvidenceVarBind i _ sp) (L _ name) -> do
addUnlocatedEvBind name (EvidenceVarBind i ModuleScope sp)
pure []
_ -> pure []
+
instance ToHie (Context (Located Name)) where
toHie c = case c of
C context (L (RealSrcSpan span _) name')
@@ -687,26 +667,6 @@ instance ToHie (Context (Located Name)) where
(S.singleton context)))
span
[]]
- -- C context (L (GeneratedSrcSpan span) name')
- -- | nameUnique name' == mkBuiltinUnique 1 -> pure []
- -- -- `mkOneRecordSelector` makes a field var using this unique, which we ignore
- -- | otherwise -> do
- -- m <- lift $ gets name_remapping
- -- org <- ask
- -- let name = case lookupNameEnv m name' of
- -- Just var -> varName var
- -- Nothing -> name'
- -- -- insert the entity info for the name into the entity_infos map
- -- lookupAndInsertEntityName name
- -- lookupAndInsertEntityName name'
- -- pure
- -- [Node
- -- (mkSourcedNodeInfo org $ NodeInfo S.empty [] $
- -- M.singleton (Right name)
- -- (IdentifierDetails Nothing
- -- (S.singleton context)))
- -- span
- -- []]
_ -> pure []
instance ToHie (Context (Located (WithUserRdr Name))) where
=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -114,20 +114,12 @@ expand_do_stmts doFlavour (stmt@(L loc (BindStmt xbsrn pat e)): lstmts)
| otherwise
= pprPanic "expand_do_stmts: The impossible happened, missing bind operator from renamer" (text "stmt" <+> ppr stmt)
-expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ (L _e_lspan e) (SyntaxExprRn then_op) _)) : lstmts)
+expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ (L _ e) (SyntaxExprRn then_op) _)) : lstmts) =
-- See Note [BodyStmt] in Language.Haskell.Syntax.Expr
-- See Note [Expanding HsDo with XXExprGhcRn] Equation (1) below
-- stmts ~~> stmts'
-- ----------------------------------------------
-- e ; stmts ~~> (>>) e stmts'
- | RealSrcSpan sp _ <- locA loc =
- do expand_stmts_expr <- expand_do_stmts doFlavour lstmts
- let expansion = mkHsApps (wrapGenSpan' sp then_op) -- (>>)
- [ wrapGenSpan e
- , expand_stmts_expr ]
- return $ L loc (mkExpandedStmt stmt doFlavour (unLoc $ expansion))
-
- | otherwise =
do expand_stmts_expr <- expand_do_stmts doFlavour lstmts
let expansion = genHsExpApps then_op -- (>>)
[ wrapGenSpan e
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -477,6 +477,7 @@ enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
dp = adjustDeltaForOffset
off (ss2delta priorEndAfterComments r)
Just (EpaSpan (UnhelpfulSpan r)) -> panic $ "enterAnn: UnhelpfulSpan:" ++ show r
+ Just (EpaSpan (GeneratedSrcSpan r)) -> panic $ "enterAnn: UnhelpfulSpan:" ++ show r
when (isJust med) $ debugM $ "enterAnn:(med,edp)=" ++ showAst (med,edp)
when (isJust medr) $ setExtraDPReturn medr
-- ---------------------------------------------
@@ -737,7 +738,7 @@ printStringAtNC el str = do
printStringAtAAC :: (Monad m, Monoid w)
=> CaptureComments -> EpaLocation -> String -> EP w m EpaLocation
printStringAtAAC capture (EpaSpan (RealSrcSpan r _)) s = printStringAtRsC capture r s
-printStringAtAAC _capture (EpaSpan ss@(UnhelpfulSpan _)) _s = error $ "printStringAtAAC:ss=" ++ show ss
+printStringAtAAC _capture (EpaSpan ss) _s = error $ "printStringAtAAC:ss=" ++ show ss
printStringAtAAC capture (EpaDelta ss d cs) s = do
mapM_ printOneComment $ concatMap tokComment cs
pe1 <- getPriorEndD
@@ -1356,7 +1357,7 @@ printOneComment c@(Comment _str loc _r _mo) = do
let dp = ss2delta pe r
debugM $ "printOneComment:(dp,pe,loc)=" ++ showGhc (dp,pe,loc)
adjustDeltaForOffsetM dp
- EpaSpan (UnhelpfulSpan _) -> return (SameLine 0)
+ EpaSpan _ -> return (SameLine 0)
mep <- getExtraDP
dp' <- case mep of
Just (EpaDelta _ edp _) -> do
=====================================
utils/check-exact/Parsers.hs
=====================================
@@ -305,8 +305,6 @@ fixModuleHeaderComments (GHC.L l p) = GHC.L l p'
where
moveComments :: GHC.EpaLocation -> GHC.LHsDecl GHC.GhcPs -> GHC.EpAnnComments
-> (GHC.LHsDecl GHC.GhcPs, GHC.EpAnnComments)
- moveComments GHC.EpaDelta{} dd cs = (dd,cs)
- moveComments (GHC.EpaSpan (GHC.UnhelpfulSpan _)) dd cs = (dd,cs)
moveComments (GHC.EpaSpan (GHC.RealSrcSpan r _)) (GHC.L (GHC.EpAnn anc an csd) a) cs = (dd,css)
where
-- Move any comments on the decl that occur prior to the location
@@ -318,12 +316,14 @@ fixModuleHeaderComments (GHC.L l p) = GHC.L l p'
dd = GHC.L (GHC.EpAnn anc an csd') a
css = cs <> GHC.EpaComments move
+ moveComments _ dd cs = (dd,cs)
(ds',an') = rebalance (GHC.hsmodDecls p, GHC.hsmodAnn $ GHC.hsmodExt p)
p' = p { GHC.hsmodExt = (GHC.hsmodExt p){ GHC.hsmodAnn = an' },
GHC.hsmodDecls = ds'
}
+
rebalance :: ([GHC.LHsDecl GHC.GhcPs], GHC.EpAnn GHC.AnnsModule)
-> ([GHC.LHsDecl GHC.GhcPs], GHC.EpAnn GHC.AnnsModule)
rebalance (ds, GHC.EpAnn a an cs) = (ds1, GHC.EpAnn a an cs')
=====================================
utils/check-exact/Transform.hs
=====================================
@@ -255,6 +255,8 @@ setEntryDPDecl d dp = setEntryDP d dp
setEntryDP :: LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP (L (EpAnn (EpaSpan ss@(UnhelpfulSpan _)) an cs) a) dp
= L (EpAnn (EpaDelta ss dp []) an cs) a
+setEntryDP (L (EpAnn (EpaSpan ss@(GeneratedSrcSpan _)) an cs) a) dp
+ = L (EpAnn (EpaDelta ss dp []) an cs) a
setEntryDP (L (EpAnn (EpaSpan ss) an (EpaComments [])) a) dp
= L (EpAnn (EpaDelta ss dp []) an (EpaComments [])) a
setEntryDP (L (EpAnn (EpaDelta ss d csd) an cs) a) dp
@@ -320,14 +322,12 @@ getEntryDP _ = SameLine 1
addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation
addEpaLocationDelta _off _anc (EpaDelta ss d cs) = EpaDelta ss d cs
-addEpaLocationDelta _off _anc (EpaSpan ss@(UnhelpfulSpan _)) = EpaDelta ss (SameLine 0) []
addEpaLocationDelta off anc (EpaSpan ss@(RealSrcSpan r _))
= EpaDelta ss (adjustDeltaForOffset off (ss2deltaEnd anc r)) []
+addEpaLocationDelta _off _anc (EpaSpan ss) = EpaDelta ss (SameLine 0) []
-- Set the entry DP for an element coming after an existing keyword annotation
setEntryDPFromAnchor :: LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t
-setEntryDPFromAnchor _off (EpaDelta _ _ _) (L la a) = L la a
-setEntryDPFromAnchor _off (EpaSpan (UnhelpfulSpan _)) (L la a) = L la a
setEntryDPFromAnchor off (EpaSpan (RealSrcSpan anc _)) ll@(L la _) = setEntryDP ll dp'
where
dp' = case la of
@@ -335,6 +335,8 @@ setEntryDPFromAnchor off (EpaSpan (RealSrcSpan anc _)) ll@(L la _) = setEntryDP
(EpAnn (EpaSpan _) _ _) -> adjustDeltaForOffset off (SameLine 0)
(EpAnn (EpaDelta _ dp _) _ _) -> adjustDeltaForOffset off dp
+setEntryDPFromAnchor _off _ ll = ll
+
-- ---------------------------------------------------------------------
-- |Take the annEntryDelta associated with the first item and
@@ -902,7 +904,7 @@ instance HasDecls (LocatedA (HsExpr GhcPs)) where
let
off = case l of
(EpaSpan (RealSrcSpan r _)) -> LayoutStartCol $ snd $ ss2pos r
- (EpaSpan (UnhelpfulSpan _)) -> LayoutStartCol 0
+ (EpaSpan _) -> LayoutStartCol 0
(EpaDelta _ (SameLine _) _) -> LayoutStartCol 0
(EpaDelta _ (DifferentLine _ c) _) -> LayoutStartCol c
ex'' = setEntryDPFromAnchor off i ex
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22ebe33299bea806c4b5cabf4fa298a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22ebe33299bea806c4b5cabf4fa298a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] configure: remove unused win32-tarballs.md5sum
by Marge Bot (＠marge-bot) 22 Dec '25
by Marge Bot (＠marge-bot) 22 Dec '25
22 Dec '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
30e513ba by Cheng Shao at 2025-12-22T17:12:00-05:00
configure: remove unused win32-tarballs.md5sum
This patch removes the unused `win32-tarballs.md5sum` file from the
tree. The current mingw tarball download logic in
`mk/get-win32-tarballs.py` fetches and checks against `SHA256SUM` from
the same location where the tarballs are fetched, and this file has
been unused for a few years.
- - - - -
2 changed files:
- .gitattributes
- − mk/win32-tarballs.md5sum
Changes:
=====================================
.gitattributes
=====================================
@@ -1,5 +1,4 @@
# convert CRLF into LF on checkin
# don't convert anything on checkout
* text=auto eol=lf
-mk/win32-tarballs.md5sum text=auto eol=LF
testsuite/tests/parser/should_run/T25375.hs text=auto eol=crlf
=====================================
mk/win32-tarballs.md5sum deleted
=====================================
@@ -1,28 +0,0 @@
-8af4600c30671775a1dde3b60fe75854 ghc-tarballs/mingw-w64/i686/mingw-w64-i686-binutils-2.32-3-phyx.pkg.tar.xz
-c442f8999c10a24059a79a0a8974bc46 ghc-tarballs/mingw-w64/i686/mingw-w64-i686-crt-git-7.0.0.5491.fe45801e-1-any.pkg.tar.xz
-dddc20e7431ab369f6e2726feb4f65d1 ghc-tarballs/mingw-w64/i686/mingw-w64-i686-gcc-9.2.0-1-phyx.pkg.tar.xz
-64130e9d870de2292d4627a67fabee51 ghc-tarballs/mingw-w64/i686/mingw-w64-i686-gcc-libs-9.2.0-1-phyx.pkg.tar.xz
-2f97e71e4ec122151c20350433268d8b ghc-tarballs/mingw-w64/i686/mingw-w64-i686-gmp-6.1.2-1-any.pkg.tar.xz
-192a25fe284cf8a78851a673d6ef672a ghc-tarballs/mingw-w64/i686/mingw-w64-i686-headers-git-7.0.0.5490.9ec54ed1-1-any.pkg.tar.xz
-a18983513ec46ff0716dc5742604a78b ghc-tarballs/mingw-w64/i686/mingw-w64-i686-isl-0.21-1-any.pkg.tar.xz
-c8dabb32fabe2492878e070ffad473f0 ghc-tarballs/mingw-w64/i686/mingw-w64-i686-libidn2-2.2.0-1-any.pkg.tar.xz
-d05ca6e90126c17db19a8cd32e7347e8 ghc-tarballs/mingw-w64/i686/mingw-w64-i686-libwinpthread-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz
-cae596bd144ad70875ef8f21e5bdb77d ghc-tarballs/mingw-w64/i686/mingw-w64-i686-mpc-1.1.0-1-any.pkg.tar.xz
-317a7a490da5c88f63638fbc5461b51e ghc-tarballs/mingw-w64/i686/mingw-w64-i686-mpfr-4.0.2-2-any.pkg.tar.xz
-15a5557d7b321bb26436dcf7adced5b7 ghc-tarballs/mingw-w64/i686/mingw-w64-i686-windows-default-manifest-6.4-3-any.pkg.tar.xz
-beb76cd6141d11c000a1f5ff2ad34971 ghc-tarballs/mingw-w64/i686/mingw-w64-i686-winpthreads-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz
-87c65e9b2930436a75dfd7d459ae98cb ghc-tarballs/mingw-w64/i686/mingw-w64-i686-zlib-1.2.8-9-any.pkg.tar.xz
-4dca7def5591b8f999e5fa20084cc7a9 ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-binutils-2.32-3-phyx.pkg.tar.xz
-d4336ca77b5edf3126a6c1358952567a ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-crt-git-7.0.0.5491.fe45801e-1-any.pkg.tar.xz
-e84e0426204b73af13752b65a035dfc2 ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-gcc-9.2.0-1-phyx.pkg.tar.xz
-b6200865004cb558c8f5cd7526975602 ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-gcc-libs-9.2.0-1-phyx.pkg.tar.xz
-1e1f79abc9fc0534d360c2889b10a9f5 ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-gmp-6.1.2-1-any.pkg.tar.xz
-ef6ad2b29b92264c78d7ba6f0a875838 ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-headers-git-7.0.0.5490.9ec54ed1-1-any.pkg.tar.xz
-623c059a9691ee7fc74b9e3f89b35782 ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-isl-0.21-1-any.pkg.tar.xz
-29a39230c6208366b9d046fbe5bdde6f ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-libidn2-2.2.0-1-any.pkg.tar.xz
-9953a82fd713f0c7ece69d9228238f4d ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-libwinpthread-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz
-c3aa7f45926edaaafe3bba988e327271 ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-mpc-1.1.0-1-any.pkg.tar.xz
-951d8046e65768e00b6dfe1bb6e23016 ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-mpfr-4.0.2-2-any.pkg.tar.xz
-8360a1dd2f6f4fd518907530f0839a48 ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-windows-default-manifest-6.4-3-any.pkg.tar.xz
-e7cf8d4ac9e9b3f79c16a09413dd1322 ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-winpthreads-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz
-60c3a388478f411b7a0908441ebeb537 ghc-tarballs/mingw-w64/x86_64/mingw-w64-x86_64-zlib-1.2.8-9-any.pkg.tar.xz
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30e513bab08193f80077d511f39594d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30e513bab08193f80077d511f39594d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] 2 commits: Do deep subsumption when computing valid hole fits
by Marge Bot (＠marge-bot) 22 Dec '25
by Marge Bot (＠marge-bot) 22 Dec '25
22 Dec '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
db1ce858 by sheaf at 2025-12-22T17:11:17-05:00
Do deep subsumption when computing valid hole fits
This commit makes a couple of improvements to the code that
computes "valid hole fits":
1. It uses deep subsumption for data constructors.
This matches up the multiplicities, as per
Note [Typechecking data constructors].
This fixes #26338 (test: LinearHoleFits).
2. It now suggests (non-unidirectional) pattern synonyms as valid
hole fits. This fixes #26339 (test: PatSynHoleFit).
3. It uses 'stableNameCmp', to make the hole fit output deterministic.
-------------------------
Metric Increase:
hard_hole_fits
-------------------------
- - - - -
72ee9100 by sheaf at 2025-12-22T17:11:17-05:00
Speed up hole fits with a quick pre-test
This speeds up the machinery for valid hole fits by doing a small
check to rule out obviously wrong hole fits, such as:
1. A hole fit identifier whose type has a different TyCon at the head,
after looking through foralls and (=>) arrows, e.g.:
hole_ty = Int
cand_ty = Maybe a
or
hole_ty = forall a b. a -> b
cand_ty = forall x y. Either x y
2. A hole fit identifier that is not polymorphic when the hole type
is polymorphic, e.g.
hole_ty = forall a. a -> a
cand_ty = Int -> Int
-------------------------
Metric Decrease:
hard_hole_fits
-------------------------
- - - - -
29 changed files:
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Errors/Hole/FitTypes.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Utils/Unify.hs
- docs/users_guide/9.16.1-notes.rst
- testsuite/tests/ghci/scripts/T8353.stderr
- testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr
- testsuite/tests/perf/compiler/hard_hole_fits.stderr
- testsuite/tests/plugins/test-hole-plugin.stderr
- testsuite/tests/th/T15321.stderr
- testsuite/tests/typecheck/should_compile/T13050.stderr
- testsuite/tests/typecheck/should_compile/T14273.stderr
- testsuite/tests/typecheck/should_compile/T14590.stderr
- testsuite/tests/typecheck/should_compile/T25180.stderr
- testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/hole_constraints.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes2.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr
- testsuite/tests/typecheck/should_fail/T14884.stderr
Changes:
=====================================
compiler/GHC/Core/DataCon.hs
=====================================
@@ -30,7 +30,7 @@ module GHC.Core.DataCon (
dataConRepType, dataConInstSig, dataConFullSig,
dataConName, dataConIdentity, dataConTag, dataConTagZ,
dataConTyCon, dataConOrigTyCon,
- dataConWrapperType, dataConNonlinearType,
+ dataConWrapperType,
dataConUnivTyVars, dataConExTyCoVars, dataConUnivAndExTyCoVars,
dataConConcreteTyVars,
dataConUserTyVars, dataConUserTyVarBinders,
@@ -1568,23 +1568,6 @@ dataConWrapperType (MkData { dcUserTyVarBinders = user_tvbs,
mkScaledFunTys arg_tys $
res_ty
-dataConNonlinearType :: DataCon -> Type
--- ^ Just like 'dataConWrapperType', but with the
--- linearity on the arguments all zapped to Many.
---
--- Only used temporarily as a stop-gap for hole fit suggestions
--- until #26338 is fixed.
-dataConNonlinearType (MkData { dcUserTyVarBinders = user_tvbs,
- dcOtherTheta = theta, dcOrigArgTys = arg_tys,
- dcOrigResTy = res_ty,
- dcStupidTheta = stupid_theta })
- = mkForAllTys user_tvbs $
- mkInvisFunTys (stupid_theta ++ theta) $
- mkScaledFunTys arg_tys' $
- res_ty
- where
- arg_tys' = map (\(Scaled w t) -> Scaled (case w of OneTy -> ManyTy; _ -> w) t) arg_tys
-
-- | Finds the instantiated types of the arguments required to construct a
-- 'DataCon' representation
-- NB: these INCLUDE any dictionary args
=====================================
compiler/GHC/Tc/Errors/Hole.hs
=====================================
@@ -36,13 +36,16 @@ import GHC.Tc.Utils.Monad
import GHC.Tc.Types.Constraint
import GHC.Tc.Types.Origin
import GHC.Tc.Utils.TcMType
+import GHC.Tc.TyCl.PatSyn (patSynBuilderOcc)
import GHC.Tc.Types.Evidence
import GHC.Tc.Types.CtLoc
import GHC.Tc.Utils.TcType
import GHC.Tc.Zonk.TcType
import GHC.Core.TyCon( TyCon, isGenerativeTyCon )
import GHC.Core.TyCo.Rep( Type(..) )
+import GHC.Core.Type (funTyFlagTyCon)
import GHC.Core.DataCon
+import GHC.Core.PatSyn (patSynName)
import GHC.Core.Predicate( Pred(..), classifyPredType, eqRelRole )
import GHC.Types.Basic
import GHC.Types.Name
@@ -50,6 +53,8 @@ import GHC.Types.Name.Reader
import GHC.Builtin.Names ( gHC_INTERNAL_ERR, gHC_INTERNAL_UNSAFE_COERCE )
import GHC.Builtin.Types ( tupleDataConName, unboxedSumDataConName )
import GHC.Types.Id
+import GHC.Types.Name.Set (extendNameSet, NameSet, emptyNameSet)
+import GHC.Types.Var (isVisibleFunArg)
import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Types.TyThing
@@ -71,7 +76,10 @@ import Data.Graph ( graphFromEdges, topSort )
import GHC.Tc.Solver ( simplifyTopWanteds )
import GHC.Tc.Solver.Monad ( runTcSEarlyAbort )
-import GHC.Tc.Utils.Unify ( tcSubTypeSigma )
+import GHC.Tc.Utils.Unify
+ ( DeepSubsumptionFlag(..), DeepSubsumptionDepth(..)
+ , tcSubTypeHoleFit
+ )
import GHC.HsToCore.Docs ( extractDocs )
import GHC.Hs.Doc
@@ -91,7 +99,6 @@ import GHC.Data.EnumSet (EnumSet)
import qualified GHC.Data.EnumSet as EnumSet
import qualified GHC.LanguageExtensions as LangExt
-
{-
Note [Valid hole fits include ...]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -245,6 +252,23 @@ In addition, we call withoutUnification to reset any unified metavariables; this
call is actually done outside tcCheckHoleFit so that the results can be formatted
for the user before resetting variables.
+Note [Deep subsumption in tcCheckHoleFit]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To check that a candidate fits in a hole, we perform a subsumption check, as
+detailed in Note [Checking hole fits]. However, should we also perform deep
+subsumption? Well, certainly if the user has enabled deep subsumption, and also
+in cases where deep subsumption is required such as to perform eta-expansion
+of data constructors, e.g.
+
+ data T = MkT Int Bool -- so that MkT :: Int %1 -> Bool %1 -> T
+
+ foo :: Int %1 -> Bool -> T
+ foo = _
+
+We should suggest MkT as a valid hole fit, because deep subsumption will
+eta expand to make the multiplicities line up, as per
+Note [Typechecking data constructors] in GHC.Tc.Gen.Head.
+
Note [Valid refinement hole fits include ...]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When the `-frefinement-level-hole-fits=N` flag is given, we additionally look
@@ -405,24 +429,61 @@ is discarded.
Note [Speeding up valid hole-fits]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-To fix #16875 we noted that a lot of time was being spent on unnecessary work.
-
-When we'd call `tcCheckHoleFit hole hole_ty ty`, we would end up by generating
-a constraint to show that `hole_ty ~ ty`, including any constraints in `ty`. For
-example, if `hole_ty = Int` and `ty = Foldable t => (a -> Bool) -> t a -> Bool`,
-we'd have `(a_a1pa[sk:1] -> Bool) -> t_t2jk[sk:1] a_a1pa[sk:1] -> Bool ~# Int`
-from the coercion, as well as `Foldable t_t2jk[sk:1]`. By adding a flag to
-`TcSEnv` and adding a `runTcSEarlyAbort`, we can fail as soon as we hit
-an insoluble constraint. Since we don't need the result in the case that it
-fails, a boolean `False` (i.e. "it didn't work" from `runTcSEarlyAbort`)
-is sufficient.
-
-We also check whether the type of the hole is an immutable type variable (i.e.
-a skolem). In that case, the only possible fits are fits of exactly that type,
-which can only come from the locals. This speeds things up quite a bit when we
-don't know anything about the type of the hole. This also helps with degenerate
-fits like (`id (_ :: a)` and `head (_ :: [a])`) when looking for fits of type
-`a`, where `a` is a skolem.
+When computing valid hole fits, we want to quickly rule out identifiers that
+clearly don't fit the type of the hole, without doing too much work.
+This is important for the performance of the "valid hole fits" feature,
+which is known to be slow in some cases (#16875).
+
+The valid hole fits machinery is given the type of the hole and a possible
+candidate identifier, and it computes whether the identifier can be used by
+performing a subtype check
+
+ tcSubTypeHoleFit .. cand_ty hole_ty
+
+which checks that the type of the candidate identifier is more general than
+the type of the hole.
+
+We currently use the following shortcuts.
+
+ 1. When computing a set of candidate identifiers for a hole:
+
+ (FastHoles1)
+ If 'hole_ty' is an immutable type variable (i.e. a skolem type variable),
+ then the only possible (useful) fits are fits of exactly that type, which
+ can only come from locally bound variables for which that skolem is in scope.
+ In that case, only include local identifiers in the list of candidate Ids.
+
+ This speeds things up quite a bit when we don't know anything about the type
+ of the hole, and helps with degenerate fits like (`id (_ :: a)` and `head (_ :: [a])`)
+ when looking for fits of type `a`, where `a` is a skolem.
+
+ 2. When checking whether a particular candidate 'cand_ty :: cand_ty' fits 'hole_ty':
+
+ (FastHoles2)
+ Abort early if 'cand_ty' is obviously not a subtype of 'hole_ty',
+ according to a cheap test. The current cheap test is in 'definitelyNotSubType',
+ which detects the following cases:
+
+ 1. 'cand_ty' and 'hole_ty' have a different TyCon at the head, after
+ looking through foralls and (=>) arrows, e.g.:
+ hole_ty = Int -- headed by Int
+ cand_ty = Maybe a -- headed by Maybe
+ or
+ hole_ty = forall a b. a -> b -- headed by (->)
+ cand_ty = forall x y. Num x => Either x y -- headed by Either
+ 2. 'hole_ty' is polymorphic but 'cand_ty' has no polymorphism, e.g.
+ hole_ty = forall a. a -> a
+ cand_ty = Int -> Int
+
+ (FastHoles3)
+ After calling 'tcSubTypeHoleFit' but before running the solver on the
+ constraints that it generated, do a quick check to see if any constraint
+ is obviously insoluble. See Note [tcCheckHoleFit: fast insolubility check].
+
+ (FastHoles4)
+ When running the solver on the constraints generated by 'tcSubTypeHoleFit',
+ do it in a special mode that stops immediately as soon as it spots an
+ insoluble constraint, using 'runTcSEarlyAbort'.
-}
-- We read the various -no-show-*-of-hole-fits flags
@@ -517,8 +578,6 @@ getLocalBindings tidy_orig ct_loc
discard_it = go env sofar tc_bndrs
keep_it id = go env (id:sofar) tc_bndrs
-
-
-- See Note [Valid hole fits include ...]
findValidHoleFits :: TidyEnv -- ^ The tidy_env for zonking
-> [Implication] -- ^ Enclosing implications for givens
@@ -558,8 +617,10 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
map IdHFCand lclBinds ++ map GreHFCand lcl
globals = map GreHFCand gbl
syntax = map NameHFCand (builtIns exts)
- -- If the hole is a rigid type-variable, then we only check the
+
+ -- If the hole is a rigid type variable, then we only check the
-- locals, since only they can match the type (in a meaningful way).
+ -- See (FastHoles1) in Note [Speeding up valid hole-fits].
only_locals = any isImmutableTyVar $ getTyVar_maybe hole_ty
to_check = if only_locals then locals
else locals ++ syntax ++ globals
@@ -679,7 +740,6 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
possiblyDiscard (Just max) fits = (fits `lengthExceeds` max, take max fits)
possiblyDiscard Nothing fits = (False, fits)
-
-- We don't (as of yet) handle holes in types, only in expressions.
findValidHoleFits env _ _ _ = return (env, noValidHoleFits)
@@ -732,13 +792,14 @@ sortHoleFitsBySize = return . sortOn sizeOfFit
-- '-fno-sort-valid-hole-fits'.
sortHoleFitsByGraph :: [TcHoleFit] -> TcM [TcHoleFit]
sortHoleFitsByGraph fits = go [] fits
- where tcSubsumesWCloning :: TcType -> TcType -> TcM Bool
- tcSubsumesWCloning ht ty = withoutUnification fvs (tcSubsumes ht ty)
- where fvs = tyCoFVsOfTypes [ht,ty]
+ where tcSubsumesWCloning :: TcSigmaType -> TcSigmaType -> TcM Bool
+ tcSubsumesWCloning fit_ty cand_ty =
+ withoutUnification (tyCoFVsOfTypes [fit_ty, cand_ty]) $
+ tcSubsumes fit_ty cand_ty
go :: [(TcHoleFit, [TcHoleFit])] -> [TcHoleFit] -> TcM [TcHoleFit]
go sofar [] = do { traceTc "subsumptionGraph was" $ ppr sofar
; return $ uncurry (++) $ partition hfIsLcl topSorted }
- where toV (hf, adjs) = (hf, hfId hf, map hfId adjs)
+ where toV (hf, adjs) = (hf, hfName hf, map hfName adjs)
(graph, fromV, _) = graphFromEdges $ map toV sofar
topSorted = map ((\(h,_,_) -> h) . fromV) $ topSort graph
go sofar (hf:hfs) =
@@ -763,7 +824,7 @@ tcFilterHoleFits :: Maybe Int
tcFilterHoleFits (Just 0) _ _ _ = return (False, []) -- Stop right away on 0
tcFilterHoleFits limit typed_hole ht@(hole_ty, _) candidates =
do { traceTc "checkingFitsFor {" $ ppr hole_ty
- ; (discards, subs) <- go [] emptyVarSet limit ht candidates
+ ; (discards, subs) <- go [] emptyNameSet limit ht candidates
; traceTc "checkingFitsFor }" empty
; return (discards, subs) }
where
@@ -772,8 +833,8 @@ tcFilterHoleFits limit typed_hole ht@(hole_ty, _) candidates =
-- Kickoff the checking of the elements.
-- We iterate over the elements, checking each one in turn for whether
-- it fits, and adding it to the results if it does.
- go :: [TcHoleFit] -- What we've found so far.
- -> VarSet -- Ids we've already checked
+ go :: [TcHoleFit] -- What we've found so far.
+ -> NameSet -- Names of identifiers we have already checked
-> Maybe Int -- How many we're allowed to find, if limited
-> (TcType, [TcTyVar]) -- The type, and its refinement variables.
-> [HoleFitCandidate] -- The elements we've yet to check.
@@ -786,40 +847,59 @@ tcFilterHoleFits limit typed_hole ht@(hole_ty, _) candidates =
do { traceTc "lookingUp" $ ppr el
; maybeThing <- lookup el
; case maybeThing of
- Just (id, id_ty) | not_trivial id ->
- do { fits <- fitsHole ty id_ty
+ Just cand@(_, is_dc, cand_ty) ->
+ do { fits <- fitsHole ty cand_ty is_dc
; case fits of
- Just (wrp, matches) -> keep_it id id_ty wrp matches
+ Just (wrp, matches) -> keep_it cand wrp matches
_ -> discard_it }
_ -> discard_it }
where
- -- We want to filter out undefined and the likes from GHC.Err (#17940)
- not_trivial id = nameModule_maybe (idName id) `notElem` [Just gHC_INTERNAL_ERR, Just gHC_INTERNAL_UNSAFE_COERCE]
-
- lookup :: HoleFitCandidate -> TcM (Maybe (Id, Type))
- lookup (IdHFCand id) = return (Just (id, idType id))
- lookup hfc = do { thing <- tcLookup name
- ; return $ case thing of
- ATcId {tct_id = id} -> Just (id, idType id)
- AGlobal (AnId id) -> Just (id, idType id)
- AGlobal (AConLike (RealDataCon con)) ->
- Just (dataConWrapId con, dataConNonlinearType con)
- _ -> Nothing }
- where name = case hfc of
- GreHFCand gre -> greName gre
- NameHFCand name -> name
+ mk_id i
+ -- Filter out undefined and the likes from GHC.Err (#17940).
+ --
+ -- TODO: we might want to filter out more, e.g. if the user defines
+ --
+ -- todo :: forall a. a
+ -- todo = undefined
+ --
+ -- we probably don't want to suggest 'todo' as a hole fit either.
+ | let nm = idName i
+ , nameModule_maybe nm `notElem` [Just gHC_INTERNAL_ERR, Just gHC_INTERNAL_UNSAFE_COERCE]
+ = Just (nm, False, idType i)
+ | otherwise
+ = Nothing
+
+ lookup :: HoleFitCandidate -> TcM (Maybe (Name, Bool, Type))
+ lookup (IdHFCand id) = return $ mk_id id
+ lookup hfc =
+ do { thing <- tcLookup name
+ ; return $
+ case thing of
+ ATcId {tct_id = id} -> mk_id id
+ AGlobal (AnId id) -> mk_id id
+ AGlobal (AConLike (RealDataCon con)) ->
+ Just (dataConName con, True, dataConWrapperType con)
+ AGlobal (AConLike (PatSynCon ps))
+ | Just (_,t) <- patSynBuilderOcc ps
+ -> -- If we ever get a 'Todo' pattern synonym,
+ -- we should filter it out here.
+ Just (patSynName ps, False, t)
+ _ -> Nothing }
+
+ where
+ name = case hfc of
+ GreHFCand gre -> greName gre
+ NameHFCand name -> name
+
discard_it = go subs seen maxleft ty elts
- keep_it eid eid_ty wrp ms = go (fit:subs) (extendVarSet seen eid)
+ keep_it (enm, _, ety) wrp ms = go (fit:subs) (extendNameSet seen enm)
((\n -> n - 1) <$> maxleft) ty elts
where
- fit = HoleFit { hfId = eid, hfCand = el, hfType = eid_ty
+ fit = HoleFit { hfName = enm, hfCand = el, hfType = ety
, hfRefLvl = length (snd ty)
, hfWrap = wrp, hfMatches = ms
, hfDoc = Nothing }
-
-
-
unfoldWrapper :: HsWrapper -> [Type]
unfoldWrapper = reverse . unfWrp'
where
@@ -828,7 +908,6 @@ tcFilterHoleFits limit typed_hole ht@(hole_ty, _) candidates =
unfWrp' (WpCompose w1 w2) = unfWrp' w1 ++ unfWrp' w2
unfWrp' _ = []
-
-- The real work happens here, where we invoke the type checker using
-- tcCheckHoleFit to see whether the given type fits the hole.
fitsHole :: (TcType, [TcTyVar]) -- The type of the hole wrapped with the
@@ -845,27 +924,36 @@ tcFilterHoleFits limit typed_hole ht@(hole_ty, _) candidates =
-- In the base case with no additional
-- holes, h_ty will just be t and ref_vars
-- will be [].
- -> TcType -- The type we're checking to whether it can be
- -- instantiated to the type h_ty.
+ -> TcType -- The type of the hole fit candidate
+ -> Bool -- Is the hole fit candidate a data constructor?
-> TcM (Maybe ([TcType], [TcType])) -- If it is not a match, we
-- return Nothing. Otherwise,
-- we Just return the list of
-- types that quantified type
- -- variables in ty would take
+ -- variables in cand_ty would take
-- if used in place of h_ty,
-- and the list types of any
-- additional holes simulated
-- with the refinement
-- variables in ref_vars.
- fitsHole (h_ty, ref_vars) ty =
+ fitsHole (h_ty, ref_vars) cand_ty cand_is_datacon =
-- We wrap this with the withoutUnification to avoid having side-effects
-- beyond the check, but we rely on the side-effects when looking for
-- refinement hole fits, so we can't wrap the side-effects deeper than this.
withoutUnification fvs $
- do { traceTc "checkingFitOf {" $ ppr ty
- ; (fits, wrp) <- tcCheckHoleFit hole h_ty ty
- ; traceTc "Did it fit?" $ ppr fits
- ; traceTc "wrap is: " $ ppr wrp
+ do { traceTc "checkingFitOf {" $ ppr cand_ty
+
+ -- Compute 'ds_flag' with the same logic as 'getDeepSubsumptionFlag_DataConHead'.
+ ; user_ds <- xoptM LangExt.DeepSubsumption
+ ; let ds_flag
+ | user_ds
+ = Deep DeepSub
+ | cand_is_datacon
+ = Deep TopSub
+ | otherwise
+ = Shallow
+ ; mbWrap <- tcCheckHoleFit ds_flag hole h_ty cand_ty
+ ; traceTc "Did it fit?" $ ppr mbWrap
; traceTc "checkingFitOf }" empty
-- We'd like to avoid refinement suggestions like `id _ _` or
-- `head _ _`, and only suggest refinements where our all phantom
@@ -875,7 +963,8 @@ tcFilterHoleFits limit typed_hole ht@(hole_ty, _) candidates =
-- variables, i.e. zonk them to read their final value to check for
-- abstract refinements, and to report what the type of the simulated
-- holes must be for this to be a match.
- ; if fits then do {
+ ; case mbWrap of
+ { Just wrp -> do {
-- Zonking is expensive, so we only do it if required.
z_wrp_tys <- liftZonkM $ zonkTcTypes (unfoldWrapper wrp)
; if null ref_vars
@@ -895,12 +984,10 @@ tcFilterHoleFits limit typed_hole ht@(hole_ty, _) candidates =
; if allowAbstract || (allFilled && allConcrete )
then return $ Just (z_wrp_tys, z_vars)
else return Nothing }}
- else return Nothing }
- where fvs = mkFVs ref_vars `unionFV` hole_fvs `unionFV` tyCoFVsOfType ty
+ ; Nothing -> return Nothing } }
+ where fvs = mkFVs ref_vars `unionFV` hole_fvs `unionFV` tyCoFVsOfType cand_ty
hole = typed_hole { th_hole = Nothing }
-
-
-- | Checks whether a MetaTyVar is flexible or not.
isFlexiTyVar :: TcTyVar -> TcM Bool
isFlexiTyVar tv | isMetaTyVar tv = isFlexi <$> readMetaTyVar tv
@@ -923,7 +1010,7 @@ withoutUnification free_vars action =
-- discarding any errors. Subsumption here means that the ty_b can fit into the
-- ty_a, i.e. `tcSubsumes a b == True` if b is a subtype of a.
tcSubsumes :: TcSigmaType -> TcSigmaType -> TcM Bool
-tcSubsumes ty_a ty_b = fst <$> tcCheckHoleFit dummyHole ty_a ty_b
+tcSubsumes ty_a ty_b = isJust <$> tcCheckHoleFit Shallow dummyHole ty_a ty_b
where dummyHole = TypedHole { th_relevant_cts = emptyBag
, th_implics = []
, th_hole = Nothing }
@@ -932,16 +1019,22 @@ tcSubsumes ty_a ty_b = fst <$> tcCheckHoleFit dummyHole ty_a ty_b
-- #14273. This makes sure that when checking whether a type fits the hole,
-- the type has to be subsumed by type of the hole as well as fulfill all
-- constraints on the type of the hole.
-tcCheckHoleFit :: TypedHole -- ^ The hole to check against
+tcCheckHoleFit :: DeepSubsumptionFlag
+ -> TypedHole -- ^ The hole to check against
-> TcSigmaType
-- ^ The type of the hole to check against (possibly modified,
-- e.g. refined with additional holes for refinement hole-fits.)
- -> TcSigmaType -- ^ The type to check whether fits.
- -> TcM (Bool, HsWrapper)
- -- ^ Whether it was a match, and the wrapper from hole_ty to ty.
-tcCheckHoleFit _ hole_ty ty | hole_ty `eqType` ty
- = return (True, idHsWrapper)
-tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $
+ -> TcSigmaType
+ -- ^ The candidate fit type
+ -> TcM (Maybe HsWrapper)
+ -- ^ Whether it was a match, and the wrapper from hole_ty to cand_ty
+tcCheckHoleFit _ _ hole_ty cand_ty
+ -- (FastHoles2) from Note [Speeding up valid hole-fits]
+ | definitelyNotSubType cand_ty hole_ty
+ = return Nothing
+ | hole_ty `eqType` cand_ty
+ = return $ Just idHsWrapper
+tcCheckHoleFit ds_flag (TypedHole {..}) hole_ty cand_ty = discardErrs $
do { -- We wrap the subtype constraint in the implications to pass along the
-- givens, and so we must ensure that any nested implications and skolems
-- end up with the correct level. The implications are ordered so that
@@ -952,16 +1045,21 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $
[] -> getTcLevel
-- imp is the innermost implication
(imp:_) -> return (ic_tclvl imp)
- ; (wrap, wanted) <- setTcLevel innermost_lvl $ captureConstraints $
- tcSubTypeSigma orig (ExprSigCtxt NoRRC) ty hole_ty
+
+ ; (wrap, wanted) <-
+ setTcLevel innermost_lvl $ captureConstraints $
+ tcSubTypeHoleFit ds_flag orig cand_ty hole_ty
+ -- See Note [Deep subsumption in tcCheckHoleFit]
+
; traceTc "Checking hole fit {" empty
; traceTc "wanteds are: " $ ppr wanted
; if | isEmptyWC wanted, isEmptyBag th_relevant_cts
-> do { traceTc "}" empty
- ; return (True, wrap) }
+ ; return $ Just wrap }
- | checkInsoluble wanted -- See Note [Fast path for tcCheckHoleFit]
- -> return (False, wrap)
+ -- (FastHoles3) from Note [Speeding up valid hole-fits]
+ | checkInsoluble wanted
+ -> return Nothing
| otherwise
-> do { fresh_binds <- newTcEvBinds
@@ -979,10 +1077,16 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $
-- the wanteds, because they are freshly generated by the
-- call to`tcSubtype_NC`.
; traceTc "final_wc is: " $ ppr final_wc
- -- See Note [Speeding up valid hole-fits]
- ; (rem, _) <- tryTc $ runTcSEarlyAbort $ simplifyTopWanteds final_wc
+
+ -- runTcSEarlyAbort: (FastHoles4) from Note [Speeding up valid hole-fits]
+ ; (rem, _) <- tryTc $ runTcSEarlyAbort
+ $ simplifyTopWanteds final_wc
; traceTc "}" empty
- ; return (any isSolvedWC rem, wrap) } }
+ ; return $
+ if any isSolvedWC rem
+ then Just wrap
+ else Nothing
+ } }
where
orig = ExprHoleOrigin (hole_occ <$> th_hole)
@@ -993,15 +1097,15 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $
setWCAndBinds binds imp wc
= mkImplicWC $ unitBag $ imp { ic_wanted = wc , ic_binds = binds }
-{- Note [Fast path for tcCheckHoleFit]
+{- Note [tcCheckHoleFit: fast insolubility check]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In `tcCheckHoleFit` we compare (with `tcSubTypeSigma`) the type of the hole
+In `tcCheckHoleFit` we compare (with `tcSubTypeHoleFit`) the type of the hole
with the type of zillions of in-scope functions, to see which would "fit".
Most of these checks fail! They generate obviously-insoluble constraints.
For these very-common cases we don't want to crank up the full constraint
solver. It's much more efficient to do a quick-and-dirty check for insolubility.
-Now, `tcSubTypeSigma` uses the on-the-fly unifier in GHC.Tc.Utils.Unify,
+Now, `tcSubTypeHoleFit` uses the on-the-fly unifier in GHC.Tc.Utils.Unify,
it has already done the dirt-simple unification. So our quick-and-dirty
check can simply look for constraints like (Int ~ Bool). We don't need
to worry about (Maybe Int ~ Maybe Bool).
@@ -1010,9 +1114,8 @@ The quick-and-dirty check is in `checkInsoluble`. It can make a big
difference: For test hard_hole_fits, compile-time allocation goes down by 37%!
-}
-
checkInsoluble :: WantedConstraints -> Bool
--- See Note [Fast path for tcCheckHoleFit]
+-- See Note [tcCheckHoleFit: fast insolubility check]
checkInsoluble (WC { wc_simple = simples })
= any is_insol simples
where
@@ -1021,7 +1124,7 @@ checkInsoluble (WC { wc_simple = simples })
_ -> False
definitelyNotEqual :: Role -> TcType -> TcType -> Bool
--- See Note [Fast path for tcCheckHoleFit]
+-- See Note [tcCheckHoleFit: fast insolubility check]
-- Specifically, does not need to recurse under type constructors
definitelyNotEqual r t1 t2
= go t1 t2
@@ -1041,3 +1144,46 @@ definitelyNotEqual r t1 t2
go_tc _ (FunTy {}) = True
go_tc _ (ForAllTy {}) = True
go_tc _ _ = False
+
+-- | @definitelyNotSubType cand_ty hole_ty@ computes whether @cand_ty@ is
+-- **definitely not** a subtype of @hole_ty@, in order to quickly rule out
+-- a possible hole fit candidate without having to do any solving.
+--
+-- See (FastHoles2) in Note [Speeding up valid hole-fits].
+definitelyNotSubType :: TcType -> TcType -> Bool
+definitelyNotSubType = go
+ where
+ go cand_ty hole_ty
+ -- Expand type synonyms
+ | Just cand_ty' <- coreView cand_ty
+ = go cand_ty' hole_ty
+ | Just hole_ty' <- coreView hole_ty
+ = go cand_ty hole_ty'
+
+ -- Different TyCons at the head (looking through foralls and =>).
+ | Just tc1 <- tc_head cand_ty
+ , Just tc2 <- tc_head hole_ty
+ , tc1 /= tc2
+ = True
+
+ -- Non-forall type does not fit a forall-typed hole.
+ | isSigmaTy hole_ty
+ , isTauTy cand_ty
+ = True
+
+ | otherwise
+ = False
+
+ -- Is this Type a TyConApp, after looking under foralls and =>?
+ -- If so, return the TyCon at the head.
+ tc_head :: Type -> Maybe TyCon
+ tc_head (FunTy { ft_af = af, ft_res = res })
+ | not $ isVisibleFunArg af
+ = tc_head res
+ | otherwise
+ = Just $ funTyFlagTyCon af
+ tc_head (TyConApp tc _)
+ = Just tc
+ tc_head (ForAllTy _ body)
+ = tc_head body
+ tc_head _ = Nothing
=====================================
compiler/GHC/Tc/Errors/Hole/FitTypes.hs
=====================================
@@ -19,6 +19,7 @@ import GHC.Types.Name
import GHC.Data.Bag
import Data.Function ( on )
+import qualified Data.Semigroup as S
data TypedHole = TypedHole { th_relevant_cts :: Bag CtEvidence
-- ^ Any relevant Cts to the hole
@@ -77,15 +78,15 @@ instance Ord HoleFitCandidate where
-- and the refinement level of the fit, which is the number of extra argument
-- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`).
data TcHoleFit =
- HoleFit { hfId :: Id -- ^ The elements id in the TcM
- , hfCand :: HoleFitCandidate -- ^ The candidate that was checked.
- , hfType :: TcType -- ^ The type of the id, possibly zonked.
- , hfRefLvl :: Int -- ^ The number of holes in this fit.
- , hfWrap :: [TcType] -- ^ The wrapper for the match.
+ HoleFit { hfName :: Name -- ^ The name of the hole fit identifier
+ , hfCand :: HoleFitCandidate -- ^ The candidate that was checked
+ , hfType :: TcType -- ^ The type of the hole fit (possibly zonked)
+ , hfRefLvl :: Int -- ^ The number of holes in this fit
+ , hfWrap :: [TcType] -- ^ The wrapper for the match
, hfMatches :: [TcType]
-- ^ What the refinement variables got matched with, if anything
, hfDoc :: Maybe [HsDocString]
- -- ^ Documentation of this HoleFit, if available.
+ -- ^ Documentation of this HoleFit, if available
}
data HoleFit
@@ -96,30 +97,25 @@ data HoleFit
-- We define an Eq and Ord instance to be able to build a graph.
instance Eq TcHoleFit where
- (==) = (==) `on` hfId
+ (==) = (==) `on` hfName
instance Outputable HoleFit where
ppr (TcHoleFit hf) = ppr hf
ppr (RawHoleFit sd) = sd
instance Outputable TcHoleFit where
- ppr (HoleFit _ cand ty _ _ mtchs _) =
- hang (name <+> holes) 2 (text "where" <+> name <+> dcolon <+> (ppr ty))
- where name = ppr $ getName cand
- holes = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) mtchs
-
--- We compare HoleFits by their name instead of their Id, since we don't
--- want our tests to be affected by the non-determinism of `nonDetCmpVar`,
--- which is used to compare Ids. When comparing, we want HoleFits with a lower
--- refinement level to come first.
+ ppr (HoleFit { hfName = cand, hfType = ty, hfMatches = mtchs }) =
+ hang (ppr cand <+> holes) 2 (text "where" <+> ppr cand <+> dcolon <+> (ppr ty))
+ where holes = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) mtchs
+
+-- | Compare HoleFits by their 'Name'. Use 'stableNameCmp' to avoid non-determinism.
+--
+-- When comparing, we want HoleFits with a lower refinement level to come first.
instance Ord TcHoleFit where
--- compare (RawHoleFit _) (RawHoleFit _) = EQ
--- compare (RawHoleFit _) _ = LT
--- compare _ (RawHoleFit _) = GT
- compare a@(HoleFit {}) b@(HoleFit {}) = cmp a b
- where cmp = if hfRefLvl a == hfRefLvl b
- then compare `on` (getName . hfCand)
- else compare `on` hfRefLvl
+ compare a@(HoleFit {}) b@(HoleFit {}) =
+ compare (hfRefLvl a) (hfRefLvl b)
+ S.<>
+ stableNameCmp (hfName a) (hfName b)
hfIsLcl :: TcHoleFit -> Bool
hfIsLcl hf@(HoleFit {}) = case hfCand hf of
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -3595,7 +3595,7 @@ pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc
pprHoleFit _ (RawHoleFit sd) = sd
pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (TcHoleFit (HoleFit {..})) =
hang display 2 provenance
- where tyApp = sep $ zipWithEqual pprArg vars hfWrap
+ where tyApp = sep $ zipWith pprArg vars hfWrap
where pprArg b arg = case binderFlag b of
Specified -> text "@" <> pprParendType arg
-- Do not print type application for inferred
@@ -3604,20 +3604,9 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (TcHoleFit (HoleFit {..})) =
Required -> pprPanic "pprHoleFit: bad Required"
(ppr b <+> ppr arg)
tyAppVars = sep $ punctuate comma $
- zipWithEqual (\v t -> ppr (binderVar v) <+> text "~" <+> pprParendType t)
+ zipWith (\v t -> ppr (binderVar v) <+> text "~" <+> pprParendType t)
vars hfWrap
-
- vars = unwrapTypeVars hfType
- where
- -- Attempts to get all the quantified type variables in a type,
- -- e.g.
- -- return :: forall (m :: * -> *) Monad m => (forall a . a -> m a)
- -- into [m, a]
- unwrapTypeVars :: Type -> [ForAllTyBinder]
- unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of
- Just (_, _, _, unfunned) -> unwrapTypeVars unfunned
- _ -> []
- where (vars, unforalled) = splitForAllForAllTyBinders t
+ vars = deepInvisTvBinders hfType
holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) hfMatches
holeDisp = if sMs then holeVs
else sep $ replicate (length hfMatches) $ text "_"
@@ -3644,6 +3633,18 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (TcHoleFit (HoleFit {..})) =
NameHFCand name -> text "bound at" <+> ppr (getSrcLoc name)
IdHFCand id_ -> text "bound at" <+> ppr (getSrcLoc id_)
+-- | Similar to 'tcDeepSplitSigmaTy_maybe', but just cares about the binders.
+deepInvisTvBinders :: TcSigmaType -> [ForAllTyBinder]
+deepInvisTvBinders = go
+ where
+ go ty | Just (_arg_ty, res_ty) <- tcSplitFunTy_maybe ty
+ = go res_ty
+ | (tvs, body) <- splitForAllForAllTyBinders ty
+ , not (null tvs)
+ = tvs ++ go body
+ | otherwise
+ = []
+
-- | Add a "Constraints include..." message.
--
-- See Note [Constraints include ...]
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -420,20 +420,6 @@ quickLookResultType :: TcRhoType -> ExpRhoType -> TcM ()
quickLookResultType app_res_rho (Check exp_rho) = qlUnify app_res_rho exp_rho
quickLookResultType _ _ = return ()
--- | Variant of 'getDeepSubsumptionFlag' which enables a top-level subsumption
--- in order to implement the plan of Note [Typechecking data constructors].
-getDeepSubsumptionFlag_DataConHead :: HsExpr GhcTc -> TcM DeepSubsumptionFlag
-getDeepSubsumptionFlag_DataConHead app_head =
- do { user_ds <- xoptM LangExt.DeepSubsumption
- ; return $
- if | user_ds
- -> Deep DeepSub
- | XExpr (ConLikeTc (RealDataCon {})) <- app_head
- -> Deep TopSub
- | otherwise
- -> Shallow
- }
-
finishApp :: (HsExpr GhcTc, AppCtxt) -> [HsExprArg 'TcpTc]
-> TcRhoType -> HsWrapper
-> TcM (HsExpr GhcTc)
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -11,7 +11,7 @@
module GHC.Tc.Utils.Unify (
-- Full-blown subsumption
tcWrapResult, tcWrapResultO, tcWrapResultMono,
- tcSubType, tcSubTypeSigma, tcSubTypePat, tcSubTypeDS,
+ tcSubType, tcSubTypeSigma, tcSubTypePat, tcSubTypeDS, tcSubTypeHoleFit,
addSubTypeCtxt,
tcSubTypeAmbiguity, tcSubMult,
checkConstraints, checkTvConstraints,
@@ -19,7 +19,7 @@ module GHC.Tc.Utils.Unify (
-- Skolemisation
DeepSubsumptionFlag(..), DeepSubsumptionDepth(..),
- getDeepSubsumptionFlag,
+ getDeepSubsumptionFlag, getDeepSubsumptionFlag_DataConHead,
isRhoTyDS,
tcSkolemise, tcSkolemiseCompleteSig, tcSkolemiseExpectedType,
@@ -77,6 +77,7 @@ import GHC.Tc.Utils.TcMType qualified as TcM
import GHC.Tc.Solver.InertSet
+import GHC.Core.ConLike (ConLike(..))
import GHC.Core.Type
import GHC.Core.TyCo.Rep hiding (Refl)
import GHC.Core.TyCo.FVs( isInjectiveInType )
@@ -1485,6 +1486,16 @@ tcSubTypeSigma :: CtOrigin -- where did the actual type arise / why are we
tcSubTypeSigma orig ctxt ty_actual ty_expected
= tc_sub_type (unifyType Nothing) orig ctxt ty_actual ty_expected
+tcSubTypeHoleFit :: DeepSubsumptionFlag
+ -> CtOrigin
+ -> TcSigmaType -- ^ Candidate expression type
+ -> TcSigmaType -- ^ Expected type (= hole type)
+ -> TcM HsWrapper
+tcSubTypeHoleFit ds_flag orig cand_ty hole_ty =
+ -- See Note [Deep subsumption in tcCheckHoleFit]
+ tc_sub_type_ds (Nothing, Top) ds_flag (unifyType Nothing)
+ orig (ExprSigCtxt NoRRC) cand_ty hole_ty
+
---------------
tcSubTypeAmbiguity :: UserTypeCtxt -- Where did this type arise
-> TcSigmaType -> TcSigmaType -> TcM HsWrapper
@@ -2015,6 +2026,20 @@ getDeepSubsumptionFlag =
else return Shallow
}
+-- | Variant of 'getDeepSubsumptionFlag' which enables a top-level subsumption
+-- in order to implement the plan of Note [Typechecking data constructors].
+getDeepSubsumptionFlag_DataConHead :: HsExpr GhcTc -> TcM DeepSubsumptionFlag
+getDeepSubsumptionFlag_DataConHead app_head =
+ do { user_ds <- xoptM LangExt.DeepSubsumption
+ ; return $
+ if | user_ds
+ -> Deep DeepSub
+ | XExpr (ConLikeTc (RealDataCon {})) <- app_head
+ -> Deep TopSub
+ | otherwise
+ -> Shallow
+ }
+
-- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption.
--
-- Given @ty_actual@ (a sigma-type) and @ty_expected@ (deeply skolemised, i.e.
=====================================
docs/users_guide/9.16.1-notes.rst
=====================================
@@ -42,6 +42,9 @@ Compiler
bound to variables. The very similar pattern ``Foo{bar = Bar{baz = 42}}``
will will not yet mark ``bar`` or ``baz`` as covered.
+- Pattern synonyms can now be suggested as valid hole fits (except, of course,
+ if they are unidirectional).
+
- When multiple ``-msse*`` flags are given, the maximum version takes effect.
For example, ``-msse4.2 -msse2`` is now equivalent to ``-msse4.2``.
Previously, only the last flag took effect.
@@ -52,6 +55,7 @@ Compiler
in addition to :ghc-flag:`-mavx2`.
Refer to the users' guide for more details about each individual flag.
+
GHCi
~~~~
=====================================
testsuite/tests/ghci/scripts/T8353.stderr
=====================================
@@ -1,4 +1,3 @@
-
Defer03.hs:4:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)]
• Couldn't match expected type ‘Int’ with actual type ‘Char’
• In the expression: 'p'
@@ -9,8 +8,8 @@ Defer03.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• In an equation for ‘f’: f = _
• Relevant bindings include f :: Int (bound at Defer03.hs:7:1)
Valid hole fits include
- f :: Int (bound at Defer03.hs:7:1)
a :: Int (defined at Defer03.hs:4:1)
+ f :: Int (bound at Defer03.hs:7:1)
maxBound :: forall a. Bounded a => a
with maxBound @Int
(imported from ‘Prelude’
@@ -30,8 +29,8 @@ Defer03.hs:7:5: error: [GHC-88464]
• In an equation for ‘f’: f = _
• Relevant bindings include f :: Int (bound at Defer03.hs:7:1)
Valid hole fits include
- f :: Int (bound at Defer03.hs:7:1)
a :: Int (defined at Defer03.hs:4:1)
+ f :: Int (bound at Defer03.hs:7:1)
maxBound :: forall a. Bounded a => a
with maxBound @Int
(imported from ‘Prelude’
@@ -51,8 +50,8 @@ Defer03.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• In an equation for ‘f’: f = _
• Relevant bindings include f :: Int (bound at Defer03.hs:7:1)
Valid hole fits include
- f :: Int (bound at Defer03.hs:7:1)
a :: Int (defined at Defer03.hs:4:1)
+ f :: Int (bound at Defer03.hs:7:1)
maxBound :: forall a. Bounded a => a
with maxBound @Int
(imported from ‘Prelude’
@@ -72,8 +71,8 @@ Defer03.hs:7:5: error: [GHC-88464]
• In an equation for ‘f’: f = _
• Relevant bindings include f :: Int (bound at Defer03.hs:7:1)
Valid hole fits include
- f :: Int (bound at Defer03.hs:7:1)
a :: Int (defined at Defer03.hs:4:1)
+ f :: Int (bound at Defer03.hs:7:1)
maxBound :: forall a. Bounded a => a
with maxBound @Int
(imported from ‘Prelude’
@@ -93,8 +92,8 @@ Defer03.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• In an equation for ‘f’: f = _
• Relevant bindings include f :: Int (bound at Defer03.hs:7:1)
Valid hole fits include
- f :: Int (bound at Defer03.hs:7:1)
a :: Int (defined at Defer03.hs:4:1)
+ f :: Int (bound at Defer03.hs:7:1)
maxBound :: forall a. Bounded a => a
with maxBound @Int
(imported from ‘Prelude’
=====================================
testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr
=====================================
@@ -1,4 +1,3 @@
-
DRFHoleFits.hs:7:7: error: [GHC-88464]
• Found hole: _ :: T -> Int
• In the expression: _ :: T -> Int
@@ -6,8 +5,8 @@ DRFHoleFits.hs:7:7: error: [GHC-88464]
• Relevant bindings include
bar :: T -> Int (bound at DRFHoleFits.hs:7:1)
Valid hole fits include
- foo :: T -> Int (defined at DRFHoleFits.hs:5:16)
bar :: T -> Int (defined at DRFHoleFits.hs:7:1)
+ foo :: T -> Int (defined at DRFHoleFits.hs:5:16)
DRFHoleFits.hs:8:7: error: [GHC-88464]
• Found hole: _ :: A.S -> Int
@@ -20,3 +19,4 @@ DRFHoleFits.hs:8:7: error: [GHC-88464]
A.foo :: A.S -> Int
(imported qualified from ‘DRFHoleFits_A’ at DRFHoleFits.hs:3:1-35
(and originally defined at DRFHoleFits_A.hs:5:16-18))
+
=====================================
testsuite/tests/perf/compiler/hard_hole_fits.stderr
=====================================
@@ -299,10 +299,10 @@ hard_hole_fits.hs:29:35: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
(bound at hard_hole_fits.hs:29:21)
testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
Valid hole fits include
- n :: Language.Haskell.Syntax.Basic.ConTag
- (bound at hard_hole_fits.hs:29:25)
i :: Language.Haskell.Syntax.Basic.SumWidth
(bound at hard_hole_fits.hs:29:27)
+ n :: Language.Haskell.Syntax.Basic.ConTag
+ (bound at hard_hole_fits.hs:29:25)
maxBound :: forall a. Bounded a => a
with maxBound @Int
(imported from ‘Prelude’
=====================================
testsuite/tests/plugins/test-hole-plugin.stderr
=====================================
@@ -1,4 +1,3 @@
-
test-hole-plugin.hs:12:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _too_long :: [Int] -> Int
Or perhaps ‘_too_long’ is mis-spelled, or not in scope
@@ -14,11 +13,11 @@ test-hole-plugin.hs:13:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Relevant bindings include
j :: [Int] -> Int (bound at test-hole-plugin.hs:13:1)
Valid hole fits include
- j :: [Int] -> Int
f :: [Int] -> Int
- i :: [Int] -> Int
g :: [Int] -> Int
h :: [Int] -> Int
+ i :: [Int] -> Int
+ j :: [Int] -> Int
head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
(Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno-max-valid-hole-fits)
@@ -59,3 +58,4 @@ test-hole-plugin.hs:16:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
+
=====================================
testsuite/tests/th/T15321.stderr
=====================================
@@ -6,7 +6,7 @@ T15321.hs:9:9: error: [GHC-88464]
fail :: forall (m :: * -> *) a.
(MonadFail m, GHC.Internal.Stack.Types.HasCallStack) =>
String -> m a
- with fail @GHC.Internal.TH.Monad.Q @GHC.Internal.TH.Syntax.Exp
+ with fail @GHC.Internal.TH.Monad.Q
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Control.Monad.Fail’))
=====================================
testsuite/tests/typecheck/should_compile/T13050.stderr
=====================================
@@ -7,13 +7,9 @@ T13050.hs:4:9: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
x :: Int (bound at T13050.hs:4:3)
f :: Int -> Int -> Int (bound at T13050.hs:4:1)
Valid hole fits include
- f :: Int -> Int -> Int (bound at T13050.hs:4:1)
g :: Int -> Int -> Int (bound at T13050.hs:5:1)
q :: Int -> Int -> Int (bound at T13050.hs:6:1)
- (-) :: forall a. Num a => a -> a -> a
- with (-) @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
+ f :: Int -> Int -> Int (bound at T13050.hs:4:1)
asTypeOf :: forall a. a -> a -> a
with asTypeOf @Int
(imported from ‘Prelude’
@@ -22,22 +18,6 @@ T13050.hs:4:9: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with const @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- subtract :: forall a. Num a => a -> a -> a
- with subtract @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
- (^) :: forall a b. (Num a, Integral b) => a -> b -> a
- with (^) @Int @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- gcd :: forall a. Integral a => a -> a -> a
- with gcd @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- lcm :: forall a. Integral a => a -> a -> a
- with lcm @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
max :: forall a. Ord a => a -> a -> a
with max @Int
(imported from ‘Prelude’
@@ -54,10 +34,30 @@ T13050.hs:4:9: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with (+) @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Num’))
+ (-) :: forall a. Num a => a -> a -> a
+ with (-) @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ subtract :: forall a. Num a => a -> a -> a
+ with subtract @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ (^) :: forall a b. (Num a, Integral b) => a -> b -> a
+ with (^) @Int @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
div :: forall a. Integral a => a -> a -> a
with div @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Real’))
+ gcd :: forall a. Integral a => a -> a -> a
+ with gcd @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
+ lcm :: forall a. Integral a => a -> a -> a
+ with lcm @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
mod :: forall a. Integral a => a -> a -> a
with mod @Int
(imported from ‘Prelude’
@@ -74,12 +74,12 @@ T13050.hs:4:9: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with seq @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Prim’))
- return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @((->) Int) @Int
+ pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ with pure @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @((->) Int) @Int
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
@@ -92,13 +92,9 @@ T13050.hs:5:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
x :: Int (bound at T13050.hs:5:3)
g :: Int -> Int -> Int (bound at T13050.hs:5:1)
Valid hole fits include
- g :: Int -> Int -> Int (bound at T13050.hs:5:1)
f :: Int -> Int -> Int (defined at T13050.hs:4:1)
q :: Int -> Int -> Int (bound at T13050.hs:6:1)
- (-) :: forall a. Num a => a -> a -> a
- with (-) @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
+ g :: Int -> Int -> Int (bound at T13050.hs:5:1)
asTypeOf :: forall a. a -> a -> a
with asTypeOf @Int
(imported from ‘Prelude’
@@ -107,22 +103,6 @@ T13050.hs:5:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with const @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- subtract :: forall a. Num a => a -> a -> a
- with subtract @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
- (^) :: forall a b. (Num a, Integral b) => a -> b -> a
- with (^) @Int @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- gcd :: forall a. Integral a => a -> a -> a
- with gcd @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- lcm :: forall a. Integral a => a -> a -> a
- with lcm @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
max :: forall a. Ord a => a -> a -> a
with max @Int
(imported from ‘Prelude’
@@ -139,10 +119,30 @@ T13050.hs:5:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with (+) @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Num’))
+ (-) :: forall a. Num a => a -> a -> a
+ with (-) @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ subtract :: forall a. Num a => a -> a -> a
+ with subtract @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ (^) :: forall a b. (Num a, Integral b) => a -> b -> a
+ with (^) @Int @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
div :: forall a. Integral a => a -> a -> a
with div @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Real’))
+ gcd :: forall a. Integral a => a -> a -> a
+ with gcd @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
+ lcm :: forall a. Integral a => a -> a -> a
+ with lcm @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
mod :: forall a. Integral a => a -> a -> a
with mod @Int
(imported from ‘Prelude’
@@ -159,12 +159,12 @@ T13050.hs:5:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with seq @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Prim’))
- return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @((->) Int) @Int
+ pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ with pure @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @((->) Int) @Int
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
@@ -178,13 +178,9 @@ T13050.hs:6:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
x :: Int (bound at T13050.hs:6:3)
q :: Int -> Int -> Int (bound at T13050.hs:6:1)
Valid hole fits include
- q :: Int -> Int -> Int (bound at T13050.hs:6:1)
f :: Int -> Int -> Int (defined at T13050.hs:4:1)
g :: Int -> Int -> Int (defined at T13050.hs:5:1)
- (-) :: forall a. Num a => a -> a -> a
- with (-) @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
+ q :: Int -> Int -> Int (bound at T13050.hs:6:1)
asTypeOf :: forall a. a -> a -> a
with asTypeOf @Int
(imported from ‘Prelude’
@@ -193,22 +189,6 @@ T13050.hs:6:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with const @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- subtract :: forall a. Num a => a -> a -> a
- with subtract @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
- (^) :: forall a b. (Num a, Integral b) => a -> b -> a
- with (^) @Int @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- gcd :: forall a. Integral a => a -> a -> a
- with gcd @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- lcm :: forall a. Integral a => a -> a -> a
- with lcm @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
max :: forall a. Ord a => a -> a -> a
with max @Int
(imported from ‘Prelude’
@@ -225,10 +205,30 @@ T13050.hs:6:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with (+) @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Num’))
+ (-) :: forall a. Num a => a -> a -> a
+ with (-) @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ subtract :: forall a. Num a => a -> a -> a
+ with subtract @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ (^) :: forall a b. (Num a, Integral b) => a -> b -> a
+ with (^) @Int @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
div :: forall a. Integral a => a -> a -> a
with div @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Real’))
+ gcd :: forall a. Integral a => a -> a -> a
+ with gcd @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
+ lcm :: forall a. Integral a => a -> a -> a
+ with lcm @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
mod :: forall a. Integral a => a -> a -> a
with mod @Int
(imported from ‘Prelude’
@@ -245,12 +245,12 @@ T13050.hs:6:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with seq @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Prim’))
- return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @((->) Int) @Int
+ pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ with pure @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @((->) Int) @Int
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
=====================================
testsuite/tests/typecheck/should_compile/T14273.stderr
=====================================
@@ -28,27 +28,27 @@ T14273.hs:7:32: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
pleaseShow :: Bool -> a -> Maybe String (bound at T14273.hs:6:1)
Constraints include Show a (from T14273.hs:5:1-49)
Valid hole fits include
- a :: a (bound at T14273.hs:7:17)
k :: String (bound at T14273.hs:10:1)
+ a :: a (bound at T14273.hs:7:17)
otherwise :: Bool
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- False :: Bool
+ EQ :: Ordering
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Types’))
- True :: Bool
+ GT :: Ordering
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Types’))
LT :: Ordering
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Types’))
- EQ :: Ordering
+ () :: () (bound at <wired into compiler>)
+ False :: Bool
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Types’))
- GT :: Ordering
+ True :: Bool
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Types’))
- () :: () (bound at <wired into compiler>)
pi :: forall a. Floating a => a
with pi @Double
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_compile/T14590.stderr
=====================================
@@ -8,14 +8,10 @@ T14590.hs:4:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
x :: Int (bound at T14590.hs:4:4)
f1 :: Int -> Int -> Int (bound at T14590.hs:4:1)
Valid hole fits include
- f1 :: Int -> Int -> Int (bound at T14590.hs:4:1)
f2 :: Int -> Int -> Int (bound at T14590.hs:5:1)
f3 :: Int -> Int -> Int (bound at T14590.hs:6:1)
f4 :: Int -> Int -> Int (bound at T14590.hs:7:1)
- (-) :: forall a. Num a => a -> a -> a
- with (-) @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
+ f1 :: Int -> Int -> Int (bound at T14590.hs:4:1)
asTypeOf :: forall a. a -> a -> a
with asTypeOf @Int
(imported from ‘Prelude’
@@ -24,22 +20,6 @@ T14590.hs:4:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with const @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- subtract :: forall a. Num a => a -> a -> a
- with subtract @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
- (^) :: forall a b. (Num a, Integral b) => a -> b -> a
- with (^) @Int @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- gcd :: forall a. Integral a => a -> a -> a
- with gcd @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- lcm :: forall a. Integral a => a -> a -> a
- with lcm @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
max :: forall a. Ord a => a -> a -> a
with max @Int
(imported from ‘Prelude’
@@ -56,10 +36,30 @@ T14590.hs:4:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with (+) @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Num’))
+ (-) :: forall a. Num a => a -> a -> a
+ with (-) @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ subtract :: forall a. Num a => a -> a -> a
+ with subtract @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ (^) :: forall a b. (Num a, Integral b) => a -> b -> a
+ with (^) @Int @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
div :: forall a. Integral a => a -> a -> a
with div @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Real’))
+ gcd :: forall a. Integral a => a -> a -> a
+ with gcd @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
+ lcm :: forall a. Integral a => a -> a -> a
+ with lcm @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
mod :: forall a. Integral a => a -> a -> a
with mod @Int
(imported from ‘Prelude’
@@ -76,12 +76,12 @@ T14590.hs:4:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with seq @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Prim’))
- return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @((->) Int) @Int
+ pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ with pure @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @((->) Int) @Int
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
@@ -96,14 +96,10 @@ T14590.hs:5:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
x :: Int (bound at T14590.hs:5:4)
f2 :: Int -> Int -> Int (bound at T14590.hs:5:1)
Valid hole fits include
- f2 :: Int -> Int -> Int (bound at T14590.hs:5:1)
f1 :: Int -> Int -> Int (defined at T14590.hs:4:1)
f3 :: Int -> Int -> Int (bound at T14590.hs:6:1)
f4 :: Int -> Int -> Int (bound at T14590.hs:7:1)
- (-) :: forall a. Num a => a -> a -> a
- with (-) @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
+ f2 :: Int -> Int -> Int (bound at T14590.hs:5:1)
asTypeOf :: forall a. a -> a -> a
with asTypeOf @Int
(imported from ‘Prelude’
@@ -112,22 +108,6 @@ T14590.hs:5:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with const @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- subtract :: forall a. Num a => a -> a -> a
- with subtract @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
- (^) :: forall a b. (Num a, Integral b) => a -> b -> a
- with (^) @Int @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- gcd :: forall a. Integral a => a -> a -> a
- with gcd @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- lcm :: forall a. Integral a => a -> a -> a
- with lcm @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
max :: forall a. Ord a => a -> a -> a
with max @Int
(imported from ‘Prelude’
@@ -144,10 +124,30 @@ T14590.hs:5:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with (+) @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Num’))
+ (-) :: forall a. Num a => a -> a -> a
+ with (-) @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ subtract :: forall a. Num a => a -> a -> a
+ with subtract @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ (^) :: forall a b. (Num a, Integral b) => a -> b -> a
+ with (^) @Int @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
div :: forall a. Integral a => a -> a -> a
with div @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Real’))
+ gcd :: forall a. Integral a => a -> a -> a
+ with gcd @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
+ lcm :: forall a. Integral a => a -> a -> a
+ with lcm @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
mod :: forall a. Integral a => a -> a -> a
with mod @Int
(imported from ‘Prelude’
@@ -164,12 +164,12 @@ T14590.hs:5:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with seq @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Prim’))
- return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @((->) Int) @Int
+ pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ with pure @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @((->) Int) @Int
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
@@ -182,14 +182,10 @@ T14590.hs:6:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
x :: Int (bound at T14590.hs:6:4)
f3 :: Int -> Int -> Int (bound at T14590.hs:6:1)
Valid hole fits include
- f3 :: Int -> Int -> Int (bound at T14590.hs:6:1)
f1 :: Int -> Int -> Int (defined at T14590.hs:4:1)
f2 :: Int -> Int -> Int (defined at T14590.hs:5:1)
f4 :: Int -> Int -> Int (bound at T14590.hs:7:1)
- (-) :: forall a. Num a => a -> a -> a
- with (-) @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
+ f3 :: Int -> Int -> Int (bound at T14590.hs:6:1)
asTypeOf :: forall a. a -> a -> a
with asTypeOf @Int
(imported from ‘Prelude’
@@ -198,22 +194,6 @@ T14590.hs:6:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with const @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- subtract :: forall a. Num a => a -> a -> a
- with subtract @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
- (^) :: forall a b. (Num a, Integral b) => a -> b -> a
- with (^) @Int @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- gcd :: forall a. Integral a => a -> a -> a
- with gcd @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- lcm :: forall a. Integral a => a -> a -> a
- with lcm @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
max :: forall a. Ord a => a -> a -> a
with max @Int
(imported from ‘Prelude’
@@ -230,10 +210,30 @@ T14590.hs:6:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with (+) @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Num’))
+ (-) :: forall a. Num a => a -> a -> a
+ with (-) @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ subtract :: forall a. Num a => a -> a -> a
+ with subtract @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ (^) :: forall a b. (Num a, Integral b) => a -> b -> a
+ with (^) @Int @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
div :: forall a. Integral a => a -> a -> a
with div @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Real’))
+ gcd :: forall a. Integral a => a -> a -> a
+ with gcd @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
+ lcm :: forall a. Integral a => a -> a -> a
+ with lcm @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
mod :: forall a. Integral a => a -> a -> a
with mod @Int
(imported from ‘Prelude’
@@ -250,12 +250,12 @@ T14590.hs:6:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with seq @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Prim’))
- return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @((->) Int) @Int
+ pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ with pure @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @((->) Int) @Int
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
@@ -269,14 +269,10 @@ T14590.hs:7:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
x :: Int (bound at T14590.hs:7:4)
f4 :: Int -> Int -> Int (bound at T14590.hs:7:1)
Valid hole fits include
- f4 :: Int -> Int -> Int (bound at T14590.hs:7:1)
f1 :: Int -> Int -> Int (defined at T14590.hs:4:1)
f2 :: Int -> Int -> Int (defined at T14590.hs:5:1)
f3 :: Int -> Int -> Int (defined at T14590.hs:6:1)
- (-) :: forall a. Num a => a -> a -> a
- with (-) @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
+ f4 :: Int -> Int -> Int (bound at T14590.hs:7:1)
asTypeOf :: forall a. a -> a -> a
with asTypeOf @Int
(imported from ‘Prelude’
@@ -285,22 +281,6 @@ T14590.hs:7:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with const @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- subtract :: forall a. Num a => a -> a -> a
- with subtract @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Num’))
- (^) :: forall a b. (Num a, Integral b) => a -> b -> a
- with (^) @Int @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- gcd :: forall a. Integral a => a -> a -> a
- with gcd @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
- lcm :: forall a. Integral a => a -> a -> a
- with lcm @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Real’))
max :: forall a. Ord a => a -> a -> a
with max @Int
(imported from ‘Prelude’
@@ -317,10 +297,30 @@ T14590.hs:7:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with (+) @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Num’))
+ (-) :: forall a. Num a => a -> a -> a
+ with (-) @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ subtract :: forall a. Num a => a -> a -> a
+ with subtract @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Num’))
+ (^) :: forall a b. (Num a, Integral b) => a -> b -> a
+ with (^) @Int @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
div :: forall a. Integral a => a -> a -> a
with div @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Real’))
+ gcd :: forall a. Integral a => a -> a -> a
+ with gcd @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
+ lcm :: forall a. Integral a => a -> a -> a
+ with lcm @Int
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Real’))
mod :: forall a. Integral a => a -> a -> a
with mod @Int
(imported from ‘Prelude’
@@ -337,12 +337,12 @@ T14590.hs:7:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with seq @Int @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Prim’))
- return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @((->) Int) @Int
+ pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ with pure @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @((->) Int) @Int
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @((->) Int)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
=====================================
testsuite/tests/typecheck/should_compile/T25180.stderr
=====================================
@@ -29,16 +29,20 @@ T25180.hs:19:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
tup1 :: a -> Solo a (bound at T25180.hs:19:1)
Valid hole fits include
tup1 :: a -> Solo a (bound at T25180.hs:19:1)
+ Solo :: forall a. a -> Solo a
+ with Solo @a
+ (imported from ‘Data.Tuple’ at T25180.hs:6:1-17
+ (and originally defined in ‘GHC.Internal.Tuple’))
MkSolo :: forall a. a -> Solo a
with MkSolo @a
(imported from ‘Data.Tuple’ at T25180.hs:6:1-17
(and originally defined in ‘GHC.Internal.Tuple’))
- return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @Solo @a
+ pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ with pure @Solo
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @Solo @a
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @Solo
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
=====================================
testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
=====================================
@@ -1,4 +1,3 @@
-
abstract_refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: [Integer] -> Integer
• In an equation for ‘f’: f = _
@@ -6,8 +5,8 @@ abstract_refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -W
f :: [Integer] -> Integer
(bound at abstract_refinement_hole_fits.hs:4:1)
Valid hole fits include
- f :: [Integer] -> Integer
g :: [Integer] -> Integer
+ f :: [Integer] -> Integer
head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
last :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
@@ -61,46 +60,46 @@ abstract_refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -W
where fst :: forall a b. (a, b) -> a
snd (_ :: (a3, t0 -> [Integer] -> Integer)) (_ :: t0)
where snd :: forall a b. (a, b) -> b
- return (_ :: Integer)
- where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: Integer)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- (>>=) (_ :: [Integer] -> a6) (_ :: a6 -> [Integer] -> Integer)
- where (>>=) :: forall (m :: * -> *) a b.
- Monad m =>
- m a -> (a -> m b) -> m b
- (>>) (_ :: [Integer] -> a5) (_ :: [Integer] -> Integer)
- where (>>) :: forall (m :: * -> *) a b.
- Monad m =>
- m a -> m b -> m b
- fmap (_ :: a7 -> Integer) (_ :: [Integer] -> a7)
- where fmap :: forall (f :: * -> *) a b.
+ return (_ :: Integer)
+ where return :: forall (m :: * -> *) a. Monad m => a -> m a
+ (*>) (_ :: [Integer] -> a8) (_ :: [Integer] -> Integer)
+ where (*>) :: forall (f :: * -> *) a b.
+ Applicative f =>
+ f a -> f b -> f b
+ (<$) (_ :: Integer) (_ :: [Integer] -> b5)
+ where (<$) :: forall (f :: * -> *) a b.
Functor f =>
- (a -> b) -> f a -> f b
+ a -> f b -> f a
+ (<*) (_ :: [Integer] -> Integer) (_ :: [Integer] -> b4)
+ where (<*) :: forall (f :: * -> *) a b.
+ Applicative f =>
+ f a -> f b -> f a
(<*>) (_ :: [Integer] -> a9 -> Integer) (_ :: [Integer] -> a9)
where (<*>) :: forall (f :: * -> *) a b.
Applicative f =>
f (a -> b) -> f a -> f b
- (*>) (_ :: [Integer] -> a8) (_ :: [Integer] -> Integer)
- where (*>) :: forall (f :: * -> *) a b.
- Applicative f =>
- f a -> f b -> f b
(=<<) (_ :: a1 -> [Integer] -> Integer) (_ :: [Integer] -> a1)
where (=<<) :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m a -> m b
+ (>>) (_ :: [Integer] -> a5) (_ :: [Integer] -> Integer)
+ where (>>) :: forall (m :: * -> *) a b.
+ Monad m =>
+ m a -> m b -> m b
+ (>>=) (_ :: [Integer] -> a6) (_ :: a6 -> [Integer] -> Integer)
+ where (>>=) :: forall (m :: * -> *) a b.
+ Monad m =>
+ m a -> (a -> m b) -> m b
+ fmap (_ :: a7 -> Integer) (_ :: [Integer] -> a7)
+ where fmap :: forall (f :: * -> *) a b.
+ Functor f =>
+ (a -> b) -> f a -> f b
(<$>) (_ :: a2 -> Integer) (_ :: [Integer] -> a2)
where (<$>) :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f a -> f b
- (<*) (_ :: [Integer] -> Integer) (_ :: [Integer] -> b4)
- where (<*) :: forall (f :: * -> *) a b.
- Applicative f =>
- f a -> f b -> f a
- (<$) (_ :: Integer) (_ :: [Integer] -> b5)
- where (<$) :: forall (f :: * -> *) a b.
- Functor f =>
- a -> f b -> f a
id (_ :: [Integer] -> Integer)
where id :: forall a. a -> a
head (_ :: [[Integer] -> Integer])
@@ -125,16 +124,16 @@ abstract_refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -W
where const :: forall a b. a -> b -> a
uncurry (_ :: a4 -> b3 -> [Integer] -> Integer) (_ :: (a4, b3))
where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
- seq (_ :: t2) (_ :: [Integer] -> Integer)
- where seq :: forall a b. a -> b -> b
($!) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
where ($!) :: forall a b. (a -> b) -> a -> b
+ seq (_ :: t2) (_ :: [Integer] -> Integer)
+ where seq :: forall a b. a -> b -> b
($) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
where ($) :: forall a b. (a -> b) -> a -> b
- return (_ :: [Integer] -> Integer) (_ :: t0)
- where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: [Integer] -> Integer) (_ :: t0)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ return (_ :: [Integer] -> Integer) (_ :: t0)
+ where return :: forall (m :: * -> *) a. Monad m => a -> m a
abstract_refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: Integer -> [Integer] -> Integer
@@ -145,8 +144,8 @@ abstract_refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -W
(bound at abstract_refinement_hole_fits.hs:7:1)
Valid hole fits include
const :: forall a b. a -> b -> a
- return :: forall (m :: * -> *) a. Monad m => a -> m a
pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
Valid refinement hole fits include
foldl (_ :: Integer -> Integer -> Integer)
where foldl :: forall (t :: * -> *) b a.
@@ -190,49 +189,49 @@ abstract_refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -W
where fst :: forall a b. (a, b) -> a
snd (_ :: (a3, t0 -> Integer -> [Integer] -> Integer)) (_ :: t0)
where snd :: forall a b. (a, b) -> b
- return (_ :: [Integer] -> Integer)
- where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: [Integer] -> Integer)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- (>>=) (_ :: Integer -> a6)
- (_ :: a6 -> Integer -> [Integer] -> Integer)
- where (>>=) :: forall (m :: * -> *) a b.
- Monad m =>
- m a -> (a -> m b) -> m b
- (>>) (_ :: Integer -> a5) (_ :: Integer -> [Integer] -> Integer)
- where (>>) :: forall (m :: * -> *) a b.
- Monad m =>
- m a -> m b -> m b
- fmap (_ :: a7 -> [Integer] -> Integer) (_ :: Integer -> a7)
- where fmap :: forall (f :: * -> *) a b.
+ return (_ :: [Integer] -> Integer)
+ where return :: forall (m :: * -> *) a. Monad m => a -> m a
+ (*>) (_ :: Integer -> a8) (_ :: Integer -> [Integer] -> Integer)
+ where (*>) :: forall (f :: * -> *) a b.
+ Applicative f =>
+ f a -> f b -> f b
+ (<$) (_ :: [Integer] -> Integer) (_ :: Integer -> b5)
+ where (<$) :: forall (f :: * -> *) a b.
Functor f =>
- (a -> b) -> f a -> f b
+ a -> f b -> f a
+ (<*) (_ :: Integer -> [Integer] -> Integer) (_ :: Integer -> b4)
+ where (<*) :: forall (f :: * -> *) a b.
+ Applicative f =>
+ f a -> f b -> f a
(<*>) (_ :: Integer -> a9 -> [Integer] -> Integer)
(_ :: Integer -> a9)
where (<*>) :: forall (f :: * -> *) a b.
Applicative f =>
f (a -> b) -> f a -> f b
- (*>) (_ :: Integer -> a8) (_ :: Integer -> [Integer] -> Integer)
- where (*>) :: forall (f :: * -> *) a b.
- Applicative f =>
- f a -> f b -> f b
(=<<) (_ :: a1 -> Integer -> [Integer] -> Integer)
(_ :: Integer -> a1)
where (=<<) :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m a -> m b
+ (>>) (_ :: Integer -> a5) (_ :: Integer -> [Integer] -> Integer)
+ where (>>) :: forall (m :: * -> *) a b.
+ Monad m =>
+ m a -> m b -> m b
+ (>>=) (_ :: Integer -> a6)
+ (_ :: a6 -> Integer -> [Integer] -> Integer)
+ where (>>=) :: forall (m :: * -> *) a b.
+ Monad m =>
+ m a -> (a -> m b) -> m b
+ fmap (_ :: a7 -> [Integer] -> Integer) (_ :: Integer -> a7)
+ where fmap :: forall (f :: * -> *) a b.
+ Functor f =>
+ (a -> b) -> f a -> f b
(<$>) (_ :: a2 -> [Integer] -> Integer) (_ :: Integer -> a2)
where (<$>) :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f a -> f b
- (<*) (_ :: Integer -> [Integer] -> Integer) (_ :: Integer -> b4)
- where (<*) :: forall (f :: * -> *) a b.
- Applicative f =>
- f a -> f b -> f a
- (<$) (_ :: [Integer] -> Integer) (_ :: Integer -> b5)
- where (<$) :: forall (f :: * -> *) a b.
- Functor f =>
- a -> f b -> f a
id (_ :: Integer -> [Integer] -> Integer)
where id :: forall a. a -> a
head (_ :: [Integer -> [Integer] -> Integer])
@@ -259,13 +258,14 @@ abstract_refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -W
uncurry (_ :: a4 -> b3 -> Integer -> [Integer] -> Integer)
(_ :: (a4, b3))
where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
- seq (_ :: t2) (_ :: Integer -> [Integer] -> Integer)
- where seq :: forall a b. a -> b -> b
($!) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
where ($!) :: forall a b. (a -> b) -> a -> b
+ seq (_ :: t2) (_ :: Integer -> [Integer] -> Integer)
+ where seq :: forall a b. a -> b -> b
($) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
where ($) :: forall a b. (a -> b) -> a -> b
- return (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
- where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ return (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
+ where return :: forall (m :: * -> *) a. Monad m => a -> m a
+
=====================================
testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
=====================================
@@ -1,4 +1,3 @@
-
constraint_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: [a] -> a
Where: ‘a’ is a rigid type variable bound by
@@ -42,10 +41,10 @@ constraint_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
where ($) :: forall a b. (a -> b) -> a -> b
($!) (_ :: [a] -> a)
where ($!) :: forall a b. (a -> b) -> a -> b
- return (_ :: a)
- where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: a)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ return (_ :: a)
+ where return :: forall (m :: * -> *) a. Monad m => a -> m a
id (_ :: [a] -> a)
where id :: forall a. a -> a
head (_ :: [[a] -> a])
@@ -62,3 +61,4 @@ constraint_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
where (!!) :: forall a.
GHC.Internal.Stack.Types.HasCallStack =>
[a] -> Int -> a
+
=====================================
testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
=====================================
@@ -1,4 +1,3 @@
-
free_monad_hole_fits.hs:14:28: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole:
_a :: (Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
@@ -55,10 +54,6 @@ free_monad_hole_fits.hs:25:31: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault
Constraints include
Applicative f (from free_monad_hole_fits.hs:22:10-40)
Valid refinement hole fits include
- fmap (_ :: a -> b)
- where fmap :: forall (f :: * -> *) a b.
- Functor f =>
- (a -> b) -> f a -> f b
(<*>) (_ :: Free f (a -> b))
where (<*>) :: forall (f :: * -> *) a b.
Applicative f =>
@@ -67,6 +62,10 @@ free_monad_hole_fits.hs:25:31: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault
where (=<<) :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m a -> m b
+ fmap (_ :: a -> b)
+ where fmap :: forall (f :: * -> *) a b.
+ Functor f =>
+ (a -> b) -> f a -> f b
(<$>) (_ :: a -> b)
where (<$>) :: forall (f :: * -> *) a b.
Functor f =>
@@ -75,3 +74,4 @@ free_monad_hole_fits.hs:25:31: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault
where ($) :: forall a b. (a -> b) -> a -> b
pure (_ :: Free f b)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+
=====================================
testsuite/tests/typecheck/should_compile/hole_constraints.stderr
=====================================
@@ -1,4 +1,3 @@
-
hole_constraints.hs:8:6: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: a
Where: ‘a’ is a rigid type variable bound by
@@ -67,8 +66,9 @@ hole_constraints.hs:27:32: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
foo :: AnyShow -> String (bound at hole_constraints.hs:27:1)
Constraints include Show a (from hole_constraints.hs:27:19-27)
Valid hole fits include
- f3 :: forall a. C a => a
f1 :: forall a. Eq a => a
f2 :: forall a. (Show a, Eq a) => a
+ f3 :: forall a. C a => a
[] :: forall a. [a]
mempty :: forall a. Monoid a => a
+
=====================================
testsuite/tests/typecheck/should_compile/holes.stderr
=====================================
@@ -40,18 +40,12 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
y :: [a] (bound at holes.hs:11:3)
z :: [a] -> [a] (bound at holes.hs:11:1)
Valid hole fits include
- y :: [a]
- z :: [a] -> [a]
g :: Int -> Char
h :: [Char]
+ y :: [a]
+ z :: [a] -> [a]
f :: forall {p}. p
otherwise :: Bool
- False :: Bool
- True :: Bool
- LT :: Ordering
- EQ :: Ordering
- GT :: Ordering
- () :: ()
(&&) :: Bool -> Bool -> Bool
not :: Bool -> Bool
(||) :: Bool -> Bool -> Bool
@@ -74,22 +68,48 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
putStrLn :: String -> IO ()
readFile :: FilePath -> IO String
writeFile :: FilePath -> String -> IO ()
+ EQ :: Ordering
+ GT :: Ordering
+ LT :: Ordering
+ () :: ()
+ False :: Bool
+ True :: Bool
(++) :: forall a. [a] -> [a] -> [a]
- filter :: forall a. (a -> Bool) -> [a] -> [a]
- fromInteger :: forall a. Num a => Integer -> a
- (-) :: forall a. Num a => a -> a -> a
- fromRational :: forall a. Fractional a => Rational -> a
- negate :: forall a. Num a => a -> a
- fromIntegral :: forall a b. (Integral a, Num b) => a -> b
- toInteger :: forall a. Integral a => a -> Integer
- toRational :: forall a. Real a => a -> Rational
- (:) :: forall a. a -> [a] -> [a]
- Nothing :: forall a. Maybe a
- Just :: forall a. a -> Maybe a
- [] :: forall a. [a]
asTypeOf :: forall a. a -> a -> a
id :: forall a. a -> a
until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
+ (**) :: forall a. Floating a => a -> a -> a
+ acos :: forall a. Floating a => a -> a
+ acosh :: forall a. Floating a => a -> a
+ asin :: forall a. Floating a => a -> a
+ asinh :: forall a. Floating a => a -> a
+ atan :: forall a. Floating a => a -> a
+ atan2 :: forall a. RealFloat a => a -> a -> a
+ atanh :: forall a. Floating a => a -> a
+ cos :: forall a. Floating a => a -> a
+ cosh :: forall a. Floating a => a -> a
+ decodeFloat :: forall a. RealFloat a => a -> (Integer, Int)
+ encodeFloat :: forall a. RealFloat a => Integer -> Int -> a
+ exp :: forall a. Floating a => a -> a
+ exponent :: forall a. RealFloat a => a -> Int
+ floatDigits :: forall a. RealFloat a => a -> Int
+ floatRadix :: forall a. RealFloat a => a -> Integer
+ floatRange :: forall a. RealFloat a => a -> (Int, Int)
+ isDenormalized :: forall a. RealFloat a => a -> Bool
+ isIEEE :: forall a. RealFloat a => a -> Bool
+ isInfinite :: forall a. RealFloat a => a -> Bool
+ isNaN :: forall a. RealFloat a => a -> Bool
+ isNegativeZero :: forall a. RealFloat a => a -> Bool
+ log :: forall a. Floating a => a -> a
+ logBase :: forall a. Floating a => a -> a -> a
+ pi :: forall a. Floating a => a
+ scaleFloat :: forall a. RealFloat a => Int -> a -> a
+ significand :: forall a. RealFloat a => a -> a
+ sin :: forall a. Floating a => a -> a
+ sinh :: forall a. Floating a => a -> a
+ sqrt :: forall a. Floating a => a -> a
+ tan :: forall a. Floating a => a -> a
+ tanh :: forall a. Floating a => a -> a
ioError :: forall a.
GHC.Internal.Stack.Types.HasCallStack =>
IOError -> IO a
@@ -102,6 +122,7 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
[a] -> [a]
drop :: forall a. Int -> [a] -> [a]
dropWhile :: forall a. (a -> Bool) -> [a] -> [a]
+ filter :: forall a. (a -> Bool) -> [a] -> [a]
head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
init :: forall a.
GHC.Internal.Stack.Types.HasCallStack =>
@@ -120,80 +141,57 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
[a] -> [a]
take :: forall a. Int -> [a] -> [a]
takeWhile :: forall a. (a -> Bool) -> [a] -> [a]
- subtract :: forall a. Num a => a -> a -> a
- readParen :: forall a. Bool -> ReadS a -> ReadS a
- (^) :: forall a b. (Num a, Integral b) => a -> b -> a
- even :: forall a. Integral a => a -> Bool
- gcd :: forall a. Integral a => a -> a -> a
- lcm :: forall a. Integral a => a -> a -> a
- odd :: forall a. Integral a => a -> Bool
- (**) :: forall a. Floating a => a -> a -> a
- acos :: forall a. Floating a => a -> a
- acosh :: forall a. Floating a => a -> a
- asin :: forall a. Floating a => a -> a
- asinh :: forall a. Floating a => a -> a
- atan :: forall a. Floating a => a -> a
- atanh :: forall a. Floating a => a -> a
- cos :: forall a. Floating a => a -> a
- cosh :: forall a. Floating a => a -> a
- exp :: forall a. Floating a => a -> a
- log :: forall a. Floating a => a -> a
- logBase :: forall a. Floating a => a -> a -> a
- pi :: forall a. Floating a => a
- sin :: forall a. Floating a => a -> a
- sinh :: forall a. Floating a => a -> a
- sqrt :: forall a. Floating a => a -> a
- tan :: forall a. Floating a => a -> a
- tanh :: forall a. Floating a => a -> a
- atan2 :: forall a. RealFloat a => a -> a -> a
- decodeFloat :: forall a. RealFloat a => a -> (Integer, Int)
- encodeFloat :: forall a. RealFloat a => Integer -> Int -> a
- exponent :: forall a. RealFloat a => a -> Int
- floatDigits :: forall a. RealFloat a => a -> Int
- floatRadix :: forall a. RealFloat a => a -> Integer
- floatRange :: forall a. RealFloat a => a -> (Int, Int)
- isDenormalized :: forall a. RealFloat a => a -> Bool
- isIEEE :: forall a. RealFloat a => a -> Bool
- isInfinite :: forall a. RealFloat a => a -> Bool
- isNaN :: forall a. RealFloat a => a -> Bool
- isNegativeZero :: forall a. RealFloat a => a -> Bool
- scaleFloat :: forall a. RealFloat a => Int -> a -> a
- significand :: forall a. RealFloat a => a -> a
(*) :: forall a. Num a => a -> a -> a
(+) :: forall a. Num a => a -> a -> a
+ (-) :: forall a. Num a => a -> a -> a
abs :: forall a. Num a => a -> a
+ fromInteger :: forall a. Num a => Integer -> a
+ negate :: forall a. Num a => a -> a
signum :: forall a. Num a => a -> a
+ subtract :: forall a. Num a => a -> a -> a
+ readParen :: forall a. Bool -> ReadS a -> ReadS a
(/) :: forall a. Fractional a => a -> a -> a
- recip :: forall a. Fractional a => a -> a
+ (^) :: forall a b. (Num a, Integral b) => a -> b -> a
div :: forall a. Integral a => a -> a -> a
divMod :: forall a. Integral a => a -> a -> (a, a)
+ even :: forall a. Integral a => a -> Bool
+ fromIntegral :: forall a b. (Integral a, Num b) => a -> b
+ fromRational :: forall a. Fractional a => Rational -> a
+ gcd :: forall a. Integral a => a -> a -> a
+ lcm :: forall a. Integral a => a -> a -> a
mod :: forall a. Integral a => a -> a -> a
+ odd :: forall a. Integral a => a -> Bool
quot :: forall a. Integral a => a -> a -> a
quotRem :: forall a. Integral a => a -> a -> (a, a)
+ recip :: forall a. Fractional a => a -> a
rem :: forall a. Integral a => a -> a -> a
- zip :: forall a b. [a] -> [b] -> [(a, b)]
+ toInteger :: forall a. Integral a => a -> Integer
+ toRational :: forall a. Real a => a -> Rational
+ Just :: forall a. a -> Maybe a
+ Nothing :: forall a. Maybe a
+ (:) :: forall a. a -> [a] -> [a]
+ [] :: forall a. [a]
+ const :: forall a b. a -> b -> a
map :: forall a b. (a -> b) -> [a] -> [b]
- realToFrac :: forall a b. (Real a, Fractional b) => a -> b
Left :: forall a b. a -> Either a b
Right :: forall a b. b -> Either a b
- (,) :: forall a b. a -> b -> (a, b)
- const :: forall a b. a -> b -> a
maybe :: forall b a. b -> (a -> b) -> Maybe a -> b
fst :: forall a b. (a, b) -> a
snd :: forall a b. (a, b) -> b
scanl :: forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanr :: forall a b. (a -> b -> b) -> b -> [a] -> [b]
unzip :: forall a b. [(a, b)] -> ([a], [b])
+ zip :: forall a b. [a] -> [b] -> [(a, b)]
(^^) :: forall a b. (Fractional a, Integral b) => a -> b -> a
ceiling :: forall a b. (RealFrac a, Integral b) => a -> b
floor :: forall a b. (RealFrac a, Integral b) => a -> b
properFraction :: forall a b.
(RealFrac a, Integral b) =>
a -> (b, a)
+ realToFrac :: forall a b. (Real a, Fractional b) => a -> b
round :: forall a b. (RealFrac a, Integral b) => a -> b
truncate :: forall a b. (RealFrac a, Integral b) => a -> b
- seq :: forall a b. a -> b -> b
- (,,) :: forall a b c. a -> b -> c -> (a, b, c)
+ (,) :: forall a b. a -> b -> (a, b)
($!) :: forall a b. (a -> b) -> a -> b
(.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
@@ -202,11 +200,13 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
unzip3 :: forall a b c. [(a, b, c)] -> ([a], [b], [c])
zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
+ seq :: forall a b. a -> b -> b
+ (,,) :: forall a b c. a -> b -> c -> (a, b, c)
($) :: forall a b. (a -> b) -> a -> b
- (,,,) :: forall a b c d. a -> b -> c -> d -> (a, b, c, d)
flip :: forall a b c. (a -> b -> c) -> b -> a -> c
zipWith3 :: forall a b c d.
(a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
+ (,,,) :: forall a b c d. a -> b -> c -> d -> (a, b, c, d)
(,,,,) :: forall a b c d e.
a -> b -> c -> d -> e -> (a, b, c, d, e)
(,,,,,) :: forall a b c d e f.
=====================================
testsuite/tests/typecheck/should_compile/holes2.stderr
=====================================
@@ -1,4 +1,3 @@
-
holes2.hs:3:5: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)]
• Ambiguous type variable ‘a0’ arising from a use of ‘show’
prevents the constraint ‘(Show a0)’ from being solved.
@@ -8,7 +7,7 @@ holes2.hs:3:5: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)]
-- Defined in ‘GHC.Internal.Data.Either’
instance Show Ordering -- Defined in ‘GHC.Internal.Show’
...plus 26 others
- ...plus 48 instances involving out-of-scope types
+ ...plus 49 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the expression: show _
In an equation for ‘f’: f = show _
@@ -23,10 +22,11 @@ holes2.hs:3:10: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
Valid hole fits include
f :: String
otherwise :: Bool
- False :: Bool
- True :: Bool
- LT :: Ordering
EQ :: Ordering
GT :: Ordering
+ LT :: Ordering
() :: ()
+ False :: Bool
+ True :: Bool
pi :: forall a. Floating a => a
+
=====================================
testsuite/tests/typecheck/should_compile/holes3.stderr
=====================================
@@ -43,18 +43,12 @@ holes3.hs:11:15: error: [GHC-88464]
y :: [a] (bound at holes3.hs:11:3)
z :: [a] -> [a] (bound at holes3.hs:11:1)
Valid hole fits include
- y :: [a]
- z :: [a] -> [a]
g :: Int -> Char
h :: [Char]
+ y :: [a]
+ z :: [a] -> [a]
f :: forall {p}. p
otherwise :: Bool
- False :: Bool
- True :: Bool
- LT :: Ordering
- EQ :: Ordering
- GT :: Ordering
- () :: ()
(&&) :: Bool -> Bool -> Bool
not :: Bool -> Bool
(||) :: Bool -> Bool -> Bool
@@ -77,22 +71,48 @@ holes3.hs:11:15: error: [GHC-88464]
putStrLn :: String -> IO ()
readFile :: FilePath -> IO String
writeFile :: FilePath -> String -> IO ()
+ EQ :: Ordering
+ GT :: Ordering
+ LT :: Ordering
+ () :: ()
+ False :: Bool
+ True :: Bool
(++) :: forall a. [a] -> [a] -> [a]
- filter :: forall a. (a -> Bool) -> [a] -> [a]
- fromInteger :: forall a. Num a => Integer -> a
- (-) :: forall a. Num a => a -> a -> a
- fromRational :: forall a. Fractional a => Rational -> a
- negate :: forall a. Num a => a -> a
- fromIntegral :: forall a b. (Integral a, Num b) => a -> b
- toInteger :: forall a. Integral a => a -> Integer
- toRational :: forall a. Real a => a -> Rational
- (:) :: forall a. a -> [a] -> [a]
- Nothing :: forall a. Maybe a
- Just :: forall a. a -> Maybe a
- [] :: forall a. [a]
asTypeOf :: forall a. a -> a -> a
id :: forall a. a -> a
until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
+ (**) :: forall a. Floating a => a -> a -> a
+ acos :: forall a. Floating a => a -> a
+ acosh :: forall a. Floating a => a -> a
+ asin :: forall a. Floating a => a -> a
+ asinh :: forall a. Floating a => a -> a
+ atan :: forall a. Floating a => a -> a
+ atan2 :: forall a. RealFloat a => a -> a -> a
+ atanh :: forall a. Floating a => a -> a
+ cos :: forall a. Floating a => a -> a
+ cosh :: forall a. Floating a => a -> a
+ decodeFloat :: forall a. RealFloat a => a -> (Integer, Int)
+ encodeFloat :: forall a. RealFloat a => Integer -> Int -> a
+ exp :: forall a. Floating a => a -> a
+ exponent :: forall a. RealFloat a => a -> Int
+ floatDigits :: forall a. RealFloat a => a -> Int
+ floatRadix :: forall a. RealFloat a => a -> Integer
+ floatRange :: forall a. RealFloat a => a -> (Int, Int)
+ isDenormalized :: forall a. RealFloat a => a -> Bool
+ isIEEE :: forall a. RealFloat a => a -> Bool
+ isInfinite :: forall a. RealFloat a => a -> Bool
+ isNaN :: forall a. RealFloat a => a -> Bool
+ isNegativeZero :: forall a. RealFloat a => a -> Bool
+ log :: forall a. Floating a => a -> a
+ logBase :: forall a. Floating a => a -> a -> a
+ pi :: forall a. Floating a => a
+ scaleFloat :: forall a. RealFloat a => Int -> a -> a
+ significand :: forall a. RealFloat a => a -> a
+ sin :: forall a. Floating a => a -> a
+ sinh :: forall a. Floating a => a -> a
+ sqrt :: forall a. Floating a => a -> a
+ tan :: forall a. Floating a => a -> a
+ tanh :: forall a. Floating a => a -> a
ioError :: forall a.
GHC.Internal.Stack.Types.HasCallStack =>
IOError -> IO a
@@ -105,6 +125,7 @@ holes3.hs:11:15: error: [GHC-88464]
[a] -> [a]
drop :: forall a. Int -> [a] -> [a]
dropWhile :: forall a. (a -> Bool) -> [a] -> [a]
+ filter :: forall a. (a -> Bool) -> [a] -> [a]
head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
init :: forall a.
GHC.Internal.Stack.Types.HasCallStack =>
@@ -123,80 +144,57 @@ holes3.hs:11:15: error: [GHC-88464]
[a] -> [a]
take :: forall a. Int -> [a] -> [a]
takeWhile :: forall a. (a -> Bool) -> [a] -> [a]
- subtract :: forall a. Num a => a -> a -> a
- readParen :: forall a. Bool -> ReadS a -> ReadS a
- (^) :: forall a b. (Num a, Integral b) => a -> b -> a
- even :: forall a. Integral a => a -> Bool
- gcd :: forall a. Integral a => a -> a -> a
- lcm :: forall a. Integral a => a -> a -> a
- odd :: forall a. Integral a => a -> Bool
- (**) :: forall a. Floating a => a -> a -> a
- acos :: forall a. Floating a => a -> a
- acosh :: forall a. Floating a => a -> a
- asin :: forall a. Floating a => a -> a
- asinh :: forall a. Floating a => a -> a
- atan :: forall a. Floating a => a -> a
- atanh :: forall a. Floating a => a -> a
- cos :: forall a. Floating a => a -> a
- cosh :: forall a. Floating a => a -> a
- exp :: forall a. Floating a => a -> a
- log :: forall a. Floating a => a -> a
- logBase :: forall a. Floating a => a -> a -> a
- pi :: forall a. Floating a => a
- sin :: forall a. Floating a => a -> a
- sinh :: forall a. Floating a => a -> a
- sqrt :: forall a. Floating a => a -> a
- tan :: forall a. Floating a => a -> a
- tanh :: forall a. Floating a => a -> a
- atan2 :: forall a. RealFloat a => a -> a -> a
- decodeFloat :: forall a. RealFloat a => a -> (Integer, Int)
- encodeFloat :: forall a. RealFloat a => Integer -> Int -> a
- exponent :: forall a. RealFloat a => a -> Int
- floatDigits :: forall a. RealFloat a => a -> Int
- floatRadix :: forall a. RealFloat a => a -> Integer
- floatRange :: forall a. RealFloat a => a -> (Int, Int)
- isDenormalized :: forall a. RealFloat a => a -> Bool
- isIEEE :: forall a. RealFloat a => a -> Bool
- isInfinite :: forall a. RealFloat a => a -> Bool
- isNaN :: forall a. RealFloat a => a -> Bool
- isNegativeZero :: forall a. RealFloat a => a -> Bool
- scaleFloat :: forall a. RealFloat a => Int -> a -> a
- significand :: forall a. RealFloat a => a -> a
(*) :: forall a. Num a => a -> a -> a
(+) :: forall a. Num a => a -> a -> a
+ (-) :: forall a. Num a => a -> a -> a
abs :: forall a. Num a => a -> a
+ fromInteger :: forall a. Num a => Integer -> a
+ negate :: forall a. Num a => a -> a
signum :: forall a. Num a => a -> a
+ subtract :: forall a. Num a => a -> a -> a
+ readParen :: forall a. Bool -> ReadS a -> ReadS a
(/) :: forall a. Fractional a => a -> a -> a
- recip :: forall a. Fractional a => a -> a
+ (^) :: forall a b. (Num a, Integral b) => a -> b -> a
div :: forall a. Integral a => a -> a -> a
divMod :: forall a. Integral a => a -> a -> (a, a)
+ even :: forall a. Integral a => a -> Bool
+ fromIntegral :: forall a b. (Integral a, Num b) => a -> b
+ fromRational :: forall a. Fractional a => Rational -> a
+ gcd :: forall a. Integral a => a -> a -> a
+ lcm :: forall a. Integral a => a -> a -> a
mod :: forall a. Integral a => a -> a -> a
+ odd :: forall a. Integral a => a -> Bool
quot :: forall a. Integral a => a -> a -> a
quotRem :: forall a. Integral a => a -> a -> (a, a)
+ recip :: forall a. Fractional a => a -> a
rem :: forall a. Integral a => a -> a -> a
- zip :: forall a b. [a] -> [b] -> [(a, b)]
+ toInteger :: forall a. Integral a => a -> Integer
+ toRational :: forall a. Real a => a -> Rational
+ Just :: forall a. a -> Maybe a
+ Nothing :: forall a. Maybe a
+ (:) :: forall a. a -> [a] -> [a]
+ [] :: forall a. [a]
+ const :: forall a b. a -> b -> a
map :: forall a b. (a -> b) -> [a] -> [b]
- realToFrac :: forall a b. (Real a, Fractional b) => a -> b
Left :: forall a b. a -> Either a b
Right :: forall a b. b -> Either a b
- (,) :: forall a b. a -> b -> (a, b)
- const :: forall a b. a -> b -> a
maybe :: forall b a. b -> (a -> b) -> Maybe a -> b
fst :: forall a b. (a, b) -> a
snd :: forall a b. (a, b) -> b
scanl :: forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanr :: forall a b. (a -> b -> b) -> b -> [a] -> [b]
unzip :: forall a b. [(a, b)] -> ([a], [b])
+ zip :: forall a b. [a] -> [b] -> [(a, b)]
(^^) :: forall a b. (Fractional a, Integral b) => a -> b -> a
ceiling :: forall a b. (RealFrac a, Integral b) => a -> b
floor :: forall a b. (RealFrac a, Integral b) => a -> b
properFraction :: forall a b.
(RealFrac a, Integral b) =>
a -> (b, a)
+ realToFrac :: forall a b. (Real a, Fractional b) => a -> b
round :: forall a b. (RealFrac a, Integral b) => a -> b
truncate :: forall a b. (RealFrac a, Integral b) => a -> b
- seq :: forall a b. a -> b -> b
- (,,) :: forall a b c. a -> b -> c -> (a, b, c)
+ (,) :: forall a b. a -> b -> (a, b)
($!) :: forall a b. (a -> b) -> a -> b
(.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
@@ -205,11 +203,13 @@ holes3.hs:11:15: error: [GHC-88464]
unzip3 :: forall a b c. [(a, b, c)] -> ([a], [b], [c])
zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
+ seq :: forall a b. a -> b -> b
+ (,,) :: forall a b c. a -> b -> c -> (a, b, c)
($) :: forall a b. (a -> b) -> a -> b
- (,,,) :: forall a b c d. a -> b -> c -> d -> (a, b, c, d)
flip :: forall a b c. (a -> b -> c) -> b -> a -> c
zipWith3 :: forall a b c d.
(a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
+ (,,,) :: forall a b c d. a -> b -> c -> d -> (a, b, c, d)
(,,,,) :: forall a b c d e.
a -> b -> c -> d -> e -> (a, b, c, d, e)
(,,,,,) :: forall a b c d e f.
=====================================
testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
=====================================
@@ -4,8 +4,8 @@ refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Relevant bindings include
f :: [Integer] -> Integer (bound at refinement_hole_fits.hs:4:1)
Valid hole fits include
- f :: [Integer] -> Integer (bound at refinement_hole_fits.hs:4:1)
g :: [Integer] -> Integer (bound at refinement_hole_fits.hs:7:1)
+ f :: [Integer] -> Integer (bound at refinement_hole_fits.hs:4:1)
head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
with head @Integer
(imported from ‘Prelude’
@@ -15,19 +15,19 @@ refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.List’))
maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
- with maximum @[] @Integer
+ with maximum @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
- with minimum @[] @Integer
+ with minimum @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
- with product @[] @Integer
+ with product @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
- with sum @[] @Integer
+ with sum @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
Valid refinement hole fits include
@@ -35,35 +35,35 @@ refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
where foldl1 :: forall (t :: * -> *) a.
Foldable t =>
(a -> a -> a) -> t a -> a
- with foldl1 @[] @Integer
+ with foldl1 @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
foldr1 (_ :: Integer -> Integer -> Integer)
where foldr1 :: forall (t :: * -> *) a.
Foldable t =>
(a -> a -> a) -> t a -> a
- with foldr1 @[] @Integer
+ with foldr1 @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
foldl (_ :: Integer -> Integer -> Integer) (_ :: Integer)
where foldl :: forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
- with foldl @[] @Integer @Integer
+ with foldl @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
foldl' (_ :: Integer -> Integer -> Integer) (_ :: Integer)
where foldl' :: forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
- with foldl' @[] @Integer @Integer
+ with foldl' @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
foldr (_ :: Integer -> Integer -> Integer) (_ :: Integer)
where foldr :: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
- with foldr @[] @Integer @Integer
+ with foldr @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
const (_ :: Integer)
@@ -84,14 +84,14 @@ refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with ($!) @GHC.Internal.Types.LiftedRep @[Integer] @Integer
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- return (_ :: Integer)
- where return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @((->) [Integer]) @Integer
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Base’))
pure (_ :: Integer)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @((->) [Integer]) @Integer
+ with pure @((->) [Integer])
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Base’))
+ return (_ :: Integer)
+ where return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @((->) [Integer])
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
j (_ :: [Integer] -> Integer)
@@ -141,12 +141,12 @@ refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with const @Integer @[Integer]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @((->) [Integer]) @Integer
+ pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ with pure @((->) [Integer])
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @((->) [Integer]) @Integer
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @((->) [Integer])
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
Valid refinement hole fits include
@@ -154,21 +154,21 @@ refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
where foldl :: forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
- with foldl @[] @Integer @Integer
+ with foldl @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
foldl' (_ :: Integer -> Integer -> Integer)
where foldl' :: forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
- with foldl' @[] @Integer @Integer
+ with foldl' @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
foldr (_ :: Integer -> Integer -> Integer)
where foldr :: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
- with foldr @[] @Integer @Integer
+ with foldr @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
curry (_ :: (Integer, [Integer]) -> Integer)
@@ -204,14 +204,14 @@ refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
@([Integer] -> Integer)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
- return (_ :: [Integer] -> Integer)
- where return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @((->) Integer) @([Integer] -> Integer)
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Base’))
pure (_ :: [Integer] -> Integer)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @((->) Integer) @([Integer] -> Integer)
+ with pure @((->) Integer)
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Base’))
+ return (_ :: [Integer] -> Integer)
+ where return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @((->) Integer)
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
j (_ :: Integer -> [Integer] -> Integer)
=====================================
testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
=====================================
@@ -26,15 +26,15 @@ subsumption_sort_hole_fits.hs:2:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdef
fail :: forall (m :: * -> *) a.
(MonadFail m, GHC.Internal.Stack.Types.HasCallStack) =>
String -> m a
- with fail @[] @String
+ with fail @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Control.Monad.Fail’))
return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @[] @String
+ with return @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @[] @String
+ with pure @[]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Base’))
=====================================
testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr
=====================================
@@ -1,4 +1,3 @@
-
type_in_type_hole_fits.hs:79:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole:
_a :: [Integer] -> Sorted (O (NLogN 2 0)) (O N) True Integer
@@ -14,18 +13,18 @@ type_in_type_hole_fits.hs:79:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefau
[a] -> Sorted cpu mem stable a
with Sorted @(O (NLogN 2 0)) @(O N) @True @Integer
(defined at type_in_type_hole_fits.hs:54:18)
- mergeSort :: forall a (n :: AsympPoly) (m :: AsympPoly)
- (s :: Bool).
- (Ord a, n >=. O (N *. LogN), m >=. O N, IsStable s) =>
- [a] -> Sorted n m s a
- with mergeSort @Integer @(O (NLogN 2 0)) @(O N) @True
- (defined at type_in_type_hole_fits.hs:61:1)
insertionSort :: forall a (n :: AsympPoly) (m :: AsympPoly)
(s :: Bool).
(Ord a, n >=. O (N ^. 2), m >=. O One, IsStable s) =>
[a] -> Sorted n m s a
with insertionSort @Integer @(O (NLogN 2 0)) @(O N) @True
(defined at type_in_type_hole_fits.hs:65:1)
+ mergeSort :: forall a (n :: AsympPoly) (m :: AsympPoly)
+ (s :: Bool).
+ (Ord a, n >=. O (N *. LogN), m >=. O N, IsStable s) =>
+ [a] -> Sorted n m s a
+ with mergeSort @Integer @(O (NLogN 2 0)) @(O N) @True
+ (defined at type_in_type_hole_fits.hs:61:1)
type_in_type_hole_fits.hs:82:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole:
@@ -37,16 +36,16 @@ type_in_type_hole_fits.hs:82:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefau
mySortB :: Sorted (O (N *. LogN)) (O N) False Integer
(bound at type_in_type_hole_fits.hs:82:1)
Valid hole fits include
- quickSort :: forall a (n :: AsympPoly) (m :: AsympPoly).
- (Ord a, n >=. O (N *. LogN), m >=. O N) =>
- [a] -> Sorted n m False a
- with quickSort @Integer @(O (NLogN 1 1)) @(O N)
- (defined at type_in_type_hole_fits.hs:71:1)
heapSort :: forall a (n :: AsympPoly) (m :: AsympPoly).
(Ord a, n >=. O (N *. LogN), m >=. O One) =>
[a] -> Sorted n m False a
with heapSort @Integer @(O (NLogN 1 1)) @(O N)
(defined at type_in_type_hole_fits.hs:74:1)
+ quickSort :: forall a (n :: AsympPoly) (m :: AsympPoly).
+ (Ord a, n >=. O (N *. LogN), m >=. O N) =>
+ [a] -> Sorted n m False a
+ with quickSort @Integer @(O (NLogN 1 1)) @(O N)
+ (defined at type_in_type_hole_fits.hs:71:1)
Sorted :: forall (cpu :: AsympPoly) (mem :: AsympPoly)
(stable :: Bool) a.
[a] -> Sorted cpu mem stable a
@@ -79,3 +78,4 @@ type_in_type_hole_fits.hs:85:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefau
[a] -> Sorted cpu mem stable a
with Sorted @(O (NLogN 1 1)) @(O One) @False @Integer
(defined at type_in_type_hole_fits.hs:54:18)
+
=====================================
testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
=====================================
@@ -25,15 +25,15 @@ valid_hole_fits.hs:17:17: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
x :: Int (bound at valid_hole_fits.hs:16:12)
c :: Int -> IO Int (bound at valid_hole_fits.hs:16:1)
Valid hole fits include
- c :: Int -> IO Int (bound at valid_hole_fits.hs:16:1)
a :: Int -> IO Int (bound at valid_hole_fits.hs:12:1)
b :: Int -> IO Int (bound at valid_hole_fits.hs:14:1)
- return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @IO @Int
+ c :: Int -> IO Int (bound at valid_hole_fits.hs:16:1)
+ pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ with pure @IO
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Base’))
- pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @IO @Int
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @IO
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Base’))
@@ -82,12 +82,12 @@ valid_hole_fits.hs:27:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with Just @Integer
(imported from ‘Data.Maybe’ at valid_hole_fits.hs:5:1-17
(and originally defined in ‘GHC.Internal.Maybe’))
- return :: forall (m :: * -> *) a. Monad m => a -> m a
- with return @Maybe @Integer
+ pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+ with pure @Maybe
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Base’))
- pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- with pure @Maybe @Integer
+ return :: forall (m :: * -> *) a. Monad m => a -> m a
+ with return @Maybe
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Base’))
@@ -100,28 +100,28 @@ valid_hole_fits.hs:30:10: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Relevant bindings include
f :: String (bound at valid_hole_fits.hs:30:1)
Valid hole fits include
- f :: String (bound at valid_hole_fits.hs:30:1)
- k :: Maybe Integer (defined at valid_hole_fits.hs:27:1)
h :: String (bound at valid_hole_fits.hs:34:1)
+ k :: Maybe Integer (defined at valid_hole_fits.hs:27:1)
+ f :: String (bound at valid_hole_fits.hs:30:1)
otherwise :: Bool
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Base’))
- False :: Bool
+ EQ :: Ordering
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Types’))
- True :: Bool
+ GT :: Ordering
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Types’))
LT :: Ordering
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Types’))
- EQ :: Ordering
+ () :: () (bound at <wired into compiler>)
+ False :: Bool
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Types’))
- GT :: Ordering
+ True :: Bool
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Types’))
- () :: () (bound at <wired into compiler>)
pi :: forall a. Floating a => a
with pi @Double
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
@@ -139,22 +139,14 @@ valid_hole_fits.hs:34:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
not :: Bool -> Bool
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Classes’))
- enumFrom :: forall a. Enum a => a -> [a]
- with enumFrom @Bool
- (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
- (and originally defined in ‘GHC.Internal.Enum’))
- Just :: forall a. a -> Maybe a
- with Just @Bool
- (imported from ‘Data.Maybe’ at valid_hole_fits.hs:5:1-17
- (and originally defined in ‘GHC.Internal.Maybe’))
id :: forall a. a -> a
with id @Bool
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Base’))
- repeat :: forall a. a -> [a]
- with repeat @Bool
+ enumFrom :: forall a. Enum a => a -> [a]
+ with enumFrom @Bool
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
- (and originally defined in ‘GHC.Internal.List’))
+ (and originally defined in ‘GHC.Internal.Enum’))
fromEnum :: forall a. Enum a => a -> Int
with fromEnum @Bool
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
@@ -167,10 +159,18 @@ valid_hole_fits.hs:34:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with succ @Bool
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Enum’))
+ repeat :: forall a. a -> [a]
+ with repeat @Bool
+ (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
+ (and originally defined in ‘GHC.Internal.List’))
show :: forall a. Show a => a -> String
with show @Bool
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Show’))
+ Just :: forall a. a -> Maybe a
+ with Just @Bool
+ (imported from ‘Data.Maybe’ at valid_hole_fits.hs:5:1-17
+ (and originally defined in ‘GHC.Internal.Maybe’))
valid_hole_fits.hs:34:14: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: Bool
@@ -213,7 +213,7 @@ valid_hole_fits.hs:38:10: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with (:) @a
(bound at <wired into compiler>)
(<$) :: forall (f :: * -> *) a b. Functor f => a -> f b -> f a
- with (<$) @[] @a @a
+ with (<$) @[]
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Base’))
seq :: forall a b. a -> b -> b
@@ -243,16 +243,16 @@ valid_hole_fits.hs:41:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with readIO @()
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.System.IO’))
- print :: forall a. Show a => a -> IO ()
- with print @String
- (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
- (and originally defined in ‘GHC.Internal.System.IO’))
fail :: forall (m :: * -> *) a.
(MonadFail m, GHC.Internal.Stack.Types.HasCallStack) =>
String -> m a
- with fail @IO @()
+ with fail @IO
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Internal.Control.Monad.Fail’))
+ print :: forall a. Show a => a -> IO ()
+ with print @String
+ (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
+ (and originally defined in ‘GHC.Internal.System.IO’))
mempty :: forall a. Monoid a => a
with mempty @(String -> IO ())
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
=====================================
testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr
=====================================
@@ -1,10 +1,10 @@
-
valid_hole_fits_interactions.hs:15:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: SBool True
• In an equation for ‘f’: f = _
• Relevant bindings include
f :: SBool True (bound at valid_hole_fits_interactions.hs:15:1)
Valid hole fits include
- f :: SBool True (bound at valid_hole_fits_interactions.hs:15:1)
STrue :: SBool True
(defined at valid_hole_fits_interactions.hs:12:3)
+ f :: SBool True (bound at valid_hole_fits_interactions.hs:15:1)
+
=====================================
testsuite/tests/typecheck/should_fail/T14884.stderr
=====================================
@@ -5,18 +5,18 @@ T14884.hs:4:5: error: [GHC-88464]
In an equation for ‘x’: x = _ print "abc"
• Relevant bindings include x :: IO () (bound at T14884.hs:4:1)
Valid hole fits include
+ foldMap :: forall (t :: * -> *) m a.
+ (Foldable t, Monoid m) =>
+ (a -> m) -> t a -> m
+ with foldMap @[]
+ (imported from ‘Prelude’
+ (and originally defined in ‘GHC.Internal.Data.Foldable’))
mapM_ :: forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
with mapM_ @[] @IO @Char @()
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.Foldable’))
- foldMap :: forall (t :: * -> *) m a.
- (Foldable t, Monoid m) =>
- (a -> m) -> t a -> m
- with foldMap @[] @(IO ()) @Char
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Data.Foldable’))
id :: forall a. a -> a
with id @(String -> IO ())
(imported from ‘Prelude’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb0628b1ed44c6f80a1c9fb409f115…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb0628b1ed44c6f80a1c9fb409f115…
You're receiving this email because of your account on gitlab.haskell.org.
1
0