diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 22 |
1 files changed, 19 insertions, 3 deletions
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 5784b9ecdb..e4f74d6b73 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -25,6 +25,7 @@ module RdrHsSyn ( mkTyClD, mkInstD, mkRdrRecordCon, mkRdrRecordUpd, setRdrNameSpace, + filterCTuple, cvBindGroup, cvBindsAndSigs, @@ -91,7 +92,8 @@ import Lexeme ( isLexCon ) import Type ( TyThing(..) ) import TysWiredIn ( cTupleTyConName, tupleTyCon, tupleDataCon, nilDataConName, nilDataConKey, - listTyConName, listTyConKey, eqTyCon_RDR ) + listTyConName, listTyConKey, eqTyCon_RDR, + tupleTyConName, cTupleTyConNameArity_maybe ) import ForeignCall import PrelNames ( forall_tv_RDR, allNameStrings ) import SrcLoc @@ -765,6 +767,13 @@ data_con_ty_con dc | otherwise -- See Note [setRdrNameSpace for wired-in names] = Unqual (setOccNameSpace tcClsName (getOccName dc)) +-- | Replaces constraint tuple names with corresponding boxed ones. +filterCTuple :: RdrName -> RdrName +filterCTuple (Exact n) + | Just arity <- cTupleTyConNameArity_maybe n + = Exact $ tupleTyConName BoxedTuple arity +filterCTuple rdr = rdr + {- Note [setRdrNameSpace for wired-in names] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -809,12 +818,19 @@ checkTyVars pp_what equals_or_where tc tparms chk t@(L loc _) = Left (loc, vcat [ text "Unexpected type" <+> quotes (ppr t) - , text "In the" <+> pp_what <+> ptext (sLit "declaration for") <+> quotes (ppr tc) + , text "In the" <+> pp_what <+> ptext (sLit "declaration for") <+> quotes tc' , vcat[ (text "A" <+> pp_what <+> ptext (sLit "declaration should have form")) - , nest 2 (pp_what <+> ppr tc + , nest 2 (pp_what <+> tc' <+> hsep (map text (takeList tparms allNameStrings)) <+> equals_or_where) ] ]) + -- Avoid printing a constraint tuple in the error message. Print + -- a plain old tuple instead (since that's what the user probably + -- wrote). See #14907 + tc' = ppr $ fmap filterCTuple tc + + + whereDots, equalsDots :: SDoc -- Second argument to checkTyVars whereDots = text "where ..." |