diff options
author | Alfredo Di Napoli <alfredo@well-typed.com> | 2021-07-06 15:26:53 +0200 |
---|---|---|
committer | Alfredo Di Napoli <alfredo@well-typed.com> | 2021-07-06 15:26:53 +0200 |
commit | fc1e2510c1fa2ffba26c9b8b84a93a62cd46c461 (patch) | |
tree | f2b3781b2c25ffc633923d608c16fd036678102e | |
parent | b4189dea79cf1d4a035f20762ed85fb194a3137f (diff) | |
download | haskell-wip/adinapoli-issue-20081.tar.gz |
Add TcRnIllegalWildcardsInConstructor to TcRnMessagewip/adinapoli-issue-20081
-rw-r--r-- | compiler/GHC/Rename/Pat.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Types.hs | 9 |
3 files changed, 18 insertions, 7 deletions
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs index f68aceaf84..28e4c806a1 100644 --- a/compiler/GHC/Rename/Pat.hs +++ b/compiler/GHC/Rename/Pat.hs @@ -806,7 +806,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) ; checkErr dd_flag (needFlagDotDot ctxt) ; (rdr_env, lcl_env) <- getRdrEnvs ; con_fields <- lookupConstructorFields con - ; when (null con_fields) (addErr (badDotDotCon con)) + ; when (null con_fields) (addErr (TcRnIllegalWildcardsInConstructor con)) ; let present_flds = mkOccSet $ map rdrNameOcc (getFieldLbls flds) -- For constructor uses (but not patterns) @@ -924,12 +924,6 @@ getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hfbLHS . unLoc) f needFlagDotDot :: HsRecFieldContext -> TcRnMessage needFlagDotDot = TcRnIllegalWildcardsInRecord . toRecordFieldPart -badDotDotCon :: Name -> TcRnMessage -badDotDotCon con - = TcRnUnknownMessage $ mkPlainError noHints $ - vcat [ text "Illegal `..' notation for constructor" <+> quotes (ppr con) - , nest 2 (text "The constructor has no labelled fields") ] - dupFieldErr :: HsRecFieldContext -> NE.NonEmpty RdrName -> TcRnMessage dupFieldErr ctxt = TcRnDuplicateFieldName (toRecordFieldPart ctxt) diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 0d842c0e2d..0ef1d48ac5 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -88,6 +88,10 @@ instance Diagnostic TcRnMessage where -> mkSimpleDecorated $ vcat [text "Illegal view pattern: " <+> ppr pat] TcRnCharLiteralOutOfRange c -> mkSimpleDecorated $ text "character literal out of range: '\\" <> char c <> char '\'' + TcRnIllegalWildcardsInConstructor con + -> mkSimpleDecorated $ + vcat [ text "Illegal `..' notation for constructor" <+> quotes (ppr con) + , nest 2 (text "The constructor has no labelled fields") ] diagnosticReason = \case TcRnUnknownMessage m @@ -131,6 +135,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnCharLiteralOutOfRange{} -> ErrorWithoutFlag + TcRnIllegalWildcardsInConstructor{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -174,6 +180,8 @@ instance Diagnostic TcRnMessage where -> [SuggestExtension LangExt.ViewPatterns] TcRnCharLiteralOutOfRange{} -> noHints + TcRnIllegalWildcardsInConstructor{} + -> noHints messageWithInfoDiagnosticMessage :: UnitState -> ErrInfo diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index 0af49bc19a..6d133bff61 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -303,6 +303,15 @@ data TcRnMessage where -} TcRnCharLiteralOutOfRange :: !Char -> TcRnMessage + {-| TcRnIllegalWildcardsInConstructor is an error that occurs whenever + the record wildcards '..' are used inside a constructor without labeled fields. + + Examples(s): None + + Test cases: None + -} + TcRnIllegalWildcardsInConstructor :: !Name -> TcRnMessage + -- | Which parts of a record field are affected by a particular error or warning. data RecordFieldPart = RecordFieldConstructor !Name |