getLexState, popLexState, pushLexState,
extension, bangPatEnabled, datatypeContextsEnabled,
addWarning,
+ incrBracketDepth, decrBracketDepth, getParserBrakDepth,
lexTokenStream
) where
}
<0> {
+ "<[" / { ifExtension hetMetEnabled `alexAndPred` notFollowedBySymbol }
+ { special ITopenBrak }
+ "]>" / { ifExtension hetMetEnabled } { special ITcloseBrak }
+ "~~" / { ifExtension hetMetEnabled } { special ITescape }
+ "%%" / { ifExtension hetMetEnabled } { special ITdoublePercent }
+ "~~$" / { ifExtension hetMetEnabled } { special ITescapeDollar }
+}
+
+<0> {
\? @varid / { ifExtension ipEnabled } { skip_one_varid ITdupipvarid }
}
| ITLarrowtail -- -<<
| ITRarrowtail -- >>-
+ -- Heterogeneous Metaprogramming extension
+ | ITopenBrak -- <[
+ | ITcloseBrak -- ]>
+ | ITescape -- ~~
+ | ITescapeDollar -- ~~$
+ | ITdoublePercent -- %%
+
| ITunknown String -- Used when the lexer can't make sense of it
| ITeof -- end of file token
alr_expecting_ocurly :: Maybe ALRLayout,
-- Have we just had the '}' for a let block? If so, than an 'in'
-- token doesn't need to close anything:
- alr_justClosedExplicitLetBlock :: Bool
+ alr_justClosedExplicitLetBlock :: Bool,
+ code_type_bracket_depth :: Int
}
-- last_loc and last_len are used when generating error messages,
-- and in pushCurrentContext only. Sigh, if only Happy passed the
setSrcLoc :: RealSrcLoc -> P ()
setSrcLoc new_loc = P $ \s -> POk s{loc=new_loc} ()
+incrBracketDepth :: P ()
+incrBracketDepth = P $ \s -> POk (s{code_type_bracket_depth = (code_type_bracket_depth s)+1}) ()
+decrBracketDepth :: P ()
+decrBracketDepth = P $ \s -> POk (s{code_type_bracket_depth = (code_type_bracket_depth s)-1}) ()
+getParserBrakDepth :: P Int
+getParserBrakDepth = P $ \s -> POk s (code_type_bracket_depth s)
+
getSrcLoc :: P RealSrcLoc
getSrcLoc = P $ \s@(PState{ loc=loc }) -> POk s loc
relaxedLayoutBit = 24
nondecreasingIndentationBit :: Int
nondecreasingIndentationBit = 25
+hetMetBit :: Int
+hetMetBit = 31
always :: Int -> Bool
always _ = True
parrEnabled flags = testBit flags parrBit
arrowsEnabled :: Int -> Bool
arrowsEnabled flags = testBit flags arrowsBit
+hetMetEnabled :: Int -> Bool
+hetMetEnabled flags = testBit flags hetMetBit
thEnabled :: Int -> Bool
thEnabled flags = testBit flags thBit
ipEnabled :: Int -> Bool
alr_last_loc = alrInitialLoc (fsLit "<no file>"),
alr_context = [],
alr_expecting_ocurly = Nothing,
- alr_justClosedExplicitLetBlock = False
+ alr_justClosedExplicitLetBlock = False,
+ code_type_bracket_depth = 0
}
where
bitmap = ffiBit `setBitIf` xopt Opt_ForeignFunctionInterface flags
.|. parrBit `setBitIf` xopt Opt_ParallelArrays flags
.|. arrowsBit `setBitIf` xopt Opt_Arrows flags
+ .|. hetMetBit `setBitIf` xopt Opt_ModalTypes flags
.|. thBit `setBitIf` xopt Opt_TemplateHaskell flags
.|. qqBit `setBitIf` xopt Opt_QuasiQuotes flags
.|. ipBit `setBitIf` xopt Opt_ImplicitParams flags