[Git][ghc/ghc][wip/T23109] 16 commits: template-haskell: improve changelog
by Simon Peyton Jones (＠simonpj) 28 Jun '25
by Simon Peyton Jones (＠simonpj) 28 Jun '25
28 Jun '25
Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC
Commits:
4b748a99 by Teo Camarasu at 2025-06-24T15:31:07-04:00
template-haskell: improve changelog
stable -> more stable, just to clarify that this interface isn't fully stable.
errornously -> mistakenly: I typod this and also let's go for a simpler word
- - - - -
e358e477 by Sylvain Henry at 2025-06-24T15:31:58-04:00
Bump stack resolver to use GHC 9.6.7
Cf #26139
- - - - -
4bf5eb63 by fendor at 2025-06-25T17:05:43-04:00
Teach `:reload` about multiple home units
`:reload` needs to lookup the `ModuleName` and must not assume the given
`ModuleName` is in the current `HomeUnit`.
We add a new utility function which allows us to find a `HomeUnitModule`
instead of a `Module`.
Further, we introduce the `GhciCommandError` type which can be used to
abort the execution of a GHCi command.
This error is caught and printed in a human readable fashion.
- - - - -
b3d97bb3 by fendor at 2025-06-25T17:06:25-04:00
Implement `-fno-load-initial-targets` flag
We add the new flag `-fno-load-initial-targets` which doesn't load all `Target`s
immediately but only computes the module graph for all `Target`s.
The user can then decide to load modules from that module graph using
the syntax:
ghci> :reload <Mod>
This will load everything in the module graph up to `Mod`.
The user can return to the initial state by using the builtin target
`none` to unload all modules.
ghci> :reload none
Is in principle identical to starting a new session with the
`-fno-load-initial-targets` flag.
The `-fno-load-initial-targets` flag allows for faster startup time of GHCi when a
user has lots of `Target`s.
We additionally extend the `:reload` command to accept multiple
`ModuleName`s. For example:
ghci> :reload <Mod1> <Mod2>
Loads all modules up to the modules `Mod1` and `Mod2`.
- - - - -
49f44e52 by Teo Camarasu at 2025-06-26T04:19:51-04:00
Expose ghc-internal unit id through the settings file
This in combination with the unit id of the compiler library allows
cabal to know of the two unit ids that should not be reinstalled (in
specific circumstances) as:
- when using plugins, we want to link against exactly the compiler unit
id
- when using TemplateHaskell we want to link against exactly the package
that contains the TemplateHaskell interfaces, which is `ghc-internal`
See: <https://github.com/haskell/cabal/issues/10087>
Resolves #25282
- - - - -
499c4efe by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Fix and clean up capture of timings
* Fixes the typo that caused 'cat ci-timings' to report "no such file or
directory"
* Gave ci_timings.txt a file extension so it may play better with other
systems
* Fixed the use of time_it so all times are recorded
* Fixed time_it to print name along with timing
- - - - -
86c90c9e by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Update collapsible section usage
The syntax apparently changed at some point.
- - - - -
04308ee4 by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Add more collapsible sections
- - - - -
43b606bb by Florian Ragwitz at 2025-06-27T16:31:26-04:00
Tick uses of wildcard/pun field binds as if using the record selector function
Fixes #17834.
See Note [Record-selector ticks] for additional reasoning behind this as well
as an overview of the implementation details and future improvements.
- - - - -
d4952549 by Ben Gamari at 2025-06-27T16:32:08-04:00
testsuite/caller-cc: Make CallerCc[123] less sensitive
These were previously sensitive to irrelevant changes in program
structure. To avoid this we filter out all by lines emitted by the
-fcaller-cc from the profile.
- - - - -
173fa540 by Simon Peyton Jones at 2025-06-28T15:25:10+01:00
Make injecting implicit bindings into its own pass
Previously we were injecting "impliicit bindings" (data constructor
worker and wrappers etc)
- both at the end of CoreTidy,
- and at the start of CorePrep
This is unpleasant and confusing. This patch puts it it its own pass,
addImplicitBinds, which runs between the two.
The function `GHC.CoreToStg.AddImplicitBinds.addImplicitBinds` now takes /all/
TyCons, not just the ones for algebraic data types. That change ripples
through to
- corePrepPgm
- doCodeGen
- byteCodeGen
All take [TyCon] which includes all TyCons
- - - - -
a2d3dde8 by Simon Peyton Jones at 2025-06-28T15:25:10+01:00
Implement unary classes
The big change is described exhaustively in
Note [Unary class magic] in GHC.Core.TyCon
Other changes
* We never unbox class dictionaries in worker/wrapper. This has been true for some
time now, but the logic is now centralised in functions in
GHC.Core.Opt.WorkWrap.Utils, namely `canUnboxTyCon`, and `canUnboxArg`
See Note [Do not unbox class dictionaries] in GHC.Core.Opt.WorkWrap.Utils.
* Refactored the `notWorthFloating` logic in GHc.Core.Opt.SetLevels.
I can't remember if I actually changed any behaviour here, but if so it's
only in a corner cases.
* Fixed a bug in `GHC.Core.TyCon.isEnumerationTyCon`, which was wrongly returning
True for (##).
* Remove redundant Role argument to `liftCoSubstWithEx`. It was always
Representational.
* I refactored evidence generation in the constraint solver:
* Made GHC.Tc.Types.Evidence contain better abstactions for evidence
generation.
* I deleted the file `GHC.Tc.Types.EvTerm` and merged its (small) contents
elsewhere. It wasn't paying its way.
* Made evidence for implicit parameters go via a proper abstraction.
Smaller things
* Rename `isDataTyCon` to `isBoxedDataTyCon`.
* GHC.Core.Corecion.liftCoSubstWithEx was only called with Representational role,
so I baked that into the function and removed the argument.
* Get rid of `GHC.Core.TyCon.tyConSingleAlgDataCon_maybe` in favour of calling
`not isNewTyCon` at the call sites; more explicit.
* Refatored `GHC.Core.TyCon.isInjectiveTyCon`; but I don't think I changed its
behaviour
* Moved `decomposeIPPred` to GHC.Core.Predicate
- - - - -
50fa8426 by Simon Peyton Jones at 2025-06-28T15:32:48+01:00
Renaming around predicate types
.. we were (as it turned out) abstracting over
type-class selectors in SPECIALISATION rules!
- - - - -
57898657 by Simon Peyton Jones at 2025-06-28T15:32:48+01:00
Small hacky fix to specUnfolding
...just using mkApps instead of mkCoreApps
(This part is likely to change again in a
future commit.)
- - - - -
16b0bd0c by Simon Peyton Jones at 2025-06-28T15:32:48+01:00
Slight improvement to pre/postInlineUnconditionally
Avoids an extra simplifier iteration
- - - - -
9589a3a6 by Simon Peyton Jones at 2025-06-28T15:32:48+01:00
Accept GHCi debugger output change
@alt-romes says this is fine
- - - - -
159 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/common.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/ByteCode/InfoTable.hs
- compiler/GHC/Core/Class.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg.hs
- + compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/Call.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- − compiler/GHC/Tc/Types/EvTerm.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Types/TyThing.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/Setup.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Exception.hs
- ghc/GHCi/UI/Print.hs
- hadrian/src/Rules/Generate.hs
- hadrian/stack.yaml
- hadrian/stack.yaml.lock
- libraries/template-haskell/changelog.md
- testsuite/tests/core-to-stg/T24124.stderr
- testsuite/tests/deSugar/should_compile/T2431.stderr
- testsuite/tests/dmdanal/should_compile/T16029.stdout
- testsuite/tests/dmdanal/sigs/T21119.stderr
- testsuite/tests/dmdanal/sigs/T21888.stderr
- testsuite/tests/ghc-e/should_fail/T18441fail5.stderr
- testsuite/tests/ghci.debugger/scripts/break011.stdout
- testsuite/tests/ghci.debugger/scripts/break024.stdout
- testsuite/tests/ghci/prog-mhu003/prog-mhu003.stderr
- testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stderr
- + testsuite/tests/ghci/prog-mhu005/Makefile
- + testsuite/tests/ghci/prog-mhu005/a/A.hs
- + testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/b/B.hs
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stdout
- + testsuite/tests/ghci/prog-mhu005/unitA
- + testsuite/tests/ghci/prog-mhu005/unitB
- + testsuite/tests/ghci/prog021/A.hs
- + testsuite/tests/ghci/prog021/B.hs
- + testsuite/tests/ghci/prog021/Makefile
- + testsuite/tests/ghci/prog021/all.T
- + testsuite/tests/ghci/prog021/prog021a.script
- + testsuite/tests/ghci/prog021/prog021a.stderr
- + testsuite/tests/ghci/prog021/prog021a.stdout
- + testsuite/tests/ghci/prog021/prog021b.script
- + testsuite/tests/ghci/prog021/prog021b.stderr
- + testsuite/tests/ghci/prog021/prog021b.stdout
- + testsuite/tests/ghci/prog022/A.hs
- + testsuite/tests/ghci/prog022/B.hs
- + testsuite/tests/ghci/prog022/Makefile
- + testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022a.script
- + testsuite/tests/ghci/prog022/ghci.prog022a.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022a.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022b.script
- + testsuite/tests/ghci/prog022/ghci.prog022b.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022b.stdout
- testsuite/tests/ghci/scripts/ghci021.stderr
- + testsuite/tests/hpc/recsel/Makefile
- + testsuite/tests/hpc/recsel/recsel.hs
- + testsuite/tests/hpc/recsel/recsel.stdout
- + testsuite/tests/hpc/recsel/test.T
- testsuite/tests/indexed-types/should_compile/T2238.hs
- testsuite/tests/numeric/should_compile/T15547.stderr
- testsuite/tests/numeric/should_compile/T23907.stderr
- testsuite/tests/profiling/should_run/caller-cc/all.T
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/simplCore/should_compile/DataToTagFamilyScrut.stderr
- testsuite/tests/simplCore/should_compile/T15205.stderr
- testsuite/tests/simplCore/should_compile/T17366.stderr
- testsuite/tests/simplCore/should_compile/T17966.stderr
- testsuite/tests/simplCore/should_compile/T22309.stderr
- testsuite/tests/simplCore/should_compile/T22375DataFamily.stderr
- testsuite/tests/simplCore/should_compile/T23307.stderr
- testsuite/tests/simplCore/should_compile/T23307a.stderr
- testsuite/tests/simplCore/should_compile/T25389.stderr
- testsuite/tests/simplCore/should_compile/T25713.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplStg/should_compile/T15226b.stderr
- testsuite/tests/tcplugins/CtIdPlugin.hs
- testsuite/tests/typecheck/should_compile/Makefile
- testsuite/tests/typecheck/should_compile/T12763.stderr
- testsuite/tests/typecheck/should_compile/T14774.stdout
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/unboxedsums/unpack_sums_7.stdout
- testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs
- testsuite/tests/wasm/should_run/control-flow/RunWasm.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99ef3a43e3e6df491526890edf8dc6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99ef3a43e3e6df491526890edf8dc6…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26115] Crucial fix to short-cut solving
by Simon Peyton Jones (＠simonpj) 28 Jun '25
by Simon Peyton Jones (＠simonpj) 28 Jun '25
28 Jun '25
Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC
Commits:
a729a7c6 by Simon Peyton Jones at 2025-06-28T13:20:06+01:00
Crucial fix to short-cut solving
noMatchableGivenDict should take account of TcSShortCut
- - - - -
1 changed file:
- compiler/GHC/Tc/Solver/Dict.hs
Changes:
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -807,7 +807,8 @@ try_instances inerts work_item@(DictCt { di_ev = ev, di_cls = cls
| otherwise -- Wanted, but not cached
= do { dflags <- getDynFlags
- ; lkup_res <- matchClassInst dflags inerts cls xis dict_loc
+ ; mode <- getTcSMode
+ ; lkup_res <- matchClassInst dflags mode inerts cls xis dict_loc
; case lkup_res of
OneInst { cir_what = what }
-> do { let is_local_given = case what of { LocalInstance -> True; _ -> False }
@@ -865,10 +866,10 @@ checkInstanceOK loc what pred
| otherwise
= loc
-matchClassInst :: DynFlags -> InertSet
+matchClassInst :: DynFlags -> TcSMode -> InertSet
-> Class -> [Type]
-> CtLoc -> TcS ClsInstResult
-matchClassInst dflags inerts clas tys loc
+matchClassInst dflags mode inerts clas tys loc
-- First check whether there is an in-scope Given that could
-- match this constraint. In that case, do not use any instance
-- whether top level, or local quantified constraints.
@@ -879,7 +880,7 @@ matchClassInst dflags inerts clas tys loc
-- It is always safe to unpack constraint tuples
-- And if we don't do so, we may never solve it at all
-- See Note [Solving tuple constraints]
- , not (noMatchableGivenDicts inerts loc clas tys)
+ , not (noMatchableGivenDicts mode inerts loc clas tys)
= do { traceTcS "Delaying instance application" $
vcat [ text "Work item:" <+> pprClassPred clas tys ]
; return NotSure }
@@ -910,8 +911,11 @@ matchClassInst dflags inerts clas tys loc
-- potentially, match the given class constraint. This is used when checking to see if a
-- Given might overlap with an instance. See Note [Instance and Given overlap]
-- in GHC.Tc.Solver.Dict
-noMatchableGivenDicts :: InertSet -> CtLoc -> Class -> [TcType] -> Bool
-noMatchableGivenDicts inerts@(IS { inert_cans = inert_cans }) loc_w clas tys
+noMatchableGivenDicts :: TcSMode -> InertSet -> CtLoc -> Class -> [TcType] -> Bool
+noMatchableGivenDicts mode inerts@(IS { inert_cans = inert_cans }) loc_w clas tys
+ | TcSShortCut <- mode
+ = True -- In TcSShortCut mode we behave as if there were no Givens at all
+ | otherwise
= not $ anyBag matchable_given $
findDictsByClass (inert_dicts inert_cans) clas
where
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a729a7c6e96bd24724f3605adb96fb1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a729a7c6e96bd24724f3605adb96fb1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] testsuite/caller-cc: Make CallerCc[123] less sensitive
by Marge Bot (＠marge-bot) 27 Jun '25
by Marge Bot (＠marge-bot) 27 Jun '25
27 Jun '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d4952549 by Ben Gamari at 2025-06-27T16:32:08-04:00
testsuite/caller-cc: Make CallerCc[123] less sensitive
These were previously sensitive to irrelevant changes in program
structure. To avoid this we filter out all by lines emitted by the
-fcaller-cc from the profile.
- - - - -
1 changed file:
- testsuite/tests/profiling/should_run/caller-cc/all.T
Changes:
=====================================
testsuite/tests/profiling/should_run/caller-cc/all.T
=====================================
@@ -8,6 +8,7 @@ setTestOpts(only_ways(prof_ways))
setTestOpts(extra_files(['Main.hs']))
setTestOpts(extra_run_opts('7'))
setTestOpts(grep_prof("Main.hs"))
+setTestOpts(grep_prof("calling:"))
# N.B. Main.hs is stolen from heapprof001.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d495254997e5d0b7b2a16a00fed05ed…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d495254997e5d0b7b2a16a00fed05ed…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Tick uses of wildcard/pun field binds as if using the record selector function
by Marge Bot (＠marge-bot) 27 Jun '25
by Marge Bot (＠marge-bot) 27 Jun '25
27 Jun '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
43b606bb by Florian Ragwitz at 2025-06-27T16:31:26-04:00
Tick uses of wildcard/pun field binds as if using the record selector function
Fixes #17834.
See Note [Record-selector ticks] for additional reasoning behind this as well
as an overview of the implementation details and future improvements.
- - - - -
6 changed files:
- compiler/GHC/HsToCore/Ticks.hs
- docs/users_guide/9.14.1-notes.rst
- + testsuite/tests/hpc/recsel/Makefile
- + testsuite/tests/hpc/recsel/recsel.hs
- + testsuite/tests/hpc/recsel/recsel.stdout
- + testsuite/tests/hpc/recsel/test.T
Changes:
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -1,12 +1,11 @@
-{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE NondecreasingIndentation #-}
-{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-
(c) Galois, 2006
(c) University of Glasgow, 2007
+(c) Florian Ragwitz, 2025
-}
module GHC.HsToCore.Ticks
@@ -38,7 +37,9 @@ import GHC.Utils.Logger
import GHC.Types.SrcLoc
import GHC.Types.Basic
import GHC.Types.Id
+import GHC.Types.Id.Info
import GHC.Types.Var.Set
+import GHC.Types.Var.Env
import GHC.Types.Name.Set hiding (FreeVars)
import GHC.Types.Name
import GHC.Types.CostCentre
@@ -48,6 +49,7 @@ import GHC.Types.ProfAuto
import Control.Monad
import Data.List (isSuffixOf, intersperse)
+import Data.Foldable (toList)
import Trace.Hpc.Mix
@@ -123,6 +125,7 @@ addTicksToBinds logger cfg
, density = mkDensity tickish $ ticks_profAuto cfg
, this_mod = mod
, tickishType = tickish
+ , recSelBinds = emptyVarEnv
}
(binds',_,st') = unTM (addTickLHsBinds binds) env st
in (binds', st')
@@ -224,8 +227,7 @@ addTickLHsBind :: LHsBind GhcTc -> TM (LHsBind GhcTc)
addTickLHsBind (L pos (XHsBindsLR bind@(AbsBinds { abs_binds = binds
, abs_exports = abs_exports
}))) =
- withEnv add_exports $
- withEnv add_inlines $ do
+ withEnv (add_rec_sels . add_inlines . add_exports) $ do
binds' <- addTickLHsBinds binds
return $ L pos $ XHsBindsLR $ bind { abs_binds = binds' }
where
@@ -247,6 +249,12 @@ addTickLHsBind (L pos (XHsBindsLR bind@(AbsBinds { abs_binds = binds
| ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports
, isInlinePragma (idInlinePragma pid) ] }
+ add_rec_sels env =
+ env{ recSelBinds = recSelBinds env `extendVarEnvList`
+ [ (abe_mono, abe_poly)
+ | ABE{ abe_poly, abe_mono } <- abs_exports
+ , RecSelId{} <- [idDetails abe_poly] ] }
+
addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches }))) = do
let name = getOccString id
decl_path <- getPathEntry
@@ -261,6 +269,10 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches
tickish <- tickishType `liftM` getEnv
case tickish of { ProfNotes | inline -> return (L pos funBind); _ -> do
+ -- See Note [Record-selector ticks]
+ selTick <- recSelTick id
+ case selTick of { Just tick -> tick_rec_sel tick; _ -> do
+
(fvs, mg) <-
getFreeVars $
addPathEntry name $
@@ -288,7 +300,40 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches
let mbCons = maybe Prelude.id (:)
return $ L pos $ funBind { fun_matches = mg
, fun_ext = second (tick `mbCons`) (fun_ext funBind) }
- }
+ } }
+ where
+ -- See Note [Record-selector ticks]
+ tick_rec_sel tick =
+ pure $ L pos $ funBind { fun_ext = second (tick :) (fun_ext funBind) }
+
+
+-- Note [Record-selector ticks]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Users expect (see #17834) that accessing a record field by its name using
+-- NamedFieldPuns or RecordWildCards will mark it as covered. This is very
+-- reasonable, because otherwise the use of those two language features will
+-- produce unnecessary noise in coverage reports, distracting from real
+-- coverage problems.
+--
+-- Because of that, GHC chooses to treat record selectors specially for
+-- coverage purposes to improve the developer experience.
+--
+-- This is done by keeping track of which 'Id's are effectively bound to
+-- record fields (using NamedFieldPuns or RecordWildCards) in 'TickTransEnv's
+-- 'recSelBinds', and making 'HsVar's corresponding to those fields tick the
+-- appropriate box when executed.
+--
+-- To enable that, we also treat 'FunBind's for record selector functions
+-- specially. We only create a TopLevelBox for the record selector function,
+-- skipping the ExpBox that'd normally be created. This simplifies the re-use
+-- of ticks for the same record selector, and is done by not recursing into
+-- the fun_matches match group for record selector functions.
+--
+-- This scheme could be extended further in the future, making coverage for
+-- constructor fields (named or even positional) mean that the field was
+-- accessed at run-time. For the time being, we only cover NamedFieldPuns and
+-- RecordWildCards binds to cover most practical use-cases while keeping it
+-- simple.
-- TODO: Revisit this
addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs
@@ -471,7 +516,10 @@ addBinTickLHsExpr boxLabel e@(L pos e0)
-- in the addTickLHsExpr family of functions.)
addTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc)
-addTickHsExpr e@(HsVar _ (L _ id)) = do freeVar id; return e
+-- See Note [Record-selector ticks]
+addTickHsExpr e@(HsVar _ (L _ id)) =
+ freeVar id >> recSelTick id >>= pure . maybe e wrap
+ where wrap tick = XExpr . HsTick tick . noLocA $ e
addTickHsExpr e@(HsIPVar {}) = return e
addTickHsExpr e@(HsOverLit {}) = return e
addTickHsExpr e@(HsOverLabel{}) = return e
@@ -532,7 +580,7 @@ addTickHsExpr (HsMultiIf ty alts)
; alts' <- mapM (traverse $ addTickGRHS isOneOfMany False False) alts
; return $ HsMultiIf ty alts' }
addTickHsExpr (HsLet x binds e) =
- bindLocals (collectLocalBinders CollNoDictBinders binds) $ do
+ bindLocals binds $ do
binds' <- addTickHsLocalBinds binds -- to think about: !patterns.
e' <- addTickLHsExprLetBody e
return (HsLet x binds' e')
@@ -580,6 +628,7 @@ addTickHsExpr e@(HsUntypedSplice{}) = return e
addTickHsExpr e@(HsGetField {}) = return e
addTickHsExpr e@(HsProjection {}) = return e
addTickHsExpr (HsProc x pat cmdtop) =
+ bindLocals pat $
liftM2 (HsProc x)
(addTickLPat pat)
(traverse (addTickHsCmdTop) cmdtop)
@@ -646,19 +695,17 @@ addTickMatch :: Bool -> Bool -> Bool {-Is this Do Expansion-} -> Match GhcTc (L
-> TM (Match GhcTc (LHsExpr GhcTc))
addTickMatch isOneOfMany isLambda isDoExp match@(Match { m_pats = L _ pats
, m_grhss = gRHSs }) =
- bindLocals (collectPatsBinders CollNoDictBinders pats) $ do
+ bindLocals pats $ do
gRHSs' <- addTickGRHSs isOneOfMany isLambda isDoExp gRHSs
return $ match { m_grhss = gRHSs' }
addTickGRHSs :: Bool -> Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)
-> TM (GRHSs GhcTc (LHsExpr GhcTc))
addTickGRHSs isOneOfMany isLambda isDoExp (GRHSs x guarded local_binds) =
- bindLocals binders $ do
+ bindLocals local_binds $ do
local_binds' <- addTickHsLocalBinds local_binds
guarded' <- mapM (traverse (addTickGRHS isOneOfMany isLambda isDoExp)) guarded
return $ GRHSs x guarded' local_binds'
- where
- binders = collectLocalBinders CollNoDictBinders local_binds
addTickGRHS :: Bool -> Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc)
-> TM (GRHS GhcTc (LHsExpr GhcTc))
@@ -697,7 +744,7 @@ addTickLStmts isGuard stmts = do
addTickLStmts' :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt GhcTc] -> TM a
-> TM ([ExprLStmt GhcTc], a)
addTickLStmts' isGuard lstmts res
- = bindLocals (collectLStmtsBinders CollNoDictBinders lstmts) $
+ = bindLocals lstmts $
do { lstmts' <- mapM (traverse (addTickStmt isGuard)) lstmts
; a <- res
; return (lstmts', a) }
@@ -710,6 +757,7 @@ addTickStmt _isGuard (LastStmt x e noret ret) =
(pure noret)
(addTickSyntaxExpr hpcSrcSpan ret)
addTickStmt _isGuard (BindStmt xbs pat e) =
+ bindLocals pat $
liftM4 (\b f -> BindStmt $ XBindStmtTc
{ xbstc_bindOp = b
, xbstc_boundResultType = xbstc_boundResultType xbs
@@ -770,17 +818,19 @@ addTickApplicativeArg isGuard (op, arg) =
liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg)
where
addTickArg (ApplicativeArgOne m_fail pat expr isBody) =
- ApplicativeArgOne
- <$> mapM (addTickSyntaxExpr hpcSrcSpan) m_fail
- <*> addTickLPat pat
- <*> addTickLHsExpr expr
- <*> pure isBody
+ bindLocals pat $
+ ApplicativeArgOne
+ <$> mapM (addTickSyntaxExpr hpcSrcSpan) m_fail
+ <*> addTickLPat pat
+ <*> addTickLHsExpr expr
+ <*> pure isBody
addTickArg (ApplicativeArgMany x stmts ret pat ctxt) =
- (ApplicativeArgMany x)
- <$> addTickLStmts isGuard stmts
- <*> (unLoc <$> addTickLHsExpr (L (noAnnSrcSpan hpcSrcSpan) ret))
- <*> addTickLPat pat
- <*> pure ctxt
+ bindLocals pat $
+ ApplicativeArgMany x
+ <$> addTickLStmts isGuard stmts
+ <*> (unLoc <$> addTickLHsExpr (L (noAnnSrcSpan hpcSrcSpan) ret))
+ <*> addTickLPat pat
+ <*> pure ctxt
addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc
-> TM (ParStmtBlock GhcTc GhcTc)
@@ -871,7 +921,7 @@ addTickHsCmd (HsCmdIf x cnd e1 c2 c3) =
(addTickLHsCmd c2)
(addTickLHsCmd c3)
addTickHsCmd (HsCmdLet x binds c) =
- bindLocals (collectLocalBinders CollNoDictBinders binds) $ do
+ bindLocals binds $ do
binds' <- addTickHsLocalBinds binds -- to think about: !patterns.
c' <- addTickLHsCmd c
return (HsCmdLet x binds' c')
@@ -907,18 +957,16 @@ addTickCmdMatchGroup mg@(MG { mg_alts = (L l matches) }) = do
addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
addTickCmdMatch match@(Match { m_pats = L _ pats, m_grhss = gRHSs }) =
- bindLocals (collectPatsBinders CollNoDictBinders pats) $ do
+ bindLocals pats $ do
gRHSs' <- addTickCmdGRHSs gRHSs
return $ match { m_grhss = gRHSs' }
addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
addTickCmdGRHSs (GRHSs x guarded local_binds) =
- bindLocals binders $ do
+ bindLocals local_binds $ do
local_binds' <- addTickHsLocalBinds local_binds
guarded' <- mapM (traverse addTickCmdGRHS) guarded
return $ GRHSs x guarded' local_binds'
- where
- binders = collectLocalBinders CollNoDictBinders local_binds
addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
-- The *guards* are *not* Cmds, although the body is
@@ -937,15 +985,14 @@ addTickLCmdStmts stmts = do
addTickLCmdStmts' :: [LStmt GhcTc (LHsCmd GhcTc)] -> TM a
-> TM ([LStmt GhcTc (LHsCmd GhcTc)], a)
addTickLCmdStmts' lstmts res
- = bindLocals binders $ do
+ = bindLocals lstmts $ do
lstmts' <- mapM (traverse addTickCmdStmt) lstmts
a <- res
return (lstmts', a)
- where
- binders = collectLStmtsBinders CollNoDictBinders lstmts
addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
addTickCmdStmt (BindStmt x pat c) =
+ bindLocals pat $
liftM2 (BindStmt x)
(addTickLPat pat)
(addTickLHsCmd c)
@@ -1006,11 +1053,13 @@ addTickArithSeqInfo (FromThenTo e1 e2 e3) =
data TickTransState = TT { ticks :: !(SizedSeq Tick)
, ccIndices :: !CostCentreState
+ , recSelTicks :: !(IdEnv CoreTickish)
}
initTTState :: TickTransState
initTTState = TT { ticks = emptySS
, ccIndices = newCostCentreState
+ , recSelTicks = emptyVarEnv
}
addMixEntry :: Tick -> TM Int
@@ -1021,6 +1070,10 @@ addMixEntry ent = do
}
return c
+addRecSelTick :: Id -> CoreTickish -> TM ()
+addRecSelTick sel tick =
+ setState $ \s -> s{ recSelTicks = extendVarEnv (recSelTicks s) sel tick }
+
data TickTransEnv = TTE { fileName :: FastString
, density :: TickDensity
, tte_countEntries :: !Bool
@@ -1033,6 +1086,7 @@ data TickTransEnv = TTE { fileName :: FastString
, blackList :: Set RealSrcSpan
, this_mod :: Module
, tickishType :: TickishType
+ , recSelBinds :: IdEnv Id
}
-- deriving Show
@@ -1154,12 +1208,13 @@ ifGoodTickSrcSpan pos then_code else_code = do
good <- isGoodTickSrcSpan pos
if good then then_code else else_code
-bindLocals :: [Id] -> TM a -> TM a
-bindLocals new_ids (TM m)
- = TM $ \ env st ->
- case m env{ inScope = inScope env `extendVarSetList` new_ids } st of
- (r, fv, st') -> (r, fv `delListFromOccEnv` occs, st')
- where occs = [ nameOccName (idName id) | id <- new_ids ]
+bindLocals :: (CollectBinders bndr, CollectFldBinders bndr) => bndr -> TM a -> TM a
+bindLocals from (TM m) = TM $ \env st ->
+ case m (with_bnds env) st of
+ (r, fv, st') -> (r, fv `delListFromOccEnv` (map (nameOccName . idName) new_bnds), st')
+ where with_bnds e = e{ inScope = inScope e `extendVarSetList` new_bnds
+ , recSelBinds = recSelBinds e `plusVarEnv` collectFldBinds from }
+ new_bnds = collectBinds from
withBlackListed :: SrcSpan -> TM a -> TM a
withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) })
@@ -1186,6 +1241,17 @@ allocTickBox boxLabel countEntries topOnly pos m
tickish <- mkTickish boxLabel countEntries topOnly pos fvs (declPath env)
return (this_loc (XExpr $ HsTick tickish $ this_loc e))
+recSelTick :: Id -> TM (Maybe CoreTickish)
+recSelTick id = ifDensity TickForCoverage maybe_tick (pure Nothing)
+ where
+ maybe_tick = getEnv >>=
+ maybe (pure Nothing) tick . (`lookupVarEnv` id) . recSelBinds
+ tick sel = getState >>=
+ maybe (alloc sel) (pure . Just) . (`lookupVarEnv` sel) . recSelTicks
+ alloc sel = allocATickBox (box sel) False False (getSrcSpan sel) noFVs
+ >>= traverse (\t -> t <$ addRecSelTick sel t)
+ box sel = TopLevelBox [getOccString sel]
+
-- the tick application inherits the source position of its
-- expression argument to support nested box allocations
allocATickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> FreeVars
@@ -1288,3 +1354,98 @@ matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
matchCount :: LMatch GhcTc body -> Int
matchCount (L _ (Match { m_grhss = GRHSs _ grhss _ }))
= length grhss
+
+-- | Convenience class used by 'bindLocals' to collect new bindings from
+-- various parts of he AST. Just delegates to
+-- 'collect{Pat,Pats,Local,LStmts}Binders' from 'GHC.Hs.Utils' as appropriate.
+class CollectBinders a where
+ collectBinds :: a -> [Id]
+
+-- | Variant of 'CollectBinders' which collects information on which locals
+-- are bound to record fields (currently only via 'RecordWildCards' or
+-- 'NamedFieldPuns') to enable better coverage support for record selectors.
+--
+-- See Note [Record-selector ticks].
+class CollectFldBinders a where
+ collectFldBinds :: a -> IdEnv Id
+
+instance CollectBinders (LocatedA (Pat GhcTc)) where
+ collectBinds = collectPatBinders CollNoDictBinders
+instance CollectBinders [LocatedA (Pat GhcTc)] where
+ collectBinds = collectPatsBinders CollNoDictBinders
+instance CollectBinders (HsLocalBinds GhcTc) where
+ collectBinds = collectLocalBinders CollNoDictBinders
+instance CollectBinders [LocatedA (Stmt GhcTc (LocatedA (HsExpr GhcTc)))] where
+ collectBinds = collectLStmtsBinders CollNoDictBinders
+instance CollectBinders [LocatedA (Stmt GhcTc (LocatedA (HsCmd GhcTc)))] where
+ collectBinds = collectLStmtsBinders CollNoDictBinders
+
+instance (CollectFldBinders a) => CollectFldBinders [a] where
+ collectFldBinds = foldr (flip plusVarEnv . collectFldBinds) emptyVarEnv
+instance (CollectFldBinders e) => CollectFldBinders (GenLocated l e) where
+ collectFldBinds = collectFldBinds . unLoc
+instance CollectFldBinders (Pat GhcTc) where
+ collectFldBinds ConPat{ pat_args = RecCon HsRecFields{ rec_flds, rec_dotdot } } =
+ collectFldBinds rec_flds `plusVarEnv` plusVarEnvList (zipWith fld_bnds [0..] rec_flds)
+ where n_explicit | Just (L _ (RecFieldsDotDot n)) <- rec_dotdot = n
+ | otherwise = length rec_flds
+ fld_bnds n (L _ HsFieldBind{ hfbLHS = L _ FieldOcc{ foLabel = L _ sel }
+ , hfbRHS = L _ (VarPat _ (L _ var))
+ , hfbPun })
+ | hfbPun || n >= n_explicit = unitVarEnv var sel
+ fld_bnds _ _ = emptyVarEnv
+ collectFldBinds ConPat{ pat_args = PrefixCon pats } = collectFldBinds pats
+ collectFldBinds ConPat{ pat_args = InfixCon p1 p2 } = collectFldBinds [p1, p2]
+ collectFldBinds (LazyPat _ pat) = collectFldBinds pat
+ collectFldBinds (BangPat _ pat) = collectFldBinds pat
+ collectFldBinds (AsPat _ _ pat) = collectFldBinds pat
+ collectFldBinds (ViewPat _ _ pat) = collectFldBinds pat
+ collectFldBinds (ParPat _ pat) = collectFldBinds pat
+ collectFldBinds (ListPat _ pats) = collectFldBinds pats
+ collectFldBinds (TuplePat _ pats _) = collectFldBinds pats
+ collectFldBinds (SumPat _ pats _ _) = collectFldBinds pats
+ collectFldBinds (SigPat _ pat _) = collectFldBinds pat
+ collectFldBinds (XPat exp) = collectFldBinds exp
+ collectFldBinds VarPat{} = emptyVarEnv
+ collectFldBinds WildPat{} = emptyVarEnv
+ collectFldBinds OrPat{} = emptyVarEnv
+ collectFldBinds LitPat{} = emptyVarEnv
+ collectFldBinds NPat{} = emptyVarEnv
+ collectFldBinds NPlusKPat{} = emptyVarEnv
+ collectFldBinds SplicePat{} = emptyVarEnv
+ collectFldBinds EmbTyPat{} = emptyVarEnv
+ collectFldBinds InvisPat{} = emptyVarEnv
+instance (CollectFldBinders r) => CollectFldBinders (HsFieldBind l r) where
+ collectFldBinds = collectFldBinds . hfbRHS
+instance CollectFldBinders XXPatGhcTc where
+ collectFldBinds (CoPat _ pat _) = collectFldBinds pat
+ collectFldBinds (ExpansionPat _ pat) = collectFldBinds pat
+instance CollectFldBinders (HsLocalBinds GhcTc) where
+ collectFldBinds (HsValBinds _ bnds) = collectFldBinds bnds
+ collectFldBinds HsIPBinds{} = emptyVarEnv
+ collectFldBinds EmptyLocalBinds{} = emptyVarEnv
+instance CollectFldBinders (HsValBinds GhcTc) where
+ collectFldBinds (ValBinds _ bnds _) = collectFldBinds bnds
+ collectFldBinds (XValBindsLR (NValBinds bnds _)) = collectFldBinds (map snd bnds)
+instance CollectFldBinders (HsBind GhcTc) where
+ collectFldBinds PatBind{ pat_lhs } = collectFldBinds pat_lhs
+ collectFldBinds (XHsBindsLR AbsBinds{ abs_exports, abs_binds }) =
+ mkVarEnv [ (abe_poly, sel)
+ | ABE{ abe_poly, abe_mono } <- abs_exports
+ , Just sel <- [lookupVarEnv monos abe_mono] ]
+ where monos = collectFldBinds abs_binds
+ collectFldBinds VarBind{} = emptyVarEnv
+ collectFldBinds FunBind{} = emptyVarEnv
+ collectFldBinds PatSynBind{} = emptyVarEnv
+instance CollectFldBinders (Stmt GhcTc e) where
+ collectFldBinds (BindStmt _ pat _) = collectFldBinds pat
+ collectFldBinds (LetStmt _ bnds) = collectFldBinds bnds
+ collectFldBinds (ParStmt _ xs _ _) = collectFldBinds [s | ParStmtBlock _ ss _ _ <- toList xs, s <- ss]
+ collectFldBinds TransStmt{ trS_stmts } = collectFldBinds trS_stmts
+ collectFldBinds RecStmt{ recS_stmts } = collectFldBinds recS_stmts
+ collectFldBinds (XStmtLR (ApplicativeStmt _ args _)) = collectFldBinds (map snd args)
+ collectFldBinds LastStmt{} = emptyVarEnv
+ collectFldBinds BodyStmt{} = emptyVarEnv
+instance CollectFldBinders (ApplicativeArg GhcTc) where
+ collectFldBinds ApplicativeArgOne{ app_arg_pattern } = collectFldBinds app_arg_pattern
+ collectFldBinds ApplicativeArgMany{ bv_pattern } = collectFldBinds bv_pattern
=====================================
docs/users_guide/9.14.1-notes.rst
=====================================
@@ -138,6 +138,11 @@ Compiler
uses of the now deprecated ``pattern`` namespace specifier in import/export
lists. See `GHC Proposal #581, section 2.3 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0581-n…>`_.
+- Code coverage (:ghc-flag:`-fhpc`) now treats uses of record fields via
+ :extension:`RecordWildCards` or :extension:`NamedFieldPuns` as if the fields
+ were accessed using the generated record selector functions, marking the fields
+ as covered in coverage reports (:ghc-ticket:`17834`).
+
GHCi
~~~~
=====================================
testsuite/tests/hpc/recsel/Makefile
=====================================
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
=====================================
testsuite/tests/hpc/recsel/recsel.hs
=====================================
@@ -0,0 +1,49 @@
+{-# LANGUAGE RecordWildCards, NamedFieldPuns, Arrows #-}
+
+import Control.Monad.Identity
+import Control.Arrow (runKleisli, arr, returnA)
+import Data.Maybe
+import Data.List
+import Data.Bifunctor
+import Trace.Hpc.Mix
+import Trace.Hpc.Tix
+import Trace.Hpc.Reflect
+
+data Foo = Foo { fooA, fooB, fooC, fooD, fooE, fooF, fooG, fooH, fooI
+ , fooJ, fooK, fooL, fooM, fooN, fooO :: Int }
+data Bar = Bar { barFoo :: Foo }
+
+fAB Foo{..} = fooA + fooB
+fC Foo{fooC} = fooC
+fD x Foo{..} = fromMaybe 0 $ if x then Just fooD else Nothing
+fE Bar{barFoo = Foo{..}} = fooE
+fF Foo{fooF = f} = f
+fG f = let Foo{..} = f in fooG
+fH f = runIdentity $ do
+ Foo{..} <- pure f
+ return fooH
+fI f = runIdentity $ do
+ let Foo{..} = f
+ return fooI
+fJ f = [ fooJ | let Foo{..} = f ] !! 0
+fK = runIdentity . runKleisli (proc f -> do
+ Foo{..} <- arr id -< f
+ returnA -< fooK)
+fL = runIdentity . runKleisli (proc f -> do
+ let Foo{..} = f;
+ returnA -< fooL)
+fM f | Foo{..} <- f = fooM
+fN f = fooN f
+fO = runIdentity . runKleisli (proc Foo{..} -> returnA -< fooO)
+
+recSel (n, TopLevelBox [s]) | any (`isPrefixOf` s) ["foo", "bar"] = Just (n, s)
+recSel _ = Nothing
+
+main = do
+ let foo = Foo 42 23 0 1 2 3 4 5 6 7 0xaffe 9 10 11 12
+ mapM_ (print . ($ foo))
+ [fAB, fC, fD False, fE . Bar, fF, fG, fH, fI, fJ, fK, fL, fM, fN, fO]
+ (Mix _ _ _ _ mixs) <- readMix [".hpc"] (Left "Main")
+ let sels = mapMaybe recSel . zip [0..] $ map snd mixs
+ (Tix [TixModule "Main" _ _ tix]) <- examineTix
+ mapM_ print . sortOn snd $ map (first (tix !!)) sels
=====================================
testsuite/tests/hpc/recsel/recsel.stdout
=====================================
@@ -0,0 +1,30 @@
+65
+0
+0
+2
+3
+4
+5
+6
+7
+45054
+9
+10
+11
+12
+(0,"barFoo")
+(1,"fooA")
+(1,"fooB")
+(1,"fooC")
+(0,"fooD")
+(1,"fooE")
+(0,"fooF")
+(1,"fooG")
+(1,"fooH")
+(1,"fooI")
+(1,"fooJ")
+(1,"fooK")
+(1,"fooL")
+(1,"fooM")
+(1,"fooN")
+(1,"fooO")
=====================================
testsuite/tests/hpc/recsel/test.T
=====================================
@@ -0,0 +1,7 @@
+setTestOpts([omit_ghci, when(fast(), skip), js_skip])
+
+test('recsel',
+ [ignore_extension,
+ when(arch('wasm32'), fragile(23243))],
+ compile_and_run, ['-fhpc'])
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43b606bb40688667f32a3b8f1543ac4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43b606bb40688667f32a3b8f1543ac4…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T18570] Fix field type mismatch error handling
by Sjoerd Visscher (＠trac-sjoerd_visscher) 27 Jun '25
by Sjoerd Visscher (＠trac-sjoerd_visscher) 27 Jun '25
27 Jun '25
Sjoerd Visscher pushed to branch wip/T18570 at Glasgow Haskell Compiler / GHC
Commits:
f536dd0e by Sjoerd Visscher at 2025-06-27T21:32:52+02:00
Fix field type mismatch error handling
- - - - -
6 changed files:
- compiler/GHC/Tc/TyCl.hs
- testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
- testsuite/tests/typecheck/should_fail/T12083a.hs
- testsuite/tests/typecheck/should_fail/T12083a.stderr
- testsuite/tests/typecheck/should_fail/T9739.hs
- testsuite/tests/typecheck/should_fail/T9739.stderr
Changes:
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -4787,6 +4787,7 @@ checkValidTyCl tc
= setSrcSpan (getSrcSpan tc) $
addTyConCtxt tc $
recoverM recovery_code $
+ checkNoErrs $
do { traceTc "Starting validity for tycon" (ppr tc)
; checkValidTyCon tc
; checkTyConConsistentWithBoot tc -- See Note [TyCon boot consistency checking]
@@ -4991,7 +4992,7 @@ checkValidTyCon tc
check_fields ((label, con1) :| other_fields)
-- These fields all have the same name, but are from
-- different constructors in the data type
- = recoverM (return ()) $ mapM_ checkOne other_fields
+ = mapM_ checkOne other_fields
-- Check that all the fields in the group have the same type
-- NB: this check assumes that all the constructors of a given
-- data type use the same type variables
@@ -5001,8 +5002,10 @@ checkValidTyCon tc
lbl = flLabel label
checkOne (_, con2) -- Do it both ways to ensure they are structurally identical
- = do { checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2
- ; checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }
+ = do { ((), no_errs) <- askNoErrs $
+ checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2
+ ; when no_errs $
+ checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }
where
res2 = dataConOrigResTy con2
fty2 = dataConFieldType con2 lbl
@@ -5029,8 +5032,10 @@ checkPartialRecordField all_cons fld
checkFieldCompat :: FieldLabelString -> DataCon -> DataCon
-> Type -> Type -> Type -> Type -> TcM ()
checkFieldCompat fld con1 con2 res1 res2 fty1 fty2
- = do { checkTc (isJust mb_subst1) (TcRnCommonFieldResultTypeMismatch con1 con2 fld)
- ; checkTc (isJust mb_subst2) (TcRnCommonFieldTypeMismatch con1 con2 fld) }
+ = if isNothing mb_subst1
+ then addErrTc $ TcRnCommonFieldResultTypeMismatch con1 con2 fld
+ else when (isNothing mb_subst2) $
+ addErrTc $ TcRnCommonFieldTypeMismatch con1 con2 fld
where
mb_subst1 = tcMatchTy res1 res2
mb_subst2 = tcMatchTyX (expectJust mb_subst1) fty1 fty2
=====================================
testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
=====================================
@@ -2,10 +2,3 @@ CommonFieldTypeMismatch.hs:3:1: error: [GHC-91827]
• Constructors A1 and A2 give different types for field ‘fld’
• In the data type declaration for ‘A’
-CommonFieldTypeMismatch.hs:4:8: error: [GHC-83865]
- • Couldn't match type ‘[Char]’ with ‘Int’
- Expected: Int
- Actual: String
- • In the expression: fld
- In an equation for ‘fld’: fld A2 {fld = fld} = fld
-
=====================================
testsuite/tests/typecheck/should_fail/T12083a.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
module T12803a where
type Constrd a = Num a ⇒ a
=====================================
testsuite/tests/typecheck/should_fail/T12083a.stderr
=====================================
@@ -1,14 +1,14 @@
-
-T12083a.hs:6:1: error: [GHC-91510]
+T12083a.hs:7:1: error: [GHC-91510]
• Illegal qualified type: Num a => a
• In the type synonym declaration for ‘Constrd’
Suggested fix:
Perhaps you intended to use the ‘RankNTypes’ extension (implied by ‘ImpredicativeTypes’)
-T12083a.hs:10:26: error: [GHC-25709]
+T12083a.hs:11:26: error: [GHC-25709]
• Data constructor ‘ExistentiallyLost’ has existential type variables, a context, or a specialised result type
ExistentiallyLost :: forall u. TC u => u -> ExistentiallyLost
• In the definition of data constructor ‘ExistentiallyLost’
In the data type declaration for ‘ExistentiallyLost’
Suggested fix:
Enable any of the following extensions: ‘ExistentialQuantification’ or ‘GADTs’
+
=====================================
testsuite/tests/typecheck/should_fail/T9739.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
module T9739 where
class Class3 a => Class1 a where
=====================================
testsuite/tests/typecheck/should_fail/T9739.stderr
=====================================
@@ -1,5 +1,4 @@
-
-T9739.hs:4:1: error: [GHC-29210]
+T9739.hs:5:1: error: [GHC-29210]
• Superclass cycle for ‘Class1’
one of whose superclasses is ‘Class3’
one of whose superclasses is ‘Class1’
@@ -7,10 +6,11 @@ T9739.hs:4:1: error: [GHC-29210]
Suggested fix:
Perhaps you intended to use the ‘UndecidableSuperClasses’ extension
-T9739.hs:9:1: error: [GHC-29210]
+T9739.hs:10:1: error: [GHC-29210]
• Superclass cycle for ‘Class3’
one of whose superclasses is ‘Class1’
one of whose superclasses is ‘Class3’
• In the class declaration for ‘Class3’
Suggested fix:
Perhaps you intended to use the ‘UndecidableSuperClasses’ extension
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f536dd0ec21e317eb4160ec0772f96e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f536dd0ec21e317eb4160ec0772f96e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ghc-9.14] 31 commits: Visible forall in GADTs (#25127)
by Ben Gamari (＠bgamari) 27 Jun '25
by Ben Gamari (＠bgamari) 27 Jun '25
27 Jun '25
Ben Gamari pushed to branch wip/ghc-9.14 at Glasgow Haskell Compiler / GHC
Commits:
fbc0b92a by Vladislav Zavialov at 2025-06-22T04:25:16+03:00
Visible forall in GADTs (#25127)
Add support for visible dependent quantification `forall a -> t` in
types of data constructors, e.g.
data KindVal a where
K :: forall k.
forall (a::k) -> -- now allowed!
k ->
KindVal a
For details, see docs/users_guide/exts/required_type_arguments.rst,
which has gained a new subsection.
DataCon in compiler/GHC/Core/DataCon.hs
---------------------------------------
The main change in this patch is that DataCon, the Core representation
of a data constructor, now uses a different type to store user-written
type variable binders:
- dcUserTyVarBinders :: [InvisTVBinder]
+ dcUserTyVarBinders :: [TyVarBinder]
where
type TyVarBinder = VarBndr TyVar ForAllTyFlag
type InvisTVBinder = VarBndr TyVar Specificity
and
data Specificity = InferredSpec | SpecifiedSpec
data ForAllTyFlag = Invisible Specificity | Required
This change necessitates some boring, mechanical changes scattered
throughout the diff:
... is now used in place of ...
-----------------+---------------
TyVarBinder | InvisTVBinder
IfaceForAllBndr | IfaceForAllSpecBndr
Specified | SpecifiedSpec
Inferred | InferredSpec
mkForAllTys | mkInvisForAllTys
additionally,
tyVarSpecToBinders -- added or removed calls
ifaceForAllSpecToBndrs -- removed calls
Visibility casts in mkDataConRep
--------------------------------
Type abstractions in Core (/\a. e) always have type (forall a. t)
because coreTyLamForAllTyFlag = Specified. This is also true of data
constructor workers. So we may be faced with the following:
data con worker: (forall a. blah)
data con wrapper: (forall a -> blah)
In this case the wrapper must use a visibility cast (e |> ForAllCo ...)
with appropriately set fco_vis{L,R}. Relevant functions:
mkDataConRep in compiler/GHC/Types/Id/Make.hs
dataConUserTyVarBindersNeedWrapper in compiler/GHC/Core/DataCon.hs
mkForAllVisCos in compiler/GHC/Core/Coercion.hs
mkCoreTyLams in compiler/GHC/Core/Make.hs
mkWpForAllCast in compiler/GHC/Tc/Types/Evidence.hs
More specifically:
- dataConUserTyVarBindersNeedWrapper has been updated to answer "yes"
if there are visible foralls in the type of the data constructor.
- mkDataConRep now uses mkCoreTyLams to generate the big lambda
abstractions (/\a b c. e) in the data con wrapper.
- mkCoreTyLams is a variant of mkCoreLams that applies visibility casts
as needed. It similar in purpose to the pre-existing mkWpForAllCast,
so the common bits have been factored out into mkForAllVisCos.
ConDecl in compiler/Language/Haskell/Syntax/Decls.hs
----------------------------------------------------
The surface syntax representation of a data constructor declaration is
ConDecl. In accordance with the proposal, only GADT syntax is extended
with support for visible forall, so we are interested in ConDeclGADT.
ConDeclGADT's field con_bndrs has been renamed to con_outer_bndrs
and is now accompanied by con_inner_bndrs:
con_outer_bndrs :: XRec pass (HsOuterSigTyVarBndrs pass)
con_inner_bndrs :: [HsForAllTelescope pass]
Visible foralls always end up in con_inner_bndrs. The outer binders are
stored and processed separately to support implicit quantification and
the forall-or-nothing rule, a design established by HsSigType.
A side effect of this change is that even in absence of visible foralls,
GHC now permits multiple invisible foralls, e.g.
data T a where { MkT :: forall a b. forall c d. ... -> T a }
But of course, this is done in service of making at least some of these
foralls visible. The entire compiler front-end has been updated to deal
with con_inner_bndrs. See the following modified or added functions:
Parser:
mkGadtDecl in compiler/GHC/Parser/PostProcess.hs
splitLHsGadtTy in compiler/GHC/Hs/Type.hs
Pretty-printer:
pprConDecl in compiler/GHC/Hs/Decls.hs
pprHsForAllTelescope in compiler/GHC/Hs/Type.hs
Renamer:
rnConDecl in compiler/GHC/Rename/Module.hs
bindHsForAllTelescopes in compiler/GHC/Rename/HsType.hs
extractHsForAllTelescopes in compiler/GHC/Rename/HsType.hs
Type checker:
tcConDecl in compiler/GHC/Tc/TyCl.hs
tcGadtConTyVarBndrs in compiler/GHC/Tc/Gen/HsType.hs
Template Haskell
----------------
The TH AST is left unchanged for the moment to avoid breakage. An
attempt to quote or reify a data constructor declaration with visible
forall in its type will result an error:
data ThRejectionReason -- in GHC/HsToCore/Errors/Types.hs
= ...
| ThDataConVisibleForall -- new error constructor
However, as noted in the previous section, GHC now permits multiple
invisible foralls, and TH was updated accordingly. Updated code:
repC in compiler/GHC/HsToCore/Quote.hs
reifyDataCon in compiler/GHC/Tc/Gen/Splice.hs
ppr @Con in libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs
Pattern matching
----------------
Everything described above concerns data constructor declarations, but
what about their use sites? Now it is trickier to type check a pattern
match fn(Con a b c)=... because we can no longer assume that a,b,c are
all value arguments. Indeed, some or all of them may very well turn out
to be required type arguments.
To that end, see the changes to:
tcDataConPat in compiler/GHC/Tc/Gen/Pat.hs
splitConTyArgs in compiler/GHC/Tc/Gen/Pat.hs
and the new helpers split_con_ty_args, zip_pats_bndrs.
This is also the reason the TcRnTooManyTyArgsInConPattern error
constructor has been removed. The new code emits TcRnArityMismatch
or TcRnIllegalInvisibleTypePattern.
Summary
-------
DataCon, ConDecl, as well as all related functions have been updated to
support required type arguments in data constructors.
Test cases:
HieGadtConSigs GadtConSigs_th_dump1 GadtConSigs_th_pprint1
T25127_data T25127_data_inst T25127_infix
T25127_newtype T25127_fail_th_quote T25127_fail_arity
TyAppPat_Tricky
Co-authored-by: mniip <mniip(a)mniip.com>
- - - - -
ae003a3a by Teo Camarasu at 2025-06-23T05:21:48-04:00
linters: lint-whitespace: bump upper-bound for containers
The version of containers was bumped in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/13989
- - - - -
0fb37893 by Matthew Pickering at 2025-06-23T13:55:10-04:00
Move ModuleGraph into UnitEnv
The ModuleGraph is a piece of information associated with the
ExternalPackageState and HomeUnitGraph. Therefore we should store it
inside the HomeUnitEnv.
- - - - -
3bf6720e by soulomoon at 2025-06-23T13:55:52-04:00
Remove hptAllFamInstances usage during upsweep
Fixes #26118
This change eliminates the use of hptAllFamInstances during the upsweep phase,
as it could access non-below modules from the home package table.
The following updates were made:
* Updated checkFamInstConsistency to accept an explicit ModuleEnv FamInstEnv
parameter and removed the call to hptAllFamInstances.
* Adjusted hugInstancesBelow so we can construct ModuleEnv FamInstEnv
from its result,
* hptAllFamInstances and allFamInstances functions are removed.
- - - - -
83ee7b78 by Ben Gamari at 2025-06-24T05:02:07-04:00
configure: Don't force value of OTOOL, etc. if not present
Previously if `otool` and `install_name_tool` were not present they
would be overridden by `fp_settings.m4`. This logic was introduced in
4ff93292243888545da452ea4d4c1987f2343591 without explanation.
- - - - -
9329c9e1 by Ben Gamari at 2025-06-24T05:02:07-04:00
ghc-toolchain: Add support for otool, install_name_tool
Fixes part of ghc#23675.
- - - - -
25f5c998 by Ben Gamari at 2025-06-24T05:02:08-04:00
ghc-toolchain: Add support for llc, opt, llvm-as
Fixes #23675.
- - - - -
51d150dd by Rodrigo Mesquita at 2025-06-24T05:02:08-04:00
hadrian: Use settings-use-distro-mingw directly
The type `ToolchainSetting` only made sense when we had more settings to
fetch from the system config file. Even then "settings-use-distro-mingw"
is arguably not a toolchain setting.
With the fix for #23675, all toolchain tools were moved to the
`ghc-toolchain` `Toolchain` format. Therefore, we can inline
`settings-use-distro-mingw` accesses and delete `ToolchainSetting`.
- - - - -
dcf68a83 by Rodrigo Mesquita at 2025-06-24T05:02:08-04:00
configure: Check LlvmTarget exists for LlvmAsFlags
If LlvmTarget was empty, LlvmAsFlags would be just "--target=".
If it is empty now, simply keep LlvmAsFlags empty.
ghc-toolchain already does this right. This fix makes the two
configurations match up.
- - - - -
580a3353 by Ben Gamari at 2025-06-24T05:02:51-04:00
rts/linker/LoadArchive: Use bool
Improve type precision by using `bool` instead of `int` and `StgBool`.
- - - - -
76d1041d by Ben Gamari at 2025-06-24T05:02:51-04:00
rts/linker/LoadArchive: Don't rely on file extensions for identification
Previously archive members would be identified via their file extension,
as described in #13103. We now instead use a more principled approach,
relying on the magic number in the member's header.
As well, we refactor treatment of archive format detection to improve
code clarity and error handling.
Closes #13103.
- - - - -
4b748a99 by Teo Camarasu at 2025-06-24T15:31:07-04:00
template-haskell: improve changelog
stable -> more stable, just to clarify that this interface isn't fully stable.
errornously -> mistakenly: I typod this and also let's go for a simpler word
- - - - -
e358e477 by Sylvain Henry at 2025-06-24T15:31:58-04:00
Bump stack resolver to use GHC 9.6.7
Cf #26139
- - - - -
4bf5eb63 by fendor at 2025-06-25T17:05:43-04:00
Teach `:reload` about multiple home units
`:reload` needs to lookup the `ModuleName` and must not assume the given
`ModuleName` is in the current `HomeUnit`.
We add a new utility function which allows us to find a `HomeUnitModule`
instead of a `Module`.
Further, we introduce the `GhciCommandError` type which can be used to
abort the execution of a GHCi command.
This error is caught and printed in a human readable fashion.
- - - - -
b3d97bb3 by fendor at 2025-06-25T17:06:25-04:00
Implement `-fno-load-initial-targets` flag
We add the new flag `-fno-load-initial-targets` which doesn't load all `Target`s
immediately but only computes the module graph for all `Target`s.
The user can then decide to load modules from that module graph using
the syntax:
ghci> :reload <Mod>
This will load everything in the module graph up to `Mod`.
The user can return to the initial state by using the builtin target
`none` to unload all modules.
ghci> :reload none
Is in principle identical to starting a new session with the
`-fno-load-initial-targets` flag.
The `-fno-load-initial-targets` flag allows for faster startup time of GHCi when a
user has lots of `Target`s.
We additionally extend the `:reload` command to accept multiple
`ModuleName`s. For example:
ghci> :reload <Mod1> <Mod2>
Loads all modules up to the modules `Mod1` and `Mod2`.
- - - - -
49f44e52 by Teo Camarasu at 2025-06-26T04:19:51-04:00
Expose ghc-internal unit id through the settings file
This in combination with the unit id of the compiler library allows
cabal to know of the two unit ids that should not be reinstalled (in
specific circumstances) as:
- when using plugins, we want to link against exactly the compiler unit
id
- when using TemplateHaskell we want to link against exactly the package
that contains the TemplateHaskell interfaces, which is `ghc-internal`
See: <https://github.com/haskell/cabal/issues/10087>
Resolves #25282
- - - - -
499c4efe by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Fix and clean up capture of timings
* Fixes the typo that caused 'cat ci-timings' to report "no such file or
directory"
* Gave ci_timings.txt a file extension so it may play better with other
systems
* Fixed the use of time_it so all times are recorded
* Fixed time_it to print name along with timing
- - - - -
86c90c9e by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Update collapsible section usage
The syntax apparently changed at some point.
- - - - -
04308ee4 by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Add more collapsible sections
- - - - -
2aa5b667 by Ben Gamari at 2025-06-27T15:21:09-04:00
compiler: Import AnnotationWrapper from ghc-internal
Since `GHC.Desugar` exported from `base` has been deprecated.
- - - - -
7455e564 by Ben Gamari at 2025-06-27T15:21:09-04:00
ghc-compact: Eliminate dependency on ghc-prim
- - - - -
7ad91a67 by Ben Gamari at 2025-06-27T15:21:09-04:00
ghc-heap: Eliminate dependency on ghc-prim
- - - - -
4fceb5a9 by Ben Gamari at 2025-06-27T15:21:09-04:00
ghc-heap: Drop redundant import
- - - - -
7d81ae17 by Ben Gamari at 2025-06-27T15:21:09-04:00
ghc-prim: Bump version to 0.13.1
There are no interface changes from 0.13.0 but the implementation now
lives in `ghc-internal`.
- - - - -
e6810293 by Ben Gamari at 2025-06-27T15:21:09-04:00
template-haskell: Bump version number to 2.24.0.0
Bumps exceptions submodule.
- - - - -
dc9a119d by Ben Gamari at 2025-06-27T15:21:09-04:00
Bump GHC version number to 9.14
- - - - -
2fa917d1 by Ben Gamari at 2025-06-27T15:21:09-04:00
Bump parsec to 3.1.18.0
Bumps parsec submodule.
- - - - -
e2659518 by Ben Gamari at 2025-06-27T15:21:09-04:00
unix: Bump to 2.8.7.0
Bumps unix submodule.
- - - - -
badbdd76 by Ben Gamari at 2025-06-27T15:21:09-04:00
binary: Bump to 0.8.9.3
Bumps binary submodule.
- - - - -
8fcbc16a by Ben Gamari at 2025-06-27T15:21:09-04:00
Win32: Bump to 2.14.2.0
Bumps Win32 submodule.
- - - - -
e91f9f0a by Ben Gamari at 2025-06-27T15:21:09-04:00
base: Bump version to 4.22.0
Bumps various submodules.
- - - - -
198 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/common.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/ConLike.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/DataCon.hs-boot
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/PatSyn.hs
- compiler/GHC/Core/TyCo/Ppr.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Env/Types.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/Var.hs-boot
- compiler/GHC/Unit/Env.hs
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/Home/PackageTable.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Pat.hs
- compiler/Setup.hs
- compiler/ghc.cabal.in
- configure.ac
- distrib/configure.ac.in
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/exts/gadt_syntax.rst
- docs/users_guide/exts/required_type_arguments.rst
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Exception.hs
- ghc/GHCi/UI/Print.hs
- hadrian/cfg/default.host.target.in
- hadrian/cfg/default.target.in
- hadrian/cfg/system.config.in
- hadrian/src/Builder.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/stack.yaml
- hadrian/stack.yaml.lock
- libraries/Win32
- libraries/array
- libraries/base/base.cabal.in
- libraries/binary
- libraries/deepseq
- libraries/directory
- libraries/exceptions
- libraries/filepath
- libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs
- libraries/ghc-boot-th/ghc-boot-th.cabal.in
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-compact/GHC/Compact.hs
- libraries/ghc-compact/GHC/Compact/Serialized.hs
- libraries/ghc-compact/ghc-compact.cabal
- libraries/ghc-experimental/ghc-experimental.cabal.in
- libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-prim/changelog.md
- libraries/ghc-prim/ghc-prim.cabal
- libraries/ghci/ghci.cabal.in
- libraries/haskeline
- libraries/hpc
- libraries/os-string
- libraries/parsec
- libraries/process
- libraries/semaphore-compat
- libraries/stm
- libraries/template-haskell/changelog.md
- libraries/template-haskell/template-haskell.cabal.in
- libraries/terminfo
- libraries/text
- libraries/unix
- linters/lint-whitespace/lint-whitespace.cabal
- m4/fp_settings.m4
- m4/ghc_toolchain.m4
- m4/prep_target_file.m4
- rts/linker/LoadArchive.c
- testsuite/tests/dependent/should_fail/T16326_Fail6.stderr
- testsuite/tests/ghc-e/should_fail/T18441fail5.stderr
- testsuite/tests/ghci/prog-mhu003/prog-mhu003.stderr
- testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stderr
- + testsuite/tests/ghci/prog-mhu005/Makefile
- + testsuite/tests/ghci/prog-mhu005/a/A.hs
- + testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/b/B.hs
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stdout
- + testsuite/tests/ghci/prog-mhu005/unitA
- + testsuite/tests/ghci/prog-mhu005/unitB
- + testsuite/tests/ghci/prog021/A.hs
- + testsuite/tests/ghci/prog021/B.hs
- + testsuite/tests/ghci/prog021/Makefile
- + testsuite/tests/ghci/prog021/all.T
- + testsuite/tests/ghci/prog021/prog021a.script
- + testsuite/tests/ghci/prog021/prog021a.stderr
- + testsuite/tests/ghci/prog021/prog021a.stdout
- + testsuite/tests/ghci/prog021/prog021b.script
- + testsuite/tests/ghci/prog021/prog021b.stderr
- + testsuite/tests/ghci/prog021/prog021b.stdout
- + testsuite/tests/ghci/prog022/A.hs
- + testsuite/tests/ghci/prog022/B.hs
- + testsuite/tests/ghci/prog022/Makefile
- + testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022a.script
- + testsuite/tests/ghci/prog022/ghci.prog022a.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022a.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022b.script
- + testsuite/tests/ghci/prog022/ghci.prog022b.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022b.stdout
- testsuite/tests/ghci/scripts/ghci021.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- + testsuite/tests/hiefile/should_run/HieGadtConSigs.hs
- + testsuite/tests/hiefile/should_run/HieGadtConSigs.stdout
- testsuite/tests/hiefile/should_run/all.T
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/printer/T18791.stderr
- + testsuite/tests/th/GadtConSigs_th_dump1.hs
- + testsuite/tests/th/GadtConSigs_th_dump1.stderr
- + testsuite/tests/th/GadtConSigs_th_pprint1.hs
- + testsuite/tests/th/GadtConSigs_th_pprint1.stderr
- testsuite/tests/th/T20868.stdout
- testsuite/tests/th/all.T
- testsuite/tests/typecheck/should_compile/T23739a.hs
- + testsuite/tests/typecheck/should_compile/TyAppPat_Tricky.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T20443b.stderr
- testsuite/tests/typecheck/should_fail/TyAppPat_TooMany.stderr
- + testsuite/tests/vdq-rta/should_compile/T25127_data.hs
- + testsuite/tests/vdq-rta/should_compile/T25127_data_inst.hs
- + testsuite/tests/vdq-rta/should_compile/T25127_infix.hs
- + testsuite/tests/vdq-rta/should_compile/T25127_newtype.hs
- testsuite/tests/vdq-rta/should_compile/all.T
- testsuite/tests/vdq-rta/should_fail/T24159_type_syntax_th_fail.script
- + testsuite/tests/vdq-rta/should_fail/T25127_fail_arity.hs
- + testsuite/tests/vdq-rta/should_fail/T25127_fail_arity.stderr
- + testsuite/tests/vdq-rta/should_fail/T25127_fail_th_quote.hs
- + testsuite/tests/vdq-rta/should_fail/T25127_fail_th_quote.stderr
- testsuite/tests/vdq-rta/should_fail/all.T
- utils/check-exact/ExactPrint.hs
- utils/ghc-toolchain/exe/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
- utils/haddock/haddock-api/haddock-api.cabal
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
- utils/haddock/haddock-library/haddock-library.cabal
- utils/haddock/haddock-test/haddock-test.cabal
- utils/haddock/haddock.cabal
- utils/hsc2hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6f3e5a3abebb97183fec50083aabc…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6f3e5a3abebb97183fec50083aabc…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
27 Jun '25
Ben Gamari pushed to branch wip/ghc-9.14 at Glasgow Haskell Compiler / GHC
Commits:
a6f3e5a3 by Ben Gamari at 2025-06-27T15:19:39-04:00
base: Bump version to 4.22.0
Bumps various submodules.
- - - - -
27 changed files:
- compiler/ghc.cabal.in
- libraries/Win32
- libraries/array
- libraries/base/base.cabal.in
- libraries/deepseq
- libraries/directory
- libraries/filepath
- libraries/ghc-boot-th/ghc-boot-th.cabal.in
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-compact/ghc-compact.cabal
- libraries/ghc-experimental/ghc-experimental.cabal.in
- libraries/ghci/ghci.cabal.in
- libraries/haskeline
- libraries/hpc
- libraries/os-string
- libraries/parsec
- libraries/process
- libraries/semaphore-compat
- libraries/stm
- libraries/template-haskell/template-haskell.cabal.in
- libraries/terminfo
- libraries/text
- utils/haddock/haddock-api/haddock-api.cabal
- utils/haddock/haddock-library/haddock-library.cabal
- utils/haddock/haddock-test/haddock-test.cabal
- utils/haddock/haddock.cabal
- utils/hsc2hs
Changes:
=====================================
compiler/ghc.cabal.in
=====================================
@@ -114,7 +114,7 @@ Library
extra-libraries: zstd
CPP-Options: -DHAVE_LIBZSTD
- Build-Depends: base >= 4.11 && < 4.22,
+ Build-Depends: base >= 4.11 && < 4.23,
deepseq >= 1.4 && < 1.6,
directory >= 1 && < 1.4,
process >= 1 && < 1.7,
=====================================
libraries/Win32
=====================================
@@ -1 +1 @@
-Subproject commit 701921b247cb227ab6398d19265d3344e4494065
+Subproject commit 7d0772bb265a6c59eb14c441cf65c778895528df
=====================================
libraries/array
=====================================
@@ -1 +1 @@
-Subproject commit b362edee437c88f2ac38971b66631ed782caa275
+Subproject commit 6d59d5deb4f2a12656ab4c4371c0d12dac4875ef
=====================================
libraries/base/base.cabal.in
=====================================
@@ -4,7 +4,7 @@ cabal-version: 3.0
-- Make sure you are editing ghc-experimental.cabal.in, not ghc-experimental.cabal
name: base
-version: 4.21.0.0
+version: 4.22.0.0
-- NOTE: Don't forget to update ./changelog.md
license: BSD-3-Clause
=====================================
libraries/deepseq
=====================================
@@ -1 +1 @@
-Subproject commit af115cc226cc87fba89d0f6e2e9212e755c24983
+Subproject commit ae2762ac241a61852c9ff4c287af234fb1ad931f
=====================================
libraries/directory
=====================================
@@ -1 +1 @@
-Subproject commit eb40bbebcaf86153bbc60772fb2e0466d35c95c4
+Subproject commit ffd4fc248ee36095ddec55598b0f8e3a9ac762a8
=====================================
libraries/filepath
=====================================
@@ -1 +1 @@
-Subproject commit 65b0f8f31aac4a306135e27734988327f8eb1e6f
+Subproject commit cbcd0ccf92f47e6c10fb9cc513a7b26facfc19fe
=====================================
libraries/ghc-boot-th/ghc-boot-th.cabal.in
=====================================
@@ -49,8 +49,8 @@ Library
GHC.Lexeme
build-depends:
- base >= 4.7 && < 4.22,
- pretty == 1.1.*
+ base >= 4.7 && < 4.23,
+ pretty == 1.1.*
if flag(bootstrap)
cpp-options: -DBOOTSTRAP_TH
=====================================
libraries/ghc-boot/ghc-boot.cabal.in
=====================================
@@ -75,7 +75,7 @@ Library
GHC.Version
GHC.Platform.Host
- build-depends: base >= 4.7 && < 4.22,
+ build-depends: base >= 4.7 && < 4.23,
binary == 0.8.*,
bytestring >= 0.10 && < 0.13,
containers >= 0.5 && < 0.9,
=====================================
libraries/ghc-compact/ghc-compact.cabal
=====================================
@@ -39,7 +39,7 @@ library
UnboxedTuples
CPP
- build-depends: base >= 4.9.0 && < 4.22,
+ build-depends: base >= 4.9.0 && < 4.23,
bytestring >= 0.10.6.0 && <0.13
ghc-options: -Wall
=====================================
libraries/ghc-experimental/ghc-experimental.cabal.in
=====================================
@@ -41,7 +41,7 @@ library
if arch(wasm32)
exposed-modules: GHC.Wasm.Prim
other-extensions:
- build-depends: base >=4.20 && < 4.22,
+ build-depends: base >=4.20 && < 4.23,
ghc-internal == @ProjectVersionForLib@.*
hs-source-dirs: src
default-language: Haskell2010
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -84,7 +84,7 @@ library
Build-Depends:
rts,
array == 0.5.*,
- base >= 4.8 && < 4.22,
+ base >= 4.8 && < 4.23,
-- ghc-internal == @ProjectVersionForLib@.*
-- TODO: Use GHC.Internal.Desugar and GHC.Internal.Base from
-- ghc-internal instead of ignoring the deprecation warning in GHCi.TH
=====================================
libraries/haskeline
=====================================
@@ -1 +1 @@
-Subproject commit 1ef56b16d3ed1f063211982668329d9e3113fd5b
+Subproject commit 991953cd5d3bb9e8057de4a0d8f2cae3455865d8
=====================================
libraries/hpc
=====================================
@@ -1 +1 @@
-Subproject commit 304aaecec374fdfbf15bfb6c223a66e9730ea253
+Subproject commit 7b7aed397cbe2bb36824d8627527fa4d5abffaa6
=====================================
libraries/os-string
=====================================
@@ -1 +1 @@
-Subproject commit 4b5efedcd2da9314edda80d973a44e67020370db
+Subproject commit 2e693aad07540173a0169971b27c9acac28eeff1
=====================================
libraries/parsec
=====================================
@@ -1 +1 @@
-Subproject commit b87122c1c74b8240e65044a8f600f0427d4dd9c3
+Subproject commit 552730e23e1fd2dae46a60d75138b8d173492462
=====================================
libraries/process
=====================================
@@ -1 +1 @@
-Subproject commit fbbe60718736999db701c12528c85cbc605ab4fb
+Subproject commit ae50731b5fb221a7631f7e9d818fc6716c85c51e
=====================================
libraries/semaphore-compat
=====================================
@@ -1 +1 @@
-Subproject commit 54882cd9a07322a4cf95d4fc0627107eaf1eb051
+Subproject commit ba87d1bb0209bd9f29bda1c878ddf345f8a2b199
=====================================
libraries/stm
=====================================
@@ -1 +1 @@
-Subproject commit def18948f42a2eb8c34efdf65f7e614d1f6d5703
+Subproject commit 23bdcc2319965911af28542e76fc01f37c107d40
=====================================
libraries/template-haskell/template-haskell.cabal.in
=====================================
@@ -51,7 +51,7 @@ Library
Language.Haskell.TH.CodeDo
build-depends:
- base >= 4.11 && < 4.22,
+ base >= 4.11 && < 4.23,
-- We don't directly depend on any of the modules from `ghc-internal`
-- But we need to depend on it to work around a hadrian bug.
-- See: https://gitlab.haskell.org/ghc/ghc/-/issues/25705
=====================================
libraries/terminfo
=====================================
@@ -1 +1 @@
-Subproject commit a76fac0c60cf6db7ed724d9b5c5067d77a23efc7
+Subproject commit 16db154e3e97e6bff62329574163851a7090f3b6
=====================================
libraries/text
=====================================
@@ -1 +1 @@
-Subproject commit b86564cae8d7262c7c4e7afe7a9163c83de3f175
+Subproject commit f1a05704a153ecc6a9bd45f6df8dd99820e74a2d
=====================================
utils/haddock/haddock-api/haddock-api.cabal
=====================================
@@ -78,7 +78,7 @@ library
build-depends: ghc-paths ^>= 0.1.0.12
-- this package typically supports only single major versions
- build-depends: base >= 4.16 && < 4.22
+ build-depends: base >= 4.16 && < 4.23
, ghc ^>= 9.14
, haddock-library ^>= 1.11
, xhtml ^>= 3000.2.2
=====================================
utils/haddock/haddock-library/haddock-library.cabal
=====================================
@@ -46,7 +46,7 @@ common ghc-options
-Wnoncanonical-monad-instances -Wmissing-home-modules
build-depends:
- , base >= 4.10 && < 4.22
+ , base >= 4.10 && < 4.23
, containers >= 0.4.2.1 && < 0.9
, text ^>= 1.2.3.0 || ^>= 2.0 || ^>= 2.1
, parsec ^>= 3.1.13.0
=====================================
utils/haddock/haddock-test/haddock-test.cabal
=====================================
@@ -16,7 +16,7 @@ library
default-language: Haskell2010
ghc-options: -Wall
hs-source-dirs: src
- build-depends: base >= 4.3 && < 4.22, bytestring, directory, process, filepath, Cabal
+ build-depends: base >= 4.3 && < 4.23, bytestring, directory, process, filepath, Cabal
exposed-modules:
Test.Haddock
=====================================
utils/haddock/haddock.cabal
=====================================
@@ -90,7 +90,7 @@ executable haddock
-- haddock typically only supports a single GHC major version
build-depends:
- base >= 4.13.0.0 && <4.22,
+ base >= 4.13.0.0 && <4.23,
-- in order for haddock's advertised version number to have proper meaning,
-- we pin down to a single haddock-api version.
haddock-api == 2.30.0
=====================================
utils/hsc2hs
=====================================
@@ -1 +1 @@
-Subproject commit 044e04f14ff886456837b9784b2972af71c66494
+Subproject commit fe3990b9f35000427b016a79330d9f195587cad8
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a6f3e5a3abebb97183fec50083aabce…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a6f3e5a3abebb97183fec50083aabce…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T18570] Fix field type mismatch error handling
by Sjoerd Visscher (＠trac-sjoerd_visscher) 27 Jun '25
by Sjoerd Visscher (＠trac-sjoerd_visscher) 27 Jun '25
27 Jun '25
Sjoerd Visscher pushed to branch wip/T18570 at Glasgow Haskell Compiler / GHC
Commits:
f05d68b2 by Sjoerd Visscher at 2025-06-27T21:00:38+02:00
Fix field type mismatch error handling
- - - - -
4 changed files:
- compiler/GHC/Tc/TyCl.hs
- testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
- testsuite/tests/typecheck/should_fail/T12083a.stderr
- testsuite/tests/typecheck/should_fail/T9739.stderr
Changes:
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -4787,6 +4787,7 @@ checkValidTyCl tc
= setSrcSpan (getSrcSpan tc) $
addTyConCtxt tc $
recoverM recovery_code $
+ checkNoErrs $
do { traceTc "Starting validity for tycon" (ppr tc)
; checkValidTyCon tc
; checkTyConConsistentWithBoot tc -- See Note [TyCon boot consistency checking]
@@ -4991,7 +4992,7 @@ checkValidTyCon tc
check_fields ((label, con1) :| other_fields)
-- These fields all have the same name, but are from
-- different constructors in the data type
- = recoverM (return ()) $ mapM_ checkOne other_fields
+ = mapM_ checkOne other_fields
-- Check that all the fields in the group have the same type
-- NB: this check assumes that all the constructors of a given
-- data type use the same type variables
@@ -5001,8 +5002,10 @@ checkValidTyCon tc
lbl = flLabel label
checkOne (_, con2) -- Do it both ways to ensure they are structurally identical
- = do { checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2
- ; checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }
+ = do { ((), no_errs) <- askNoErrs $
+ checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2
+ ; when no_errs $
+ checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }
where
res2 = dataConOrigResTy con2
fty2 = dataConFieldType con2 lbl
@@ -5029,8 +5032,10 @@ checkPartialRecordField all_cons fld
checkFieldCompat :: FieldLabelString -> DataCon -> DataCon
-> Type -> Type -> Type -> Type -> TcM ()
checkFieldCompat fld con1 con2 res1 res2 fty1 fty2
- = do { checkTc (isJust mb_subst1) (TcRnCommonFieldResultTypeMismatch con1 con2 fld)
- ; checkTc (isJust mb_subst2) (TcRnCommonFieldTypeMismatch con1 con2 fld) }
+ = if isNothing mb_subst1
+ then addErrTc $ TcRnCommonFieldResultTypeMismatch con1 con2 fld
+ else when (isNothing mb_subst2) $
+ addErrTc $ TcRnCommonFieldTypeMismatch con1 con2 fld
where
mb_subst1 = tcMatchTy res1 res2
mb_subst2 = tcMatchTyX (expectJust mb_subst1) fty1 fty2
=====================================
testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
=====================================
@@ -2,10 +2,3 @@ CommonFieldTypeMismatch.hs:3:1: error: [GHC-91827]
• Constructors A1 and A2 give different types for field ‘fld’
• In the data type declaration for ‘A’
-CommonFieldTypeMismatch.hs:4:8: error: [GHC-83865]
- • Couldn't match type ‘[Char]’ with ‘Int’
- Expected: Int
- Actual: String
- • In the expression: fld
- In an equation for ‘fld’: fld A2 {fld = fld} = fld
-
=====================================
testsuite/tests/typecheck/should_fail/T12083a.stderr
=====================================
@@ -1,4 +1,3 @@
-
T12083a.hs:6:1: error: [GHC-91510]
• Illegal qualified type: Num a => a
• In the type synonym declaration for ‘Constrd’
@@ -12,3 +11,20 @@ T12083a.hs:10:26: error: [GHC-25709]
In the data type declaration for ‘ExistentiallyLost’
Suggested fix:
Enable any of the following extensions: ‘ExistentialQuantification’ or ‘GADTs’
+
+T12083a.hs:15:5: error: [GHC-27958]
+ • Could not deduce ‘ATF1 (p0, p1) ~ p0’
+ arising from a superclass required to satisfy ‘TC (p0, p1)’,
+ arising from a type ambiguity check for
+ the type signature for ‘uie_handlers’
+ from the context: TC u
+ bound by the type signature for:
+ uie_handlers :: forall u. TC u => ADT Int
+ at T12083a.hs:15:5-28
+ The type variables ‘p0’, ‘p1’ are ambiguous
+ • In the ambiguity check for ‘uie_handlers’
+ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+ When checking the class method:
+ uie_handlers :: forall u. TC u => ADT Int
+ In the class declaration for ‘TC’
+
=====================================
testsuite/tests/typecheck/should_fail/T9739.stderr
=====================================
@@ -1,4 +1,3 @@
-
T9739.hs:4:1: error: [GHC-29210]
• Superclass cycle for ‘Class1’
one of whose superclasses is ‘Class3’
@@ -7,6 +6,22 @@ T9739.hs:4:1: error: [GHC-29210]
Suggested fix:
Perhaps you intended to use the ‘UndecidableSuperClasses’ extension
+T9739.hs:7:3: error: [GHC-39999]
+ • Could not deduce ‘Class1 t0’
+ arising from a superclass required to satisfy ‘Class3 t0’,
+ arising from a type ambiguity check for
+ the type signature for ‘class2’
+ from the context: (Class2 t a, Class3 t)
+ bound by the type signature for:
+ class2 :: forall t a m. (Class2 t a, Class3 t) => a -> m
+ at T9739.hs:7:3-32
+ The type variable ‘t0’ is ambiguous
+ • In the ambiguity check for ‘class2’
+ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+ When checking the class method:
+ class2 :: forall t a m. (Class2 t a, Class3 t) => a -> m
+ In the class declaration for ‘Class2’
+
T9739.hs:9:1: error: [GHC-29210]
• Superclass cycle for ‘Class3’
one of whose superclasses is ‘Class1’
@@ -14,3 +29,4 @@ T9739.hs:9:1: error: [GHC-29210]
• In the class declaration for ‘Class3’
Suggested fix:
Perhaps you intended to use the ‘UndecidableSuperClasses’ extension
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f05d68b257f64624a82619580396dd2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f05d68b257f64624a82619580396dd2…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
27 Jun '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-8 at Glasgow Haskell Compiler / GHC
Commits:
6986f25d by Rodrigo Mesquita at 2025-06-27T16:19:01+01:00
Fixes
- - - - -
03235e46 by Rodrigo Mesquita at 2025-06-27T16:43:36+01:00
Tweaks
- - - - -
5851082d by Rodrigo Mesquita at 2025-06-27T17:21:06+01:00
Checkpoint but segfaults in GC
- - - - -
748ddd68 by Rodrigo Mesquita at 2025-06-27T17:51:51+01:00
Start part 4....
- - - - -
11 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Types/Tickish.hs
- ghc/GHCi/UI.hs
- rts/Interpreter.c
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -72,8 +72,6 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64)
import qualified Data.List as List ( any )
import GHC.Exts
-import GHC.HsToCore.Breakpoints (ModBreaks(..))
-
-- -----------------------------------------------------------------------------
-- Unlinked BCOs
@@ -110,14 +108,14 @@ assembleBCOs
-> FlatBag (ProtoBCO Name)
-> [TyCon]
-> [(Name, ByteString)]
- -> Maybe (InternalModBreaks, ModBreaks)
+ -> InternalModBreaks
-> [SptEntry]
-> IO CompiledByteCode
assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
-- TODO: the profile should be bundled with the interpreter: the rts ways are
-- fixed for an interpreter
let itbls = mkITbls profile tycons
- bcos <- mapM (assembleBCO (profilePlatform profile)) proto_bcos
+ bcos <- mapM (assembleBCO (profilePlatform profile)) proto_bcos
return CompiledByteCode
{ bc_bcos = bcos
, bc_itbls = itbls
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -13,12 +13,17 @@ module GHC.ByteCode.Breakpoints
InternalModBreaks(..), CgBreakInfo(..)
, mkInternalModBreaks
- -- ** Operations
- , getInternalBreak, addInternalBreak
-
-- ** Internal breakpoint identifier
, InternalBreakpointId(..), BreakInfoIndex
+ -- * Operations
+
+ -- ** Internal-level operations
+ , getInternalBreak, addInternalBreak
+
+ -- ** Source-level information operations
+ , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
+
-- * Utils
, seqInternalModBreaks
@@ -26,16 +31,19 @@ module GHC.ByteCode.Breakpoints
where
import GHC.Prelude
+import GHC.Types.SrcLoc
+import GHC.Types.Name.Occurrence
import Control.DeepSeq
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
+import GHC.HsToCore.Breakpoints
import GHC.Iface.Syntax
-import GHC.Types.Tickish
import GHC.Unit.Module (Module)
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import Data.Array
{-
Note [ModBreaks vs InternalModBreaks]
@@ -120,11 +128,19 @@ data InternalModBreaks = InternalModBreaks
, imodBreaks_module :: !Module
-- ^ Also cache the module corresponding to these 'InternalModBreaks',
-- for instance for internal sanity checks.
+
+ , imodBreaks_modBreaks :: !(Maybe ModBreaks)
+ -- ^ Store the original ModBreaks for this module, unchanged.
+ -- Allows us to query about source-level breakpoint information using
+ -- an internal breakpoint id.
}
-- | Construct an 'InternalModBreaks'
-mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> InternalModBreaks
-mkInternalModBreaks mod im = InternalModBreaks im mod
+mkInternalModBreaks :: Module -> Maybe ModBreaks -> InternalModBreaks
+mkInternalModBreaks mod mbs =
+ assertPpr (Just mod == (modBreaks_module <$> mbs))
+ (text "Constructing InternalModBreaks with the ModBreaks of a different module!") $
+ InternalModBreaks mempty mod mbs
-- | Information about a breakpoint that we know at code-generation time
-- In order to be used, this needs to be hydrated relative to the current HscEnv by
@@ -161,6 +177,34 @@ assert_modules_match ibi_mod imbs_mod =
(text "Tried to query the InternalModBreaks of module" <+> ppr imbs_mod
<+> text "with an InternalBreakpointId for module" <+> ppr ibi_mod)
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+
+-- | Get the source span for this breakpoint
+getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> Maybe SrcSpan
+getBreakLoc = getBreakXXX modBreaks_locs
+
+-- | Get the vars for this breakpoint
+getBreakVars :: InternalBreakpointId -> InternalModBreaks -> Maybe [OccName]
+getBreakVars = getBreakXXX modBreaks_vars
+
+-- | Get the decls for this breakpoint
+getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> Maybe [String]
+getBreakDecls = getBreakXXX modBreaks_decls
+
+-- | Get the decls for this breakpoint
+getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> Maybe (String, String)
+getBreakCCS = getBreakXXX modBreaks_ccs
+
+-- | Internal utility to access a ModBreaks field at a particular breakpoint index
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> Maybe a
+getBreakXXX view (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ mbs <- imodBreaks_modBreaks imbs
+ Just $ view mbs ! bi_tick_index (cgb_tick_id cgb)
+
--------------------------------------------------------------------------------
-- Instances
--------------------------------------------------------------------------------
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -46,7 +46,6 @@ import Foreign
import Data.ByteString (ByteString)
import qualified GHC.Exts.Heap as Heap
import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
-import GHC.HsToCore.Breakpoints (ModBreaks)
import GHC.Unit.Module
-- -----------------------------------------------------------------------------
@@ -62,9 +61,8 @@ data CompiledByteCode = CompiledByteCode
, bc_strs :: [(Name, ByteString)]
-- ^ top-level strings (heap allocated)
- , bc_breaks :: (Maybe (InternalModBreaks, ModBreaks))
- -- ^ All (internal and tick-level) breakpoint information (no information
- -- if breakpoints are disabled).
+ , bc_breaks :: InternalModBreaks
+ -- ^ All breakpoint information (no information if breakpoints are disabled).
--
-- This information is used when loading a bytecode object: we will
-- construct the arrays to be used at runtime to trigger breakpoints then
@@ -74,10 +72,6 @@ data CompiledByteCode = CompiledByteCode
-- breakpoint information indexed by the internal breakpoint id here (in
-- 'getModBreaks').
- -- TODO: If ModBreaks is serialized and reconstructed as part of ModDetails
- -- we don't need to keep it in bc_breaks as it can be fetched from the
- -- 'HomeModInfo' directly, right?
-
, bc_spt_entries :: ![SptEntry]
-- ^ Static pointer table entries which should be loaded along with the
-- BCOs. See Note [Grand plan for static forms] in
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -17,10 +17,6 @@ module GHC.HsToCore.Breakpoints
( -- * ModBreaks
mkModBreaks, ModBreaks(..)
- -- ** Queries
- -- TODO: See where we could use these rather than using the arrays directly.
- , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
-
-- ** Re-exports BreakpointId
, BreakpointId(..), BreakTickIndex
) where
@@ -35,7 +31,6 @@ import GHC.Types.Name (OccName)
import GHC.Types.Tickish (BreakTickIndex, BreakpointId(..))
import GHC.Unit.Module (Module)
import GHC.Utils.Outputable
-import GHC.Utils.Panic
import Data.List (intersperse)
--------------------------------------------------------------------------------
@@ -103,34 +98,6 @@ mkModBreaks interpreterProfiled modl extendedMixEntries
, modBreaks_module = modl
}
--- | Get the source span for this breakpoint
-getBreakLoc :: BreakpointId -> ModBreaks -> SrcSpan
-getBreakLoc = getBreakXXX modBreaks_locs
-
--- | Get the vars for this breakpoint
-getBreakVars :: BreakpointId -> ModBreaks -> [OccName]
-getBreakVars = getBreakXXX modBreaks_vars
-
--- | Get the decls for this breakpoint
-getBreakDecls :: BreakpointId -> ModBreaks -> [String]
-getBreakDecls = getBreakXXX modBreaks_decls
-
--- | Get the decls for this breakpoint
-getBreakCCS :: BreakpointId -> ModBreaks -> (String, String)
-getBreakCCS = getBreakXXX modBreaks_ccs
-
--- | Internal utility to access a ModBreaks field at a particular breakpoint index
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> BreakpointId -> ModBreaks -> a
-getBreakXXX view (BreakpointId bid_mod ix) mbs =
- assert_modules_match bid_mod (modBreaks_module mbs) $ view mbs ! ix
-
--- | Assert that the module in the 'BreakpointId' and in 'ModBreaks' match.
-assert_modules_match :: Module -> Module -> a -> a
-assert_modules_match bid_mod mbs_mod =
- assertPpr (bid_mod == mbs_mod)
- (text "Tried to query the ModBreaks of module" <+> ppr mbs_mod
- <+> text "with a BreakpointId for module" <+> ppr bid_mod)
-
{-
Note [Field modBreaks_decls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -128,7 +128,6 @@ import GHC.Tc.Utils.Monad
import GHC.IfaceToCore
import GHC.HsToCore.Breakpoints
-import GHC.ByteCode.Breakpoints
import Control.Monad
import Data.Array
@@ -157,7 +156,7 @@ getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
let bid = historyBreakpointId hist
(_, brks) <- readModBreaks hug (bi_tick_mod bid)
- return $ modBreaks_locs brks ! bi_tick_index bid
+ return $ getBreakLoc bid brks
{- | Finds the enclosing top level function name -}
-- ToDo: a better way to do this would be to keep hold of the decl_path computed
@@ -358,7 +357,7 @@ handleRunStatus step expr bindings final_ids status history0 = do
(_, tick_brks) <- liftIO $ readModBreaks hug (bi_tick_mod bid)
breakArray <- getBreakArray interp ibi
let
- span = modBreaks_locs tick_brks ! bi_tick_index bid
+ span = getBreakLoc bid tick_brks
decl = intercalate "." $ modBreaks_decls tick_brks ! bi_tick_index bid
-- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
@@ -450,7 +449,7 @@ resumeExec step mbCnt
-- When the user specified a break ignore count, set it
-- in the interpreter
case (mb_brkpt, mbCnt) of
- (Just (bid, ibi), Just cnt) ->
+ (Just (_bid, ibi), Just cnt) ->
setupBreakpoint interp ibi cnt
_ -> return ()
@@ -476,6 +475,7 @@ getBreakArray :: GhcMonad m => Interp -> InternalBreakpointId -> m (ForeignRef B
getBreakArray interp InternalBreakpointId{ibi_info_mod} = do
breakArrays <- liftIO $ breakarray_env . linker_env . expectJust
<$> Loader.getLoaderState interp
+ pprTraceM "hello" (ppr $ moduleEnvKeys breakArrays)
return $ expectJust $ lookupModuleEnv breakArrays ibi_info_mod
back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
@@ -506,7 +506,7 @@ moveHist fn = do
Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
Just (bid, _ibi) -> liftIO $ do
(_, brks) <- readModBreaks (hsc_HUG hsc_env) (bi_tick_mod bid)
- return $ modBreaks_locs brks ! bi_tick_index bid -- todo: getBreakLoc
+ return $ getBreakLoc bid brks
(hsc_env1, names) <-
liftIO $ bindLocalsAtBreakpoint hsc_env apStack span (snd <$> mb_info)
let ic = hsc_IC hsc_env1
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -28,10 +28,8 @@ module GHC.Runtime.Interpreter
, whereFrom
, getModBreaks
, readModBreaks
- , readModBreaksMaybe
, seqHValue
, evalBreakpointToId
- , internalBreakIdToBreakId
-- * The object-code linker
, initObjLinker
@@ -76,7 +74,6 @@ import GHCi.Message
import GHCi.RemoteTypes
import GHCi.ResolvedBCO
import GHCi.BreakArray (BreakArray)
-import GHC.HsToCore.Breakpoints
import GHC.ByteCode.Breakpoints
import GHC.ByteCode.Types
@@ -95,12 +92,10 @@ import GHC.Utils.Fingerprint
import GHC.Unit.Module
import GHC.Unit.Home.ModInfo
-import GHC.Unit.Home.Graph (lookupHugByModule)
import GHC.Unit.Env
#if defined(HAVE_INTERNAL_INTERPRETER)
import GHCi.Run
-import GHC.Platform.Ways
#endif
import Control.Concurrent
@@ -109,10 +104,8 @@ import Control.Monad.IO.Class
import Control.Monad.Catch as MC (mask)
import Data.Binary
import Data.ByteString (ByteString)
-import Data.Array ((!))
import Foreign hiding (void)
import qualified GHC.Exts.Heap as Heap
-import GHC.Stack.CCS (CostCentre,CostCentreStack)
import System.Directory
import System.Process
import qualified GHC.InfoProv as InfoProv
@@ -123,6 +116,7 @@ import qualified GHC.Unit.Home.Graph as HUG
-- Standard libraries
import GHC.Exts
+import GHC.Stack
{- Note [Remote GHCi]
~~~~~~~~~~~~~~~~~~
@@ -423,20 +417,6 @@ evalBreakpointToId eval_break =
, ibi_info_index = eb_info_index eval_break
}
--- | An @'InternalBreakpointId'@ is an index into the @IntMap 'CgBreakInfo'@ of
--- a specific module's @'ModBreaks'@.
---
--- To get the @'BreakpointId'@, an index from the Core-level ticks to the
--- associated SrcSpans and other source-level relevant details, lookup it up in
--- the @'CgBreakInfo'@ of this internal id's module.
---
--- See also Note [Breakpoint identifiers]
-internalBreakIdToBreakId :: HomeUnitGraph -> InternalBreakpointId -> IO BreakpointId
-internalBreakIdToBreakId hug ibi = do
- (imbs, _) <- readModBreaks hug (ibi_info_mod ibi)
- let CgBreakInfo{cgb_tick_id} = getInternalBreak ibi imbs
- return cgb_tick_id
-
-- | Process the result of a Seq or ResumeSeq message. #2950
handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus () -> IO (EvalResult ())
handleSeqHValueStatus interp unit_env eval_status =
@@ -456,16 +436,15 @@ handleSeqHValueStatus interp unit_env eval_status =
Just break -> do
let ibi = evalBreakpointToId break
hug = ue_home_unit_graph unit_env
- bi <- internalBreakIdToBreakId hug ibi
-- Just case: Stopped at a breakpoint, extract SrcSpan information
-- from the breakpoint.
- mb_modbreaks <- getModBreaks . expectJust <$> lookupHugByModule (bi_tick_mod bi) hug
+ mb_modbreaks <- readModBreaks hug ibi
case mb_modbreaks of
-- Nothing case - should not occur! We should have the appropriate
-- breakpoint information
Nothing -> nothing_case
- Just (_, modbreaks) -> put $ brackets . ppr $ (modBreaks_locs modbreaks) ! bi_tick_index bi
+ Just modbreaks -> put $ brackets . ppr $ getBreakLoc ibi modbreaks
-- resume the seq (:force) processing in the iserv process
withForeignRef resume_ctxt_fhv $ \hval -> do
@@ -751,22 +730,19 @@ wormholeRef interp _r = case interpInstance interp of
-- | Get the breakpoint information from the ByteCode object associated to this
-- 'HomeModInfo'.
-getModBreaks :: HomeModInfo -> Maybe (InternalModBreaks, ModBreaks)
+getModBreaks :: HomeModInfo -> Maybe InternalModBreaks
getModBreaks hmi
| Just linkable <- homeModInfoByteCode hmi,
-- The linkable may have 'DotO's as well; only consider BCOs. See #20570.
[cbc] <- linkableBCOs linkable
- = bc_breaks cbc
+ = Just $ bc_breaks cbc
| otherwise
= Nothing -- probably object code
-- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
-- from the 'HomeUnitGraph'.
-readModBreaks :: HomeUnitGraph -> Module -> IO (InternalModBreaks, ModBreaks)
-readModBreaks hug mod = expectJust <$> readModBreaksMaybe hug mod
-
-readModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe (InternalModBreaks, ModBreaks))
-readModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
+readModBreaks :: HasCallStack => HomeUnitGraph -> InternalBreakpointId -> IO (Maybe InternalModBreaks)
+readModBreaks hug ibi = getModBreaks . expectJust <$> HUG.lookupHugByModule (ibi_info_mod ibi) hug
-- -----------------------------------------------------------------------------
-- Misc utils
=====================================
compiler/GHC/Runtime/Interpreter/Types.hs
=====================================
@@ -49,6 +49,9 @@ import GHCi.RemoteTypes
import GHCi.Message ( Pipe )
import GHC.Platform
+#if defined(HAVE_INTERNAL_INTERPRETER)
+import GHC.Platform.Ways
+#endif
import GHC.Utils.TmpFs
import GHC.Utils.Logger
import GHC.Unit.Env
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -124,7 +124,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
flattenBind (StgRec bs) = bs
(proto_bcos, BcM_State{..}) <-
- runBc hsc_env this_mod $ do
+ runBc hsc_env this_mod mb_modBreaks $ do
let flattened_binds = concatMap flattenBind (reverse lifted_binds)
FlatBag.fromList (fromIntegral $ length flattened_binds) <$> mapM schemeTopBind flattened_binds
@@ -132,13 +132,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
"Proto-BCOs" FormatByteCode
(vcat (intersperse (char ' ') (map ppr $ elemsFlatBag proto_bcos)))
- let all_mod_breaks = case mb_modBreaks of
- Just modBreaks -> Just (internalBreaks, modBreaks)
- Nothing -> Nothing
- -- no modBreaks, thus drop all
- -- internalBreaks? Will we ever want to have internal breakpoints in
- -- a module for which we're not doing breakpoints at all? probably
- cbc <- assembleBCOs profile proto_bcos tycs strings all_mod_breaks spt_entries
+ cbc <- assembleBCOs profile proto_bcos tycs strings internalBreaks spt_entries
-- Squash space leaks in the CompiledByteCode. This is really
-- important, because when loading a set of modules into GHCi
@@ -397,44 +391,21 @@ schemeR_wrk fvs nm original_body (args, body)
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
code <- schemeE d 0 p rhs
- hsc_env <- getHscEnv
- current_mod <- getCurrentModule
- liftIO (readModBreaksMaybe (hsc_HUG hsc_env) current_mod) >>= \case
- Nothing -> pure code
- Just _ -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
-
- ibi <- newBreakInfo breakInfo
+ platform <- profilePlatform <$> getProfile
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
+
+ -- TODO: Lookup tick_id in InternalBreakMods and if it returns Nothing then
+ -- we don't have Breakpoint information for this Breakpoint so might as well
+ -- not emit the instruction.
+ ibi <- newBreakInfo breakInfo
+ return $ BRK_FUN ibi `consOL` code
- return $ BRK_FUN ibi `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
--- TODO: WHERE TO PUT
--- Determine the GHCi-allocated 'BreakArray' and module pointer for the module
--- from which the breakpoint originates.
--- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs
--- to refer to pointers in GHCi's address space.
--- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by
--- 'GHC.HsToCore.deSugar'.
---
--- Breakpoints might be disabled because we're in TH, because
--- @-fno-break-points@ was specified, or because a module was reloaded without
--- reinitializing 'ModBreaks'.
---
--- If the module stored in the breakpoint is the currently processed module, use
--- the 'ModBreaks' from the state.
--- If that is 'Nothing', consider breakpoints to be disabled and skip the
--- instruction.
---
--- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph).
--- If the module doesn't exist there, or if the 'ModBreaks' value is
--- uninitialized, skip the instruction (i.e. return Nothing).
-
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
getVarOffSets platform depth env = map getOffSet
where
@@ -2630,9 +2601,9 @@ newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (r, BcM_State))
deriving (Functor, Applicative, Monad, MonadIO)
via (ReaderT BcM_Env (StateT BcM_State IO))
-runBc :: HscEnv -> Module -> BcM r -> IO (r, BcM_State)
-runBc hsc_env this_mod (BcM m)
- = m (BcM_Env hsc_env this_mod) (BcM_State 0 0 (mkInternalModBreaks this_mod mempty))
+runBc :: HscEnv -> Module -> Maybe ModBreaks -> BcM r -> IO (r, BcM_State)
+runBc hsc_env this_mod mbs (BcM m)
+ = m (BcM_Env hsc_env this_mod) (BcM_State 0 0 (mkInternalModBreaks this_mod mbs))
instance HasDynFlags BcM where
getDynFlags = hsc_dflags <$> getHscEnv
=====================================
compiler/GHC/Types/Tickish.hs
=====================================
@@ -45,6 +45,7 @@ import Language.Haskell.Syntax.Extension ( NoExtField )
import Data.Data
import GHC.Utils.Outputable (Outputable (ppr), text, (<+>))
+import Data.Array
{- *********************************************************************
* *
@@ -179,6 +180,8 @@ deriving instance Data (GenTickish 'TickishPassCmm)
--------------------------------------------------------------------------------
-- | Breakpoint tick index
+-- newtype BreakTickIndex = BreakTickIndex Int
+-- deriving (Eq, Ord, Data, Ix, NFData, Outputable)
type BreakTickIndex = Int
-- | Breakpoint identifier.
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -66,7 +66,8 @@ import qualified GHC
import GHC ( LoadHowMuch(..), Target(..), TargetId(..),
Resume, SingleStep, Ghc,
GetDocsFailure(..), pushLogHookM,
- getModuleGraph, handleSourceError )
+ getModuleGraph, handleSourceError,
+ InternalBreakpointId(..) )
import GHC.Driver.Main (hscParseModuleWithLocation, hscParseStmtWithLocation)
import GHC.Hs.ImpExp
import GHC.Hs
@@ -78,7 +79,6 @@ import GHC.Core.TyCo.Ppr
import GHC.Types.SafeHaskell ( getSafeMode )
import GHC.Types.SourceError ( SourceError )
import GHC.Types.Name
-import GHC.Types.Breakpoint
import GHC.Types.Var ( varType )
import GHC.Iface.Syntax ( showToHeader )
import GHC.Builtin.Names
@@ -1572,11 +1572,9 @@ afterRunStmt step run_result = do
Right names -> do
show_types <- isOptionSet ShowType
when show_types $ printTypeOfNames names
- GHC.ExecBreak names mb_info
+ GHC.ExecBreak names mibi
| first_resume : _ <- resumes
- -> do mbid <- maybe (pure Nothing)
- (fmap Just . liftIO . internalBreakIdToBreakId hug) mb_info
- mb_id_loc <- toBreakIdAndLocation mbid
+ -> do mb_id_loc <- toBreakIdAndLocation mibi
let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
if (null bCmd)
then printStoppedAtBreakInfo first_resume names
@@ -1609,13 +1607,13 @@ runAllocs m = do
_ -> Nothing
toBreakIdAndLocation :: GhciMonad m
- => Maybe GHC.BreakpointId -> m (Maybe (Int, BreakLocation))
+ => Maybe GHC.InternalBreakpointId -> m (Maybe (Int, BreakLocation))
toBreakIdAndLocation Nothing = return Nothing
toBreakIdAndLocation (Just inf) = do
st <- getGHCiState
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakModule loc == bi_tick_mod inf,
- breakTick loc == bi_tick_index inf ]
+ breakModule loc == ibi_info_mod inf,
+ breakTick loc == ibi_info_index inf ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
@@ -3795,7 +3793,7 @@ pprStopped res =
<> text (GHC.resumeDecl res))
<> char ',' <+> ppr (GHC.resumeSpan res)
where
- mb_mod_name = moduleName . bi_tick_mod . fst <$> GHC.resumeBreakpointId res
+ mb_mod_name = moduleName . ibi_info_mod . snd <$> GHC.resumeBreakpointId res
showUnits :: GHC.GhcMonad m => m ()
showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do
@@ -4350,11 +4348,11 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
case result of
Left sdoc -> printForUser sdoc
Right (loc, count) -> do
- let bi = GHC.BreakpointId
- { bi_tick_mod = breakModule loc
- , bi_tick_index = breakTick loc
+ let ibi = GHC.InternalBreakpointId
+ { ibi_info_mod = breakModule loc
+ , ibi_info_index = breakTick loc
}
- setupBreakpoint bi count
+ setupBreakpoint ibi count
ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch [break, count] = do
@@ -4371,10 +4369,10 @@ getIgnoreCount str =
where
sdocIgnore = text "Ignore count" <+> quotes (text str)
-setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
+setupBreakpoint :: GhciMonad m => GHC.InternalBreakpointId -> Int -> m()
setupBreakpoint loc count = do
hsc_env <- GHC.getSession
- GHC.setupBreakpoint hsc_env loc count
+ GHC.setupBreakpoint (hscInterp hsc_env) loc count
backCmd :: GhciMonad m => String -> m ()
backCmd arg
@@ -4450,7 +4448,7 @@ breakById inp = do
Left sdoc -> printForUser sdoc
Right (mod, mod_info, fun_str) -> do
let modBreaks = expectJust (GHC.modInfoModBreaks mod_info)
- findBreakAndSet mod $ \_ -> findBreakForBind fun_str modBreaks
+ findBreakAndSet mod $ \_ -> findBreakForBind fun_str (snd modBreaks)
breakSyntax :: a
breakSyntax = throwGhcException $ CmdLineError ("Syntax: :break [<mod>.]<func>[.<func>]\n"
@@ -4729,10 +4727,10 @@ turnBreakOnOff onOff loc
return loc { breakEnabled = onOff }
setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
-setBreakFlag md ix enaDisa = do
+setBreakFlag md ix enaDisa = do
let enaDisaToCount True = breakOn
enaDisaToCount False = breakOff
- setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
+ setupBreakpoint (GHC.InternalBreakpointId md ix) $ enaDisaToCount enaDisa
-- ---------------------------------------------------------------------------
-- User code exception handling
=====================================
rts/Interpreter.c
=====================================
@@ -1454,9 +1454,9 @@ run_BCO:
/* check for a breakpoint on the beginning of a let binding */
case bci_BRK_FUN:
{
- int arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
+ W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
#if defined(PROFILING)
- int arg5_cc;
+ W_ arg5_cc;
#endif
StgArrBytes *breakPoints;
int returning_from_break, stop_next_breakpoint;
@@ -1473,7 +1473,7 @@ run_BCO:
arg1_brk_array = BCO_GET_LARGE_ARG;
arg2_info_mod_name = BCO_GET_LARGE_ARG;
arg3_info_mod_id = BCO_GET_LARGE_ARG;
- arg4_info_index = BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_LIT(BCO_GET_LARGE_ARG);
#if defined(PROFILING)
arg5_cc = BCO_GET_LARGE_ARG;
#else
@@ -1506,11 +1506,11 @@ run_BCO:
// stop the current thread if either `stop_next_breakpoint` is
// true OR if the ignore count for this particular breakpoint is zero
- StgInt ignore_count = ((StgInt*)breakPoints->payload)[BCO_LIT(arg4_info_index)];
+ StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
if (stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
- ((StgInt*)breakPoints->payload)[BCO_LIT(arg4_info_index)] = --ignore_count;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
else if (stop_next_breakpoint == true || ignore_count == 0)
{
@@ -1560,7 +1560,7 @@ run_BCO:
SpW(10) = (W_)new_aps;
SpW(9) = (W_)False_closure; // True <=> an exception
SpW(8) = (W_)&stg_ap_ppv_info;
- SpW(7) = (W_)BCO_LIT(arg4_info_index);
+ SpW(7) = (W_)arg4_info_index;
SpW(6) = (W_)&stg_ap_n_info;
SpW(5) = (W_)BCO_LIT(arg3_info_mod_id);
SpW(4) = (W_)&stg_ap_n_info;
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a1ba3e64481e43efc1f40cf9001ab…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a1ba3e64481e43efc1f40cf9001ab…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T18570] Fix field type mismatch error handling
by Sjoerd Visscher (＠trac-sjoerd_visscher) 27 Jun '25
by Sjoerd Visscher (＠trac-sjoerd_visscher) 27 Jun '25
27 Jun '25
Sjoerd Visscher pushed to branch wip/T18570 at Glasgow Haskell Compiler / GHC
Commits:
cd2daa3b by Sjoerd Visscher at 2025-06-27T16:56:17+02:00
Fix field type mismatch error handling
- - - - -
2 changed files:
- compiler/GHC/Tc/TyCl.hs
- testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
Changes:
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -4787,6 +4787,7 @@ checkValidTyCl tc
= setSrcSpan (getSrcSpan tc) $
addTyConCtxt tc $
recoverM recovery_code $
+ checkNoErrs $
do { traceTc "Starting validity for tycon" (ppr tc)
; checkValidTyCon tc
; checkTyConConsistentWithBoot tc -- See Note [TyCon boot consistency checking]
@@ -4991,7 +4992,7 @@ checkValidTyCon tc
check_fields ((label, con1) :| other_fields)
-- These fields all have the same name, but are from
-- different constructors in the data type
- = recoverM (return ()) $ mapM_ checkOne other_fields
+ = mapM_ checkOne other_fields
-- Check that all the fields in the group have the same type
-- NB: this check assumes that all the constructors of a given
-- data type use the same type variables
@@ -5001,8 +5002,10 @@ checkValidTyCon tc
lbl = flLabel label
checkOne (_, con2) -- Do it both ways to ensure they are structurally identical
- = do { checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2
- ; checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }
+ = do { ((), no_errs) <- askNoErrs $
+ checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2
+ ; when no_errs $
+ checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }
where
res2 = dataConOrigResTy con2
fty2 = dataConFieldType con2 lbl
@@ -5029,8 +5032,8 @@ checkPartialRecordField all_cons fld
checkFieldCompat :: FieldLabelString -> DataCon -> DataCon
-> Type -> Type -> Type -> Type -> TcM ()
checkFieldCompat fld con1 con2 res1 res2 fty1 fty2
- = do { checkTc (isJust mb_subst1) (TcRnCommonFieldResultTypeMismatch con1 con2 fld)
- ; checkTc (isJust mb_subst2) (TcRnCommonFieldTypeMismatch con1 con2 fld) }
+ = do { unless (isJust mb_subst1) (addErrTc $ TcRnCommonFieldResultTypeMismatch con1 con2 fld)
+ ; unless (isJust mb_subst2) (addErrTc $ TcRnCommonFieldTypeMismatch con1 con2 fld) }
where
mb_subst1 = tcMatchTy res1 res2
mb_subst2 = tcMatchTyX (expectJust mb_subst1) fty1 fty2
=====================================
testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
=====================================
@@ -2,10 +2,3 @@ CommonFieldTypeMismatch.hs:3:1: error: [GHC-91827]
• Constructors A1 and A2 give different types for field ‘fld’
• In the data type declaration for ‘A’
-CommonFieldTypeMismatch.hs:4:8: error: [GHC-83865]
- • Couldn't match type ‘[Char]’ with ‘Int’
- Expected: Int
- Actual: String
- • In the expression: fld
- In an equation for ‘fld’: fld A2 {fld = fld} = fld
-
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd2daa3b3c16af0e44d82c65e632fc2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd2daa3b3c16af0e44d82c65e632fc2…
You're receiving this email because of your account on gitlab.haskell.org.
1
0