-- |
-- Module      :  Language.C.Parser.Monad
-- Copyright   :  (c) 2006-2011 Harvard University
--                (c) 2011-2013 Geoffrey Mainland
-- License     :  BSD-style
-- Maintainer  :  mainland@drexel.edu

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Language.C.Parser.Monad (
    P,
    runP,
    evalP,

    PState,
    emptyPState,

    getInput,
    setInput,
    pushLexState,
    popLexState,
    getLexState,
    pushbackToken,
    getPushbackToken,
    getCurToken,
    setCurToken,

    addTypedef,
    addClassdef,
    addVariable,
    isTypedef,
    isClassdef,

    pushScope,
    popScope,

    c99Exts,
    c11Exts,
    gccExts,
    blocksExts,
    cudaExts,
    openCLExts,
    objcExts,

    useExts,
    antiquotationExts,
    useC99Exts,
    useC11Exts,
    useGccExts,
    useBlocksExts,
    useCUDAExts,
    useOpenCLExts,
    useObjCExts,

    LexerException(..),
    ParserException(..),
    quoteTok,
    failAt,
    lexerError,
    unexpectedEOF,
    emptyCharacterLiteral,
    illegalCharacterLiteral,
    illegalNumericalLiteral,
    parserError,
    unclosed,
    expected,
    expectedAt,

    AlexInput(..),
    alexGetChar,
    alexGetByte,
    alexInputPrevChar,
    alexLoc,
    nextChar,
    peekChar,
    maybePeekChar,
    skipChar,

    AlexPredicate,
    allowAnti,
    ifExtension
  ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative(..))
#endif /* !MIN_VERSION_base(4,8,0) */
import Control.Monad.Exception
import Control.Monad.State
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Internal (c2w)
import Data.List (foldl')
import Data.Loc
#if !(MIN_VERSION_base(4,9,0))
import Data.Monoid (Monoid(..), (<>))
#endif /* !(MIN_VERSION_base(4,9,0)) */
#if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import Data.Word
import Text.PrettyPrint.Mainland
import Text.PrettyPrint.Mainland.Class

import Language.C.Parser.Tokens
import Language.C.Syntax

data PState = PState
    { PState -> AlexInput
input      :: !AlexInput
    , PState -> Maybe (L Token)
pbToken    :: !(Maybe (L Token))
    , PState -> L Token
curToken   :: L Token
    , PState -> [Int]
lexState   :: ![Int]
    , PState -> ExtensionsInt
extensions :: !ExtensionsInt
    , PState -> Set String
typedefs   :: !(Set.Set String)
    , PState -> Set String
classdefs  :: !(Set.Set String)
    , PState -> [(Set String, Set String)]
scopes     :: [(Set.Set String, Set.Set String)]
    }

emptyPState :: [Extensions]
            -> [String]
            -> B.ByteString
            -> Maybe Pos
            -> PState
emptyPState :: [Extensions] -> [String] -> ByteString -> Maybe Pos -> PState
emptyPState [Extensions]
exts [String]
typnames ByteString
buf Maybe Pos
pos = PState
    { input :: AlexInput
input       = AlexInput
inp
    , pbToken :: Maybe (L Token)
pbToken     = forall a. Maybe a
Nothing
    , curToken :: L Token
curToken    = forall a. HasCallStack => String -> a
error String
"no token"
    , lexState :: [Int]
lexState    = [Int
0]
    , extensions :: ExtensionsInt
extensions  = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Bits a => a -> Int -> a
setBit ExtensionsInt
0 (forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => a -> Int
fromEnum [Extensions]
exts)
    , typedefs :: Set String
typedefs    = forall a. Ord a => [a] -> Set a
Set.fromList [String]
typnames
    , classdefs :: Set String
classdefs   = forall a. Set a
Set.empty
    , scopes :: [(Set String, Set String)]
scopes      = []
    }
  where
    inp :: AlexInput
    inp :: AlexInput
inp = AlexInput
          { alexPos :: Maybe Pos
alexPos      = Maybe Pos
pos
          , alexPrevChar :: Char
alexPrevChar = Char
'\n'
          , alexInput :: ByteString
alexInput    = ByteString
buf
          , alexOff :: Int
alexOff      = Int
0
          }

newtype P a = P { forall a. P a -> PState -> Either SomeException (a, PState)
runP :: PState -> Either SomeException (a, PState) }

instance Functor P where
    fmap :: forall a b. (a -> b) -> P a -> P b
fmap a -> b
f P a
mx = forall a. (PState -> Either SomeException (a, PState)) -> P a
P forall a b. (a -> b) -> a -> b
$ \PState
s -> case forall a. P a -> PState -> Either SomeException (a, PState)
runP P a
mx PState
s of
                            Left SomeException
e         -> forall a b. a -> Either a b
Left SomeException
e
                            Right (a
x, PState
s')  -> forall a b. b -> Either a b
Right (a -> b
f a
x, PState
s')

instance Applicative P where
    pure :: forall a. a -> P a
pure a
x = forall a. (PState -> Either SomeException (a, PState)) -> P a
P forall a b. (a -> b) -> a -> b
$ \PState
s -> forall a b. b -> Either a b
Right (a
x, PState
s)

    P (a -> b)
mf <*> :: forall a b. P (a -> b) -> P a -> P b
<*> P a
mx = forall a. (PState -> Either SomeException (a, PState)) -> P a
P forall a b. (a -> b) -> a -> b
$ \PState
s -> case forall a. P a -> PState -> Either SomeException (a, PState)
runP P (a -> b)
mf PState
s of
                            Left SomeException
e         -> forall a b. a -> Either a b
Left SomeException
e
                            Right (a -> b
f, PState
s')  -> forall a. P a -> PState -> Either SomeException (a, PState)
runP (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f P a
mx) PState
s'

instance Monad P where
    P a
m >>= :: forall a b. P a -> (a -> P b) -> P b
>>= a -> P b
k = forall a. (PState -> Either SomeException (a, PState)) -> P a
P forall a b. (a -> b) -> a -> b
$ \PState
s -> case forall a. P a -> PState -> Either SomeException (a, PState)
runP P a
m PState
s of
                          Left SomeException
e         -> forall a b. a -> Either a b
Left SomeException
e
                          Right (a
a, PState
s')  -> forall a. P a -> PState -> Either SomeException (a, PState)
runP (a -> P b
k a
a) PState
s'

    return :: forall a. a -> P a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure

#if MIN_VERSION_base(4,13,0)
instance MonadFail P where
#endif
    fail :: forall a. String -> P a
fail String
msg = do
        AlexInput
inp <- P AlexInput
getInput
        forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ParserException
ParserException (AlexInput -> AlexInput -> Loc
alexLoc AlexInput
inp AlexInput
inp) (String -> Doc
text String
msg)

instance MonadState PState P where
    get :: P PState
get    = forall a. (PState -> Either SomeException (a, PState)) -> P a
P forall a b. (a -> b) -> a -> b
$ \PState
s -> forall a b. b -> Either a b
Right (PState
s, PState
s)
    put :: PState -> P ()
put PState
s  = forall a. (PState -> Either SomeException (a, PState)) -> P a
P forall a b. (a -> b) -> a -> b
$ \PState
_ -> forall a b. b -> Either a b
Right ((), PState
s)

instance MonadException P where
    throw :: forall e a. Exception e => e -> P a
throw e
e = forall a. (PState -> Either SomeException (a, PState)) -> P a
P forall a b. (a -> b) -> a -> b
$ \PState
_ -> forall a b. a -> Either a b
Left (forall e. Exception e => e -> SomeException
toException e
e)

    P a
m catch :: forall e a. Exception e => P a -> (e -> P a) -> P a
`catch` e -> P a
h = forall a. (PState -> Either SomeException (a, PState)) -> P a
P forall a b. (a -> b) -> a -> b
$ \PState
s ->
        case forall a. P a -> PState -> Either SomeException (a, PState)
runP P a
m PState
s of
          Left SomeException
e ->
              case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                Just e
e'  -> forall a. P a -> PState -> Either SomeException (a, PState)
runP (e -> P a
h e
e') PState
s
                Maybe e
Nothing  -> forall a b. a -> Either a b
Left SomeException
e
          Right (a
a, PState
s')  -> forall a b. b -> Either a b
Right (a
a, PState
s')

evalP :: P a -> PState -> Either SomeException a
evalP :: forall a. P a -> PState -> Either SomeException a
evalP P a
comp PState
st =
    case forall a. P a -> PState -> Either SomeException (a, PState)
runP P a
comp PState
st of
      Left SomeException
e        -> forall a b. a -> Either a b
Left SomeException
e
      Right (a
a, PState
_)  -> forall a b. b -> Either a b
Right a
a

getInput  :: P AlexInput
getInput :: P AlexInput
getInput = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PState -> AlexInput
input

setInput  :: AlexInput -> P ()
setInput :: AlexInput -> P ()
setInput AlexInput
inp = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState
s { input :: AlexInput
input = AlexInput
inp }

pushLexState :: Int -> P ()
pushLexState :: Int -> P ()
pushLexState Int
ls = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState
s { lexState :: [Int]
lexState = Int
ls forall a. a -> [a] -> [a]
: PState -> [Int]
lexState PState
s }

popLexState :: P Int
popLexState :: P Int
popLexState = do
    Int
ls <- P Int
getLexState
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PState
s ->
        PState
s { lexState :: [Int]
lexState = forall a. [a] -> [a]
tail (PState -> [Int]
lexState PState
s) }
    forall (m :: * -> *) a. Monad m => a -> m a
return Int
ls

getLexState :: P Int
getLexState :: P Int
getLexState = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState -> [Int]
lexState)

pushbackToken :: L Token -> P ()
pushbackToken :: L Token -> P ()
pushbackToken L Token
tok = do
    Maybe (L Token)
maybe_tok <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PState -> Maybe (L Token)
pbToken
    case Maybe (L Token)
maybe_tok of
      Maybe (L Token)
Nothing -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PState
s -> PState
s { pbToken :: Maybe (L Token)
pbToken = forall a. a -> Maybe a
Just L Token
tok }
      Just L Token
_  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"More than one token pushed back."

getPushbackToken :: P (Maybe (L Token))
getPushbackToken :: P (Maybe (L Token))
getPushbackToken = do
    Maybe (L Token)
tok <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PState -> Maybe (L Token)
pbToken
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PState
s -> PState
s { pbToken :: Maybe (L Token)
pbToken = forall a. Maybe a
Nothing }
    forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (L Token)
tok

getCurToken :: P (L Token)
getCurToken :: P (L Token)
getCurToken = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PState -> L Token
curToken

setCurToken :: L Token -> P ()
setCurToken :: L Token -> P ()
setCurToken L Token
tok = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PState
s -> PState
s { curToken :: L Token
curToken = L Token
tok }

addTypedef :: String -> P ()
addTypedef :: String -> P ()
addTypedef String
ident = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState
s { typedefs :: Set String
typedefs = forall a. Ord a => a -> Set a -> Set a
Set.insert String
ident (PState -> Set String
typedefs PState
s) }

addClassdef :: String -> P ()
addClassdef :: String -> P ()
addClassdef String
ident = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState
s { classdefs :: Set String
classdefs = forall a. Ord a => a -> Set a -> Set a
Set.insert String
ident (PState -> Set String
classdefs PState
s) }

addVariable :: String -> P ()
addVariable :: String -> P ()
addVariable String
ident = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState
s { typedefs :: Set String
typedefs  = forall a. Ord a => a -> Set a -> Set a
Set.delete String
ident (PState -> Set String
typedefs PState
s)
      , classdefs :: Set String
classdefs = forall a. Ord a => a -> Set a -> Set a
Set.delete String
ident (PState -> Set String
classdefs PState
s)
      }

isTypedef :: String -> P Bool
isTypedef :: String -> P Bool
isTypedef String
ident = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ \PState
s ->
    forall a. Ord a => a -> Set a -> Bool
Set.member String
ident (PState -> Set String
typedefs PState
s)

isClassdef :: String -> P Bool
isClassdef :: String -> P Bool
isClassdef String
ident = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ \PState
s ->
    forall a. Ord a => a -> Set a -> Bool
Set.member String
ident (PState -> Set String
classdefs PState
s)

pushScope :: P ()
pushScope :: P ()
pushScope = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify  forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState
s { scopes :: [(Set String, Set String)]
scopes = (PState -> Set String
typedefs PState
s, PState -> Set String
classdefs PState
s) forall a. a -> [a] -> [a]
: PState -> [(Set String, Set String)]
scopes PState
s }

popScope :: P ()
popScope :: P ()
popScope = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify  forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState
s { scopes :: [(Set String, Set String)]
scopes     = (forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState -> [(Set String, Set String)]
scopes) PState
s
      , typedefs :: Set String
typedefs   = (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState -> [(Set String, Set String)]
scopes) PState
s
      , classdefs :: Set String
classdefs  = (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState -> [(Set String, Set String)]
scopes) PState
s
      }

antiquotationExts :: ExtensionsInt
antiquotationExts :: ExtensionsInt
antiquotationExts = (forall a. Bits a => Int -> a
bit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Extensions
Antiquotation

c99Exts :: ExtensionsInt
c99Exts :: ExtensionsInt
c99Exts = (forall a. Bits a => Int -> a
bit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Extensions
C99

c11Exts :: ExtensionsInt
c11Exts :: ExtensionsInt
c11Exts = (forall a. Bits a => Int -> a
bit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Extensions
C11

gccExts :: ExtensionsInt
gccExts :: ExtensionsInt
gccExts = (forall a. Bits a => Int -> a
bit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Extensions
Gcc

blocksExts :: ExtensionsInt
blocksExts :: ExtensionsInt
blocksExts = (forall a. Bits a => Int -> a
bit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Extensions
Blocks

cudaExts :: ExtensionsInt
cudaExts :: ExtensionsInt
cudaExts = (forall a. Bits a => Int -> a
bit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Extensions
CUDA

openCLExts :: ExtensionsInt
openCLExts :: ExtensionsInt
openCLExts = (forall a. Bits a => Int -> a
bit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Extensions
OpenCL

objcExts :: ExtensionsInt
objcExts :: ExtensionsInt
objcExts = (forall a. Bits a => Int -> a
bit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Extensions
Blocks forall a. Bits a => a -> a -> a
.|. (forall a. Bits a => Int -> a
bit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) Extensions
ObjC

useExts :: ExtensionsInt -> P Bool
useExts :: ExtensionsInt -> P Bool
useExts ExtensionsInt
ext = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState -> ExtensionsInt
extensions PState
s forall a. Bits a => a -> a -> a
.&. ExtensionsInt
ext forall a. Eq a => a -> a -> Bool
/= ExtensionsInt
0

useC99Exts :: P Bool
useC99Exts :: P Bool
useC99Exts = ExtensionsInt -> P Bool
useExts ExtensionsInt
c99Exts

useC11Exts :: P Bool
useC11Exts :: P Bool
useC11Exts = ExtensionsInt -> P Bool
useExts ExtensionsInt
c11Exts

useGccExts :: P Bool
useGccExts :: P Bool
useGccExts = ExtensionsInt -> P Bool
useExts ExtensionsInt
gccExts

useBlocksExts :: P Bool
useBlocksExts :: P Bool
useBlocksExts = ExtensionsInt -> P Bool
useExts ExtensionsInt
blocksExts

useCUDAExts :: P Bool
useCUDAExts :: P Bool
useCUDAExts = ExtensionsInt -> P Bool
useExts ExtensionsInt
cudaExts

useOpenCLExts :: P Bool
useOpenCLExts :: P Bool
useOpenCLExts = ExtensionsInt -> P Bool
useExts ExtensionsInt
openCLExts

useObjCExts :: P Bool
useObjCExts :: P Bool
useObjCExts = ExtensionsInt -> P Bool
useExts ExtensionsInt
objcExts

data LexerException = LexerException (Maybe Pos) Doc
  deriving (Typeable)

instance Exception LexerException where

instance Show LexerException where
    show :: LexerException -> String
show (LexerException Maybe Pos
pos Doc
msg) =
        Int -> Doc -> String
pretty Int
80 forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
4 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
ppr Maybe Pos
pos forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
":" Doc -> Doc -> Doc
</> Doc
msg

data ParserException = ParserException Loc Doc
  deriving (Typeable)

instance Exception ParserException where

instance Show ParserException where
    show :: ParserException -> String
show (ParserException Loc
loc Doc
msg) =
        Int -> Doc -> String
pretty Int
80 forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
4 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
ppr Loc
loc forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
":" Doc -> Doc -> Doc
</> Doc
msg

quoteTok :: Doc -> Doc
quoteTok :: Doc -> Doc
quoteTok = Doc -> Doc -> Doc -> Doc
enclose (Char -> Doc
char Char
'`') (Char -> Doc
char Char
'\'')

failAt :: Loc -> String -> P a
failAt :: forall a. Loc -> String -> P a
failAt Loc
loc String
msg =
    forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ParserException
ParserException Loc
loc (String -> Doc
text String
msg)

lexerError :: AlexInput -> Doc -> P a
lexerError :: forall a. AlexInput -> Doc -> P a
lexerError AlexInput
inp Doc
s =
    forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw forall a b. (a -> b) -> a -> b
$ Maybe Pos -> Doc -> LexerException
LexerException (AlexInput -> Maybe Pos
alexPos AlexInput
inp) (String -> Doc
text String
"lexer error on" Doc -> Doc -> Doc
<+> Doc
s)

unexpectedEOF :: AlexInput -> P a
unexpectedEOF :: forall a. AlexInput -> P a
unexpectedEOF AlexInput
inp =
    forall a. AlexInput -> Doc -> P a
lexerError AlexInput
inp (String -> Doc
text String
"unexpected end of file")

emptyCharacterLiteral :: AlexInput -> P a
emptyCharacterLiteral :: forall a. AlexInput -> P a
emptyCharacterLiteral AlexInput
inp =
    forall a. AlexInput -> Doc -> P a
lexerError AlexInput
inp (String -> Doc
text String
"empty character literal")

illegalCharacterLiteral :: AlexInput -> P a
illegalCharacterLiteral :: forall a. AlexInput -> P a
illegalCharacterLiteral AlexInput
inp =
    forall a. AlexInput -> Doc -> P a
lexerError AlexInput
inp (String -> Doc
text String
"illegal character literal")

illegalNumericalLiteral :: AlexInput -> P a
illegalNumericalLiteral :: forall a. AlexInput -> P a
illegalNumericalLiteral AlexInput
inp =
    forall a. AlexInput -> Doc -> P a
lexerError AlexInput
inp (String -> Doc
text String
"illegal numerical literal")

parserError :: Loc -> Doc -> P a
parserError :: forall a. Loc -> Doc -> P a
parserError Loc
loc Doc
msg =
    forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ParserException
ParserException Loc
loc Doc
msg

unclosed :: Loc -> String -> P a
unclosed :: forall a. Loc -> String -> P a
unclosed Loc
loc String
x =
    forall a. Loc -> Doc -> P a
parserError (Loc -> Loc
locEnd Loc
loc) (String -> Doc
text String
"unclosed" Doc -> Doc -> Doc
<+> Doc -> Doc
quoteTok (String -> Doc
text String
x))

expected :: [String] -> Maybe String -> P b
expected :: forall b. [String] -> Maybe String -> P b
expected [String]
alts Maybe String
after = do
    L Token
tok <- P (L Token)
getCurToken
    forall b. L Token -> [String] -> Maybe String -> P b
expectedAt L Token
tok [String]
alts Maybe String
after

expectedAt :: L Token -> [String] -> Maybe String -> P b
expectedAt :: forall b. L Token -> [String] -> Maybe String -> P b
expectedAt tok :: L Token
tok@(L Loc
loc Token
_) [String]
alts Maybe String
after = do
    forall a. Loc -> Doc -> P a
parserError (Loc -> Loc
locStart Loc
loc) (String -> Doc
text String
"expected" Doc -> Doc -> Doc
<+> [String] -> Doc
pprAlts [String]
alts Doc -> Doc -> Doc
<+> L Token -> Doc
pprGot L Token
tok forall a. Semigroup a => a -> a -> a
<> Maybe String -> Doc
pprAfter Maybe String
after)
  where
    pprAlts :: [String] -> Doc
    pprAlts :: [String] -> Doc
pprAlts []        = Doc
empty
    pprAlts [String
s]       = String -> Doc
text String
s
    pprAlts [String
s1, String
s2]  = String -> Doc
text String
s1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"or" Doc -> Doc -> Doc
<+> String -> Doc
text String
s2
    pprAlts (String
s : [String]
ss)  = String -> Doc
text String
s forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
<+> [String] -> Doc
pprAlts [String]
ss

    pprGot :: L Token -> Doc
    pprGot :: L Token -> Doc
pprGot (L Loc
_ Token
Teof)  = String -> Doc
text String
"but reached end of file"
    pprGot (L Loc
_ Token
t)     = String -> Doc
text String
"but got" Doc -> Doc -> Doc
<+> Doc -> Doc
quoteTok (forall a. Pretty a => a -> Doc
ppr Token
t)

    pprAfter :: Maybe String -> Doc
    pprAfter :: Maybe String -> Doc
pprAfter Maybe String
Nothing     = Doc
empty
    pprAfter (Just String
what) = String -> Doc
text String
" after" Doc -> Doc -> Doc
<+> String -> Doc
text String
what

data AlexInput = AlexInput
  {  AlexInput -> Maybe Pos
alexPos      :: !(Maybe Pos)
  ,  AlexInput -> Char
alexPrevChar :: {-#UNPACK#-} !Char
  ,  AlexInput -> ByteString
alexInput    :: {-#UNPACK#-} !B.ByteString
  ,  AlexInput -> Int
alexOff      :: {-#UNPACK#-} !Int
  }

alexGetChar :: AlexInput -> Maybe (Char, AlexInput)
alexGetChar :: AlexInput -> Maybe (Char, AlexInput)
alexGetChar AlexInput
inp =
    case ByteString -> Maybe (Char, ByteString)
B.uncons (AlexInput -> ByteString
alexInput AlexInput
inp) of
      Maybe (Char, ByteString)
Nothing       -> forall a. Maybe a
Nothing
      Just (Char
c, ByteString
bs)  -> forall a. a -> Maybe a
Just (Char
c, AlexInput
inp  {  alexPos :: Maybe Pos
alexPos       = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Pos
pos -> Pos -> Char -> Pos
advancePos Pos
pos Char
c) (AlexInput -> Maybe Pos
alexPos AlexInput
inp)
                                     ,  alexPrevChar :: Char
alexPrevChar  = Char
c
                                     ,  alexInput :: ByteString
alexInput     = ByteString
bs
                                     ,  alexOff :: Int
alexOff       = AlexInput -> Int
alexOff AlexInput
inp forall a. Num a => a -> a -> a
+ Int
1
                                     })

alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)
alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)
alexGetByte AlexInput
inp =
    case AlexInput -> Maybe (Char, AlexInput)
alexGetChar AlexInput
inp of
      Maybe (Char, AlexInput)
Nothing        -> forall a. Maybe a
Nothing
      Just (Char
c, AlexInput
inp') -> forall a. a -> Maybe a
Just (Char -> Word8
c2w Char
c, AlexInput
inp')

alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar = AlexInput -> Char
alexPrevChar

alexLoc :: AlexInput -> AlexInput -> Loc
alexLoc :: AlexInput -> AlexInput -> Loc
alexLoc AlexInput
inp1 AlexInput
inp2 =
    case (AlexInput -> Maybe Pos
alexPos AlexInput
inp1, AlexInput -> Maybe Pos
alexPos AlexInput
inp2) of
      (Just Pos
pos1, Just Pos
pos2) -> Pos -> Pos -> Loc
Loc Pos
pos1 Pos
pos2
      (Maybe Pos, Maybe Pos)
_                      -> Loc
NoLoc

nextChar :: P Char
nextChar :: P Char
nextChar = do
    AlexInput
inp <- P AlexInput
getInput
    case AlexInput -> Maybe (Char, AlexInput)
alexGetChar AlexInput
inp of
      Maybe (Char, AlexInput)
Nothing         -> forall a. AlexInput -> P a
unexpectedEOF AlexInput
inp
      Just (Char
c, AlexInput
inp')  -> AlexInput -> P ()
setInput AlexInput
inp' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
c

peekChar ::P Char
peekChar :: P Char
peekChar = do
    AlexInput
inp <- P AlexInput
getInput
    case ByteString -> Maybe (Char, ByteString)
B.uncons (AlexInput -> ByteString
alexInput AlexInput
inp) of
      Maybe (Char, ByteString)
Nothing      -> forall a. AlexInput -> P a
unexpectedEOF AlexInput
inp
      Just (Char
c, ByteString
_)  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
c

maybePeekChar :: P (Maybe Char)
maybePeekChar :: P (Maybe Char)
maybePeekChar = do
    AlexInput
inp <- P AlexInput
getInput
    case AlexInput -> Maybe (Char, AlexInput)
alexGetChar AlexInput
inp of
      Maybe (Char, AlexInput)
Nothing      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Just (Char
c, AlexInput
_)  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Char
c)

skipChar :: P ()
skipChar :: P ()
skipChar = do
    AlexInput
inp <- P AlexInput
getInput
    case AlexInput -> Maybe (Char, AlexInput)
alexGetChar AlexInput
inp of
      Maybe (Char, AlexInput)
Nothing         -> forall a. AlexInput -> P a
unexpectedEOF AlexInput
inp
      Just (Char
_, AlexInput
inp')  -> AlexInput -> P ()
setInput AlexInput
inp'

-- | The components of an 'AlexPredicate' are the predicate state, input stream
-- before the token, length of the token, input stream after the token.
type AlexPredicate =  PState
                   -> AlexInput
                   -> Int
                   -> AlexInput
                   -> Bool

allowAnti :: AlexPredicate
allowAnti :: AlexPredicate
allowAnti = ExtensionsInt -> AlexPredicate
ifExtension ExtensionsInt
antiquotationExts

ifExtension :: ExtensionsInt -> AlexPredicate
ifExtension :: ExtensionsInt -> AlexPredicate
ifExtension ExtensionsInt
i PState
s AlexInput
_ Int
_ AlexInput
_ = PState -> ExtensionsInt
extensions PState
s forall a. Bits a => a -> a -> a
.&. ExtensionsInt
i forall a. Eq a => a -> a -> Bool
/= ExtensionsInt
0