[commit: ghc] master: Complain about illegal type literals in renamer, not parser (ac157de)
git at git.haskell.org
git at git.haskell.org
Fri Sep 26 11:35:08 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/ac157de3cd959a18a71fa056403675e2c0563497/ghc
>---------------------------------------------------------------
commit ac157de3cd959a18a71fa056403675e2c0563497
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Sep 26 12:34:13 2014 +0100
Complain about illegal type literals in renamer, not parser
A premature complaint was causing Trac #9634. Acutally this
change also simplifies the lexer and eliminates duplication.
(The renamer was already making the check, as it happens.)
>---------------------------------------------------------------
ac157de3cd959a18a71fa056403675e2c0563497
compiler/parser/Lexer.x | 5 -----
compiler/parser/Parser.y.pp | 4 ++--
compiler/parser/RdrHsSyn.lhs | 12 +-----------
compiler/rename/RnTypes.lhs | 3 +--
testsuite/tests/parser/should_fail/T3811b.stderr | 2 +-
testsuite/tests/typecheck/should_fail/T9634.hs | 3 +++
testsuite/tests/typecheck/should_fail/T9634.stderr | 3 +++
testsuite/tests/typecheck/should_fail/all.T | 1 +
testsuite/tests/typecheck/should_fail/tcfail094.stderr | 2 +-
9 files changed, 13 insertions(+), 22 deletions(-)
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 8fd5bd9..aa5ddc3 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -65,7 +65,6 @@ module Lexer (
getLexState, popLexState, pushLexState,
extension, bangPatEnabled, datatypeContextsEnabled,
traditionalRecordSyntaxEnabled,
- typeLiteralsEnabled,
explicitForallEnabled,
inRulePrag,
explicitNamespacesEnabled,
@@ -1950,7 +1949,6 @@ data ExtBits
| NondecreasingIndentationBit
| SafeHaskellBit
| TraditionalRecordSyntaxBit
- | TypeLiteralsBit
| ExplicitNamespacesBit
| LambdaCaseBit
| BinaryLiteralsBit
@@ -2002,8 +2000,6 @@ sccProfilingOn :: ExtsBitmap -> Bool
sccProfilingOn = xtest SccProfilingOnBit
traditionalRecordSyntaxEnabled :: ExtsBitmap -> Bool
traditionalRecordSyntaxEnabled = xtest TraditionalRecordSyntaxBit
-typeLiteralsEnabled :: ExtsBitmap -> Bool
-typeLiteralsEnabled = xtest TypeLiteralsBit
explicitNamespacesEnabled :: ExtsBitmap -> Bool
explicitNamespacesEnabled = xtest ExplicitNamespacesBit
@@ -2074,7 +2070,6 @@ mkPState flags buf loc =
.|. NondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags
.|. SafeHaskellBit `setBitIf` safeImportsOn flags
.|. TraditionalRecordSyntaxBit `setBitIf` xopt Opt_TraditionalRecordSyntax flags
- .|. TypeLiteralsBit `setBitIf` xopt Opt_DataKinds flags
.|. ExplicitNamespacesBit `setBitIf` xopt Opt_ExplicitNamespaces flags
.|. LambdaCaseBit `setBitIf` xopt Opt_LambdaCase flags
.|. BinaryLiteralsBit `setBitIf` xopt Opt_BinaryLiterals flags
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index fcc21e1..e33808d 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -1207,8 +1207,8 @@ atype :: { LHsType RdrName }
| '[' ctype ',' comma_types1 ']' { LL $ HsExplicitListTy
placeHolderKind ($2 : $4) }
- | INTEGER {% mkTyLit $ LL $ HsNumTy $ getINTEGER $1 }
- | STRING {% mkTyLit $ LL $ HsStrTy $ getSTRING $1 }
+ | INTEGER { LL $ HsTyLit $ HsNumTy $ getINTEGER $1 }
+ | STRING { LL $ HsTyLit $ HsStrTy $ getSTRING $1 }
-- An inst_type is what occurs in the head of an instance decl
-- e.g. (Foo a, Gaz b) => Wibble a b
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 823be85..6bd5d27 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -20,7 +20,6 @@ module RdrHsSyn (
splitCon, mkInlinePragma,
splitPatSyn, toPatSynMatchGroup,
mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
- mkTyLit,
mkTyClD, mkInstD,
cvBindGroup,
@@ -261,15 +260,6 @@ mkSpliceDecl lexpr@(L loc expr)
where
splice = mkHsSplice lexpr
-mkTyLit :: Located (HsTyLit) -> P (LHsType RdrName)
-mkTyLit l =
- do allowed <- extension typeLiteralsEnabled
- if allowed
- then return (HsTyLit `fmap` l)
- else parseErrorSDoc (getLoc l)
- (text "Illegal literal in type (use DataKinds to enable):" <+>
- ppr l)
-
mkRoleAnnotDecl :: SrcSpan
-> Located RdrName -- type being annotated
-> [Located (Maybe FastString)] -- roles
@@ -430,7 +420,7 @@ splitCon ty
return (data_con, mk_rest ts)
split (L l (HsTupleTy _ [])) [] = return (L l (getRdrName unitDataCon), PrefixCon [])
-- See Note [Unit tuples] in HsTypes
- split (L l _) _ = parseErrorSDoc l (text "parse error in constructor in data/newtype declaration:" <+> ppr ty)
+ split (L l _) _ = parseErrorSDoc l (text "Cannot parse data constructor in a data/newtype declaration:" <+> ppr ty)
mk_rest [L _ (HsRecTy flds)] = RecCon flds
mk_rest ts = PrefixCon ts
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index c719191..38985a4 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -257,11 +257,10 @@ rnHsTyKi isType doc tupleTy@(HsTupleTy tup_con tys)
; (tys', fvs) <- mapFvRn (rnLHsTyKi isType doc) tys
; return (HsTupleTy tup_con tys', fvs) }
--- Perhaps we should use a separate extension here?
-- Ensure that a type-level integer is nonnegative (#8306, #8412)
rnHsTyKi isType _ tyLit@(HsTyLit t)
= do { data_kinds <- xoptM Opt_DataKinds
- ; unless (data_kinds || isType) (addErr (dataKindsErr isType tyLit))
+ ; unless data_kinds (addErr (dataKindsErr isType tyLit))
; when (negLit t) (addErr negLitErr)
; return (HsTyLit t, emptyFVs) }
where
diff --git a/testsuite/tests/parser/should_fail/T3811b.stderr b/testsuite/tests/parser/should_fail/T3811b.stderr
index 342354d..e2360b2 100644
--- a/testsuite/tests/parser/should_fail/T3811b.stderr
+++ b/testsuite/tests/parser/should_fail/T3811b.stderr
@@ -1,3 +1,3 @@
T3811b.hs:4:14:
- parse error in constructor in data/newtype declaration: !B
+ Cannot parse data constructor in a data/newtype declaration: !B
diff --git a/testsuite/tests/typecheck/should_fail/T9634.hs b/testsuite/tests/typecheck/should_fail/T9634.hs
new file mode 100644
index 0000000..57dea22
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9634.hs
@@ -0,0 +1,3 @@
+module T9634 where
+
+data X = 1
diff --git a/testsuite/tests/typecheck/should_fail/T9634.stderr b/testsuite/tests/typecheck/should_fail/T9634.stderr
new file mode 100644
index 0000000..1a2ed05
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9634.stderr
@@ -0,0 +1,3 @@
+
+T9634.hs:3:10:
+ Cannot parse data constructor in a data/newtype declaration: 1
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 431a9ba..960b5c3 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -335,3 +335,4 @@ test('T9305', normal, compile_fail, [''])
test('T9323', normal, compile_fail, [''])
test('T9415', normal, compile_fail, [''])
test('T9612', normal, compile_fail, [''])
+test('T9634', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_fail/tcfail094.stderr b/testsuite/tests/typecheck/should_fail/tcfail094.stderr
index c38674b..d3f5e76 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail094.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail094.stderr
@@ -1,3 +1,3 @@
tcfail094.hs:7:14:
- Illegal literal in type (use DataKinds to enable): 1
+ Illegal type: ‘1’ Perhaps you intended to use DataKinds
More information about the ghc-commits
mailing list