{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-- UUAGC 0.9.53.1 (src/GLua/AG/AST.ag)
module GLua.AG.AST where

{-# LINE 10 "src/GLua/AG/AST.ag" #-}

import GLua.AG.Token
import GLua.Position
import GLua.TokenTypes ()
import GHC.Generics
import Data.Aeson
{-# LINE 16 "src/GLua/AG/AST.hs" #-}
-- AReturn -----------------------------------------------------
data AReturn = AReturn (Region) (MExprList)
             | NoReturn
             deriving ( forall x. Rep AReturn x -> AReturn
forall x. AReturn -> Rep AReturn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AReturn x -> AReturn
$cfrom :: forall x. AReturn -> Rep AReturn x
Generic,Int -> AReturn -> ShowS
[AReturn] -> ShowS
AReturn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AReturn] -> ShowS
$cshowList :: [AReturn] -> ShowS
show :: AReturn -> String
$cshow :: AReturn -> String
showsPrec :: Int -> AReturn -> ShowS
$cshowsPrec :: Int -> AReturn -> ShowS
Show)
-- AST ---------------------------------------------------------
data AST = AST (([MToken])) (Block)
         deriving ( forall x. Rep AST x -> AST
forall x. AST -> Rep AST x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AST x -> AST
$cfrom :: forall x. AST -> Rep AST x
Generic,Int -> AST -> ShowS
[AST] -> ShowS
AST -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AST] -> ShowS
$cshowList :: [AST] -> ShowS
show :: AST -> String
$cshow :: AST -> String
showsPrec :: Int -> AST -> ShowS
$cshowsPrec :: Int -> AST -> ShowS
Show)
-- Args --------------------------------------------------------
data Args = ListArgs (MExprList)
          | TableArg (FieldList)
          | StringArg (MToken)
          deriving ( forall x. Rep Args x -> Args
forall x. Args -> Rep Args x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Args x -> Args
$cfrom :: forall x. Args -> Rep Args x
Generic,Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Args] -> ShowS
$cshowList :: [Args] -> ShowS
show :: Args -> String
$cshow :: Args -> String
showsPrec :: Int -> Args -> ShowS
$cshowsPrec :: Int -> Args -> ShowS
Show)
-- BinOp -------------------------------------------------------
data BinOp = AOr
           | AAnd
           | ALT
           | AGT
           | ALEQ
           | AGEQ
           | ANEq
           | AEq
           | AConcatenate
           | APlus
           | BinMinus
           | AMultiply
           | ADivide
           | AModulus
           | APower
           deriving ( BinOp -> BinOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinOp -> BinOp -> Bool
$c/= :: BinOp -> BinOp -> Bool
== :: BinOp -> BinOp -> Bool
$c== :: BinOp -> BinOp -> Bool
Eq,forall x. Rep BinOp x -> BinOp
forall x. BinOp -> Rep BinOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinOp x -> BinOp
$cfrom :: forall x. BinOp -> Rep BinOp x
Generic,Eq BinOp
BinOp -> BinOp -> Bool
BinOp -> BinOp -> Ordering
BinOp -> BinOp -> BinOp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BinOp -> BinOp -> BinOp
$cmin :: BinOp -> BinOp -> BinOp
max :: BinOp -> BinOp -> BinOp
$cmax :: BinOp -> BinOp -> BinOp
>= :: BinOp -> BinOp -> Bool
$c>= :: BinOp -> BinOp -> Bool
> :: BinOp -> BinOp -> Bool
$c> :: BinOp -> BinOp -> Bool
<= :: BinOp -> BinOp -> Bool
$c<= :: BinOp -> BinOp -> Bool
< :: BinOp -> BinOp -> Bool
$c< :: BinOp -> BinOp -> Bool
compare :: BinOp -> BinOp -> Ordering
$ccompare :: BinOp -> BinOp -> Ordering
Ord,Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinOp] -> ShowS
$cshowList :: [BinOp] -> ShowS
show :: BinOp -> String
$cshow :: BinOp -> String
showsPrec :: Int -> BinOp -> ShowS
$cshowsPrec :: Int -> BinOp -> ShowS
Show)
-- Block -------------------------------------------------------
data Block = Block (Region) (MStatList) (AReturn)
           deriving ( forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic,Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show)
-- Declaration -------------------------------------------------
type Declaration = ( PrefixExp,MaybeMExpr)
-- Else --------------------------------------------------------
type Else = Maybe (MElse)
-- ElseIf ------------------------------------------------------
type ElseIf = ( MExpr,Block)
-- ElseIfList --------------------------------------------------
type ElseIfList = [MElseIf]
-- Expr --------------------------------------------------------
data Expr = ANil
          | AFalse
          | ATrue
          | ANumber (String)
          | AString (MToken)
          | AVarArg
          | AnonymousFunc (([MToken])) (Block)
          | APrefixExpr (PrefixExp)
          | ATableConstructor (FieldList)
          | BinOpExpr (BinOp) (MExpr) (MExpr)
          | UnOpExpr (UnOp) (MExpr)
          deriving ( forall x. Rep Expr x -> Expr
forall x. Expr -> Rep Expr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Expr x -> Expr
$cfrom :: forall x. Expr -> Rep Expr x
Generic,Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show)
-- ExprSuffixList ----------------------------------------------
type ExprSuffixList = [PFExprSuffix]
-- Field -------------------------------------------------------
data Field = ExprField (MExpr) (MExpr) (FieldSep)
           | NamedField (MToken) (MExpr) (FieldSep)
           | UnnamedField (MExpr) (FieldSep)
           deriving ( forall x. Rep Field x -> Field
forall x. Field -> Rep Field x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field x -> Field
$cfrom :: forall x. Field -> Rep Field x
Generic,Int -> Field -> ShowS
FieldList -> ShowS
Field -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: FieldList -> ShowS
$cshowList :: FieldList -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show)
-- FieldList ---------------------------------------------------
type FieldList = [Field]
-- FieldSep ----------------------------------------------------
data FieldSep = CommaSep
              | SemicolonSep
              | NoSep
              deriving ( FieldSep -> FieldSep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldSep -> FieldSep -> Bool
$c/= :: FieldSep -> FieldSep -> Bool
== :: FieldSep -> FieldSep -> Bool
$c== :: FieldSep -> FieldSep -> Bool
Eq,forall x. Rep FieldSep x -> FieldSep
forall x. FieldSep -> Rep FieldSep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldSep x -> FieldSep
$cfrom :: forall x. FieldSep -> Rep FieldSep x
Generic,Int -> FieldSep -> ShowS
[FieldSep] -> ShowS
FieldSep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldSep] -> ShowS
$cshowList :: [FieldSep] -> ShowS
show :: FieldSep -> String
$cshow :: FieldSep -> String
showsPrec :: Int -> FieldSep -> ShowS
$cshowsPrec :: Int -> FieldSep -> ShowS
Show)
-- FuncName ----------------------------------------------------
data FuncName = FuncName (([MToken])) ((Maybe MToken))
              deriving ( forall x. Rep FuncName x -> FuncName
forall x. FuncName -> Rep FuncName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FuncName x -> FuncName
$cfrom :: forall x. FuncName -> Rep FuncName x
Generic,Int -> FuncName -> ShowS
[FuncName] -> ShowS
FuncName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FuncName] -> ShowS
$cshowList :: [FuncName] -> ShowS
show :: FuncName -> String
$cshow :: FuncName -> String
showsPrec :: Int -> FuncName -> ShowS
$cshowsPrec :: Int -> FuncName -> ShowS
Show)
-- MElse -------------------------------------------------------
data MElse = MElse (Region) (Block)
           deriving ( forall x. Rep MElse x -> MElse
forall x. MElse -> Rep MElse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MElse x -> MElse
$cfrom :: forall x. MElse -> Rep MElse x
Generic,Int -> MElse -> ShowS
[MElse] -> ShowS
MElse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MElse] -> ShowS
$cshowList :: [MElse] -> ShowS
show :: MElse -> String
$cshow :: MElse -> String
showsPrec :: Int -> MElse -> ShowS
$cshowsPrec :: Int -> MElse -> ShowS
Show)
-- MElseIf -----------------------------------------------------
data MElseIf = MElseIf (Region) (ElseIf)
             deriving ( forall x. Rep MElseIf x -> MElseIf
forall x. MElseIf -> Rep MElseIf x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MElseIf x -> MElseIf
$cfrom :: forall x. MElseIf -> Rep MElseIf x
Generic,Int -> MElseIf -> ShowS
[MElseIf] -> ShowS
MElseIf -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MElseIf] -> ShowS
$cshowList :: [MElseIf] -> ShowS
show :: MElseIf -> String
$cshow :: MElseIf -> String
showsPrec :: Int -> MElseIf -> ShowS
$cshowsPrec :: Int -> MElseIf -> ShowS
Show)
-- MExpr -------------------------------------------------------
data MExpr = MExpr (Region) (Expr)
           deriving ( forall x. Rep MExpr x -> MExpr
forall x. MExpr -> Rep MExpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MExpr x -> MExpr
$cfrom :: forall x. MExpr -> Rep MExpr x
Generic,Int -> MExpr -> ShowS
MExprList -> ShowS
MExpr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: MExprList -> ShowS
$cshowList :: MExprList -> ShowS
show :: MExpr -> String
$cshow :: MExpr -> String
showsPrec :: Int -> MExpr -> ShowS
$cshowsPrec :: Int -> MExpr -> ShowS
Show)
-- MExprList ---------------------------------------------------
type MExprList = [MExpr]
-- MStat -------------------------------------------------------
data MStat = MStat (Region) (Stat)
           deriving ( forall x. Rep MStat x -> MStat
forall x. MStat -> Rep MStat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MStat x -> MStat
$cfrom :: forall x. MStat -> Rep MStat x
Generic,Int -> MStat -> ShowS
MStatList -> ShowS
MStat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: MStatList -> ShowS
$cshowList :: MStatList -> ShowS
show :: MStat -> String
$cshow :: MStat -> String
showsPrec :: Int -> MStat -> ShowS
$cshowsPrec :: Int -> MStat -> ShowS
Show)
-- MStatList ---------------------------------------------------
type MStatList = [MStat]
-- MaybeMExpr --------------------------------------------------
type MaybeMExpr = Maybe (MExpr)
-- PFExprSuffix ------------------------------------------------
data PFExprSuffix = Call (Args)
                  | MetaCall (MToken) (Args)
                  | ExprIndex (MExpr)
                  | DotIndex (MToken)
                  deriving ( forall x. Rep PFExprSuffix x -> PFExprSuffix
forall x. PFExprSuffix -> Rep PFExprSuffix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PFExprSuffix x -> PFExprSuffix
$cfrom :: forall x. PFExprSuffix -> Rep PFExprSuffix x
Generic,Int -> PFExprSuffix -> ShowS
[PFExprSuffix] -> ShowS
PFExprSuffix -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFExprSuffix] -> ShowS
$cshowList :: [PFExprSuffix] -> ShowS
show :: PFExprSuffix -> String
$cshow :: PFExprSuffix -> String
showsPrec :: Int -> PFExprSuffix -> ShowS
$cshowsPrec :: Int -> PFExprSuffix -> ShowS
Show)
-- PrefixExp ---------------------------------------------------
data PrefixExp = PFVar (MToken) (ExprSuffixList)
               | ExprVar (MExpr) (ExprSuffixList)
               deriving ( forall x. Rep PrefixExp x -> PrefixExp
forall x. PrefixExp -> Rep PrefixExp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrefixExp x -> PrefixExp
$cfrom :: forall x. PrefixExp -> Rep PrefixExp x
Generic,Int -> PrefixExp -> ShowS
[PrefixExp] -> ShowS
PrefixExp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrefixExp] -> ShowS
$cshowList :: [PrefixExp] -> ShowS
show :: PrefixExp -> String
$cshow :: PrefixExp -> String
showsPrec :: Int -> PrefixExp -> ShowS
$cshowsPrec :: Int -> PrefixExp -> ShowS
Show)
-- Stat --------------------------------------------------------
data Stat = Def (VarsList)
          | LocDef (VarsList)
          | AFuncCall (PrefixExp)
          | ALabel (MToken)
          | ABreak
          | AContinue
          | AGoto (MToken)
          | ADo (Block)
          | AWhile (MExpr) (Block)
          | ARepeat (Block) (MExpr)
          | AIf (MExpr) (Block) (ElseIfList) (Else)
          | ANFor (MToken) (MExpr) (MExpr) (MExpr) (Block)
          | AGFor (([MToken])) (MExprList) (Block)
          | AFunc (FuncName) (([MToken])) (Block)
          | ALocFunc (FuncName) (([MToken])) (Block)
          deriving ( forall x. Rep Stat x -> Stat
forall x. Stat -> Rep Stat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Stat x -> Stat
$cfrom :: forall x. Stat -> Rep Stat x
Generic,Int -> Stat -> ShowS
[Stat] -> ShowS
Stat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stat] -> ShowS
$cshowList :: [Stat] -> ShowS
show :: Stat -> String
$cshow :: Stat -> String
showsPrec :: Int -> Stat -> ShowS
$cshowsPrec :: Int -> Stat -> ShowS
Show)
-- UnOp --------------------------------------------------------
data UnOp = UnMinus
          | ANot
          | AHash
          deriving ( forall x. Rep UnOp x -> UnOp
forall x. UnOp -> Rep UnOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnOp x -> UnOp
$cfrom :: forall x. UnOp -> Rep UnOp x
Generic,Int -> UnOp -> ShowS
[UnOp] -> ShowS
UnOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnOp] -> ShowS
$cshowList :: [UnOp] -> ShowS
show :: UnOp -> String
$cshow :: UnOp -> String
showsPrec :: Int -> UnOp -> ShowS
$cshowsPrec :: Int -> UnOp -> ShowS
Show)
-- VarsList ----------------------------------------------------
type VarsList = [Declaration]