diff options
| author | Iavor S. Diatchki <iavor.diatchki@gmail.com> | 2012-03-18 14:42:06 -0700 |
|---|---|---|
| committer | Iavor S. Diatchki <iavor.diatchki@gmail.com> | 2012-03-18 14:42:06 -0700 |
| commit | 29e3d7b1cb7bb83bab0cbb7bf565aef50baa27ef (patch) | |
| tree | 1071d00b274cd72eca9c497782149fce28470236 | |
| parent | 5e10022dee2d52a4284eaf6556e27c795e20aa66 (diff) | |
| download | haskell-29e3d7b1cb7bb83bab0cbb7bf565aef50baa27ef.tar.gz | |
Only parse type literals when using `DataKinds`.
| -rw-r--r-- | compiler/parser/Lexer.x | 6 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 4 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.lhs | 14 |
3 files changed, 22 insertions, 2 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 74da99a005..2b042947b6 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -56,6 +56,7 @@ module Lexer ( getLexState, popLexState, pushLexState, extension, bangPatEnabled, datatypeContextsEnabled, traditionalRecordSyntaxEnabled, + typeLiteralsEnabled, addWarning, lexTokenStream ) where @@ -1806,6 +1807,8 @@ safeHaskellBit :: Int safeHaskellBit = 26 traditionalRecordSyntaxBit :: Int traditionalRecordSyntaxBit = 27 +typeLiteralsBit :: Int +typeLiteralsBit = 28 always :: Int -> Bool always _ = True @@ -1849,6 +1852,8 @@ nondecreasingIndentation :: Int -> Bool nondecreasingIndentation flags = testBit flags nondecreasingIndentationBit traditionalRecordSyntaxEnabled :: Int -> Bool traditionalRecordSyntaxEnabled flags = testBit flags traditionalRecordSyntaxBit +typeLiteralsEnabled :: Int -> Bool +typeLiteralsEnabled flags = testBit flags typeLiteralsBit -- PState for parsing options pragmas -- @@ -1908,6 +1913,7 @@ 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 -- setBitIf :: Int -> Bool -> Int b `setBitIf` cond | cond = bit b diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 35f8e487ab..0dd90f5337 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1080,8 +1080,8 @@ atype :: { LHsType RdrName } | SIMPLEQUOTE '(' ctype ',' comma_types1 ')' { LL $ HsExplicitTupleTy [] ($3 : $5) } | SIMPLEQUOTE '[' comma_types0 ']' { LL $ HsExplicitListTy placeHolderKind $3 } | '[' ctype ',' comma_types1 ']' { LL $ HsExplicitListTy placeHolderKind ($2 : $4) } - | INTEGER { LL $ HsTyLit $ HsNumTy $ getINTEGER $1 } - | STRING { LL $ HsTyLit $ HsStrTy $ getSTRING $1 } + | INTEGER {% mkTyLit $ LL $ HsNumTy $ getINTEGER $1 } + | STRING {% mkTyLit $ LL $ 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 9c000ee765..1bb7695b7d 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -14,6 +14,7 @@ module RdrHsSyn ( mkClassDecl, mkTyData, mkTyFamily, mkTySynonym, splitCon, mkInlinePragma, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp + mkTyLit, cvBindGroup, cvBindsAndSigs, @@ -250,6 +251,19 @@ mkTopSpliceDecl :: LHsExpr RdrName -> HsDecl RdrName mkTopSpliceDecl (L _ (HsQuasiQuoteE qq)) = QuasiQuoteD qq mkTopSpliceDecl (L _ (HsSpliceE (HsSplice _ expr))) = SpliceD (SpliceDecl expr Explicit) mkTopSpliceDecl other_expr = SpliceD (SpliceDecl other_expr Implicit) + + +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 -XDataKinds to enable):" <+> + ppr l) + + + \end{code} %************************************************************************ |