{
-- XXX The above flags turn off warnings in the generated code:
+{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-- everywhere: skip whitespace and comments
$white_no_nl+ ;
-$tab+ { warn Opt_WarnTabs (text "Tab character") }
+$tab+ { warn Opt_WarnTabs (text "Warning: Tab character") }
-- Everywhere: deal with nested comments. We explicitly rule out
-- pragmas, "{-#", so that we don't accidentally treat them as comments.
\$ @varid / { ifExtension thEnabled } { skip_one_varid ITidEscape }
"$(" / { ifExtension thEnabled } { token ITparenEscape }
+-- For backward compatibility, accept the old dollar syntax
+ "[$" @varid "|" / { ifExtension qqEnabled }
+ { lex_quasiquote_tok }
+
"[" @varid "|" / { ifExtension qqEnabled }
{ lex_quasiquote_tok }
}
| ITdynamic
| ITsafe
| ITthreadsafe
+ | ITinterruptible
| ITunsafe
| ITstdcallconv
| ITccallconv
isSpecial ITdynamic = True
isSpecial ITsafe = True
isSpecial ITthreadsafe = True
+isSpecial ITinterruptible = True
isSpecial ITunsafe = True
isSpecial ITccallconv = True
isSpecial ITstdcallconv = True
( "dynamic", ITdynamic, bit ffiBit),
( "safe", ITsafe, bit ffiBit),
( "threadsafe", ITthreadsafe, bit ffiBit), -- ToDo: remove
+ ( "interruptible", ITinterruptible, bit ffiBit),
( "unsafe", ITunsafe, bit ffiBit),
( "stdcall", ITstdcallconv, bit ffiBit),
( "ccall", ITccallconv, bit ffiBit),
(AI l _) <- getInput
let offset = srcLocCol l
ctx <- getContext
+ relaxed <- extension relaxedLayout
+ let strict' = strict || not relaxed
case ctx of
Layout prev_off : _ |
- (strict && prev_off >= offset ||
- not strict && prev_off > offset) -> do
+ (strict' && prev_off >= offset ||
+ not strict' && prev_off > offset) -> do
-- token is indented to the left of the previous context.
-- we must generate a {} sequence now.
pushLexState layout_left
recBit = 22 -- rec
alternativeLayoutRuleBit :: Int
alternativeLayoutRuleBit = 23
+relaxedLayoutBit :: Int
+relaxedLayoutBit = 24
always :: Int -> Bool
always _ = True
oldQualOps flags = not (newQualOps flags)
alternativeLayoutRule :: Int -> Bool
alternativeLayoutRule flags = testBit flags alternativeLayoutRuleBit
+relaxedLayout :: Int -> Bool
+relaxedLayout flags = testBit flags relaxedLayoutBit
-- PState for parsing options pragmas
--
.|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags
.|. newQualOpsBit `setBitIf` xopt Opt_NewQualifiedOperators flags
.|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags
+ .|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags
--
setBitIf :: Int -> Bool -> Int
b `setBitIf` cond | cond = bit b