    {-# LANGUAGE CPP #-}
    {-# OPTIONS_GHC -Wwarn=incomplete-uni-patterns #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.C.Syntax.ParserMonad
    -- Copyright   :  (c) [1999..2004] Manuel M T Chakravarty
    --                (c) 2005-2007 Duncan Coutts
    -- License     :  BSD-style
    -- Maintainer  :  benedikt.huber@gmail.com
    -- Portability :  portable
    --
    -- Monad for the C lexer and parser
    --
    --  This monad has to be usable with Alex and Happy. Some things in it are
    --  dictated by that, eg having to be able to remember the last token.
    --
    --  The monad also provides a unique name supply (via the Name module)
    --
    --  For parsing C we have to maintain a set of identifiers that we know to be
    --  typedef'ed type identifiers. We also must deal correctly with scope so we
    --  keep a list of sets of identifiers so we can save the outer scope when we
    --  enter an inner scope.
    module Language.C.Parser.ParserMonad (
      P,
      execParser,
      failP,
      getNewName,        -- :: P Name
      addTypedef,        -- :: Ident -> P ()
      shadowTypedef,     -- :: Ident -> P ()
      isTypeIdent,       -- :: Ident -> P Bool
      enterScope,        -- :: P ()
      leaveScope,        -- :: P ()
      setPos,            -- :: Position -> P ()
      getPos,            -- :: P Position
      getInput,          -- :: P String
      setInput,          -- :: String -> P ()
      getLastToken,      -- :: P CToken
      getSavedToken,     -- :: P CToken
      setLastToken,      -- :: CToken -> P ()
      handleEofToken,    -- :: P ()
      getCurrentPosition,-- :: P Position
      ParseError(..),
      ) where
    import Language.C.Data.Error (internalErr, showErrorInfo,ErrorInfo(..),ErrorLevel(..))
    import Language.C.Data.Position  (Position(..))
    import Language.C.Data.InputStream
    import Language.C.Data.Name    (Name)
    import Language.C.Data.Ident    (Ident)
    import Language.C.Parser.Tokens (CToken(CTokEof))

    import Prelude hiding (Applicative(..), MonadFail(..))
    import Control.Applicative (Applicative(..))
    import Control.Monad (liftM, ap)
    import Control.Monad.Fail (MonadFail (..))
    import Data.Set  (Set)
    import qualified Data.Set as Set (fromList, insert, member, delete)

    newtype ParseError = ParseError ([String],Position)
    instance Show ParseError where
        show :: ParseError -> String
    show (ParseError ([String]
    msgs,Position
    pos)) = String -> ErrorInfo -> String
    showErrorInfo String
    "Syntax Error !" (ErrorLevel -> Position -> [String] -> ErrorInfo
    ErrorInfo ErrorLevel
    LevelError Position
    pos [String]
    msgs)

    data ParseResult a
      = POk !PState a
      | PFailed [String] Position   -- The error message and position

    data PState = PState {
            PState -> Position
    curPos     :: !Position,        -- position at current input location
            PState -> InputStream
    curInput   :: !InputStream,      -- the current input
            PState -> CToken
    prevToken  ::  CToken,          -- the previous token
            PState -> CToken
    savedToken ::  CToken,          -- and the token before that
            PState -> [Name]
    namesupply :: ![Name],          -- the name unique supply
            PState -> Set Ident
    tyidents   :: !(Set Ident),     -- the set of typedef'ed identifiers
            PState -> [Set Ident]
    scopes     :: ![Set Ident]      -- the tyident sets for outer scopes
         }

    newtype P a = P { forall a. P a -> PState -> ParseResult a
    unP :: PState -> ParseResult a }

    instance Functor P where
      fmap :: forall a b. (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 :: forall a. a -> P a
    pure = a -> P a
    forall a. a -> P a
    returnP
      <*> :: forall a b. 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
      >>= :: forall a b. P a -> (a -> P b) -> P b
    (>>=) = P a -> (a -> P b) -> P b
    forall a b. P a -> (a -> P b) -> P b
    thenP
    #if !MIN_VERSION_base(4,13,0)
      fail m = getPos >>= \pos -> failP pos [m]
    #endif

    #if MIN_VERSION_base(4,9,0)
    instance MonadFail P where
      fail :: forall a. String -> P a
    fail String
    m = P Position
    getPos P Position -> (Position -> P a) -> P a
    forall a b. P a -> (a -> P b) -> P b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Position
    pos -> Position -> [String] -> P a
    forall a. Position -> [String] -> P a
    failP Position
    pos [String
    m]
    #endif

    -- | execute the given parser on the supplied input stream.
    --   returns 'ParseError' if the parser failed, and a pair of
    --   result and remaining name supply otherwise
    --
    -- Synopsis: @execParser parser inputStream initialPos predefinedTypedefs uniqNameSupply@
    execParser :: P a -> InputStream -> Position -> [Ident] -> [Name]
               -> Either ParseError (a,[Name])
    execParser :: forall a.
    P a
    -> InputStream
    -> Position
    -> [Ident]
    -> [Name]
    -> Either ParseError (a, [Name])
    execParser (P PState -> ParseResult a
    parser) InputStream
    input Position
    pos [Ident]
    builtins [Name]
    names =
      case PState -> ParseResult a
    parser PState
    initialState of
        PFailed [String]
    message Position
    errpos -> ParseError -> Either ParseError (a, [Name])
    forall a b. a -> Either a b
    Left (([String], Position) -> ParseError
    ParseError ([String]
    message,Position
    errpos))
        POk PState
    st a
    result -> (a, [Name]) -> Either ParseError (a, [Name])
    forall a b. b -> Either a b
    Right (a
    result, PState -> [Name]
    namesupply PState
    st)
      where initialState :: PState
    initialState = PState {
              curPos :: Position
    curPos = Position
    pos,
              curInput :: InputStream
    curInput = InputStream
    input,
              prevToken :: CToken
    prevToken = String -> CToken
    forall a. String -> a
    internalErr String
    "CLexer.execParser: Touched undefined token!",
              savedToken :: CToken
    savedToken = String -> CToken
    forall a. String -> a
    internalErr String
    "CLexer.execParser: Touched undefined token (safed token)!",
              namesupply :: [Name]
    namesupply = [Name]
    names,
              tyidents :: Set Ident
    tyidents = [Ident] -> Set Ident
    forall a. Ord a => [a] -> Set a
    Set.fromList [Ident]
    builtins,
              scopes :: [Set Ident]
    scopes   = []
            }

    {-# INLINE returnP #-}
    returnP :: a -> P a
    returnP :: forall a. a -> P a
    returnP a
    a = (PState -> ParseResult a) -> P a
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult a) -> P a)
    -> (PState -> ParseResult a) -> P a
    forall a b. (a -> b) -> a -> b
    $ \PState
    s -> PState -> a -> ParseResult a
    forall a. PState -> a -> ParseResult a
    POk PState
    s a
    a

    {-# INLINE thenP #-}
    thenP :: P a -> (a -> P b) -> P b
    (P PState -> ParseResult a
    m) thenP :: forall a b. P a -> (a -> P b) -> P b
    `thenP` a -> P b
    k = (PState -> ParseResult b) -> P b
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult b) -> P b)
    -> (PState -> ParseResult b) -> P b
    forall a b. (a -> b) -> a -> b
    $ \PState
    s ->
            case PState -> ParseResult a
    m PState
    s of
                    POk PState
    s' a
    a        -> (P b -> PState -> ParseResult b
    forall a. P a -> PState -> ParseResult a
    unP (a -> P b
    k a
    a)) PState
    s'
                    PFailed [String]
    err Position
    pos -> [String] -> Position -> ParseResult b
    forall a. [String] -> Position -> ParseResult a
    PFailed [String]
    err Position
    pos

    failP :: Position -> [String] -> P a
    failP :: forall a. Position -> [String] -> P a
    failP Position
    pos [String]
    msg = (PState -> ParseResult a) -> P a
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult a) -> P a)
    -> (PState -> ParseResult a) -> P a
    forall a b. (a -> b) -> a -> b
    $ \PState
    _ -> [String] -> Position -> ParseResult a
    forall a. [String] -> Position -> ParseResult a
    PFailed [String]
    msg Position
    pos

    getNewName :: P Name
    getNewName :: P Name
    getNewName = (PState -> ParseResult Name) -> P Name
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult Name) -> P Name)
    -> (PState -> ParseResult Name) -> P Name
    forall a b. (a -> b) -> a -> b
    $ \s :: PState
    s@PState{namesupply :: PState -> [Name]
    namesupply=(Name
    n:[Name]
    ns)} -> Name
    n Name -> ParseResult Name -> ParseResult Name
    forall a b. a -> b -> b
    `seq` PState -> Name -> ParseResult Name
    forall a. PState -> a -> ParseResult a
    POk PState
    s{namesupply=ns} Name
    n

    setPos :: Position -> P ()
    setPos :: Position -> P ()
    setPos Position
    pos = (PState -> ParseResult ()) -> P ()
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult ()) -> P ())
    -> (PState -> ParseResult ()) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \PState
    s -> PState -> () -> ParseResult ()
    forall a. PState -> a -> ParseResult a
    POk PState
    s{curPos=pos} ()

    getPos :: P Position
    getPos :: P Position
    getPos = (PState -> ParseResult Position) -> P Position
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult Position) -> P Position)
    -> (PState -> ParseResult Position) -> P Position
    forall a b. (a -> b) -> a -> b
    $ \s :: PState
    s@PState{curPos :: PState -> Position
    curPos=Position
    pos} -> PState -> Position -> ParseResult Position
    forall a. PState -> a -> ParseResult a
    POk PState
    s Position
    pos

    addTypedef :: Ident -> P ()
    addTypedef :: Ident -> P ()
    addTypedef Ident
    ident = ((PState -> ParseResult ()) -> P ()
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult ()) -> P ())
    -> (PState -> ParseResult ()) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \s :: PState
    s@PState{tyidents :: PState -> Set Ident
    tyidents=Set Ident
    tyids} ->
                                 PState -> () -> ParseResult ()
    forall a. PState -> a -> ParseResult a
    POk PState
    s{tyidents = ident `Set.insert` tyids} ())

    shadowTypedef :: Ident -> P ()
    shadowTypedef :: Ident -> P ()
    shadowTypedef Ident
    ident = ((PState -> ParseResult ()) -> P ()
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult ()) -> P ())
    -> (PState -> ParseResult ()) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \s :: PState
    s@PState{tyidents :: PState -> Set Ident
    tyidents=Set Ident
    tyids} ->
                                 -- optimisation: mostly the ident will not be in
                                 -- the tyident set so do a member lookup to avoid
                                 --  churn induced by calling delete
                                 PState -> () -> ParseResult ()
    forall a. PState -> a -> ParseResult a
    POk PState
    s{tyidents = if ident `Set.member` tyids
                                                    then ident `Set.delete` tyids
                                                    else tyids } ())

    isTypeIdent :: Ident -> P Bool
    isTypeIdent :: Ident -> P Bool
    isTypeIdent Ident
    ident = (PState -> ParseResult Bool) -> P Bool
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult Bool) -> P Bool)
    -> (PState -> ParseResult Bool) -> P Bool
    forall a b. (a -> b) -> a -> b
    $ \s :: PState
    s@PState{tyidents :: PState -> Set Ident
    tyidents=Set Ident
    tyids} ->
                                 PState -> Bool -> ParseResult Bool
    forall a. PState -> a -> ParseResult a
    POk PState
    s (Bool -> ParseResult Bool) -> Bool -> ParseResult Bool
    forall a b. (a -> b) -> a -> b
    $! Ident -> Set Ident -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member Ident
    ident Set Ident
    tyids

    enterScope :: P ()
    enterScope :: P ()
    enterScope = (PState -> ParseResult ()) -> P ()
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult ()) -> P ())
    -> (PState -> ParseResult ()) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \s :: PState
    s@PState{tyidents :: PState -> Set Ident
    tyidents=Set Ident
    tyids,scopes :: PState -> [Set Ident]
    scopes=[Set Ident]
    ss} ->
                         PState -> () -> ParseResult ()
    forall a. PState -> a -> ParseResult a
    POk PState
    s{scopes=tyids:ss} ()

    leaveScope :: P ()
    leaveScope :: P ()
    leaveScope = (PState -> ParseResult ()) -> P ()
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult ()) -> P ())
    -> (PState -> ParseResult ()) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \s :: PState
    s@PState{scopes :: PState -> [Set Ident]
    scopes=[Set Ident]
    ss} ->
                         case [Set Ident]
    ss of
                           []          -> String -> ParseResult ()
    forall a. HasCallStack => String -> a
    error String
    "leaveScope: already in global scope"
                           (Set Ident
    tyids:[Set Ident]
    ss') -> PState -> () -> ParseResult ()
    forall a. PState -> a -> ParseResult a
    POk PState
    s{tyidents=tyids, scopes=ss'} ()

    getInput :: P InputStream
    getInput :: P InputStream
    getInput = (PState -> ParseResult InputStream) -> P InputStream
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult InputStream) -> P InputStream)
    -> (PState -> ParseResult InputStream) -> P InputStream
    forall a b. (a -> b) -> a -> b
    $ \s :: PState
    s@PState{curInput :: PState -> InputStream
    curInput=InputStream
    i} -> PState -> InputStream -> ParseResult InputStream
    forall a. PState -> a -> ParseResult a
    POk PState
    s InputStream
    i

    setInput :: InputStream -> P ()
    setInput :: InputStream -> P ()
    setInput InputStream
    i = (PState -> ParseResult ()) -> P ()
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult ()) -> P ())
    -> (PState -> ParseResult ()) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \PState
    s -> PState -> () -> ParseResult ()
    forall a. PState -> a -> ParseResult a
    POk PState
    s{curInput=i} ()

    getLastToken :: P CToken
    getLastToken :: P CToken
    getLastToken = (PState -> ParseResult CToken) -> P CToken
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult CToken) -> P CToken)
    -> (PState -> ParseResult CToken) -> P CToken
    forall a b. (a -> b) -> a -> b
    $ \s :: PState
    s@PState{prevToken :: PState -> CToken
    prevToken=CToken
    tok} -> PState -> CToken -> ParseResult CToken
    forall a. PState -> a -> ParseResult a
    POk PState
    s CToken
    tok

    getSavedToken :: P CToken
    getSavedToken :: P CToken
    getSavedToken = (PState -> ParseResult CToken) -> P CToken
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult CToken) -> P CToken)
    -> (PState -> ParseResult CToken) -> P CToken
    forall a b. (a -> b) -> a -> b
    $ \s :: PState
    s@PState{savedToken :: PState -> CToken
    savedToken=CToken
    tok} -> PState -> CToken -> ParseResult CToken
    forall a. PState -> a -> ParseResult a
    POk PState
    s CToken
    tok

    -- | @setLastToken modifyCache tok@
    setLastToken :: CToken -> P ()
    setLastToken :: CToken -> P ()
    setLastToken CToken
    CTokEof = (PState -> ParseResult ()) -> P ()
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult ()) -> P ())
    -> (PState -> ParseResult ()) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \PState
    s -> PState -> () -> ParseResult ()
    forall a. PState -> a -> ParseResult a
    POk PState
    s{savedToken=(prevToken s)} ()
    setLastToken CToken
    tok      = (PState -> ParseResult ()) -> P ()
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult ()) -> P ())
    -> (PState -> ParseResult ()) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \PState
    s -> PState -> () -> ParseResult ()
    forall a. PState -> a -> ParseResult a
    POk PState
    s{prevToken=tok,savedToken=(prevToken s)} ()

    -- | handle an End-Of-File token (changes savedToken)
    handleEofToken :: P ()
    handleEofToken :: P ()
    handleEofToken = (PState -> ParseResult ()) -> P ()
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult ()) -> P ())
    -> (PState -> ParseResult ()) -> P ()
    forall a b. (a -> b) -> a -> b
    $ \PState
    s -> PState -> () -> ParseResult ()
    forall a. PState -> a -> ParseResult a
    POk PState
    s{savedToken=(prevToken s)} ()

    getCurrentPosition :: P Position
    getCurrentPosition :: P Position
    getCurrentPosition = (PState -> ParseResult Position) -> P Position
    forall a. (PState -> ParseResult a) -> P a
    P ((PState -> ParseResult Position) -> P Position)
    -> (PState -> ParseResult Position) -> P Position
    forall a b. (a -> b) -> a -> b
    $ \s :: PState
    s@PState{curPos :: PState -> Position
    curPos=Position
    pos} -> PState -> Position -> ParseResult Position
    forall a. PState -> a -> ParseResult a
    POk PState
    s Position
    pos