module Ast.Parser.Expr where
import qualified Ast.Parser.Asm as PA
import qualified Ast.Parser.Literal as PL
import qualified Ast.Parser.State as PS
import qualified Ast.Parser.Type as PT
import qualified Ast.Parser.Utils as AU
import qualified Ast.Parser.Utils as PU
import qualified Ast.Types as AT
import qualified Control.Monad.Combinators.Expr as CE
import qualified Control.Monad.State as S
import qualified Data.Maybe as DM
import qualified Shared.Utils as SU
import qualified Text.Megaparsec as M
parseExpr :: PU.Parser AT.Expr
parseExpr :: Parser Expr
parseExpr = Parser Expr
-> [[Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr]]
-> Parser Expr
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
CE.makeExprParser (Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
PU.lexeme Parser Expr
parseTerm) [[Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr]]
operationTable
operationTable :: [[CE.Operator PU.Parser AT.Expr]]
operationTable :: [[Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr]]
operationTable =
[ [ String
-> (SrcLoc -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.postfix String
".*" (SrcLoc -> UnaryOperation -> Expr -> Expr
`AT.UnaryOp` UnaryOperation
AT.Deref),
String
-> (SrcLoc -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.postfix String
".&" (SrcLoc -> UnaryOperation -> Expr -> Expr
`AT.UnaryOp` UnaryOperation
AT.AddrOf),
String
-> (SrcLoc -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.postfix String
"++" (SrcLoc -> UnaryOperation -> Expr -> Expr
`AT.UnaryOp` UnaryOperation
AT.PostInc),
String
-> (SrcLoc -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.postfix String
"--" (SrcLoc -> UnaryOperation -> Expr -> Expr
`AT.UnaryOp` UnaryOperation
AT.PostDec),
Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
parseCall
],
[ String
-> (SrcLoc -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.prefix String
"!" (SrcLoc -> UnaryOperation -> Expr -> Expr
`AT.UnaryOp` UnaryOperation
AT.Not),
String
-> (SrcLoc -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.prefix String
"not" (SrcLoc -> UnaryOperation -> Expr -> Expr
`AT.UnaryOp` UnaryOperation
AT.Not),
String
-> (SrcLoc -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.prefix String
"~" (SrcLoc -> UnaryOperation -> Expr -> Expr
`AT.UnaryOp` UnaryOperation
AT.BitNot),
String
-> (SrcLoc -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.prefix String
"++" (SrcLoc -> UnaryOperation -> Expr -> Expr
`AT.UnaryOp` UnaryOperation
AT.PreInc),
String
-> (SrcLoc -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.prefix String
"--" (SrcLoc -> UnaryOperation -> Expr -> Expr
`AT.UnaryOp` UnaryOperation
AT.PreDec)
],
[ String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"*" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Mul),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"/" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Div),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"mod" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Mod)
],
[ String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"+" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Add),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"-" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Sub)
],
[ String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"&" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.BitAnd),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"|" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.BitOr),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"^" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.BitXor),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"<<" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.BitShl),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
">>" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.BitShr)
],
[ String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"==" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Eq),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"is" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Eq),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"!=" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Ne),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"<=" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Lte),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
">=" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Gte),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"<" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Lt),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
">" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Gt),
Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
parseAssignment,
Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
parseArrayAccess,
Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
parseStructAccess
],
[ String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"and" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.And),
String
-> (SrcLoc -> Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
PU.binary String
"or" (SrcLoc -> Operation -> Expr -> Expr -> Expr
`AT.Op` Operation
AT.Or)
]
]
parseCall :: CE.Operator PU.Parser AT.Expr
parseCall :: Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
parseCall = Parser (Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
forall (m :: * -> *) a. m (a -> a) -> Operator m a
CE.Postfix (Parser (Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr)
-> Parser (Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
forall a b. (a -> b) -> a -> b
$ do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
[Expr]
args <- ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"(") (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
")") (ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr])
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
forall a b. (a -> b) -> a -> b
$ Parser Expr
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many Parser Expr
parseExpr
(Expr -> Expr) -> Parser (Expr -> Expr)
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (\Expr
func -> SrcLoc -> Expr -> [Expr] -> Expr
AT.Call SrcLoc
srcLoc Expr
func [Expr]
args)
parseAssignment :: CE.Operator PU.Parser AT.Expr
parseAssignment :: Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
parseAssignment = Parser (Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
CE.InfixL (Parser (Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr)
-> Parser (Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
forall a b. (a -> b) -> a -> b
$ do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc Parser SrcLoc
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser SrcLoc
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"="
(Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr))
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
target Expr
value -> SrcLoc -> Expr -> Expr -> Expr
AT.Assignment SrcLoc
srcLoc Expr
target Expr
value
parseArrayAccess :: CE.Operator PU.Parser AT.Expr
parseArrayAccess :: Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
parseArrayAccess = Parser (Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
CE.InfixL (Parser (Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr)
-> Parser (Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
forall a b. (a -> b) -> a -> b
$ do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc Parser SrcLoc
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser SrcLoc
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
".#"
(Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr))
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
value Expr
pos -> SrcLoc -> Expr -> Expr -> Expr
AT.ArrayAccess SrcLoc
srcLoc Expr
value Expr
pos
parseStructAccess :: CE.Operator PU.Parser AT.Expr
parseStructAccess :: Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
parseStructAccess = Parser (Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
CE.InfixL (Parser (Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr)
-> Parser (Expr -> Expr -> Expr)
-> Operator
(ParsecT ParseErrorCustom String (StateT ParserState IO)) Expr
forall a b. (a -> b) -> a -> b
$ do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc Parser SrcLoc
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser SrcLoc
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"."
(Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr))
-> (Expr -> Expr -> Expr) -> Parser (Expr -> Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
value Expr
field -> SrcLoc -> Expr -> Expr -> Expr
AT.StructAccess SrcLoc
srcLoc Expr
value Expr
field
parseTerm :: PU.Parser AT.Expr
parseTerm :: Parser Expr
parseTerm =
[Parser Expr] -> Parser Expr
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice
[ Parser Expr
parseIf,
Parser Expr
parseWhile,
Parser Expr
parseFrom,
Parser Expr
parseReturn,
Parser Expr
parseBreak,
Parser Expr
parseContinue,
(Expr -> Expr) -> Parser Expr
parseBlock Expr -> Expr
forall a. a -> a
id,
Parser Expr
parseCast,
Parser Expr
parseDefer,
Parser Expr
parseAssembly,
Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser Expr
parseFunction,
Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser Expr
parseForeignFunction,
Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser Expr
parseDeclaration,
Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser Expr
parseLit,
Parser Expr
parseVar,
Parser Expr
parseParenExpr
]
parseLit :: PU.Parser AT.Expr
parseLit :: Parser Expr
parseLit = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
SrcLoc -> Literal -> Expr
AT.Lit SrcLoc
srcLoc (Literal -> Expr)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Literal
-> Parser Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseErrorCustom String (StateT ParserState IO) Literal
PL.parseLiteral
parseVar :: PU.Parser AT.Expr
parseVar :: Parser Expr
parseVar = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
String
name <- ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.identifier
ParserState
env <- ParsecT ParseErrorCustom String (StateT ParserState IO) ParserState
forall s (m :: * -> *). MonadState s m => m s
S.get
case String -> ParserState -> Maybe Type
PS.lookupVar String
name ParserState
env of
(Just Type
t) -> Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ SrcLoc -> String -> Type -> Expr
AT.Var SrcLoc
srcLoc String
name Type
t
Maybe Type
_ -> Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ SrcLoc -> String -> Type -> Expr
AT.Var SrcLoc
srcLoc String
name Type
AT.TUnknown
parseFunction :: PU.Parser AT.Expr
parseFunction :: Parser Expr
parseFunction = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
String
name <- ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.identifier
Type
ft <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
":" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
PT.parseType
case Type
ft of
(AT.TFunction Type
ret [Type]
pts Bool
_) -> do
[String]
params <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"=" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [String]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [String]
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many (ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall a. Parser a -> Parser a
PU.lexeme ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.identifier)
((String, Type)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ())
-> [(String, Type)]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(String
p, Type
t) -> (ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (String -> Type -> ParserState -> ParserState
PS.insertVar String
p Type
t)) ([(String, Type)]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ())
-> [(String, Type)]
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall a b. (a -> b) -> a -> b
$ [String] -> [Type] -> [(String, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
params [Type]
pts
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (String -> Type -> ParserState -> ParserState
PS.insertVar String
name Type
ft)
Expr
body <-
if Type
ret Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
/= Type
AT.TVoid
then (Expr -> Expr) -> Parser Expr
parseBlock Expr -> Expr
implicitReturn
else (Expr -> Expr) -> Parser Expr
parseBlock Expr -> Expr
forall a. a -> a
id
Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ AT.Function {funcLoc :: SrcLoc
AT.funcLoc = SrcLoc
srcLoc, funcName :: String
AT.funcName = String
name, funcType :: Type
AT.funcType = Type
ft, funcParams :: [String]
AT.funcParams = [String]
params, funcBody :: Expr
AT.funcBody = Expr
body}
Type
_ -> ParseErrorCustom -> Parser Expr
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure (ParseErrorCustom -> Parser Expr)
-> ParseErrorCustom -> Parser Expr
forall a b. (a -> b) -> a -> b
$ String -> Type -> ParseErrorCustom
AU.InvalidFunctionType String
name Type
ft
implicitReturn :: AT.Expr -> AT.Expr
implicitReturn :: Expr -> Expr
implicitReturn e :: Expr
e@(AT.Lit {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn e :: Expr
e@(AT.Var {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn e :: Expr
e@(AT.Function {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn e :: Expr
e@(AT.ForeignFunction {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn e :: Expr
e@(AT.Declaration {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn e :: Expr
e@(AT.Assignment {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn e :: Expr
e@(AT.Call {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn (AT.If SrcLoc
loc Expr
cond Expr
then' (Just Expr
else')) = SrcLoc -> Expr -> Expr -> Maybe Expr -> Expr
AT.If SrcLoc
loc Expr
cond (Expr -> Expr
implicitReturn Expr
then') (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
implicitReturn Expr
else'
implicitReturn (AT.If SrcLoc
loc Expr
cond Expr
then' Maybe Expr
Nothing) = SrcLoc -> Expr -> Expr -> Maybe Expr -> Expr
AT.If SrcLoc
loc Expr
cond (Expr -> Expr
implicitReturn Expr
then') Maybe Expr
forall a. Maybe a
Nothing
implicitReturn e :: Expr
e@(AT.While {}) = Expr
e
implicitReturn e :: Expr
e@(AT.From {}) = Expr
e
implicitReturn (AT.Block []) = [Expr] -> Expr
AT.Block []
implicitReturn (AT.Block [Expr]
es) = [Expr] -> Expr
AT.Block ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> [Expr]
forall a. HasCallStack => [a] -> [a]
init [Expr]
es [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Expr -> Expr
implicitReturn (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
forall a. HasCallStack => [a] -> a
last [Expr]
es]
implicitReturn e :: Expr
e@(AT.Return SrcLoc
_ Maybe Expr
_) = Expr
e
implicitReturn e :: Expr
e@(AT.Break {}) = Expr
e
implicitReturn e :: Expr
e@(AT.Continue {}) = Expr
e
implicitReturn e :: Expr
e@(AT.Op {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn e :: Expr
e@(AT.UnaryOp {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn e :: Expr
e@(AT.StructAccess {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn e :: Expr
e@(AT.ArrayAccess {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn e :: Expr
e@(AT.Cast {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
implicitReturn e :: Expr
e@(AT.Assembly {}) = SrcLoc -> Maybe Expr -> Expr
AT.Return (Expr -> SrcLoc
SU.getLoc Expr
e) (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
parseForeignFunction :: PU.Parser AT.Expr
parseForeignFunction :: Parser Expr
parseForeignFunction = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
String
name <- ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.identifier
Type
ft <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
":" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"foreign" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
forall a. Parser a -> Parser a
PU.lexeme ParsecT ParseErrorCustom String (StateT ParserState IO) Type
PT.parseType
case Type
ft of
t :: Type
t@(AT.TFunction {}) -> do
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (String -> Type -> ParserState -> ParserState
PS.insertVar String
name Type
t)
Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$
AT.ForeignFunction
{ funcLoc :: SrcLoc
AT.funcLoc = SrcLoc
srcLoc,
funcName :: String
AT.funcName = String
name,
funcType :: Type
AT.funcType = Type
t
}
Type
_ -> ParseErrorCustom -> Parser Expr
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure (ParseErrorCustom -> Parser Expr)
-> ParseErrorCustom -> Parser Expr
forall a b. (a -> b) -> a -> b
$ String -> Type -> ParseErrorCustom
AU.InvalidFunctionType String
name Type
ft
parseDeclaration :: PU.Parser AT.Expr
parseDeclaration :: Parser Expr
parseDeclaration = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
String
name <- ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.identifier
Type
t <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
":" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
PT.parseType
Maybe Expr
value <- Parser Expr
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional (Parser Expr
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr))
-> Parser Expr
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr)
forall a b. (a -> b) -> a -> b
$ String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"=" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Expr -> Parser Expr
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Expr
parseExpr
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (String -> Type -> ParserState -> ParserState
PS.insertVar String
name Type
t)
Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ AT.Declaration {declLoc :: SrcLoc
AT.declLoc = SrcLoc
srcLoc, declName :: String
AT.declName = String
name, declType :: Type
AT.declType = Type
t, declInit :: Maybe Expr
AT.declInit = Maybe Expr
value}
parseIf :: PU.Parser AT.Expr
parseIf :: Parser Expr
parseIf = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
Expr
cond <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"if" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Expr -> Parser Expr
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
PU.lexeme Parser Expr
parseExpr
Expr
then' <- (Expr -> Expr) -> Parser Expr
parseBlock Expr -> Expr
forall a. a -> a
id
Maybe Expr
else' <- Parser Expr
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional (Parser Expr
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr))
-> Parser Expr
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr)
forall a b. (a -> b) -> a -> b
$ String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"else" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Expr -> Parser Expr
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Expr -> Expr) -> Parser Expr
parseBlock Expr -> Expr
forall a. a -> a
id
Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ AT.If {ifLoc :: SrcLoc
AT.ifLoc = SrcLoc
srcLoc, ifCond :: Expr
AT.ifCond = Expr
cond, ifThen :: Expr
AT.ifThen = Expr
then', ifElse :: Maybe Expr
AT.ifElse = Maybe Expr
else'}
parseWhile :: PU.Parser AT.Expr
parseWhile :: Parser Expr
parseWhile = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
Expr
cond <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"loop" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Expr -> Parser Expr
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Expr
parseExpr
Expr
body <- (Expr -> Expr) -> Parser Expr
parseBlock Expr -> Expr
forall a. a -> a
id
Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ AT.While {whileLoc :: SrcLoc
AT.whileLoc = SrcLoc
srcLoc, whileCond :: Expr
AT.whileCond = Expr
cond, whileBody :: Expr
AT.whileBody = Expr
body}
parseFrom :: PU.Parser AT.Expr
parseFrom :: Parser Expr
parseFrom = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
Expr
start <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"from" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Expr -> Parser Expr
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
PU.lexeme Parser Expr
parseExpr
Expr
end <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"to" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Expr -> Parser Expr
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
PU.lexeme Parser Expr
parseExpr
Maybe Expr
step <- Parser Expr
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional (Parser Expr
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr))
-> Parser Expr
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr)
forall a b. (a -> b) -> a -> b
$ Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Parser Expr -> Parser Expr) -> Parser Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"by" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Expr -> Parser Expr
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
PU.lexeme Parser Expr
parseExpr
(String
name, Type
type') <-
ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"[") (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"]") (ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type))
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
forall a b. (a -> b) -> a -> b
$ do
String
name <- ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.identifier
Type
type' <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
":" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
PT.parseType
(String, Type)
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (String, Type)
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, Type
type')
let decl :: Expr
decl = SrcLoc -> String -> Type -> Maybe Expr -> Expr
AT.Declaration SrcLoc
srcLoc String
name Type
type' (Maybe Expr -> Expr) -> Maybe Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
start
let var :: Expr
var = SrcLoc -> String -> Type -> Expr
AT.Var SrcLoc
srcLoc String
name Type
type'
let one :: Expr
one = SrcLoc -> Literal -> Expr
AT.Lit SrcLoc
srcLoc (Integer -> Literal
AT.LInt Integer
1)
let stepExpr :: Expr
stepExpr = SrcLoc -> Expr -> Expr -> Expr
AT.Assignment SrcLoc
srcLoc Expr
var (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Operation -> Expr -> Expr -> Expr
AT.Op SrcLoc
srcLoc Operation
AT.Add Expr
var (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr -> Expr
forall a. a -> Maybe a -> a
DM.fromMaybe Expr
one Maybe Expr
step
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (String -> Type -> ParserState -> ParserState
PS.insertVar String
name Type
type')
Expr
body <- (Expr -> Expr) -> Parser Expr
parseBlock Expr -> Expr
forall a. a -> a
id
Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr
AT.From SrcLoc
srcLoc Expr
start Expr
end Expr
stepExpr Expr
decl Expr
body
parseBlock :: (AT.Expr -> AT.Expr) -> PU.Parser AT.Expr
parseBlock :: (Expr -> Expr) -> Parser Expr
parseBlock Expr -> Expr
f = do
String
_ <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"{"
ParserState
outerState <- ParsecT ParseErrorCustom String (StateT ParserState IO) ParserState
forall s (m :: * -> *). MonadState s m => m s
S.get
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ParserState -> ParserState
PS.pushScope
[Expr]
es <- Parser Expr
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many (Parser Expr
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr])
-> Parser Expr
-> ParsecT ParseErrorCustom String (StateT ParserState IO) [Expr]
forall a b. (a -> b) -> a -> b
$ Parser Expr -> Parser Expr
forall a. Parser a -> Parser a
PU.lexeme Parser Expr
parseExpr
String
_ <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"}"
ParserState
blockState <- ParsecT ParseErrorCustom String (StateT ParserState IO) ParserState
forall s (m :: * -> *). MonadState s m => m s
S.get
let ([Expr]
deferred, ParserState
ds) = ParserState -> ([Expr], ParserState)
PS.popScope ParserState
blockState
ParserState
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
S.put ParserState
outerState {deferState :: DeferState
PS.deferState = ParserState -> DeferState
PS.deferState ParserState
ds}
Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr -> Expr
deferedExpr [Expr]
deferred (Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
f (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
AT.Block [Expr]
es
deferedExpr :: [AT.Expr] -> AT.Expr -> AT.Expr
deferedExpr :: [Expr] -> Expr -> Expr
deferedExpr [Expr]
ds (AT.Block []) = [Expr] -> Expr
AT.Block [Expr]
ds
deferedExpr [Expr]
ds (AT.Block [Expr]
es) = case [Expr] -> Expr
forall a. HasCallStack => [a] -> a
last [Expr]
es of
e :: Expr
e@(AT.Return SrcLoc
_ Maybe Expr
_) -> [Expr] -> Expr
AT.Block ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> [Expr]
forall a. HasCallStack => [a] -> [a]
init [Expr]
es [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Expr]
ds [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Expr
e]
Expr
_ -> [Expr] -> Expr
AT.Block ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr]
es [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Expr]
ds
deferedExpr [Expr]
_ Expr
e = Expr
e
parseReturn :: PU.Parser AT.Expr
parseReturn :: Parser Expr
parseReturn = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
String
_ <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"ret"
SrcLoc -> Maybe Expr -> Expr
AT.Return SrcLoc
srcLoc (Maybe Expr -> Expr)
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr)
-> Parser Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Expr
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional Parser Expr
parseExpr
parseBreak :: PU.Parser AT.Expr
parseBreak :: Parser Expr
parseBreak = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
String
_ <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"stop"
Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Expr
AT.Break SrcLoc
srcLoc
parseContinue :: PU.Parser AT.Expr
parseContinue :: Parser Expr
parseContinue = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
String
_ <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"next"
Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Expr
AT.Continue SrcLoc
srcLoc
parseCast :: PU.Parser AT.Expr
parseCast :: Parser Expr
parseCast = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
Type
type' <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"@" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
PT.parseType
Expr
expr <- ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Expr
-> Parser Expr
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"(") (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
")") Parser Expr
parseExpr
Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parser Expr) -> Expr -> Parser Expr
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Type -> Expr -> Expr
AT.Cast SrcLoc
srcLoc Type
type' Expr
expr
parseDefer :: PU.Parser AT.Expr
parseDefer :: Parser Expr
parseDefer = do
Expr
defered <- String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"defer" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Expr -> Parser Expr
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Expr
parseExpr
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ())
-> (ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall a b. (a -> b) -> a -> b
$ Expr -> ParserState -> ParserState
PS.pushDefered Expr
defered
Maybe Expr
next <- Parser Expr
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional Parser Expr
parseExpr
case Maybe Expr
next of
Maybe Expr
Nothing -> ParseErrorCustom -> Parser Expr
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure (ParseErrorCustom -> Parser Expr)
-> ParseErrorCustom -> Parser Expr
forall a b. (a -> b) -> a -> b
$ Expr -> ParseErrorCustom
PU.InvalidDefer Expr
defered
(Just Expr
e) -> Expr -> Parser Expr
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e
parseParenExpr :: PU.Parser AT.Expr
parseParenExpr :: Parser Expr
parseParenExpr = ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Expr
-> Parser Expr
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"(") (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
")") Parser Expr
parseExpr
parseAssembly :: PU.Parser AT.Expr
parseAssembly :: Parser Expr
parseAssembly = do
SrcLoc
srcLoc <- Parser SrcLoc
PU.parseSrcLoc
SrcLoc -> AsmExpr -> Expr
AT.Assembly SrcLoc
srcLoc (AsmExpr -> Expr)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) AsmExpr
-> Parser Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"__asm__" ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) AsmExpr
-> ParsecT ParseErrorCustom String (StateT ParserState IO) AsmExpr
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Expr
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Type
-> ParsecT ParseErrorCustom String (StateT ParserState IO) AsmExpr
PA.parseAsm Parser Expr
parseExpr ParsecT ParseErrorCustom String (StateT ParserState IO) Type
PT.parseType)