[Git][ghc/ghc][master] Use tcInferFRR to prevent bad generalisation
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Jun 14 11:04:18 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00
Use tcInferFRR to prevent bad generalisation
Fixes #23176
- - - - -
5 changed files:
- compiler/GHC/Tc/Gen/Bind.hs
- testsuite/tests/polykinds/T22743.stderr
- + testsuite/tests/rep-poly/T23176.hs
- + testsuite/tests/rep-poly/T23176.stderr
- testsuite/tests/rep-poly/all.T
Changes:
=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -1210,20 +1210,10 @@ This check, mkInferredPolyId, is really in the wrong place:
`inferred_poly_ty` doesn't obey the PKTI and it would be better not to
generalise it in the first place; see #20686. But for now it works.
-How else could we avoid generalising over escaping type variables? I
-considered:
-
-* Adjust the generalisation in GHC.Tc.Solver to directly check for
- escaping kind variables; instead, promote or default them. But that
- gets into the defaulting swamp and is a non-trivial and unforced
- change, so I have left it alone for now.
-
-* When inferring the type of a binding, in `tcMonoBinds`, we create
- an ExpSigmaType with `tcInfer`. If we simply gave it an ir_frr field
- that said "must have fixed runtime rep", then the kind would be made
- Concrete; and we never generalise over Concrete variables. A bit
- more indirect, but we need the "don't generalise over Concrete variables"
- stuff anyway.
+I considered adjusting the generalisation in GHC.Tc.Solver to directly check for
+escaping kind variables; instead, promoting or defaulting them. But that
+gets into the defaulting swamp and is a non-trivial and unforced
+change, so I have left it alone for now.
Note [Impedance matching]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1312,7 +1302,9 @@ tcMonoBinds is_rec sig_fn no_gen
, Nothing <- sig_fn name -- ...with no type signature
= setSrcSpanA b_loc $
do { ((co_fn, matches'), rhs_ty')
- <- tcInfer $ \ exp_ty ->
+ <- tcInferFRR (FRRBinder name) $ \ exp_ty ->
+ -- tcInferFRR: the type of a let-binder must have
+ -- a fixed runtime rep. See #23176
tcExtendBinderStack [TcIdBndr_ExpType name exp_ty NotTopLevel] $
-- We extend the error context even for a non-recursive
-- function so that in type error messages we show the
@@ -1334,7 +1326,9 @@ tcMonoBinds is_rec sig_fn no_gen
| NonRecursive <- is_rec -- ...binder isn't mentioned in RHS
, all (isNothing . sig_fn) bndrs
= addErrCtxt (patMonoBindsCtxt pat grhss) $
- do { (grhss', pat_ty) <- tcInfer $ \ exp_ty ->
+ do { (grhss', pat_ty) <- tcInferFRR FRRPatBind $ \ exp_ty ->
+ -- tcInferFRR: the type of each let-binder must have
+ -- a fixed runtime rep. See #23176
tcGRHSsPat grhss exp_ty
; let exp_pat_ty :: Scaled ExpSigmaTypeFRR
=====================================
testsuite/tests/polykinds/T22743.stderr
=====================================
@@ -1,7 +1,10 @@
-T22743.hs:10:1: error: [GHC-31147]
- • Quantified type's kind mentions quantified type variable
- type: ‘forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a’
- where the body of the forall has this kind: ‘TYPE (f g)’
- • When checking the inferred type
- x :: forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a
+T22743.hs:10:1: error: [GHC-52083]
+ The binder ‘x’
+ cannot be assigned a fixed runtime representation, not even by defaulting.
+ Suggested fix: Add a type signature.
+
+T22743.hs:10:1: error: [GHC-52083]
+ The binder ‘x’
+ cannot be assigned a fixed runtime representation, not even by defaulting.
+ Suggested fix: Add a type signature.
=====================================
testsuite/tests/rep-poly/T23176.hs
=====================================
@@ -0,0 +1,6 @@
+module T23176 where
+
+import GHC.Exts
+
+f = outOfScope :: (_ :: TYPE (r s))
+(g :: _) = outOfScope :: (_ :: TYPE (r s))
=====================================
testsuite/tests/rep-poly/T23176.stderr
=====================================
@@ -0,0 +1,30 @@
+
+T23176.hs:5:1: error: [GHC-52083]
+ The binder ‘f’
+ cannot be assigned a fixed runtime representation, not even by defaulting.
+ Suggested fix: Add a type signature.
+
+T23176.hs:5:1: error: [GHC-52083]
+ The binder ‘f’
+ cannot be assigned a fixed runtime representation, not even by defaulting.
+ Suggested fix: Add a type signature.
+
+T23176.hs:5:1: error: [GHC-52083]
+ The binder ‘f’
+ cannot be assigned a fixed runtime representation, not even by defaulting.
+ Suggested fix: Add a type signature.
+
+T23176.hs:6:1: error: [GHC-52083]
+ The pattern binding
+ cannot be assigned a fixed runtime representation, not even by defaulting.
+ Suggested fix: Add a type signature.
+
+T23176.hs:6:1: error: [GHC-52083]
+ The pattern binding
+ cannot be assigned a fixed runtime representation, not even by defaulting.
+ Suggested fix: Add a type signature.
+
+T23176.hs:6:1: error: [GHC-52083]
+ The pattern binding
+ cannot be assigned a fixed runtime representation, not even by defaulting.
+ Suggested fix: Add a type signature.
=====================================
testsuite/tests/rep-poly/all.T
=====================================
@@ -118,3 +118,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ##
test('T23051', normal, compile_fail, [''])
test('T23153', normal, compile_fail, [''])
test('T23154', normal, compile_fail, [''])
+test('T23176', normal, compile_fail, ['-XPartialTypeSignatures -fdefer-out-of-scope-variables'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b80ef202d24a3d529d4409d7a6815a9644ea32a9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b80ef202d24a3d529d4409d7a6815a9644ea32a9
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/20230614/5454a918/attachment-0001.html>
More information about the ghc-commits
mailing list