Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/29e3d7b1cb7bb83bab0cbb7bf565aef50baa27ef >--------------------------------------------------------------- commit 29e3d7b1cb7bb83bab0cbb7bf565aef50baa27ef Author: Iavor S. Diatchki <[email protected]> Date: Sun Mar 18 14:42:06 2012 -0700 Only parse type literals when using `DataKinds`. >--------------------------------------------------------------- compiler/parser/Lexer.x | 6 ++++++ compiler/parser/Parser.y.pp | 4 ++-- 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 74da99a..2b04294 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 35f8e48..0dd90f5 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 9c000ee..1bb7695 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} %************************************************************************ _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
