Commit 46e8f199 authored by Rik Steenkamp's avatar Rik Steenkamp Committed by Ben Gamari

Fix a closed type family error message

Now we check whether a closed type family's equation is headed with
the correct type before we kind-check the equation.

Also, instead of "expected only no parameters" we now generate the
message "expected no parameters".

Fixes #11623.

Reviewers: simonpj, austin, bgamari

Reviewed By: simonpj, bgamari

Subscribers: simonpj, goldfire, thomie

Differential Revision: https://phabricator.haskell.org/D2089

GHC Trac Issues: #11623
parent 90538d86
......@@ -1070,12 +1070,16 @@ proper tcMatchTys here.) -}
-------------------------
kcTyFamInstEqn :: FamTyConShape -> LTyFamInstEqn Name -> TcM ()
kcTyFamInstEqn fam_tc_shape
(L loc (TyFamEqn { tfe_pats = pats, tfe_rhs = hs_ty }))
kcTyFamInstEqn fam_tc_shape@(fam_tc_name,_,_,_)
(L loc (TyFamEqn { tfe_tycon = L _ eqn_tc_name
, tfe_pats = pats
, tfe_rhs = hs_ty }))
= setSrcSpan loc $
discardResult $
tc_fam_ty_pats fam_tc_shape Nothing -- not an associated type
pats (discardResult . (tcCheckLHsType hs_ty))
do { checkTc (fam_tc_name == eqn_tc_name)
(wrongTyFamName fam_tc_name eqn_tc_name)
; discardResult $
tc_fam_ty_pats fam_tc_shape Nothing -- not an associated type
pats (discardResult . (tcCheckLHsType hs_ty)) }
tcTyFamInstEqn :: FamTyConShape -> Maybe ClsInfo -> LTyFamInstEqn Name -> TcM CoAxBranch
-- Needs to be here, not in TcInstDcls, because closed families
......@@ -1084,12 +1088,11 @@ tcTyFamInstEqn fam_tc_shape@(fam_tc_name,_,_,_) mb_clsinfo
(L loc (TyFamEqn { tfe_tycon = L _ eqn_tc_name
, tfe_pats = pats
, tfe_rhs = hs_ty }))
= setSrcSpan loc $
= ASSERT( fam_tc_name == eqn_tc_name )
setSrcSpan loc $
tcFamTyPats fam_tc_shape mb_clsinfo pats (discardResult . (tcCheckLHsType hs_ty)) $
\tvs' pats' res_kind ->
do { checkTc (fam_tc_name == eqn_tc_name)
(wrongTyFamName fam_tc_name eqn_tc_name)
; rhs_ty <- solveEqualities $ tcCheckLHsType hs_ty res_kind
do { rhs_ty <- solveEqualities $ tcCheckLHsType hs_ty res_kind
; rhs_ty <- zonkTcTypeToType emptyZonkEnv rhs_ty
; traceTc "tcTyFamInstEqn" (ppr fam_tc_name <+> pprTvBndrs tvs')
-- don't print out the pats here, as they might be zonked inside the knot
......@@ -1206,7 +1209,7 @@ tc_fam_ty_pats (name, _, binders, res_kind) mb_clsinfo
too_many_args hs_ty n
= hang (text "Too many parameters to" <+> ppr name <> colon)
2 (vcat [ ppr hs_ty <+> text "is unexpected;"
, text "expected only" <+>
, text (if n == 1 then "expected" else "expected only") <+>
speakNOf (n-1) (text "parameter") ])
-- See Note [tc_fam_ty_pats vs tcFamTyPats]
......
{-# LANGUAGE TypeFamilies #-}
module T11623 where
type family T where { Maybe T = Int }
T11623.hs:5:23: error:
• Mismatched type name in type family instance.
Expected: T
Actual: Maybe
• In the type family declaration for ‘T’
......@@ -409,6 +409,7 @@ test('T11464', normal, compile_fail, [''])
test('T11563', normal, compile_fail, [''])
test('T11541', normal, compile_fail, [''])
test('T11313', normal, compile_fail, [''])
test('T11623', normal, compile_fail, [''])
test('T11723', normal, compile_fail, [''])
test('T11724', normal, compile_fail, [''])
test('BadUnboxedTuple', 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