{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Haskell.Exts.ParseMonad
-- Copyright   :  Niklas Broberg (c) 2004-2009,
--                Original (c) The GHC Team, 1997-2000
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  Niklas Broberg, d00nibro@chalmers.se
-- Stability   :  stable
-- Portability :  portable
--
-- Monads for the Haskell parser and lexer.
--
-----------------------------------------------------------------------------

module Language.Haskell.Exts.ParseMonad(
        -- * Generic Parsing
        Parseable(..),
        -- * Parsing
        P, ParseResult(..), atSrcLoc, LexContext(..),
        ParseMode(..), defaultParseMode, fromParseResult,
        runParserWithMode, runParserWithModeComments, runParser,
        getSrcLoc, pushCurrentContext, popContext,
        getExtensions, getIgnoreFunctionArity,
        -- * Lexing
        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,
        -- * Harp/Hsx
        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 -- (Extension, impliesExts, haskell2010)

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
-- To avoid import warnings for Control.Applicative, Data.Monoid, and Data.Semigroup
import Prelude

-- | Class providing function for parsing at many different types.
--
--   Note that for convenience of implementation, the default methods have
--   definitions equivalent to 'undefined'.  The minimal definition is all of
--   the visible methods.
class Parseable ast where
  -- | Parse a string with default mode.
  parse :: String -> ParseResult ast
  parse = ParseMode -> String -> ParseResult ast
forall ast. Parseable ast => ParseMode -> String -> ParseResult ast
parseWithMode ParseMode
defaultParseMode
  -- | Parse a string with an explicit 'ParseMode'.
  parseWithMode :: ParseMode -> String -> ParseResult ast
  parseWithMode ParseMode
mode = ParseMode -> P ast -> String -> ParseResult ast
forall a. ParseMode -> P a -> String -> ParseResult a
runParserWithMode ParseMode
mode (P ast -> String -> ParseResult ast)
-> (Maybe [Fixity] -> P ast)
-> Maybe [Fixity]
-> String
-> ParseResult ast
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Fixity] -> P ast
forall ast. Parseable ast => Maybe [Fixity] -> P ast
parser (Maybe [Fixity] -> String -> ParseResult ast)
-> Maybe [Fixity] -> String -> ParseResult ast
forall a b. (a -> b) -> a -> b
$ ParseMode -> Maybe [Fixity]
fixities ParseMode
mode
  -- | Parse a string with an explicit 'ParseMode', returning all comments along
  --   with the AST.
  parseWithComments :: ParseMode -> String -> ParseResult (ast, [Comment])
  parseWithComments ParseMode
mode = ParseMode -> P ast -> String -> ParseResult (ast, [Comment])
forall a. ParseMode -> P a -> String -> ParseResult (a, [Comment])
runParserWithModeComments ParseMode
mode (P ast -> String -> ParseResult (ast, [Comment]))
-> (Maybe [Fixity] -> P ast)
-> Maybe [Fixity]
-> String
-> ParseResult (ast, [Comment])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Fixity] -> P ast
forall ast. Parseable ast => Maybe [Fixity] -> P ast
parser (Maybe [Fixity] -> String -> ParseResult (ast, [Comment]))
-> Maybe [Fixity] -> String -> ParseResult (ast, [Comment])
forall a b. (a -> b) -> a -> b
$ ParseMode -> Maybe [Fixity]
fixities ParseMode
mode
  -- | Internal parser, used to provide default definitions for the others.
  parser :: Maybe [Fixity] -> P ast

-- | The result of a parse.
data ParseResult a
    = ParseOk a  -- ^ The parse succeeded, yielding a value.
    | ParseFailed SrcLoc String
                -- ^ The parse failed at the specified
                -- source location, with an error message.
    deriving (Int -> ParseResult a -> ShowS
[ParseResult a] -> ShowS
ParseResult a -> String
(Int -> ParseResult a -> ShowS)
-> (ParseResult a -> String)
-> ([ParseResult a] -> ShowS)
-> Show (ParseResult a)
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, Eq (ParseResult a)
Eq (ParseResult a)
-> (ParseResult a -> ParseResult a -> Ordering)
-> (ParseResult a -> ParseResult a -> Bool)
-> (ParseResult a -> ParseResult a -> Bool)
-> (ParseResult a -> ParseResult a -> Bool)
-> (ParseResult a -> ParseResult a -> Bool)
-> (ParseResult a -> ParseResult a -> ParseResult a)
-> (ParseResult a -> ParseResult a -> ParseResult a)
-> Ord (ParseResult a)
ParseResult a -> ParseResult a -> Bool
ParseResult a -> ParseResult a -> Ordering
ParseResult a -> ParseResult a -> ParseResult a
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
$cp1Ord :: forall a. Ord a => Eq (ParseResult a)
Ord, ParseResult a -> ParseResult a -> Bool
(ParseResult a -> ParseResult a -> Bool)
-> (ParseResult a -> ParseResult a -> Bool) -> Eq (ParseResult a)
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)

-- | Retrieve the result of a successful parse, throwing an
--   error if the parse is actually not successful.
fromParseResult :: ParseResult a -> a
fromParseResult :: ParseResult a -> a
fromParseResult (ParseOk a
a) = a
a
fromParseResult (ParseFailed SrcLoc
loc String
str) = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"fromParseResult: Parse failed at ["
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
srcFilename SrcLoc
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"] (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (SrcLoc -> Int
srcLine SrcLoc
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (SrcLoc -> Int
srcColumn SrcLoc
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str

instance Functor ParseResult where
  fmap :: (a -> b) -> ParseResult a -> ParseResult b
fmap a -> b
f (ParseOk a
x)           = b -> ParseResult b
forall a. a -> ParseResult a
ParseOk (b -> ParseResult b) -> b -> ParseResult b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
  fmap a -> b
_ (ParseFailed SrcLoc
loc String
msg) = SrcLoc -> String -> ParseResult b
forall a. SrcLoc -> String -> ParseResult a
ParseFailed SrcLoc
loc String
msg

instance Applicative ParseResult where
  pure :: a -> ParseResult a
pure = a -> ParseResult a
forall a. a -> ParseResult a
ParseOk
  ParseOk a -> b
f           <*> :: ParseResult (a -> b) -> ParseResult a -> ParseResult b
<*> ParseResult a
x = a -> b
f (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseResult a
x
  ParseFailed SrcLoc
loc String
msg <*> ParseResult a
_ = SrcLoc -> String -> ParseResult b
forall a. SrcLoc -> String -> ParseResult a
ParseFailed SrcLoc
loc String
msg

instance Monad ParseResult where
  return :: a -> ParseResult a
return = a -> ParseResult a
forall a. a -> ParseResult a
ParseOk
#if !MIN_VERSION_base(4,13,0)
  fail = Fail.fail
#endif
  ParseOk a
x           >>= :: 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
_ = SrcLoc -> String -> ParseResult b
forall a. SrcLoc -> String -> ParseResult a
ParseFailed SrcLoc
loc String
msg
instance Fail.MonadFail ParseResult where
  fail :: String -> ParseResult a
fail = SrcLoc -> String -> ParseResult a
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 = m -> ParseResult m
forall a. a -> ParseResult a
ParseOk (m -> ParseResult m) -> m -> ParseResult m
forall a b. (a -> b) -> a -> b
$ m
x m -> m -> m
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 -- left-biased

instance ( Monoid m , Semigroup m) => Monoid (ParseResult m) where
  mempty :: ParseResult m
mempty = m -> ParseResult m
forall a. a -> ParseResult a
ParseOk m
forall a. Monoid a => a
mempty
  mappend :: ParseResult m -> ParseResult m -> ParseResult m
mappend = ParseResult m -> ParseResult m -> ParseResult m
forall a. Semigroup a => a -> a -> a
(<>)

-- internal version
data ParseStatus a = Ok ParseState a | Failed SrcLoc String
    deriving Int -> ParseStatus a -> ShowS
[ParseStatus a] -> ShowS
ParseStatus a -> String
(Int -> ParseStatus a -> ShowS)
-> (ParseStatus a -> String)
-> ([ParseStatus a] -> ShowS)
-> Show (ParseStatus a)
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
(LexContext -> LexContext -> Bool)
-> (LexContext -> LexContext -> Bool) -> Eq LexContext
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
Eq LexContext
-> (LexContext -> LexContext -> Ordering)
-> (LexContext -> LexContext -> Bool)
-> (LexContext -> LexContext -> Bool)
-> (LexContext -> LexContext -> Bool)
-> (LexContext -> LexContext -> Bool)
-> (LexContext -> LexContext -> LexContext)
-> (LexContext -> LexContext -> LexContext)
-> Ord 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
$cp1Ord :: Eq LexContext
Ord,Int -> LexContext -> ShowS
[LexContext] -> ShowS
LexContext -> String
(Int -> LexContext -> ShowS)
-> (LexContext -> String)
-> ([LexContext] -> ShowS)
-> Show LexContext
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
(ExtContext -> ExtContext -> Bool)
-> (ExtContext -> ExtContext -> Bool) -> Eq ExtContext
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
Eq ExtContext
-> (ExtContext -> ExtContext -> Ordering)
-> (ExtContext -> ExtContext -> Bool)
-> (ExtContext -> ExtContext -> Bool)
-> (ExtContext -> ExtContext -> Bool)
-> (ExtContext -> ExtContext -> Bool)
-> (ExtContext -> ExtContext -> ExtContext)
-> (ExtContext -> ExtContext -> ExtContext)
-> Ord 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
$cp1Ord :: Eq ExtContext
Ord,Int -> ExtContext -> ShowS
[ExtContext] -> ShowS
ExtContext -> String
(Int -> ExtContext -> ShowS)
-> (ExtContext -> String)
-> ([ExtContext] -> ShowS)
-> Show ExtContext
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)
-- (True,_) = We're in a do context.
-- (_, True)= Next token must be a virtual closing brace.

type ParseState = ([LexContext],[[KnownExtension]],[ExtContext],CtxtFlag,[Comment])

indentOfParseState :: ParseState -> Int
indentOfParseState :: ParseState -> Int
indentOfParseState (Layout Int
n:[LexContext]
_,[[KnownExtension]]
_,[ExtContext]
_,CtxtFlag
_,[Comment]
_) = Int
n
indentOfParseState ParseState
_                    = Int
0

-- | Static parameters governing a parse.
--   Note that the various parse functions in "Language.Haskell.Exts.Parser"
--   never look at LANGUAGE pragmas, regardless of
--   what the @ignoreLanguagePragmas@ flag is set to.
--   Only the various @parseFile@ functions in "Language.Haskell.Exts" will
--   act on it, when set to 'False'.

data ParseMode = ParseMode {
        -- | original name of the file being parsed
        ParseMode -> String
parseFilename :: String,
        -- | base language (e.g. Haskell98, Haskell2010)
        ParseMode -> Language
baseLanguage :: Language,
        -- | list of extensions enabled for parsing
        ParseMode -> [Extension]
extensions :: [Extension],
        -- | if 'True', the parser won't care about further extensions
        --   in LANGUAGE pragmas in source files
        ParseMode -> Bool
ignoreLanguagePragmas :: Bool,
        -- | if 'True', the parser won't read line position information
        --   from LINE pragmas in source files
        ParseMode -> Bool
ignoreLinePragmas :: Bool,
        -- | list of fixities to be aware of
        ParseMode -> Maybe [Fixity]
fixities :: Maybe [Fixity],
        -- | Checks whether functions have a consistent arity
        ParseMode -> Bool
ignoreFunctionArity :: Bool
        }

-- | Default parameters for a parse.
--   The default is an unknown filename,
--   no extensions (i.e. Haskell 98),
--   don't ignore LANGUAGE pragmas, do ignore LINE pragmas,
--   and be aware of fixities from the 'Prelude'.
defaultParseMode :: ParseMode
defaultParseMode :: ParseMode
defaultParseMode = ParseMode :: String
-> Language
-> [Extension]
-> Bool
-> Bool
-> Maybe [Fixity]
-> Bool
-> ParseMode
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 = [Fixity] -> Maybe [Fixity]
forall a. a -> Maybe a
Just [Fixity]
preludeFixities,
        ignoreFunctionArity :: Bool
ignoreFunctionArity = Bool
False
        }

-- Version of ParseMode used internally,
-- where the language and extensions have
-- been expanded
data InternalParseMode = IParseMode {
        InternalParseMode -> String
iParseFilename :: String,
        InternalParseMode -> [KnownExtension]
iExtensions :: [KnownExtension],
        -- iIgnoreLanguagePragmas :: Bool,
        InternalParseMode -> Bool
iIgnoreLinePragmas :: Bool,
        InternalParseMode -> Bool
iIgnoreFunctionArity :: Bool
        -- iFixities :: Maybe [Fixity]
    }

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) {-_ilang -} Bool
iline {- _fx -} Bool
farity


-- | Monad for parsing

newtype P a = P { P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP ::
                String              -- input string
             -> Int                 -- current column
             -> Int                 -- current line
             -> SrcLoc              -- location of last token read
             -> Char                -- Last token read used for lexing TypeApplication UGH
             -> ParseState          -- layout info.
             -> InternalParseMode   -- parse parameters
             -> ParseStatus a
        }

runParserWithMode :: ParseMode -> P a -> String -> ParseResult a
{-runParserWithMode mode (P m) s = case m s 0 1 start ([],[],(False,False),[]) mode of
    Ok _ a -> ParseOk a
    Failed loc msg -> ParseFailed loc msg
    where start = SrcLoc {
        srcFilename = parseFilename mode,
        srcLine = 1,
        srcColumn = 1
    }
-}
runParserWithMode :: ParseMode -> P a -> String -> ParseResult a
runParserWithMode ParseMode
mode P a
pm = ((a, [Comment]) -> a)
-> ParseResult (a, [Comment]) -> ParseResult a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [Comment]) -> a
forall a b. (a, b) -> a
fst (ParseResult (a, [Comment]) -> ParseResult a)
-> (String -> ParseResult (a, [Comment]))
-> String
-> ParseResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> P a -> String -> ParseResult (a, [Comment])
forall a. ParseMode -> P a -> String -> ParseResult (a, [Comment])
runParserWithModeComments ParseMode
mode P a
pm

runParser :: P a -> String -> ParseResult a
runParser :: P a -> String -> ParseResult a
runParser = ParseMode -> P a -> String -> ParseResult a
forall a. ParseMode -> P a -> String -> ParseResult a
runParserWithMode ParseMode
defaultParseMode

runParserWithModeComments :: ParseMode -> P a -> String -> ParseResult (a, [Comment])
runParserWithModeComments :: ParseMode -> P a -> String -> ParseResult (a, [Comment])
runParserWithModeComments 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]
_,CtxtFlag
_,[Comment]
cs) a
a -> (a, [Comment]) -> ParseResult (a, [Comment])
forall a. a -> ParseResult a
ParseOk (a
a, [Comment] -> [Comment]
forall a. [a] -> [a]
reverse [Comment]
cs)
    Failed SrcLoc
loc String
msg    -> SrcLoc -> String -> ParseResult (a, [Comment])
forall a. SrcLoc -> String -> ParseResult a
ParseFailed SrcLoc
loc String
msg
    where start :: SrcLoc
start = SrcLoc :: String -> Int -> Int -> SrcLoc
SrcLoc {
        srcFilename :: String
srcFilename = ParseMode -> String
parseFilename ParseMode
mode,
        srcLine :: Int
srcLine = Int
1,
        srcColumn :: Int
srcColumn = Int
1
        }
  --        allExts mode@(ParseMode {extensions = es}) = mode { extensions = impliesExts es }

    --      allExts mode = let imode = to

instance Functor P where
  fmap :: (a -> b) -> P a -> P b
fmap = (a -> b) -> P a -> P b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative P where
  pure :: a -> P a
pure = a -> P a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: P (a -> b) -> P a -> P 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 :: a -> P a
return a
a = (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
_l Char
_ch ParseState
s InternalParseMode
_m -> ParseState -> a -> ParseStatus a
forall a. ParseState -> a -> ParseStatus a
Ok ParseState
s a
a
    P String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
m >>= :: P a -> (a -> P b) -> P b
>>= a -> P b
k = (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus b)
-> P b
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus b)
 -> P b)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus b)
-> P b
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 -> SrcLoc -> String -> ParseStatus b
forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc String
msg
            Ok ParseState
s' a
a -> P b
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus b
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 :: String -> P a
fail String
s = (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
_r Int
_col Int
_line SrcLoc
loc Char
_ ParseState
_stk InternalParseMode
_m -> SrcLoc -> String -> ParseStatus a
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 :: P a -> SrcLoc -> P a
`atSrcLoc` SrcLoc
loc = (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
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 = (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus SrcLoc)
-> P SrcLoc
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus SrcLoc)
 -> P SrcLoc)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus SrcLoc)
-> P SrcLoc
forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
l Char
_ ParseState
s InternalParseMode
_m -> ParseState -> SrcLoc -> ParseStatus SrcLoc
forall a. ParseState -> a -> ParseStatus a
Ok ParseState
s SrcLoc
l

getModuleName :: P String
getModuleName :: P String
getModuleName = (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus String)
-> P String
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus String)
 -> P String)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus String)
-> P String
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 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [String] -> 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') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
'\\'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
str
                          in case String
str' of
                              []      -> [ShowS
removeSuffix String
l]
                              (Char
_:String
str'') -> String
l String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitPath String
str''

        removeSuffix :: ShowS
removeSuffix String
l = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
'.'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
l

     in ParseState -> String -> ParseStatus String
forall a. ParseState -> a -> ParseStatus a
Ok ParseState
s String
mn

-- Enter a new layout context.  If we are already in a layout context,
-- ensure that the new indent is greater than the indent of that context.
-- (So if the source loc is not to the right of the current indent, an
-- empty list {} will be inserted.)

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
    Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
dob Bool -> Bool -> Bool
&& Int
loc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indent
           Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
dob Bool -> Bool -> Bool
&& Int
loc Int -> Int -> Bool
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 = (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus Int)
-> P Int
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus Int)
 -> P Int)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus Int)
-> P Int
forall a b. (a -> b) -> a -> b
$ \String
_r Int
_x Int
_y SrcLoc
_ Char
_ ParseState
stk InternalParseMode
_mode -> ParseState -> Int -> ParseStatus Int
forall a. ParseState -> a -> ParseStatus a
Ok ParseState
stk (ParseState -> Int
indentOfParseState ParseState
stk)

pushContext :: LexContext -> P ()
pushContext :: LexContext -> P ()
pushContext LexContext
ctxt =
--trace ("pushing lexical scope: " ++ show ctxt ++"\n") $
    (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus ())
-> P ()
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus ())
 -> P ())
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus ())
-> P ()
forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
_l Char
_ ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, CtxtFlag
p, [Comment]
c) InternalParseMode
_m -> ParseState -> () -> ParseStatus ()
forall a. ParseState -> a -> ParseStatus a
Ok (LexContext
ctxtLexContext -> [LexContext] -> [LexContext]
forall a. a -> [a] -> [a]
:[LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, CtxtFlag
p, [Comment]
c) ()

popContext :: P ()
popContext :: P ()
popContext = (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus ())
-> P ()
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus ())
 -> P ())
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus ())
-> 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, CtxtFlag
p, [Comment]
c) -> --trace ("popping lexical scope, context now "++show s ++ "\n") $
                          ParseState -> () -> ParseStatus ()
forall a. ParseState -> a -> ParseStatus a
Ok ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, CtxtFlag
p, [Comment]
c) ()
        ([],[[KnownExtension]]
_,[ExtContext]
_,CtxtFlag
_,[Comment]
_)   -> SrcLoc -> String -> ParseStatus ()
forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc String
"Unexpected }" -- error "Internal error: empty context in popContext"

{-
-- HaRP/Hsx
pushExtContext :: ExtContext -> P ()
pushExtContext ctxt = P $ \_i _x _y _l (s, e, p, c) _m -> Ok (s, ctxt:e, p, c) ()

popExtContext :: P ()
popExtContext = P $ \_i _x _y _l (s, e, p, c) _m ->
    case e of
     (_:e') ->
       Ok (s, e', p, c) ()
     [] -> error "Internal error: empty context in popExtContext"
-}

-- Extension-aware lexing/parsing
getExtensions :: P [KnownExtension]
getExtensions :: P [KnownExtension]
getExtensions = (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus [KnownExtension])
-> P [KnownExtension]
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus [KnownExtension])
 -> P [KnownExtension])
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus [KnownExtension])
-> P [KnownExtension]
forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
_l Char
_ ParseState
s InternalParseMode
m ->
    ParseState -> [KnownExtension] -> ParseStatus [KnownExtension]
forall a. ParseState -> a -> ParseStatus a
Ok ParseState
s ([KnownExtension] -> ParseStatus [KnownExtension])
-> [KnownExtension] -> ParseStatus [KnownExtension]
forall a b. (a -> b) -> a -> b
$ InternalParseMode -> [KnownExtension]
iExtensions InternalParseMode
m

pushCtxtFlag :: P ()
pushCtxtFlag :: P ()
pushCtxtFlag =
    (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus ())
-> P ()
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus ())
 -> P ())
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus ())
-> 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 -> ParseState -> () -> ParseStatus ()
forall a. ParseState -> a -> ParseStatus a
Ok ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, (Bool
d,Bool
True), [Comment]
cs) ()
        Bool
_     -> String -> ParseStatus ()
forall a. HasCallStack => String -> a
error String
"Internal error: context flag already pushed"

pullDoStatus :: P Bool
pullDoStatus :: P Bool
pullDoStatus = (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus Bool)
-> P Bool
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus Bool)
 -> P Bool)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus Bool)
-> P Bool
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 -> ParseState -> Bool -> ParseStatus Bool
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 = (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus Bool)
-> P Bool
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus Bool)
 -> P Bool)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus Bool)
-> P Bool
forall a b. (a -> b) -> a -> b
$ \String
_i Int
_x Int
_y SrcLoc
_l Char
_ ParseState
s InternalParseMode
m ->
  ParseState -> Bool -> ParseStatus Bool
forall a. ParseState -> a -> ParseStatus a
Ok ParseState
s (Bool -> ParseStatus Bool) -> Bool -> ParseStatus Bool
forall a b. (a -> b) -> a -> b
$ InternalParseMode -> Bool
iIgnoreFunctionArity InternalParseMode
m




----------------------------------------------------------------------------
-- Monad for lexical analysis:
-- a continuation-passing version of the parsing monad

newtype Lex r a = Lex { Lex r a -> (a -> P r) -> P r
runL :: (a -> P r) -> P r }

instance Functor (Lex r) where
    fmap :: (a -> b) -> Lex r a -> Lex r b
fmap = (a -> b) -> Lex r a -> Lex r b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative (Lex r) where
    pure :: a -> Lex r a
pure = a -> Lex r a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: Lex r (a -> b) -> Lex r a -> Lex r 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 :: a -> Lex r a
return a
a = ((a -> P r) -> P r) -> Lex r a
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((a -> P r) -> P r) -> Lex r a) -> ((a -> P r) -> P r) -> Lex r a
forall a b. (a -> b) -> a -> b
$ \a -> P r
k -> a -> P r
k a
a
    Lex (a -> P r) -> P r
v >>= :: Lex r a -> (a -> Lex r b) -> Lex r b
>>= a -> Lex r b
f = ((b -> P r) -> P r) -> Lex r b
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((b -> P r) -> P r) -> Lex r b) -> ((b -> P r) -> P r) -> Lex r b
forall a b. (a -> b) -> a -> b
$ \b -> P r
k -> (a -> P r) -> P r
v (\a
a -> Lex r b -> (b -> P r) -> P r
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 >> :: Lex r a -> Lex r b -> Lex r b
>> Lex (b -> P r) -> P r
w = ((b -> P r) -> P r) -> Lex r b
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((b -> P r) -> P r) -> Lex r b) -> ((b -> P r) -> P r) -> Lex r b
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 :: String -> Lex r a
fail String
s = ((a -> P r) -> P r) -> Lex r a
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((a -> P r) -> P r) -> Lex r a) -> ((a -> P r) -> P r) -> Lex r a
forall a b. (a -> b) -> a -> b
$ \a -> P r
_ -> String -> P r
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s

-- Operations on this monad

getInput :: Lex r String
getInput :: Lex r String
getInput = ((String -> P r) -> P r) -> Lex r String
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((String -> P r) -> P r) -> Lex r String)
-> ((String -> P r) -> P r) -> Lex r String
forall a b. (a -> b) -> a -> b
$ \String -> P r
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus r)
-> P r
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus r)
 -> P r)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus r)
-> P r
forall a b. (a -> b) -> a -> b
$ \String
r -> P r
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus r
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (String -> P r
cont String
r) String
r

-- | Discard some input characters (these must not include tabs or newlines).

discard :: Int -> Lex r ()
discard :: Int -> Lex r ()
discard Int
n = ((() -> P r) -> P r) -> Lex r ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P r) -> P r) -> Lex r ())
-> ((() -> P r) -> P r) -> Lex r ()
forall a b. (a -> b) -> a -> b
$ \() -> P r
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus r)
-> P r
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus r)
 -> P r)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus r)
-> P r
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> ShowS
forall a. Int -> [a] -> [a]
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
r else (Char
chChar -> ShowS
forall a. a -> [a] -> [a]
:String
r)
                           in P r
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus r
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P r
cont ()) String
rest (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Int
y SrcLoc
loc Char
newCh

-- | Get the last discarded character.
-- This is only used for type application.

getLastChar :: Lex r Char
getLastChar :: Lex r Char
getLastChar = ((Char -> P r) -> P r) -> Lex r Char
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((Char -> P r) -> P r) -> Lex r Char)
-> ((Char -> P r) -> P r) -> Lex r Char
forall a b. (a -> b) -> a -> b
$ \Char -> P r
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus r)
-> P r
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus r)
 -> P r)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus r)
-> P r
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch -> P r
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus r
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


-- | Discard the next character, which must be a newline.

lexNewline :: Lex a ()
lexNewline :: Lex a ()
lexNewline = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
rs Int
_x Int
y SrcLoc
loc  ->
  case String
rs of
    (Char
_:String
r) -> P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
1 (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SrcLoc
loc
    []    -> \Char
_ ParseState
_ InternalParseMode
_ -> SrcLoc -> String -> ParseStatus a
forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc String
"Lexer: expected newline."

-- | Discard the next character, which must be a tab.

lexTab :: Lex a ()
lexTab :: Lex a ()
lexTab = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \(Char
_:String
r) Int
x -> P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
tAB_LENGTH Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
tAB_LENGTH)

tAB_LENGTH :: Int
tAB_LENGTH :: Int
tAB_LENGTH = Int
8

-- Consume and return the largest string of characters satisfying p

lexWhile :: (Char -> Bool) -> Lex a String
lexWhile :: (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
p = ((String -> P a) -> P a) -> Lex a String
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((String -> P a) -> P a) -> Lex a String)
-> ((String -> P a) -> P a) -> Lex a String
forall a b. (a -> b) -> a -> b
$ \String -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
rss Int
c Int
l SrcLoc
loc Char
char ->
  case String
rss of
    [] -> P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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 Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
       in if Char -> Bool
p Char
r
            then P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Lex a String -> (String -> P a) -> P a
forall r a. Lex r a -> (a -> P r) -> P r
runL ((Char
rChar -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> Lex a String -> Lex a String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Lex a String
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 P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (String -> P a
cont []) (Char
rChar -> ShowS
forall a. a -> [a] -> [a]
:String
rs) Int
c Int
l SrcLoc
loc Char
char

-- | lexWhile without the return value.
lexWhile_ :: (Char -> Bool) -> Lex a ()
lexWhile_ :: (Char -> Bool) -> Lex a ()
lexWhile_ Char -> Bool
p = do String
_ <- (Char -> Bool) -> Lex a String
forall a. (Char -> Bool) -> Lex a String
lexWhile Char -> Bool
p
                 () -> Lex a ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- An alternative scan, to which we can return if subsequent scanning
-- is unsuccessful.

alternative :: Lex a v -> Lex a (Lex a v)
alternative :: Lex a v -> Lex a (Lex a v)
alternative (Lex (v -> P a) -> P a
v) = ((Lex a v -> P a) -> P a) -> Lex a (Lex a v)
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((Lex a v -> P a) -> P a) -> Lex a (Lex a v))
-> ((Lex a v -> P a) -> P a) -> Lex a (Lex a v)
forall a b. (a -> b) -> a -> b
$ \Lex a v -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y ->
    P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Lex a v -> P a
cont (((v -> P a) -> P a) -> Lex a v
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((v -> P a) -> P a) -> Lex a v) -> ((v -> P a) -> P a) -> Lex a v
forall a b. (a -> b) -> a -> b
$ \v -> P a
cont' -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
_r Int
_x Int
_y ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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

-- The source location is the coordinates of the previous token,
-- or, while scanning a token, the start of the current token.

-- col is the current column in the source file.
-- We also need to remember between scanning tokens whether we are
-- somewhere at the beginning of the line before the first token.
-- This could be done with an extra Bool argument to the P monad,
-- but as a hack we use a col value of 0 to indicate this situation.

-- Setting col to 0 is used in two places: just after emitting a virtual
-- close brace due to layout, so that next time through we check whether
-- we also need to emit a semi-colon, and at the beginning of the file,
-- by runParser, to kick off the lexer.
-- Thus when col is zero, the true column can be taken from the loc.

checkBOL :: Lex a Bool
checkBOL :: Lex a Bool
checkBOL = ((Bool -> P a) -> P a) -> Lex a Bool
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((Bool -> P a) -> P a) -> Lex a Bool)
-> ((Bool -> P a) -> P a) -> Lex a Bool
forall a b. (a -> b) -> a -> b
$ \Bool -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc ->
        if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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 P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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 :: Lex a ()
setBOL = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
_ -> P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (() -> P a
cont ()) String
r Int
0

-- Set the loc to the current position

startToken :: Lex a ()
startToken :: Lex a ()
startToken = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
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 :: String -> Int -> Int -> SrcLoc
SrcLoc {
        srcFilename :: String
srcFilename = InternalParseMode -> String
iParseFilename InternalParseMode
mode,
        srcLine :: Int
srcLine = Int
y,
        srcColumn :: Int
srcColumn = Int
x
    } in
    P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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

-- Current status with respect to the offside (layout) rule:
-- LT: we are to the left of the current indent (if any)
-- EQ: we are at the current indent (if any)
-- GT: we are to the right of the current indent, or not subject to layout

getOffside :: Lex a Ordering
getOffside :: Lex a Ordering
getOffside = ((Ordering -> P a) -> P a) -> Lex a Ordering
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((Ordering -> P a) -> P a) -> Lex a Ordering)
-> ((Ordering -> P a) -> P a) -> Lex a Ordering
forall a b. (a -> b) -> a -> b
$ \Ordering -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ParseState
stk ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Ordering -> P a
cont (Int -> Int -> Ordering
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 :: Lex a SrcLoc
getSrcLocL = ((SrcLoc -> P a) -> P a) -> Lex a SrcLoc
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((SrcLoc -> P a) -> P a) -> Lex a SrcLoc)
-> ((SrcLoc -> P a) -> P a) -> Lex a SrcLoc
forall a b. (a -> b) -> a -> b
$ \SrcLoc -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
i Int
x Int
y SrcLoc
l ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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 :: Int -> Lex a ()
setSrcLineL Int
y = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
i Int
x Int
_ ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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 :: LexContext -> Lex a ()
pushContextL LexContext
ctxt = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
stk, [[KnownExtension]]
exts, [ExtContext]
e, CtxtFlag
pst, [Comment]
cs) ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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
ctxtLexContext -> [LexContext] -> [LexContext]
forall a. a -> [a] -> [a]
:[LexContext]
stk, [[KnownExtension]]
exts, [ExtContext]
e, CtxtFlag
pst, [Comment]
cs)

popContextL :: String -> Lex a ()
popContextL :: String -> Lex a ()
popContextL String
_ = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
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, CtxtFlag
pst, [Comment]
cs) -> P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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, CtxtFlag
pst, [Comment]
cs) InternalParseMode
m
        ([], [[KnownExtension]]
_, [ExtContext]
_, CtxtFlag
_, [Comment]
_)           -> SrcLoc -> String -> ParseStatus a
forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc String
"Unexpected }"

pullCtxtFlag :: Lex a Bool
pullCtxtFlag :: Lex a Bool
pullCtxtFlag = ((Bool -> P a) -> P a) -> Lex a Bool
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((Bool -> P a) -> P a) -> Lex a Bool)
-> ((Bool -> P a) -> P a) -> Lex a Bool
forall a b. (a -> b) -> a -> b
$ \Bool -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
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) ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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 :: Lex a ()
flagDo = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
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) ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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)


-- Harp/Hsx

getExtContext :: Lex a (Maybe ExtContext)
getExtContext :: Lex a (Maybe ExtContext)
getExtContext = ((Maybe ExtContext -> P a) -> P a) -> Lex a (Maybe ExtContext)
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((Maybe ExtContext -> P a) -> P a) -> Lex a (Maybe ExtContext))
-> ((Maybe ExtContext -> P a) -> P a) -> Lex a (Maybe ExtContext)
forall a b. (a -> b) -> a -> b
$ \Maybe ExtContext -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch stk :: ParseState
stk@([LexContext]
_, [[KnownExtension]]
_, [ExtContext]
e, CtxtFlag
_, [Comment]
_) ->
        let me :: Maybe ExtContext
me = case [ExtContext]
e of
              [] -> Maybe ExtContext
forall a. Maybe a
Nothing
              (ExtContext
c:[ExtContext]
_) -> ExtContext -> Maybe ExtContext
forall a. a -> Maybe a
Just ExtContext
c
        in P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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 :: ExtContext -> Lex a ()
pushExtContextL ExtContext
ec = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, CtxtFlag
p, [Comment]
c) ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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
ecExtContext -> [ExtContext] -> [ExtContext]
forall a. a -> [a] -> [a]
:[ExtContext]
e, CtxtFlag
p, [Comment]
c)

popExtContextL :: String -> Lex a ()
popExtContextL :: String -> Lex a ()
popExtContextL String
fn = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s,[[KnownExtension]]
exts,[ExtContext]
e,CtxtFlag
p,[Comment]
c) InternalParseMode
m -> case [ExtContext]
e of
            (ExtContext
_:[ExtContext]
ec)   -> P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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,CtxtFlag
p,[Comment]
c) InternalParseMode
m
            []       -> SrcLoc -> String -> ParseStatus a
forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc (String
"Internal error: empty tag context in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fn)


-- Extension-aware lexing

getExtensionsL :: Lex a [KnownExtension]
getExtensionsL :: Lex a [KnownExtension]
getExtensionsL = (([KnownExtension] -> P a) -> P a) -> Lex a [KnownExtension]
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex ((([KnownExtension] -> P a) -> P a) -> Lex a [KnownExtension])
-> (([KnownExtension] -> P a) -> P a) -> Lex a [KnownExtension]
forall a b. (a -> b) -> a -> b
$ \[KnownExtension] -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ParseState
s InternalParseMode
m ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP ([KnownExtension] -> P a
cont ([KnownExtension] -> P a) -> [KnownExtension] -> P a
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

-- | Add an extension to the current configuration.
addExtensionL :: KnownExtension -> Lex a ()
addExtensionL :: KnownExtension -> Lex a ()
addExtensionL KnownExtension
ext = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, [[KnownExtension]]
oldExts, [ExtContext]
e, CtxtFlag
p, [Comment]
c) InternalParseMode
m ->
        let newExts :: [KnownExtension]
newExts = [KnownExtension] -> [KnownExtension]
impliesExts [KnownExtension
ext] [KnownExtension] -> [KnownExtension] -> [KnownExtension]
forall a. [a] -> [a] -> [a]
++ InternalParseMode -> [KnownExtension]
iExtensions InternalParseMode
m
        in P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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, CtxtFlag
p, [Comment]
c) (InternalParseMode
m {iExtensions :: [KnownExtension]
iExtensions = [KnownExtension]
newExts})

-- | Save the current configuration of extensions.
saveExtensionsL :: Lex a ()
saveExtensionsL :: Lex a ()
saveExtensionsL = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, [[KnownExtension]]
oldExts, [ExtContext]
e, CtxtFlag
p, [Comment]
c) InternalParseMode
m ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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
m[KnownExtension] -> [[KnownExtension]] -> [[KnownExtension]]
forall a. a -> [a] -> [a]
:[[KnownExtension]]
oldExts, [ExtContext]
e, CtxtFlag
p, [Comment]
c) InternalParseMode
m

-- | Return to the previous saved extensions configuration.
restoreExtensionsL :: Lex a ()
restoreExtensionsL :: Lex a ()
restoreExtensionsL = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s,[[KnownExtension]]
exts,[ExtContext]
e,CtxtFlag
p,[Comment]
c) InternalParseMode
m -> case [[KnownExtension]]
exts of
            ([KnownExtension]
_:[[KnownExtension]]
prev) -> P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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,CtxtFlag
p,[Comment]
c) InternalParseMode
m
            [[KnownExtension]]
_        -> SrcLoc -> String -> ParseStatus a
forall a. SrcLoc -> String -> ParseStatus a
Failed SrcLoc
loc String
"Internal error: empty extension stack"

-- LINE-aware lexing

ignoreLinePragmasL :: Lex a Bool
ignoreLinePragmasL :: Lex a Bool
ignoreLinePragmasL = ((Bool -> P a) -> P a) -> Lex a Bool
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((Bool -> P a) -> P a) -> Lex a Bool)
-> ((Bool -> P a) -> P a) -> Lex a Bool
forall a b. (a -> b) -> a -> b
$ \Bool -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
c ParseState
s InternalParseMode
m ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
forall a.
P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
runP (Bool -> P a
cont (Bool -> P a) -> Bool -> P a
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

-- If we read a file name in a LINE pragma, we should update the state.
setLineFilenameL :: String -> Lex a ()
setLineFilenameL :: String -> Lex a ()
setLineFilenameL String
name = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ParseState
s InternalParseMode
m ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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})

-- Comments

pushComment :: Comment -> Lex a ()
pushComment :: Comment -> Lex a ()
pushComment Comment
c = ((() -> P a) -> P a) -> Lex a ()
forall r a. ((a -> P r) -> P r) -> Lex r a
Lex (((() -> P a) -> P a) -> Lex a ())
-> ((() -> P a) -> P a) -> Lex a ()
forall a b. (a -> b) -> a -> b
$ \() -> P a
cont -> (String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
forall a.
(String
 -> Int
 -> Int
 -> SrcLoc
 -> Char
 -> ParseState
 -> InternalParseMode
 -> ParseStatus a)
-> P a
P ((String
  -> Int
  -> Int
  -> SrcLoc
  -> Char
  -> ParseState
  -> InternalParseMode
  -> ParseStatus a)
 -> P a)
-> (String
    -> Int
    -> Int
    -> SrcLoc
    -> Char
    -> ParseState
    -> InternalParseMode
    -> ParseStatus a)
-> P a
forall a b. (a -> b) -> a -> b
$ \String
r Int
x Int
y SrcLoc
loc Char
ch ([LexContext]
s, [[KnownExtension]]
exts, [ExtContext]
e, CtxtFlag
p, [Comment]
cs) ->
        P a
-> String
-> Int
-> Int
-> SrcLoc
-> Char
-> ParseState
-> InternalParseMode
-> ParseStatus a
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, CtxtFlag
p, Comment
cComment -> [Comment] -> [Comment]
forall a. a -> [a] -> [a]
:[Comment]
cs)