[Git][ghc/ghc][wip/supersven/riscv-vectors] 2 commits: Delete cruft
by Sven Tennie (＠supersven) 29 Jun '25
by Sven Tennie (＠supersven) 29 Jun '25
29 Jun '25
Sven Tennie pushed to branch wip/supersven/riscv-vectors at Glasgow Haskell Compiler / GHC
Commits:
f6705fd2 by Sven Tennie at 2025-06-28T17:58:23+02:00
Delete cruft
- - - - -
463de889 by Sven Tennie at 2025-06-29T12:04:59+02:00
CheckVectorSupport: Support non-RVV cpus
- - - - -
5 changed files:
- − Makefile.save
- − Notes.md
- − ghc.diff
- − git.diff
- rts/CheckVectorSupport.c
Changes:
=====================================
Makefile.save deleted
=====================================
@@ -1,13 +0,0 @@
-.PHONY: boot configure build test-simd000
-
-boot:
- ./boot
-
-configure: boot
- configure_ghc
-
-build:
- hadrian/build -j --docs=none --flavour=devel2
-
-test-simd000: build
- CROSS_EMULATOR="qemu-riscv64" hadrian/build -j --docs=none --flavour=devel2 test --only=simd000
=====================================
Notes.md deleted
=====================================
@@ -1,7 +0,0 @@
-main.S:
-
-```
-v8 {q = {0xb0000000000000003}, l = {0x3, 0xb}, w = {0x3, 0x0, 0xb, 0x0}, s = {0x3, 0x0, 0x0, 0x0, 0xb, 0x0, 0x0, 0x0}, b = {0x3, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0xb, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0}}
-v10 {q = {0x1}, l = {0x1, 0x0}, w = {0x1, 0x0, 0x0, 0x0}, s = {0x1, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0}, b = {0x1, 0x0 <repeats 15 times>}}
-
-```
=====================================
ghc.diff deleted
=====================================
@@ -1,74 +0,0 @@
-diff --git a/compiler/CodeGen.Platform.h b/compiler/CodeGen.Platform.h
-index 6f85686030..f91fee07fe 100644
---- a/compiler/CodeGen.Platform.h
-+++ b/compiler/CodeGen.Platform.h
-@@ -1274,44 +1274,6 @@ freeReg REG_XMM5 = False
- freeReg REG_XMM6 = False
- # endif
-
--# if defined(REG_YMM1)
--freeReg REG_YMM1 = False
--# endif
--# if defined(REG_YMM2)
--freeReg REG_YMM2 = False
--# endif
--# if defined(REG_YMM3)
--freeReg REG_YMM3 = False
--# endif
--# if defined(REG_YMM4)
--freeReg REG_YMM4 = False
--# endif
--# if defined(REG_YMM5)
--freeReg REG_YMM5 = False
--# endif
--# if defined(REG_YMM6)
--freeReg REG_YMM6 = False
--# endif
--
--# if defined(REG_ZMM1)
--freeReg REG_ZMM1 = False
--# endif
--# if defined(REG_ZMM2)
--freeReg REG_ZMM2 = False
--# endif
--# if defined(REG_ZMM3)
--freeReg REG_ZMM3 = False
--# endif
--# if defined(REG_ZMM4)
--freeReg REG_ZMM4 = False
--# endif
--# if defined(REG_ZMM5)
--freeReg REG_ZMM5 = False
--# endif
--# if defined(REG_ZMM6)
--freeReg REG_ZMM6 = False
--# endif
--
- freeReg _ = True
-
- #else
-diff --git a/compiler/GHC/CmmToAsm/RV64/Instr.hs b/compiler/GHC/CmmToAsm/RV64/Instr.hs
-index bb4e0ba61c..ec00d5ef68 100644
---- a/compiler/GHC/CmmToAsm/RV64/Instr.hs
-+++ b/compiler/GHC/CmmToAsm/RV64/Instr.hs
-@@ -20,7 +20,6 @@ import GHC.CmmToAsm.Utils
- import GHC.Data.FastString (LexicalFastString)
- import GHC.Platform
- import GHC.Platform.Reg
--import GHC.Platform.Reg.Class.Separate
- import GHC.Platform.Regs
- import GHC.Prelude
- import GHC.Stack
-diff --git a/compiler/GHC/CmmToAsm/RV64/Ppr.hs b/compiler/GHC/CmmToAsm/RV64/Ppr.hs
-index 75cbcf2da6..2735bb5bef 100644
---- a/compiler/GHC/CmmToAsm/RV64/Ppr.hs
-+++ b/compiler/GHC/CmmToAsm/RV64/Ppr.hs
-@@ -797,7 +797,7 @@ pprInstr platform instr = case instr of
- FNMSub -> text "\tfnmsub" <> dot <> floatPrecission d
- in op4 fma d r1 r2 r3
- VFMA variant o1@(OpReg fmt _reg) o2 o3
-- | VecFormat l fmt' <- fmt ->
-+ | VecFormat _l fmt' <- fmt ->
- let formatString = if (isFloatFormat . scalarFormatFormat) fmt' then text "f" else text ""
- prefix = text "v" <> formatString
- suffix = text "vv"
=====================================
git.diff deleted
=====================================
@@ -1,33 +0,0 @@
-diff --git a/testsuite/driver/cpuinfo.py b/testsuite/driver/cpuinfo.py
-index 4617b04a4c..841ec9dfdc 100644
---- a/testsuite/driver/cpuinfo.py
-+++ b/testsuite/driver/cpuinfo.py
-@@ -2151,6 +2152,10 @@ def _get_cpu_info_from_riscv_isa():
- seen.add(item)
- return unique_list
-
-+ # Big endian is easier to head, but RISC-V is little endian
-+ def bigToLittleEndian(w):
-+ return int.from_bytes(w, byteorder='big').to_bytes(4, byteorder='little')
-+
- g_trace.header('Tying to get info from device-tree ...')
-
- try:
-@@ -2175,16 +2180,17 @@ def _get_cpu_info_from_riscv_isa():
-
- if arch_string.startswith('rv32'):
- vlen = run_asm(
-- b"\xc2\x20\x25\x73", # csrr a0, 0xc22
-- b"\x00\x00\x80\x67" # ret
-+ bigToLittleEndian(b"\xc2\x20\x25\x73"), # csrr a0, 0xc22
-+ bigToLittleEndian(b"\x00\x00\x80\x67") # ret
- )
- elif arch_string.startswith('rv64'):
- vlen = run_asm(
-- b"\xc2\x20\x25\x73", # csrr a0, 0xc22
-- b"\x00\x05\x05\x1b", # sext.w a0, a0
-- b"\x00\x00\x80\x67" # ret
-+ bigToLittleEndian(b"\xc2\x20\x25\x73"), # csrr a0, 0xc22
-+ bigToLittleEndian(b"\x00\x05\x05\x1b"), # sext.w a0, a0
-+ bigToLittleEndian(b"\x00\x00\x80\x67") # ret
- )
=====================================
rts/CheckVectorSupport.c
=====================================
@@ -4,10 +4,17 @@
#if defined(__riscv_v) && defined(__riscv_v_intrinsic)
#include <riscv_vector.h>
#include <stdlib.h>
+#include <signal.h>
+#include <setjmp.h>
-// TODO: Find better file for this.
-void* malloc_vlen_vector() {
- return malloc(__riscv_vlenb());
+static jmp_buf jmpbuf;
+
+// Signal handler for SIGILL (Illegal Instruction)
+static void sigill_handler(int);
+static void sigill_handler(__attribute__((unused)) int sig) {
+ // If we get here, the vector instruction caused an illegal instruction
+ // exception. We just swallow it.
+ longjmp(jmpbuf, 1);
}
#endif
@@ -74,11 +81,29 @@ int checkVectorSupport(void) {
supports_V32 = hwcap & PPC_FEATURE_HAS_VSX;
*/
+ // Detect RISC-V support
#elif defined(__riscv_v) && defined(__riscv_v_intrinsic)
// __riscv_v ensures we only get here when the compiler target (arch)
// supports vectors.
-
- unsigned vlenb = __riscv_vlenb();
+ // Unfortunately, the status registers that could tell about RVV support
+ // are part of the priviledged ISA. So, we try to get VLENB from the `vlenb`
+ // register that only exists with RVV. If this throws an illegal instruction
+ // exception, we know that RVV is not supported by the executing CPU.
+
+ // Set up signal handler to catch illegal instruction
+ struct sigaction sa, old_sa;
+ sa.sa_handler = sigill_handler;
+ sigemptyset(&sa.sa_mask);
+ sa.sa_flags = 0;
+ sigaction(SIGILL, &sa, &old_sa);
+
+ unsigned vlenb = 0;
+ if (setjmp(jmpbuf) == 0) {
+ // Try to execute a vector instruction
+ vlenb = __riscv_vlenb();
+ }
+ // Restore original signal handler
+ sigaction(SIGILL, &old_sa, NULL);
// VLENB gives the length in bytes
supports_V16 = vlenb >= 16;
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f5ae460efbb8513e80941fdeecea8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f5ae460efbb8513e80941fdeecea8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/bump-win32-tarballs] rts: Fix offset by 1 error and check for both delimiters
by Tamar Christina (＠Phyx) 29 Jun '25
by Tamar Christina (＠Phyx) 29 Jun '25
29 Jun '25
Tamar Christina pushed to branch wip/bump-win32-tarballs at Glasgow Haskell Compiler / GHC
Commits:
d2c66a91 by Tamar Christina at 2025-06-29T11:00:06+01:00
rts: Fix offset by 1 error and check for both delimiters
- - - - -
1 changed file:
- rts/linker/LoadArchive.c
Changes:
=====================================
rts/linker/LoadArchive.c
=====================================
@@ -250,11 +250,11 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_,
// Check that the previous entry ends with the expected
// end-of-string delimiter.
#if defined(mingw32_HOST_OS)
-#define STRING_TABLE_DELIM '\0'
+#define IS_SYMBOL_DELIMITER(STR) (STR =='\n' || STR == '\0')
#else
-#define STRING_TABLE_DELIM '\n'
+#define IS_SYMBOL_DELIMITER(STR) (STR =='\n')
#endif
- if (n != 0 && gnuFileIndex[n - 1] != STRING_TABLE_DELIM) {
+ if (n != 0 && !IS_SYMBOL_DELIMITER(gnuFileIndex[n - 1])) {
errorBelch("loadArchive: GNU-variant filename offset "
"%d invalid (range [0..%d]) while reading "
"filename from `%" PATH_FMT "'",
@@ -263,10 +263,10 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_,
}
int i;
- for (i = n; gnuFileIndex[i] != '\n'; i++)
+ for (i = n; !IS_SYMBOL_DELIMITER(gnuFileIndex[i]); i++)
;
- size_t FileNameSize = i - n - 1;
+ size_t FileNameSize = i - n;
if (FileNameSize >= *fileNameSize) {
/* Double it to avoid potentially continually
increasing it by 1 */
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2c66a91150b49e3969c25af2a9868f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2c66a91150b49e3969c25af2a9868f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
28 Jun '25
Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC
Commits:
0d1363c0 by Simon Peyton Jones at 2025-06-28T23:00:40+01:00
Wibbles
- - - - -
66114346 by Simon Peyton Jones at 2025-06-28T23:37:33+01:00
Wibble
- - - - -
6 changed files:
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -3375,7 +3375,7 @@ beats_or_same (CI { ci_key = args1 }) (CI { ci_key = args2 })
go_arg (SpecDict {}) (SpecDict {}) = True
go_arg UnspecType UnspecType = True
go_arg UnspecArg UnspecArg = True
- go_arg _ _ = False
+ go_arg _ _ = False
----------------------
splitDictBinds :: FloatedDictBinds -> IdSet -> (FloatedDictBinds, OrdList DictBind, IdSet)
@@ -3491,7 +3491,6 @@ newSpecIdSM old_name new_ty details info
; return (assert (not (isCoVarType new_ty)) $
mkLocalVar details new_name ManyTy new_ty info) }
-
{-
Old (but interesting) stuff about unboxed bindings
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -796,216 +796,6 @@ Note [Desugaring new-form SPECIALISE pragmas]
which is desugared in this module by `dsSpec`. For the context see
Note [Handling new-form SPECIALISE pragmas] in GHC.Tc.Gen.Sig
-Suppose we have f :: forall p q. (Ord p, Eq q) => p -> q -> q, and a pragma
-
- {-# SPECIALISE forall x. f @[a] @[Int] x [3,4] #-}
-
-In `dsSpec` the `SpecPragE` will look something like this:
-
- SpecPragE { spe_fn_id = f
- , spe_bndrs = @a (d:Ord a) (x:[a])
- , spe_call = let d2:Ord [a] = $dfOrdList d
- d3:Eq [Int] = $dfEqList $dfEqInt
- in f @[a] @[Int] d2 d3 x [3,4] }
-We want to get
-
- RULE forall a (d2:Ord a) (d3:Eq [Int]) (x:[a]).
- f @[a] @[Int] d2 d3 x [3,4] = $sf d2 x
-
- $sf :: forall a. Ord [a] => a -> Int
- $sf = /\a. \d2 x.
- let d3 = $dfEqList $dfEqInt
- in <f-rhs> @[a] @[Int] d2 d3 x [3,4]
-
-Notice that
-
-(SP1) If the expression in the SPECIALISE pragma had a type signature, such as
- SPECIALISE f :: Eq b => Int -> b -> b
- then the desugared expression may have type abstractions and applications
- "in the way", like this:
- (/\b. (\d:Eq b). let d1 = $dfOrdInt in f @Int @b d1 d) @b (d2:Eq b)
- The lambdas come from the type signature, which is then re-instantiated,
- hence the applications of those lambdas.
-
- We use the simple optimiser to simplify this to
- let { d = d2; d1 = $dfOrdInt } in f @Int @b d1 d
-
- Important: do no inlining in this "simple optimiser" phase:
- use `simpleOptExprNoInline`. E.g. we don't want to turn it into
- f @Int @b $dfOrdInt d2
- because the latter is harder to match.
-
- Similarly if we have
- let { d1=d; d2=d } in f d1 d2
- we don't want to inline d1/d2 to get this
- f d d
-
-(SP2) $sf does not simply quantify over (d:Ord a). Instead, to figure out what
- it should quantify over, and to include the 'd3' binding in the body of $sf,
- we use the function `prepareSpecLHS`. It takes the simplified LHS `core_call`,
- and uses the dictionary bindings to figure out the RULE LHS and RHS.
-
- This is described in Note [prepareSpecLHS].
-
-Note [prepareSpecLHS]
-~~~~~~~~~~~~~~~~~~~~~
-To compute the appropriate RULE LHS and RHS for a new-form specialise pragma,
-as described in Note [Desugaring new-form SPECIALISE pragmas], we use a function
-called prepareSpecLHS.
-It takes as input a list of (type and evidence) binders, and a Core expression.
-For example, suppose its input is of the following form:
-
- spe_bndrs = @a (d:Ord a)
- spe_call =
- let
- -- call these bindings the call_binds
- d1 :: Num Int
- d1 = $dfNumInt
- d2 :: Ord [a]
- d2 = $dfOrdList d
- d3 :: Eq a
- d3 = $p1Ord d3
- d4 :: Ord (F a)
- d4 = d |> co1
- d5 :: Ord (G a)
- d5 = d4 |> co2
- in
- f @[a] @Int d1 d2 d3 d5
-
-The goal of prepareSpecLHS is then to generate the following two things:
-
- - A specialisation, of the form:
-
- $sf <spec_args> =
- let <spec_binds>
- in <f-rhs> @[a] @Int d1 d2 d3 d5
-
- - A rule, of the form:
-
- RULE forall a d1 d2 d3 d5. f @[a] @Int d1 d2 d3 d5 =
- let <rule_binds>
- in $sf <spec_args>
-
-That is, we must compute 'spec_args', 'rule_binds' and 'spec_binds'. A first
-approach might be:
-
- - take spec_args = spe_bndrs,
- - spec_binds = call_binds.
-
-If we did so, the RULE would look like:
-
- RULE forall a d1 d2 d3 d5. f @[a] @Int d1 d2 d3 d5 =
- let d = <???>
- in $sf @a d
-
-The problem is: how do we recover 'd' from 'd1', 'd2', 'd3', 'd5'? Essentially,
-we need to run call_binds in reverse. In this example, we had:
-
- d1 :: Num Int
- d1 = $dfNumInt
- d2 :: Ord [a]
- d2 = $dfOrdList d
- d3 :: Eq a
- d3 = $p1Ord d3
- d4 :: Ord (F a)
- d4 = d |> co1
- d5 :: Ord (G a)
- d5 = d4 |> co2
-
-Let's try to recover (d: Ord a) from 'd1', 'd2', 'd4', 'd5':
-
- - d1 is a constant binding, so it doesn't help us.
- - d2 uses a top-level instance, which we can't run in reverse; we can't
- obtain Ord a from Ord [a].
- - d3 uses a superclass selector which prevents us from making progress.
- - d5 is defined using d4, and both involve a cast.
- In theory we could define d = d5 |> sym (co1 ; co2), but this gets
- pretty complicated.
-
-This demonstrates the following:
-
- 1. The bindings can't necessarily be "run in reverse".
- 2. Even if the bindings theoretically can be "run in reverse", it is not
- straightforward to do so.
-
-Now, we could strive to make the let-bindings reversible. We already do this
-to some extent for quantified constraints, as explained in
-Note [Fully solving constraints for specialisation] in GHC.Tc.Gen.Sig,
-using the TcSSpecPrag solver mode described in Note [TcSSpecPrag] in GHC.Tc.Solver.Monad.
-However, given (2), we don't bother ensuring that e.g. we don't use top-level
-class instances like in d2 above. Instead, we handle these bindings in
-prepareSpecLHS as follows:
-
- (a) Go through the bindings in order.
-
- (1) Bindings like
- d1 = $dfNumInt
- depend only on constants and move to the specialised function body.
- That is crucial -- it makes those specialised methods available in the
- specialised body. These are the `spec_const_binds`.
-
- Note that these binds /can/ depend on locally-quantified /type/ variables.
- For example, if we have
- instance Monad (ST s) where ...
- then the dictionary for (Monad (ST s)) is effectively a constant dictionary.
- This is important to get specialisation for such types. Example in test T8331.
-
- (2) Other bindings, like
- d2:Ord [a] = $dfOrdList d
- d3 = d
- depend on a locally-quantifed evidence variable `d`.
- Surprisingly, /we want to drop these bindings entirely!/
- This is because, as explained above, it is too difficult to run these
- in reverse. Instead, we drop them, and re-compute which dictionaries
- we will quantify over.
-
- (3) Finally, inside those dictionary bindings we should find the call of the
- function itself
- f @[a] @[Int] d2 d3 x [3,4]
- 'prepareSpecLHS' takes the call apart and returns its arguments.
-
- (b) Now, (a)(2) means that the RULE does not quantify over 'd' any more; it
- quantifies over 'd1' 'd2' 'd3' 'd5'. So we recompute the `rule_bndrs`
- from scratch.
-
- Moreover, the specialised function also no longer quantifies over 'd',
- it quantifies over 'd2' 'd3' 'd5'. This set of binders is computed by
- taking the RULE binders and subtracting off the binders from
- the `spec_const_binds`.
-
-[Shortcoming] This whole approach does have one downside, compared to running
-the let-bindings in reverse: it doesn't allow us to common-up dictionaries.
-Consider for example:
-
- g :: forall a b. ( Eq a, Ord b ) => a -> b -> Bool
- {-# SPECIALISE g :: forall c. Ord c => c -> c -> Bool #-}
-
-The input to prepareSpecLHS will be (more or less):
-
- spe_bndrs: @c (d:Ord c)
- spe_call =
- let
- d1 :: Eq c
- d1 = $p1Ord d
- d2 :: Ord c
- d2 = d
- in
- g @c @c d1 d2
-
-The approach described in (2) will thus lead us to generate:
-
- RULE g @c @c d1 d2 = $sg @c d1 d2
- $sg @c d1 d2 = <g-rhs> @c @c d1 d2
-
-when we would rather avoid passing both dictionaries, and instead generate:
-
- RULE g @c @c d1 d2 = let { d = d2 } in $sg @c d
- $sg @c d = let { d1 = $p1Ord d; d2 = d } in <g-rhs> @c @c d1 d2
-
-For now, we accept this infelicity.
-
-Note [Desugaring new-form SPECIALISE pragmas] -- Take 2
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have
f :: forall a b c d. (Ord a, Ord b, Eq c, Ix d) => ...
f = rhs
@@ -1027,11 +817,11 @@ We /could/ generate
RULE f d1 d2 d3 d4 e1..en = $sf d1 d2 d3 d4
$sf d1 d2 d3 d4 = <rhs> d1 d2 d3 d4
-But that would do no specialisation! What we want is this:
+But that would do no specialisation at all! What we want is this:
RULE f d1 _d2 _d3 d4 e1..en = $sf d1 d4
$sf d1 d4 = let d7 = d1 -- Renaming
- dx1 = d7 -- Renaming
- d6 = dx1
+ dx1 = d1 -- Renaming
+ d6 = d1 -- Renaming
d2 = $fOrdList d6
d3 = $fEqList $fEqInt
in rhs d1 d2 d3 d4
@@ -1045,46 +835,61 @@ Notice that:
to line things up
The transformation goes in these steps
+
(S1) decomposeCall: decomopose `the_call` into
- - `rev_binds`: the enclosing let-bindings (actually reversed)
+ - `binds`: the enclosing let-bindings
- `rule_lhs_args`: the arguments of the call itself
- We carefully arrange that the dictionary arguments of the actual
- call, `rule_lhs_args` are all distinct dictionary variables,
- not expressions. How? We use `simpleOptExprNoInline` to avoid
- inlining the let-bindings.
+
+ If the expression in the SPECIALISE pragma had a type signature, such as
+ SPECIALISE g :: Eq b => Int -> b -> b
+ then the desugared expression may have type abstractions and applications
+ "in the way", like this:
+ (/\b. (\d:Eq b). let d1 = $dfOrdInt in f @Int @b d1 d) @b (d2:Eq b)
+ The lambdas come from the type signature, which is then re-instantiated,
+ hence the applications of those lambdas.
+
+ so `decomposeCall` uses the simple optimiser to simplify this to
+ let { d = d2; d1 = $dfOrdInt } in f @Int @b d1 d
+
+ Wrinkle (S1a): do no inlining in this "simple optimiser" phase:
+ use `simpleOptExprNoInline`. E.g. we don't want to turn it into
+ f @Int @b $dfOrdInt d2
+ because the latter is harder to match. Similarly if we have
+ let { d1=d; d2=d } in f d1 d2
+ we don't want to inline d1/d2 to get this
+ f d d
+
+ TL;DR: as a result the dictionary arguments of the actual call,
+ `rule_lhs_args` are all distinct dictionary variables, not
+ expressions.
(S2) Compute `rule_bndrs`: the free vars of `rule_lhs_args`, which
will be the forall'd template variables of the RULE. In the example,
rule_bndrs = d1,d2,d3,d4
-
-(S3) grabSpecBinds: transform `rev_binds` into `spec_binds`: the
- bindings we will wrap around the call in the RHS of `$sf`
-
-(S4) Find `spec_bndrs`, the subset of `rule_bndrs` that we actually
- need to pass to `$sf`, simply by filtering out those that are
- bound by `spec_binds`. In the example
- spec_bndrs = d1,d4
-
-
- Working inner
-* Grab any bindings we can that will "shadow" the forall'd
- rule-bndrs, giving specialised bindings for them.
- * We keep a set of known_bndrs starting with {d1,..,dn}
- * We keep a binding iff no free var is
- (a) in orig_bndrs (i.e. not totally free)
- (b) not in known_bndrs
- * If we keep it, add its binder to known_bndrs; if not, don't
-
-To maximise what we can "grab", start by extracting /renamings/ of the
-forall'd rule_bndrs, and bringing them to the top. A renaming is
- rule_bndr = d
-If we see this:
- * Bring d=rule_bndr to the top
- * Add d to the set of variables to look for on the right.
- e.g. rule_bndrs = d1, d2
- Bindings { d7=d9; d1=d7 }
- Bring to the top { d7=d1; d9=d7 }
-
+ These variables will get values from a successful RULE match.
+
+(S3) `getRenamings`: starting from the rule_bndrs, make bindings for
+ all other variables that are equal to them. In the example, we
+ make renaming-bindings for d7, dx1, d6.
+
+ NB1: we don't actually have to remove the original bindings;
+ it's harmless to leave them
+ NB2: We also reverse bindings like d1 = d2 |> co, to get
+ d2 = d1 |> sym co
+ It's easy and may help.
+
+(S4) `pickSpecBinds`: pick the bindings we want to keep in the
+ specialised function. We start from `known_vars`, the variables we
+ know, namely the `rule_bndrs` and the binders from (S3), which are
+ all equal to one of the `rule_bndrs`.
+
+ Then we keep a binding if the free vars of its RHS are all known.
+ In our example, `d2` and `d3` are both picked, but `d4` is not.
+ The non-picked ones won't end up being specialised.
+
+(S5) Finally, work out which of the `rule_bndrs` we must pass on to
+ specialised function. We just filter out ones bound by a renaming
+ or a picked binding.
-}
------------------------
@@ -1155,7 +960,9 @@ dsSpec_help :: Name -> Id -> CoreExpr -- Function to specialise
-> InlinePragma -> [Var] -> CoreExpr
-> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule))
dsSpec_help poly_nm poly_id poly_rhs spec_inl orig_bndrs ds_call
- = do { mb_call_info <- decomposeCall poly_id ds_call
+ = do { -- Decompose the call
+ -- Step (S1) of Note [Desugaring new-form SPECIALISE pragmas]
+ mb_call_info <- decomposeCall poly_id ds_call
; case mb_call_info of {
Nothing -> return Nothing ;
Just (binds, rule_lhs_args) ->
@@ -1167,12 +974,17 @@ dsSpec_help poly_nm poly_id poly_rhs spec_inl orig_bndrs ds_call
is_local :: Var -> Bool
is_local v = v `elemVarSet` locals
+ -- Find `rule_bndrs`: (S2) of Note [Desugaring new-form SPECIALISE pragmas]
rule_bndrs = scopedSort (exprsSomeFreeVarsList is_local rule_lhs_args)
+ -- getRenamings: (S3) of Note [Desugaring new-form SPECIALISE pragmas]
rn_binds = getRenamings orig_bndrs binds rule_bndrs
+
+ -- pickSpecBinds: (S4) of Note [Desugaring new-form SPECIALISE pragmas]
known_vars = mkVarSet rule_bndrs `extendVarSetList` bindersOfBinds rn_binds
picked_binds = pickSpecBinds is_local known_vars binds
+ -- Fins `spec_bndrs`: (S5) of Note [Desugaring new-form SPECIALISE pragmas]
-- Make spec_bndrs, the variables to pass to the specialised
-- function, by filtering out the rule_bndrs that aren't needed
spec_binds_bndr_set = mkVarSet (bindersOfBinds picked_binds)
@@ -1262,12 +1074,12 @@ dsSpec_help poly_nm poly_id poly_rhs spec_inl orig_bndrs ds_call
decomposeCall :: Id -> CoreExpr
-> DsM (Maybe ([CoreBind], [CoreExpr] ))
-- Decompose the call into (let <binds> in f <args>)
+-- See (S1) in Note [Desugaring new-form SPECIALISE pragmas]
decomposeCall poly_id ds_call
- = do { -- Simplify the (desugared) call; see wrinkle (SP1)
- -- in Note [Desugaring new-form SPECIALISE pragmas]
- ; dflags <- getDynFlags
+ = do { dflags <- getDynFlags
; let simpl_opts = initSimpleOpts dflags
core_call = simpleOptExprNoInline simpl_opts ds_call
+ -- simpleOpeExprNoInlint: see Wrinkle (S1a)!
; case go [] core_call of {
Nothing -> do { diagnosticDs (DsRuleLhsTooComplicated ds_call core_call)
=====================================
compiler/GHC/Tc/Gen/Sig.hs
=====================================
@@ -759,9 +759,7 @@ This is done in three parts.
(1) Typecheck the expression, capturing its constraints
- (2) Solve these constraints, but in special TcSSpecPrag mode which ensures
- each original Wanted is either fully solved or left untouched.
- See Note [Fully solving constraints for specialisation].
+ (2) Solve these constraints
(3) Compute the constraints to quantify over, using `getRuleQuantCts` on
the unsolved constraints returned by (2).
@@ -797,68 +795,6 @@ This is done in three parts.
of the form:
forall @a @b d1 d2 d3. f d1 d2 d3 = $sf d1 d2 d3
-Note [Fully solving constraints for specialisation]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-As far as specialisation is concerned, it is actively harmful to simplify
-constraints without /fully/ solving them.
-
-Example:
-
- f :: ∀ a t. (Eq a, ∀x. Eq x => Eq (t x)). t a -> Char
- {-# SPECIALISE f @Int #-}
-
- Typechecking 'f' will result in [W] Eq Int, [W] ∀x. Eq x => Eq (t x).
- We absolutely MUST leave the quantified constraint alone, because we want to
- quantify over it. If we were to try to simplify it, we would emit an
- implication and would thereafter never be able to quantify over the original
- quantified constraint.
-
- However, we still need to simplify quantified constraints that can be
- /fully solved/ from instances, otherwise we would never be able to
- specialise them away. Example: {-# SPECIALISE f @a @[] #-}.
-
-The conclusion is this:
-
- when solving the constraints that arise from a specialise pragma, following
- the recipe described in Note [Handling new-form SPECIALISE pragmas], all
- Wanted quantified constraints should either be:
- - fully solved (no free evidence variables), or
- - left untouched.
-
-To achieve this, we run the solver in a special "all-or-nothing" solving mode,
-described in Note [TcSSpecPrag] in GHC.Tc.Solver.Monad.
-
-Note that a similar problem arises in other situations in which the solver takes
-an irreversible step, such as using a top-level class instance. This is currently
-less important, as the desugarer can handle these cases. To explain, consider:
-
- g :: ∀ a. Eq a => a -> Bool
- {-# SPECIALISE g @[e] #-}
-
- Typechecking 'g' will result in [W] Eq [e]. Were we to simplify this to
- [W] Eq e, we would have difficulty generating a RULE for the specialisation:
-
- $sg :: Eq e => [e] -> Bool
-
- RULE ∀ e (d :: Eq [e]). g @[e] d = $sg @e (??? :: Eq e)
- -- Can't fill in ??? because we can't run instances in reverse.
-
- RULE ∀ e (d :: Eq e). g @[e] ($fEqList @e d) = $sg @e d
- -- Bad RULE matching template: matches on the structure of a dictionary
-
- Moreover, there is no real benefit to any of this, because the specialiser
- can't do anything useful from the knowledge that a dictionary for 'Eq [e]' is
- constructed from a dictionary for 'Eq e' using the 'Eq' instance for lists.
-
-Here, it would make sense to also use the "solve completely" mechanism in the
-typechecker to avoid producing evidence terms that we can't "run in reverse".
-However, the current implementation tackles this issue in the desugarer, as is
-explained in Note [prepareSpecLHS] in GHC.HsToCore.Binds.
-So, for the time being at least, in TcSSpecPrag mode, we don't attempt to "fully solve"
-constraints when we use a top-level instance. This might change in the future,
-were we to decide to attempt to address [Shortcoming] in Note [prepareSpecLHS]
-in GHC.HsToCore.Binds.
-
Note [Handling old-form SPECIALISE pragmas]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
NB: this code path is deprecated, and is scheduled to be removed in GHC 9.18, as per #25440.
@@ -1039,7 +975,7 @@ tcSpecPrag poly_id (SpecSigE nm rule_bndrs spec_e inl)
<- tcRuleBndrs skol_info rule_bndrs $
tcInferRho spec_e
- -- (2) Solve the resulting wanteds in TcSSpecPrag mode.
+ -- (2) Solve the resulting wanteds
; ev_binds_var <- newTcEvBinds
; spec_e_wanted <- setTcLevel rhs_tclvl $
runTcSWithEvBinds ev_binds_var $
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -462,30 +462,20 @@ from the instance that we have in scope:
case x of { GHC.Types.I# x1 -> GHC.Types.I# (GHC.Prim.+# x1 1#) }
** NB: It is important to emphasize that all this is purely an optimization:
-** exactly the same programs should typecheck with or without this
-** procedure.
-
-Solving fully
-~~~~~~~~~~~~~
-There is a reason why the solver does not simply try to solve such
-constraints with top-level instances. If the solver finds a relevant
-instance declaration in scope, that instance may require a context
-that can't be solved for. A good example of this is:
-
- f :: Ord [a] => ...
- f x = ..Need Eq [a]...
-
-If we have instance `Eq a => Eq [a]` in scope and we tried to use it, we would
-be left with the obligation to solve the constraint Eq a, which we cannot. So we
-must be conservative in our attempt to use an instance declaration to solve the
-[W] constraint we're interested in.
-
-Our rule is that we try to solve all of the instance's subgoals
-recursively all at once. Precisely: We only attempt to solve
-constraints of the form `C1, ... Cm => C t1 ... t n`, where all the Ci
-are themselves class constraints of the form `C1', ... Cm' => C' t1'
-... tn'` and we only succeed if the entire tree of constraints is
-solvable from instances.
+** exactly the same programs should typecheck with or without this procedure.
+
+Consider
+ f :: Ord [a] => ...
+ f x = ..Need Eq [a]...
+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:
+ If we could solve a constraint from a local Given,
+ try first to /completely/ solve the constraint using only top-level instances.
+ - If that succeeds, use it
+ - If not, use the local Given
An example that succeeds:
@@ -511,7 +501,8 @@ An example that fails:
f :: C [a] b => b -> Bool
f x = m x == []
-Which, because solving `Eq [a]` demands `Eq a` which we cannot solve, produces:
+Which, because solving `Eq [a]` demands `Eq a` which we cannot solve. so short-cut
+solving fails and we use the superclass of C:
f :: forall a b. C [a] b => b -> Bool
f = \ (@ a) (@ b) ($dC :: C [a] b) (eta :: b) ->
@@ -521,23 +512,49 @@ Which, because solving `Eq [a]` demands `Eq a` which we cannot solve, produces:
(m @ [a] @ b $dC eta)
(GHC.Types.[] @ a)
-Note [Shortcut solving: type families]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Suppose we have (#13943)
- class Take (n :: Nat) where ...
- instance {-# OVERLAPPING #-} Take 0 where ..
- instance {-# OVERLAPPABLE #-} (Take (n - 1)) => Take n where ..
-
-And we have [W] Take 3. That only matches one instance so we get
-[W] Take (3-1). Really we should now rewrite to reduce the (3-1) to 2, and
-so on -- but that is reproducing yet more of the solver. Sigh. For now,
-we just give up (remember all this is just an optimisation).
-
-But we must not just naively try to lookup (Take (3-1)) in the
-InstEnv, or it'll (wrongly) appear not to match (Take 0) and get a
-unique match on the (Take n) instance. That leads immediately to an
-infinite loop. Hence the check that 'preds' have no type families
-(isTyFamFree).
+The moving parts are relatively simple:
+
+* To attempt to solve the constraint completely, we just recursively
+ call the constraint solver. See the use of `tryTcS` in
+ `tcShortCutSolver`.
+
+* When this attempted recursive solving, we set a special mode
+ `TcSShortCut`, which signals that we are trying to solve using only
+ top-level instances. We switch on `TcSShortCut` mode in
+ `tryShortCutSolver`.
+
+* When in TcSShortCut mode, we behave specially in a few places:
+ - `tryInertDicts`, where we would otherwise look for a Given to solve our Wantee
+ - `noMatchableGivenDicts`, which also consults the Givens
+ - `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
+
+
+Some wrinkles:
+
+(SCS1) Note [Shortcut solving: incoherence]
+
+(SCS2) The short-cut solver just uses the solver recursively, so we get its
+ full power:
+
+ * We need to be able to handle recursive super classes. The
+ solved_dicts state ensures that we remember what we have already
+ tried to solve to avoid looping.
+
+ * As #15164 showed, it can be important to exploit sharing between
+ goals. E.g. To solve G we may need G1 and G2. To solve G1 we may need H;
+ and to solve G2 we may need H. If we don't spot this sharing we may
+ solve H twice; and if this pattern repeats we may get exponentially bad
+ behaviour.
+
+ * Suppose we have (#13943)
+ class Take (n :: Nat) where ...
+ instance {-# OVERLAPPING #-} Take 0 where ..
+ instance {-# OVERLAPPABLE #-} (Take (n - 1)) => Take n where ..
+
+ And we have [W] Take 3. That only matches one instance so we get
+ [W] Take (3-1). Then we should reduce the (3-1) to 2, and continue.
Note [Shortcut solving: incoherence]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -603,37 +620,6 @@ The output of `main` if we avoid the optimization under the effect of
IncoherentInstances is `1`. If we were to do the optimization, the output of
`main` would be `2`.
-Note [Shortcut try_solve_from_instance]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The workhorse of the short-cut solver is
- try_solve_from_instance :: (EvBindMap, DictMap CtEvidence)
- -> CtEvidence -- Solve this
- -> MaybeT TcS (EvBindMap, DictMap CtEvidence)
-Note that:
-
-* The CtEvidence is the goal to be solved
-
-* The MaybeT manages early failure if we find a subgoal that
- cannot be solved from instances.
-
-* The (EvBindMap, DictMap CtEvidence) is an accumulating purely-functional
- state that allows try_solve_from_instance to augment the evidence
- bindings and inert_solved_dicts as it goes.
-
- If it succeeds, we commit all these bindings and solved dicts to the
- main TcS InertSet. If not, we abandon it all entirely.
-
-Passing along the solved_dicts important for two reasons:
-
-* We need to be able to handle recursive super classes. The
- solved_dicts state ensures that we remember what we have already
- tried to solve to avoid looping.
-
-* As #15164 showed, it can be important to exploit sharing between
- goals. E.g. To solve G we may need G1 and G2. To solve G1 we may need H;
- and to solve G2 we may need H. If we don't spot this sharing we may
- solve H twice; and if this pattern repeats we may get exponentially bad
- behaviour.
Note [No Given/Given fundeps]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -942,20 +942,16 @@ The constraint solver can operate in different modes:
* TcSVanilla: Normal constraint solving mode. This is the default.
* TcSPMCheck: Used by the pattern match overlap checker.
- Like TcSVanilla, but the idea is that the returned InertSet will
- later be resumed, so we do not want to restore type-equality cycles
- See also Note [Type equality cycles] in GHC.Tc.Solver.Equality
+ Like TcSVanilla, but the idea is that the returned InertSet will
+ later be resumed, so we do not want to restore type-equality cycles
+ See also Note [Type equality cycles] in GHC.Tc.Solver.Equality
* TcSEarlyAbort: Abort (fail in the monad) as soon as we come across an
insoluble constraint. This is used to fail-fast when checking for hole-fits.
See Note [Speeding up valid hole-fits].
-* TcSSpecPrag: Solve constraints fully or not at all. This is described in
- Note [TcSSpecPrag].
-
- This mode is currently used in one place only: when solving constraints
- arising from specialise pragmas.
- See Note [Fully solving constraints for specialisation] in GHC.Tc.Gen.Sig.
+* TcSShortCut: Solve constraints fully or not at all. This is described in
+ Note [Shortcut solving] in GHC.Tc.Solver.Dict
-}
data TcSEnv
@@ -1126,54 +1122,6 @@ runTcSEarlyAbort tcs
= do { ev_binds_var <- TcM.newTcEvBinds
; runTcSWithEvBinds' TcSEarlyAbort ev_binds_var tcs }
--- | Run the 'TcS' monad in 'TcSSpecPrag' mode, which either fully solves
--- individual Wanted quantified constraints or leaves them alone.
---
-
-{- Note [TcSSpecPrag]
-~~~~~~~~~~~~~~~~~~~~~
-The TcSSpecPrag mode is a specialized constraint solving mode that guarantees
-that Wanted quantified constraints are either:
- - Fully solved with no free evidence variables, or
- - Left completely untouched (no simplification at all)
-
-Examples:
-
- * [W] forall x. Eq x => Eq (f x).
-
- In TcSSpecPrag mode, we **do not** process this quantified constraint by
- creating a new implication constraint; we leave it alone instead.
-
- * [W] Eq (Maybe Int).
-
- This constraint is solved fully, using two top-level Eq instances.
-
- * [W] forall x. Eq x => Eq [x].
-
- This constraint is solved fully as well, using the Eq instance for lists.
-
-This functionality is crucially used by the specialiser, for which taking an
-irreversible constraint solving steps is actively harmful, as described in
-Note [Fully solving constraints for specialisation] in GHC.Tc.Gen.Sig.
-
-Note that currently we **do not** refrain from using top-level instances,
-even though we also can't run them in reverse; this isn't a problem for the
-specialiser (which is currently the sole consumer of this functionality).
-
-The implementation is as follows: in TcSSpecPrag mode, when we are about to
-solve a Wanted quantified constraint by emitting an implication, we call the
-special function `solveCompletelyIfRequired`. This function recursively calls
-the solver but in TcSVanilla mode (i.e. full-blown solving, with no restrictions).
-If this recursive call manages to solve all the remaining constraints fully,
-then we proceed with that outcome (i.e. we continue with that inert set, etc).
-Otherwise, we discard everything that happened in the recursive call, and
-continue with the original quantified constraint unchanged.
-
-In the future, we could consider re-using this functionality for the short-cut
-solver (see Note [Shortcut solving] in GHC.Tc.Solver.Dict), but we would have to
-be wary of the performance implications.
--}
-
-- | This can deal only with equality constraints.
runTcSEqualities :: TcS a -> TcM a
runTcSEqualities thing_inside
@@ -1282,20 +1230,21 @@ setTcLevelTcS lvl (TcS thing_inside)
nestImplicTcS :: EvBindsVar
-> TcLevel -> TcS a
-> TcS a
-nestImplicTcS ref inner_tclvl (TcS thing_inside)
+nestImplicTcS ev_binds_var inner_tclvl (TcS thing_inside)
= TcS $ \ env@(TcSEnv { tcs_inerts = old_inert_var }) ->
do { inerts <- TcM.readTcRef old_inert_var
-- Initialise the inert_cans from the inert_givens of the parent
-- so that the child is not polluted with the parent's inert Wanteds
+ -- See Note [trySolveImplication] in GHC.Tc.Solver.Solve
+ -- All other InertSet fields are inherited
; let nest_inert = inerts { inert_cycle_breakers = pushCycleBreakerVarStack
(inert_cycle_breakers inerts)
, inert_cans = (inert_givens inerts)
{ inert_given_eqs = False } }
- -- All other InertSet fields are inherited
; new_inert_var <- TcM.newTcRef nest_inert
; new_wl_var <- TcM.newTcRef emptyWorkList
- ; let nest_env = env { tcs_ev_binds = ref
+ ; let nest_env = env { tcs_ev_binds = ev_binds_var
, tcs_inerts = new_inert_var
, tcs_worklist = new_wl_var }
; res <- TcM.setTcLevel inner_tclvl $
@@ -1306,7 +1255,7 @@ nestImplicTcS ref inner_tclvl (TcS thing_inside)
#if defined(DEBUG)
-- Perform a check that the thing_inside did not cause cycles
- ; ev_binds <- TcM.getTcEvBindsMap ref
+ ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var
; checkForCyclicBinds ev_binds
#endif
; return res }
=====================================
compiler/GHC/Tc/Solver/Solve.hs
=====================================
@@ -260,6 +260,11 @@ more meaningful error message (see T19627)
This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field.
-}
+{- ********************************************************************************
+* *
+* Solving implication constraints *
+* *
+******************************************************************************** -}
solveNestedImplications :: Bag Implication
-> TcS (Bag Implication)
@@ -280,7 +285,22 @@ solveNestedImplications implics
; return unsolved_implics }
+{- Note [trySolveImplication]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+`trySolveImplication` may be invoked while solving simple wanteds, notably from
+`solveWantedForAll`. It returns a Bool to say if solving succeeded or failed.
+
+It used `nestImplicTcS` to build a nested scope. One subtle point is that
+`nestImplicTcS` uses the `inert_givens` (not the `inert_cans`) of the current
+inert set to initialse the `InertSet` of the nested scope. It super-important not
+to pollute the sub-solving problem with the unsolved Wanteds of the current scope.
+
+Whenever we do `solveSimpleGivens`, we snapshot the `inert_cans` into `inert_givens`.
+(At that moment there should be no Wanteds.)
+-}
+
trySolveImplication :: Implication -> TcS Bool
+-- See Note [trySolveImplication]
trySolveImplication (Implic { ic_tclvl = tclvl
, ic_binds = ev_binds_var
, ic_given = given_ids
@@ -977,6 +997,7 @@ solveSimpleGivens givens
-- Capture the Givens in the inert_givens of the inert set
-- for use by subsequent calls of nestImplicTcS
+ -- See Note [trySolveImplication]
; updInertSet (\is -> is { inert_givens = inert_cans is })
; cans <- getInertCans
@@ -1368,6 +1389,8 @@ solveWantedForAll qci tvs theta body_pred
, unitBag (mkNonCanonical $ CtWanted wanted_ev)) }
; traceTcS "solveForAll {" (ppr skol_tvs $$ ppr given_ev_vars $$ ppr wanteds $$ ppr w_id)
+
+ -- Try to solve the constraint completely
; ev_binds_var <- TcS.newTcEvBinds
; solved <- trySolveImplication $
(implicationPrototype loc_env)
@@ -1381,9 +1404,13 @@ solveWantedForAll qci tvs theta body_pred
; traceTcS "solveForAll }" (ppr solved)
; evbs <- TcS.getTcEvBindsMap ev_binds_var
; if not solved
- then do { addInertForAll qci
+ then do { -- Not completely solved; abandon that attempt and add the
+ -- original constraint to the inert set
+ addInertForAll qci
; stopWith (CtWanted wtd) "Wanted forall-constraint:unsolved" }
- else do { setWantedEvTerm dest EvCanonical $
+
+ else do { -- Completely solved; build an evidence terms
+ setWantedEvTerm dest EvCanonical $
EvFun { et_tvs = skol_tvs, et_given = given_ev_vars
, et_binds = evBindMapBinds evbs, et_body = w_id }
; stopWith (CtWanted wtd) "Wanted forall-constraint:solved" } }
@@ -1404,36 +1431,68 @@ solveWantedForAll qci tvs theta body_pred
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Solving a wanted forall (quantified) constraint
[W] df :: forall a b. (Eq a, Ord b) => C x a b
-is delightfully easy. Just build an implication constraint
+is delightfully easy in principle. Just build an implication constraint
forall ab. (g1::Eq a, g2::Ord b) => [W] d :: C x a
and discharge df thus:
df = /\ab. \g1 g2. let <binds> in d
where <binds> is filled in by solving the implication constraint.
All the machinery is to hand; there is little to do.
-We can take a more straightforward parth when there is a matching Given, e.g.
- [W] dg :: forall c d. (Eq c, Ord d) => C x c d
-In this case, it's better to directly solve the Wanted from the Given, instead
-of building an implication. This is more than a simple optimisation; see
-Note [Solving Wanted QCs from Given QCs].
+There are some tricky corners though:
+
+(WFA1) We can take a more straightforward parth when there is a matching Given, e.g.
+ [W] dg :: forall c d. (Eq c, Ord d) => C x c d
+ In this case, it's better to directly solve the Wanted from the Given, instead
+ of building an implication. This is more than a simple optimisation; see
+ Note [Solving Wanted QCs from Given QCs].
+
+(WFA2) Termination: see #19690. We want to maintain the invariant (QC-INV):
+
+ (QC-INV) Every quantified constraint returns a non-bottom dictionary
+
+ just as every top-level instance declaration guarantees to return a non-bottom
+ dictionary. But as #19690 shows, it is possible to get a bottom dicionary
+ by superclass selection if we aren't careful. The situation is very similar
+ to that described in Note [Recursive superclasses] in GHC.Tc.TyCl.Instance;
+ and we use the same solution:
+
+ * Give the Givens a CtOrigin of (GivenOrigin (InstSkol IsQC head_size))
+ * Give the Wanted a CtOrigin of (ScOrigin IsQC NakedSc)
+
+ Both of these things are done in solveForAll. Now the mechanism described
+ in Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance takes over.
+
+(WFA3) We do not actually emit an implication to solve later. Rather we
+ try to solve it completely immediately using `trySolveImplication`
+ - If successful, we can build evidence
+ - If unsuccessful, we abandon the attempt and add the unsolved
+ forall-constraint to the inert set.
+ Several reasons for this "solve immediately" approach
-The tricky point is about termination: see #19690. We want to maintain
-the invariant (QC-INV):
+ - It saves quite a bit of plumbing, tracking the emitted implications for
+ later solving; and the evidence would have to contain as-yet-incomplte
+ bindings which complicates tracking of unused Givens.
- (QC-INV) Every quantified constraint returns a non-bottom dictionary
+ - We get better error messages, about failing to solve, say
+ (forall a. a->a) ~ (forall b. b->Int)
-just as every top-level instance declaration guarantees to return a non-bottom
-dictionary. But as #19690 shows, it is possible to get a bottom dicionary
-by superclass selection if we aren't careful. The situation is very similar
-to that described in Note [Recursive superclasses] in GHC.Tc.TyCl.Instance;
-and we use the same solution:
+ - Consider
+ f :: forall f a. (Ix a, forall x. Eq x => Eq (f x)) => a -> f a
+ {-# SPECIALISE f :: forall f. (forall x. Eq x => Eq (f x)) => Int -> f Int #-}
+ This SPECIALISE is treated like an expression with a type signature, so
+ we instantiate the constraints, simplify them and re-generalise. From the
+ instantaiation we get [W] d :: (forall x. Eq a => Eq (f x))
+ and we want to generalise over that. We do not want to attempt to solve it
+ and them get stuck, and emit an error message. If we can't solve it, better
+ to leave it alone
-* Give the Givens a CtOrigin of (GivenOrigin (InstSkol IsQC head_size))
-* Give the Wanted a CtOrigin of (ScOrigin IsQC NakedSc)
+ We still need to simplify quantified constraints that can be
+ /fully solved/ from instances, otherwise we would never be able to
+ specialise them away. Example: {-# SPECIALISE f @[] @a #-}.
-Both of these things are done in solveForAll. Now the mechanism described
-in Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance takes over.
+ You might worry about the wasted work, but it is seldom repeated (because the
+ constraint solver seldom iterates much).
Note [Solving a Given forall-constraint]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a729a7c6e96bd24724f3605adb96fb…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a729a7c6e96bd24724f3605adb96fb…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T23109] 5 commits: Implement unary classes
by Simon Peyton Jones (＠simonpj) 28 Jun '25
by Simon Peyton Jones (＠simonpj) 28 Jun '25
28 Jun '25
Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC
Commits:
39f6451f by Simon Peyton Jones at 2025-06-28T15:36:09+01:00
Implement unary classes
The big change is described exhaustively in
Note [Unary class magic] in GHC.Core.TyCon
Other changes
* We never unbox class dictionaries in worker/wrapper. This has been true for some
time now, but the logic is now centralised in functions in
GHC.Core.Opt.WorkWrap.Utils, namely `canUnboxTyCon`, and `canUnboxArg`
See Note [Do not unbox class dictionaries] in GHC.Core.Opt.WorkWrap.Utils.
* Refactored the `notWorthFloating` logic in GHc.Core.Opt.SetLevels.
I can't remember if I actually changed any behaviour here, but if so it's
only in a corner cases.
* Fixed a bug in `GHC.Core.TyCon.isEnumerationTyCon`, which was wrongly returning
True for (##).
* Remove redundant Role argument to `liftCoSubstWithEx`. It was always
Representational.
* I refactored evidence generation in the constraint solver:
* Made GHC.Tc.Types.Evidence contain better abstactions for evidence
generation.
* I deleted the file `GHC.Tc.Types.EvTerm` and merged its (small) contents
elsewhere. It wasn't paying its way.
* Made evidence for implicit parameters go via a proper abstraction.
Smaller things
* Rename `isDataTyCon` to `isBoxedDataTyCon`.
* GHC.Core.Corecion.liftCoSubstWithEx was only called with Representational role,
so I baked that into the function and removed the argument.
* Get rid of `GHC.Core.TyCon.tyConSingleAlgDataCon_maybe` in favour of calling
`not isNewTyCon` at the call sites; more explicit.
* Refatored `GHC.Core.TyCon.isInjectiveTyCon`; but I don't think I changed its
behaviour
* Moved `decomposeIPPred` to GHC.Core.Predicate
Compile time performance changes:
geo. mean +0.1%
minimum -6.8%
maximum +14.4%
The +14% one is in T21839c, where it seems that a bit more inlining
is taking place. That seems acceptable; and the average change is small
Metric Decrease:
LargeRecord
T12227
T16577
T21839r
T5642
Metric Increase:
T15164
T21839c
T5321FD
T5321Fun
WWRec
- - - - -
ea6a8dda by Simon Peyton Jones at 2025-06-28T15:36:43+01:00
Renaming around predicate types
.. we were (as it turned out) abstracting over
type-class selectors in SPECIALISATION rules!
- - - - -
1cd6455d by Simon Peyton Jones at 2025-06-28T15:36:43+01:00
Small hacky fix to specUnfolding
...just using mkApps instead of mkCoreApps
(This part is likely to change again in a
future commit.)
- - - - -
5f4d1bbe by Simon Peyton Jones at 2025-06-28T15:36:43+01:00
Slight improvement to pre/postInlineUnconditionally
Avoids an extra simplifier iteration
- - - - -
8e9b33f1 by Simon Peyton Jones at 2025-06-28T15:36:43+01:00
Accept GHCi debugger output change
@alt-romes says this is fine
- - - - -
90 changed files:
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Core/Class.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/Call.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- − compiler/GHC/Tc/Types/EvTerm.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Types/Var.hs
- compiler/ghc.cabal.in
- testsuite/tests/core-to-stg/T24124.stderr
- testsuite/tests/deSugar/should_compile/T2431.stderr
- testsuite/tests/dmdanal/should_compile/T16029.stdout
- testsuite/tests/dmdanal/sigs/T21119.stderr
- testsuite/tests/dmdanal/sigs/T21888.stderr
- testsuite/tests/ghci.debugger/scripts/break011.stdout
- testsuite/tests/ghci.debugger/scripts/break024.stdout
- testsuite/tests/indexed-types/should_compile/T2238.hs
- testsuite/tests/numeric/should_compile/T15547.stderr
- testsuite/tests/numeric/should_compile/T23907.stderr
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/simplCore/should_compile/DataToTagFamilyScrut.stderr
- testsuite/tests/simplCore/should_compile/T15205.stderr
- testsuite/tests/simplCore/should_compile/T17366.stderr
- testsuite/tests/simplCore/should_compile/T17966.stderr
- testsuite/tests/simplCore/should_compile/T22309.stderr
- testsuite/tests/simplCore/should_compile/T22375DataFamily.stderr
- testsuite/tests/simplCore/should_compile/T23307.stderr
- testsuite/tests/simplCore/should_compile/T23307a.stderr
- testsuite/tests/simplCore/should_compile/T25389.stderr
- testsuite/tests/simplCore/should_compile/T25713.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplStg/should_compile/T15226b.stderr
- testsuite/tests/tcplugins/CtIdPlugin.hs
- testsuite/tests/typecheck/should_compile/Makefile
- testsuite/tests/typecheck/should_compile/T12763.stderr
- testsuite/tests/typecheck/should_compile/T14774.stdout
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/unboxedsums/unpack_sums_7.stdout
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9589a3a6d13f63a4c87a6accee3ab1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9589a3a6d13f63a4c87a6accee3ab1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T23109] 16 commits: template-haskell: improve changelog
by Simon Peyton Jones (＠simonpj) 28 Jun '25
by Simon Peyton Jones (＠simonpj) 28 Jun '25
28 Jun '25
Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC
Commits:
4b748a99 by Teo Camarasu at 2025-06-24T15:31:07-04:00
template-haskell: improve changelog
stable -> more stable, just to clarify that this interface isn't fully stable.
errornously -> mistakenly: I typod this and also let's go for a simpler word
- - - - -
e358e477 by Sylvain Henry at 2025-06-24T15:31:58-04:00
Bump stack resolver to use GHC 9.6.7
Cf #26139
- - - - -
4bf5eb63 by fendor at 2025-06-25T17:05:43-04:00
Teach `:reload` about multiple home units
`:reload` needs to lookup the `ModuleName` and must not assume the given
`ModuleName` is in the current `HomeUnit`.
We add a new utility function which allows us to find a `HomeUnitModule`
instead of a `Module`.
Further, we introduce the `GhciCommandError` type which can be used to
abort the execution of a GHCi command.
This error is caught and printed in a human readable fashion.
- - - - -
b3d97bb3 by fendor at 2025-06-25T17:06:25-04:00
Implement `-fno-load-initial-targets` flag
We add the new flag `-fno-load-initial-targets` which doesn't load all `Target`s
immediately but only computes the module graph for all `Target`s.
The user can then decide to load modules from that module graph using
the syntax:
ghci> :reload <Mod>
This will load everything in the module graph up to `Mod`.
The user can return to the initial state by using the builtin target
`none` to unload all modules.
ghci> :reload none
Is in principle identical to starting a new session with the
`-fno-load-initial-targets` flag.
The `-fno-load-initial-targets` flag allows for faster startup time of GHCi when a
user has lots of `Target`s.
We additionally extend the `:reload` command to accept multiple
`ModuleName`s. For example:
ghci> :reload <Mod1> <Mod2>
Loads all modules up to the modules `Mod1` and `Mod2`.
- - - - -
49f44e52 by Teo Camarasu at 2025-06-26T04:19:51-04:00
Expose ghc-internal unit id through the settings file
This in combination with the unit id of the compiler library allows
cabal to know of the two unit ids that should not be reinstalled (in
specific circumstances) as:
- when using plugins, we want to link against exactly the compiler unit
id
- when using TemplateHaskell we want to link against exactly the package
that contains the TemplateHaskell interfaces, which is `ghc-internal`
See: <https://github.com/haskell/cabal/issues/10087>
Resolves #25282
- - - - -
499c4efe by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Fix and clean up capture of timings
* Fixes the typo that caused 'cat ci-timings' to report "no such file or
directory"
* Gave ci_timings.txt a file extension so it may play better with other
systems
* Fixed the use of time_it so all times are recorded
* Fixed time_it to print name along with timing
- - - - -
86c90c9e by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Update collapsible section usage
The syntax apparently changed at some point.
- - - - -
04308ee4 by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Add more collapsible sections
- - - - -
43b606bb by Florian Ragwitz at 2025-06-27T16:31:26-04:00
Tick uses of wildcard/pun field binds as if using the record selector function
Fixes #17834.
See Note [Record-selector ticks] for additional reasoning behind this as well
as an overview of the implementation details and future improvements.
- - - - -
d4952549 by Ben Gamari at 2025-06-27T16:32:08-04:00
testsuite/caller-cc: Make CallerCc[123] less sensitive
These were previously sensitive to irrelevant changes in program
structure. To avoid this we filter out all by lines emitted by the
-fcaller-cc from the profile.
- - - - -
173fa540 by Simon Peyton Jones at 2025-06-28T15:25:10+01:00
Make injecting implicit bindings into its own pass
Previously we were injecting "impliicit bindings" (data constructor
worker and wrappers etc)
- both at the end of CoreTidy,
- and at the start of CorePrep
This is unpleasant and confusing. This patch puts it it its own pass,
addImplicitBinds, which runs between the two.
The function `GHC.CoreToStg.AddImplicitBinds.addImplicitBinds` now takes /all/
TyCons, not just the ones for algebraic data types. That change ripples
through to
- corePrepPgm
- doCodeGen
- byteCodeGen
All take [TyCon] which includes all TyCons
- - - - -
a2d3dde8 by Simon Peyton Jones at 2025-06-28T15:25:10+01:00
Implement unary classes
The big change is described exhaustively in
Note [Unary class magic] in GHC.Core.TyCon
Other changes
* We never unbox class dictionaries in worker/wrapper. This has been true for some
time now, but the logic is now centralised in functions in
GHC.Core.Opt.WorkWrap.Utils, namely `canUnboxTyCon`, and `canUnboxArg`
See Note [Do not unbox class dictionaries] in GHC.Core.Opt.WorkWrap.Utils.
* Refactored the `notWorthFloating` logic in GHc.Core.Opt.SetLevels.
I can't remember if I actually changed any behaviour here, but if so it's
only in a corner cases.
* Fixed a bug in `GHC.Core.TyCon.isEnumerationTyCon`, which was wrongly returning
True for (##).
* Remove redundant Role argument to `liftCoSubstWithEx`. It was always
Representational.
* I refactored evidence generation in the constraint solver:
* Made GHC.Tc.Types.Evidence contain better abstactions for evidence
generation.
* I deleted the file `GHC.Tc.Types.EvTerm` and merged its (small) contents
elsewhere. It wasn't paying its way.
* Made evidence for implicit parameters go via a proper abstraction.
Smaller things
* Rename `isDataTyCon` to `isBoxedDataTyCon`.
* GHC.Core.Corecion.liftCoSubstWithEx was only called with Representational role,
so I baked that into the function and removed the argument.
* Get rid of `GHC.Core.TyCon.tyConSingleAlgDataCon_maybe` in favour of calling
`not isNewTyCon` at the call sites; more explicit.
* Refatored `GHC.Core.TyCon.isInjectiveTyCon`; but I don't think I changed its
behaviour
* Moved `decomposeIPPred` to GHC.Core.Predicate
- - - - -
50fa8426 by Simon Peyton Jones at 2025-06-28T15:32:48+01:00
Renaming around predicate types
.. we were (as it turned out) abstracting over
type-class selectors in SPECIALISATION rules!
- - - - -
57898657 by Simon Peyton Jones at 2025-06-28T15:32:48+01:00
Small hacky fix to specUnfolding
...just using mkApps instead of mkCoreApps
(This part is likely to change again in a
future commit.)
- - - - -
16b0bd0c by Simon Peyton Jones at 2025-06-28T15:32:48+01:00
Slight improvement to pre/postInlineUnconditionally
Avoids an extra simplifier iteration
- - - - -
9589a3a6 by Simon Peyton Jones at 2025-06-28T15:32:48+01:00
Accept GHCi debugger output change
@alt-romes says this is fine
- - - - -
159 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/common.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/ByteCode/InfoTable.hs
- compiler/GHC/Core/Class.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg.hs
- + compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/Call.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- − compiler/GHC/Tc/Types/EvTerm.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Types/TyThing.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/Setup.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Exception.hs
- ghc/GHCi/UI/Print.hs
- hadrian/src/Rules/Generate.hs
- hadrian/stack.yaml
- hadrian/stack.yaml.lock
- libraries/template-haskell/changelog.md
- testsuite/tests/core-to-stg/T24124.stderr
- testsuite/tests/deSugar/should_compile/T2431.stderr
- testsuite/tests/dmdanal/should_compile/T16029.stdout
- testsuite/tests/dmdanal/sigs/T21119.stderr
- testsuite/tests/dmdanal/sigs/T21888.stderr
- testsuite/tests/ghc-e/should_fail/T18441fail5.stderr
- testsuite/tests/ghci.debugger/scripts/break011.stdout
- testsuite/tests/ghci.debugger/scripts/break024.stdout
- testsuite/tests/ghci/prog-mhu003/prog-mhu003.stderr
- testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stderr
- + testsuite/tests/ghci/prog-mhu005/Makefile
- + testsuite/tests/ghci/prog-mhu005/a/A.hs
- + testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/b/B.hs
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stdout
- + testsuite/tests/ghci/prog-mhu005/unitA
- + testsuite/tests/ghci/prog-mhu005/unitB
- + testsuite/tests/ghci/prog021/A.hs
- + testsuite/tests/ghci/prog021/B.hs
- + testsuite/tests/ghci/prog021/Makefile
- + testsuite/tests/ghci/prog021/all.T
- + testsuite/tests/ghci/prog021/prog021a.script
- + testsuite/tests/ghci/prog021/prog021a.stderr
- + testsuite/tests/ghci/prog021/prog021a.stdout
- + testsuite/tests/ghci/prog021/prog021b.script
- + testsuite/tests/ghci/prog021/prog021b.stderr
- + testsuite/tests/ghci/prog021/prog021b.stdout
- + testsuite/tests/ghci/prog022/A.hs
- + testsuite/tests/ghci/prog022/B.hs
- + testsuite/tests/ghci/prog022/Makefile
- + testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022a.script
- + testsuite/tests/ghci/prog022/ghci.prog022a.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022a.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022b.script
- + testsuite/tests/ghci/prog022/ghci.prog022b.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022b.stdout
- testsuite/tests/ghci/scripts/ghci021.stderr
- + testsuite/tests/hpc/recsel/Makefile
- + testsuite/tests/hpc/recsel/recsel.hs
- + testsuite/tests/hpc/recsel/recsel.stdout
- + testsuite/tests/hpc/recsel/test.T
- testsuite/tests/indexed-types/should_compile/T2238.hs
- testsuite/tests/numeric/should_compile/T15547.stderr
- testsuite/tests/numeric/should_compile/T23907.stderr
- testsuite/tests/profiling/should_run/caller-cc/all.T
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/simplCore/should_compile/DataToTagFamilyScrut.stderr
- testsuite/tests/simplCore/should_compile/T15205.stderr
- testsuite/tests/simplCore/should_compile/T17366.stderr
- testsuite/tests/simplCore/should_compile/T17966.stderr
- testsuite/tests/simplCore/should_compile/T22309.stderr
- testsuite/tests/simplCore/should_compile/T22375DataFamily.stderr
- testsuite/tests/simplCore/should_compile/T23307.stderr
- testsuite/tests/simplCore/should_compile/T23307a.stderr
- testsuite/tests/simplCore/should_compile/T25389.stderr
- testsuite/tests/simplCore/should_compile/T25713.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplStg/should_compile/T15226b.stderr
- testsuite/tests/tcplugins/CtIdPlugin.hs
- testsuite/tests/typecheck/should_compile/Makefile
- testsuite/tests/typecheck/should_compile/T12763.stderr
- testsuite/tests/typecheck/should_compile/T14774.stdout
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/unboxedsums/unpack_sums_7.stdout
- testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs
- testsuite/tests/wasm/should_run/control-flow/RunWasm.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99ef3a43e3e6df491526890edf8dc6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99ef3a43e3e6df491526890edf8dc6…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26115] Crucial fix to short-cut solving
by Simon Peyton Jones (＠simonpj) 28 Jun '25
by Simon Peyton Jones (＠simonpj) 28 Jun '25
28 Jun '25
Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC
Commits:
a729a7c6 by Simon Peyton Jones at 2025-06-28T13:20:06+01:00
Crucial fix to short-cut solving
noMatchableGivenDict should take account of TcSShortCut
- - - - -
1 changed file:
- compiler/GHC/Tc/Solver/Dict.hs
Changes:
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -807,7 +807,8 @@ try_instances inerts work_item@(DictCt { di_ev = ev, di_cls = cls
| otherwise -- Wanted, but not cached
= do { dflags <- getDynFlags
- ; lkup_res <- matchClassInst dflags inerts cls xis dict_loc
+ ; mode <- getTcSMode
+ ; lkup_res <- matchClassInst dflags mode inerts cls xis dict_loc
; case lkup_res of
OneInst { cir_what = what }
-> do { let is_local_given = case what of { LocalInstance -> True; _ -> False }
@@ -865,10 +866,10 @@ checkInstanceOK loc what pred
| otherwise
= loc
-matchClassInst :: DynFlags -> InertSet
+matchClassInst :: DynFlags -> TcSMode -> InertSet
-> Class -> [Type]
-> CtLoc -> TcS ClsInstResult
-matchClassInst dflags inerts clas tys loc
+matchClassInst dflags mode inerts clas tys loc
-- First check whether there is an in-scope Given that could
-- match this constraint. In that case, do not use any instance
-- whether top level, or local quantified constraints.
@@ -879,7 +880,7 @@ matchClassInst dflags inerts clas tys loc
-- It is always safe to unpack constraint tuples
-- And if we don't do so, we may never solve it at all
-- See Note [Solving tuple constraints]
- , not (noMatchableGivenDicts inerts loc clas tys)
+ , not (noMatchableGivenDicts mode inerts loc clas tys)
= do { traceTcS "Delaying instance application" $
vcat [ text "Work item:" <+> pprClassPred clas tys ]
; return NotSure }
@@ -910,8 +911,11 @@ matchClassInst dflags inerts clas tys loc
-- potentially, match the given class constraint. This is used when checking to see if a
-- Given might overlap with an instance. See Note [Instance and Given overlap]
-- in GHC.Tc.Solver.Dict
-noMatchableGivenDicts :: InertSet -> CtLoc -> Class -> [TcType] -> Bool
-noMatchableGivenDicts inerts@(IS { inert_cans = inert_cans }) loc_w clas tys
+noMatchableGivenDicts :: TcSMode -> InertSet -> CtLoc -> Class -> [TcType] -> Bool
+noMatchableGivenDicts mode inerts@(IS { inert_cans = inert_cans }) loc_w clas tys
+ | TcSShortCut <- mode
+ = True -- In TcSShortCut mode we behave as if there were no Givens at all
+ | otherwise
= not $ anyBag matchable_given $
findDictsByClass (inert_dicts inert_cans) clas
where
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a729a7c6e96bd24724f3605adb96fb1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a729a7c6e96bd24724f3605adb96fb1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] testsuite/caller-cc: Make CallerCc[123] less sensitive
by Marge Bot (＠marge-bot) 27 Jun '25
by Marge Bot (＠marge-bot) 27 Jun '25
27 Jun '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d4952549 by Ben Gamari at 2025-06-27T16:32:08-04:00
testsuite/caller-cc: Make CallerCc[123] less sensitive
These were previously sensitive to irrelevant changes in program
structure. To avoid this we filter out all by lines emitted by the
-fcaller-cc from the profile.
- - - - -
1 changed file:
- testsuite/tests/profiling/should_run/caller-cc/all.T
Changes:
=====================================
testsuite/tests/profiling/should_run/caller-cc/all.T
=====================================
@@ -8,6 +8,7 @@ setTestOpts(only_ways(prof_ways))
setTestOpts(extra_files(['Main.hs']))
setTestOpts(extra_run_opts('7'))
setTestOpts(grep_prof("Main.hs"))
+setTestOpts(grep_prof("calling:"))
# N.B. Main.hs is stolen from heapprof001.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d495254997e5d0b7b2a16a00fed05ed…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d495254997e5d0b7b2a16a00fed05ed…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Tick uses of wildcard/pun field binds as if using the record selector function
by Marge Bot (＠marge-bot) 27 Jun '25
by Marge Bot (＠marge-bot) 27 Jun '25
27 Jun '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
43b606bb by Florian Ragwitz at 2025-06-27T16:31:26-04:00
Tick uses of wildcard/pun field binds as if using the record selector function
Fixes #17834.
See Note [Record-selector ticks] for additional reasoning behind this as well
as an overview of the implementation details and future improvements.
- - - - -
6 changed files:
- compiler/GHC/HsToCore/Ticks.hs
- docs/users_guide/9.14.1-notes.rst
- + testsuite/tests/hpc/recsel/Makefile
- + testsuite/tests/hpc/recsel/recsel.hs
- + testsuite/tests/hpc/recsel/recsel.stdout
- + testsuite/tests/hpc/recsel/test.T
Changes:
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -1,12 +1,11 @@
-{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE NondecreasingIndentation #-}
-{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-
(c) Galois, 2006
(c) University of Glasgow, 2007
+(c) Florian Ragwitz, 2025
-}
module GHC.HsToCore.Ticks
@@ -38,7 +37,9 @@ import GHC.Utils.Logger
import GHC.Types.SrcLoc
import GHC.Types.Basic
import GHC.Types.Id
+import GHC.Types.Id.Info
import GHC.Types.Var.Set
+import GHC.Types.Var.Env
import GHC.Types.Name.Set hiding (FreeVars)
import GHC.Types.Name
import GHC.Types.CostCentre
@@ -48,6 +49,7 @@ import GHC.Types.ProfAuto
import Control.Monad
import Data.List (isSuffixOf, intersperse)
+import Data.Foldable (toList)
import Trace.Hpc.Mix
@@ -123,6 +125,7 @@ addTicksToBinds logger cfg
, density = mkDensity tickish $ ticks_profAuto cfg
, this_mod = mod
, tickishType = tickish
+ , recSelBinds = emptyVarEnv
}
(binds',_,st') = unTM (addTickLHsBinds binds) env st
in (binds', st')
@@ -224,8 +227,7 @@ addTickLHsBind :: LHsBind GhcTc -> TM (LHsBind GhcTc)
addTickLHsBind (L pos (XHsBindsLR bind@(AbsBinds { abs_binds = binds
, abs_exports = abs_exports
}))) =
- withEnv add_exports $
- withEnv add_inlines $ do
+ withEnv (add_rec_sels . add_inlines . add_exports) $ do
binds' <- addTickLHsBinds binds
return $ L pos $ XHsBindsLR $ bind { abs_binds = binds' }
where
@@ -247,6 +249,12 @@ addTickLHsBind (L pos (XHsBindsLR bind@(AbsBinds { abs_binds = binds
| ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports
, isInlinePragma (idInlinePragma pid) ] }
+ add_rec_sels env =
+ env{ recSelBinds = recSelBinds env `extendVarEnvList`
+ [ (abe_mono, abe_poly)
+ | ABE{ abe_poly, abe_mono } <- abs_exports
+ , RecSelId{} <- [idDetails abe_poly] ] }
+
addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches }))) = do
let name = getOccString id
decl_path <- getPathEntry
@@ -261,6 +269,10 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches
tickish <- tickishType `liftM` getEnv
case tickish of { ProfNotes | inline -> return (L pos funBind); _ -> do
+ -- See Note [Record-selector ticks]
+ selTick <- recSelTick id
+ case selTick of { Just tick -> tick_rec_sel tick; _ -> do
+
(fvs, mg) <-
getFreeVars $
addPathEntry name $
@@ -288,7 +300,40 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches
let mbCons = maybe Prelude.id (:)
return $ L pos $ funBind { fun_matches = mg
, fun_ext = second (tick `mbCons`) (fun_ext funBind) }
- }
+ } }
+ where
+ -- See Note [Record-selector ticks]
+ tick_rec_sel tick =
+ pure $ L pos $ funBind { fun_ext = second (tick :) (fun_ext funBind) }
+
+
+-- Note [Record-selector ticks]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Users expect (see #17834) that accessing a record field by its name using
+-- NamedFieldPuns or RecordWildCards will mark it as covered. This is very
+-- reasonable, because otherwise the use of those two language features will
+-- produce unnecessary noise in coverage reports, distracting from real
+-- coverage problems.
+--
+-- Because of that, GHC chooses to treat record selectors specially for
+-- coverage purposes to improve the developer experience.
+--
+-- This is done by keeping track of which 'Id's are effectively bound to
+-- record fields (using NamedFieldPuns or RecordWildCards) in 'TickTransEnv's
+-- 'recSelBinds', and making 'HsVar's corresponding to those fields tick the
+-- appropriate box when executed.
+--
+-- To enable that, we also treat 'FunBind's for record selector functions
+-- specially. We only create a TopLevelBox for the record selector function,
+-- skipping the ExpBox that'd normally be created. This simplifies the re-use
+-- of ticks for the same record selector, and is done by not recursing into
+-- the fun_matches match group for record selector functions.
+--
+-- This scheme could be extended further in the future, making coverage for
+-- constructor fields (named or even positional) mean that the field was
+-- accessed at run-time. For the time being, we only cover NamedFieldPuns and
+-- RecordWildCards binds to cover most practical use-cases while keeping it
+-- simple.
-- TODO: Revisit this
addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs
@@ -471,7 +516,10 @@ addBinTickLHsExpr boxLabel e@(L pos e0)
-- in the addTickLHsExpr family of functions.)
addTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc)
-addTickHsExpr e@(HsVar _ (L _ id)) = do freeVar id; return e
+-- See Note [Record-selector ticks]
+addTickHsExpr e@(HsVar _ (L _ id)) =
+ freeVar id >> recSelTick id >>= pure . maybe e wrap
+ where wrap tick = XExpr . HsTick tick . noLocA $ e
addTickHsExpr e@(HsIPVar {}) = return e
addTickHsExpr e@(HsOverLit {}) = return e
addTickHsExpr e@(HsOverLabel{}) = return e
@@ -532,7 +580,7 @@ addTickHsExpr (HsMultiIf ty alts)
; alts' <- mapM (traverse $ addTickGRHS isOneOfMany False False) alts
; return $ HsMultiIf ty alts' }
addTickHsExpr (HsLet x binds e) =
- bindLocals (collectLocalBinders CollNoDictBinders binds) $ do
+ bindLocals binds $ do
binds' <- addTickHsLocalBinds binds -- to think about: !patterns.
e' <- addTickLHsExprLetBody e
return (HsLet x binds' e')
@@ -580,6 +628,7 @@ addTickHsExpr e@(HsUntypedSplice{}) = return e
addTickHsExpr e@(HsGetField {}) = return e
addTickHsExpr e@(HsProjection {}) = return e
addTickHsExpr (HsProc x pat cmdtop) =
+ bindLocals pat $
liftM2 (HsProc x)
(addTickLPat pat)
(traverse (addTickHsCmdTop) cmdtop)
@@ -646,19 +695,17 @@ addTickMatch :: Bool -> Bool -> Bool {-Is this Do Expansion-} -> Match GhcTc (L
-> TM (Match GhcTc (LHsExpr GhcTc))
addTickMatch isOneOfMany isLambda isDoExp match@(Match { m_pats = L _ pats
, m_grhss = gRHSs }) =
- bindLocals (collectPatsBinders CollNoDictBinders pats) $ do
+ bindLocals pats $ do
gRHSs' <- addTickGRHSs isOneOfMany isLambda isDoExp gRHSs
return $ match { m_grhss = gRHSs' }
addTickGRHSs :: Bool -> Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)
-> TM (GRHSs GhcTc (LHsExpr GhcTc))
addTickGRHSs isOneOfMany isLambda isDoExp (GRHSs x guarded local_binds) =
- bindLocals binders $ do
+ bindLocals local_binds $ do
local_binds' <- addTickHsLocalBinds local_binds
guarded' <- mapM (traverse (addTickGRHS isOneOfMany isLambda isDoExp)) guarded
return $ GRHSs x guarded' local_binds'
- where
- binders = collectLocalBinders CollNoDictBinders local_binds
addTickGRHS :: Bool -> Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc)
-> TM (GRHS GhcTc (LHsExpr GhcTc))
@@ -697,7 +744,7 @@ addTickLStmts isGuard stmts = do
addTickLStmts' :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt GhcTc] -> TM a
-> TM ([ExprLStmt GhcTc], a)
addTickLStmts' isGuard lstmts res
- = bindLocals (collectLStmtsBinders CollNoDictBinders lstmts) $
+ = bindLocals lstmts $
do { lstmts' <- mapM (traverse (addTickStmt isGuard)) lstmts
; a <- res
; return (lstmts', a) }
@@ -710,6 +757,7 @@ addTickStmt _isGuard (LastStmt x e noret ret) =
(pure noret)
(addTickSyntaxExpr hpcSrcSpan ret)
addTickStmt _isGuard (BindStmt xbs pat e) =
+ bindLocals pat $
liftM4 (\b f -> BindStmt $ XBindStmtTc
{ xbstc_bindOp = b
, xbstc_boundResultType = xbstc_boundResultType xbs
@@ -770,17 +818,19 @@ addTickApplicativeArg isGuard (op, arg) =
liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg)
where
addTickArg (ApplicativeArgOne m_fail pat expr isBody) =
- ApplicativeArgOne
- <$> mapM (addTickSyntaxExpr hpcSrcSpan) m_fail
- <*> addTickLPat pat
- <*> addTickLHsExpr expr
- <*> pure isBody
+ bindLocals pat $
+ ApplicativeArgOne
+ <$> mapM (addTickSyntaxExpr hpcSrcSpan) m_fail
+ <*> addTickLPat pat
+ <*> addTickLHsExpr expr
+ <*> pure isBody
addTickArg (ApplicativeArgMany x stmts ret pat ctxt) =
- (ApplicativeArgMany x)
- <$> addTickLStmts isGuard stmts
- <*> (unLoc <$> addTickLHsExpr (L (noAnnSrcSpan hpcSrcSpan) ret))
- <*> addTickLPat pat
- <*> pure ctxt
+ bindLocals pat $
+ ApplicativeArgMany x
+ <$> addTickLStmts isGuard stmts
+ <*> (unLoc <$> addTickLHsExpr (L (noAnnSrcSpan hpcSrcSpan) ret))
+ <*> addTickLPat pat
+ <*> pure ctxt
addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc
-> TM (ParStmtBlock GhcTc GhcTc)
@@ -871,7 +921,7 @@ addTickHsCmd (HsCmdIf x cnd e1 c2 c3) =
(addTickLHsCmd c2)
(addTickLHsCmd c3)
addTickHsCmd (HsCmdLet x binds c) =
- bindLocals (collectLocalBinders CollNoDictBinders binds) $ do
+ bindLocals binds $ do
binds' <- addTickHsLocalBinds binds -- to think about: !patterns.
c' <- addTickLHsCmd c
return (HsCmdLet x binds' c')
@@ -907,18 +957,16 @@ addTickCmdMatchGroup mg@(MG { mg_alts = (L l matches) }) = do
addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
addTickCmdMatch match@(Match { m_pats = L _ pats, m_grhss = gRHSs }) =
- bindLocals (collectPatsBinders CollNoDictBinders pats) $ do
+ bindLocals pats $ do
gRHSs' <- addTickCmdGRHSs gRHSs
return $ match { m_grhss = gRHSs' }
addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
addTickCmdGRHSs (GRHSs x guarded local_binds) =
- bindLocals binders $ do
+ bindLocals local_binds $ do
local_binds' <- addTickHsLocalBinds local_binds
guarded' <- mapM (traverse addTickCmdGRHS) guarded
return $ GRHSs x guarded' local_binds'
- where
- binders = collectLocalBinders CollNoDictBinders local_binds
addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
-- The *guards* are *not* Cmds, although the body is
@@ -937,15 +985,14 @@ addTickLCmdStmts stmts = do
addTickLCmdStmts' :: [LStmt GhcTc (LHsCmd GhcTc)] -> TM a
-> TM ([LStmt GhcTc (LHsCmd GhcTc)], a)
addTickLCmdStmts' lstmts res
- = bindLocals binders $ do
+ = bindLocals lstmts $ do
lstmts' <- mapM (traverse addTickCmdStmt) lstmts
a <- res
return (lstmts', a)
- where
- binders = collectLStmtsBinders CollNoDictBinders lstmts
addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
addTickCmdStmt (BindStmt x pat c) =
+ bindLocals pat $
liftM2 (BindStmt x)
(addTickLPat pat)
(addTickLHsCmd c)
@@ -1006,11 +1053,13 @@ addTickArithSeqInfo (FromThenTo e1 e2 e3) =
data TickTransState = TT { ticks :: !(SizedSeq Tick)
, ccIndices :: !CostCentreState
+ , recSelTicks :: !(IdEnv CoreTickish)
}
initTTState :: TickTransState
initTTState = TT { ticks = emptySS
, ccIndices = newCostCentreState
+ , recSelTicks = emptyVarEnv
}
addMixEntry :: Tick -> TM Int
@@ -1021,6 +1070,10 @@ addMixEntry ent = do
}
return c
+addRecSelTick :: Id -> CoreTickish -> TM ()
+addRecSelTick sel tick =
+ setState $ \s -> s{ recSelTicks = extendVarEnv (recSelTicks s) sel tick }
+
data TickTransEnv = TTE { fileName :: FastString
, density :: TickDensity
, tte_countEntries :: !Bool
@@ -1033,6 +1086,7 @@ data TickTransEnv = TTE { fileName :: FastString
, blackList :: Set RealSrcSpan
, this_mod :: Module
, tickishType :: TickishType
+ , recSelBinds :: IdEnv Id
}
-- deriving Show
@@ -1154,12 +1208,13 @@ ifGoodTickSrcSpan pos then_code else_code = do
good <- isGoodTickSrcSpan pos
if good then then_code else else_code
-bindLocals :: [Id] -> TM a -> TM a
-bindLocals new_ids (TM m)
- = TM $ \ env st ->
- case m env{ inScope = inScope env `extendVarSetList` new_ids } st of
- (r, fv, st') -> (r, fv `delListFromOccEnv` occs, st')
- where occs = [ nameOccName (idName id) | id <- new_ids ]
+bindLocals :: (CollectBinders bndr, CollectFldBinders bndr) => bndr -> TM a -> TM a
+bindLocals from (TM m) = TM $ \env st ->
+ case m (with_bnds env) st of
+ (r, fv, st') -> (r, fv `delListFromOccEnv` (map (nameOccName . idName) new_bnds), st')
+ where with_bnds e = e{ inScope = inScope e `extendVarSetList` new_bnds
+ , recSelBinds = recSelBinds e `plusVarEnv` collectFldBinds from }
+ new_bnds = collectBinds from
withBlackListed :: SrcSpan -> TM a -> TM a
withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) })
@@ -1186,6 +1241,17 @@ allocTickBox boxLabel countEntries topOnly pos m
tickish <- mkTickish boxLabel countEntries topOnly pos fvs (declPath env)
return (this_loc (XExpr $ HsTick tickish $ this_loc e))
+recSelTick :: Id -> TM (Maybe CoreTickish)
+recSelTick id = ifDensity TickForCoverage maybe_tick (pure Nothing)
+ where
+ maybe_tick = getEnv >>=
+ maybe (pure Nothing) tick . (`lookupVarEnv` id) . recSelBinds
+ tick sel = getState >>=
+ maybe (alloc sel) (pure . Just) . (`lookupVarEnv` sel) . recSelTicks
+ alloc sel = allocATickBox (box sel) False False (getSrcSpan sel) noFVs
+ >>= traverse (\t -> t <$ addRecSelTick sel t)
+ box sel = TopLevelBox [getOccString sel]
+
-- the tick application inherits the source position of its
-- expression argument to support nested box allocations
allocATickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> FreeVars
@@ -1288,3 +1354,98 @@ matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
matchCount :: LMatch GhcTc body -> Int
matchCount (L _ (Match { m_grhss = GRHSs _ grhss _ }))
= length grhss
+
+-- | Convenience class used by 'bindLocals' to collect new bindings from
+-- various parts of he AST. Just delegates to
+-- 'collect{Pat,Pats,Local,LStmts}Binders' from 'GHC.Hs.Utils' as appropriate.
+class CollectBinders a where
+ collectBinds :: a -> [Id]
+
+-- | Variant of 'CollectBinders' which collects information on which locals
+-- are bound to record fields (currently only via 'RecordWildCards' or
+-- 'NamedFieldPuns') to enable better coverage support for record selectors.
+--
+-- See Note [Record-selector ticks].
+class CollectFldBinders a where
+ collectFldBinds :: a -> IdEnv Id
+
+instance CollectBinders (LocatedA (Pat GhcTc)) where
+ collectBinds = collectPatBinders CollNoDictBinders
+instance CollectBinders [LocatedA (Pat GhcTc)] where
+ collectBinds = collectPatsBinders CollNoDictBinders
+instance CollectBinders (HsLocalBinds GhcTc) where
+ collectBinds = collectLocalBinders CollNoDictBinders
+instance CollectBinders [LocatedA (Stmt GhcTc (LocatedA (HsExpr GhcTc)))] where
+ collectBinds = collectLStmtsBinders CollNoDictBinders
+instance CollectBinders [LocatedA (Stmt GhcTc (LocatedA (HsCmd GhcTc)))] where
+ collectBinds = collectLStmtsBinders CollNoDictBinders
+
+instance (CollectFldBinders a) => CollectFldBinders [a] where
+ collectFldBinds = foldr (flip plusVarEnv . collectFldBinds) emptyVarEnv
+instance (CollectFldBinders e) => CollectFldBinders (GenLocated l e) where
+ collectFldBinds = collectFldBinds . unLoc
+instance CollectFldBinders (Pat GhcTc) where
+ collectFldBinds ConPat{ pat_args = RecCon HsRecFields{ rec_flds, rec_dotdot } } =
+ collectFldBinds rec_flds `plusVarEnv` plusVarEnvList (zipWith fld_bnds [0..] rec_flds)
+ where n_explicit | Just (L _ (RecFieldsDotDot n)) <- rec_dotdot = n
+ | otherwise = length rec_flds
+ fld_bnds n (L _ HsFieldBind{ hfbLHS = L _ FieldOcc{ foLabel = L _ sel }
+ , hfbRHS = L _ (VarPat _ (L _ var))
+ , hfbPun })
+ | hfbPun || n >= n_explicit = unitVarEnv var sel
+ fld_bnds _ _ = emptyVarEnv
+ collectFldBinds ConPat{ pat_args = PrefixCon pats } = collectFldBinds pats
+ collectFldBinds ConPat{ pat_args = InfixCon p1 p2 } = collectFldBinds [p1, p2]
+ collectFldBinds (LazyPat _ pat) = collectFldBinds pat
+ collectFldBinds (BangPat _ pat) = collectFldBinds pat
+ collectFldBinds (AsPat _ _ pat) = collectFldBinds pat
+ collectFldBinds (ViewPat _ _ pat) = collectFldBinds pat
+ collectFldBinds (ParPat _ pat) = collectFldBinds pat
+ collectFldBinds (ListPat _ pats) = collectFldBinds pats
+ collectFldBinds (TuplePat _ pats _) = collectFldBinds pats
+ collectFldBinds (SumPat _ pats _ _) = collectFldBinds pats
+ collectFldBinds (SigPat _ pat _) = collectFldBinds pat
+ collectFldBinds (XPat exp) = collectFldBinds exp
+ collectFldBinds VarPat{} = emptyVarEnv
+ collectFldBinds WildPat{} = emptyVarEnv
+ collectFldBinds OrPat{} = emptyVarEnv
+ collectFldBinds LitPat{} = emptyVarEnv
+ collectFldBinds NPat{} = emptyVarEnv
+ collectFldBinds NPlusKPat{} = emptyVarEnv
+ collectFldBinds SplicePat{} = emptyVarEnv
+ collectFldBinds EmbTyPat{} = emptyVarEnv
+ collectFldBinds InvisPat{} = emptyVarEnv
+instance (CollectFldBinders r) => CollectFldBinders (HsFieldBind l r) where
+ collectFldBinds = collectFldBinds . hfbRHS
+instance CollectFldBinders XXPatGhcTc where
+ collectFldBinds (CoPat _ pat _) = collectFldBinds pat
+ collectFldBinds (ExpansionPat _ pat) = collectFldBinds pat
+instance CollectFldBinders (HsLocalBinds GhcTc) where
+ collectFldBinds (HsValBinds _ bnds) = collectFldBinds bnds
+ collectFldBinds HsIPBinds{} = emptyVarEnv
+ collectFldBinds EmptyLocalBinds{} = emptyVarEnv
+instance CollectFldBinders (HsValBinds GhcTc) where
+ collectFldBinds (ValBinds _ bnds _) = collectFldBinds bnds
+ collectFldBinds (XValBindsLR (NValBinds bnds _)) = collectFldBinds (map snd bnds)
+instance CollectFldBinders (HsBind GhcTc) where
+ collectFldBinds PatBind{ pat_lhs } = collectFldBinds pat_lhs
+ collectFldBinds (XHsBindsLR AbsBinds{ abs_exports, abs_binds }) =
+ mkVarEnv [ (abe_poly, sel)
+ | ABE{ abe_poly, abe_mono } <- abs_exports
+ , Just sel <- [lookupVarEnv monos abe_mono] ]
+ where monos = collectFldBinds abs_binds
+ collectFldBinds VarBind{} = emptyVarEnv
+ collectFldBinds FunBind{} = emptyVarEnv
+ collectFldBinds PatSynBind{} = emptyVarEnv
+instance CollectFldBinders (Stmt GhcTc e) where
+ collectFldBinds (BindStmt _ pat _) = collectFldBinds pat
+ collectFldBinds (LetStmt _ bnds) = collectFldBinds bnds
+ collectFldBinds (ParStmt _ xs _ _) = collectFldBinds [s | ParStmtBlock _ ss _ _ <- toList xs, s <- ss]
+ collectFldBinds TransStmt{ trS_stmts } = collectFldBinds trS_stmts
+ collectFldBinds RecStmt{ recS_stmts } = collectFldBinds recS_stmts
+ collectFldBinds (XStmtLR (ApplicativeStmt _ args _)) = collectFldBinds (map snd args)
+ collectFldBinds LastStmt{} = emptyVarEnv
+ collectFldBinds BodyStmt{} = emptyVarEnv
+instance CollectFldBinders (ApplicativeArg GhcTc) where
+ collectFldBinds ApplicativeArgOne{ app_arg_pattern } = collectFldBinds app_arg_pattern
+ collectFldBinds ApplicativeArgMany{ bv_pattern } = collectFldBinds bv_pattern
=====================================
docs/users_guide/9.14.1-notes.rst
=====================================
@@ -138,6 +138,11 @@ Compiler
uses of the now deprecated ``pattern`` namespace specifier in import/export
lists. See `GHC Proposal #581, section 2.3 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0581-n…>`_.
+- Code coverage (:ghc-flag:`-fhpc`) now treats uses of record fields via
+ :extension:`RecordWildCards` or :extension:`NamedFieldPuns` as if the fields
+ were accessed using the generated record selector functions, marking the fields
+ as covered in coverage reports (:ghc-ticket:`17834`).
+
GHCi
~~~~
=====================================
testsuite/tests/hpc/recsel/Makefile
=====================================
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
=====================================
testsuite/tests/hpc/recsel/recsel.hs
=====================================
@@ -0,0 +1,49 @@
+{-# LANGUAGE RecordWildCards, NamedFieldPuns, Arrows #-}
+
+import Control.Monad.Identity
+import Control.Arrow (runKleisli, arr, returnA)
+import Data.Maybe
+import Data.List
+import Data.Bifunctor
+import Trace.Hpc.Mix
+import Trace.Hpc.Tix
+import Trace.Hpc.Reflect
+
+data Foo = Foo { fooA, fooB, fooC, fooD, fooE, fooF, fooG, fooH, fooI
+ , fooJ, fooK, fooL, fooM, fooN, fooO :: Int }
+data Bar = Bar { barFoo :: Foo }
+
+fAB Foo{..} = fooA + fooB
+fC Foo{fooC} = fooC
+fD x Foo{..} = fromMaybe 0 $ if x then Just fooD else Nothing
+fE Bar{barFoo = Foo{..}} = fooE
+fF Foo{fooF = f} = f
+fG f = let Foo{..} = f in fooG
+fH f = runIdentity $ do
+ Foo{..} <- pure f
+ return fooH
+fI f = runIdentity $ do
+ let Foo{..} = f
+ return fooI
+fJ f = [ fooJ | let Foo{..} = f ] !! 0
+fK = runIdentity . runKleisli (proc f -> do
+ Foo{..} <- arr id -< f
+ returnA -< fooK)
+fL = runIdentity . runKleisli (proc f -> do
+ let Foo{..} = f;
+ returnA -< fooL)
+fM f | Foo{..} <- f = fooM
+fN f = fooN f
+fO = runIdentity . runKleisli (proc Foo{..} -> returnA -< fooO)
+
+recSel (n, TopLevelBox [s]) | any (`isPrefixOf` s) ["foo", "bar"] = Just (n, s)
+recSel _ = Nothing
+
+main = do
+ let foo = Foo 42 23 0 1 2 3 4 5 6 7 0xaffe 9 10 11 12
+ mapM_ (print . ($ foo))
+ [fAB, fC, fD False, fE . Bar, fF, fG, fH, fI, fJ, fK, fL, fM, fN, fO]
+ (Mix _ _ _ _ mixs) <- readMix [".hpc"] (Left "Main")
+ let sels = mapMaybe recSel . zip [0..] $ map snd mixs
+ (Tix [TixModule "Main" _ _ tix]) <- examineTix
+ mapM_ print . sortOn snd $ map (first (tix !!)) sels
=====================================
testsuite/tests/hpc/recsel/recsel.stdout
=====================================
@@ -0,0 +1,30 @@
+65
+0
+0
+2
+3
+4
+5
+6
+7
+45054
+9
+10
+11
+12
+(0,"barFoo")
+(1,"fooA")
+(1,"fooB")
+(1,"fooC")
+(0,"fooD")
+(1,"fooE")
+(0,"fooF")
+(1,"fooG")
+(1,"fooH")
+(1,"fooI")
+(1,"fooJ")
+(1,"fooK")
+(1,"fooL")
+(1,"fooM")
+(1,"fooN")
+(1,"fooO")
=====================================
testsuite/tests/hpc/recsel/test.T
=====================================
@@ -0,0 +1,7 @@
+setTestOpts([omit_ghci, when(fast(), skip), js_skip])
+
+test('recsel',
+ [ignore_extension,
+ when(arch('wasm32'), fragile(23243))],
+ compile_and_run, ['-fhpc'])
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43b606bb40688667f32a3b8f1543ac4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43b606bb40688667f32a3b8f1543ac4…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T18570] Fix field type mismatch error handling
by Sjoerd Visscher (＠trac-sjoerd_visscher) 27 Jun '25
by Sjoerd Visscher (＠trac-sjoerd_visscher) 27 Jun '25
27 Jun '25
Sjoerd Visscher pushed to branch wip/T18570 at Glasgow Haskell Compiler / GHC
Commits:
f536dd0e by Sjoerd Visscher at 2025-06-27T21:32:52+02:00
Fix field type mismatch error handling
- - - - -
6 changed files:
- compiler/GHC/Tc/TyCl.hs
- testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
- testsuite/tests/typecheck/should_fail/T12083a.hs
- testsuite/tests/typecheck/should_fail/T12083a.stderr
- testsuite/tests/typecheck/should_fail/T9739.hs
- testsuite/tests/typecheck/should_fail/T9739.stderr
Changes:
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -4787,6 +4787,7 @@ checkValidTyCl tc
= setSrcSpan (getSrcSpan tc) $
addTyConCtxt tc $
recoverM recovery_code $
+ checkNoErrs $
do { traceTc "Starting validity for tycon" (ppr tc)
; checkValidTyCon tc
; checkTyConConsistentWithBoot tc -- See Note [TyCon boot consistency checking]
@@ -4991,7 +4992,7 @@ checkValidTyCon tc
check_fields ((label, con1) :| other_fields)
-- These fields all have the same name, but are from
-- different constructors in the data type
- = recoverM (return ()) $ mapM_ checkOne other_fields
+ = mapM_ checkOne other_fields
-- Check that all the fields in the group have the same type
-- NB: this check assumes that all the constructors of a given
-- data type use the same type variables
@@ -5001,8 +5002,10 @@ checkValidTyCon tc
lbl = flLabel label
checkOne (_, con2) -- Do it both ways to ensure they are structurally identical
- = do { checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2
- ; checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }
+ = do { ((), no_errs) <- askNoErrs $
+ checkFieldCompat lbl con1 con2 res1 res2 fty1 fty2
+ ; when no_errs $
+ checkFieldCompat lbl con2 con1 res2 res1 fty2 fty1 }
where
res2 = dataConOrigResTy con2
fty2 = dataConFieldType con2 lbl
@@ -5029,8 +5032,10 @@ checkPartialRecordField all_cons fld
checkFieldCompat :: FieldLabelString -> DataCon -> DataCon
-> Type -> Type -> Type -> Type -> TcM ()
checkFieldCompat fld con1 con2 res1 res2 fty1 fty2
- = do { checkTc (isJust mb_subst1) (TcRnCommonFieldResultTypeMismatch con1 con2 fld)
- ; checkTc (isJust mb_subst2) (TcRnCommonFieldTypeMismatch con1 con2 fld) }
+ = if isNothing mb_subst1
+ then addErrTc $ TcRnCommonFieldResultTypeMismatch con1 con2 fld
+ else when (isNothing mb_subst2) $
+ addErrTc $ TcRnCommonFieldTypeMismatch con1 con2 fld
where
mb_subst1 = tcMatchTy res1 res2
mb_subst2 = tcMatchTyX (expectJust mb_subst1) fty1 fty2
=====================================
testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
=====================================
@@ -2,10 +2,3 @@ CommonFieldTypeMismatch.hs:3:1: error: [GHC-91827]
• Constructors A1 and A2 give different types for field ‘fld’
• In the data type declaration for ‘A’
-CommonFieldTypeMismatch.hs:4:8: error: [GHC-83865]
- • Couldn't match type ‘[Char]’ with ‘Int’
- Expected: Int
- Actual: String
- • In the expression: fld
- In an equation for ‘fld’: fld A2 {fld = fld} = fld
-
=====================================
testsuite/tests/typecheck/should_fail/T12083a.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
module T12803a where
type Constrd a = Num a ⇒ a
=====================================
testsuite/tests/typecheck/should_fail/T12083a.stderr
=====================================
@@ -1,14 +1,14 @@
-
-T12083a.hs:6:1: error: [GHC-91510]
+T12083a.hs:7:1: error: [GHC-91510]
• Illegal qualified type: Num a => a
• In the type synonym declaration for ‘Constrd’
Suggested fix:
Perhaps you intended to use the ‘RankNTypes’ extension (implied by ‘ImpredicativeTypes’)
-T12083a.hs:10:26: error: [GHC-25709]
+T12083a.hs:11:26: error: [GHC-25709]
• Data constructor ‘ExistentiallyLost’ has existential type variables, a context, or a specialised result type
ExistentiallyLost :: forall u. TC u => u -> ExistentiallyLost
• In the definition of data constructor ‘ExistentiallyLost’
In the data type declaration for ‘ExistentiallyLost’
Suggested fix:
Enable any of the following extensions: ‘ExistentialQuantification’ or ‘GADTs’
+
=====================================
testsuite/tests/typecheck/should_fail/T9739.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
module T9739 where
class Class3 a => Class1 a where
=====================================
testsuite/tests/typecheck/should_fail/T9739.stderr
=====================================
@@ -1,5 +1,4 @@
-
-T9739.hs:4:1: error: [GHC-29210]
+T9739.hs:5:1: error: [GHC-29210]
• Superclass cycle for ‘Class1’
one of whose superclasses is ‘Class3’
one of whose superclasses is ‘Class1’
@@ -7,10 +6,11 @@ T9739.hs:4:1: error: [GHC-29210]
Suggested fix:
Perhaps you intended to use the ‘UndecidableSuperClasses’ extension
-T9739.hs:9:1: error: [GHC-29210]
+T9739.hs:10:1: error: [GHC-29210]
• Superclass cycle for ‘Class3’
one of whose superclasses is ‘Class1’
one of whose superclasses is ‘Class3’
• In the class declaration for ‘Class3’
Suggested fix:
Perhaps you intended to use the ‘UndecidableSuperClasses’ extension
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f536dd0ec21e317eb4160ec0772f96e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f536dd0ec21e317eb4160ec0772f96e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ghc-9.14] 31 commits: Visible forall in GADTs (#25127)
by Ben Gamari (＠bgamari) 27 Jun '25
by Ben Gamari (＠bgamari) 27 Jun '25
27 Jun '25
Ben Gamari pushed to branch wip/ghc-9.14 at Glasgow Haskell Compiler / GHC
Commits:
fbc0b92a by Vladislav Zavialov at 2025-06-22T04:25:16+03:00
Visible forall in GADTs (#25127)
Add support for visible dependent quantification `forall a -> t` in
types of data constructors, e.g.
data KindVal a where
K :: forall k.
forall (a::k) -> -- now allowed!
k ->
KindVal a
For details, see docs/users_guide/exts/required_type_arguments.rst,
which has gained a new subsection.
DataCon in compiler/GHC/Core/DataCon.hs
---------------------------------------
The main change in this patch is that DataCon, the Core representation
of a data constructor, now uses a different type to store user-written
type variable binders:
- dcUserTyVarBinders :: [InvisTVBinder]
+ dcUserTyVarBinders :: [TyVarBinder]
where
type TyVarBinder = VarBndr TyVar ForAllTyFlag
type InvisTVBinder = VarBndr TyVar Specificity
and
data Specificity = InferredSpec | SpecifiedSpec
data ForAllTyFlag = Invisible Specificity | Required
This change necessitates some boring, mechanical changes scattered
throughout the diff:
... is now used in place of ...
-----------------+---------------
TyVarBinder | InvisTVBinder
IfaceForAllBndr | IfaceForAllSpecBndr
Specified | SpecifiedSpec
Inferred | InferredSpec
mkForAllTys | mkInvisForAllTys
additionally,
tyVarSpecToBinders -- added or removed calls
ifaceForAllSpecToBndrs -- removed calls
Visibility casts in mkDataConRep
--------------------------------
Type abstractions in Core (/\a. e) always have type (forall a. t)
because coreTyLamForAllTyFlag = Specified. This is also true of data
constructor workers. So we may be faced with the following:
data con worker: (forall a. blah)
data con wrapper: (forall a -> blah)
In this case the wrapper must use a visibility cast (e |> ForAllCo ...)
with appropriately set fco_vis{L,R}. Relevant functions:
mkDataConRep in compiler/GHC/Types/Id/Make.hs
dataConUserTyVarBindersNeedWrapper in compiler/GHC/Core/DataCon.hs
mkForAllVisCos in compiler/GHC/Core/Coercion.hs
mkCoreTyLams in compiler/GHC/Core/Make.hs
mkWpForAllCast in compiler/GHC/Tc/Types/Evidence.hs
More specifically:
- dataConUserTyVarBindersNeedWrapper has been updated to answer "yes"
if there are visible foralls in the type of the data constructor.
- mkDataConRep now uses mkCoreTyLams to generate the big lambda
abstractions (/\a b c. e) in the data con wrapper.
- mkCoreTyLams is a variant of mkCoreLams that applies visibility casts
as needed. It similar in purpose to the pre-existing mkWpForAllCast,
so the common bits have been factored out into mkForAllVisCos.
ConDecl in compiler/Language/Haskell/Syntax/Decls.hs
----------------------------------------------------
The surface syntax representation of a data constructor declaration is
ConDecl. In accordance with the proposal, only GADT syntax is extended
with support for visible forall, so we are interested in ConDeclGADT.
ConDeclGADT's field con_bndrs has been renamed to con_outer_bndrs
and is now accompanied by con_inner_bndrs:
con_outer_bndrs :: XRec pass (HsOuterSigTyVarBndrs pass)
con_inner_bndrs :: [HsForAllTelescope pass]
Visible foralls always end up in con_inner_bndrs. The outer binders are
stored and processed separately to support implicit quantification and
the forall-or-nothing rule, a design established by HsSigType.
A side effect of this change is that even in absence of visible foralls,
GHC now permits multiple invisible foralls, e.g.
data T a where { MkT :: forall a b. forall c d. ... -> T a }
But of course, this is done in service of making at least some of these
foralls visible. The entire compiler front-end has been updated to deal
with con_inner_bndrs. See the following modified or added functions:
Parser:
mkGadtDecl in compiler/GHC/Parser/PostProcess.hs
splitLHsGadtTy in compiler/GHC/Hs/Type.hs
Pretty-printer:
pprConDecl in compiler/GHC/Hs/Decls.hs
pprHsForAllTelescope in compiler/GHC/Hs/Type.hs
Renamer:
rnConDecl in compiler/GHC/Rename/Module.hs
bindHsForAllTelescopes in compiler/GHC/Rename/HsType.hs
extractHsForAllTelescopes in compiler/GHC/Rename/HsType.hs
Type checker:
tcConDecl in compiler/GHC/Tc/TyCl.hs
tcGadtConTyVarBndrs in compiler/GHC/Tc/Gen/HsType.hs
Template Haskell
----------------
The TH AST is left unchanged for the moment to avoid breakage. An
attempt to quote or reify a data constructor declaration with visible
forall in its type will result an error:
data ThRejectionReason -- in GHC/HsToCore/Errors/Types.hs
= ...
| ThDataConVisibleForall -- new error constructor
However, as noted in the previous section, GHC now permits multiple
invisible foralls, and TH was updated accordingly. Updated code:
repC in compiler/GHC/HsToCore/Quote.hs
reifyDataCon in compiler/GHC/Tc/Gen/Splice.hs
ppr @Con in libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs
Pattern matching
----------------
Everything described above concerns data constructor declarations, but
what about their use sites? Now it is trickier to type check a pattern
match fn(Con a b c)=... because we can no longer assume that a,b,c are
all value arguments. Indeed, some or all of them may very well turn out
to be required type arguments.
To that end, see the changes to:
tcDataConPat in compiler/GHC/Tc/Gen/Pat.hs
splitConTyArgs in compiler/GHC/Tc/Gen/Pat.hs
and the new helpers split_con_ty_args, zip_pats_bndrs.
This is also the reason the TcRnTooManyTyArgsInConPattern error
constructor has been removed. The new code emits TcRnArityMismatch
or TcRnIllegalInvisibleTypePattern.
Summary
-------
DataCon, ConDecl, as well as all related functions have been updated to
support required type arguments in data constructors.
Test cases:
HieGadtConSigs GadtConSigs_th_dump1 GadtConSigs_th_pprint1
T25127_data T25127_data_inst T25127_infix
T25127_newtype T25127_fail_th_quote T25127_fail_arity
TyAppPat_Tricky
Co-authored-by: mniip <mniip(a)mniip.com>
- - - - -
ae003a3a by Teo Camarasu at 2025-06-23T05:21:48-04:00
linters: lint-whitespace: bump upper-bound for containers
The version of containers was bumped in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/13989
- - - - -
0fb37893 by Matthew Pickering at 2025-06-23T13:55:10-04:00
Move ModuleGraph into UnitEnv
The ModuleGraph is a piece of information associated with the
ExternalPackageState and HomeUnitGraph. Therefore we should store it
inside the HomeUnitEnv.
- - - - -
3bf6720e by soulomoon at 2025-06-23T13:55:52-04:00
Remove hptAllFamInstances usage during upsweep
Fixes #26118
This change eliminates the use of hptAllFamInstances during the upsweep phase,
as it could access non-below modules from the home package table.
The following updates were made:
* Updated checkFamInstConsistency to accept an explicit ModuleEnv FamInstEnv
parameter and removed the call to hptAllFamInstances.
* Adjusted hugInstancesBelow so we can construct ModuleEnv FamInstEnv
from its result,
* hptAllFamInstances and allFamInstances functions are removed.
- - - - -
83ee7b78 by Ben Gamari at 2025-06-24T05:02:07-04:00
configure: Don't force value of OTOOL, etc. if not present
Previously if `otool` and `install_name_tool` were not present they
would be overridden by `fp_settings.m4`. This logic was introduced in
4ff93292243888545da452ea4d4c1987f2343591 without explanation.
- - - - -
9329c9e1 by Ben Gamari at 2025-06-24T05:02:07-04:00
ghc-toolchain: Add support for otool, install_name_tool
Fixes part of ghc#23675.
- - - - -
25f5c998 by Ben Gamari at 2025-06-24T05:02:08-04:00
ghc-toolchain: Add support for llc, opt, llvm-as
Fixes #23675.
- - - - -
51d150dd by Rodrigo Mesquita at 2025-06-24T05:02:08-04:00
hadrian: Use settings-use-distro-mingw directly
The type `ToolchainSetting` only made sense when we had more settings to
fetch from the system config file. Even then "settings-use-distro-mingw"
is arguably not a toolchain setting.
With the fix for #23675, all toolchain tools were moved to the
`ghc-toolchain` `Toolchain` format. Therefore, we can inline
`settings-use-distro-mingw` accesses and delete `ToolchainSetting`.
- - - - -
dcf68a83 by Rodrigo Mesquita at 2025-06-24T05:02:08-04:00
configure: Check LlvmTarget exists for LlvmAsFlags
If LlvmTarget was empty, LlvmAsFlags would be just "--target=".
If it is empty now, simply keep LlvmAsFlags empty.
ghc-toolchain already does this right. This fix makes the two
configurations match up.
- - - - -
580a3353 by Ben Gamari at 2025-06-24T05:02:51-04:00
rts/linker/LoadArchive: Use bool
Improve type precision by using `bool` instead of `int` and `StgBool`.
- - - - -
76d1041d by Ben Gamari at 2025-06-24T05:02:51-04:00
rts/linker/LoadArchive: Don't rely on file extensions for identification
Previously archive members would be identified via their file extension,
as described in #13103. We now instead use a more principled approach,
relying on the magic number in the member's header.
As well, we refactor treatment of archive format detection to improve
code clarity and error handling.
Closes #13103.
- - - - -
4b748a99 by Teo Camarasu at 2025-06-24T15:31:07-04:00
template-haskell: improve changelog
stable -> more stable, just to clarify that this interface isn't fully stable.
errornously -> mistakenly: I typod this and also let's go for a simpler word
- - - - -
e358e477 by Sylvain Henry at 2025-06-24T15:31:58-04:00
Bump stack resolver to use GHC 9.6.7
Cf #26139
- - - - -
4bf5eb63 by fendor at 2025-06-25T17:05:43-04:00
Teach `:reload` about multiple home units
`:reload` needs to lookup the `ModuleName` and must not assume the given
`ModuleName` is in the current `HomeUnit`.
We add a new utility function which allows us to find a `HomeUnitModule`
instead of a `Module`.
Further, we introduce the `GhciCommandError` type which can be used to
abort the execution of a GHCi command.
This error is caught and printed in a human readable fashion.
- - - - -
b3d97bb3 by fendor at 2025-06-25T17:06:25-04:00
Implement `-fno-load-initial-targets` flag
We add the new flag `-fno-load-initial-targets` which doesn't load all `Target`s
immediately but only computes the module graph for all `Target`s.
The user can then decide to load modules from that module graph using
the syntax:
ghci> :reload <Mod>
This will load everything in the module graph up to `Mod`.
The user can return to the initial state by using the builtin target
`none` to unload all modules.
ghci> :reload none
Is in principle identical to starting a new session with the
`-fno-load-initial-targets` flag.
The `-fno-load-initial-targets` flag allows for faster startup time of GHCi when a
user has lots of `Target`s.
We additionally extend the `:reload` command to accept multiple
`ModuleName`s. For example:
ghci> :reload <Mod1> <Mod2>
Loads all modules up to the modules `Mod1` and `Mod2`.
- - - - -
49f44e52 by Teo Camarasu at 2025-06-26T04:19:51-04:00
Expose ghc-internal unit id through the settings file
This in combination with the unit id of the compiler library allows
cabal to know of the two unit ids that should not be reinstalled (in
specific circumstances) as:
- when using plugins, we want to link against exactly the compiler unit
id
- when using TemplateHaskell we want to link against exactly the package
that contains the TemplateHaskell interfaces, which is `ghc-internal`
See: <https://github.com/haskell/cabal/issues/10087>
Resolves #25282
- - - - -
499c4efe by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Fix and clean up capture of timings
* Fixes the typo that caused 'cat ci-timings' to report "no such file or
directory"
* Gave ci_timings.txt a file extension so it may play better with other
systems
* Fixed the use of time_it so all times are recorded
* Fixed time_it to print name along with timing
- - - - -
86c90c9e by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Update collapsible section usage
The syntax apparently changed at some point.
- - - - -
04308ee4 by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Add more collapsible sections
- - - - -
2aa5b667 by Ben Gamari at 2025-06-27T15:21:09-04:00
compiler: Import AnnotationWrapper from ghc-internal
Since `GHC.Desugar` exported from `base` has been deprecated.
- - - - -
7455e564 by Ben Gamari at 2025-06-27T15:21:09-04:00
ghc-compact: Eliminate dependency on ghc-prim
- - - - -
7ad91a67 by Ben Gamari at 2025-06-27T15:21:09-04:00
ghc-heap: Eliminate dependency on ghc-prim
- - - - -
4fceb5a9 by Ben Gamari at 2025-06-27T15:21:09-04:00
ghc-heap: Drop redundant import
- - - - -
7d81ae17 by Ben Gamari at 2025-06-27T15:21:09-04:00
ghc-prim: Bump version to 0.13.1
There are no interface changes from 0.13.0 but the implementation now
lives in `ghc-internal`.
- - - - -
e6810293 by Ben Gamari at 2025-06-27T15:21:09-04:00
template-haskell: Bump version number to 2.24.0.0
Bumps exceptions submodule.
- - - - -
dc9a119d by Ben Gamari at 2025-06-27T15:21:09-04:00
Bump GHC version number to 9.14
- - - - -
2fa917d1 by Ben Gamari at 2025-06-27T15:21:09-04:00
Bump parsec to 3.1.18.0
Bumps parsec submodule.
- - - - -
e2659518 by Ben Gamari at 2025-06-27T15:21:09-04:00
unix: Bump to 2.8.7.0
Bumps unix submodule.
- - - - -
badbdd76 by Ben Gamari at 2025-06-27T15:21:09-04:00
binary: Bump to 0.8.9.3
Bumps binary submodule.
- - - - -
8fcbc16a by Ben Gamari at 2025-06-27T15:21:09-04:00
Win32: Bump to 2.14.2.0
Bumps Win32 submodule.
- - - - -
e91f9f0a by Ben Gamari at 2025-06-27T15:21:09-04:00
base: Bump version to 4.22.0
Bumps various submodules.
- - - - -
198 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/common.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/ConLike.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/DataCon.hs-boot
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/PatSyn.hs
- compiler/GHC/Core/TyCo/Ppr.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Env/Types.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/Var.hs-boot
- compiler/GHC/Unit/Env.hs
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/Home/PackageTable.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Pat.hs
- compiler/Setup.hs
- compiler/ghc.cabal.in
- configure.ac
- distrib/configure.ac.in
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/exts/gadt_syntax.rst
- docs/users_guide/exts/required_type_arguments.rst
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Exception.hs
- ghc/GHCi/UI/Print.hs
- hadrian/cfg/default.host.target.in
- hadrian/cfg/default.target.in
- hadrian/cfg/system.config.in
- hadrian/src/Builder.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/stack.yaml
- hadrian/stack.yaml.lock
- libraries/Win32
- libraries/array
- libraries/base/base.cabal.in
- libraries/binary
- libraries/deepseq
- libraries/directory
- libraries/exceptions
- libraries/filepath
- libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs
- libraries/ghc-boot-th/ghc-boot-th.cabal.in
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-compact/GHC/Compact.hs
- libraries/ghc-compact/GHC/Compact/Serialized.hs
- libraries/ghc-compact/ghc-compact.cabal
- libraries/ghc-experimental/ghc-experimental.cabal.in
- libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-prim/changelog.md
- libraries/ghc-prim/ghc-prim.cabal
- libraries/ghci/ghci.cabal.in
- libraries/haskeline
- libraries/hpc
- libraries/os-string
- libraries/parsec
- libraries/process
- libraries/semaphore-compat
- libraries/stm
- libraries/template-haskell/changelog.md
- libraries/template-haskell/template-haskell.cabal.in
- libraries/terminfo
- libraries/text
- libraries/unix
- linters/lint-whitespace/lint-whitespace.cabal
- m4/fp_settings.m4
- m4/ghc_toolchain.m4
- m4/prep_target_file.m4
- rts/linker/LoadArchive.c
- testsuite/tests/dependent/should_fail/T16326_Fail6.stderr
- testsuite/tests/ghc-e/should_fail/T18441fail5.stderr
- testsuite/tests/ghci/prog-mhu003/prog-mhu003.stderr
- testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stderr
- + testsuite/tests/ghci/prog-mhu005/Makefile
- + testsuite/tests/ghci/prog-mhu005/a/A.hs
- + testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/b/B.hs
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stdout
- + testsuite/tests/ghci/prog-mhu005/unitA
- + testsuite/tests/ghci/prog-mhu005/unitB
- + testsuite/tests/ghci/prog021/A.hs
- + testsuite/tests/ghci/prog021/B.hs
- + testsuite/tests/ghci/prog021/Makefile
- + testsuite/tests/ghci/prog021/all.T
- + testsuite/tests/ghci/prog021/prog021a.script
- + testsuite/tests/ghci/prog021/prog021a.stderr
- + testsuite/tests/ghci/prog021/prog021a.stdout
- + testsuite/tests/ghci/prog021/prog021b.script
- + testsuite/tests/ghci/prog021/prog021b.stderr
- + testsuite/tests/ghci/prog021/prog021b.stdout
- + testsuite/tests/ghci/prog022/A.hs
- + testsuite/tests/ghci/prog022/B.hs
- + testsuite/tests/ghci/prog022/Makefile
- + testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022a.script
- + testsuite/tests/ghci/prog022/ghci.prog022a.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022a.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022b.script
- + testsuite/tests/ghci/prog022/ghci.prog022b.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022b.stdout
- testsuite/tests/ghci/scripts/ghci021.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- + testsuite/tests/hiefile/should_run/HieGadtConSigs.hs
- + testsuite/tests/hiefile/should_run/HieGadtConSigs.stdout
- testsuite/tests/hiefile/should_run/all.T
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/printer/T18791.stderr
- + testsuite/tests/th/GadtConSigs_th_dump1.hs
- + testsuite/tests/th/GadtConSigs_th_dump1.stderr
- + testsuite/tests/th/GadtConSigs_th_pprint1.hs
- + testsuite/tests/th/GadtConSigs_th_pprint1.stderr
- testsuite/tests/th/T20868.stdout
- testsuite/tests/th/all.T
- testsuite/tests/typecheck/should_compile/T23739a.hs
- + testsuite/tests/typecheck/should_compile/TyAppPat_Tricky.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T20443b.stderr
- testsuite/tests/typecheck/should_fail/TyAppPat_TooMany.stderr
- + testsuite/tests/vdq-rta/should_compile/T25127_data.hs
- + testsuite/tests/vdq-rta/should_compile/T25127_data_inst.hs
- + testsuite/tests/vdq-rta/should_compile/T25127_infix.hs
- + testsuite/tests/vdq-rta/should_compile/T25127_newtype.hs
- testsuite/tests/vdq-rta/should_compile/all.T
- testsuite/tests/vdq-rta/should_fail/T24159_type_syntax_th_fail.script
- + testsuite/tests/vdq-rta/should_fail/T25127_fail_arity.hs
- + testsuite/tests/vdq-rta/should_fail/T25127_fail_arity.stderr
- + testsuite/tests/vdq-rta/should_fail/T25127_fail_th_quote.hs
- + testsuite/tests/vdq-rta/should_fail/T25127_fail_th_quote.stderr
- testsuite/tests/vdq-rta/should_fail/all.T
- utils/check-exact/ExactPrint.hs
- utils/ghc-toolchain/exe/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
- utils/haddock/haddock-api/haddock-api.cabal
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
- utils/haddock/haddock-library/haddock-library.cabal
- utils/haddock/haddock-test/haddock-test.cabal
- utils/haddock/haddock.cabal
- utils/hsc2hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6f3e5a3abebb97183fec50083aabc…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6f3e5a3abebb97183fec50083aabc…
You're receiving this email because of your account on gitlab.haskell.org.
1
0