summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2014-09-26 12:34:13 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2014-09-26 12:34:53 +0100
commitac157de3cd959a18a71fa056403675e2c0563497 (patch)
tree81f474ddc5df264fa9ac57c072933467c84f394b
parent0e16cbf34d5d882c6f4800295db5fa5e2b42c342 (diff)
downloadhaskell-ac157de3cd959a18a71fa056403675e2c0563497.tar.gz
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.)
-rw-r--r--compiler/parser/Lexer.x5
-rw-r--r--compiler/parser/Parser.y.pp4
-rw-r--r--compiler/parser/RdrHsSyn.lhs12
-rw-r--r--compiler/rename/RnTypes.lhs3
-rw-r--r--testsuite/tests/parser/should_fail/T3811b.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T9634.hs3
-rw-r--r--testsuite/tests/typecheck/should_fail/T9634.stderr3
-rw-r--r--testsuite/tests/typecheck/should_fail/all.T1
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail094.stderr2
9 files changed, 13 insertions, 22 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 8fd5bd93db..aa5ddc377d 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 fcc21e11b6..e33808daac 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 823be8518a..6bd5d27b1a 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 c719191dec..38985a45d9 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 342354dd84..e2360b23ef 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 0000000000..57dea22792
--- /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 0000000000..1a2ed05ef1
--- /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 431a9ba767..960b5c3ac2 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 c38674bfa1..d3f5e7623a 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