{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
module Language.Haskell.Exts.ParseMonad(
Parseable(..),
P, ParseResult(..), atSrcLoc, LexContext(..),
ParseMode(..), defaultParseMode, fromParseResult,
runParserWithMode, runParserWithModeComments, runParser,
getSrcLoc, pushCurrentContext, popContext,
getExtensions, getIgnoreFunctionArity,
Lex(runL), getInput, discard, getLastChar, lexNewline,
lexTab, lexWhile, lexWhile_,
alternative, checkBOL, setBOL, startToken, getOffside,
pushContextL, popContextL, getExtensionsL, addExtensionL,
saveExtensionsL, restoreExtensionsL, pushComment,
getSrcLocL, setSrcLineL, ignoreLinePragmasL, setLineFilenameL,
ExtContext(..),
pushExtContextL, popExtContextL, getExtContext,
pullCtxtFlag, flagDo,
getModuleName
) where
import Language.Haskell.Exts.SrcLoc (SrcLoc(..), noLoc)
import Language.Haskell.Exts.Fixity (Fixity, preludeFixities)
import Language.Haskell.Exts.Comments
import Language.Haskell.Exts.Extension
import Data.List (intercalate)
import Control.Applicative
import Control.Monad (when, liftM, ap)
import qualified Control.Monad.Fail as Fail
import Data.Monoid hiding ((<>))
#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup (Semigroup(..))
#endif
import Prelude
class Parseable ast where
parse :: String -> ParseResult ast
parse = forall ast. Parseable ast => ParseMode -> String -> ParseResult ast
parseWithMode ParseMode
defaultParseMode
parseWithMode :: ParseMode -> String -> ParseResult ast
parseWithMode ParseMode
mode = forall a. ParseMode -> P a -> String -> ParseResult a
runParserWithMode ParseMode
mode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ast. Parseable ast => Maybe [Fixity] -> P ast
parser forall a b. (a -> b) -> a -> b
$ ParseMode -> Maybe [Fixity]
fixities ParseMode
mode
:: ParseMode -> String -> ParseResult (ast, [Comment])
parseWithComments ParseMode
mode = forall a. ParseMode -> P a -> String -> ParseResult (a, [Comment])
runParserWithModeComments ParseMode
mode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ast. Parseable ast => Maybe [Fixity] -> P ast
parser forall a b. (a -> b) -> a -> b
$ ParseMode -> Maybe [Fixity]
fixities ParseMode
mode
parser :: Maybe [Fixity] -> P ast
data ParseResult a
= ParseOk a
| ParseFailed SrcLoc String
deriving (Int -> ParseResult a -> ShowS
forall a. Show a => Int -> ParseResult a -> ShowS
forall a. Show a => [ParseResult a] -> ShowS
forall a. Show a => ParseResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseResult a] -> ShowS
$cshowList :: forall a. Show a => [ParseResult a] -> ShowS
show :: ParseResult a -> String
$cshow :: forall a. Show a => ParseResult a -> String
showsPrec :: Int -> ParseResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ParseResult a -> ShowS
Show, ParseResult a -> ParseResult a -> Bool
ParseResult a -> ParseResult a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ParseResult a)
forall a. Ord a => ParseResult a -> ParseResult a -> Bool
forall a. Ord a => ParseResult a -> ParseResult a -> Ordering
forall a. Ord a => ParseResult a -> ParseResult a -> ParseResult a
min :: ParseResult a -> ParseResult a -> ParseResult a
$cmin :: forall a. Ord a => ParseResult a -> ParseResult a -> ParseResult a
max :: ParseResult a -> ParseResult a -> ParseResult a
$cmax :: forall a. Ord a => ParseResult a -> ParseResult a -> ParseResult a
>= :: ParseResult a -> ParseResult a -> Bool
$c>= :: forall a. Ord a => ParseResult a -> ParseResult a -> Bool
> :: ParseResult a -> ParseResult a -> Bool
$c> :: forall a. Ord a => ParseResult a -> ParseResult a -> Bool
<= :: ParseResult a -> ParseResult a -> Bool
$c<= :: forall a. Ord a => ParseResult a -> ParseResult a -> Bool
< :: ParseResult a -> ParseResult a -> Bool
$c< :: forall a. Ord a => ParseResult a -> ParseResult a -> Bool
compare :: ParseResult a -> ParseResult a -> Ordering
$ccompare :: forall a. Ord a => ParseResult a -> ParseResult a -> Ordering
Ord, ParseResult a -> ParseResult a -> Bool
forall a. Eq a => ParseResult a -> ParseResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseResult a -> ParseResult a -> Bool
$c/= :: forall a. Eq a => ParseResult a -> ParseResult a -> Bool
== :: ParseResult a -> ParseResult a -> Bool
$c== :: forall a. Eq a => ParseResult a -> ParseResult a -> Bool
Eq)
fromParseResult :: ParseResult a -> a
fromParseResult :: forall a. ParseResult a -> a
fromParseResult (ParseOk a
a) = a
a
fromParseResult (ParseFailed SrcLoc
loc String
str) = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"fromParseResult: Parse failed at ["
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
srcFilename SrcLoc
loc forall a. [a] -> [a] -> [a]
++ String
"] (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SrcLoc -> Int
srcLine SrcLoc
loc) forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SrcLoc -> Int
srcColumn SrcLoc
loc) forall a. [a] -> [a] -> [a]
++ String
"): " forall a. [a] -> [a] -> [a]
++ String
str
instance Functor ParseResult where
fmap :: forall a b. (a -> b) -> ParseResult a -> ParseResult b
fmap a -> b
f (ParseOk a
x) = forall a. a -> ParseResult a
ParseOk forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
fmap a -> b
_ (ParseFailed SrcLoc
loc String
msg) = forall a. SrcLoc -> String -> ParseResult a
ParseFailed SrcLoc
loc String
msg
instance Applicative ParseResult where
pure :: forall a. a -> ParseResult a
pure = forall a. a -> ParseResult a
ParseOk
ParseOk a -> b
f <*> :: forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
<*> ParseResult a
x = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseResult a
x
ParseFailed SrcLoc
loc String
msg <*> ParseResult a
_ = forall a. SrcLoc -> String -> ParseResult a
ParseFailed SrcLoc
loc String
msg
instance Monad ParseResult where
return :: forall a. a -> ParseResult a
return = forall a. a -> ParseResult a
ParseOk
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
ParseOk a
x >>= :: forall a b. ParseResult a -> (a -> ParseResult b) -> ParseResult b
>>= a -> ParseResult b
f = a -> ParseResult b
f a
x
ParseFailed SrcLoc
loc String
msg >>= a -> ParseResult b
_ = forall a. SrcLoc -> String -> ParseResult a
ParseFailed SrcLoc
loc String
msg
instance Fail.MonadFail ParseResult where
fail :: forall a. String -> ParseResult a
fail = forall a. SrcLoc -> String -> ParseResult a
ParseFailed SrcLoc
noLoc
instance Semigroup m => Semigroup (ParseResult m) where
ParseOk m
x <> :: ParseResult m -> ParseResult m -> ParseResult m
<> ParseOk m
y = forall a. a -> ParseResult a
ParseOk forall a b. (a -> b) -> a -> b
$ m
x forall a. Semigroup a => a -> a -> a
<> m
y
ParseOk m
_ <> ParseResult m
err = ParseResult m
err
ParseResult m
err <> ParseResult m
_ = ParseResult m
err
instance ( Monoid m , Semigroup m) => Monoid (ParseResult m) where
mempty :: ParseResult m
mempty = forall a. a -> ParseResult a
ParseOk forall a. Monoid a => a
mempty
mappend :: ParseResult m -> ParseResult m -> ParseResult m
mappend = forall a. Semigroup a => a -> a -> a
(<>)
data ParseStatus a = Ok ParseState a | Failed SrcLoc String
deriving Int -> ParseStatus a -> ShowS
forall a. Show a => Int -> ParseStatus a -> ShowS
forall a. Show a => [ParseStatus a] -> ShowS
forall a. Show a => ParseStatus a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseStatus a] -> ShowS
$cshowList :: forall a. Show a => [ParseStatus a] -> ShowS
show :: ParseStatus a -> String
$cshow :: forall a. Show a => ParseStatus a -> String
showsPrec :: Int -> ParseStatus a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ParseStatus a -> ShowS
Show
data LexContext = NoLayout | Layout Int
deriving (LexContext -> LexContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LexContext -> LexContext -> Bool
$c/= :: LexContext -> LexContext -> Bool
== :: LexContext -> LexContext -> Bool
$c== :: LexContext -> LexContext -> Bool
Eq,Eq LexContext
LexContext -> LexContext -> Bool
LexContext -> LexContext -> Ordering
LexContext -> LexContext -> LexContext
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LexContext -> LexContext -> LexContext
$cmin :: LexContext -> LexContext -> LexContext
max :: LexContext -> LexContext -> LexContext
$cmax :: LexContext -> LexContext -> LexContext
>= :: LexContext -> LexContext -> Bool
$c>= :: LexContext -> LexContext -> Bool
> :: LexContext -> LexContext -> Bool
$c> :: LexContext -> LexContext -> Bool
<= :: LexContext -> LexContext -> Bool
$c<= :: LexContext -> LexContext -> Bool
< :: LexContext -> LexContext -> Bool
$c< :: LexContext -> LexContext -> Bool
compare :: LexContext -> LexContext -> Ordering
$ccompare :: LexContext -> LexContext -> Ordering
Ord,Int -> LexContext -> ShowS
[LexContext] -> ShowS
LexContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LexContext] -> ShowS
$cshowList :: [LexContext] -> ShowS
show :: LexContext -> String
$cshow :: LexContext -> String
showsPrec :: Int -> LexContext -> ShowS
$cshowsPrec :: Int -> LexContext -> ShowS
Show)
data ExtContext = CodeCtxt | HarpCtxt | TagCtxt | ChildCtxt
| CloseTagCtxt | CodeTagCtxt
deriving (ExtContext -> ExtContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtContext -> ExtContext -> Bool
$c/= :: ExtContext -> ExtContext -> Bool
== :: ExtContext -> ExtContext -> Bool
$c== :: ExtContext -> ExtContext -> Bool
Eq,Eq ExtContext
ExtContext -> ExtContext -> Bool
ExtContext -> ExtContext -> Ordering
ExtContext -> ExtContext -> ExtContext
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExtContext -> ExtContext -> ExtContext
$cmin :: ExtContext -> ExtContext -> ExtContext
max :: ExtContext -> ExtContext -> ExtContext
$cmax :: ExtContext -> ExtContext -> ExtContext
>= :: ExtContext -> ExtContext -> Bool
$c>= :: ExtContext -> ExtContext -> Bool
> :: ExtContext -> ExtContext -> Bool
$c> :: ExtContext -> ExtContext -> Bool
<= :: ExtContext -> ExtContext -> Bool
$c<= :: ExtContext -> ExtContext -> Bool
< :: ExtContext -> ExtContext -> Bool
$c< :: ExtContext -> ExtContext -> Bool
compare :: ExtContext -> ExtContext -> Ordering
$ccompare :: ExtContext -> ExtContext -> Ordering
Ord,Int -> ExtContext -> ShowS
[ExtContext] -> ShowS
ExtContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtContext] -> ShowS
$cshowList :: [ExtContext] -> ShowS
show :: ExtContext -> String
$cshow :: ExtContext -> String
showsPrec :: Int -> ExtContext -> ShowS
$cshowsPrec :: Int -> ExtContext -> ShowS
Show)
type CtxtFlag = (Bool,Bool)
type ParseState = ([LexContext],[[KnownExtension]],[ExtContext],CtxtFlag,[Comment])
indentOfParseState :: ParseState -> Int
indentOfParseState :: ParseState -> Int
indentOfParseState (Layout Int
n:[LexContext]
_,[[KnownExtension]]
_,[ExtContext]
_,(Bool, Bool)
_,[Comment]
_) = Int
n
indentOfParseState ParseState
_ = Int
0
data ParseMode = ParseMode {
ParseMode -> String
parseFilename :: String,
ParseMode -> Language
baseLanguage :: Language,
ParseMode -> [Extension]
extensions :: [Extension],
ParseMode -> Bool
ignoreLanguagePragmas :: Bool,
ParseMode -> Bool
ignoreLinePragmas :: Bool,
ParseMode -> Maybe [Fixity]
fixities :: Maybe [Fixity],
ParseMode -> Bool
ignoreFunctionArity :: Bool
}
defaultParseMode :: ParseMode
defaultParseMode :: ParseMode
defaultParseMode = ParseMode {
parseFilename :: String
parseFilename = String
"<unknown>.hs",
baseLanguage :: Language
baseLanguage = Language
Haskell2010,
extensions :: [Extension]
extensions = [],
ignoreLanguagePragmas :: Bool
ignoreLanguagePragmas = Bool
False,
ignoreLinePragmas :: Bool
ignoreLinePragmas = Bool
True,
fixities :: Maybe [Fixity]
fixities = forall a. a -> Maybe a
Just [Fixity]
preludeFixities,
ignoreFunctionArity :: Bool
ignoreFunctionArity = Bool
False
}
data InternalParseMode = IParseMode {
InternalParseMode -> String
iParseFilename :: String,
InternalParseMode -> [KnownExtension]
iExtensions :: [KnownExtension],
InternalParseMode -> Bool
iIgnoreLinePragmas :: Bool,
InternalParseMode -> Bool
iIgnoreFunctionArity :: Bool
}
toInternalParseMode :: ParseMode -> InternalParseMode
toInternalParseMode :: ParseMode -> InternalParseMode
toInternalParseMode (ParseMode String
pf Language
bLang [Extension]
exts Bool
_ilang Bool
iline Maybe [Fixity]
_fx Bool
farity) =
String -> [KnownExtension] -> Bool -> Bool -> InternalParseMode
IParseMode String
pf (Language -> [Extension] -> [KnownExtension]
toExtensionList Language
bLang [Extension]
exts) Bool
iline Bool
farity
newtype P a = P { forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP ::
String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
}
runParserWithMode :: ParseMode -> P a -> String -> ParseResult a
runParserWithMode :: forall a. ParseMode -> P a -> String -> ParseResult a
runParserWithMode ParseMode
mode P a
pm = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParseMode -> P a -> String -> ParseResult (a, [Comment])
runParserWithModeComments ParseMode
mode P a
pm
runParser :: P a -> String -> ParseResult a
runParser :: forall a. P a -> String -> ParseResult a
runParser = forall a. ParseMode -> P a -> String -> ParseResult a
runParserWithMode ParseMode
defaultParseMode
runParserWithModeComments :: ParseMode -> P a -> String -> ParseResult (a, [Comment])
ParseMode
mode = let mode2 :: InternalParseMode
mode2 = ParseMode -> InternalParseMode
toInternalParseMode ParseMode
mode in \(P String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
m) String
s ->
case String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
m String
s Int
0 Int
1 SrcLoc
start Char
'\n' ([],[],[],(Bool
False,Bool
False),[]) InternalParseMode
mode2 of
Ok ([LexContext]
_,[[KnownExtension]]
_,[ExtContext]
_,(Bool, Bool)
_,[Comment]
cs) a
a -> forall a. a -> ParseResult a
ParseOk (a
a, forall a. [a] -> [a]
reverse [Comment]
cs)
Failed SrcLoc
loc String
msg -> forall a. SrcLoc -> String -> ParseResult a
ParseFailed SrcLoc
loc String
msg
where start :: SrcLoc
start = SrcLoc {
srcFilename :: String
srcFilename = ParseMode -> String
parseFilename ParseMode
mode,
srcLine :: Int
srcLine = Int
1,
srcColumn :: Int
srcColumn = Int
1
}
instance Functor P where
fmap :: forall a b. (a -> b) -> P a -> P b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative P where
pure :: forall a. a -> P a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. P (a -> b) -> P a -> P b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad P where
return :: forall a. a -> P a
return a
a = forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
_l Char
_ch ParseState
s InternalParseMode
_m -> forall a. ParseState -> a -> ParseStatus a
Ok ParseState
s a
a
P String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
m >>= :: forall a b. P a -> (a -> P b) -> P b
>>= a -> P b
k = forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
i Int
x Int
y SrcLoc
l Char
ch ParseState
s InternalParseMode
mode ->
case String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
m String
i Int
x Int
y SrcLoc
l Char
ch ParseState
s InternalParseMode
mode of
Failed SrcLoc
loc String
msg -> forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc String
msg
Ok ParseState
s' a
a -> forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (a -> P b
k a
a) String
i Int
x Int
y SrcLoc
l Char
ch ParseState
s' InternalParseMode
mode
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance Fail.MonadFail P where
fail :: forall a. String -> P a
fail String
s = forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_r Int
_col Int
_line SrcLoc
loc Char
_ ParseState
_stk InternalParseMode
_m -> forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc String
s
atSrcLoc :: P a -> SrcLoc -> P a
P String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
m atSrcLoc :: forall a. P a -> SrcLoc -> P a
`atSrcLoc` SrcLoc
loc = forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
i Int
x Int
y SrcLoc
_l Char
ch -> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
m String
i Int
x Int
y SrcLoc
loc Char
ch
getSrcLoc :: P SrcLoc
getSrcLoc :: P SrcLoc
getSrcLoc = forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
l Char
_ ParseState
s InternalParseMode
_m -> forall a. ParseState -> a -> ParseStatus a
Ok ParseState
s SrcLoc
l
getModuleName :: P String
getModuleName :: P String
getModuleName = forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
_l Char
_ch ParseState
s InternalParseMode
m ->
let fn :: String
fn = InternalParseMode -> String
iParseFilename InternalParseMode
m
mn :: String
mn = forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall a b. (a -> b) -> a -> b
$ String -> [String]
splitPath String
fn
splitPath :: String -> [String]
splitPath :: String -> [String]
splitPath String
"" = []
splitPath String
str = let (String
l,String
str') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
'\\'forall a. Eq a => a -> a -> Bool
==) String
str
in case String
str' of
[] -> [ShowS
removeSuffix String
l]
(Char
_:String
str'') -> String
l forall a. a -> [a] -> [a]
: String -> [String]
splitPath String
str''
removeSuffix :: ShowS
removeSuffix String
l = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
'.'forall a. Eq a => a -> a -> Bool
/=) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse String
l
in forall a. ParseState -> a -> ParseStatus a
Ok ParseState
s String
mn
pushCurrentContext :: P ()
pushCurrentContext :: P ()
pushCurrentContext = do
SrcLoc
lc <- P SrcLoc
getSrcLoc
Int
indent <- P Int
currentIndent
Bool
dob <- P Bool
pullDoStatus
let loc :: Int
loc = SrcLoc -> Int
srcColumn SrcLoc
lc
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
dob Bool -> Bool -> Bool
&& Int
loc forall a. Ord a => a -> a -> Bool
< Int
indent
Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
dob Bool -> Bool -> Bool
&& Int
loc forall a. Ord a => a -> a -> Bool
<= Int
indent) P ()
pushCtxtFlag
LexContext -> P ()
pushContext (Int -> LexContext
Layout Int
loc)
currentIndent :: P Int
currentIndent :: P Int
currentIndent = forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_r Int
_x Int
_y SrcLoc
_ Char
_ ParseState
stk InternalParseMode
_mode -> forall a. ParseState -> a -> ParseStatus a
Ok ParseState
stk (ParseState -> Int
indentOfParseState ParseState
stk)
pushContext :: LexContext -> P ()
pushContext :: LexContext -> P ()
pushContext LexContext
ctxt =
forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
_l Char
_ ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, (Bool, Bool)
p, [Comment]
c) InternalParseMode
_m -> forall a. ParseState -> a -> ParseStatus a
Ok (LexContext
ctxtforall a. a -> [a] -> [a]
:[LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, (Bool, Bool)
p, [Comment]
c) ()
popContext :: P ()
popContext :: P ()
popContext = forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
loc Char
_ ParseState
stk InternalParseMode
_m ->
case ParseState
stk of
(LexContext
_:[LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, (Bool, Bool)
p, [Comment]
c) ->
forall a. ParseState -> a -> ParseStatus a
Ok ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, (Bool, Bool)
p, [Comment]
c) ()
([],[[KnownExtension]]
_,[ExtContext]
_,(Bool, Bool)
_,[Comment]
_) -> forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc String
"Unexpected }"
getExtensions :: P [KnownExtension]
getExtensions :: P [KnownExtension]
getExtensions = forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
_l Char
_ ParseState
s InternalParseMode
m ->
forall a. ParseState -> a -> ParseStatus a
Ok ParseState
s forall a b. (a -> b) -> a -> b
$ InternalParseMode -> [KnownExtension]
iExtensions InternalParseMode
m
pushCtxtFlag :: P ()
pushCtxtFlag :: P ()
pushCtxtFlag =
forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
_l Char
_ ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, (Bool
d,Bool
c), [Comment]
cs) InternalParseMode
_m -> case Bool
c of
Bool
False -> forall a. ParseState -> a -> ParseStatus a
Ok ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, (Bool
d,Bool
True), [Comment]
cs) ()
Bool
_ -> forall a. HasCallStack => String -> a
error String
"Internal error: context flag already pushed"
pullDoStatus :: P Bool
pullDoStatus :: P Bool
pullDoStatus = forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
_l Char
_ ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, (Bool
d,Bool
c), [Comment]
cs) InternalParseMode
_m -> forall a. ParseState -> a -> ParseStatus a
Ok ([LexContext]
s,[[KnownExtension]]
exts,[ExtContext]
e,(Bool
False,Bool
c),[Comment]
cs) Bool
d
getIgnoreFunctionArity :: P Bool
getIgnoreFunctionArity :: P Bool
getIgnoreFunctionArity = forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
_l Char
_ ParseState
s InternalParseMode
m ->
forall a. ParseState -> a -> ParseStatus a
Ok ParseState
s forall a b. (a -> b) -> a -> b
$ InternalParseMode -> Bool
iIgnoreFunctionArity InternalParseMode
m
newtype Lex r a = Lex { forall r a. Lex r a -> (a -> P r) -> P r
runL :: (a -> P r) -> P r }
instance Functor (Lex r) where
fmap :: forall a b. (a -> b) -> Lex r a -> Lex r b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative (Lex r) where
pure :: forall a. a -> Lex r a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. Lex r (a -> b) -> Lex r a -> Lex r b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (Lex r) where
return :: forall a. a -> Lex r a
return a
a = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \a -> P r
k -> a -> P r
k a
a
Lex (a -> P r) -> P r
v >>= :: forall a b. Lex r a -> (a -> Lex r b) -> Lex r b
>>= a -> Lex r b
f = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \b -> P r
k -> (a -> P r) -> P r
v (\a
a -> forall r a. Lex r a -> (a -> P r) -> P r
runL (a -> Lex r b
f a
a) b -> P r
k)
Lex (a -> P r) -> P r
v >> :: forall a b. Lex r a -> Lex r b -> Lex r b
>> Lex (b -> P r) -> P r
w = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \b -> P r
k -> (a -> P r) -> P r
v (\a
_ -> (b -> P r) -> P r
w b -> P r
k)
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance Fail.MonadFail (Lex r) where
fail :: forall a. String -> Lex r a
fail String
s = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \a -> P r
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s
getInput :: Lex r String
getInput :: forall r. Lex r String
getInput = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \String -> P r
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r -> forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (String -> P r
cont String
r) String
r
discard :: Int -> Lex r ()
discard :: forall r. Int -> Lex r ()
discard Int
n = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P r
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch
-> let (Char
newCh:String
rest)= if Int
n forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. Int -> [a] -> [a]
drop (Int
nforall a. Num a => a -> a -> a
-Int
1) String
r else (Char
chforall a. a -> [a] -> [a]
:String
r)
in forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P r
cont ()) String
rest (Int
xforall a. Num a => a -> a -> a
+Int
n) Int
y SrcLoc
loc Char
newCh
getLastChar :: Lex r Char
getLastChar :: forall r. Lex r Char
getLastChar = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \Char -> P r
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch -> forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Char -> P r
cont Char
ch) String
r Int
x Int
y SrcLoc
loc Char
ch
lexNewline :: Lex a ()
lexNewline :: forall a. Lex a ()
lexNewline = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
rs Int
_x Int
y SrcLoc
loc ->
case String
rs of
(Char
_:String
r) -> forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
1 (Int
yforall a. Num a => a -> a -> a
+Int
1) SrcLoc
loc
[] -> \Char
_ ParseState
_ InternalParseMode
_ -> forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc String
"Lexer: expected newline."
lexTab :: Lex a ()
lexTab :: forall a. Lex a ()
lexTab = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \(Char
_:String
r) Int
x -> forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r (Int -> Int
nextTab Int
x)
nextTab :: Int -> Int
nextTab :: Int -> Int
nextTab Int
x = Int
x forall a. Num a => a -> a -> a
+ (Int
tAB_LENGTH forall a. Num a => a -> a -> a
- (Int
xforall a. Num a => a -> a -> a
-Int
1) forall a. Integral a => a -> a -> a
`mod` Int
tAB_LENGTH)
tAB_LENGTH :: Int
tAB_LENGTH :: Int
tAB_LENGTH = Int
8
lexWhile :: (Char -> Bool) -> Lex a String
lexWhile :: forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
p = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \String -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
rss Int
c Int
l SrcLoc
loc Char
char ->
case String
rss of
[] -> forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (String -> P a
cont []) [] Int
c Int
l SrcLoc
loc Char
char
(Char
r:String
rs) ->
let
l' :: Int
l' = case Char
r of
Char
'\n' -> Int
l forall a. Num a => a -> a -> a
+ Int
1
Char
_ -> Int
l
c' :: Int
c' = case Char
r of
Char
'\n' -> Int
1
Char
_ -> Int
c forall a. Num a => a -> a -> a
+ Int
1
in if Char -> Bool
p Char
r
then forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (forall r a. Lex r a -> (a -> P r) -> P r
runL ((Char
rforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
p) String -> P a
cont) String
rs Int
c' Int
l' SrcLoc
loc Char
r
else forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (String -> P a
cont []) (Char
rforall a. a -> [a] -> [a]
:String
rs) Int
c Int
l SrcLoc
loc Char
char
lexWhile_ :: (Char -> Bool) -> Lex a ()
lexWhile_ :: forall a. (Char -> Bool) -> Lex a ()
lexWhile_ Char -> Bool
p = do String
_ <- forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
p
forall (m :: * -> *) a. Monad m => a -> m a
return ()
alternative :: Lex a v -> Lex a (Lex a v)
alternative :: forall a v. Lex a v -> Lex a (Lex a v)
alternative (Lex (v -> P a) -> P a
v) = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \Lex a v -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Lex a v -> P a
cont (forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \v -> P a
cont' -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
_r Int
_x Int
_y ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP ((v -> P a) -> P a
v v -> P a
cont') String
r Int
x Int
y)) String
r Int
x Int
y
checkBOL :: Lex a Bool
checkBOL :: forall a. Lex a Bool
checkBOL = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \Bool -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc ->
if Int
x forall a. Eq a => a -> a -> Bool
== Int
0 then forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Bool -> P a
cont Bool
True) String
r (SrcLoc -> Int
srcColumn SrcLoc
loc) Int
y SrcLoc
loc
else forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Bool -> P a
cont Bool
False) String
r Int
x Int
y SrcLoc
loc
setBOL :: Lex a ()
setBOL :: forall a. Lex a ()
setBOL = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
_ -> forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
0
startToken :: Lex a ()
startToken :: forall a. Lex a ()
startToken = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
s Int
x Int
y SrcLoc
_ Char
c ParseState
stk InternalParseMode
mode ->
let loc :: SrcLoc
loc = SrcLoc {
srcFilename :: String
srcFilename = InternalParseMode -> String
iParseFilename InternalParseMode
mode,
srcLine :: Int
srcLine = Int
y,
srcColumn :: Int
srcColumn = Int
x
} in
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
s Int
x Int
y SrcLoc
loc Char
c ParseState
stk InternalParseMode
mode
getOffside :: Lex a Ordering
getOffside :: forall a. Lex a Ordering
getOffside = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \Ordering -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ParseState
stk ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Ordering -> P a
cont (forall a. Ord a => a -> a -> Ordering
compare Int
x (ParseState -> Int
indentOfParseState ParseState
stk))) String
r Int
x Int
y SrcLoc
loc Char
ch ParseState
stk
getSrcLocL :: Lex a SrcLoc
getSrcLocL :: forall a. Lex a SrcLoc
getSrcLocL = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \SrcLoc -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
i Int
x Int
y SrcLoc
l ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (SrcLoc -> P a
cont (SrcLoc
l { srcLine :: Int
srcLine = Int
y, srcColumn :: Int
srcColumn = Int
x })) String
i Int
x Int
y SrcLoc
l
setSrcLineL :: Int -> Lex a ()
setSrcLineL :: forall r. Int -> Lex r ()
setSrcLineL Int
y = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
i Int
x Int
_ ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
i Int
x Int
y
pushContextL :: LexContext -> Lex a ()
pushContextL :: forall a. LexContext -> Lex a ()
pushContextL LexContext
ctxt = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
stk, [[KnownExtension]]
exts, [ExtContext]
e, (Bool, Bool)
pst, [Comment]
cs) ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
x Int
y SrcLoc
loc Char
ch (LexContext
ctxtforall a. a -> [a] -> [a]
:[LexContext]
stk, [[KnownExtension]]
exts, [ExtContext]
e, (Bool, Bool)
pst, [Comment]
cs)
popContextL :: String -> Lex a ()
popContextL :: forall a. String -> Lex a ()
popContextL String
_ = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ParseState
stk InternalParseMode
m -> case ParseState
stk of
(LexContext
_:[LexContext]
ctxt, [[KnownExtension]]
exts, [ExtContext]
e, (Bool, Bool)
pst, [Comment]
cs) -> forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
ctxt, [[KnownExtension]]
exts, [ExtContext]
e, (Bool, Bool)
pst, [Comment]
cs) InternalParseMode
m
([], [[KnownExtension]]
_, [ExtContext]
_, (Bool, Bool)
_, [Comment]
_) -> forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc String
"Unexpected }"
pullCtxtFlag :: Lex a Bool
pullCtxtFlag :: forall a. Lex a Bool
pullCtxtFlag = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \Bool -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
ct, [[KnownExtension]]
exts, [ExtContext]
e, (Bool
d,Bool
c), [Comment]
cs) ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Bool -> P a
cont Bool
c) String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
ct, [[KnownExtension]]
exts, [ExtContext]
e, (Bool
d,Bool
False), [Comment]
cs)
flagDo :: Lex a ()
flagDo :: forall a. Lex a ()
flagDo = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
ct, [[KnownExtension]]
exts, [ExtContext]
e, (Bool
_,Bool
c), [Comment]
cs) ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
ct, [[KnownExtension]]
exts, [ExtContext]
e, (Bool
True,Bool
c), [Comment]
cs)
getExtContext :: Lex a (Maybe ExtContext)
getExtContext :: forall a. Lex a (Maybe ExtContext)
getExtContext = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \Maybe ExtContext -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch stk :: ParseState
stk@([LexContext]
_, [[KnownExtension]]
_, [ExtContext]
e, (Bool, Bool)
_, [Comment]
_) ->
let me :: Maybe ExtContext
me = case [ExtContext]
e of
[] -> forall a. Maybe a
Nothing
(ExtContext
c:[ExtContext]
_) -> forall a. a -> Maybe a
Just ExtContext
c
in forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Maybe ExtContext -> P a
cont Maybe ExtContext
me) String
r Int
x Int
y SrcLoc
loc Char
ch ParseState
stk
pushExtContextL :: ExtContext -> Lex a ()
pushExtContextL :: forall a. ExtContext -> Lex a ()
pushExtContextL ExtContext
ec = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, (Bool, Bool)
p, [Comment]
c) ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, [[KnownExtension]]
exts, ExtContext
ecforall a. a -> [a] -> [a]
:[ExtContext]
e, (Bool, Bool)
p, [Comment]
c)
popExtContextL :: String -> Lex a ()
popExtContextL :: forall a. String -> Lex a ()
popExtContextL String
fn = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s,[[KnownExtension]]
exts,[ExtContext]
e,(Bool, Bool)
p,[Comment]
c) InternalParseMode
m -> case [ExtContext]
e of
(ExtContext
_:[ExtContext]
ec) -> forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s,[[KnownExtension]]
exts,[ExtContext]
ec,(Bool, Bool)
p,[Comment]
c) InternalParseMode
m
[] -> forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc (String
"Internal error: empty tag context in " forall a. [a] -> [a] -> [a]
++ String
fn)
getExtensionsL :: Lex a [KnownExtension]
getExtensionsL :: forall a. Lex a [KnownExtension]
getExtensionsL = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \[KnownExtension] -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ParseState
s InternalParseMode
m ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP ([KnownExtension] -> P a
cont forall a b. (a -> b) -> a -> b
$ InternalParseMode -> [KnownExtension]
iExtensions InternalParseMode
m) String
r Int
x Int
y SrcLoc
loc Char
ch ParseState
s InternalParseMode
m
addExtensionL :: KnownExtension -> Lex a ()
addExtensionL :: forall a. KnownExtension -> Lex a ()
addExtensionL KnownExtension
ext = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, [[KnownExtension]]
oldExts, [ExtContext]
e, (Bool, Bool)
p, [Comment]
c) InternalParseMode
m ->
let newExts :: [KnownExtension]
newExts = [KnownExtension] -> [KnownExtension]
impliesExts [KnownExtension
ext] forall a. [a] -> [a] -> [a]
++ InternalParseMode -> [KnownExtension]
iExtensions InternalParseMode
m
in forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, [[KnownExtension]]
oldExts, [ExtContext]
e, (Bool, Bool)
p, [Comment]
c) (InternalParseMode
m {iExtensions :: [KnownExtension]
iExtensions = [KnownExtension]
newExts})
saveExtensionsL :: Lex a ()
saveExtensionsL :: forall a. Lex a ()
saveExtensionsL = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, [[KnownExtension]]
oldExts, [ExtContext]
e, (Bool, Bool)
p, [Comment]
c) InternalParseMode
m ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, InternalParseMode -> [KnownExtension]
iExtensions InternalParseMode
mforall a. a -> [a] -> [a]
:[[KnownExtension]]
oldExts, [ExtContext]
e, (Bool, Bool)
p, [Comment]
c) InternalParseMode
m
restoreExtensionsL :: Lex a ()
restoreExtensionsL :: forall a. Lex a ()
restoreExtensionsL = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s,[[KnownExtension]]
exts,[ExtContext]
e,(Bool, Bool)
p,[Comment]
c) InternalParseMode
m -> case [[KnownExtension]]
exts of
([KnownExtension]
_:[[KnownExtension]]
prev) -> forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s,[[KnownExtension]]
prev,[ExtContext]
e,(Bool, Bool)
p,[Comment]
c) InternalParseMode
m
[[KnownExtension]]
_ -> forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc String
"Internal error: empty extension stack"
ignoreLinePragmasL :: Lex a Bool
ignoreLinePragmasL :: forall a. Lex a Bool
ignoreLinePragmasL = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \Bool -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
c ParseState
s InternalParseMode
m ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Bool -> P a
cont forall a b. (a -> b) -> a -> b
$ InternalParseMode -> Bool
iIgnoreLinePragmas InternalParseMode
m) String
r Int
x Int
y SrcLoc
loc Char
c ParseState
s InternalParseMode
m
setLineFilenameL :: String -> Lex a ()
setLineFilenameL :: forall a. String -> Lex a ()
setLineFilenameL String
name = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ParseState
s InternalParseMode
m ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
x Int
y SrcLoc
loc Char
ch ParseState
s (InternalParseMode
m {iParseFilename :: String
iParseFilename = String
name})
pushComment :: Comment -> Lex a ()
Comment
c = forall r a. ((a -> P r) -> P r) -> Lex r a
Lex forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> forall a.
(String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a)
-> P a
P forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, (Bool, Bool)
p, [Comment]
cs) ->
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, (Bool, Bool)
p, Comment
cforall a. a -> [a] -> [a]
:[Comment]
cs)