{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module GLua.Lexer where
import GLua.AG.Token (MToken (..), Token (..))
import Data.Char (ord)
import GLua.Position (LineColPos (..), Region (..))
import Text.Parsec (
ParseError,
SourcePos,
anyChar,
char,
digit,
endOfLine,
eof,
getPosition,
lookAhead,
many,
many1,
manyTill,
noneOf,
oneOf,
option,
optionMaybe,
parse,
satisfy,
sourceColumn,
sourceLine,
space,
string,
try,
(<?>),
(<|>),
)
import Text.Parsec.Pos (newPos)
import Text.Parsec.String (Parser)
rgStart2sp :: Region -> SourcePos
rgStart2sp :: Region -> SourcePos
rgStart2sp (Region LineColPos
start LineColPos
_) = LineColPos -> SourcePos
lcp2sp LineColPos
start
rgEnd2sp :: Region -> SourcePos
rgEnd2sp :: Region -> SourcePos
rgEnd2sp (Region LineColPos
_ LineColPos
end) = LineColPos -> SourcePos
lcp2sp LineColPos
end
sp2Rg :: SourcePos -> Region
sp2Rg :: SourcePos -> Region
sp2Rg SourcePos
sp = LineColPos -> LineColPos -> Region
Region (SourcePos -> LineColPos
sp2lcp SourcePos
sp) (SourcePos -> LineColPos
sp2lcp SourcePos
sp)
lcp2sp :: LineColPos -> SourcePos
lcp2sp :: LineColPos -> SourcePos
lcp2sp (LineColPos Int
l Int
c Int
_) = String -> Int -> Int -> SourcePos
newPos String
"source.lua" (Int
l forall a. Num a => a -> a -> a
+ Int
1) (Int
c forall a. Num a => a -> a -> a
+ Int
1)
sp2lcp :: SourcePos -> LineColPos
sp2lcp :: SourcePos -> LineColPos
sp2lcp SourcePos
pos = Int -> Int -> Int -> LineColPos
LineColPos (SourcePos -> Int
sourceLine SourcePos
pos forall a. Num a => a -> a -> a
- Int
1) (SourcePos -> Int
sourceColumn SourcePos
pos forall a. Num a => a -> a -> a
- Int
1) Int
0
pPos :: Parser LineColPos
pPos :: Parser LineColPos
pPos = SourcePos -> LineColPos
sp2lcp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
pIdentifierCharacter :: Parser Char
pIdentifierCharacter :: Parser Char
pIdentifierCharacter = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
validChar
where
validChar :: Char -> Bool
validChar :: Char -> Bool
validChar Char
c =
Char -> Char -> Char -> Bool
cBetween Char
c Char
'0' Char
'9'
Bool -> Bool -> Bool
|| Char -> Char -> Char -> Bool
cBetween Char
c Char
'A' Char
'Z'
Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
Bool -> Bool -> Bool
|| Char -> Char -> Char -> Bool
cBetween Char
c Char
'a' Char
'z'
Bool -> Bool -> Bool
|| Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
>= Int
128
pNonDigitIdentifierCharacter :: Parser Char
pNonDigitIdentifierCharacter :: Parser Char
pNonDigitIdentifierCharacter = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
validChar
where
validChar :: Char -> Bool
validChar :: Char -> Bool
validChar Char
c =
Char -> Char -> Char -> Bool
cBetween Char
c Char
'A' Char
'Z'
Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
Bool -> Bool -> Bool
|| Char -> Char -> Char -> Bool
cBetween Char
c Char
'a' Char
'z'
Bool -> Bool -> Bool
|| Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
>= Int
128
cBetween :: Char -> Char -> Char -> Bool
cBetween :: Char -> Char -> Char -> Bool
cBetween Char
c Char
left Char
right = Char
c forall a. Ord a => a -> a -> Bool
>= Char
left Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
right
pUntilEnd :: Parser String
pUntilEnd :: Parser String
pUntilEnd = forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a b. a -> b -> a
const Char
'\n' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof))
parseWhitespace :: Parser String
parseWhitespace :: Parser String
parseWhitespace = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"whitespace"
parseOptionalWhitespace :: Parser String
parseOptionalWhitespace :: Parser String
parseOptionalWhitespace = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"whitespace"
escapedStringChar :: Char -> Parser String
escapedStringChar :: Char -> Parser String
escapedStringChar Char
delim = (\String
escaped -> Char
'\\' forall a. a -> [a] -> [a]
: String
escaped) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
escapedChar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'\n', Char
delim]
where
escapedChar :: Parser String
escapedChar = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'z' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
parseOptionalWhitespace forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
startNestedString :: Parser String
startNestedString :: Parser String
startNestedString = do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
String
depth <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=')
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
forall (m :: * -> *) a. Monad m => a -> m a
return String
depth
nestedString :: String -> Parser String
nestedString :: String -> Parser String
nestedString String
depth = do
let
endStr :: String
endStr = String
"]" forall a. [a] -> [a] -> [a]
++ String
depth forall a. [a] -> [a] -> [a]
++ String
"]"
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
endStr)
parseLuaComment :: Parser Token
= do
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"--"
Maybe String
startNested <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser String
startNestedString)
case Maybe String
startNested of
Maybe String
Nothing -> String -> Token
DashComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
pUntilEnd
Just String
depth -> do
String
contents <- String -> Parser String
nestedString String
depth
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> String -> Token
DashBlockComment (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
depth) String
contents
parseCComment :: Parser Token
= do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Token
SlashComment forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
pUntilEnd)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> Token
SlashBlockComment forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"*/") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a b. a -> b -> a
const String
"\n" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
parseComment :: Parser Token
= Parser Token
parseLuaComment forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Token
parseCComment forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Comment"
nestedStringToMLString :: String -> String -> Token
nestedStringToMLString :: String -> String -> Token
nestedStringToMLString String
depth String
contents = String -> Token
MLString (Char -> String -> String
showChar Char
'[' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
depth forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
'[' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
contents forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
']' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
depth forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
']' forall a b. (a -> b) -> a -> b
$ String
"")
parseLineString :: Char -> Parser String
parseLineString :: Char -> Parser String
parseLineString Char
c = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> Parser String
escapedStringChar Char
c) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
parseString :: Parser Token
parseString :: Parser Token
parseString =
String -> Token
SQString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser String
parseLineString Char
'\''
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> Token
DQString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser String
parseLineString Char
'"'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
String
depth <- Parser String
startNestedString
String -> String -> Token
nestedStringToMLString String
depth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser String
nestedString String
depth forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"String"
parseNumber :: Parser Token
parseNumber :: Parser Token
parseNumber = String -> Token
TNumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser String
pHexadecimal forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
pBinary forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
pNumber) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser String
pLLULL forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" Parser String
parseNumberSuffix)) forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Number"
where
pNumber :: Parser String
pNumber :: Parser String
pNumber = forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" Parser String
pDecimal
pDecimal :: Parser String
pDecimal :: Parser String
pDecimal = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
pHexDecimal :: Parser String
pHexDecimal :: Parser String
pHexDecimal = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Char
pHex
pHexadecimal :: Parser String
pHexadecimal :: Parser String
pHexadecimal = forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0x") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0X")) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parser Char
pHex forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" Parser String
pHexDecimal)
pHex :: Parser Char
pHex :: Parser Char
pHex = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'a', Char
'b', Char
'c', Char
'd', Char
'e', Char
'f', Char
'A', Char
'B', Char
'C', Char
'D', Char
'E', Char
'F']
pBinary :: Parser String
pBinary :: Parser String
pBinary = forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0b") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0B")) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parser Char
pBin forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" Parser String
pDecimal)
pBin :: Parser Char
pBin :: Parser Char
pBin = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'0', Char
'1']
pLLULL :: Parser String
pLLULL :: Parser String
pLLULL = Parser String
pULL forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
pLL
pLL :: Parser String
pLL :: Parser String
pLL = String
"LL" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'L', Char
'l'] forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'L', Char
'l']
pULL :: Parser String
pULL :: Parser String
pULL = String
"ULL" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'U', Char
'u'] forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
pLL
parseNumberSuffix :: Parser String
parseNumberSuffix :: Parser String
parseNumberSuffix = forall {u}. ParsecT String u Identity String
imaginary forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall {u}. ParsecT String u Identity String
extension
where
imaginary :: ParsecT String u Identity String
imaginary = (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'i', Char
'I']
extension :: ParsecT String u Identity String
extension =
(\Char
e String
s String
d -> Char
e forall a. a -> [a] -> [a]
: String
s forall a. [a] -> [a] -> [a]
++ String
d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'e', Char
'E', Char
'p', Char
'P']
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"+" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"-")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
parseKeyword :: Token -> String -> Parser Token
parseKeyword :: Token -> String -> Parser Token
parseKeyword Token
tok String
str =
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
( do
String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
str
(\String
s -> String -> Token
Identifier (String
str forall a. [a] -> [a] -> [a]
++ String
s)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Parser Char
pIdentifierCharacter)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Token
tok
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Keyword "
forall a. [a] -> [a] -> [a]
++ String
str
)
parseIdentifier :: Parser String
parseIdentifier :: Parser String
parseIdentifier = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
pNonDigitIdentifierCharacter forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Char
pIdentifierCharacter forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Identifier"
parseLabel :: Parser Token
parseLabel :: Parser Token
parseLabel =
String -> String -> String -> Token
Label
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"::"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
parseOptionalWhitespace
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
parseIdentifier
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
parseOptionalWhitespace
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"::"
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Label"
parseDots :: Parser Token
parseDots :: Parser Token
parseDots = do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
( do
Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Token
VarArg forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.')
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Token
Concatenate
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
( do
String
nums <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
String
suffix <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" Parser String
parseNumberSuffix
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Token
TNumber (Char
'.' forall a. a -> [a] -> [a]
: (String
nums forall a. [a] -> [a] -> [a]
++ String
suffix))
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Token
Dot
parseToken :: Parser Token
parseToken :: Parser Token
parseToken =
String -> Token
Whitespace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
parseWhitespace
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Token
parseString
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Token
parseNumber
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
TTrue String
"true"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
TFalse String
"false"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Nil String
"nil"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Not String
"not"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
And String
"and"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Or String
"or"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Function String
"function"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Local String
"local"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
If String
"if"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Then String
"then"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Elseif String
"elseif"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Else String
"else"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
For String
"for"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
In String
"in"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Do String
"do"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
While String
"while"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Until String
"until"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Repeat String
"repeat"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Continue String
"continue"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Break String
"break"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
Return String
"return"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> String -> Parser Token
parseKeyword Token
End String
"end"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> Token
Identifier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
parseIdentifier
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
Semicolon forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Token
parseDots
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Token
parseComment
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
Token
Plus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"+"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
Minus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"-"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
Multiply forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"*"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
Divide forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
Modulus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
Power forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"^"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
TEq forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"==")
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
Equals forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"="
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
TNEq forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"~="
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
TCNEq forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"!=")
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
CNot forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"!"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
TLEQ forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<=")
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
TLT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
TGEQ forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
">=")
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
TGT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
">"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Token
parseLabel
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
Colon forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
":"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
Comma forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
","
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
Hash forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"#"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
CAnd forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"&&"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
COr forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"||"
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
LRound forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
RRound forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
LCurly forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
RCurly forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
LSquare forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token
RSquare forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
annotated :: (Region -> a -> b) -> Parser a -> Parser b
annotated :: forall a b. (Region -> a -> b) -> Parser a -> Parser b
annotated Region -> a -> b
f Parser a
p = (\LineColPos
s a
t LineColPos
e -> Region -> a -> b
f (LineColPos -> LineColPos -> Region
Region LineColPos
s LineColPos
e) a
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LineColPos
pPos forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LineColPos
pPos
parseMToken :: Parser MToken
parseMToken :: Parser MToken
parseMToken =
do
LineColPos
start <- Parser LineColPos
pPos
Token
tok <- Parser Token
parseToken
LineColPos
end <- Parser LineColPos
pPos
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Region -> Token -> MToken
MToken (LineColPos -> LineColPos -> Region
Region LineColPos
start LineColPos
end) Token
tok
parseTokens :: Parser [MToken]
parseTokens :: Parser [MToken]
parseTokens = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser MToken
parseMToken
parseHashBang :: Parser String
parseHashBang :: Parser String
parseHashBang = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
pUntilEnd)
execParseTokens :: String -> Either ParseError [MToken]
execParseTokens :: String -> Either ParseError [MToken]
execParseTokens = forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parser String
parseHashBang forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [MToken]
parseTokens forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) String
"input"