import DynFlags
import Module
import Ctype
-import BasicTypes ( InlineSpec(..), RuleMatchInfo(..) )
+import BasicTypes ( InlineSpec(..), RuleMatchInfo(..), FractionalLit(..) )
import Util ( readRational )
import Control.Monad
{ token ITcubxparen }
}
-<0> {
- "{|" / { ifExtension genericsEnabled } { token ITocurlybar }
- "|}" / { ifExtension genericsEnabled } { token ITccurlybar }
-}
-
<0,option_prags> {
\( { special IToparen }
\) { special ITcparen }
| IToptions_prag String
| ITinclude_prag String
| ITlanguage_prag
+ | ITvect_prag
+ | ITvect_scalar_prag
| ITdotdot -- reserved symbols
| ITcolon
| ITchar Char
| ITstring FastString
| ITinteger Integer
- | ITrational Rational
+ | ITrational FractionalLit
| ITprimchar Char
| ITprimstring FastString
| ITprimint Integer
| ITprimword Integer
- | ITprimfloat Rational
- | ITprimdouble Rational
+ | ITprimfloat FractionalLit
+ | ITprimdouble FractionalLit
-- Template Haskell extension tokens
| ITopenExpQuote -- [| or [e|
-- readRational can understand negative rationals, exponents, everything.
tok_float, tok_primfloat, tok_primdouble :: String -> Token
-tok_float str = ITrational $! readRational str
-tok_primfloat str = ITprimfloat $! readRational str
-tok_primdouble str = ITprimdouble $! readRational str
+tok_float str = ITrational $! readFractionalLit str
+tok_primfloat str = ITprimfloat $! readFractionalLit str
+tok_primdouble str = ITprimdouble $! readFractionalLit str
+
+readFractionalLit :: String -> FractionalLit
+readFractionalLit str = (FL $! str) $! readRational str
-- -----------------------------------------------------------------------------
-- Layout processing
-- -fglasgow-exts or -XParallelArrays) are represented by a bitmap stored in an unboxed
-- integer
-genericsBit :: Int
-genericsBit = 0 -- {| and |}
+-- The "genericsBit" is now unused, available for others
+-- genericsBit :: Int
+-- genericsBit = 0 -- {|, |} and "generic"
+
ffiBit :: Int
ffiBit = 1
parrBit :: Int
always :: Int -> Bool
always _ = True
-genericsEnabled :: Int -> Bool
-genericsEnabled flags = testBit flags genericsBit
parrEnabled :: Int -> Bool
parrEnabled flags = testBit flags parrBit
arrowsEnabled :: Int -> Bool
mkPState :: DynFlags -> StringBuffer -> SrcLoc -> PState
mkPState flags buf loc =
PState {
- buffer = buf,
+ buffer = buf,
dflags = flags,
messages = emptyMessages,
last_loc = mkSrcSpan loc loc,
alr_justClosedExplicitLetBlock = False
}
where
- bitmap = genericsBit `setBitIf` xopt Opt_Generics flags
- .|. ffiBit `setBitIf` xopt Opt_ForeignFunctionInterface flags
- .|. parrBit `setBitIf` xopt Opt_ParallelArrays flags
- .|. arrowsBit `setBitIf` xopt Opt_Arrows flags
- .|. thBit `setBitIf` xopt Opt_TemplateHaskell flags
- .|. qqBit `setBitIf` xopt Opt_QuasiQuotes flags
- .|. ipBit `setBitIf` xopt Opt_ImplicitParams flags
- .|. explicitForallBit `setBitIf` xopt Opt_ExplicitForAll flags
- .|. bangPatBit `setBitIf` xopt Opt_BangPatterns flags
- .|. tyFamBit `setBitIf` xopt Opt_TypeFamilies flags
- .|. haddockBit `setBitIf` dopt Opt_Haddock flags
- .|. magicHashBit `setBitIf` xopt Opt_MagicHash flags
- .|. kindSigsBit `setBitIf` xopt Opt_KindSignatures flags
- .|. recursiveDoBit `setBitIf` xopt Opt_RecursiveDo flags
- .|. recBit `setBitIf` xopt Opt_DoRec flags
- .|. recBit `setBitIf` xopt Opt_Arrows flags
- .|. unicodeSyntaxBit `setBitIf` xopt Opt_UnicodeSyntax flags
- .|. unboxedTuplesBit `setBitIf` xopt Opt_UnboxedTuples flags
+ bitmap = ffiBit `setBitIf` xopt Opt_ForeignFunctionInterface flags
+ .|. parrBit `setBitIf` xopt Opt_ParallelArrays flags
+ .|. arrowsBit `setBitIf` xopt Opt_Arrows flags
+ .|. thBit `setBitIf` xopt Opt_TemplateHaskell flags
+ .|. qqBit `setBitIf` xopt Opt_QuasiQuotes flags
+ .|. ipBit `setBitIf` xopt Opt_ImplicitParams flags
+ .|. explicitForallBit `setBitIf` xopt Opt_ExplicitForAll flags
+ .|. bangPatBit `setBitIf` xopt Opt_BangPatterns flags
+ .|. tyFamBit `setBitIf` xopt Opt_TypeFamilies flags
+ .|. haddockBit `setBitIf` dopt Opt_Haddock flags
+ .|. magicHashBit `setBitIf` xopt Opt_MagicHash flags
+ .|. kindSigsBit `setBitIf` xopt Opt_KindSignatures flags
+ .|. recursiveDoBit `setBitIf` xopt Opt_RecursiveDo flags
+ .|. recBit `setBitIf` xopt Opt_DoRec flags
+ .|. recBit `setBitIf` xopt Opt_Arrows flags
+ .|. unicodeSyntaxBit `setBitIf` xopt Opt_UnicodeSyntax flags
+ .|. unboxedTuplesBit `setBitIf` xopt Opt_UnboxedTuples flags
.|. datatypeContextsBit `setBitIf` xopt Opt_DatatypeContexts flags
.|. transformComprehensionsBit `setBitIf` xopt Opt_TransformListComp flags
+ .|. transformComprehensionsBit `setBitIf` xopt Opt_MonadComprehensions flags
.|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags
.|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags
- .|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags
+ .|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags
.|. nondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags
--
setBitIf :: Int -> Bool -> Int
b `setBitIf` cond | cond = bit b
- | otherwise = 0
+ | otherwise = 0
addWarning :: DynFlag -> SrcSpan -> SDoc -> P ()
addWarning option srcspan warning
("generated", token ITgenerated_prag),
("core", token ITcore_prag),
("unpack", token ITunpack_prag),
- ("ann", token ITann_prag)])
+ ("ann", token ITann_prag),
+ ("vectorize", token ITvect_prag)])
twoWordPrags = Map.fromList([("inline conlike", token (ITinline_prag Inline ConLike)),
("notinline conlike", token (ITinline_prag NoInline ConLike)),
("specialize inline", token (ITspec_inline_prag True)),
- ("specialize notinline", token (ITspec_inline_prag False))])
-
+ ("specialize notinline", token (ITspec_inline_prag False)),
+ ("vectorize scalar", token ITvect_scalar_prag)])
dispatch_pragmas :: Map String Action -> Action
dispatch_pragmas prags span buf len = case Map.lookup (clean_pragma (lexemeToString buf len)) prags of
canonical prag' = case prag' of
"noinline" -> "notinline"
"specialise" -> "specialize"
+ "vectorise" -> "vectorize"
"constructorlike" -> "conlike"
_ -> prag'
canon_ws s = unwords (map canonical (words s))