[Git][ghc/ghc][master] Fix untouchability test
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Jun 20 11:22:46 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
04f5bb85 by Simon Peyton Jones at 2024-06-20T07:22:03-04:00
Fix untouchability test
This MR fixes #24938. The underlying problem was tha the test for
"does this implication bring in scope any equalities" was plain wrong.
See
Note [Tracking Given equalities] and
Note [Let-bound skolems]
both in GHC.Tc.Solver.InertSet.
Then
* Test LocalGivenEqs succeeds for a different reason than before;
see (LBS2) in Note [Let-bound skolems]
* New test T24938a succeeds because of (LBS2), whereas it failed
before.
* Test LocalGivenEqs2 now fails, as it should.
* Test T224938, the repro from the ticket, fails, as it should.
- - - - -
13 changed files:
- compiler/GHC/Tc/Solver/InertSet.hs
- testsuite/tests/indexed-types/should_fail/T13784.stderr
- testsuite/tests/linters/notes.stdout
- testsuite/tests/patsyn/should_fail/T11010.stderr
- testsuite/tests/typecheck/should_compile/LocalGivenEqs.hs
- testsuite/tests/typecheck/should_compile/LocalGivenEqs2.hs
- + testsuite/tests/typecheck/should_compile/LocalGivenEqs2.stderr
- + testsuite/tests/typecheck/should_compile/T24938a.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T22645.stderr
- + testsuite/tests/typecheck/should_fail/T24938.hs
- + testsuite/tests/typecheck/should_fail/T24938.stderr
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
compiler/GHC/Tc/Solver/InertSet.hs
=====================================
@@ -647,11 +647,16 @@ enclosing Given equality.
Exactly which constraints should trigger (UNTOUCHABLE), and hence
should update inert_given_eq_lvl?
-* We do /not/ need to worry about let-bound skolems, such ast
+(TGE1) We do /not/ need to worry about let-bound skolems, such as
forall[2] a. a ~ [b] => blah
- See Note [Let-bound skolems]
+ See Note [Let-bound skolems] and the isOuterTyVar tests in `updGivenEqs`
-* Consider an implication
+(TGE2) However, solely to support better error messages (see Note [HasGivenEqs] in
+ GHC.Tc.Types.Constraint) we also track these "local" equalities in the
+ boolean inert_given_eqs field. This field is used only subsequntly (see
+ `getHasGivenEqs`), to set the ic_given_eqs field to LocalGivenEqs.
+
+(TGE3) Consider an implication
forall[2]. beta[1] => alpha[1] ~ Int
where beta is a unification variable that has already been unified
to () in an outer scope. Then alpha[1] is perfectly touchable and
@@ -659,64 +664,66 @@ should update inert_given_eq_lvl?
an equality, we should canonicalise first, rather than just looking at
the /original/ givens (#8644).
- * However, we must take account of *potential* equalities. Consider the
+(TGE4) However, we must take account of *potential* equalities. Consider the
same example again, but this time we have /not/ yet unified beta:
forall[2] beta[1] => ...blah...
Because beta might turn into an equality, updGivenEqs conservatively
treats it as a potential equality, and updates inert_give_eq_lvl
- * What about something like forall[2] a b. a ~ F b => [W] alpha[1] ~ X y z?
-
- That Given cannot affect the Wanted, because the Given is entirely
- *local*: it mentions only skolems bound in the very same
- implication. Such equalities need not make alpha untouchable. (Test
- case typecheck/should_compile/LocalGivenEqs has a real-life
- motivating example, with some detailed commentary.)
- Hence the 'mentionsOuterVar' test in updGivenEqs.
-
- However, solely to support better error messages
- (see Note [HasGivenEqs] in GHC.Tc.Types.Constraint) we also track
- these "local" equalities in the boolean inert_given_eqs field.
- This field is used only to set the ic_given_eqs field to LocalGivenEqs;
- see the function getHasGivenEqs.
-
- Here is a simpler case that triggers this behaviour:
-
- data T where
- MkT :: F a ~ G b => a -> b -> T
-
- f (MkT _ _) = True
-
- Because of this behaviour around local equality givens, we can infer the
- type of f. This is typecheck/should_compile/LocalGivenEqs2.
-
- * We need not look at the equality relation involved (nominal vs
+(TGE5) We should not look at the equality relation involved (nominal vs
representational), because representational equalities can still
imply nominal ones. For example, if (G a ~R G b) and G's argument's
role is nominal, then we can deduce a ~N b.
+Historical note: prior to #24938 we also ignored Given equalities that
+did not mention an "outer" type variable. But that is wrong, as #24938
+showed. Another example is immortalised in test LocalGivenEqs2
+ data T where
+ MkT :: F a ~ G b => a -> b -> T
+ f (MkT _ _) = True
+We should not infer the type for `f`; let-bound-skolems does not apply.
+
Note [Let-bound skolems]
~~~~~~~~~~~~~~~~~~~~~~~~
If * the inert set contains a canonical Given CEqCan (a ~ ty)
and * 'a' is a skolem bound in this very implication,
then:
-a) The Given is pretty much a let-binding, like
- f :: (a ~ b->c) => a -> a
- Here the equality constraint is like saying
- let a = b->c in ...
- It is not adding any new, local equality information,
- and hence can be ignored by has_given_eqs
+ a) The Given is pretty much a let-binding, like
+ f :: (a ~ b->c) => a -> a
+ Here the equality constraint is like saying
+ let a = b->c in ...
+ It is not adding any new, local equality information,
+ and hence can be ignored by has_given_eqs
-b) 'a' will have been completely substituted out in the inert set,
- so we can safely discard it.
+ b) 'a' will have been completely substituted out in the inert set,
+ so we can safely discard it.
For an example, see #9211.
-See also GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure
-that the right variable is on the left of the equality when both are
-tyvars.
+The actual test is in `isLetBoundSkolemCt`
+
+Wrinkles:
+
+(LBS1) See GHC.Tc.Utils.Unify Note [Deeper level on the left] for how we ensure
+ that the correct variable is on the left of the equality when both are
+ tyvars.
+
+(LBS2) We also want this to work for
+ forall a. [G] F b ~ a (CEqCt with TyFamLHS)
+ Here the Given will have a TyFamLHS, with the skolem-bound tyvar on the RHS.
+ See tests T24938a, and LocalGivenEqs.
+
+(LBS3) Happily (LBS2) also makes cycle-breakers work. Suppose we have
+ forall a. [G] (F a) Int ~ a
+ where F has arity 1, and `a` is the locally-bound skolem. Then, as
+ Note [Type equality cycles] explains, we split into
+ [G] F a ~ cbv, [G] cbv Int ~ a
+ where `cbv` is the cycle breaker variable. But cbv has the same level
+ as `a`, so `isOuterTyVar` (called in `isLetBoundSkolemCt`) will return False.
+
+ This actually matters occasionally: see test LocalGivenEqs.
You might wonder whether the skolem really needs to be bound "in the
very same implication" as the equality constraint.
@@ -741,6 +748,18 @@ body of the lambda we'll get
Now, unify alpha := a. Now we are stuck with an unsolved alpha~Int!
So we must treat alpha as untouchable under the forall[2] implication.
+Possible future improvements. The current test just looks to see whether one
+side of an equality is a locally-bound skolem. But actually we could, in
+theory, do better: if one side (or both sides, actually) of an equality
+ineluctably mentions a local skolem, then the equality cannot possibly impact
+types outside of the implication (because doing to would cause those types to be
+ill-scoped). The problem is the "ineluctably": this means that no expansion,
+other solving, etc., could possibly get rid of the variable. This is hard,
+perhaps impossible, to know for sure, especially when we think about type family
+interactions. (And it's a user-visible property so we don't want it to be hard
+to predict.) So we keep the existing check, looking for one lone variable,
+because we're sure that variable isn't going anywhere.
+
Note [Detailed InertCans Invariants]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The InertCans represents a collection of constraints with the following properties:
@@ -1467,27 +1486,28 @@ updGivenEqs :: TcLevel -> Ct -> InertCans -> InertCans
-- if the constraint is a given equality that should prevent
-- filling in an outer unification variable.
-- See Note [Tracking Given equalities]
-updGivenEqs tclvl ct inerts@(IC { inert_given_eq_lvl = ge_lvl })
+--
+-- Precondition: Ct is either CEqCan or CIrredCan
+updGivenEqs tclvl ct inerts
| not (isGivenCt ct) = inerts
- | not_equality ct = inerts -- See Note [Let-bound skolems]
- | otherwise = inerts { inert_given_eq_lvl = ge_lvl'
- , inert_given_eqs = True }
- where
- ge_lvl' | mentionsOuterVar tclvl (ctEvidence ct)
- -- Includes things like (c a), which *might* be an equality
- = tclvl
- | otherwise
- = ge_lvl
-
- not_equality :: Ct -> Bool
- -- True <=> definitely not an equality of any kind
- -- except for a let-bound skolem, which doesn't count
- -- See Note [Let-bound skolems]
- -- NB: no need to spot the boxed CDictCan (a ~ b) because its
- -- superclass (a ~# b) will be a CEqCan
- not_equality (CEqCan (EqCt { eq_lhs = TyVarLHS tv })) = not (isOuterTyVar tclvl tv)
- not_equality (CDictCan {}) = True
- not_equality _ = False
+
+ -- See Note [Let-bound skolems]
+ | isLetBoundSkolemCt tclvl ct = inerts { inert_given_eqs = True }
+
+ -- At this point we are left with a constraint that either
+ -- is an equality (F a ~ ty), or /might/ be, like (c a)
+ | otherwise = inerts { inert_given_eq_lvl = tclvl
+ , inert_given_eqs = True }
+
+isLetBoundSkolemCt :: TcLevel -> Ct -> Bool
+-- See Note [Let-bound skolems]
+isLetBoundSkolemCt tclvl (CEqCan (EqCt { eq_lhs = lhs, eq_rhs = rhs }))
+ = case lhs of
+ TyVarLHS tv -> not (isOuterTyVar tclvl tv)
+ TyFamLHS {} -> case getTyVar_maybe rhs of
+ Just tv -> not (isOuterTyVar tclvl tv)
+ Nothing -> False
+isLetBoundSkolemCt _ _ = False
data KickOutSpec -- See Note [KickOutSpec]
= KOAfterUnify TcTyVarSet -- We have unified these tyvars
@@ -1732,11 +1752,6 @@ Hence:
* *
********************************************************************* -}
-mentionsOuterVar :: TcLevel -> CtEvidence -> Bool
-mentionsOuterVar tclvl ev
- = anyFreeVarsOfType (isOuterTyVar tclvl) $
- ctEvPred ev
-
isOuterTyVar :: TcLevel -> TyCoVar -> Bool
-- True of a type variable that comes from a
-- shallower level than the ambient level (tclvl)
=====================================
testsuite/tests/indexed-types/should_fail/T13784.stderr
=====================================
@@ -1,6 +1,10 @@
-
T13784.hs:29:28: error: [GHC-25897]
- • Couldn't match type ‘as’ with ‘a : Divide a as’
+ • Could not deduce ‘as ~ (a : Divide a as)’
+ from the context: (a : as) ~ (a1 : as1)
+ bound by a pattern with constructor:
+ :* :: forall a (as :: [*]). a -> Product as -> Product (a : as),
+ in an equation for ‘divide’
+ at T13784.hs:29:13-19
Expected: Product (Divide a (a : as))
Actual: Product as1
‘as’ is a rigid type variable bound by
@@ -36,3 +40,4 @@ T13784.hs:33:29: error: [GHC-83865]
• Relevant bindings include
divide :: Product (a : as) -> (b, Product (Divide b (a : as)))
(bound at T13784.hs:33:5)
+
=====================================
testsuite/tests/linters/notes.stdout
=====================================
@@ -44,8 +44,6 @@ ref testsuite/tests/perf/should_run/all.T:8:6: Note [Solving from instanc
ref testsuite/tests/polykinds/CuskFam.hs:16:11: Note [Unifying implicit CUSK variables]
ref testsuite/tests/simplCore/should_compile/T5776.hs:16:7: Note [Simplifying RULE lhs constraints]
ref testsuite/tests/simplCore/should_compile/simpl018.hs:3:7: Note [Float coercions]
-ref testsuite/tests/typecheck/should_compile/LocalGivenEqs.hs:7:7: Note [When does an implication have given equalities?]
-ref testsuite/tests/typecheck/should_compile/LocalGivenEqs2.hs:4:6: Note [When does an implication have given equalities?]
ref testsuite/tests/typecheck/should_compile/T9117.hs:3:12: Note [Order of Coercible Instances]
ref testsuite/tests/typecheck/should_compile/tc200.hs:5:7: Note [Multiple instantiation]
ref testsuite/tests/typecheck/should_compile/tc228.hs:9:7: Note [Inference and implication constraints]
=====================================
testsuite/tests/patsyn/should_fail/T11010.stderr
=====================================
@@ -1,6 +1,8 @@
-
T11010.hs:9:34: error: [GHC-25897]
- • Couldn't match type ‘a1’ with ‘Int’
+ • Could not deduce ‘a1 ~ Int’
+ from the context: a ~ Int
+ bound by the signature for pattern synonym ‘IntFun’
+ at T11010.hs:9:1-36
Expected: a -> b
Actual: a1 -> b
‘a1’ is a rigid type variable bound by
@@ -15,3 +17,4 @@ T11010.hs:9:34: error: [GHC-25897]
|
9 | pattern IntFun str f x = Fun str f x
| ^
+
=====================================
testsuite/tests/typecheck/should_compile/LocalGivenEqs.hs
=====================================
@@ -4,7 +4,7 @@
module LocalGivenEqs where
--- See Note [When does an implication have given equalities?] in GHC.Tc.Solver.Monad;
+-- See Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet;
-- this tests custom treatment for LocalGivenEqs
{-
=====================================
testsuite/tests/typecheck/should_compile/LocalGivenEqs2.hs
=====================================
@@ -1,9 +1,7 @@
{-# LANGUAGE TypeFamilies, GADTSyntax, ExistentialQuantification #-}
--- This is a simple case that exercises the LocalGivenEqs bullet
--- of Note [When does an implication have given equalities?] in GHC.Tc.Solver.Monad
--- If a future change rejects this, that's not the end of the world, but it's nice
--- to be able to infer `f`.
+-- This one should be rejected.
+-- See Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet
module LocalGivenEqs2 where
=====================================
testsuite/tests/typecheck/should_compile/LocalGivenEqs2.stderr
=====================================
@@ -0,0 +1,16 @@
+LocalGivenEqs2.hs:14:15: error: [GHC-25897]
+ • Could not deduce ‘p ~ Bool’
+ from the context: F a ~ G b
+ bound by a pattern with constructor:
+ MkT :: forall a b. (F a ~ G b) => a -> b -> T,
+ in an equation for ‘f’
+ at LocalGivenEqs2.hs:14:4-10
+ ‘p’ is a rigid type variable bound by
+ the inferred type of f :: T -> p
+ at LocalGivenEqs2.hs:14:1-18
+ • In the expression: True
+ In an equation for ‘f’: f (MkT _ _) = True
+ • Relevant bindings include
+ f :: T -> p (bound at LocalGivenEqs2.hs:14:1)
+ Suggested fix: Consider giving ‘f’ a type signature
+
=====================================
testsuite/tests/typecheck/should_compile/T24938a.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE TypeFamilies, GADTs #-}
+
+module T24938a where
+
+type family F a
+
+data T b where
+ MkT :: forall a b. F b ~ a => a -> T b
+ -- This equality is a let-bound skolem
+
+f (MkT x) = True
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -762,7 +762,7 @@ test('InstanceGivenOverlap2', expect_broken(20076), compile_fail, [''])
test('T19044', normal, compile, [''])
test('T19052', normal, compile, [''])
test('LocalGivenEqs', normal, compile, [''])
-test('LocalGivenEqs2', normal, compile, [''])
+test('LocalGivenEqs2', normal, compile_fail, [''])
test('T18891', normal, compile, [''])
test('TyAppPat_Existential', normal, compile, [''])
@@ -918,3 +918,5 @@ test('T23764', normal, compile, [''])
test('T23739a', normal, compile, [''])
test('T24810', normal, compile, [''])
test('T24887', normal, compile, [''])
+test('T24938a', normal, compile, [''])
+
=====================================
testsuite/tests/typecheck/should_fail/T22645.stderr
=====================================
@@ -1,6 +1,9 @@
-
T22645.hs:9:5: error: [GHC-25897]
- • Couldn't match type ‘a’ with ‘b’ arising from a use of ‘coerce’
+ • Could not deduce ‘a ~ b’ arising from a use of ‘coerce’
+ from the context: Coercible a b
+ bound by the type signature for:
+ p :: forall a b. Coercible a b => T Maybe a -> T Maybe b
+ at T22645.hs:8:1-44
‘a’ is a rigid type variable bound by
the type signature for:
p :: forall a b. Coercible a b => T Maybe a -> T Maybe b
@@ -13,3 +16,4 @@ T22645.hs:9:5: error: [GHC-25897]
In an equation for ‘p’: p = coerce
• Relevant bindings include
p :: T Maybe a -> T Maybe b (bound at T22645.hs:9:1)
+
=====================================
testsuite/tests/typecheck/should_fail/T24938.hs
=====================================
@@ -0,0 +1,33 @@
+{-# LANGUAGE TypeFamilyDependencies, PartialTypeSignatures #-}
+
+module T24938 where
+
+import Prelude (Int, String, undefined)
+
+data Eq a b where
+ Refl :: Eq a a
+
+type family Mt a = r | r -> a
+
+anyM :: Mt a
+anyM = undefined
+
+useIntAndRaise :: Mt Int -> a
+useIntAndRaise = undefined
+
+type family Nt a = r | r -> a
+
+use :: Nt a -> a
+use = undefined
+
+anyN :: Nt a
+anyN = undefined
+
+foo p (e :: Eq (Mt Int) (Nt String)) =
+ (case e of
+ Refl ->
+ let bar x =
+ if p then useIntAndRaise x
+ else use x
+ in
+ bar) anyM
=====================================
testsuite/tests/typecheck/should_fail/T24938.stderr
=====================================
@@ -0,0 +1,19 @@
+T24938.hs:30:16: error: [GHC-25897]
+ • Could not deduce ‘p ~ GHC.Types.Bool’
+ from the context: Nt String ~ Mt Int
+ bound by a pattern with constructor:
+ Refl :: forall {k} (a :: k). Eq a a,
+ in a case alternative
+ at T24938.hs:28:5-8
+ ‘p’ is a rigid type variable bound by
+ the inferred type of foo :: p -> Eq (Mt Int) (Nt String) -> t
+ at T24938.hs:(26,1)-(33,17)
+ • In the expression: p
+ In the expression: if p then useIntAndRaise x else use x
+ In an equation for ‘bar’:
+ bar x = if p then useIntAndRaise x else use x
+ • Relevant bindings include
+ p :: p (bound at T24938.hs:26:5)
+ foo :: p -> Eq (Mt Int) (Nt String) -> t (bound at T24938.hs:26:1)
+ Suggested fix: Consider giving ‘foo’ a type signature
+
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -728,3 +728,4 @@ test('T24470a', normal, compile_fail, [''])
test('T24553', normal, compile_fail, [''])
test('T23739b', normal, compile_fail, [''])
test('T24868', normal, compile_fail, [''])
+test('T24938', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04f5bb85c8109843b9ac2af2a3e26544d05e02f4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04f5bb85c8109843b9ac2af2a3e26544d05e02f4
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/20240620/869a3793/attachment-0001.html>
More information about the ghc-commits
mailing list