X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=5c41d7238d22df7b37f9d28152d44da04c51b611;hb=679a7c41949c438c0a6ace92b0334bb795690738;hp=2d4a225b7b8dd826979147640821ce099348bc9d;hpb=7217f562ed08b7ef8a702065d437f7b6366aea88;p=ghc-hetmet.git

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 2d4a225..5c41d72 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -51,6 +51,7 @@ module Lexer (
    failLocMsgP, failSpanMsgP, srcParseFail,
    getMessages, 
    popContext, pushCurrentContext, setLastToken, setSrcLoc,
+   activeContext, nextIsEOF,
    getLexState, popLexState, pushLexState,
    extension, bangPatEnabled, datatypeContextsEnabled,
    addWarning,
@@ -484,6 +485,8 @@ data Token
   | IToptions_prag String
   | ITinclude_prag String
   | ITlanguage_prag
+  | ITvect_prag
+  | ITvect_scalar_prag
 
   | ITdotdot  			-- reserved symbols
   | ITcolon
@@ -510,8 +513,8 @@ data Token
   | ITvocurly
   | ITvccurly
   | ITobrack
-  | ITopabrack			-- [:, for parallel arrays with -XParr
-  | ITcpabrack			-- :], for parallel arrays with -XParr
+  | ITopabrack			-- [:, for parallel arrays with -XParallelArrays
+  | ITcpabrack			-- :], for parallel arrays with -XParallelArrays
   | ITcbrack
   | IToparen
   | ITcparen
@@ -1670,6 +1673,11 @@ getInput = P $ \s@PState{ loc=l, buffer=b } -> POk s (AI l b)
 setInput :: AlexInput -> P ()
 setInput (AI l b) = P $ \s -> POk s{ loc=l, buffer=b } ()
 
+nextIsEOF :: P Bool
+nextIsEOF = do
+  AI _ s <- getInput
+  return $ atEnd s
+
 pushLexState :: Int -> P ()
 pushLexState ls = P $ \s@PState{ lex_state=l } -> POk s{lex_state=ls:l} ()
 
@@ -1684,6 +1692,15 @@ popNextToken
     = P $ \s@PState{ alr_next_token = m } ->
               POk (s {alr_next_token = Nothing}) m
 
+activeContext :: P Bool
+activeContext = do
+  ctxt <- getALRContext
+  expc <- getAlrExpectingOCurly
+  impt <- implicitTokenPending
+  case (ctxt,expc) of
+    ([],Nothing) -> return impt
+    _other       -> return True
+
 setAlrLastLoc :: SrcSpan -> P ()
 setAlrLastLoc l = P $ \s -> POk (s {alr_last_loc = l}) ()
 
@@ -1707,6 +1724,13 @@ setJustClosedExplicitLetBlock b
 setNextToken :: Located Token -> P ()
 setNextToken t = P $ \s -> POk (s {alr_next_token = Just t}) ()
 
+implicitTokenPending :: P Bool
+implicitTokenPending
+    = P $ \s@PState{ alr_pending_implicit_tokens = ts } ->
+              case ts of
+              [] -> POk s False
+              _  -> POk s True
+
 popPendingImplicitToken :: P (Maybe (Located Token))
 popPendingImplicitToken
     = P $ \s@PState{ alr_pending_implicit_tokens = ts } ->
@@ -1724,7 +1748,7 @@ setAlrExpectingOCurly :: Maybe ALRLayout -> P ()
 setAlrExpectingOCurly b = P $ \s -> POk (s {alr_expecting_ocurly = b}) ()
 
 -- for reasons of efficiency, flags indicating language extensions (eg,
--- -fglasgow-exts or -XParr) are represented by a bitmap stored in an unboxed
+-- -fglasgow-exts or -XParallelArrays) are represented by a bitmap stored in an unboxed
 -- integer
 
 genericsBit :: Int
@@ -1851,12 +1875,12 @@ mkPState flags buf loc =
     where
       bitmap = genericsBit `setBitIf` xopt Opt_Generics flags
 	       .|. ffiBit            `setBitIf` xopt Opt_ForeignFunctionInterface flags
-	       .|. parrBit           `setBitIf` xopt Opt_PArr         flags
-	       .|. arrowsBit         `setBitIf` xopt Opt_Arrows       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
+	       .|. 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
@@ -2253,13 +2277,14 @@ oneWordPrags = Map.fromList([("rules", rulePrag),
                            ("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
@@ -2278,6 +2303,7 @@ clean_pragma prag = canon_ws (map toLower (unprefix prag))
                           canonical prag' = case prag' of
                                               "noinline" -> "notinline"
                                               "specialise" -> "specialize"
+                                              "vectorise" -> "vectorize"
                                               "constructorlike" -> "conlike"
                                               _ -> prag'
                           canon_ws s = unwords (map canonical (words s))