diff options
| author | HE, Tao <sighingnow@gmail.com> | 2018-02-12 19:55:41 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-02-13 17:49:43 -0500 |
| commit | 8936ab69d18669bab3ca4edf40458f88ae5903f0 (patch) | |
| tree | f793c1a8f115a0956386a78f355d30836805272e /compiler | |
| parent | 0c9777b787d072f9f57e0cdfe44e2e2d48217077 (diff) | |
| download | haskell-8936ab69d18669bab3ca4edf40458f88ae5903f0.tar.gz | |
Raise parse error for `data T where`.
Empty GADTs data declarations can't be identified in type checker. This
patch adds additional checks in parser and raise a parse error when
encounter empty GADTs declarations but extension `GADTs` is not enabled.
Only empty declarations are checked in parser to avoid affecting
existing
error messages related to missing GADTs extension.
This patch should fix issue 8258.
Signed-off-by: HE, Tao <sighingnow@gmail.com>
Test Plan: make test TEST="T8258 T8258NoGADTs"
Reviewers: bgamari, mpickering, alanz, RyanGlScott
Reviewed By: bgamari, RyanGlScott
Subscribers: adamse, RyanGlScott, rwbarton, thomie, mpickering, carter
GHC Trac Issues: #8258
Differential Revision: https://phabricator.haskell.org/D4350
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/parser/Parser.y | 19 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 16 |
2 files changed, 27 insertions, 8 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 7f1a725b6b..898ed3c5ae 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2087,14 +2087,17 @@ both become a HsTyVar ("Zero", DataName) after the renamer. gadt_constrlist :: { Located ([AddAnn] ,[LConDecl GhcPs]) } -- Returned in order - : 'where' '{' gadt_constrs '}' { L (comb2 $1 $3) - ([mj AnnWhere $1 - ,moc $2 - ,mcc $4] - , unLoc $3) } - | 'where' vocurly gadt_constrs close { L (comb2 $1 $3) - ([mj AnnWhere $1] - , unLoc $3) } + + : 'where' '{' gadt_constrs '}' {% checkEmptyGADTs $ + L (comb2 $1 $3) + ([mj AnnWhere $1 + ,moc $2 + ,mcc $4] + , unLoc $3) } + | 'where' vocurly gadt_constrs close {% checkEmptyGADTs $ + L (comb2 $1 $3) + ([mj AnnWhere $1] + , unLoc $3) } | {- empty -} { noLoc ([],[]) } gadt_constrs :: { Located [LConDecl GhcPs] } diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 357d22438a..6ac6cbc974 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -55,6 +55,7 @@ module RdrHsSyn ( checkValSigLhs, checkDoAndIfThenElse, checkRecordSyntax, + checkEmptyGADTs, parseErrorSDoc, hintBangPat, splitTilde, splitTildeApps, @@ -783,6 +784,21 @@ checkRecordSyntax lr@(L loc r) (text "Illegal record syntax (use TraditionalRecordSyntax):" <+> ppr r) +-- | Check if the gadt_constrlist is empty. Only raise parse error for +-- `data T where` to avoid affecting existing error message, see #8258. +checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs]) + -> P (Located ([AddAnn], [LConDecl GhcPs])) +checkEmptyGADTs gadts@(L span (_, [])) -- Empty GADT declaration. + = do opts <- fmap options getPState + if LangExt.GADTSyntax `extopt` opts -- GADTs implies GADTSyntax + then return gadts + else parseErrorSDoc span $ vcat + [ text "Illegal keyword 'where' in data declaration" + , text "Perhaps you intended to use GADTs or a similar language" + , text "extension to enable syntax: data T where" + ] +checkEmptyGADTs gadts = return gadts -- Ordinary GADT declaration. + checkTyClHdr :: Bool -- True <=> class header -- False <=> type header -> LHsType GhcPs |