Commit 3c74a512 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Deal with large extra-contraints wildcards

For reasons explained in TcHsType
Note [Extra-constraint holes in partial type signatures],
if we had
  f :: (_) => blahs
and the '_' was filled in by more than a 62-tuple of contraints,
GHC crashed.

The same Note explains the hacky solution I have adopted to
evade this.  Maybe there is some better way, but I couldn't
see one that didn't involve a great deal of work. And the problem
is a very narrow one!  If the hack bites us we'll need to think
again.
parent b3ae47ca
......@@ -621,12 +621,13 @@ Note [How tuples work] See also Note [Known-key names] in PrelNames
- Given constraints: the superclasses automatically become available
- Wanted constraints: there is a built-in instance
instance (c1,c2) => (c1,c2)
- Currently just go up to 16; beyond that
See TcInteract.matchCTuple
- Currently just go up to 62; beyond that
you have to use manual nesting
- Their OccNames look like (%,,,%), so they can easily be
distinguished from term tuples. But (following Haskell) we
pretty-print saturated constraint tuples with round parens; see
BasicTypes.tupleParens.
pretty-print saturated constraint tuples with round parens;
see BasicTypes.tupleParens.
* In quite a lot of places things are restrcted just to
BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish
......
......@@ -42,7 +42,7 @@ import TyCon
import TcType
import Type( mkStrLitTy, tidyOpenType, splitTyConApp_maybe)
import TysPrim
import TysWiredIn( cTupleTyConName )
import TysWiredIn( cTupleTyConName, mkBoxedTupleTy )
import Id
import Var
import VarSet
......@@ -959,20 +959,20 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
keep_me = psig_qtvs `unionVarSet` free_tvs
my_theta = pickCapturedPreds keep_me inferred_theta
-- Report the inferred constraints for an extra-constraints wildcard/hole as
-- an error message, unless the PartialTypeSignatures flag is enabled. In this
-- case, the extra inferred constraints are accepted without complaining.
-- NB: inferred_theta already includes all the annotated constraints
-- Fill in the extra-constraints wildcard hole with inferred_theta,
-- so that the Hole constraint we have already emitted (in tcHsPartialSigType)
-- can report what filled it in.
-- NB: my_theta already includes all the annotated constraints
inferred_diff = [ pred
| pred <- my_theta
, all (not . (`eqType` pred)) annotated_theta ]
; ctuple <- mk_ctuple inferred_diff
; writeMetaTyVar wc_var ctuple
; traceTc "completeTheta" $
vcat [ ppr sig
, ppr annotated_theta, ppr inferred_theta
, ppr inferred_diff ]
; return (my_qtvs, my_theta) }
| otherwise -- A complete type signature is dealt with in mkInferredPolyId
......@@ -988,9 +988,9 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
where
keep_me = free_tvs `unionVarSet` psig_qtvs
mk_ctuple [pred] = return pred
mk_ctuple preds = do { tc <- tcLookupTyCon (cTupleTyConName (length preds))
; return (mkTyConApp tc preds) }
mk_ctuple preds = return (mkBoxedTupleTy preds)
-- Hack alert! See TcHsType:
-- Note [Extra-constraint holes in partial type signatures]
mk_psig_qtvs :: [(Name,TcTyVar)] -> TcM TcTyVarSet
mk_psig_qtvs annotated_tvs
......
......@@ -1962,7 +1962,7 @@ It isn't essential for correctness.
************************************************************************
* *
Partial signatures and pattern signatures
Partial signatures
* *
************************************************************************
......@@ -1998,6 +1998,9 @@ tcHsPartialSigType ctxt sig_ty
; return ( (wcs, wcx, explicit_tvs, theta, tau)
, bound_tvs) }
-- Spit out the wildcards (including the extra-constraints one)
-- as "hole" constraints, so that they'll be reported if necessary
-- See Note [Extra-constraint holes in partial type signatures]
; emitWildCardHoleConstraints wcs
; explicit_tvs <- mapM zonkTyCoVarKind explicit_tvs
......@@ -2026,6 +2029,53 @@ tcPartialContext hs_theta
= do { theta <- mapM tcLHsPredType hs_theta
; return (theta, Nothing) }
{- Note [Extra-constraint holes in partial type signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
f :: (_) => a -> a
f x = ...
* The renamer makes a wildcard name for the "_", and puts it in
the hswc_wcs field.
* Then, in tcHsPartialSigType, we make a new hole TcTyVar, in
tcWildCardBindersX.
* TcBinds.chooseInferredQuantifiers fills in that hole TcTyVar
with the inferred constraints, e.g. (Eq a, Show a)
* TcErrors.mkHoleError finally reports the error.
An annoying difficulty happens if there are more than 62 inferred
constraints. Then we need to fill in the TcTyVar with (say) a 70-tuple.
Where do we find the TyCon? For good reasons we only have constraint
tuples up to 62 (see Note [How tuples work] in TysWiredIn). So how
can we make a 70-tuple? This was the root cause of Trac #14217.
It's incredibly tiresome, becuase we only need this type to fill
in the hole, to commuincate to the error reporting machinery. Nothing
more. So I use a HACK:
* I make an /ordinary/ tuple of the constraints, in
TcBinds.chooseInferredQuantifiers. This is ill-kinded because
ordinary tuples can't contain contraints, but it works fine. And for
ordinary tuples we don't have the same limit as for constraint
tuples (which need selectors and an assocated class).
* Because it is ill-kided, it trips an assert in writeMetaTyVar,
so now I disable the assertion if we are writing a type of
kind Constraint. (That seldom/never normally happens so we aren't
losing much.)
Result works fine, but it may eventually bite us.
************************************************************************
* *
Pattern signatures (i.e signatures that occur in patterns)
* *
********************************************************************* -}
tcHsPatSigType :: UserTypeCtxt
-> LHsSigWcType GhcRn -- The type signature
-> TcM ( [(Name, TcTyVar)] -- Wildcards
......
......@@ -24,7 +24,7 @@ module TcMType (
cloneMetaTyVar,
newFmvTyVar, newFskTyVar,
readMetaTyVar, writeMetaTyVar, writeMetaTyVarRef,
readMetaTyVar, writeMetaTyVar,
newMetaDetails, isFilledMetaTyVar, isUnfilledMetaTyVar,
--------------------------------
......@@ -677,8 +677,11 @@ writeMetaTyVarRef tyvar ref ty
; zonked_tv_kind <- zonkTcType tv_kind
; zonked_ty_kind <- zonkTcType ty_kind
; let kind_check_ok = isPredTy tv_kind -- Don't check kinds for updates
-- to coercion variables
-- to coercion variables. Why not??
|| isConstraintKind zonked_tv_kind
|| tcEqKind zonked_ty_kind zonked_tv_kind
-- Hack alert! isConstraintKind: see TcHsType
-- Note [Extra-constraint holes in partial type signatures]
kind_msg = hang (text "Ill-kinded update to meta tyvar")
2 ( ppr tyvar <+> text "::" <+> (ppr tv_kind $$ ppr zonked_tv_kind)
......
{- # LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
module T14217 where
data Foo a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
a21 a22 a23 a24 a25 a26 a27 a28 a29 a30
a31 a32 a33 a34 a35 a36 a37 a38 a39 a40
a41 a42 a43 a44 a45 a46 a47 a48 a49 a50
a51 a52 a53 a54 a55 a56 a57 a58 a59 a60
a61 a62 a63
= MkFoo
eq :: ( Eq a1, Eq a2 , Eq a3 , Eq a4 , Eq a5 , Eq a6 , Eq a7 , Eq a8 , Eq a9, Eq a10
, Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20
, Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30
, Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40
, Eq a41, Eq a42, Eq a43, Eq a44, Eq a45, Eq a46, Eq a47, Eq a48, Eq a49, Eq a50
, Eq a51, Eq a52, Eq a53, Eq a54, Eq a55, Eq a56, Eq a57, Eq a58, Eq a59, Eq a60
, Eq a61, Eq a62, Eq a63)
=> Foo a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
a21 a22 a23 a24 a25 a26 a27 a28 a29 a30
a31 a32 a33 a34 a35 a36 a37 a38 a39 a40
a41 a42 a43 a44 a45 a46 a47 a48 a49 a50
a51 a52 a53 a54 a55 a56 a57 a58 a59 a60
a61 a62 a63
-> Bool
eq = error "urk"
eqFoo :: (_)
=> Foo a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
a21 a22 a23 a24 a25 a26 a27 a28 a29 a30
a31 a32 a33 a34 a35 a36 a37 a38 a39 a40
a41 a42 a43 a44 a45 a46 a47 a48 a49 a50
a51 a52 a53 a54 a55 a56 a57 a58 a59 a60
a61 a62 a63
-> Bool
eqFoo x = eq x
T14217.hs:32:11: error:
• Found type wildcard ‘_’
standing for ‘(Eq a63, Eq a62, Eq a61, Eq a60, Eq a59, Eq a58,
Eq a57, Eq a56, Eq a55, Eq a54, Eq a53, Eq a52, Eq a51, Eq a50,
Eq a49, Eq a48, Eq a47, Eq a46, Eq a45, Eq a44, Eq a43, Eq a42,
Eq a41, Eq a40, Eq a39, Eq a38, Eq a37, Eq a36, Eq a35, Eq a34,
Eq a33, Eq a32, Eq a31, Eq a30, Eq a29, Eq a28, Eq a27, Eq a26,
Eq a25, Eq a24, Eq a23, Eq a22, Eq a21, Eq a20, Eq a19, Eq a18,
Eq a17, Eq a16, Eq a15, Eq a14, Eq a13, Eq a12, Eq a11, Eq a10,
Eq a9, Eq a8, Eq a7, Eq a6, Eq a5, Eq a4, Eq a3, Eq a2, Eq a1)’
Where: ‘a63’, ‘a62’, ‘a61’, ‘a60’, ‘a59’, ‘a58’, ‘a57’, ‘a56’,
‘a55’, ‘a54’, ‘a53’, ‘a52’, ‘a51’, ‘a50’, ‘a49’, ‘a48’, ‘a47’,
‘a46’, ‘a45’, ‘a44’, ‘a43’, ‘a42’, ‘a41’, ‘a40’, ‘a39’, ‘a38’,
‘a37’, ‘a36’, ‘a35’, ‘a34’, ‘a33’, ‘a32’, ‘a31’, ‘a30’, ‘a29’,
‘a28’, ‘a27’, ‘a26’, ‘a25’, ‘a24’, ‘a23’, ‘a22’, ‘a21’, ‘a20’,
‘a19’, ‘a18’, ‘a17’, ‘a16’, ‘a15’, ‘a14’, ‘a13’, ‘a12’, ‘a11’,
‘a10’, ‘a9’, ‘a8’, ‘a7’, ‘a6’, ‘a5’, ‘a4’, ‘a3’, ‘a2’, ‘a1’
are rigid type variables bound by
the inferred type of
eqFoo :: (Eq a63, Eq a62, Eq a61, Eq a60, Eq a59, Eq a58, Eq a57,
Eq a56, Eq a55, Eq a54, Eq a53, Eq a52, Eq a51, Eq a50, Eq a49,
Eq a48, Eq a47, Eq a46, Eq a45, Eq a44, Eq a43, Eq a42, Eq a41,
Eq a40, Eq a39, Eq a38, Eq a37, Eq a36, Eq a35, Eq a34, Eq a33,
Eq a32, Eq a31, Eq a30, Eq a29, Eq a28, Eq a27, Eq a26, Eq a25,
Eq a24, Eq a23, Eq a22, Eq a21, Eq a20, Eq a19, Eq a18, Eq a17,
Eq a16, Eq a15, Eq a14, Eq a13, Eq a12, Eq a11, Eq a10, Eq a9,
Eq a8, Eq a7, Eq a6, Eq a5, Eq a4, Eq a3, Eq a2, Eq a1) =>
Foo
a1
a2
a3
a4
a5
a6
a7
a8
a9
a10
a11
a12
a13
a14
a15
a16
a17
a18
a19
a20
a21
a22
a23
a24
a25
a26
a27
a28
a29
a30
a31
a32
a33
a34
a35
a36
a37
a38
a39
a40
a41
a42
a43
a44
a45
a46
a47
a48
a49
a50
a51
a52
a53
a54
a55
a56
a57
a58
a59
a60
a61
a62
a63
-> Bool
at T14217.hs:41:1-14
To use the inferred type, enable PartialTypeSignatures
• In the type signature:
eqFoo :: _ =>
Foo a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 a61 a62 a63
-> Bool
......@@ -70,3 +70,4 @@ test('T12531', normal, compile, ['-fdefer-typed-holes'])
test('T12845', normal, compile, [''])
test('T12844', normal, compile, [''])
test('T13482', normal, compile, [''])
test('T14217', normal, compile_fail, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment