[commit: ghc] ghc-8.0: Fix two wrong uses of "data constructor" in error msgs (f3fe3c5)
git at git.haskell.org
git at git.haskell.org
Thu Feb 18 12:02:38 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.0
Link : http://ghc.haskell.org/trac/ghc/changeset/f3fe3c5e2cc417e8c8724de4468b22de670e413e/ghc
>---------------------------------------------------------------
commit f3fe3c5e2cc417e8c8724de4468b22de670e413e
Author: Rik Steenkamp <rik at ewps.nl>
Date: Tue Feb 16 22:42:08 2016 +0100
Fix two wrong uses of "data constructor" in error msgs
Replace `NoDataKinds :: PromotionErr` by `NoDataKindsTC` and
`NoDataKindsDC` (just like there is `NoTypeInTypeTC` and
`NoTypeInTypeDC`). This allows for a correct error message when a kind
signature contains a type constructor and `-XDataKinds` is not
specified.
Apply a small fix to `TcError.hs` where instead of "data constructor" we
should say "pattern synonym".
Reviewers: austin, goldfire, bgamari
Reviewed By: bgamari
Subscribers: goldfire, thomie
Differential Revision: https://phabricator.haskell.org/D1909
(cherry picked from commit af5a0e5004cfb1e041280fd7c16f2c1bfee67961)
>---------------------------------------------------------------
f3fe3c5e2cc417e8c8724de4468b22de670e413e
compiler/typecheck/TcErrors.hs | 6 ++++--
compiler/typecheck/TcHsType.hs | 9 +++++----
compiler/typecheck/TcRnTypes.hs | 9 ++++++---
3 files changed, 15 insertions(+), 9 deletions(-)
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 1985147..0d8057d 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -39,6 +39,7 @@ import NameSet
import Bag
import ErrUtils ( ErrMsg, errDoc, pprLocErrMsg )
import BasicTypes
+import ConLike ( ConLike(..) )
import Util
import FastString
import Outputable
@@ -1833,8 +1834,9 @@ mk_dict_err ctxt (ct, (matches, unifiers, unsafe_overlapped))
| orig <- origs ] ] ]
| otherwise = []
- ppr_skol (PatSkol dc _) = text "the data constructor" <+> quotes (ppr dc)
- ppr_skol skol_info = ppr skol_info
+ ppr_skol (PatSkol (RealDataCon dc) _) = text "the data constructor" <+> quotes (ppr dc)
+ ppr_skol (PatSkol (PatSynCon ps) _) = text "the pattern synonym" <+> quotes (ppr ps)
+ ppr_skol skol_info = ppr skol_info
extra_note | any isFunTy (filterOutInvisibleTypes (classTyCon clas) tys)
= text "(maybe you haven't applied a function to enough arguments?)"
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index f5537b6..d04ee97 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -987,7 +987,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon
ATcTyCon tc_tc -> do { data_kinds <- xoptM LangExt.DataKinds
; unless (isTypeLevel (mode_level mode) ||
data_kinds) $
- promotionErr name NoDataKinds
+ promotionErr name NoDataKindsTC
; tc <- get_loopy_tc name tc_tc
; return (mkNakedTyConApp tc [], tyConKind tc_tc) }
-- mkNakedTyConApp: see Note [Type-checking inside the knot]
@@ -1001,7 +1001,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon
; unless (isTypeLevel (mode_level mode) ||
data_kinds ||
isKindTyCon tc) $
- promotionErr name NoDataKinds
+ promotionErr name NoDataKindsTC
; unless (isTypeLevel (mode_level mode) ||
type_in_type ||
isLegacyPromotableTyCon tc) $
@@ -1011,7 +1011,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon
AGlobal (AConLike (RealDataCon dc))
-> do { data_kinds <- xoptM LangExt.DataKinds
; unless (data_kinds || specialPromotedDc dc) $
- promotionErr name NoDataKinds
+ promotionErr name NoDataKindsDC
; type_in_type <- xoptM LangExt.TypeInType
; unless ( type_in_type ||
( isTypeLevel (mode_level mode) &&
@@ -2142,7 +2142,8 @@ promotionErr name err
where
reason = case err of
FamDataConPE -> text "it comes from a data family instance"
- NoDataKinds -> text "Perhaps you intended to use DataKinds"
+ NoDataKindsTC -> text "Perhaps you intended to use DataKinds"
+ NoDataKindsDC -> text "Perhaps you intended to use DataKinds"
NoTypeInTypeTC -> text "Perhaps you intended to use TypeInType"
NoTypeInTypeDC -> text "Perhaps you intended to use TypeInType"
PatSynPE -> text "Pattern synonyms cannot be promoted"
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 35d434e..38fc5c9 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -905,7 +905,8 @@ data PromotionErr
| RecDataConPE -- Data constructor in a recursive loop
-- See Note [ARecDataCon: recusion and promoting data constructors] in TcTyClsDecls
- | NoDataKinds -- -XDataKinds not enabled
+ | NoDataKindsTC -- -XDataKinds not enabled (for a tycon)
+ | NoDataKindsDC -- -XDataKinds not enabled (for a datacon)
| NoTypeInTypeTC -- -XTypeInType not enabled (for a tycon)
| NoTypeInTypeDC -- -XTypeInType not enabled (for a datacon)
@@ -925,7 +926,8 @@ instance Outputable PromotionErr where
ppr PatSynPE = text "PatSynPE"
ppr FamDataConPE = text "FamDataConPE"
ppr RecDataConPE = text "RecDataConPE"
- ppr NoDataKinds = text "NoDataKinds"
+ ppr NoDataKindsTC = text "NoDataKindsTC"
+ ppr NoDataKindsDC = text "NoDataKindsDC"
ppr NoTypeInTypeTC = text "NoTypeInTypeTC"
ppr NoTypeInTypeDC = text "NoTypeInTypeDC"
@@ -942,7 +944,8 @@ pprPECategory TyConPE = text "Type constructor"
pprPECategory PatSynPE = text "Pattern synonym"
pprPECategory FamDataConPE = text "Data constructor"
pprPECategory RecDataConPE = text "Data constructor"
-pprPECategory NoDataKinds = text "Data constructor"
+pprPECategory NoDataKindsTC = text "Type constructor"
+pprPECategory NoDataKindsDC = text "Data constructor"
pprPECategory NoTypeInTypeTC = text "Type constructor"
pprPECategory NoTypeInTypeDC = text "Data constructor"
More information about the ghc-commits
mailing list