Commit 29e3d7b1 authored by Iavor S. Diatchki's avatar Iavor S. Diatchki

Only parse type literals when using `DataKinds`.

parent 5e10022d
......@@ -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
......
......@@ -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
......
......@@ -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}
%************************************************************************
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment