diff options
Diffstat (limited to 'compiler/parser/Lexer.x')
| -rw-r--r-- | compiler/parser/Lexer.x | 104 |
1 files changed, 63 insertions, 41 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 69dc0992c8..2887edff04 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -68,6 +68,8 @@ module Lexer ( explicitNamespacesEnabled, patternSynonymsEnabled, sccProfilingOn, hpcEnabled, + typeOperatorsEnabled, + starIsTypeEnabled, addWarning, lexTokenStream, addAnnotation,AddAnn,addAnnsAt,mkParensApiAnn, @@ -682,6 +684,7 @@ data Token | ITdarrow IsUnicodeSyntax | ITminus | ITbang + | ITstar IsUnicodeSyntax | ITdot | ITbiglam -- GHC-extension symbols @@ -893,6 +896,8 @@ reservedSymsFM = listToUFM $ ,("-", ITminus, always) ,("!", ITbang, always) + ,("*", ITstar NormalSyntax, starIsTypeEnabled) + -- For 'forall a . t' ,(".", ITdot, always) -- \i -> explicitForallEnabled i || inRulePrag i) @@ -915,6 +920,8 @@ reservedSymsFM = listToUFM $ \i -> unicodeSyntaxEnabled i && arrowsEnabled i) ,("⤜", ITRarrowtail UnicodeSyntax, \i -> unicodeSyntaxEnabled i && arrowsEnabled i) + ,("★", ITstar UnicodeSyntax, + \i -> unicodeSyntaxEnabled i && starIsTypeEnabled i) -- ToDo: ideally, → and ∷ should be "specials", so that they cannot -- form part of a large operator. This would let us have a better @@ -2257,6 +2264,8 @@ data ExtBits | TypeApplicationsBit | StaticPointersBit | NumericUnderscoresBit + | TypeOperatorsBit + | StarIsTypeBit deriving Enum @@ -2325,6 +2334,10 @@ staticPointersEnabled :: ExtsBitmap -> Bool staticPointersEnabled = xtest StaticPointersBit numericUnderscoresEnabled :: ExtsBitmap -> Bool numericUnderscoresEnabled = xtest NumericUnderscoresBit +typeOperatorsEnabled :: ExtsBitmap -> Bool +typeOperatorsEnabled = xtest TypeOperatorsBit +starIsTypeEnabled :: ExtsBitmap -> Bool +starIsTypeEnabled = xtest StarIsTypeBit -- PState for parsing options pragmas -- @@ -2343,47 +2356,56 @@ mkParserFlags flags = , pExtsBitmap = bitmap } where - bitmap = FfiBit `setBitIf` xopt LangExt.ForeignFunctionInterface flags - .|. InterruptibleFfiBit `setBitIf` xopt LangExt.InterruptibleFFI flags - .|. CApiFfiBit `setBitIf` xopt LangExt.CApiFFI flags - .|. ArrowsBit `setBitIf` xopt LangExt.Arrows flags - .|. ThBit `setBitIf` xopt LangExt.TemplateHaskell flags - .|. ThQuotesBit `setBitIf` xopt LangExt.TemplateHaskellQuotes flags - .|. QqBit `setBitIf` xopt LangExt.QuasiQuotes flags - .|. IpBit `setBitIf` xopt LangExt.ImplicitParams flags - .|. OverloadedLabelsBit `setBitIf` xopt LangExt.OverloadedLabels flags - .|. ExplicitForallBit `setBitIf` xopt LangExt.ExplicitForAll flags - .|. BangPatBit `setBitIf` xopt LangExt.BangPatterns flags - .|. HaddockBit `setBitIf` gopt Opt_Haddock flags - .|. MagicHashBit `setBitIf` xopt LangExt.MagicHash flags - .|. RecursiveDoBit `setBitIf` xopt LangExt.RecursiveDo flags - .|. UnicodeSyntaxBit `setBitIf` xopt LangExt.UnicodeSyntax flags - .|. UnboxedTuplesBit `setBitIf` xopt LangExt.UnboxedTuples flags - .|. UnboxedSumsBit `setBitIf` xopt LangExt.UnboxedSums flags - .|. DatatypeContextsBit `setBitIf` xopt LangExt.DatatypeContexts flags - .|. TransformComprehensionsBit `setBitIf` xopt LangExt.TransformListComp flags - .|. TransformComprehensionsBit `setBitIf` xopt LangExt.MonadComprehensions flags - .|. RawTokenStreamBit `setBitIf` gopt Opt_KeepRawTokenStream flags - .|. HpcBit `setBitIf` gopt Opt_Hpc flags - .|. AlternativeLayoutRuleBit `setBitIf` xopt LangExt.AlternativeLayoutRule flags - .|. RelaxedLayoutBit `setBitIf` xopt LangExt.RelaxedLayout flags - .|. SccProfilingOnBit `setBitIf` gopt Opt_SccProfilingOn flags - .|. NondecreasingIndentationBit `setBitIf` xopt LangExt.NondecreasingIndentation flags - .|. SafeHaskellBit `setBitIf` safeImportsOn flags - .|. TraditionalRecordSyntaxBit `setBitIf` xopt LangExt.TraditionalRecordSyntax flags - .|. ExplicitNamespacesBit `setBitIf` xopt LangExt.ExplicitNamespaces flags - .|. LambdaCaseBit `setBitIf` xopt LangExt.LambdaCase flags - .|. BinaryLiteralsBit `setBitIf` xopt LangExt.BinaryLiterals flags - .|. NegativeLiteralsBit `setBitIf` xopt LangExt.NegativeLiterals flags - .|. HexFloatLiteralsBit `setBitIf` xopt LangExt.HexFloatLiterals flags - .|. PatternSynonymsBit `setBitIf` xopt LangExt.PatternSynonyms flags - .|. TypeApplicationsBit `setBitIf` xopt LangExt.TypeApplications flags - .|. StaticPointersBit `setBitIf` xopt LangExt.StaticPointers flags - .|. NumericUnderscoresBit `setBitIf` xopt LangExt.NumericUnderscores flags - - setBitIf :: ExtBits -> Bool -> ExtsBitmap - b `setBitIf` cond | cond = xbit b - | otherwise = 0 + bitmap = safeHaskellBit .|. langExtBits .|. optBits + safeHaskellBit = + SafeHaskellBit `setBitIf` safeImportsOn flags + langExtBits = + FfiBit `xoptBit` LangExt.ForeignFunctionInterface + .|. InterruptibleFfiBit `xoptBit` LangExt.InterruptibleFFI + .|. CApiFfiBit `xoptBit` LangExt.CApiFFI + .|. ArrowsBit `xoptBit` LangExt.Arrows + .|. ThBit `xoptBit` LangExt.TemplateHaskell + .|. ThQuotesBit `xoptBit` LangExt.TemplateHaskellQuotes + .|. QqBit `xoptBit` LangExt.QuasiQuotes + .|. IpBit `xoptBit` LangExt.ImplicitParams + .|. OverloadedLabelsBit `xoptBit` LangExt.OverloadedLabels + .|. ExplicitForallBit `xoptBit` LangExt.ExplicitForAll + .|. BangPatBit `xoptBit` LangExt.BangPatterns + .|. MagicHashBit `xoptBit` LangExt.MagicHash + .|. RecursiveDoBit `xoptBit` LangExt.RecursiveDo + .|. UnicodeSyntaxBit `xoptBit` LangExt.UnicodeSyntax + .|. UnboxedTuplesBit `xoptBit` LangExt.UnboxedTuples + .|. UnboxedSumsBit `xoptBit` LangExt.UnboxedSums + .|. DatatypeContextsBit `xoptBit` LangExt.DatatypeContexts + .|. TransformComprehensionsBit `xoptBit` LangExt.TransformListComp + .|. TransformComprehensionsBit `xoptBit` LangExt.MonadComprehensions + .|. AlternativeLayoutRuleBit `xoptBit` LangExt.AlternativeLayoutRule + .|. RelaxedLayoutBit `xoptBit` LangExt.RelaxedLayout + .|. NondecreasingIndentationBit `xoptBit` LangExt.NondecreasingIndentation + .|. TraditionalRecordSyntaxBit `xoptBit` LangExt.TraditionalRecordSyntax + .|. ExplicitNamespacesBit `xoptBit` LangExt.ExplicitNamespaces + .|. LambdaCaseBit `xoptBit` LangExt.LambdaCase + .|. BinaryLiteralsBit `xoptBit` LangExt.BinaryLiterals + .|. NegativeLiteralsBit `xoptBit` LangExt.NegativeLiterals + .|. HexFloatLiteralsBit `xoptBit` LangExt.HexFloatLiterals + .|. PatternSynonymsBit `xoptBit` LangExt.PatternSynonyms + .|. TypeApplicationsBit `xoptBit` LangExt.TypeApplications + .|. StaticPointersBit `xoptBit` LangExt.StaticPointers + .|. NumericUnderscoresBit `xoptBit` LangExt.NumericUnderscores + .|. TypeOperatorsBit `xoptBit` LangExt.TypeOperators + .|. StarIsTypeBit `xoptBit` LangExt.StarIsType + optBits = + HaddockBit `goptBit` Opt_Haddock + .|. RawTokenStreamBit `goptBit` Opt_KeepRawTokenStream + .|. HpcBit `goptBit` Opt_Hpc + .|. SccProfilingOnBit `goptBit` Opt_SccProfilingOn + + xoptBit bit ext = bit `setBitIf` xopt ext flags + goptBit bit opt = bit `setBitIf` gopt opt flags + + setBitIf :: ExtBits -> Bool -> ExtsBitmap + b `setBitIf` cond | cond = xbit b + | otherwise = 0 -- | Creates a parse state from a 'DynFlags' value mkPState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState |