{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module GLua.Parser where

import GLua.AG.AST (
  AReturn (..),
  AST (..),
  Args (..),
  BinOp (..),
  Block (..),
  Expr (..),
  Field (..),
  FieldSep (..),
  FuncName (..),
  MElse (MElse),
  MElseIf (MElseIf),
  MExpr (..),
  MStat (..),
  PFExprSuffix (..),
  PrefixExp (..),
  Stat (..),
  UnOp (..),
 )
import GLua.AG.Token (
  MToken (..),
  Token (..),
 )
import qualified GLua.Lexer as Lex
import GLua.TokenTypes (
  isWhitespace,
  mpos,
  splitComments,
  tokenSize,
 )

import GLua.Position (LineColPos (..), Region (..))
import Text.Parsec (
  ParseError,
  Parsec,
  SourceName,
  SourcePos,
  anyToken,
  between,
  chainl1,
  choice,
  eof,
  getPosition,
  getState,
  incSourceColumn,
  lookAhead,
  many,
  many1,
  option,
  optionMaybe,
  putState,
  runParser,
  sepBy1,
  sourceColumn,
  sourceLine,
  tokenPrim,
  try,
  (<?>),
  (<|>),
 )
import Text.Parsec.Pos (newPos)

type AParser = Parsec [MToken] LineColPos

-- | Execute a parser
execAParser :: SourceName -> AParser a -> [MToken] -> Either ParseError a
execAParser :: forall a.
SourceName -> AParser a -> [MToken] -> Either ParseError a
execAParser SourceName
name AParser a
p = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> SourceName -> s -> Either ParseError a
runParser AParser a
p (Int -> Int -> Int -> LineColPos
LineColPos Int
0 Int
0 Int
0) SourceName
name

-- | Parse Garry's mod Lua tokens to an abstract syntax tree.
-- Also returns parse errors
parseGLua :: [MToken] -> Either ParseError AST
parseGLua :: [MToken] -> Either ParseError AST
parseGLua [MToken]
mts =
  let
    ([MToken]
cms, [MToken]
ts) = [MToken] -> ([MToken], [MToken])
splitComments forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. MToken -> Bool
isWhitespace) forall a b. (a -> b) -> a -> b
$ [MToken]
mts
  in
    forall a.
SourceName -> AParser a -> [MToken] -> Either ParseError a
execAParser SourceName
"source.lua" ([MToken] -> AParser AST
parseChunk [MToken]
cms) [MToken]
ts

parseGLuaFromString :: String -> Either ParseError AST
parseGLuaFromString :: SourceName -> Either ParseError AST
parseGLuaFromString SourceName
contents =
  case SourceName -> Either ParseError [MToken]
Lex.execParseTokens SourceName
contents of
    Left ParseError
parseErrors -> forall a b. a -> Either a b
Left ParseError
parseErrors
    Right [MToken]
lexicon -> [MToken] -> Either ParseError AST
parseGLua forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. MToken -> Bool
isWhitespace) [MToken]
lexicon

-- | Region start to SourcePos
rgStart2sp :: Region -> SourcePos
rgStart2sp :: Region -> SourcePos
rgStart2sp (Region LineColPos
start LineColPos
_) = LineColPos -> SourcePos
lcp2sp LineColPos
start

-- | Region end to SourcePos
rgEnd2sp :: Region -> SourcePos
rgEnd2sp :: Region -> SourcePos
rgEnd2sp (Region LineColPos
_ LineColPos
end) = LineColPos -> SourcePos
lcp2sp LineColPos
end

-- | SourcePos to region
sp2Rg :: SourcePos -> Region
sp2Rg :: SourcePos -> Region
sp2Rg SourcePos
sp = LineColPos -> LineColPos -> Region
Region (SourcePos -> LineColPos
sp2lcp SourcePos
sp) (SourcePos -> LineColPos
sp2lcp SourcePos
sp)

-- | LineColPos to SourcePos
lcp2sp :: LineColPos -> SourcePos
lcp2sp :: LineColPos -> SourcePos
lcp2sp (LineColPos Int
l Int
c Int
_) = SourceName -> Int -> Int -> SourcePos
newPos SourceName
"source.lua" (Int
l forall a. Num a => a -> a -> a
+ Int
1) (Int
c forall a. Num a => a -> a -> a
+ Int
1)

-- | SourcePos to LineColPos
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

-- | Update a SourcePos with an MToken
updatePosMToken :: SourcePos -> MToken -> [MToken] -> SourcePos
updatePosMToken :: SourcePos -> MToken -> [MToken] -> SourcePos
updatePosMToken SourcePos
_ (MToken Region
p Token
tok) [] = SourcePos -> Int -> SourcePos
incSourceColumn (Region -> SourcePos
rgStart2sp Region
p) (Token -> Int
tokenSize Token
tok)
updatePosMToken SourcePos
_ MToken
_ (MToken Region
p Token
_ : [MToken]
_) = Region -> SourcePos
rgStart2sp Region
p

-- | Match a token
pMTok :: Token -> AParser MToken
pMTok :: Token -> AParser MToken
pMTok Token
tok =
  do
    let
      testMToken :: MToken -> Maybe MToken
      testMToken :: MToken -> Maybe MToken
testMToken mt :: MToken
mt@(MToken Region
_ Token
t) = if Token
t forall a. Eq a => a -> a -> Bool
== Token
tok then forall a. a -> Maybe a
Just MToken
mt else forall a. Maybe a
Nothing

    mt :: MToken
mt@(MToken Region
pos Token
_) <- forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> SourceName)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim forall a. Show a => a -> SourceName
show SourcePos -> MToken -> [MToken] -> SourcePos
updatePosMToken MToken -> Maybe MToken
testMToken

    forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState (Region -> LineColPos
rgEnd Region
pos)

    forall (m :: * -> *) a. Monad m => a -> m a
return MToken
mt

-- Tokens that satisfy a condition
pMSatisfy :: (MToken -> Bool) -> AParser MToken
pMSatisfy :: (MToken -> Bool) -> AParser MToken
pMSatisfy MToken -> Bool
cond =
  do
    let
      testMToken :: MToken -> Maybe MToken
      testMToken :: MToken -> Maybe MToken
testMToken MToken
mt = if MToken -> Bool
cond MToken
mt then forall a. a -> Maybe a
Just MToken
mt else forall a. Maybe a
Nothing

    forall a. (MToken -> Maybe a) -> AParser a
pMToken MToken -> Maybe MToken
testMToken

pMToken :: forall a. (MToken -> Maybe a) -> AParser a
pMToken :: forall a. (MToken -> Maybe a) -> AParser a
pMToken MToken -> Maybe a
cond =
  let
    testMToken :: MToken -> Maybe (MToken, a)
    testMToken :: MToken -> Maybe (MToken, a)
testMToken MToken
mt = (MToken
mt,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MToken -> Maybe a
cond MToken
mt
  in
    do
      (MToken Region
pos Token
_, a
res) <- forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> SourceName)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim forall a. Show a => a -> SourceName
show SourcePos -> MToken -> [MToken] -> SourcePos
updatePosMToken MToken -> Maybe (MToken, a)
testMToken

      forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState (Region -> LineColPos
rgEnd Region
pos)

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

-- | Get the source position.
-- Simply gets the start position of the next token.
-- Falls back on the collected position when there is no token left.
pPos :: AParser LineColPos
pPos :: AParser LineColPos
pPos = Region -> LineColPos
rgStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. MToken -> Region
mpos 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
lookAhead forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 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

-- | Get the source position
-- Simply gets the end position of the last parsed token
pEndPos :: AParser LineColPos
pEndPos :: AParser LineColPos
pEndPos = forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

-- | A thing of which the region is to be parsed
annotated :: (Region -> a -> b) -> AParser a -> AParser b
annotated :: forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> a -> b
f AParser 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
<$> AParser LineColPos
pPos forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser LineColPos
pEndPos

-- | Parses the full AST
-- Its first parameter contains all comments
-- Assumes the mtokens fed to the AParser have no comments
parseChunk :: [MToken] -> AParser AST
parseChunk :: [MToken] -> AParser AST
parseChunk [MToken]
cms = [MToken] -> Block -> AST
AST [MToken]
cms forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Block
parseBlock 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

-- | Parse a block with an optional return value
parseBlock :: AParser Block
parseBlock :: AParser Block
parseBlock = do
  -- using 'pEndPos' here, to make sure the region starts right at the end of the last token. This
  -- is to make sure it captures the whitespace too.
  LineColPos
start <- AParser LineColPos
pEndPos
  [MStat]
mStats <- forall a b. AParser a -> AParser b -> AParser [b]
pInterleaved (Token -> AParser MToken
pMTok Token
Semicolon) AParser MStat
parseMStat
  AReturn
returnStatement <- ParsecT [MToken] LineColPos Identity AReturn
parseReturn 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 AReturn
NoReturn
  -- Using 'pPos' here, to make sure the region also includes the whitespace
  LineColPos
end <- AParser LineColPos
pPos
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Region -> [MStat] -> AReturn -> Block
Block (LineColPos -> LineColPos -> Region
Region LineColPos
start LineColPos
end) [MStat]
mStats AReturn
returnStatement

parseMStat :: AParser MStat
parseMStat :: AParser MStat
parseMStat = forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> Stat -> MStat
MStat AParser Stat
parseStat

-- | Parser that is interleaved with 0 or more of the other parser
pInterleaved :: AParser a -> AParser b -> AParser [b]
pInterleaved :: forall a b. AParser a -> AParser b -> AParser [b]
pInterleaved AParser a
sep AParser b
q = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many AParser a
sep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (AParser b
q forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many AParser a
sep)

-- | Parse a return value
parseReturn :: AParser AReturn
parseReturn :: ParsecT [MToken] LineColPos Identity AReturn
parseReturn = forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> MExprList -> AReturn
AReturn (Token -> AParser MToken
pMTok Token
Return forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Token -> AParser MToken
pMTok Token
Semicolon) forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"return statement")

-- | Label
parseLabel :: AParser MToken
parseLabel :: AParser MToken
parseLabel = (MToken -> Bool) -> AParser MToken
pMSatisfy MToken -> Bool
isLabel forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"label"
  where
    isLabel :: MToken -> Bool
    isLabel :: MToken -> Bool
isLabel (MToken Region
_ (Label{})) = Bool
True
    isLabel MToken
_ = Bool
False

-- | Parse a single statement
parseStat :: AParser Stat
parseStat :: AParser Stat
parseStat =
  MToken -> Stat
ALabel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
parseLabel
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Stat
ABreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Break
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Stat
AContinue forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Continue
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Block -> Stat
ADo forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Do forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
End
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MExpr -> Block -> Stat
AWhile forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
While forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Do forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
End
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Block -> MExpr -> Stat
ARepeat forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Repeat forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Until forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser Stat
parseIf
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser Stat
parseFunction
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser Stat
parseFor
    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 (MToken -> Stat
AGoto forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok (SourceName -> Token
Identifier SourceName
"goto") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MToken
pName)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser Stat
parseDefinition
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PrefixExp -> Stat
AFuncCall forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser PrefixExp
pFunctionCall
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Token -> AParser MToken
pMTok Token
Local
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( AParser Stat
parseLocalDefinition
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser Stat
parseLocalFunction
         )

-- | Global definition
-- Note: Uses try to avoid conflicts with function calls
parseDefinition :: AParser Stat
parseDefinition :: AParser Stat
parseDefinition = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
(<?>) SourceName
"variable definition" forall a b. (a -> b) -> a -> b
$ do
  [PrefixExp]
vars <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
    [PrefixExp]
vs <- ParsecT [MToken] LineColPos Identity [PrefixExp]
parseVarList
    MToken
_ <- Token -> AParser MToken
pMTok Token
Equals
    forall (m :: * -> *) a. Monad m => a -> m a
return [PrefixExp]
vs

  MExprList
exprs <- ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ VarsList -> Stat
Def (forall a b. [a] -> [b] -> [(a, b)]
zip [PrefixExp]
vars (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just MExprList
exprs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat forall a. Maybe a
Nothing))

-- | Local definition
parseLocalDefinition :: AParser Stat
parseLocalDefinition :: AParser Stat
parseLocalDefinition = [PrefixExp] -> MExprList -> Stat
def forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [MToken] LineColPos Identity [PrefixExp]
parseLocalVarList 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 [] (Token -> AParser MToken
pMTok Token
Equals forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList) forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"variable declaration"
  where
    def :: [PrefixExp] -> [MExpr] -> Stat
    def :: [PrefixExp] -> MExprList -> Stat
def [PrefixExp]
ps MExprList
exs = VarsList -> Stat
LocDef forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [PrefixExp]
ps (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just MExprList
exs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat forall a. Maybe a
Nothing)

-- | Global function definition
parseFunction :: AParser Stat
parseFunction :: AParser Stat
parseFunction =
  FuncName -> [MToken] -> Block -> Stat
AFunc
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Function
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser FuncName
parseFuncName
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Token -> AParser MToken
pMTok Token
LRound) (Token -> AParser MToken
pMTok Token
RRound) AParser [MToken]
parseParList
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
End
    forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function definition"

-- | Local function definition
parseLocalFunction :: AParser Stat
parseLocalFunction :: AParser Stat
parseLocalFunction =
  FuncName -> [MToken] -> Block -> Stat
ALocFunc
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Function
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser FuncName
parseLocFuncName
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Token -> AParser MToken
pMTok Token
LRound) (Token -> AParser MToken
pMTok Token
RRound) AParser [MToken]
parseParList
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
End
    forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"local function definition"

-- | Parse if then elseif then else end expressions
parseIf :: AParser Stat
parseIf :: AParser Stat
parseIf =
  MExpr -> Block -> ElseIfList -> Else -> Stat
AIf
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
If
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Then
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    -- elseif
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> ElseIf -> MElseIf
MElseIf forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Elseif forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Then forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    -- else
    forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> Block -> MElse
MElse forall a b. (a -> b) -> a -> b
$ Token -> AParser MToken
pMTok Token
Else forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AParser Block
parseBlock)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
End
    forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"if statement"

parseFor :: AParser Stat
parseFor :: AParser Stat
parseFor = AParser Stat
parseNFor forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser Stat
parseGFor

-- | Parse numeric for loop
parseNFor :: AParser Stat
parseNFor :: AParser Stat
parseNFor = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
(<?>) SourceName
"numeric for loop" forall a b. (a -> b) -> a -> b
$
  do
    MToken
name <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
      MToken
_ <- Token -> AParser MToken
pMTok Token
For
      MToken
name <- AParser MToken
pName
      MToken
_ <- Token -> AParser MToken
pMTok Token
Equals
      forall (m :: * -> *) a. Monad m => a -> m a
return MToken
name

    MExpr
start <- AParser MExpr
parseExpression
    MToken
_ <- Token -> AParser MToken
pMTok Token
Comma
    MExpr
to <- AParser MExpr
parseExpression
    MExpr
st <- AParser MExpr
step
    MToken
_ <- Token -> AParser MToken
pMTok Token
Do
    Block
blk <- AParser Block
parseBlock
    MToken
_ <- Token -> AParser MToken
pMTok Token
End

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MToken -> MExpr -> MExpr -> MExpr -> Block -> Stat
ANFor MToken
name MExpr
start MExpr
to MExpr
st Block
blk
  where
    step :: AParser MExpr
    step :: AParser MExpr
step = Token -> AParser MToken
pMTok Token
Comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AParser MExpr
parseExpression forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> Expr -> MExpr
MExpr (forall (m :: * -> *) a. Monad m => a -> m a
return (SourceName -> Expr
ANumber SourceName
"1"))

-- | Generic for loop
parseGFor :: AParser Stat
parseGFor :: AParser Stat
parseGFor = [MToken] -> MExprList -> Block -> Stat
AGFor forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
For forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser [MToken]
parseNameList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
In forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Do forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
End forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"generic for loop"

-- | Function name (includes dot indices and meta indices)
parseFuncName :: AParser FuncName
parseFuncName :: AParser FuncName
parseFuncName =
  (\MToken
a [MToken]
b Maybe MToken
c -> [MToken] -> Maybe MToken -> FuncName
FuncName (MToken
a forall a. a -> [a] -> [a]
: [MToken]
b) Maybe MToken
c)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName
    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 (Token -> AParser MToken
pMTok Token
Dot forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AParser MToken
pName)
    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 forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Colon forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MToken
pName)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function name"

-- | Local function name: cannot be a meta function nor indexed
parseLocFuncName :: AParser FuncName
parseLocFuncName :: AParser FuncName
parseLocFuncName = (\MToken
name -> [MToken] -> Maybe MToken -> FuncName
FuncName [MToken
name] forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function name"

-- | Parse a number into an expression
parseNumber :: AParser Expr
parseNumber :: AParser Expr
parseNumber = forall a. (MToken -> Maybe a) -> AParser a
pMToken MToken -> Maybe Expr
isNumber forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"number"
  where
    isNumber :: MToken -> Maybe Expr
    isNumber :: MToken -> Maybe Expr
isNumber = \case
      MToken Region
_ (TNumber SourceName
str) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SourceName -> Expr
ANumber SourceName
str
      MToken
_ -> forall a. Maybe a
Nothing

-- | Parse any kind of string
parseString :: AParser MToken
parseString :: AParser MToken
parseString = (MToken -> Bool) -> AParser MToken
pMSatisfy MToken -> Bool
isString forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"string"
  where
    isString :: MToken -> Bool
    isString :: MToken -> Bool
isString (MToken Region
_ (DQString SourceName
_)) = Bool
True
    isString (MToken Region
_ (SQString SourceName
_)) = Bool
True
    isString (MToken Region
_ (MLString SourceName
_)) = Bool
True
    isString MToken
_ = Bool
False

-- | Parse an identifier
pName :: AParser MToken
pName :: AParser MToken
pName = (MToken -> Bool) -> AParser MToken
pMSatisfy MToken -> Bool
isName forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"identifier"
  where
    isName :: MToken -> Bool
    isName :: MToken -> Bool
isName (MToken Region
_ (Identifier SourceName
_)) = Bool
True
    isName MToken
_ = Bool
False

-- | Parse a list of identifiers
parseNameList :: AParser [MToken]
parseNameList :: AParser [MToken]
parseNameList = forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 AParser MToken
pName (Token -> AParser MToken
pMTok Token
Comma)

-- | Parse variable list (var1, var2, var3)
parseVarList :: AParser [PrefixExp]
parseVarList :: ParsecT [MToken] LineColPos Identity [PrefixExp]
parseVarList = forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 AParser PrefixExp
parseVar (Token -> AParser MToken
pMTok Token
Comma)

-- | Parse local variable list (var1, var2, var3)
parseLocalVarList :: AParser [PrefixExp]
parseLocalVarList :: ParsecT [MToken] LineColPos Identity [PrefixExp]
parseLocalVarList = forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 (MToken -> ExprSuffixList -> PrefixExp
PFVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (Token -> AParser MToken
pMTok Token
Comma)

-- | Parse list of function parameters
parseParList :: AParser [MToken]
parseParList :: AParser [MToken]
parseParList = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ AParser [MToken]
nameParam forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser [MToken]
vararg
  where
    vararg :: AParser [MToken]
vararg = (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> AParser MToken
pMTok Token
VarArg forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"..."
    nameParam :: AParser [MToken]
nameParam = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser [MToken]
moreParams forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"parameter"
    moreParams :: AParser [MToken]
moreParams = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ Token -> AParser MToken
pMTok Token
Comma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AParser [MToken]
nameParam forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser [MToken]
vararg)

-- | list of expressions
parseExpressionList :: AParser [MExpr]
parseExpressionList :: ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList = forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 AParser MExpr
parseExpression (Token -> AParser MToken
pMTok Token
Comma)

-- | Subexpressions, i.e. without operators
parseSubExpression :: AParser Expr
parseSubExpression :: AParser Expr
parseSubExpression =
  Expr
ANil
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Nil
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Expr
AFalse
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TFalse
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Expr
ATrue
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TTrue
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser Expr
parseNumber
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MToken -> Expr
AString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
parseString
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Expr
AVarArg
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
VarArg
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser Expr
parseAnonymFunc
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> PrefixExp -> Expr
APrefixExpr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser PrefixExp
parsePrefixExp
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> FieldList -> Expr
ATableConstructor
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser FieldList
parseTableConstructor
    forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"expression"

-- | Separate parser for anonymous function subexpression
parseAnonymFunc :: AParser Expr
parseAnonymFunc :: AParser Expr
parseAnonymFunc =
  [MToken] -> Block -> Expr
AnonymousFunc
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Function
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
LRound
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser [MToken]
parseParList
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RRound
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Block
parseBlock
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
End
    forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"anonymous function"

-- | Parse operators of the same precedence in a chain
samePrioL :: [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL :: [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL [(Token, BinOp)]
ops AParser MExpr
pr = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 AParser MExpr
pr (forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (forall a b. (a -> b) -> [a] -> [b]
map (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f [(Token, BinOp)]
ops))
  where
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f (Token
t, BinOp
at) = forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated (\Region
p MToken
_ MExpr
e1 MExpr
e2 -> Region -> Expr -> MExpr
MExpr Region
p (BinOp -> MExpr -> MExpr -> Expr
BinOpExpr BinOp
at MExpr
e1 MExpr
e2)) (Token -> AParser MToken
pMTok Token
t)

samePrioR :: [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioR :: [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioR [(Token, BinOp)]
ops AParser MExpr
pr = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 AParser MExpr
pr (forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (forall a b. (a -> b) -> [a] -> [b]
map (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f [(Token, BinOp)]
ops))
  where
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
    f :: (Token, BinOp) -> AParser (MExpr -> MExpr -> MExpr)
f (Token
t, BinOp
at) = forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated (\Region
p MToken
_ MExpr
e1 MExpr
e2 -> Region -> Expr -> MExpr
MExpr Region
p (BinOp -> MExpr -> MExpr -> Expr
BinOpExpr BinOp
at MExpr
e1 MExpr
e2)) (Token -> AParser MToken
pMTok Token
t)

-- | Parse unary operator (-, not, #)
parseUnOp :: AParser UnOp
parseUnOp :: AParser UnOp
parseUnOp =
  UnOp
UnMinus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Minus
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> UnOp
ANot forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Not
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> UnOp
ANot forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
CNot
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> UnOp
AHash forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Hash

-- | Parses a binary operator
parseBinOp :: AParser BinOp
parseBinOp :: AParser BinOp
parseBinOp =
  BinOp
AOr forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Or
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
AOr forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
COr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
AAnd forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
And
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
AAnd forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
CAnd
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
ALT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TLT
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
AGT forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TGT
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
ALEQ forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TLEQ
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
AGEQ forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TGEQ
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
ANEq forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TNEq
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
ANEq forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TCNEq
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
AEq forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
TEq
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
AConcatenate forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Concatenate
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
APlus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Plus
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
BinMinus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Minus
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
AMultiply forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Multiply
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
ADivide forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Divide
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
AModulus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Modulus
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BinOp
APower forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Power

-- | Operators, sorted by priority
-- Priority from: http://www.lua.org/manual/5.2/manual.html#3.4.7
lvl1, lvl2, lvl3, lvl4, lvl5, lvl6, lvl8 :: [(Token, BinOp)]
lvl1 :: [(Token, BinOp)]
lvl1 = [(Token
Or, BinOp
AOr), (Token
COr, BinOp
AOr)]
lvl2 :: [(Token, BinOp)]
lvl2 = [(Token
And, BinOp
AAnd), (Token
CAnd, BinOp
AAnd)]
lvl3 :: [(Token, BinOp)]
lvl3 = [(Token
TLT, BinOp
ALT), (Token
TGT, BinOp
AGT), (Token
TLEQ, BinOp
ALEQ), (Token
TGEQ, BinOp
AGEQ), (Token
TNEq, BinOp
ANEq), (Token
TCNEq, BinOp
ANEq), (Token
TEq, BinOp
AEq)]
lvl4 :: [(Token, BinOp)]
lvl4 = [(Token
Concatenate, BinOp
AConcatenate)]
lvl5 :: [(Token, BinOp)]
lvl5 = [(Token
Plus, BinOp
APlus), (Token
Minus, BinOp
BinMinus)]
lvl6 :: [(Token, BinOp)]
lvl6 = [(Token
Multiply, BinOp
AMultiply), (Token
Divide, BinOp
ADivide), (Token
Modulus, BinOp
AModulus)]
-- lvl7 is unary operators
lvl8 :: [(Token, BinOp)]
lvl8 = [(Token
Power, BinOp
APower)]

-- | Parse chains of binary and unary operators
parseExpression :: AParser MExpr
parseExpression :: AParser MExpr
parseExpression =
  [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL
    [(Token, BinOp)]
lvl1
    ( [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL [(Token, BinOp)]
lvl2 forall a b. (a -> b) -> a -> b
$
        [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL [(Token, BinOp)]
lvl3 forall a b. (a -> b) -> a -> b
$
          [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioR [(Token, BinOp)]
lvl4 forall a b. (a -> b) -> a -> b
$
            [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL [(Token, BinOp)]
lvl5 forall a b. (a -> b) -> a -> b
$
              [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioL [(Token, BinOp)]
lvl6 forall a b. (a -> b) -> a -> b
$
                forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> Expr -> MExpr
MExpr (UnOp -> MExpr -> Expr
UnOpExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser UnOp
parseUnOp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression)
                  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [(Token, BinOp)] -> AParser MExpr -> AParser MExpr
samePrioR [(Token, BinOp)]
lvl8 (forall a b. (Region -> a -> b) -> AParser a -> AParser b
annotated Region -> Expr -> MExpr
MExpr (AParser Expr
parseSubExpression forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> UnOp -> MExpr -> Expr
UnOpExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser UnOp
parseUnOp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression)) -- lvl7
    )
    forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"expression"

-- | Prefix expressions
-- can have any arbitrary list of expression suffixes
parsePrefixExp :: AParser PrefixExp
parsePrefixExp :: AParser PrefixExp
parsePrefixExp = AParser ExprSuffixList -> AParser PrefixExp
pPrefixExp (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many AParser PFExprSuffix
pPFExprSuffix)

-- | Prefix expressions
-- The suffixes define rules on the allowed suffixes
pPrefixExp :: AParser [PFExprSuffix] -> AParser PrefixExp
pPrefixExp :: AParser ExprSuffixList -> AParser PrefixExp
pPrefixExp AParser ExprSuffixList
suffixes =
  MToken -> ExprSuffixList -> PrefixExp
PFVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
pName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser ExprSuffixList
suffixes
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MExpr -> ExprSuffixList -> PrefixExp
ExprVar forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
LRound forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RRound forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser ExprSuffixList
suffixes

-- | Parse any expression suffix
pPFExprSuffix :: AParser PFExprSuffix
pPFExprSuffix :: AParser PFExprSuffix
pPFExprSuffix = AParser PFExprSuffix
pPFExprCallSuffix forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser PFExprSuffix
pPFExprIndexSuffix

-- | Parse an indexing expression suffix
pPFExprCallSuffix :: AParser PFExprSuffix
pPFExprCallSuffix :: AParser PFExprSuffix
pPFExprCallSuffix =
  Args -> PFExprSuffix
Call
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser Args
parseArgs
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MToken -> Args -> PFExprSuffix
MetaCall
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Colon
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MToken
pName
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser Args
parseArgs
    forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function call"

-- | Parse an indexing expression suffix
pPFExprIndexSuffix :: AParser PFExprSuffix
pPFExprIndexSuffix :: AParser PFExprSuffix
pPFExprIndexSuffix =
  MExpr -> PFExprSuffix
ExprIndex
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
LSquare
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RSquare
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MToken -> PFExprSuffix
DotIndex
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Dot
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MToken
pName
    forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"indexation"

-- | Function calls are prefix expressions, but the last suffix MUST be either a function call or a metafunction call
pFunctionCall :: AParser PrefixExp
pFunctionCall :: AParser PrefixExp
pFunctionCall = AParser ExprSuffixList -> AParser PrefixExp
pPrefixExp AParser ExprSuffixList
suffixes forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function call"
  where
    suffixes :: AParser ExprSuffixList
suffixes =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        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
          ( (\ExprSuffixList
ix PFExprSuffix
c -> ExprSuffixList
ix forall a. [a] -> [a] -> [a]
++ [PFExprSuffix
c]) 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 AParser PFExprSuffix
pPFExprIndexSuffix forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser PFExprSuffix
pPFExprCallSuffix
              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
<$> AParser PFExprSuffix
pPFExprCallSuffix
          )

-- | single variable. Note: definition differs from reference to circumvent the left recursion
-- var ::= Name [{PFExprSuffix}* indexation] | '(' exp ')' {PFExprSuffix}* indexation
-- where "{PFExprSuffix}* indexation" is any arbitrary sequence of prefix expression suffixes that end with an indexation
parseVar :: AParser PrefixExp
parseVar :: AParser PrefixExp
parseVar = AParser ExprSuffixList -> AParser PrefixExp
pPrefixExp AParser ExprSuffixList
suffixes forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"variable"
  where
    suffixes :: AParser ExprSuffixList
suffixes =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        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]
many
          ( (\ExprSuffixList
c PFExprSuffix
ix -> ExprSuffixList
c forall a. [a] -> [a] -> [a]
++ [PFExprSuffix
ix]) 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 AParser PFExprSuffix
pPFExprCallSuffix forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser PFExprSuffix
pPFExprIndexSuffix
              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
<$> AParser PFExprSuffix
pPFExprIndexSuffix
          )

-- | Arguments of a function call (including brackets)
parseArgs :: AParser Args
parseArgs :: AParser Args
parseArgs =
  MExprList -> Args
ListArgs
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
LRound
    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 [] ParsecT [MToken] LineColPos Identity MExprList
parseExpressionList
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RRound
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> FieldList -> Args
TableArg
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser FieldList
parseTableConstructor
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MToken -> Args
StringArg
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MToken
parseString
    forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function arguments"

-- | Table constructor
parseTableConstructor :: AParser [Field]
parseTableConstructor :: AParser FieldList
parseTableConstructor = Token -> AParser MToken
pMTok Token
LCurly forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AParser FieldList
parseFieldList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RCurly forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"table"

-- | A list of table entries
-- Grammar: field {separator field} [separator]
parseFieldList :: AParser [Field]
parseFieldList :: AParser FieldList
parseFieldList = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ do
  FieldSep -> Field
field <- AParser (FieldSep -> Field)
parseField
  FieldSep
sep <- AParser FieldSep
parseOptionalFieldSep
  case FieldSep
sep of
    FieldSep
NoSep -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [FieldSep -> Field
field FieldSep
NoSep]
    FieldSep
_ -> (FieldSep -> Field
field FieldSep
sep forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser FieldList
parseFieldList

-- | Parse a named field (e.g. {named = field})
-- Contains try to avoid conflict with unnamed fields
parseNamedField :: AParser (FieldSep -> Field)
parseNamedField :: AParser (FieldSep -> Field)
parseNamedField = do
  MToken
name <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
    MToken
n <- AParser MToken
pName
    MToken
_ <- Token -> AParser MToken
pMTok Token
Equals
    forall (m :: * -> *) a. Monad m => a -> m a
return MToken
n

  MToken -> MExpr -> FieldSep -> Field
NamedField MToken
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MExpr
parseExpression

-- | A field in a table
parseField :: AParser (FieldSep -> Field)
parseField :: AParser (FieldSep -> Field)
parseField =
  MExpr -> MExpr -> FieldSep -> Field
ExprField
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
LSquare
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
RSquare
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> AParser MToken
pMTok Token
Equals
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AParser MExpr
parseExpression
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> AParser (FieldSep -> Field)
parseNamedField
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MExpr -> FieldSep -> Field
UnnamedField
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AParser MExpr
parseExpression
    forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"field"

-- | Field separator, either comma or semicolon
parseFieldSep :: AParser FieldSep
parseFieldSep :: AParser FieldSep
parseFieldSep =
  FieldSep
CommaSep forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Comma
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> FieldSep
SemicolonSep forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token -> AParser MToken
pMTok Token
Semicolon

-- | Optional field separator, returns NoSep when no separator is found
-- Used at the end of a field list
parseOptionalFieldSep :: AParser FieldSep
parseOptionalFieldSep :: AParser FieldSep
parseOptionalFieldSep = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option FieldSep
NoSep AParser FieldSep
parseFieldSep