-- |
-- 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.Identity
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 :: AlexInput
-> Maybe (L Token)
-> L Token
-> [Int]
-> ExtensionsInt
-> Set String
-> Set String
-> [(Set String, Set String)]
-> PState
PState
    { input :: AlexInput
input       = AlexInput
inp
    , pbToken :: Maybe (L Token)
pbToken     = Maybe (L Token)
forall a. Maybe a
Nothing
    , curToken :: L Token
curToken    = String -> L Token
forall a. HasCallStack => String -> a
error String
"no token"
    , lexState :: [Int]
lexState    = [Int
0]
    , extensions :: ExtensionsInt
extensions  = (ExtensionsInt -> Int -> ExtensionsInt)
-> ExtensionsInt -> [Int] -> ExtensionsInt
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ExtensionsInt -> Int -> ExtensionsInt
forall a. Bits a => a -> Int -> a
setBit ExtensionsInt
0 ((Extensions -> Int) -> [Extensions] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Extensions -> Int
forall a. Enum a => a -> Int
fromEnum [Extensions]
exts)
    , typedefs :: Set String
typedefs    = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
typnames
    , classdefs :: Set String
classdefs   = Set String
forall a. Set a
Set.empty
    , scopes :: [(Set String, Set String)]
scopes      = []
    }
  where
    inp :: AlexInput
    inp :: AlexInput
inp = AlexInput :: Maybe Pos -> Char -> ByteString -> Int -> AlexInput
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 { P a -> PState -> Either SomeException (a, PState)
runP :: PState -> Either SomeException (a, PState) }

instance Functor P where
    fmap :: (a -> b) -> P a -> P b
fmap a -> b
f P a
x = P a
x P a -> (a -> P b) -> P b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> P b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> P b) -> (a -> b) -> a -> P b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

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
    P a
m >>= :: P a -> (a -> P b) -> P b
>>= a -> P b
k = (PState -> Either SomeException (b, PState)) -> P b
forall a. (PState -> Either SomeException (a, PState)) -> P a
P ((PState -> Either SomeException (b, PState)) -> P b)
-> (PState -> Either SomeException (b, PState)) -> P b
forall a b. (a -> b) -> a -> b
$ \PState
s ->
        case P a -> PState -> Either SomeException (a, PState)
forall a. P a -> PState -> Either SomeException (a, PState)
runP P a
m PState
s of
          Left SomeException
e         -> SomeException -> Either SomeException (b, PState)
forall a b. a -> Either a b
Left SomeException
e
          Right (a
a, PState
s')  -> P b -> PState -> Either SomeException (b, PState)
forall a. P a -> PState -> Either SomeException (a, PState)
runP (a -> P b
k a
a) PState
s'

    P a
m1 >> :: P a -> P b -> P b
>> P b
m2 = (PState -> Either SomeException (b, PState)) -> P b
forall a. (PState -> Either SomeException (a, PState)) -> P a
P ((PState -> Either SomeException (b, PState)) -> P b)
-> (PState -> Either SomeException (b, PState)) -> P b
forall a b. (a -> b) -> a -> b
$ \PState
s ->
        case P a -> PState -> Either SomeException (a, PState)
forall a. P a -> PState -> Either SomeException (a, PState)
runP P a
m1 PState
s of
          Left SomeException
e         -> SomeException -> Either SomeException (b, PState)
forall a b. a -> Either a b
Left SomeException
e
          Right (a
_, PState
s')  -> P b -> PState -> Either SomeException (b, PState)
forall a. P a -> PState -> Either SomeException (a, PState)
runP P b
m2 PState
s'

    return :: a -> P a
return a
a = (PState -> Either SomeException (a, PState)) -> P a
forall a. (PState -> Either SomeException (a, PState)) -> P a
P ((PState -> Either SomeException (a, PState)) -> P a)
-> (PState -> Either SomeException (a, PState)) -> P a
forall a b. (a -> b) -> a -> b
$ \PState
s -> (a, PState) -> Either SomeException (a, PState)
forall a b. b -> Either a b
Right (a
a, PState
s)

#if MIN_VERSION_base(4,13,0)
instance MonadFail P where
#endif
    fail :: String -> P a
fail String
msg = do
        AlexInput
inp <- P AlexInput
getInput
        ParserException -> P a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw (ParserException -> P a) -> ParserException -> P a
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    = (PState -> Either SomeException (PState, PState)) -> P PState
forall a. (PState -> Either SomeException (a, PState)) -> P a
P ((PState -> Either SomeException (PState, PState)) -> P PState)
-> (PState -> Either SomeException (PState, PState)) -> P PState
forall a b. (a -> b) -> a -> b
$ \PState
s -> (PState, PState) -> Either SomeException (PState, PState)
forall a b. b -> Either a b
Right (PState
s, PState
s)
    put :: PState -> P ()
put PState
s  = (PState -> Either SomeException ((), PState)) -> P ()
forall a. (PState -> Either SomeException (a, PState)) -> P a
P ((PState -> Either SomeException ((), PState)) -> P ())
-> (PState -> Either SomeException ((), PState)) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
_ -> ((), PState) -> Either SomeException ((), PState)
forall a b. b -> Either a b
Right ((), PState
s)

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

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

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

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

setInput  :: AlexInput -> P ()
setInput :: AlexInput -> P ()
setInput AlexInput
inp = (PState -> PState) -> P ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
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 = (PState -> PState) -> P ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState
s { lexState :: [Int]
lexState = Int
ls Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: PState -> [Int]
lexState PState
s }

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

getLexState :: P Int
getLexState :: P Int
getLexState = (PState -> Int) -> P Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> (PState -> [Int]) -> PState -> Int
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 <- (PState -> Maybe (L Token)) -> P (Maybe (L Token))
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 -> (PState -> PState) -> P ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
s -> PState
s { pbToken :: Maybe (L Token)
pbToken = L Token -> Maybe (L Token)
forall a. a -> Maybe a
Just L Token
tok }
      Just L Token
_  -> String -> P ()
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 <- (PState -> Maybe (L Token)) -> P (Maybe (L Token))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PState -> Maybe (L Token)
pbToken
    (PState -> PState) -> P ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
s -> PState
s { pbToken :: Maybe (L Token)
pbToken = Maybe (L Token)
forall a. Maybe a
Nothing }
    Maybe (L Token) -> P (Maybe (L Token))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (L Token)
tok

getCurToken :: P (L Token)
getCurToken :: P (L Token)
getCurToken = (PState -> L Token) -> P (L Token)
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 = (PState -> PState) -> P ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
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 = (PState -> PState) -> P ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState
s { typedefs :: Set String
typedefs = String -> Set String -> Set String
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 = (PState -> PState) -> P ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState
s { classdefs :: Set String
classdefs = String -> Set String -> Set String
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 = (PState -> PState) -> P ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState
s { typedefs :: Set String
typedefs  = String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.delete String
ident (PState -> Set String
typedefs PState
s)
      , classdefs :: Set String
classdefs = String -> Set String -> Set String
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 = (PState -> Bool) -> P Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((PState -> Bool) -> P Bool) -> (PState -> Bool) -> P Bool
forall a b. (a -> b) -> a -> b
$ \PState
s ->
    String -> Set String -> Bool
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 = (PState -> Bool) -> P Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((PState -> Bool) -> P Bool) -> (PState -> Bool) -> P Bool
forall a b. (a -> b) -> a -> b
$ \PState
s ->
    String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member String
ident (PState -> Set String
classdefs PState
s)

pushScope :: P ()
pushScope :: P ()
pushScope = (PState -> PState) -> P ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify  ((PState -> PState) -> P ()) -> (PState -> PState) -> P ()
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) (Set String, Set String)
-> [(Set String, Set String)] -> [(Set String, Set String)]
forall a. a -> [a] -> [a]
: PState -> [(Set String, Set String)]
scopes PState
s }

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

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

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

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

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

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

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

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

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

useExts :: ExtensionsInt -> P Bool
useExts :: ExtensionsInt -> P Bool
useExts ExtensionsInt
ext = (PState -> Bool) -> P Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((PState -> Bool) -> P Bool) -> (PState -> Bool) -> P Bool
forall a b. (a -> b) -> a -> b
$ \PState
s ->
    PState -> ExtensionsInt
extensions PState
s ExtensionsInt -> ExtensionsInt -> ExtensionsInt
forall a. Bits a => a -> a -> a
.&. ExtensionsInt
ext ExtensionsInt -> ExtensionsInt -> Bool
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 (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Maybe Pos -> Doc
forall a. Pretty a => a -> Doc
ppr Maybe Pos
pos Doc -> Doc -> Doc
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 (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Loc -> Doc
forall a. Pretty a => a -> Doc
ppr Loc
loc Doc -> Doc -> Doc
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 :: Loc -> String -> P a
failAt Loc
loc String
msg =
    ParserException -> P a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw (ParserException -> P a) -> ParserException -> P a
forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ParserException
ParserException Loc
loc (String -> Doc
text String
msg)

lexerError :: AlexInput -> Doc -> P a
lexerError :: AlexInput -> Doc -> P a
lexerError AlexInput
inp Doc
s =
    LexerException -> P a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw (LexerException -> P a) -> LexerException -> P a
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 :: AlexInput -> P a
unexpectedEOF AlexInput
inp =
    AlexInput -> Doc -> P a
forall a. AlexInput -> Doc -> P a
lexerError AlexInput
inp (String -> Doc
text String
"unexpected end of file")

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

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

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

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

unclosed :: Loc -> String -> P a
unclosed :: Loc -> String -> P a
unclosed Loc
loc String
x =
    Loc -> Doc -> P a
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 :: [String] -> Maybe String -> P b
expected [String]
alts Maybe String
after = do
    L Token
tok <- P (L Token)
getCurToken
    L Token -> [String] -> Maybe String -> P b
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 :: L Token -> [String] -> Maybe String -> P b
expectedAt tok :: L Token
tok@(L Loc
loc Token
_) [String]
alts Maybe String
after = do
    Loc -> Doc -> P b
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 Doc -> Doc -> Doc
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 Doc -> Doc -> Doc
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 (Token -> Doc
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       -> Maybe (Char, AlexInput)
forall a. Maybe a
Nothing
      Just (Char
c, ByteString
bs)  -> (Char, AlexInput) -> Maybe (Char, AlexInput)
forall a. a -> Maybe a
Just (Char
c, AlexInput
inp  {  alexPos :: Maybe Pos
alexPos       = (Pos -> Pos) -> Maybe Pos -> Maybe Pos
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 Int -> Int -> Int
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        -> Maybe (Word8, AlexInput)
forall a. Maybe a
Nothing
      Just (Char
c, AlexInput
inp') -> (Word8, AlexInput) -> Maybe (Word8, AlexInput)
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         -> AlexInput -> P Char
forall a. AlexInput -> P a
unexpectedEOF AlexInput
inp
      Just (Char
c, AlexInput
inp')  -> AlexInput -> P ()
setInput AlexInput
inp' P () -> P Char -> P Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> P Char
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      -> AlexInput -> P Char
forall a. AlexInput -> P a
unexpectedEOF AlexInput
inp
      Just (Char
c, ByteString
_)  -> Char -> P Char
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      -> Maybe Char -> P (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
forall a. Maybe a
Nothing
      Just (Char
c, AlexInput
_)  -> Maybe Char -> P (Maybe Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Maybe Char
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         -> AlexInput -> P ()
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 ExtensionsInt -> ExtensionsInt -> ExtensionsInt
forall a. Bits a => a -> a -> a
.&. ExtensionsInt
i ExtensionsInt -> ExtensionsInt -> Bool
forall a. Eq a => a -> a -> Bool
/= ExtensionsInt
0