diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2014-09-26 12:34:13 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2014-09-26 12:34:53 +0100 |
commit | ac157de3cd959a18a71fa056403675e2c0563497 (patch) | |
tree | 81f474ddc5df264fa9ac57c072933467c84f394b | |
parent | 0e16cbf34d5d882c6f4800295db5fa5e2b42c342 (diff) | |
download | haskell-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.x | 5 | ||||
-rw-r--r-- | compiler/parser/Parser.y.pp | 4 | ||||
-rw-r--r-- | compiler/parser/RdrHsSyn.lhs | 12 | ||||
-rw-r--r-- | compiler/rename/RnTypes.lhs | 3 | ||||
-rw-r--r-- | testsuite/tests/parser/should_fail/T3811b.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/T9634.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/T9634.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/all.T | 1 | ||||
-rw-r--r-- | 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 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 |