getLexState, popLexState, pushLexState,
extension, bangPatEnabled, datatypeContextsEnabled,
addWarning,
- incrBracketDepth, decrBracketDepth, getParserBrakDepth,
+ incrBracketDepth, incrBracketDepth1, decrBracketDepth, getParserBrakDepth, pushBracketDepth, popBracketDepth,
lexTokenStream
) where
import Ctype
import BasicTypes ( InlineSpec(..), RuleMatchInfo(..), FractionalLit(..) )
import Util ( readRational )
+import HsSyn (CodeFlavor(..))
import Control.Monad
import Data.Bits
"<[" / { ifExtension hetMetEnabled `alexAndPred` notFollowedBySymbol }
{ special ITopenBrak }
"]>" / { ifExtension hetMetEnabled } { special ITcloseBrak }
+ "<{" / { ifExtension hetMetEnabled `alexAndPred` notFollowedBySymbol }
+ { special ITopenBrak1 }
+ "}>" / { ifExtension hetMetEnabled } { special ITcloseBrak1 }
"~~" / { ifExtension hetMetEnabled } { special ITescape }
"%%" / { ifExtension hetMetEnabled } { special ITdoublePercent }
"~~$" / { ifExtension hetMetEnabled } { special ITescapeDollar }
| ITvbar
| ITlarrow
| ITrarrow
+ | ITkappa
| ITat
| ITtilde
| ITdarrow
-- Heterogeneous Metaprogramming extension
| ITopenBrak -- <[
| ITcloseBrak -- ]>
+ | ITopenBrak1 -- <{
+ | ITcloseBrak1 -- }>
| ITescape -- ~~
| ITescapeDollar -- ~~$
| ITdoublePercent -- %%
,("|", ITvbar, always)
,("<-", ITlarrow, always)
,("->", ITrarrow, always)
+ ,("~~>", ITkappa, always)
,("@", ITat, always)
,("~", ITtilde, always)
,("=>", ITdarrow, always)
-- Have we just had the '}' for a let block? If so, than an 'in'
-- token doesn't need to close anything:
alr_justClosedExplicitLetBlock :: Bool,
- code_type_bracket_depth :: Int
+ code_type_bracket_depth :: [CodeFlavor],
+ code_type_bracket_depth_stack :: [CodeFlavor]
}
-- last_loc and last_len are used when generating error messages,
-- and in pushCurrentContext only. Sigh, if only Happy passed the
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}) ()
+incrBracketDepth = P $ \s -> POk (s{code_type_bracket_depth = KappaFlavor:(code_type_bracket_depth s)}) ()
+incrBracketDepth1 :: P ()
+incrBracketDepth1 = P $ \s -> POk (s{code_type_bracket_depth = LambdaFlavor:(code_type_bracket_depth s)}) ()
decrBracketDepth :: P ()
-decrBracketDepth = P $ \s -> POk (s{code_type_bracket_depth = (code_type_bracket_depth s)-1}) ()
-getParserBrakDepth :: P Int
+decrBracketDepth = P $ \s -> POk (s{code_type_bracket_depth = tail (code_type_bracket_depth s)}) ()
+pushBracketDepth :: P ()
+pushBracketDepth = P $ \s -> POk (s{code_type_bracket_depth = tail (code_type_bracket_depth s),
+ code_type_bracket_depth_stack = (head (code_type_bracket_depth s)):(code_type_bracket_depth_stack s)
+ }) ()
+popBracketDepth :: P ()
+popBracketDepth = P $ \s -> POk (s{code_type_bracket_depth = (head (code_type_bracket_depth_stack s)):(code_type_bracket_depth s),
+ code_type_bracket_depth_stack = tail (code_type_bracket_depth_stack s)
+ }) ()
+getParserBrakDepth :: P [CodeFlavor]
getParserBrakDepth = P $ \s -> POk s (code_type_bracket_depth s)
getSrcLoc :: P RealSrcLoc
alr_context = [],
alr_expecting_ocurly = Nothing,
alr_justClosedExplicitLetBlock = False,
- code_type_bracket_depth = 0
+ code_type_bracket_depth = [],
+ code_type_bracket_depth_stack = []
}
where
bitmap = ffiBit `setBitIf` xopt Opt_ForeignFunctionInterface flags