{-# 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 = 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 b a. (b -> a -> b) -> b -> [a] -> b
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
{ 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 = (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
mx PState
s of
Left SomeException
e -> SomeException -> Either SomeException (b, PState)
forall a b. a -> Either a b
Left SomeException
e
Right (a
x, PState
s') -> (b, PState) -> Either SomeException (b, PState)
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 = (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
x, PState
s)
P (a -> b)
mf <*> :: forall a b. P (a -> b) -> P a -> P b
<*> P a
mx = (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 -> b) -> PState -> Either SomeException (a -> b, PState)
forall a. P a -> PState -> Either SomeException (a, PState)
runP P (a -> b)
mf PState
s of
Left SomeException
e -> SomeException -> Either SomeException (b, PState)
forall a b. a -> Either a b
Left SomeException
e
Right (a -> b
f, PState
s') -> P b -> PState -> Either SomeException (b, PState)
forall a. P a -> PState -> Either SomeException (a, PState)
runP ((a -> b) -> P a -> P b
forall a b. (a -> b) -> P a -> P b
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 = (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'
return :: forall a. a -> P a
return = a -> P a
forall a. a -> P a
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
ParserException -> P a
forall e a. Exception e => e -> 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 :: forall e a. Exception e => 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 :: forall e a. Exception e => 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 :: forall a. 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 = 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 = ls : lexState 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 = tail (lexState s) }
Int -> P Int
forall a. a -> P a
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. HasCallStack => [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 = Just tok }
Just L Token
_ -> String -> P ()
forall a. String -> P a
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 = Nothing }
Maybe (L Token) -> P (Maybe (L Token))
forall a. a -> P a
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 = 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.insert ident (typedefs 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.insert ident (classdefs 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.delete ident (typedefs s)
, classdefs = Set.delete ident (classdefs 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 = (typedefs s, classdefs s) : scopes 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 = (tail . scopes) s
, typedefs = (fst . head . scopes) s
, classdefs = (snd . head . scopes) 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 :: forall a. Loc -> String -> P a
failAt Loc
loc String
msg =
ParserException -> P a
forall e a. Exception e => e -> 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 :: forall a. AlexInput -> Doc -> P a
lexerError AlexInput
inp Doc
s =
LexerException -> P a
forall e a. Exception e => e -> 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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. Loc -> Doc -> P a
parserError Loc
loc Doc
msg =
ParserException -> P a
forall e a. Exception e => e -> 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 :: forall a. 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 :: forall b. [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 :: forall b. 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 = fmap (\Pos
pos -> Pos -> Char -> Pos
advancePos Pos
pos Char
c) (alexPos inp)
, alexPrevChar = c
, alexInput = bs
, alexOff = alexOff inp + 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 a b. P a -> P b -> P b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> P Char
forall a. a -> P a
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 a. a -> P a
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 a. a -> P a
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 a. a -> P a
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'
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