[Git][ghc/ghc][wip/backports-9.14] 12 commits: STM: don't create a transaction in the rhs of catchRetry# (#26028)
by Ben Gamari (＠bgamari) 12 Aug '25
by Ben Gamari (＠bgamari) 12 Aug '25
12 Aug '25
Ben Gamari pushed to branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC
Commits:
712da356 by Sylvain Henry at 2025-08-12T12:33:43-04:00
STM: don't create a transaction in the rhs of catchRetry# (#26028)
We don't need to create a transaction for the rhs of (catchRetry#)
because contrary to the lhs we don't need to abort it on retry. Moreover
it is particularly harmful if we have code such as (#26028):
let cN = readTVar vN >> retry
tree = c1 `orElse` (c2 `orElse` (c3 `orElse` ...))
atomically tree
Because it will stack transactions for the rhss and the read-sets of all
the transactions will be iteratively merged in O(n^2) after the
execution of the most nested retry.
(cherry picked from commit 0a5836891ca29836a24c306d2a364c2e4b5377fd)
- - - - -
a52e0d45 by Zubin Duggal at 2025-08-12T12:33:54-04:00
haddock: Don't warn about missing link destinations for derived names.
Fixes #26114
(cherry picked from commit 5dabc718a04bfc4d277c5ff7f815ee3d6b9670cb)
- - - - -
9d73a535 by ARATA Mizuki at 2025-08-12T12:34:35-04:00
x86 NCG: Better lowering for shuffleFloatX4# and shuffleDoubleX2#
The new implementation
* make use of specialized instructions like (V)UNPCK{L,H}{PS,PD}, and
* do not require -mavx.
Close #26096
Co-authored-by: sheaf <sam.derbyshire(a)gmail.com>
(cherry picked from commit 7ee22fd53bea1c69780613c339feee9ae75525b2)
- - - - -
86a6ca1e by Duncan Coutts at 2025-08-12T12:34:59-04:00
base: Deprecate GHC.Weak.Finalize.runFinalizerBatch
https://github.com/haskell/core-libraries-committee/issues/342
(cherry picked from commit 360fa82cc0e06163c7d712a22e7a33cf30e6b852)
- - - - -
3be62b10 by Zubin Duggal at 2025-08-12T12:35:18-04:00
fetch_gitlab: Ensure we copy users_guide.pdf and Haddock.pdf to the release docs directory
Fixes #24093
(cherry picked from commit 9fa590a6e27545995cdcf419ed7a6504e6668b18)
- - - - -
3c02ae3c by Teo Camarasu at 2025-08-12T12:35:37-04:00
rts/nonmovingGC: remove n_free
We remove the nonmovingHeap.n_free variable.
We wanted this to track the length of nonmovingHeap.free.
But this isn't possible to do atomically.
When this isn't accurate we can get a segfault by going past the end of
the list.
Instead, we just count the length of the list when we grab it in
nonmovingPruneFreeSegment.
Resolves #26186
(cherry picked from commit 45efaf71d97355f76fe0db5af2fc5b4b67fddf47)
- - - - -
d96470b1 by Andreas Klebinger at 2025-08-12T12:35:58-04:00
Disable -fprof-late-overloaded-calls for join points.
Currently GHC considers cost centres as destructive to
join contexts. Or in other words this is not considered valid:
join f x = ...
in
... -> scc<tick> jmp
This makes the functionality of `-fprof-late-overloaded-calls` not feasible
for join points in general. We used to try to work around this by putting the
ticks on the rhs of the join point rather than around the jump. However beyond
the loss of accuracy this was broken for recursive join points as we ended up
with something like:
rec-join f x = scc<tick> ... jmp f x
Which similarly is not valid as the tick once again destroys the tail call.
One might think we could limit ourselves to non-recursive tail calls and do
something clever like:
join f x = scc<tick> ...
in ... jmp f x
And sometimes this works! But sometimes the full rhs would look something like:
join g x = ....
join f x = scc<tick> ... -> jmp g x
Which, would again no longer be valid. I believe in the long run we can make
cost centre ticks non-destructive to join points. Or we could keep track of
where we are/are not allowed to insert a cost centre. But in the short term I will
simply disable the annotation of join calls under this flag.
(cherry picked from commit 7da86e165612721c4e09f772a3fdaffc733e9293)
- - - - -
99e4eb40 by Rodrigo Mesquita at 2025-08-12T12:36:10-04:00
base: Export displayExceptionWithInfo
This function should be exposed from base following CLC#285
Approved change in CLC#344
Fixes #26058
(cherry picked from commit ef03d8b8851a1cace5f792fe5a91b6b227198aa2)
- - - - -
81de45dc by Sebastian Graf at 2025-08-12T12:36:29-04:00
CprAnal: Detect recursive newtypes (#25944)
While `cprTransformDataConWork` handles recursive data con workers, it
did not detect the case when a newtype is responsible for the recursion.
This is now detected in the `Cast` case of `cprAnal`.
The same reproducer made it clear that `isRecDataCon` lacked congruent
handling for `AppTy` and `CastTy`, now fixed.
Furthermore, the new repro case T25944 triggered this bug via an
infinite loop in `cprFix`, caused by the infelicity in `isRecDataCon`.
While it should be much less likely to trigger such an infinite loop now
that `isRecDataCon` has been fixed, I made sure to abort the loop after
10 iterations and emitting a warning instead.
Fixes #25944.
(cherry picked from commit 4bc78496406f7469640faaa46e2f311c05760124)
- - - - -
3d821e16 by Ben Gamari at 2025-08-12T12:36:43-04:00
configure: Allow override of CrossCompiling
As noted in #26236, the current inference logic is a bit simplistic. In
particular, there are many cases (e.g. building for a new libc) where
the target and host triples may differ yet we are still able to run the
produced artifacts as native code.
Closes #26236.
(cherry picked from commit 81577fe7c1913c53608bf03e48f84507be904620)
- - - - -
0061a178 by Matthew Pickering at 2025-08-12T12:37:37-04:00
level imports: Check the level of exported identifiers
The level imports specification states that exported identifiers have to
be at level 0. This patch adds the requird level checks that all
explicitly mentioned identifiers occur at level 0.
For implicit export specifications (T(..) and module B), only level 0
identifiers are selected for re-export.
ghc-proposal: https://github.com/ghc-proposals/ghc-proposals/pull/705
Fixes #26090
(cherry picked from commit 246b785367d8bf0059a641306fe662fecc3342af)
- - - - -
c0e762b9 by Ben Gamari at 2025-08-12T12:37:57-04:00
testsuite/recomp015: Ignore stderr
This is necessary since ld.bfd complains
that we don't have a .note.GNU-stack section,
potentially resulting in an executable stack.
(cherry picked from commit 637bb53825b9414f7c7dbed4cc3e5cc1ed4d2329)
- - - - -
63 changed files:
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/Core/LateCC/OverloadedCalls.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Types/Name/Reader.hs
- configure.ac
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/profiling.rst
- libraries/base/changelog.md
- libraries/base/src/Control/Exception.hs
- libraries/base/src/GHC/Weak/Finalize.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- rts/PrimOps.cmm
- rts/RaiseAsync.c
- rts/STM.c
- rts/sm/NonMoving.c
- rts/sm/NonMoving.h
- rts/sm/NonMovingAllocate.c
- rts/sm/Sanity.c
- + testsuite/tests/cpranal/sigs/T25944.hs
- + testsuite/tests/cpranal/sigs/T25944.stderr
- testsuite/tests/cpranal/sigs/all.T
- testsuite/tests/driver/recomp015/all.T
- testsuite/tests/haddock/haddock_testsuite/Makefile
- + testsuite/tests/haddock/haddock_testsuite/T26114.hs
- + testsuite/tests/haddock/haddock_testsuite/T26114.stdout
- testsuite/tests/haddock/haddock_testsuite/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/lib/stm/T26028.hs
- + testsuite/tests/lib/stm/T26028.stdout
- + testsuite/tests/lib/stm/all.T
- testsuite/tests/simd/should_run/all.T
- + testsuite/tests/simd/should_run/doublex2_shuffle.hs
- + testsuite/tests/simd/should_run/doublex2_shuffle.stdout
- + testsuite/tests/simd/should_run/doublex2_shuffle_baseline.hs
- + testsuite/tests/simd/should_run/doublex2_shuffle_baseline.stdout
- + testsuite/tests/simd/should_run/floatx4_shuffle.hs
- + testsuite/tests/simd/should_run/floatx4_shuffle.stdout
- + testsuite/tests/simd/should_run/floatx4_shuffle_baseline.hs
- + testsuite/tests/simd/should_run/floatx4_shuffle_baseline.stdout
- + testsuite/tests/splice-imports/DodgyLevelExport.hs
- + testsuite/tests/splice-imports/DodgyLevelExport.stderr
- + testsuite/tests/splice-imports/DodgyLevelExportA.hs
- + testsuite/tests/splice-imports/LevelImportExports.hs
- + testsuite/tests/splice-imports/LevelImportExports.stdout
- + testsuite/tests/splice-imports/LevelImportExportsA.hs
- testsuite/tests/splice-imports/Makefile
- + testsuite/tests/splice-imports/ModuleExport.hs
- + testsuite/tests/splice-imports/ModuleExport.stderr
- + testsuite/tests/splice-imports/ModuleExportA.hs
- + testsuite/tests/splice-imports/ModuleExportB.hs
- + testsuite/tests/splice-imports/T26090.hs
- + testsuite/tests/splice-imports/T26090.stderr
- + testsuite/tests/splice-imports/T26090A.hs
- testsuite/tests/splice-imports/all.T
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13f323286857f69417f2d4ae4e38b2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13f323286857f69417f2d4ae4e38b2…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/backports-9.14] In TcSShortCut, typechecker plugins should get empty Givens
by Ben Gamari (＠bgamari) 12 Aug '25
by Ben Gamari (＠bgamari) 12 Aug '25
12 Aug '25
Ben Gamari pushed to branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC
Commits:
13f32328 by Simon Peyton Jones at 2025-08-12T12:33:03-04:00
In TcSShortCut, typechecker plugins should get empty Givens
Solving in TcShortCut mode means /ignoring the Givens/. So we
should not pass them to typechecker plugins!
Fixes #26258.
This is a fixup to the earlier MR:
commit 1bd12371feacc52394a0e660ef9349f9e8ee1c06
Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com>
Date: Mon Jul 21 10:04:49 2025 +0100
Improve treatment of SPECIALISE pragmas -- again!
(cherry picked from commit 2860a9a5d657eacd711a7df4a231dc9fe81402c2)
- - - - -
3 changed files:
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
Changes:
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -496,11 +496,15 @@ We could use the Eq [a] superclass of the Ord [a], or we could use the top-level
instance `Eq a => Eq [a]`. But if we did the latter we'd be stuck with an
insoluble constraint (Eq a).
-So the ShortCutSolving rule is this:
+-----------------------------------
+So the ShortCutSolving plan is this:
If we could solve a constraint from a local Given,
- try first to /completely/ solve the constraint using only top-level instances.
+ try first to /completely/ solve the constraint
+ using only top-level instances,
+ /without/ using any local Givens.
- If that succeeds, use it
- If not, use the local Given
+-----------------------------------
An example that succeeds:
@@ -555,7 +559,7 @@ The moving parts are relatively simple:
- `matchLocalInst`, which would otherwise consult Given quantified constraints
- `GHC.Tc.Solver.Instance.Class.matchInstEnv`: when short-cut solving, don't
pick overlappable top-level instances
-
+ - `GHC.Tc.Solver.Solve.runTcPluginsWanted`: don't pass any Givens to the plugin
Some wrinkles:
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -897,7 +897,9 @@ for it, so TcS carries a mutable location where the binding can be
added. This is initialised from the innermost implication constraint.
-}
--- | See Note [TcSMode]
+-- | The mode for the constraint solving monad.
+--
+-- See Note [TcSMode], where each constructor is documented
data TcSMode
= TcSVanilla -- ^ Normal constraint solving
| TcSPMCheck -- ^ Used when doing patterm match overlap checks
@@ -905,6 +907,12 @@ data TcSMode
| TcSShortCut -- ^ Fully solve all constraints, without using local Givens
deriving (Eq)
+instance Outputable TcSMode where
+ ppr TcSVanilla = text "TcSVanilla"
+ ppr TcSPMCheck = text "TcSPMCheck"
+ ppr TcSEarlyAbort = text "TcSEarlyAbort"
+ ppr TcSShortCut = text "TcSShortcut"
+
{- Note [TcSMode]
~~~~~~~~~~~~~~~~~
The constraint solver can operate in different modes:
=====================================
compiler/GHC/Tc/Solver/Solve.hs
=====================================
@@ -1011,9 +1011,17 @@ solveSimpleGivens givens
solveSimpleWanteds :: Cts -> TcS Cts
-- The result is not necessarily zonked
solveSimpleWanteds simples
- = do { traceTcS "solveSimpleWanteds {" (ppr simples)
+ = do { mode <- getTcSMode
; dflags <- getDynFlags
+ ; inerts <- getInertSet
+
+ ; traceTcS "solveSimpleWanteds {" $
+ vcat [ text "Mode:" <+> ppr mode
+ , text "Inerts:" <+> ppr inerts
+ , text "Wanteds to solve:" <+> ppr simples ]
+
; (n,wc) <- go 1 (solverIterations dflags) simples
+
; traceTcS "solveSimpleWanteds end }" $
vcat [ text "iterations =" <+> ppr n
, text "residual =" <+> ppr wc ]
@@ -1663,19 +1671,28 @@ runTcPluginsGiven
-- 'solveSimpleWanteds' should feed the updated wanteds back into the
-- main solver.
runTcPluginsWanted :: Cts -> TcS (Bool, Cts)
-runTcPluginsWanted simples1
- | isEmptyBag simples1
- = return (False, simples1)
+runTcPluginsWanted wanted
+ | isEmptyBag wanted
+ = return (False, wanted)
| otherwise
= do { solvers <- getTcPluginSolvers
- ; if null solvers then return (False, simples1) else
-
- do { given <- getInertGivens
- ; wanted <- TcS.zonkSimples simples1 -- Plugin requires zonked inputs
-
- ; traceTcS "Running plugins (" (vcat [ text "Given:" <+> ppr given
- , text "Wanted:" <+> ppr wanted ])
- ; p <- runTcPluginSolvers solvers (given, bagToList wanted)
+ ; if null solvers then return (False, wanted) else
+
+ do { -- Find the set of Givens to give to the plugin.
+ -- If TcSMode = TcSShortCut, we are solving with
+ -- no Givens so don't return any (#26258)!
+ -- See Note [Shortcut solving] in GHC.Tc.Solver.Dict
+ mode <- getTcSMode
+ ; given <- case mode of
+ TcSShortCut -> return []
+ _ -> getInertGivens
+
+ -- Plugin requires zonked input wanteds
+ ; zonked_wanted <- TcS.zonkSimples wanted
+
+ ; traceTcS "Running plugins {" (vcat [ text "Given:" <+> ppr given
+ , text "Wanted:" <+> ppr zonked_wanted ])
+ ; p <- runTcPluginSolvers solvers (given, bagToList zonked_wanted)
; let (_, solved_wanted) = pluginSolvedCts p
(_, unsolved_wanted) = pluginInputCts p
new_wanted = pluginNewCts p
@@ -1684,9 +1701,6 @@ runTcPluginsWanted simples1
listToBag unsolved_wanted `andCts`
listToBag insols
--- SLPJ: I'm deeply suspicious of this
--- ; updInertCans (removeInertCts $ solved_givens)
-
; mapM_ setEv solved_wanted
; traceTcS "Finished plugins }" (ppr new_wanted)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/13f323286857f69417f2d4ae4e38b21…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/13f323286857f69417f2d4ae4e38b21…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/backports-9.14] Revert "base: Expose Backtraces constructor and fields"
by Ben Gamari (＠bgamari) 12 Aug '25
by Ben Gamari (＠bgamari) 12 Aug '25
12 Aug '25
Ben Gamari pushed to branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC
Commits:
7fb21569 by fendor at 2025-08-12T12:32:21-04:00
Revert "base: Expose Backtraces constructor and fields"
This reverts commit 17db44c5b32fff82ea988fa4f1a233d1a27bdf57.
(cherry picked from commit 4f6bc9cf2a5569e8ac3303a79f8a88fb23e2578b)
- - - - -
6 changed files:
- libraries/base/changelog.md
- libraries/base/src/Control/Exception/Backtrace.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
Changes:
=====================================
libraries/base/changelog.md
=====================================
@@ -23,7 +23,6 @@
* `GHC.TypeNats.Internal`
* `GHC.ExecutionStack.Internal`.
* Deprecate `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329)
- * Expose constructor and field of `Backtraces` from `Control.Exception.Backtrace`, as per [CLC #199](https://github.com/haskell/core-libraries-committee/issues/199#issuecomment-1954662391)
* Fix incorrect results of `integerPowMod` when the base is 0 and the exponent is negative, and `integerRecipMod` when the modulus is zero ([#26017](https://gitlab.haskell.org/ghc/ghc/-/issues/26017)).
* Fix the rewrite rule for `scanl'` not being strict in the first element of the output list ([#26143](https://gitlab.haskell.org/ghc/ghc/-/issues/26143)).
=====================================
libraries/base/src/Control/Exception/Backtrace.hs
=====================================
@@ -51,7 +51,7 @@ module Control.Exception.Backtrace
, getBacktraceMechanismState
, setBacktraceMechanismState
-- * Collecting backtraces
- , Backtraces(..)
+ , Backtraces
, displayBacktraces
, collectBacktraces
) where
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
+ data Backtraces = ...
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
+ data Backtraces = ...
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
+ data Backtraces = ...
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -322,7 +322,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
+ data Backtraces = ...
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7fb21569beed25a2b81002cf8a7576e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7fb21569beed25a2b81002cf8a7576e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Ben Gamari pushed new branch wip/backports-9.14 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.14
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Ben Gamari pushed new branch wip/T26281 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T26281
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Improve deep subsumption
by Marge Bot (＠marge-bot) 12 Aug '25
by Marge Bot (＠marge-bot) 12 Aug '25
12 Aug '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
56b32c5a by sheaf at 2025-08-12T10:00:19-04:00
Improve deep subsumption
This commit improves the DeepSubsumption sub-typing implementation
in GHC.Tc.Utils.Unify.tc_sub_type_deep by being less eager to fall back
to unification.
For example, we now are properly able to prove the subtyping relationship
((∀ a. a->a) -> Int) -> Bool <= β[tau] Bool
for an unfilled metavariable β. In this case (with an AppTy on the right),
we used to fall back to unification. No longer: now, given that the LHS
is a FunTy and that the RHS is a deep rho type (does not need any instantiation),
we try to make the RHS into a FunTy, viz.
β := (->) γ
We can then continue using covariance & contravariance of the function
arrow, which allows us to prove the subtyping relationship, instead of
trying to unify which would cause us to error out with:
Couldn't match expected type ‘β’ with actual type ‘(->) ((∀ a. a -> a) -> Int)
See Note [FunTy vs non-FunTy case in tc_sub_type_deep] in GHC.Tc.Utils.Unify.
The other main improvement in this patch concerns type inference.
The main subsumption logic happens (before & after this patch) in
GHC.Tc.Gen.App.checkResultTy. However, before this patch, all of the
DeepSubsumption logic only kicked in in 'check' mode, not in 'infer' mode.
This patch adds deep instantiation in the 'infer' mode of checkResultTy
when we are doing deep subsumption, which allows us to accept programs
such as:
f :: Int -> (forall a. a->a)
g :: Int -> Bool -> Bool
test1 b =
case b of
True -> f
False -> g
test2 b =
case b of
True -> g
False -> f
See Note [Deeply instantiate in checkResultTy when inferring].
Finally, we add representation-polymorphism checks to ensure that the
lambda abstractions we introduce when doing subsumption obey the
representation polymorphism invariants of Note [Representation polymorphism invariants]
in GHC.Core. See Note [FunTy vs FunTy case in tc_sub_type_deep].
This is accompanied by a courtesy change to `(<.>) :: HsWrapper -> HsWrapper -> HsWrapper`,
adding the equation:
WpCast c1 <.> WpCast c2 = WpCast (c1 `mkTransCo` c2)
This is useful because mkWpFun does not introduce an eta-expansion when
both of the argument & result wrappers are casts; so this change allows
us to avoid introducing lambda abstractions when casts suffice.
Fixes #26225
- - - - -
d175aff8 by Sylvain Henry at 2025-08-12T10:01:31-04:00
Add regression test for #18619
- - - - -
a3983a26 by Sylvain Henry at 2025-08-12T10:02:20-04:00
RTS: remove some TSAN annotations (#20464)
Use RELAXED_LOAD_ALWAYS macro instead.
- - - - -
0434af81 by Ben Gamari at 2025-08-12T10:03:02-04:00
Bump time submodule to 1.15
Also required bumps of Cabal, directory, and hpc.
- - - - -
be2e65f6 by Ben Gamari at 2025-08-12T10:35:58-04:00
rts: Clarify rationale for undefined atomic wrappers
Since c06e3f46d24ef69f3a3d794f5f604cb8c2a40cbc the RTS has declared
various atomic operation wrappers defined by ghc-internal as undefined.
While the rationale for this isn't clear from the commit message, I
believe that this is necessary due to the unregisterised backend.
Specifically, the code generator will reference these symbols when
compiling RTS Cmm sources.
- - - - -
dc8e2942 by Andreas Klebinger at 2025-08-12T10:36:00-04:00
Make unexpected LLVM versions a warning rather than an error.
Typically a newer LLVM version *will* work so erroring out if
a user uses a newer LLVM version is too aggressive.
Fixes #25915
- - - - -
8a14d3e2 by Zubin Duggal at 2025-08-12T10:36:02-04:00
testsuite: Be more permissive when filtering out GNU_PROPERTY_TYPE linker warnings
The warning text is slightly different with ld.bfd.
Fixes #26249
- - - - -
fc691fb4 by Teo Camarasu at 2025-08-12T10:36:03-04:00
rts: ensure MessageBlackHole.link is always a valid closure
We turn a MessageBlackHole into an StgInd in wakeBlockingQueue().
Therefore it's important that the link field, which becomes the
indirection field, always points to a valid closure.
It's unclear whether it's currently possible for the previous behaviour
to lead to a crash, but it's good to be consistent about this invariant nonetheless.
Co-authored-by: Andreas Klebinger <klebinger.andreas(a)gmx.at>
- - - - -
d7990d5a by Teo Camarasu at 2025-08-12T10:36:03-04:00
rts: spin if we see a WHITEHOLE in messageBlackHole
When a BLACKHOLE gets cancelled in raiseAsync, we indirect to a THUNK.
GC can then shortcut this, replacing our BLACKHOLE with a fresh THUNK.
This THUNK is not guaranteed to have a valid indirectee field.
If at the same time, a message intended for the previous BLACKHOLE is
processed and concurrently we BLACKHOLE the THUNK, thus temporarily
turning it into a WHITEHOLE, we can get a segfault, since we look at the
undefined indirectee field of the THUNK
The fix is simple: spin if we see a WHITEHOLE, and it will soon be
replaced with a valid BLACKHOLE.
Resolves #26205
- - - - -
423d9752 by Oleg Grenrus at 2025-08-12T10:36:04-04:00
Allow defining HasField instances for naughty fields
Resolves #26295
... as HasField solver doesn't solve for fields with "naughty"
selectors, we could as well allow defining HasField instances for these
fields.
- - - - -
49 changed files:
- compiler/GHC/Builtin/PrimOps/Ids.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Concrete.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/ghc.cabal.in
- ghc/ghc-bin.cabal.in
- libraries/Cabal
- libraries/directory
- libraries/hpc
- libraries/time
- libraries/unix
- rts/Messages.c
- rts/StgMiscClosures.cmm
- rts/Updates.h
- rts/external-symbols.list.in
- rts/posix/ticker/Pthread.c
- rts/posix/ticker/TimerFd.c
- rts/rts.cabal
- testsuite/driver/testlib.py
- testsuite/tests/corelint/LintEtaExpand.stderr
- testsuite/tests/indexed-types/should_fail/T5439.stderr
- + testsuite/tests/numeric/should_run/T18619.hs
- + testsuite/tests/numeric/should_run/T18619.stderr
- testsuite/tests/numeric/should_run/all.T
- + testsuite/tests/overloadedrecflds/should_run/T26295.hs
- + testsuite/tests/overloadedrecflds/should_run/T26295.stdout
- testsuite/tests/overloadedrecflds/should_run/all.T
- testsuite/tests/partial-sigs/should_compile/T10403.stderr
- testsuite/tests/partial-sigs/should_fail/T10615.stderr
- + testsuite/tests/rep-poly/NoEtaRequired.hs
- testsuite/tests/rep-poly/T21906.stderr
- testsuite/tests/rep-poly/all.T
- + testsuite/tests/typecheck/should_compile/T26225.hs
- + testsuite/tests/typecheck/should_compile/T26225b.hs
- testsuite/tests/typecheck/should_compile/all.T
- − testsuite/tests/typecheck/should_fail/T12563.stderr
- testsuite/tests/typecheck/should_fail/T14618.stderr
- testsuite/tests/typecheck/should_fail/T6022.stderr
- testsuite/tests/typecheck/should_fail/T8883.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_fail/tcfail140.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/64fad685ef3edd4818dcb346a4bc4a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/64fad685ef3edd4818dcb346a4bc4a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] RTS: remove some TSAN annotations (#20464)
by Marge Bot (＠marge-bot) 12 Aug '25
by Marge Bot (＠marge-bot) 12 Aug '25
12 Aug '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
a3983a26 by Sylvain Henry at 2025-08-12T10:02:20-04:00
RTS: remove some TSAN annotations (#20464)
Use RELAXED_LOAD_ALWAYS macro instead.
- - - - -
2 changed files:
- rts/posix/ticker/Pthread.c
- rts/posix/ticker/TimerFd.c
Changes:
=====================================
rts/posix/ticker/Pthread.c
=====================================
@@ -92,15 +92,13 @@ static void *itimer_thread_func(void *_handle_tick)
// Relaxed is sufficient: If we don't see that exited was set in one iteration we will
// see it next time.
- TSAN_ANNOTATE_BENIGN_RACE(&exited, "itimer_thread_func");
- while (!RELAXED_LOAD(&exited)) {
+ while (!RELAXED_LOAD_ALWAYS(&exited)) {
if (rtsSleep(itimer_interval) != 0) {
sysErrorBelch("Ticker: sleep failed: %s", strerror(errno));
}
// first try a cheap test
- TSAN_ANNOTATE_BENIGN_RACE(&stopped, "itimer_thread_func");
- if (RELAXED_LOAD(&stopped)) {
+ if (RELAXED_LOAD_ALWAYS(&stopped)) {
OS_ACQUIRE_LOCK(&mutex);
// should we really stop?
if (stopped) {
=====================================
rts/posix/ticker/TimerFd.c
=====================================
@@ -109,8 +109,7 @@ static void *itimer_thread_func(void *_handle_tick)
// Relaxed is sufficient: If we don't see that exited was set in one iteration we will
// see it next time.
- TSAN_ANNOTATE_BENIGN_RACE(&exited, "itimer_thread_func");
- while (!RELAXED_LOAD(&exited)) {
+ while (!RELAXED_LOAD_ALWAYS(&exited)) {
if (poll(pollfds, 2, -1) == -1) {
// While the RTS attempts to mask signals, some foreign libraries
// may rely on signal delivery may unmask them. Consequently we may
@@ -144,8 +143,7 @@ static void *itimer_thread_func(void *_handle_tick)
}
// first try a cheap test
- TSAN_ANNOTATE_BENIGN_RACE(&stopped, "itimer_thread_func");
- if (RELAXED_LOAD(&stopped)) {
+ if (RELAXED_LOAD_ALWAYS(&stopped)) {
OS_ACQUIRE_LOCK(&mutex);
// should we really stop?
if (stopped) {
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3983a264c7509ed25cae0ade60c13b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3983a264c7509ed25cae0ade60c13b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
0434af81 by Ben Gamari at 2025-08-12T10:03:02-04:00
Bump time submodule to 1.15
Also required bumps of Cabal, directory, and hpc.
- - - - -
7 changed files:
- compiler/ghc.cabal.in
- ghc/ghc-bin.cabal.in
- libraries/Cabal
- libraries/directory
- libraries/hpc
- libraries/time
- libraries/unix
Changes:
=====================================
compiler/ghc.cabal.in
=====================================
@@ -120,7 +120,7 @@ Library
process >= 1 && < 1.7,
bytestring >= 0.11 && < 0.13,
binary == 0.8.*,
- time >= 1.4 && < 1.15,
+ time >= 1.4 && < 1.16,
containers >= 0.6.2.1 && < 0.9,
array >= 0.1 && < 0.6,
filepath >= 1.5 && < 1.6,
=====================================
ghc/ghc-bin.cabal.in
=====================================
@@ -64,7 +64,7 @@ Executable ghc
ghci == @ProjectVersionMunged@,
haskeline == 0.8.*,
exceptions == 0.10.*,
- time >= 1.8 && < 1.15
+ time >= 1.8 && < 1.16
CPP-Options: -DHAVE_INTERNAL_INTERPRETER
Other-Modules:
GHCi.Leak
=====================================
libraries/Cabal
=====================================
@@ -1 +1 @@
-Subproject commit 703582f80f6d7f0c914ef4b885affcfc7b7b6ec8
+Subproject commit d9b0904b49dc84e0bfc79062daf2bbdf9d22a422
=====================================
libraries/directory
=====================================
@@ -1 +1 @@
-Subproject commit ffd4fc248ee36095ddec55598b0f8e3a9ac762a8
+Subproject commit 6442a3cf04f74d82cdf8c9213324313d52b23d28
=====================================
libraries/hpc
=====================================
@@ -1 +1 @@
-Subproject commit 7b7aed397cbe2bb36824d8627527fa4d5abffaa6
+Subproject commit 12675279dc5cbea4ade8b5157b080390d598f03f
=====================================
libraries/time
=====================================
@@ -1 +1 @@
-Subproject commit e5c5d1987011efe88a21ab6ded45aaa33a16274f
+Subproject commit 507f50844802f1469ba6cadfeefd4e3fecee0416
=====================================
libraries/unix
=====================================
@@ -1 +1 @@
-Subproject commit 1c3548c3906bb0d912eda5685968934183f4b51f
+Subproject commit c9b3e95b5c15b118e55522bd92963038c6a88160
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0434af813cd5aa629ef7566cd267d7c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0434af813cd5aa629ef7566cd267d7c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
12 Aug '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d175aff8 by Sylvain Henry at 2025-08-12T10:01:31-04:00
Add regression test for #18619
- - - - -
3 changed files:
- + testsuite/tests/numeric/should_run/T18619.hs
- + testsuite/tests/numeric/should_run/T18619.stderr
- testsuite/tests/numeric/should_run/all.T
Changes:
=====================================
testsuite/tests/numeric/should_run/T18619.hs
=====================================
@@ -0,0 +1,7 @@
+module Main where
+
+import Data.Bits
+
+main :: IO ()
+main = do
+ print $ Data.Bits.shiftL (1 :: Integer) ((-1) :: Int)
=====================================
testsuite/tests/numeric/should_run/T18619.stderr
=====================================
@@ -0,0 +1,3 @@
+T18619: Uncaught exception ghc-internal:GHC.Internal.Exception.Type.ArithException:
+
+arithmetic overflow
=====================================
testsuite/tests/numeric/should_run/all.T
=====================================
@@ -87,3 +87,4 @@ test('T24066', normal, compile_and_run, [''])
test('div01', normal, compile_and_run, [''])
test('T24245', normal, compile_and_run, [''])
test('T25653', normal, compile_and_run, [''])
+test('T18619', exit_code(1), compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d175aff8ad6bb982c4b6e12993f6b4e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d175aff8ad6bb982c4b6e12993f6b4e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
56b32c5a by sheaf at 2025-08-12T10:00:19-04:00
Improve deep subsumption
This commit improves the DeepSubsumption sub-typing implementation
in GHC.Tc.Utils.Unify.tc_sub_type_deep by being less eager to fall back
to unification.
For example, we now are properly able to prove the subtyping relationship
((∀ a. a->a) -> Int) -> Bool <= β[tau] Bool
for an unfilled metavariable β. In this case (with an AppTy on the right),
we used to fall back to unification. No longer: now, given that the LHS
is a FunTy and that the RHS is a deep rho type (does not need any instantiation),
we try to make the RHS into a FunTy, viz.
β := (->) γ
We can then continue using covariance & contravariance of the function
arrow, which allows us to prove the subtyping relationship, instead of
trying to unify which would cause us to error out with:
Couldn't match expected type ‘β’ with actual type ‘(->) ((∀ a. a -> a) -> Int)
See Note [FunTy vs non-FunTy case in tc_sub_type_deep] in GHC.Tc.Utils.Unify.
The other main improvement in this patch concerns type inference.
The main subsumption logic happens (before & after this patch) in
GHC.Tc.Gen.App.checkResultTy. However, before this patch, all of the
DeepSubsumption logic only kicked in in 'check' mode, not in 'infer' mode.
This patch adds deep instantiation in the 'infer' mode of checkResultTy
when we are doing deep subsumption, which allows us to accept programs
such as:
f :: Int -> (forall a. a->a)
g :: Int -> Bool -> Bool
test1 b =
case b of
True -> f
False -> g
test2 b =
case b of
True -> g
False -> f
See Note [Deeply instantiate in checkResultTy when inferring].
Finally, we add representation-polymorphism checks to ensure that the
lambda abstractions we introduce when doing subsumption obey the
representation polymorphism invariants of Note [Representation polymorphism invariants]
in GHC.Core. See Note [FunTy vs FunTy case in tc_sub_type_deep].
This is accompanied by a courtesy change to `(<.>) :: HsWrapper -> HsWrapper -> HsWrapper`,
adding the equation:
WpCast c1 <.> WpCast c2 = WpCast (c1 `mkTransCo` c2)
This is useful because mkWpFun does not introduce an eta-expansion when
both of the argument & result wrappers are casts; so this change allows
us to avoid introducing lambda abstractions when casts suffice.
Fixes #26225
- - - - -
26 changed files:
- compiler/GHC/Builtin/PrimOps/Ids.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Concrete.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Types/Id/Make.hs
- testsuite/tests/corelint/LintEtaExpand.stderr
- testsuite/tests/indexed-types/should_fail/T5439.stderr
- testsuite/tests/partial-sigs/should_compile/T10403.stderr
- testsuite/tests/partial-sigs/should_fail/T10615.stderr
- + testsuite/tests/rep-poly/NoEtaRequired.hs
- testsuite/tests/rep-poly/T21906.stderr
- testsuite/tests/rep-poly/all.T
- + testsuite/tests/typecheck/should_compile/T26225.hs
- + testsuite/tests/typecheck/should_compile/T26225b.hs
- testsuite/tests/typecheck/should_compile/all.T
- − testsuite/tests/typecheck/should_fail/T12563.stderr
- testsuite/tests/typecheck/should_fail/T14618.stderr
- testsuite/tests/typecheck/should_fail/T6022.stderr
- testsuite/tests/typecheck/should_fail/T8883.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_fail/tcfail140.stderr
Changes:
=====================================
compiler/GHC/Builtin/PrimOps/Ids.hs
=====================================
@@ -99,7 +99,7 @@ computePrimOpConcTyVarsFromType nm tyvars arg_tys _res_ty = mkNameEnv concs
| tv `elem` [ runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar
, levity1TyVar, levity2TyVar ]
= listToMaybe $
- mapMaybe (\ (i,arg) -> Argument i <$> positiveKindPos_maybe tv arg)
+ mapMaybe (\ (i,arg) -> mkArgPos i <$> positiveKindPos_maybe tv arg)
(zip [1..] arg_tys)
| otherwise
= Nothing
@@ -124,7 +124,7 @@ negativeKindPos_maybe tv ty
)
where
recur (pos, scaled_ty)
- = Argument pos <$> positiveKindPos_maybe tv (scaledThing scaled_ty)
+ = mkArgPos pos <$> positiveKindPos_maybe tv (scaledThing scaled_ty)
-- (assumes we don't have any function types nested inside other types)
-- | Does this type variable appear in a kind in a positive position in the
@@ -145,7 +145,7 @@ positiveKindPos_maybe tv ty
)
where
recur (pos, scaled_ty)
- = Argument pos <$> negativeKindPos_maybe tv (scaledThing scaled_ty)
+ = mkArgPos pos <$> negativeKindPos_maybe tv (scaledThing scaled_ty)
-- (assumes we don't have any function types nested inside other types)
finish ty
| tv `elemVarSet` tyCoVarsOfType (typeKind ty)
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -39,7 +39,7 @@ import GHC.HsToCore.Coverage
import GHC.HsToCore.Docs
import GHC.Tc.Types
-import GHC.Tc.Types.Origin ( Position(..) )
+import GHC.Tc.Types.Origin ( Position(..), mkArgPos )
import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances )
import GHC.Tc.Module ( runTcInteractive )
@@ -780,7 +780,7 @@ mkUnsafeCoercePrimPair _old_id old_expr
arity = 1
concs = mkRepPolyIdConcreteTyVars
- [((mkTyVarTy openAlphaTyVar, Argument 1 Top), runtimeRep1TyVar)]
+ [((mkTyVarTy openAlphaTyVar, mkArgPos 1 Top), runtimeRep1TyVar)]
unsafeCoercePrimName
id = mkExportedLocalId (RepPolyId concs) unsafeCoercePrimName ty `setIdInfo` info
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -430,7 +430,8 @@ tcApp rn_expr exp_res_ty
-- Step 5.2: typecheck the arguments, and monomorphise
-- any un-unified instantiation variables
; tc_args <- tcValArgs DoQL inst_args
- -- Step 5.3: typecheck the arguments
+ -- Step 5.3: zonk to expose the polymophism hidden under
+ -- QuickLook instantiation variables in `app_res_rho`
; app_res_rho <- liftZonkM $ zonkTcType app_res_rho
-- Step 5.4: subsumption check against the expected type
; res_wrap <- checkResultTy rn_expr tc_head inst_args
@@ -463,6 +464,8 @@ finishApp tc_head@(tc_fun,_) tc_args app_res_rho res_wrap
; traceTc "End tcApp }" (ppr tc_fun)
; return (mkHsWrap res_wrap res_expr) }
+-- | Connect up the inferred type of an application with the expected type.
+-- This is usually just a unification, but with deep subsumption there is more to do.
checkResultTy :: HsExpr GhcRn
-> (HsExpr GhcTc, AppCtxt) -- Head
-> [HsExprArg p] -- Arguments, just error messages
@@ -470,11 +473,29 @@ checkResultTy :: HsExpr GhcRn
-- expose foralls, but maybe not deeply instantiated
-> ExpRhoType -- Expected type; this is deeply skolemised
-> TcM HsWrapper
--- Connect up the inferred type of the application with the expected type
--- This is usually just a unification, but with deep subsumption there is more to do
-checkResultTy _ _ _ app_res_rho (Infer inf_res)
- = do { co <- fillInferResult app_res_rho inf_res
- ; return (mkWpCastN co) }
+checkResultTy rn_expr _fun _inst_args app_res_rho (Infer inf_res)
+ = fillInferResultDS (exprCtOrigin rn_expr) app_res_rho inf_res
+ -- See Note [Deeply instantiate in checkResultTy when inferring]
+
+{- Note [Deeply instantiate in checkResultTy when inferring]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To accept the following program (T26225b) with -XDeepSubsumption, we need to
+deeply instantiate when inferring in checkResultTy:
+
+ f :: Int -> (forall a. a->a)
+ g :: Int -> Bool -> Bool
+
+ test b =
+ case b of
+ True -> f
+ False -> g
+
+If we don't deeply instantiate in the branches of the case expression, we will
+try to unify the type of 'f' with that of 'g', which fails. If we instead
+deeply instantiate 'f', we will fill the 'InferResult' with 'Int -> alpha -> alpha'
+which then successfully unifies with the type of 'g' when we come to fill the
+'InferResult' hole a second time for the second case branch.
+-}
checkResultTy rn_expr (tc_fun, fun_ctxt) inst_args app_res_rho (Check res_ty)
-- Unify with expected type from the context
@@ -502,8 +523,6 @@ checkResultTy rn_expr (tc_fun, fun_ctxt) inst_args app_res_rho (Check res_ty)
-- Even though both app_res_rho and res_ty are rho-types,
-- they may have nested polymorphism, so if deep subsumption
-- is on we must call tcSubType.
- -- Zonk app_res_rho first, because QL may have instantiated some
- -- delta variables to polytypes, and tcSubType doesn't expect that
do { wrap <- tcSubTypeDS rn_expr app_res_rho res_ty
; traceTc "checkResultTy 2 }" (ppr app_res_rho $$ ppr res_ty)
; return wrap } }
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -1056,7 +1056,8 @@ tcSynArgA orig op sigma_ty arg_shapes res_shape thing_inside
tc_syn_arg _ (SynFun {}) _
= pprPanic "tcSynArgA hits a SynFun" (ppr orig)
tc_syn_arg res_ty (SynType the_ty) thing_inside
- = do { wrap <- tcSubType orig GenSigCtxt res_ty the_ty
+ = do { wrap <- addSubTypeCtxt res_ty the_ty $
+ tcSubType orig GenSigCtxt Nothing res_ty the_ty
; result <- thing_inside []
; return (result, wrap) }
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -946,7 +946,7 @@ Terms are eagerly instantiated. This means that if you say
then `id` gets instantiated to have type alpha -> alpha. The variable
alpha is then unconstrained and regeneralized. So we may well end up with
- x = /\x. id @a
+ x = /\a. id @a
But we cannot do this in types, as we have no type-level lambda.
So, we must be careful only to instantiate at the last possible moment, when
@@ -954,9 +954,15 @@ we're sure we're never going to want the lost polymorphism again. This is done
in calls to `tcInstInvisibleTyBinders`; a particular case in point is in
`checkExpectedKind`.
+For example, suppose we have:
+ Actual: ∀ k2 k. k -> k2 -> k
+ Expected: ∀ k. k -> Type -> k
+We must very delicately instantiate just k2 to kappa, and then unify
+ (∀ k. k -> Type -> k) ~ (∀ k. k -> kappa -> k)
+
Otherwise, we are careful /not/ to instantiate. For example:
-* at a variable in `tcTyVar`
-* in `tcInferLHsTypeUnsaturated`, which is used by :kind in GHCi.
+ * at a variable in `tcTyVar`
+ * in `tcInferLHsTypeUnsaturated`, which is used by :kind in GHCi.
************************************************************************
* *
@@ -1977,6 +1983,8 @@ checkExpKind :: HsType GhcRn -> TcType -> TcKind -> ExpKind -> TcM TcType
checkExpKind rn_ty ty ki (Check ki') =
checkExpectedKind rn_ty ty ki ki'
checkExpKind _rn_ty ty ki (Infer cell) = do
+ -- NB: do not instantiate.
+ -- See Note [Do not always instantiate eagerly in types]
co <- fillInferResult ki cell
pure (ty `mkCastTy` co)
=====================================
compiler/GHC/Tc/Types/Evidence.hs
=====================================
@@ -199,28 +199,44 @@ instance Monoid HsWrapper where
mempty = WpHole
(<.>) :: HsWrapper -> HsWrapper -> HsWrapper
-WpHole <.> c = c
-c <.> WpHole = c
-c1 <.> c2 = c1 `WpCompose` c2
-
--- | Smart constructor to create a 'WpFun' 'HsWrapper'.
+WpHole <.> c = c
+c <.> WpHole = c
+WpCast c1 <.> WpCast c2 = WpCast (c1 `mkTransCo` c2)
+ -- If we can represent the HsWrapper as a cast, try to do so: this may avoid
+ -- unnecessary eta-expansion (see 'mkWpFun').
+c1 <.> c2 = c1 `WpCompose` c2
+
+-- | Smart constructor to create a 'WpFun' 'HsWrapper', which avoids introducing
+-- a lambda abstraction if the two supplied wrappers are either identities or
+-- casts.
+--
+-- PRECONDITION: either:
--
--- PRECONDITION: the "from" type of the first wrapper must have a syntactically
--- fixed RuntimeRep (see Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete).
+-- 1. both of the 'HsWrapper's are identities or casts, or
+-- 2. both the "from" and "to" types of the first wrapper have a syntactically
+-- fixed RuntimeRep (see Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete).
mkWpFun :: HsWrapper -> HsWrapper
-> Scaled TcTypeFRR -- ^ the "from" type of the first wrapper
- -- MUST have a fixed RuntimeRep
-> TcType -- ^ Either "from" type or "to" type of the second wrapper
-- (used only when the second wrapper is the identity)
-> HsWrapper
- -- NB: we can't check that the argument type has a fixed RuntimeRep with an assertion,
- -- because of [Wrinkle: Typed Template Haskell] in Note [hasFixedRuntimeRep]
- -- in GHC.Tc.Utils.Concrete.
mkWpFun WpHole WpHole _ _ = WpHole
mkWpFun WpHole (WpCast co2) (Scaled w t1) _ = WpCast (mk_wp_fun_co w (mkRepReflCo t1) co2)
mkWpFun (WpCast co1) WpHole (Scaled w _) t2 = WpCast (mk_wp_fun_co w (mkSymCo co1) (mkRepReflCo t2))
mkWpFun (WpCast co1) (WpCast co2) (Scaled w _) _ = WpCast (mk_wp_fun_co w (mkSymCo co1) co2)
-mkWpFun co1 co2 t1 _ = WpFun co1 co2 t1
+mkWpFun w_arg w_res t1 _ =
+ -- In this case, we will desugar to a lambda
+ --
+ -- \x. w_res[ e w_arg[x] ]
+ --
+ -- To satisfy Note [Representation polymorphism invariants] in GHC.Core,
+ -- it must be the case that both the lambda bound variable x and the function
+ -- argument w_arg[x] have a fixed runtime representation, i.e. that both the
+ -- "from" and "to" types of the first wrapper "w_arg" have a fixed runtime representation.
+ --
+ -- Unfortunately, we can't check this with an assertion here, because of
+ -- [Wrinkle: Typed Template Haskell] in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete.
+ WpFun w_arg w_res t1
mkWpEta :: [Id] -> HsWrapper -> HsWrapper
-- (mkWpEta [x1, x2] wrap) [e]
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -1,9 +1,10 @@
{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneKindSignatures #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
-- | Describes the provenance of types as they flow through the type-checker.
-- The datatypes here are mainly used for error message generation.
@@ -39,7 +40,7 @@ module GHC.Tc.Types.Origin (
mkFRRUnboxedTuple, mkFRRUnboxedSum,
-- ** FixedRuntimeRep origin for rep-poly 'Id's
- RepPolyId(..), Polarity(..), Position(..),
+ RepPolyId(..), Polarity(..), Position(..), mkArgPos,
-- ** Arrow command FixedRuntimeRep origin
FRRArrowContext(..), pprFRRArrowContext,
@@ -78,7 +79,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Stack
import GHC.Utils.Monad
-import GHC.Utils.Misc( HasDebugCallStack )
+import GHC.Utils.Misc( HasDebugCallStack, nTimes )
import GHC.Types.Unique
import GHC.Types.Unique.Supply
@@ -1188,7 +1189,7 @@ data FixedRuntimeRepContext
-- See 'FRRArrowContext' for more details.
| FRRArrow !FRRArrowContext
- -- | A representation-polymorphic check arising from a call
+ -- | A representation-polymorphism check arising from a call
-- to 'matchExpectedFunTys' or 'matchActualFunTy'.
--
-- See 'ExpectedFunTyOrigin' for more details.
@@ -1197,6 +1198,13 @@ data FixedRuntimeRepContext
!Int
-- ^ argument position (1-indexed)
+ -- | A representation-polymorphism check arising from eta-expansion
+ -- performed as part of deep subsumption.
+ | forall p. FRRDeepSubsumption
+ { frrDSExpected :: Bool
+ , frrDSPosition :: Position p
+ }
+
-- | The description of a representation-polymorphic 'Id'.
data RepPolyId
-- | A representation-polymorphic 'PrimOp'.
@@ -1234,8 +1242,8 @@ pprFixedRuntimeRepContext (FRRRecordUpdate lbl _arg)
pprFixedRuntimeRepContext (FRRBinder binder)
= sep [ text "The binder"
, quotes (ppr binder) ]
-pprFixedRuntimeRepContext (FRRRepPolyId nm id what)
- = pprFRRRepPolyId id nm what
+pprFixedRuntimeRepContext (FRRRepPolyId nm id pos)
+ = text "The" <+> ppr pos <+> text "of" <+> pprRepPolyId id nm
pprFixedRuntimeRepContext FRRPatBind
= text "The pattern binding"
pprFixedRuntimeRepContext FRRPatSynArg
@@ -1277,6 +1285,13 @@ pprFixedRuntimeRepContext (FRRArrow arrowContext)
= pprFRRArrowContext arrowContext
pprFixedRuntimeRepContext (FRRExpectedFunTy funTyOrig arg_pos)
= pprExpectedFunTyOrigin funTyOrig arg_pos
+pprFixedRuntimeRepContext (FRRDeepSubsumption is_exp pos)
+ = hsep [ text "The", what, text "type of the"
+ , ppr (Argument pos)
+ , text "of the eta-expansion"
+ ]
+ where
+ what = if is_exp then text "expected" else text "actual"
instance Outputable FixedRuntimeRepContext where
ppr = pprFixedRuntimeRepContext
@@ -1305,34 +1320,117 @@ data ArgPos
* *
********************************************************************* -}
+{- Note [Positional information in representation-polymorphism errors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider an invalid instantiation of the 'catch#' primop:
+
+ catch#
+ :: forall {q :: RuntimeRep} {k :: Levity} (a :: TYPE q)
+ (b :: TYPE (BoxedRep k)).
+ (State# RealWorld -> (# State# RealWorld, a #))
+ -> (b -> State# RealWorld -> (# State# RealWorld, a #))
+ -> State# RealWorld
+ -> (# State# RealWorld, a #)
+
+ boo :: forall r (a :: TYPE r). ...
+ boo = catch# @a
+
+The instantiation is invalid because we insist that the quantified RuntimeRep
+type variable 'q' be instantiated to a concrete RuntimeRep, as per
+Note [Representation-polymorphism checking built-ins] in GHC.Tc.Utils.Concrete.
+
+We report this as the following error message:
+
+ The result of the first argument of the primop ‘catch#’ does not have a fixed runtime representation.
+ Its type is: (a :: TYPE r).
+
+The positional information in this message, namely "The result of the first argument",
+is produced by using the 'Position' datatype. In this case:
+
+ pos :: Position Neg
+ pos = Result (Argument Top)
+ ppr pos = "result of the first argument"
+
+Other examples:
+
+ pos2 :: Position Neg
+ pos2 = Argument (Result (Result Top))
+ ppr pos2 = "3rd argument"
+
+ pos3 :: Position Pos
+ pos3 = Argument (Result (Argument (Result Top)))
+ ppr pos3 = "2nd argument of the 2nd argument"
+
+It's useful to keep track at the type-level whether we are in a positive or
+negative position in the type, as for primops we can usually tolerate
+representation-polymorphism in positive positions, but not in negative ones;
+for example
+
+ ($) :: forall {r} (a :: Type) (b :: TYPE r). (a -> b) -> a -> b
+
+
+This positional information is (currently) used to report representation-polymorphism
+errors in precisely the following two situations:
+
+ 1. Representation-polymorphic Ids with no binding, as described in
+ Note [Representation-polymorphic Ids with no binding] in GHC.Tc.Utils.Concrete.
+
+ This uses the 'FRRRepPolyId' constructor of 'FixedRuntimeRepContext'.
+
+ 2. When inserting eta-expansions for deep subsumption.
+ See Wrinkle [Representation-polymorphism checking during subtyping] in
+ Note [FunTy vs FunTy case in tc_sub_type_deep] in GHC.Tc.Utils.Unify.
+
+ This uses the 'FRRDeepSubsumption' constructor of 'FixedRuntimeRepContext'.
+-}
+
+-- | Are we in a positive (covariant) or negative (contravariant) position?
+--
+-- See Note [Positional information in representation-polymorphism errors].
data Polarity = Pos | Neg
+-- | Flip the 'Polarity': turn positive into negative and vice-versa.
type FlipPolarity :: Polarity -> Polarity
-type family FlipPolarity p where
+type family FlipPolarity p = r | r -> p where
FlipPolarity Pos = Neg
FlipPolarity Neg = Pos
-- | A position in which a type variable appears in a type;
-- in particular, whether it appears in a positive or a negative position.
+--
+-- See Note [Positional information in representation-polymorphism errors].
type Position :: Polarity -> Hs.Type
data Position p where
- -- | In the @i@-th argument of a function arrow
- Argument :: Int -> Position (FlipPolarity p) -> Position p
+ -- | In the argument of a function arrow
+ Argument :: Position p -> Position (FlipPolarity p)
-- | In the result of a function arrow
Result :: Position p -> Position p
-- | At the top level of a type
Top :: Position Pos
-
-pprFRRRepPolyId :: RepPolyId -> Name -> Position Neg -> SDoc
-pprFRRRepPolyId id nm (Argument i pos) =
- text "The" <+> what <+> speakNth i <+> text "argument of" <+> pprRepPolyId id nm
+deriving stock instance Show (Position p)
+instance Outputable (Position p) where
+ ppr = go 1
+ where
+ go :: Int -> Position q -> SDoc
+ go i (Argument (Result pos)) = go (i+1) (Argument pos)
+ go i (Argument pos) = speakNth i <+> text "argument" <+> aux 1 pos
+ go i (Result (Result pos)) = go i (Result pos)
+ go i (Result pos) = text "result" <+> aux i pos
+ go _ Top = text "top-level"
+
+ aux :: Int -> Position q -> SDoc
+ aux i pos = case pos of { Top -> empty; _ -> text "of the" <+> go i pos }
+
+-- | @'mkArgPos' i p@ makes the 'Position' @p@ relative to the @ith@ argument.
+--
+-- Example: @ppr (mkArgPos 3 (Result Top)) == "in the result of the 3rd argument"@.
+mkArgPos :: Int -> Position p -> Position (FlipPolarity p)
+mkArgPos i = go
where
- what = case pos of
- Top -> empty
- Result {} -> text "return type of the"
- _ -> text "nested return type inside the"
-pprFRRRepPolyId id nm (Result {}) =
- text "The result of" <+> pprRepPolyId id nm
+ go :: Position p -> Position (FlipPolarity p)
+ go Top = Argument $ nTimes (i-1) Result Top
+ go (Result p) = Result $ go p
+ go (Argument p) = Argument $ go p
pprRepPolyId :: RepPolyId -> Name -> SDoc
pprRepPolyId id nm = id_desc <+> quotes (ppr nm)
=====================================
compiler/GHC/Tc/Utils/Concrete.hs
=====================================
@@ -803,7 +803,7 @@ idConcreteTvs id
= mkNameEnv
[(tyVarName a_rep, ConcreteFRR $ FixedRuntimeRepOrigin (mkTyVarTy a)
$ FRRRepPolyId unsafeCoercePrimName RepPolyFunction
- $ Argument 1 Top)]
+ $ mkArgPos 1 Top)]
| otherwise
= idDetailsConcreteTvs $ idDetails id
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
@@ -18,6 +19,7 @@ module GHC.Tc.Utils.Unify (
-- Full-blown subsumption
tcWrapResult, tcWrapResultO, tcWrapResultMono,
tcSubType, tcSubTypeSigma, tcSubTypePat, tcSubTypeDS,
+ addSubTypeCtxt,
tcSubTypeAmbiguity, tcSubMult,
checkConstraints, checkTvConstraints,
buildImplicationFor, buildTvImplication, emitResidualTvConstraint,
@@ -25,9 +27,10 @@ module GHC.Tc.Utils.Unify (
-- Skolemisation
DeepSubsumptionFlag(..), getDeepSubsumptionFlag, isRhoTyDS,
tcSkolemise, tcSkolemiseCompleteSig, tcSkolemiseExpectedType,
+ deeplyInstantiate,
-- Various unifications
- unifyType, unifyKind, unifyInvisibleType, unifyExpectedType,
+ unifyType, unifyKind, unifyInvisibleType,
unifyExprType, unifyTypeAndEmit, promoteTcType,
swapOverTyVars, touchabilityTest, checkTopShape, lhsPriority,
UnifyEnv(..), updUEnvLoc, setUEnvRole,
@@ -57,7 +60,7 @@ module GHC.Tc.Utils.Unify (
simpleUnifyCheck, UnifyCheckCaller(..), SimpleUnifyResult(..),
- fillInferResult,
+ fillInferResult, fillInferResultDS
) where
import GHC.Prelude
@@ -796,12 +799,14 @@ matchExpectedFunTys :: forall a.
-- Postcondition:
-- If exp_ty is Check {}, then [ExpPatType] and ExpRhoType results are all Check{}
-- If exp_ty is Infer {}, then [ExpPatType] and ExpRhoType results are all Infer{}
-matchExpectedFunTys herald _ arity (Infer inf_res) thing_inside
+matchExpectedFunTys herald _ctxt arity (Infer inf_res) thing_inside
= do { arg_tys <- mapM (new_infer_arg_ty herald) [1 .. arity]
; res_ty <- newInferExpType
; result <- thing_inside (map ExpFunPatTy arg_tys) res_ty
; arg_tys <- mapM (\(Scaled m t) -> Scaled m <$> readExpType t) arg_tys
; res_ty <- readExpType res_ty
+ -- NB: mkScaledFunTys arg_tys res_ty does not contain any foralls
+ -- (even nested ones), so no need to instantiate.
; co <- fillInferResult (mkScaledFunTys arg_tys res_ty) inf_res
; return (mkWpCastN co, result) }
@@ -1223,7 +1228,21 @@ unification variable. We discard the evidence.
-}
-
+-- | A version of 'fillInferResult' that also performs deep instantiation
+-- when deep subsumption is enabled.
+--
+-- See also Note [Instantiation of InferResult].
+fillInferResultDS :: CtOrigin -> TcRhoType -> InferResult -> TcM HsWrapper
+fillInferResultDS ct_orig rho inf_res
+ = do { massertPpr (isRhoTy rho) $
+ vcat [ text "fillInferResultDS: input type is not a rho-type"
+ , text "ty:" <+> ppr rho ]
+ ; ds_flag <- getDeepSubsumptionFlag
+ ; case ds_flag of
+ Shallow -> mkWpCastN <$> fillInferResult rho inf_res
+ Deep -> do { (inst_wrap, rho') <- deeplyInstantiate ct_orig rho
+ ; co <- fillInferResult rho' inf_res
+ ; return (mkWpCastN co <.> inst_wrap) } }
{-
************************************************************************
@@ -1290,27 +1309,34 @@ tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpR
tcWrapResultO orig rn_expr expr actual_ty res_ty
= do { traceTc "tcWrapResult" (vcat [ text "Actual: " <+> ppr actual_ty
, text "Expected:" <+> ppr res_ty ])
- ; wrap <- tcSubTypeNC orig GenSigCtxt (Just $ HsExprRnThing rn_expr) actual_ty res_ty
+ ; wrap <- tcSubType orig GenSigCtxt (Just $ HsExprRnThing rn_expr) actual_ty res_ty
; return (mkHsWrap wrap expr) }
-tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTc
- -> TcRhoType -- Actual -- a rho-type not a sigma-type
- -> ExpRhoType -- Expected
- -> TcM (HsExpr GhcTc)
--- A version of tcWrapResult to use when the actual type is a
+-- | A version of 'tcWrapResult' to use when the actual type is a
-- rho-type, so nothing to instantiate; just go straight to unify.
--- It means we don't need to pass in a CtOrigin
+-- It means we don't need to pass in a CtOrigin.
+tcWrapResultMono :: HasDebugCallStack
+ => HsExpr GhcRn -> HsExpr GhcTc
+ -> TcRhoType -- ^ Actual; a rho-type, not a sigma-type
+ -> ExpRhoType -- ^ Expected
+ -> TcM (HsExpr GhcTc)
tcWrapResultMono rn_expr expr act_ty res_ty
- = assertPpr (isRhoTy act_ty) (ppr act_ty $$ ppr rn_expr) $
- do { co <- unifyExpectedType rn_expr act_ty res_ty
+ = do { co <- tcSubTypeMono rn_expr act_ty res_ty
; return (mkHsWrapCo co expr) }
-unifyExpectedType :: HsExpr GhcRn
- -> TcRhoType -- Actual -- a rho-type not a sigma-type
- -> ExpRhoType -- Expected
- -> TcM TcCoercionN
-unifyExpectedType rn_expr act_ty exp_ty
- = case exp_ty of
+-- | A version of 'tcSubType' to use when the actual type is a rho-type,
+-- so that no instantiation is needed.
+tcSubTypeMono :: HasDebugCallStack
+ => HsExpr GhcRn
+ -> TcRhoType -- ^ Actual; a rho-type, not a sigma-type
+ -> ExpRhoType -- ^ Expected
+ -> TcM TcCoercionN
+tcSubTypeMono rn_expr act_ty exp_ty
+ = assertPpr (isDeepRhoTy act_ty)
+ (vcat [ text "Actual type is not a (deep) rho-type."
+ , text "act_ty:" <+> ppr act_ty
+ , text "rn_expr:" <+> ppr rn_expr]) $
+ case exp_ty of
Infer inf_res -> fillInferResult act_ty inf_res
Check exp_ty -> unifyType (Just $ HsExprRnThing rn_expr) act_ty exp_ty
@@ -1331,46 +1357,39 @@ tcSubTypePat _ _ (Infer inf_res) ty_expected
; return (mkWpCastN (mkSymCo co)) }
---------------
-tcSubType :: CtOrigin -> UserTypeCtxt
- -> TcSigmaType -- ^ Actual
- -> ExpRhoType -- ^ Expected
- -> TcM HsWrapper
--- Checks that 'actual' is more polymorphic than 'expected'
-tcSubType orig ctxt ty_actual ty_expected
- = addSubTypeCtxt ty_actual ty_expected $
- do { traceTc "tcSubType" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected])
- ; tcSubTypeNC orig ctxt Nothing ty_actual ty_expected }
----------------
+-- | A subtype check that performs deep subsumption.
+-- See also 'tcSubTypeMono', for when no instantiation is required.
tcSubTypeDS :: HsExpr GhcRn
-> TcRhoType -- Actual type -- a rho-type not a sigma-type
-> TcRhoType -- Expected type
-- DeepSubsumption <=> when checking, this type
-- is deeply skolemised
-> TcM HsWrapper
--- Similar signature to unifyExpectedType; does deep subsumption
-- Only one call site, in GHC.Tc.Gen.App.tcApp
tcSubTypeDS rn_expr act_rho exp_rho
- = tc_sub_type_deep (unifyExprType rn_expr) orig GenSigCtxt act_rho exp_rho
+ = tc_sub_type_deep Top (unifyExprType rn_expr) orig GenSigCtxt act_rho exp_rho
where
orig = exprCtOrigin rn_expr
---------------
-tcSubTypeNC :: CtOrigin -- ^ Used when instantiating
- -> UserTypeCtxt -- ^ Used when skolemising
- -> Maybe TypedThing -- ^ The expression that has type 'actual' (if known)
- -> TcSigmaType -- ^ Actual type
- -> ExpRhoType -- ^ Expected type
- -> TcM HsWrapper
-tcSubTypeNC inst_orig ctxt m_thing ty_actual res_ty
+
+-- | Checks that the 'actual' type is more polymorphic than the 'expected' type.
+tcSubType :: CtOrigin -- ^ Used when instantiating
+ -> UserTypeCtxt -- ^ Used when skolemising
+ -> Maybe TypedThing -- ^ The expression that has type 'actual' (if known)
+ -> TcSigmaType -- ^ Actual type
+ -> ExpRhoType -- ^ Expected type
+ -> TcM HsWrapper
+tcSubType inst_orig ctxt m_thing ty_actual res_ty
= case res_ty of
Check ty_expected -> tc_sub_type (unifyType m_thing) inst_orig ctxt
ty_actual ty_expected
Infer inf_res -> do { (wrap, rho) <- topInstantiate inst_orig ty_actual
-- See Note [Instantiation of InferResult]
- ; co <- fillInferResult rho inf_res
- ; return (mkWpCastN co <.> wrap) }
+ ; inst <- fillInferResultDS inst_orig rho inf_res
+ ; return (inst <.> wrap) }
---------------
tcSubTypeSigma :: CtOrigin -- where did the actual type arise / why are we
@@ -1388,9 +1407,9 @@ tcSubTypeAmbiguity :: UserTypeCtxt -- Where did this type arise
-> TcSigmaType -> TcSigmaType -> TcM HsWrapper
-- See Note [Ambiguity check and deep subsumption]
tcSubTypeAmbiguity ctxt ty_actual ty_expected
- = tc_sub_type_ds Shallow (unifyType Nothing)
- (AmbiguityCheckOrigin ctxt)
- ctxt ty_actual ty_expected
+ = tc_sub_type_ds Top Shallow (unifyType Nothing)
+ (AmbiguityCheckOrigin ctxt)
+ ctxt ty_actual ty_expected
---------------
addSubTypeCtxt :: TcType -> ExpType -> TcM a -> TcM a
@@ -1411,8 +1430,9 @@ addSubTypeCtxt ty_actual ty_expected thing_inside
{- Note [Instantiation of InferResult]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We now always instantiate before filling in InferResult, so that
-the result is a TcRhoType: see #17173 for discussion.
+When typechecking expressions (not types, not patterns), we always instantiate
+before filling in InferResult, so that the result is a TcRhoType.
+See #17173 for discussion.
For example:
@@ -1444,6 +1464,9 @@ For example:
There is one place where we don't want to instantiate eagerly,
namely in GHC.Tc.Module.tcRnExpr, which implements GHCi's :type
command. See Note [Implementing :type] in GHC.Tc.Module.
+
+This also means that, if DeepSubsumption is enabled, we should also instantiate
+deeply; we do this by using fillInferResultDS.
-}
---------------
@@ -1464,16 +1487,17 @@ tc_sub_type :: (TcType -> TcType -> TcM TcCoercionN) -- How to unify
----------------------
tc_sub_type unify inst_orig ctxt ty_actual ty_expected
= do { ds_flag <- getDeepSubsumptionFlag
- ; tc_sub_type_ds ds_flag unify inst_orig ctxt ty_actual ty_expected }
+ ; tc_sub_type_ds Top ds_flag unify inst_orig ctxt ty_actual ty_expected }
----------------------
-tc_sub_type_ds :: DeepSubsumptionFlag
+tc_sub_type_ds :: Position p -- ^ position in the type (for error messages only)
+ -> DeepSubsumptionFlag
-> (TcType -> TcType -> TcM TcCoercionN)
-> CtOrigin -> UserTypeCtxt -> TcSigmaType
-> TcSigmaType -> TcM HsWrapper
-- tc_sub_type_ds is the main subsumption worker function
-- It takes an explicit DeepSubsumptionFlag
-tc_sub_type_ds ds_flag unify inst_orig ctxt ty_actual ty_expected
+tc_sub_type_ds pos ds_flag unify inst_orig ctxt ty_actual ty_expected
| definitely_poly ty_expected -- See Note [Don't skolemise unnecessarily]
, isRhoTyDS ds_flag ty_actual
= do { traceTc "tc_sub_type (drop to equality)" $
@@ -1490,7 +1514,7 @@ tc_sub_type_ds ds_flag unify inst_orig ctxt ty_actual ty_expected
; (sk_wrap, inner_wrap)
<- tcSkolemise ds_flag ctxt ty_expected $ \sk_rho ->
case ds_flag of
- Deep -> tc_sub_type_deep unify inst_orig ctxt ty_actual sk_rho
+ Deep -> tc_sub_type_deep pos unify inst_orig ctxt ty_actual sk_rho
Shallow -> tc_sub_type_shallow unify inst_orig ty_actual sk_rho
; return (sk_wrap <.> inner_wrap) }
@@ -1656,7 +1680,7 @@ The effects are in these main places:
see the call to tcDeeplySkolemise in tcSkolemiseScoped.
4. In GHC.Tc.Gen.App.tcApp we call tcSubTypeDS to match the result
- type. Without deep subsumption, unifyExpectedType would be sufficent.
+ type. Without deep subsumption, tcSubTypeMono would be sufficent.
In all these cases note that the deep skolemisation must be done /first/.
Consider (1)
@@ -1669,8 +1693,10 @@ Wrinkles:
(DS1) Note that we /always/ use shallow subsumption in the ambiguity check.
See Note [Ambiguity check and deep subsumption].
-(DS2) Deep subsumption requires deep instantiation too.
- See Note [The need for deep instantiation]
+(DS2) When doing deep subsumption, we must be careful not to needlessly
+ drop down to unification, e.g. in cases such as:
+ (Bool -> ∀ d. d->d) <= alpha beta gamma
+ See Note [FunTy vs non-FunTy case in tc_sub_type_deep].
(DS3) The interaction between deep subsumption and required foralls
(forall a -> ty) is a bit subtle. See #24696 and
@@ -1701,6 +1727,69 @@ ToDo: this eta-abstraction plays fast and loose with termination,
because it can introduce extra lambdas. Maybe add a `seq` to
fix this
+Note [FunTy vs FunTy case in tc_sub_type_deep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The goal of tc_sub_type_deep is to produce an HsWrapper that "proves" that the
+actual type is a subtype of the expected type. The most important case is how
+we deal with function arrows. Suppose we have:
+
+ ty_actual = act_arg -> act_res
+ ty_expected = exp_arg -> exp_res
+
+To produce fun_wrap :: (act_arg -> act_res) ~> (exp_arg -> exp_res), we use
+the fact that the function arrow is contravariant in its argument type and
+covariant in its result type. Thus we recursively perform subtype checks
+on the argument types (with actual/expected switched) and the result types,
+to get:
+
+ arg_wrap :: exp_arg ~> act_arg -- NB: expected/actual have switched sides
+ res_wrap :: act_res ~> exp_res
+
+Then fun_wrap = mkWpFun arg_wrap res_wrap.
+
+Wrinkle [Representation-polymorphism checking during subtyping]
+
+ Inserting a WpFun HsWrapper amounts to impedance matching in deep subsumption
+ via eta-expansion:
+
+ f ==> \ (x :: exp_arg) -> res_wrap [ f (arg_wrap [x]) ]
+
+ As we produce a lambda, we must enforce the representation polymorphism
+ invariants described in Note [Representation polymorphism invariants] in GHC.Core.
+ That is, we must ensure that both x (the lambda binder) and (arg_wrap [x]) (the function argument)
+ have a fixed runtime representation.
+
+ Note however that desugaring mkWpFun does not always introduce a lambda: if
+ both the argument and result HsWrappers are casts, then a FunCo cast suffices,
+ in which case we should not perform representation-polymorphism checking.
+
+ This means that, in the FunTy/FunTy case of tc_sub_type_deep, we can skip
+ the representation-polymorphism checks if the produced argument and result
+ wrappers are identities or casts.
+ It is important to do so, otherwise we reject valid programs.
+
+ Here's a contrived example (there are undoubtedly more natural examples)
+ (see testsuite/tests/rep-poly/NoEtaRequired):
+
+ type Id :: k -> k
+ type family Id a where
+
+ type T :: TYPE r -> TYPE (Id r)
+ type family T a where
+
+ test :: forall r (a :: TYPE r). a :~~: T a -> ()
+ test HRefl =
+ let
+ f :: (a -> a) -> ()
+ f _ = ()
+ g :: T a -> T a
+ g = undefined
+ in f g
+
+ We don't need to eta-expand `g` to make `f g` typecheck; a cast suffices.
+ Hence we should not perform representation-polymorphism checks; they would
+ fail here.
+
Note [Setting the argument context]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider we are doing the ambiguity check for the (bogus)
@@ -1751,30 +1840,31 @@ complains.
The easiest solution was to use tcEqMult in tc_sub_type_deep, and
insist on equality. This is only in the DeepSubsumption code anyway.
-Note [The need for deep instantiation]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [FunTy vs non-FunTy case in tc_sub_type_deep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this, without Quick Look, but with Deep Subsumption:
f :: ∀a b c. a b c -> Int
g :: Bool -> ∀d. d -> d
-Consider the application (f g). We need to do the subsumption test
-
- (Bool -> ∀ d. d->d) <= (alpha beta gamma)
+To typecheck the application (f g), we need to do the subsumption test
-where alpha, beta, gamma are the unification variables that instantiate a,b,c,
-respectively. We must not drop down to unification, or we will reject the call.
-Rather we must deeply instantiate the LHS to get
+ (Bool -> ∀ d. d->d) <= alpha beta gamma
- (Bool -> delta -> delta) <= (alpha beta gamma)
+where alpha, beta, gamma are the unification variables that instantiate a,b,c
+(respectively). We must not drop down to unification, or we will reject the call.
+Instead, we should only unify alpha := (->), in which case we end up with the
+usual FunTy vs FunTy case of Note [FunTy vs FunTy case in tc_sub_type_deep]:
-and now we can unify to get
+ (Bool -> ∀ d. d->d) <= beta -> gamma
- alpha = (->)
- beta = Bool
- gamma = delta -> delta
+which is straightforwardly solved by beta := Bool, using covariance in the return
+type of the function arrow, and instantiating the forall before unifying with gamma.
-Hence the call to `deeplyInstantiate` in `tc_sub_type_deep`.
+The conclusion is this: when doing a deep subtype check (in tc_sub_type_deep),
+if the LHS is a FunTy and the RHS is a rho-type which is not a FunTy,
+then unify the RHS with a FunTy and continue by performing a sub-type check on
+the LHS vs the new RHS. And vice-versa (if it's the RHS that is a FunTy).
-See typecheck/should_compile/T11305 for an example of when this is important.
+See T11305 and T26225 for examples of when this is important.
Note [Deep subsumption and required foralls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1837,12 +1927,17 @@ getDeepSubsumptionFlag :: TcM DeepSubsumptionFlag
getDeepSubsumptionFlag = do { ds <- xoptM LangExt.DeepSubsumption
; if ds then return Deep else return Shallow }
+-- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption.
+--
+-- Given @ty_actual@ (a sigma-type) and @ty_expected@ (deeply skolemised, i.e.
+-- a deep rho type), it returns an 'HsWrapper' @wrap :: ty_actual ~> ty_expected@.
tc_sub_type_deep :: HasDebugCallStack
- => (TcType -> TcType -> TcM TcCoercionN) -- How to unify
- -> CtOrigin -- Used when instantiating
- -> UserTypeCtxt -- Used when skolemising
- -> TcSigmaType -- Actual; a sigma-type
- -> TcRhoType -- Expected; deeply skolemised
+ => Position p -- ^ Position in the type (for error messages only)
+ -> (TcType -> TcType -> TcM TcCoercionN) -- ^ How to unify
+ -> CtOrigin -- ^ Used when instantiating
+ -> UserTypeCtxt -- ^ Used when skolemising
+ -> TcSigmaType -- ^ Actual; a sigma-type
+ -> TcRhoType -- ^ Expected; deeply skolemised
-> TcM HsWrapper
-- If wrap = tc_sub_type_deep t1 t2
@@ -1850,63 +1945,161 @@ tc_sub_type_deep :: HasDebugCallStack
-- Here is where the work actually happens!
-- Precondition: ty_expected is deeply skolemised
-tc_sub_type_deep unify inst_orig ctxt ty_actual ty_expected
+tc_sub_type_deep pos unify inst_orig ctxt ty_actual ty_expected
= assertPpr (isDeepRhoTy ty_expected) (ppr ty_expected) $
do { traceTc "tc_sub_type_deep" $
vcat [ text "ty_actual =" <+> ppr ty_actual
, text "ty_expected =" <+> ppr ty_expected ]
; go ty_actual ty_expected }
where
- -- NB: 'go' is not recursive, except for doing coreView
- go ty_a ty_e | Just ty_a' <- coreView ty_a = go ty_a' ty_e
- | Just ty_e' <- coreView ty_e = go ty_a ty_e'
- go (TyVarTy tv_a) ty_e
- = do { lookup_res <- isFilledMetaTyVar_maybe tv_a
+ -- 'unwrap' removes top-level type synonyms & looks through filled meta-tyvars
+ unwrap :: TcType -> TcM TcType
+ unwrap ty
+ | Just ty' <- coreView ty
+ = unwrap ty'
+ unwrap ty@(TyVarTy tv)
+ = do { lookup_res <- isFilledMetaTyVar_maybe tv
; case lookup_res of
- Just ty_a' ->
- do { traceTc "tc_sub_type_deep following filled meta-tyvar:"
- (ppr tv_a <+> text "-->" <+> ppr ty_a')
- ; tc_sub_type_deep unify inst_orig ctxt ty_a' ty_e }
- Nothing -> just_unify ty_actual ty_expected }
-
- go ty_a@(FunTy { ft_af = af1, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res })
- ty_e@(FunTy { ft_af = af2, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res })
- | isVisibleFunArg af1, isVisibleFunArg af2
- = if (isTauTy ty_a && isTauTy ty_e) -- Short cut common case to avoid
- then just_unify ty_actual ty_expected -- unnecessary eta expansion
- else
- -- This is where we do the co/contra thing, and generate a WpFun, which in turn
- -- causes eta-expansion, which we don't like; hence encouraging NoDeepSubsumption
- do { arg_wrap <- tc_sub_type_ds Deep unify given_orig GenSigCtxt exp_arg act_arg
- -- GenSigCtxt: See Note [Setting the argument context]
- ; res_wrap <- tc_sub_type_deep unify inst_orig ctxt act_res exp_res
- ; tcEqMult inst_orig act_mult exp_mult
- -- See Note [Multiplicity in deep subsumption]
- ; return (mkWpFun arg_wrap res_wrap (Scaled exp_mult exp_arg) exp_res) }
- -- arg_wrap :: exp_arg ~> act_arg
- -- res_wrap :: act-res ~> exp_res
- where
- given_orig = GivenOrigin (SigSkol GenSigCtxt exp_arg [])
-
- go ty_a ty_e
+ Just ty' -> unwrap ty'
+ Nothing -> return ty }
+ unwrap ty = return ty
+
+ go, go1 :: TcType -> TcType -> TcM HsWrapper
+ go ty_a ty_e =
+ do { ty_a' <- unwrap ty_a
+ ; ty_e' <- unwrap ty_e
+ ; go1 ty_a' ty_e' }
+
+ -- If ty_actual is not a rho-type, instantiate it first; otherwise
+ -- unification has no chance of succeeding.
+ go1 ty_a ty_e
| let (tvs, theta, _) = tcSplitSigmaTy ty_a
, not (null tvs && null theta)
= do { (in_wrap, in_rho) <- topInstantiate inst_orig ty_a
- ; body_wrap <- tc_sub_type_deep unify inst_orig ctxt in_rho ty_e
+ ; body_wrap <- go in_rho ty_e
; return (body_wrap <.> in_wrap) }
- | otherwise -- Revert to unification
- = do { -- It's still possible that ty_actual has nested foralls. Instantiate
- -- these, as there's no way unification will succeed with them in.
- -- See Note [The need for deep instantiation]
- (inst_wrap, rho_a) <- deeplyInstantiate inst_orig ty_actual
- ; unify_wrap <- just_unify rho_a ty_expected
- ; return (unify_wrap <.> inst_wrap) }
+ -- Main case: FunTy vs FunTy. go_fun does the work.
+ go1 (FunTy { ft_af = af1, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res })
+ (FunTy { ft_af = af2, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res })
+ | isVisibleFunArg af1
+ , isVisibleFunArg af2
+ = go_fun af1 act_mult act_arg act_res
+ af2 exp_mult exp_arg exp_res
+
+ -- See Note [FunTy vs non-FunTy case in tc_sub_type_deep]
+ go1 (FunTy { ft_af = af1, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res }) ty_e
+ | isVisibleFunArg af1
+ = do { exp_mult <- newMultiplicityVar
+ ; exp_arg <- newOpenFlexiTyVarTy -- NB: no FRR check needed; we might not need to eta-expand
+ ; exp_res <- newOpenFlexiTyVarTy
+ ; let exp_funTy = FunTy { ft_af = af1, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res }
+ ; unify_wrap <- just_unify exp_funTy ty_e
+ ; fun_wrap <- go_fun af1 act_mult act_arg act_res af1 exp_mult exp_arg exp_res
+ ; return $ unify_wrap <.> fun_wrap
+ -- unify_wrap :: exp_funTy ~> ty_e
+ -- fun_wrap :: ty_a ~> exp_funTy
+ }
+ go1 ty_a (FunTy { ft_af = af2, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res })
+ | isVisibleFunArg af2
+ = do { act_mult <- newMultiplicityVar
+ ; act_arg <- newOpenFlexiTyVarTy -- NB: no FRR check needed; we might not need to eta-expand
+ ; act_res <- newOpenFlexiTyVarTy
+ ; let act_funTy = FunTy { ft_af = af2, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res }
+
+ ; unify_wrap <- just_unify ty_a act_funTy
+ ; fun_wrap <- go_fun af2 act_mult act_arg act_res af2 exp_mult exp_arg exp_res
+ ; return $ fun_wrap <.> unify_wrap
+ -- unify_wrap :: ty_a ~> act_funTy
+ -- fun_wrap :: act_funTy ~> ty_e
+ }
+
+ -- Otherwise, revert to unification.
+ go1 ty_a ty_e = just_unify ty_a ty_e
just_unify ty_a ty_e = do { cow <- unify ty_a ty_e
; return (mkWpCastN cow) }
+ -- FunTy/FunTy case: this is where we insert any necessary eta-expansions.
+ go_fun :: FunTyFlag -> Mult -> TcType -> TcType -- actual FunTy
+ -> FunTyFlag -> Mult -> TcType -> TcType -- expected FunTy
+ -> TcM HsWrapper
+ go_fun act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res
+ -- See Note [FunTy vs FunTy case in tc_sub_type_deep]
+ = do { arg_wrap <- tc_sub_type_ds (Argument pos) Deep unify given_orig GenSigCtxt exp_arg act_arg
+ -- GenSigCtxt: See Note [Setting the argument context]
+ ; res_wrap <- tc_sub_type_deep (Result pos) unify inst_orig ctxt act_res exp_res
+
+ -- See Note [Multiplicity in deep subsumption]
+ ; tcEqMult inst_orig act_mult exp_mult
+
+ ; mkWpFun_FRR pos
+ act_af act_mult act_arg act_res
+ exp_af exp_mult exp_arg exp_res
+ arg_wrap res_wrap
+ }
+ where
+ given_orig = GivenOrigin (SigSkol GenSigCtxt exp_arg [])
+
+-- | Like 'mkWpFun', except that it performs representation-polymorphism
+-- checks on the argument type.
+mkWpFun_FRR
+ :: Position p
+ -> FunTyFlag -> Type -> TcType -> Type -- actual FunTy
+ -> FunTyFlag -> Type -> TcType -> Type -- expected FunTy
+ -> HsWrapper -- ^ exp_arg ~> act_arg
+ -> HsWrapper -- ^ act_res ~> exp_res
+ -> TcM HsWrapper -- ^ act_funTy ~> exp_funTy
+mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res arg_wrap res_wrap
+ | needs_eta
+ -- See Wrinkle [Representation-polymorphism checking during subtyping]
+ = do { (exp_arg_co, exp_arg_frr) <- hasFixedRuntimeRep (FRRDeepSubsumption True pos) exp_arg
+ ; (act_arg_co, _act_arg_frr) <- hasFixedRuntimeRep (FRRDeepSubsumption False pos) act_arg
+ ; let
+ exp_arg_fun_co =
+ mkFunCo Nominal exp_af
+ (mkReflCo Nominal exp_mult)
+ (mkSymCo exp_arg_co)
+ (mkReflCo Nominal exp_res)
+ act_arg_fun_co =
+ mkFunCo Nominal act_af
+ (mkReflCo Nominal act_mult)
+ act_arg_co
+ (mkReflCo Nominal act_res)
+ arg_wrap_frr =
+ mkWpCastN (mkSymCo exp_arg_co) <.> arg_wrap <.> mkWpCastN act_arg_co
+ -- exp_arg_co :: exp_arg ~> exp_arg_frr
+ -- act_arg_co :: act_arg ~> act_arg_frr
+ -- arg_wrap :: exp_arg ~> act_arg
+ -- arg_wrap_frr :: exp_arg_frr ~> act_arg_frr
+
+ -- NB: because of the needs_eta guard, we know that mkWpFun will
+ -- return (WpFun ...); so we might as well just use the WpFun constructor.
+ ; return $
+ mkWpCastN exp_arg_fun_co
+ <.>
+ WpFun arg_wrap_frr res_wrap (Scaled exp_mult exp_arg_frr)
+ <.>
+ mkWpCastN act_arg_fun_co }
+ | otherwise
+ = return $
+ mkWpFun arg_wrap res_wrap (Scaled exp_mult exp_arg) exp_res
+ -- NB: because of 'needs_eta', this will never actually be a WpFun.
+ -- mkWpFun will turn it into a WpHole or WpCast, which is why
+ -- we can skip the hasFixedRuntimeRep checks in this case.
+ -- See Wrinkle [Representation-polymorphism checking during subtyping]
+ where
+ needs_eta :: Bool
+ needs_eta =
+ not (hole_or_cast arg_wrap)
+ ||
+ not (hole_or_cast res_wrap)
+ hole_or_cast :: HsWrapper -> Bool
+ hole_or_cast WpHole = True
+ hole_or_cast (WpCast {}) = True
+ hole_or_cast _ = False
+
-----------------------
deeplySkolemise :: SkolemInfo -> TcSigmaType
-> TcM ( HsWrapper
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -1950,7 +1950,7 @@ seqId = pcRepPolyId seqName ty concs info
Case (Var x) x openBetaTy [Alt DEFAULT [] (Var y)]
concs = mkRepPolyIdConcreteTyVars
- [ ((openBetaTy, Argument 2 Top), runtimeRep2TyVar)]
+ [ ((openBetaTy, mkArgPos 2 Top), runtimeRep2TyVar)]
arity = 2
@@ -2009,7 +2009,7 @@ oneShotId = pcRepPolyId oneShotName ty concs info
arity = 2
concs = mkRepPolyIdConcreteTyVars
- [((openAlphaTy, Argument 2 Top), runtimeRep1TyVar)]
+ [((openAlphaTy, mkArgPos 2 Top), runtimeRep1TyVar)]
----------------------------------------------------------------------
{- Note [Wired-in Ids for rebindable syntax]
@@ -2054,7 +2054,7 @@ leftSectionId = pcRepPolyId leftSectionName ty concs info
arity = 2
concs = mkRepPolyIdConcreteTyVars
- [((openAlphaTy, Argument 2 Top), runtimeRep1TyVar)]
+ [((openAlphaTy, mkArgPos 2 Top), runtimeRep1TyVar)]
-- See Note [Left and right sections] in GHC.Rename.Expr
-- See Note [Wired-in Ids for rebindable syntax]
@@ -2088,8 +2088,8 @@ rightSectionId = pcRepPolyId rightSectionName ty concs info
concs =
mkRepPolyIdConcreteTyVars
- [ ((openAlphaTy, Argument 3 Top), runtimeRep1TyVar)
- , ((openBetaTy , Argument 2 Top), runtimeRep2TyVar)]
+ [ ((openAlphaTy, mkArgPos 3 Top), runtimeRep1TyVar)
+ , ((openBetaTy , mkArgPos 2 Top), runtimeRep2TyVar)]
--------------------------------------------------------------------------------
@@ -2119,7 +2119,7 @@ coerceId = pcRepPolyId coerceName ty concs info
[Alt (DataAlt coercibleDataCon) [eq] (Cast (Var x) (mkCoVarCo eq))]
concs = mkRepPolyIdConcreteTyVars
- [((mkTyVarTy av, Argument 1 Top), rv)]
+ [((mkTyVarTy av, mkArgPos 1 Top), rv)]
{-
Note [seqId magic]
=====================================
testsuite/tests/corelint/LintEtaExpand.stderr
=====================================
@@ -15,7 +15,7 @@ in coerce BAD 1
CvSubst = []>
in coerce BAD 2
<no location info>: warning:
- • The return type of the first argument of the primop ‘catch#’ does not have a fixed runtime representation:
+ • The result of the first argument of the primop ‘catch#’ does not have a fixed runtime representation:
a :: TYPE q
Substitution: <InScope = {a q}
IdSubst = []
@@ -23,7 +23,7 @@ in coerce BAD 2
CvSubst = []>
in catch# BAD 1
<no location info>: warning:
- • The return type of the first argument of the primop ‘catch#’ does not have a fixed runtime representation:
+ • The result of the first argument of the primop ‘catch#’ does not have a fixed runtime representation:
‘q’ is not concrete.
Substitution: <InScope = {a q}
IdSubst = []
=====================================
testsuite/tests/indexed-types/should_fail/T5439.stderr
=====================================
@@ -1,16 +1,12 @@
-
-T5439.hs:83:33: error: [GHC-83865]
- • Couldn't match expected type: Attempt (HElemOf rs)
- with actual type: Attempt (HHead (HDrop n0 l0))
- -> Attempt (HElemOf l0)
- • Probable cause: ‘($)’ is applied to too few arguments
- In the second argument of ‘($)’, namely
- ‘inj $ Failure (e :: SomeException)’
+T5439.hs:83:28: error: [GHC-83865]
+ • Couldn't match type: Attempt (HElemOf rs)
+ with: Attempt (HHead (HDrop n0 l0)) -> Attempt (HElemOf l0)
+ Expected: f (Attempt (HHead (HDrop n0 l0)) -> Attempt (HElemOf l0))
+ Actual: f (Attempt (WaitOpResult (WaitOps rs)))
+ • In the first argument of ‘complete’, namely ‘ev’
+ In the first argument of ‘($)’, namely ‘complete ev’
In a stmt of a 'do' block:
c <- complete ev $ inj $ Failure (e :: SomeException)
- In the expression:
- do c <- complete ev $ inj $ Failure (e :: SomeException)
- return $ c || not first
• Relevant bindings include
register :: Bool -> Peano n -> WaitOps (HDrop n rs) -> IO Bool
(bound at T5439.hs:65:9)
@@ -30,3 +26,4 @@ T5439.hs:83:39: error: [GHC-83865]
‘inj $ Failure (e :: SomeException)’
In a stmt of a 'do' block:
c <- complete ev $ inj $ Failure (e :: SomeException)
+
=====================================
testsuite/tests/partial-sigs/should_compile/T10403.stderr
=====================================
@@ -1,22 +1,21 @@
-
T10403.hs:16:7: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found extra-constraints wildcard standing for ‘Functor f’
Where: ‘f’ is a rigid type variable bound by
- the inferred type of h1 :: Functor f => (a1 -> a2) -> f a1 -> H f
+ the inferred type of h1 :: Functor f => (t -> b) -> f t -> H f
at T10403.hs:18:1-41
• In the type signature: h1 :: _ => _
T10403.hs:16:12: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘(a1 -> a2) -> f a1 -> H f’
- Where: ‘a2’, ‘a1’, ‘f’ are rigid type variables bound by
- the inferred type of h1 :: Functor f => (a1 -> a2) -> f a1 -> H f
+ • Found type wildcard ‘_’ standing for ‘(t -> b) -> f t -> H f’
+ Where: ‘b’, ‘t’, ‘f’ are rigid type variables bound by
+ the inferred type of h1 :: Functor f => (t -> b) -> f t -> H f
at T10403.hs:18:1-41
• In the type signature: h1 :: _ => _
T10403.hs:20:7: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘(a1 -> a2) -> f a1 -> H f’
- Where: ‘a2’, ‘a1’, ‘f’ are rigid type variables bound by
- the inferred type of h2 :: (a1 -> a2) -> f a1 -> H f
+ • Found type wildcard ‘_’ standing for ‘(t -> b) -> f t -> H f’
+ Where: ‘b’, ‘t’, ‘f’ are rigid type variables bound by
+ the inferred type of h2 :: (t -> b) -> f t -> H f
at T10403.hs:23:1-41
• In the type signature: h2 :: _
@@ -24,7 +23,8 @@ T10403.hs:23:15: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)]
• No instance for ‘Functor f’ arising from a use of ‘fmap’
Possible fix:
add (Functor f) to the context of
- the inferred type of h2 :: (a1 -> a2) -> f a1 -> H f
+ the inferred type of h2 :: (t -> b) -> f t -> H f
• In the second argument of ‘(.)’, namely ‘fmap (const ())’
In the expression: (H . fmap (const ())) (fmap f b)
In an equation for ‘h2’: h2 f b = (H . fmap (const ())) (fmap f b)
+
=====================================
testsuite/tests/partial-sigs/should_fail/T10615.stderr
=====================================
@@ -1,39 +1,34 @@
-
T10615.hs:5:7: error: [GHC-88464]
- • Found type wildcard ‘_’ standing for ‘w’
- Where: ‘w’ is a rigid type variable bound by
- the inferred type of f1 :: w -> f
+ • Found type wildcard ‘_’ standing for ‘t’
+ Where: ‘t’ is a rigid type variable bound by
+ the inferred type of f1 :: t -> f
at T10615.hs:6:1-10
To use the inferred type, enable PartialTypeSignatures
• In the type signature: f1 :: _ -> f
T10615.hs:6:6: error: [GHC-25897]
- • Couldn't match type ‘f’ with ‘b1 -> w’
- Expected: w -> f
- Actual: w -> b1 -> w
+ • Couldn't match expected type ‘f’ with actual type ‘b1 -> t’
‘f’ is a rigid type variable bound by
- the inferred type of f1 :: w -> f
+ the inferred type of f1 :: t -> f
at T10615.hs:5:1-12
• In the expression: const
In an equation for ‘f1’: f1 = const
- • Relevant bindings include f1 :: w -> f (bound at T10615.hs:6:1)
+ • Relevant bindings include f1 :: t -> f (bound at T10615.hs:6:1)
T10615.hs:8:7: error: [GHC-88464]
- • Found type wildcard ‘_’ standing for ‘w’
- Where: ‘w’ is a rigid type variable bound by
- the inferred type of f2 :: w -> _f
+ • Found type wildcard ‘_’ standing for ‘t’
+ Where: ‘t’ is a rigid type variable bound by
+ the inferred type of f2 :: t -> _f
at T10615.hs:9:1-10
To use the inferred type, enable PartialTypeSignatures
• In the type signature: f2 :: _ -> _f
T10615.hs:9:6: error: [GHC-25897]
- • Couldn't match type ‘_f’ with ‘b0 -> w’
- Expected: w -> _f
- Actual: w -> b0 -> w
+ • Couldn't match expected type ‘_f’ with actual type ‘b0 -> t’
‘_f’ is a rigid type variable bound by
- the inferred type of f2 :: w -> _f
+ the inferred type of f2 :: t -> _f
at T10615.hs:8:1-13
• In the expression: const
In an equation for ‘f2’: f2 = const
- • Relevant bindings include f2 :: w -> _f (bound at T10615.hs:9:1)
+ • Relevant bindings include f2 :: t -> _f (bound at T10615.hs:9:1)
=====================================
testsuite/tests/rep-poly/NoEtaRequired.hs
=====================================
@@ -0,0 +1,31 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE DataKinds, TypeFamilies, PolyKinds, StandaloneKindSignatures #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module NoEtaRequired where
+
+import Data.Proxy
+import Data.Type.Equality ( (:~~:)(..) )
+import GHC.Exts ( TYPE, RuntimeRep(..) )
+
+type Id :: k -> k
+type family Id a where
+
+type T :: TYPE r -> TYPE (Id r)
+type family T a where
+
+test :: forall r (a :: TYPE r). a :~~: T a -> ()
+test HRefl =
+ let
+ f :: (a -> a) -> ()
+ f _ = ()
+ g :: T a -> T a
+ g = undefined
+ in f g
+-- This test makes sure we DO NOT eta-expand 'g' to '\ x -> g x' when trying
+-- to make 'f g' typecheck. We CANNOT eta-expand here, as the binder 'x' would
+-- not have a fixed runtime representation.
+
=====================================
testsuite/tests/rep-poly/T21906.stderr
=====================================
@@ -1,5 +1,5 @@
T21906.hs:14:17: error: [GHC-55287]
- • The return type of the third argument of the primop ‘keepAlive#’
+ • The result of the third argument of the primop ‘keepAlive#’
does not have a fixed runtime representation.
Its type is:
b1 :: TYPE r1
@@ -12,7 +12,7 @@ T21906.hs:14:17: error: [GHC-55287]
In an equation for ‘test1’: test1 val s f = keepAlive# val s f
T21906.hs:21:25: error: [GHC-55287]
- • The return type of the first argument of the primop ‘catch#’
+ • The result of the first argument of the primop ‘catch#’
does not have a fixed runtime representation.
Its type is:
a1 :: TYPE q1
@@ -26,7 +26,7 @@ T21906.hs:21:25: error: [GHC-55287]
test2 action handle s = catch# action handle s
T21906.hs:30:17: error: [GHC-55287]
- • The nested return type inside the second argument of the primop ‘control0#’
+ • The result of the first argument of the first argument of the second argument of the primop ‘control0#’
does not have a fixed runtime representation.
Its type is:
b0 :: TYPE r0
@@ -39,7 +39,7 @@ T21906.hs:30:17: error: [GHC-55287]
In an equation for ‘test3’: test3 tag f s = control0# tag f s
T21906.hs:35:19: error: [GHC-55287]
- • The return type of the first argument of the primop ‘fork#’
+ • The result of the first argument of the primop ‘fork#’
does not have a fixed runtime representation.
Its type is:
a0 :: TYPE q0
=====================================
testsuite/tests/rep-poly/all.T
=====================================
@@ -112,6 +112,7 @@ test('RepPolyWrappedVar', normal, compile_fail, [''])
test('RepPolyWrappedVar2', [js_skip], compile, [''])
test('UnliftedNewtypesCoerceFail', normal, compile_fail, [''])
test('UnliftedNewtypesLevityBinder', normal, compile_fail, [''])
+test('NoEtaRequired', normal, compile, [''])
###############################################################################
## The following tests require rewriting in RuntimeReps, ##
=====================================
testsuite/tests/typecheck/should_compile/T26225.hs
=====================================
@@ -0,0 +1,78 @@
+{-# LANGUAGE DeepSubsumption #-}
+{-# LANGUAGE NamedWildCards #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
+
+module T26225 where
+
+-- Recall: ty1 is a subtype of ty2, written ty1 ⊑ ty2,
+-- if we can use ty1 wherever ty2 is expected.
+-- Can also read as "ty1 is more polymorphic than ty2".
+-- Example: ∀ a. a -> a ⊑ Int -> Int, meaning that we can pass
+-- the identity function where one is expecting a function of type Int -> Int.
+
+-- Int -> (∀ a. a -> a) ⊑ α[tau]
+-- Accepted by GHC.
+ex0 :: ()
+ex0 =
+ let
+ f :: Int -> (∀ a. a -> a)
+ f _ = id
+ g :: _α -> ()
+ g _ = ()
+ in g f
+
+-- ((∀ a. a->a) -> Int) -> Bool ⊑ α[tau]
+-- Rejected by GHC up to and including 9.14.
+ex1' :: ()
+ex1' =
+ let
+ f :: ((∀ a. a -> a) -> Int) -> Bool
+ f _ = False
+ g :: _α -> ()
+ g _ = ()
+ in g f
+ -- Couldn't match expected type ‘α’ with actual type ‘((∀ a. a -> a) -> Int) -> Bool’
+
+-- ((∀ a. a->a) -> Int) -> Bool ⊑ β[tau] Bool
+-- Rejected by GHC up to and including 9.14.
+ex2' :: ()
+ex2' =
+ let
+ f :: ((∀ a. a -> a) -> Int) -> Bool
+ f _ = False
+ g :: _β Bool -> ()
+ g _ = ()
+ in g f
+ -- Couldn't match expected type ‘β’ with actual type ‘(->) ((∀ a. a -> a) -> Int)’
+
+-- ex3 :: β[tau] Bool ⊑ (∀ a. a->a) -> Bool
+-- Rejected by GHC up to and including 9.14.
+ex3 :: ()
+ex3 =
+ let
+ f :: _β Bool
+ f = undefined
+ g :: ((∀ a. a -> a) -> Bool) -> ()
+ g _ = ()
+ in g f
+ -- Couldn't match expected type ‘β’ with actual type ‘(->) (∀ a. a -> a)’
+
+-- ex3' :: F Int Bool ⊑ (∀ a. a->a) -> Bool, where F Int = (->) (Int -> Int)
+-- Rejected by GHC up to and including 9.14.
+ex3' :: ()
+ex3' =
+ let
+ f :: F Int Bool
+ f _ = False
+ g :: ((∀ a. a -> a) -> Bool) -> ()
+ g _ = ()
+ in g f
+ -- • Couldn't match type: Int -> Int
+ -- with: ∀ a. a -> a
+ -- Expected: (∀ a. a -> a) -> Bool
+ -- Actual: F Int Bool
+type family F a where { F Int = (->) (Int -> Int) }
=====================================
testsuite/tests/typecheck/should_compile/T26225b.hs
=====================================
@@ -0,0 +1,21 @@
+{-# LANGUAGE DeepSubsumption #-}
+{-# LANGUAGE RankNTypes #-}
+
+module T26225b where
+
+f :: Int -> (forall a. a->a)
+f _ x = x
+g :: Int -> Bool -> Bool
+g _ x = x
+
+test3 b =
+ case b of
+ True -> f
+ False -> g
+test3' b =
+ case b of
+ True -> g
+ False -> f
+-- Both of these currently error with:
+-- * Couldn't match type: forall a. a -> a
+-- with: Bool -> Bool
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -861,6 +861,8 @@ test('DeepSubsumption06', normal, compile, ['-XHaskell98'])
test('DeepSubsumption07', normal, compile, ['-XHaskell2010'])
test('DeepSubsumption08', normal, compile, [''])
test('DeepSubsumption09', normal, compile, [''])
+test('T26225', normal, compile, [''])
+test('T26225b', normal, compile, [''])
test('T21765', normal, compile, [''])
test('T21951a', normal, compile, ['-Wredundant-strictness-flags'])
test('T21951b', normal, compile, ['-Wredundant-strictness-flags'])
=====================================
testsuite/tests/typecheck/should_fail/T12563.stderr deleted
=====================================
@@ -1,15 +0,0 @@
-
-T12563.hs:8:15: error: [GHC-91028]
- • Couldn't match expected type ‘(forall a. f a) -> f r’
- with actual type ‘p’
- Cannot equate type variable ‘p’
- with a type involving polytypes: (forall a. f a) -> f r
- ‘p’ is a rigid type variable bound by
- the inferred type of x :: p -> f r
- at T12563.hs:8:1-15
- • In the first argument of ‘foo’, namely ‘g’
- In the expression: foo g
- In the expression: \ g -> foo g
- • Relevant bindings include
- g :: p (bound at T12563.hs:8:6)
- x :: p -> f r (bound at T12563.hs:8:1)
=====================================
testsuite/tests/typecheck/should_fail/T14618.stderr
=====================================
@@ -1,4 +1,3 @@
-
T14618.hs:7:14: error: [GHC-25897]
• Couldn't match expected type ‘b’ with actual type ‘a’
‘a’ is a rigid type variable bound by
@@ -19,3 +18,4 @@ T14618.hs:7:14: error: [GHC-25897]
f' = f
• Relevant bindings include
safeCoerce :: a -> b (bound at T14618.hs:7:1)
+
=====================================
testsuite/tests/typecheck/should_fail/T6022.stderr
=====================================
@@ -1,7 +1,7 @@
-
T6022.hs:4:1: error: [GHC-80003]
- • Non type-variable argument in the constraint: Eq ([a] -> a)
+ • Non type-variable argument in the constraint: Eq ([t] -> t)
• When checking the inferred type
- f :: forall {a}. Eq ([a] -> a) => ([a] -> a) -> Bool
+ f :: forall {t}. Eq ([t] -> t) => ([t] -> t) -> Bool
Suggested fix:
Perhaps you intended to use the ‘FlexibleContexts’ extension
+
=====================================
testsuite/tests/typecheck/should_fail/T8883.stderr
=====================================
@@ -1,9 +1,9 @@
-
T8883.hs:21:1: error: [GHC-80003]
- • Non type-variable argument in the constraint: Functor (PF a)
+ • Non type-variable argument in the constraint: Functor (PF t)
• When checking the inferred type
- fold :: forall {a} {b}.
- (Functor (PF a), Regular a) =>
- (PF a b -> b) -> a -> b
+ fold :: forall {t} {b}.
+ (Functor (PF t), Regular t) =>
+ (PF t b -> b) -> t -> b
Suggested fix:
Perhaps you intended to use the ‘FlexibleContexts’ extension
+
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -432,7 +432,7 @@ test('T12124', normal, compile_fail, [''])
test('T12430', normal, compile_fail, [''])
test('T12589', normal, compile_fail, [''])
test('T12529', normal, compile_fail, [''])
-test('T12563', normal, compile_fail, [''])
+test('T12563', normal, compile, ['']) # Turns out we can accept this one after all!
test('T12648', normal, compile_fail, [''])
test('T12729', normal, compile_fail, [''])
test('T12785b', normal, compile_fail, [''])
=====================================
testsuite/tests/typecheck/should_fail/tcfail140.stderr
=====================================
@@ -1,4 +1,3 @@
-
tcfail140.hs:11:7: error: [GHC-83865]
• Couldn't match expected type ‘t1 -> t’ with actual type ‘Int’
• The function ‘f’ is applied to two visible arguments,
@@ -17,13 +16,13 @@ tcfail140.hs:13:10: error: [GHC-83865]
rot :: p -> t (bound at tcfail140.hs:13:1)
tcfail140.hs:15:15: error: [GHC-83865]
- • Couldn't match expected type ‘a -> b’ with actual type ‘Int’
+ • Couldn't match expected type ‘t -> b’ with actual type ‘Int’
• In the first argument of ‘map’, namely ‘(3 `f`)’
In the expression: map (3 `f`) xs
In an equation for ‘bot’: bot xs = map (3 `f`) xs
• Relevant bindings include
- xs :: [a] (bound at tcfail140.hs:15:5)
- bot :: [a] -> [b] (bound at tcfail140.hs:15:1)
+ xs :: [t] (bound at tcfail140.hs:15:5)
+ bot :: [t] -> [b] (bound at tcfail140.hs:15:1)
tcfail140.hs:17:8: error: [GHC-27346]
• The data constructor ‘Just’ should have 1 argument, but has been given none
@@ -36,3 +35,4 @@ tcfail140.hs:20:1: error: [GHC-83865]
• Couldn't match expected type ‘Int’ with actual type ‘t0 -> Bool’
• The equation for ‘g’ has two visible arguments,
but its type ‘Int -> Int’ has only one
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56b32c5a2d5d7cad89a12f4d74dc940…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56b32c5a2d5d7cad89a12f4d74dc940…
You're receiving this email because of your account on gitlab.haskell.org.
1
0