[Git][ghc/ghc][wip/T25266] Wibbles
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Fri Oct 11 23:15:44 UTC 2024
Simon Peyton Jones pushed to branch wip/T25266 at Glasgow Haskell Compiler / GHC
Commits:
f9073e3d by Simon Peyton Jones at 2024-10-12T00:15:19+01:00
Wibbles
- - - - -
6 changed files:
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Types/Constraint.hs
- testsuite/tests/partial-sigs/should_fail/T10615.stderr
- testsuite/tests/typecheck/should_fail/T18398.stderr
Changes:
=====================================
compiler/GHC/Tc/Deriv/Infer.hs
=====================================
@@ -763,8 +763,9 @@ simplifyDeriv (DS { ds_loc = loc, ds_tvs = tvs
-- See [STEP DAC HOIST]
-- From the simplified constraints extract a subset 'good' that will
-- become the context 'min_theta' for the derived instance.
- ; let (residual_simple, _) = approximateWC solved_wanteds
- -- Ignore any equalities hidden under Given equalities
+ ; let residual_simple = approximateWC False solved_wanteds
+ -- False: ignore any non-qauntifiable constraints,
+ -- including equalities hidden under Given equalities
head_size = pSizeClassPred clas inst_tys
good = mapMaybeBag get_good residual_simple
=====================================
compiler/GHC/Tc/Solver.hs
=====================================
@@ -1453,7 +1453,7 @@ decideAndPromoteTyVars infer_mode name_taus psigs wanted
-- not mono. Need to zonk them because they are meta-tyvar TyVarTvs
; (psig_qtvs, psig_theta, tau_tys) <- getSeedTys name_taus psigs
- ; let (can_quant_cts, no_quant_cts) = approximateWC wanted
+ ; let (can_quant_cts, no_quant_cts) = approximateWCX wanted
can_quant = ctsPreds can_quant_cts
no_quant = ctsPreds no_quant_cts
(post_mr_quant, mr_no_quant) = applyMR dflags infer_mode can_quant
=====================================
compiler/GHC/Tc/Solver/Default.hs
=====================================
@@ -818,10 +818,9 @@ findDefaultableGroups (default_tys, extended_defaults) wanteds
, defaultable_tyvar tv
, defaultable_classes (map (classTyCon . sndOf3) group) ]
where
- (simples1,simples2) = approximateWC wanteds
- simples = simples1 `unionBags` simples2
- -- simples: for the purpose of defaulting we don't care
- -- about shape or enclosing equalities
+ simples = approximateWC True wanteds
+ -- True: for the purpose of defaulting we don't care
+ -- about shape or enclosing equalities
-- See (W3) in Note [ApproximateWC] in GHC.Tc.Types.Constraint
(unaries, non_unaries) = partitionWith find_unary (bagToList simples)
=====================================
compiler/GHC/Tc/Types/Constraint.hs
=====================================
@@ -61,7 +61,7 @@ module GHC.Tc.Types.Constraint (
tyCoVarsOfWC, tyCoVarsOfWCList,
insolubleWantedCt, insolubleCt, insolubleIrredCt,
insolubleImplic, nonDefaultableTyVarsOfWC,
- approximateWC,
+ approximateWCX, approximateWC,
Implication(..), implicationPrototype, checkTelescopeSkol,
ImplicStatus(..), isInsolubleStatus, isSolvedStatus,
@@ -1788,10 +1788,18 @@ type ApproxWC = ( Bag Ct -- Free quantifiable constraints
, Bag Ct ) -- Free non-quantifiable constraints
-- due to shape, or enclosing equality
-approximateWC :: WantedConstraints -> ApproxWC
+approximateWC include_non_quantifiable cts
+ | include_non_quantifiable = quant `unionBags` no_quant
+ | otherwise = quant
+ where
+ (quant, no_quant) = approximateWCX cts
+
+approximateWCX :: WantedConstraints -> ApproxWC
+-- The "X" means "extended";
+-- we return both quantifiable and non-quantifiable constraints
-- See Note [ApproximateWC]
-- See Note [floatKindEqualities vs approximateWC]
-approximateWC wc
+approximateWCX wc
= float_wc False emptyVarSet wc (emptyBag, emptyBag)
where
float_wc :: Bool -- True <=> there are enclosing equalities
=====================================
testsuite/tests/partial-sigs/should_fail/T10615.stderr
=====================================
@@ -1,34 +1,39 @@
T10615.hs:5:7: error: [GHC-88464]
- • Found type wildcard ‘_’ standing for ‘w1’
- Where: ‘w1’ is an ambiguous type variable
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of f1 :: w -> f
+ at T10615.hs:6:1-10
To use the inferred type, enable PartialTypeSignatures
• In the type signature: f1 :: _ -> f
T10615.hs:6:6: error: [GHC-25897]
- • Couldn't match type ‘f’ with ‘b1 -> w1’
- Expected: w1 -> f
- Actual: w1 -> b1 -> w1
+ • Couldn't match type ‘f’ with ‘b1 -> w’
+ Expected: w -> f
+ Actual: w -> b1 -> w
‘f’ is a rigid type variable bound by
- the inferred type of f1 :: w1 -> f
+ the inferred type of f1 :: w -> f
at T10615.hs:5:1-12
• In the expression: const
In an equation for ‘f1’: f1 = const
- • Relevant bindings include f1 :: w1 -> f (bound at T10615.hs:6:1)
+ • Relevant bindings include f1 :: w -> f (bound at T10615.hs:6:1)
T10615.hs:8:7: error: [GHC-88464]
- • Found type wildcard ‘_’ standing for ‘w0’
- Where: ‘w0’ is an ambiguous type variable
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of f2 :: w -> _f
+ at T10615.hs:9:1-10
To use the inferred type, enable PartialTypeSignatures
• In the type signature: f2 :: _ -> _f
T10615.hs:9:6: error: [GHC-25897]
- • Couldn't match type ‘_f’ with ‘b0 -> w0’
- Expected: w0 -> _f
- Actual: w0 -> b0 -> w0
+ • Couldn't match type ‘_f’ with ‘b0 -> w’
+ Expected: w -> _f
+ Actual: w -> b0 -> w
‘_f’ is a rigid type variable bound by
- the inferred type of f2 :: w0 -> _f
+ the inferred type of f2 :: w -> _f
at T10615.hs:8:1-13
• In the expression: const
In an equation for ‘f2’: f2 = const
- • Relevant bindings include f2 :: w0 -> _f (bound at T10615.hs:9:1)
+ • Relevant bindings include f2 :: w -> _f (bound at T10615.hs:9:1)
+
=====================================
testsuite/tests/typecheck/should_fail/T18398.stderr
=====================================
@@ -6,7 +6,7 @@ T18398.hs:13:34: error: [GHC-39999]
In the expression: case x of MkEx _ -> meth x y
T18398.hs:13:70: error: [GHC-39999]
- • No instance for ‘C Ex t0’ arising from a use of ‘meth’
+ • No instance for ‘C Ex t1’ arising from a use of ‘meth’
• In the expression: meth x z
In a case alternative: MkEx _ -> meth x z
In the expression: case x of MkEx _ -> meth x z
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9073e3d0381ecf864040579b4ddecfb8f9bec65
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9073e3d0381ecf864040579b4ddecfb8f9bec65
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241011/2e8640cd/attachment-0001.html>
More information about the ghc-commits
mailing list