module Ast.Parser.Program where
import qualified Ast.Parser.Expr as PE
import qualified Ast.Parser.PreProcessor as PP
import qualified Ast.Parser.TypeDefinition as PT
import qualified Ast.Parser.Utils as PU
import qualified Ast.Types as AT
import qualified Text.Megaparsec as M
parseProgram :: String -> PU.Parser AT.Program
parseProgram :: String -> Parser Program
parseProgram String
sourceFile = do
String
source <- String -> Parser String
PP.preprocess String
sourceFile
String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
M.setInput String
source
()
_ <- ParsecT ParseErrorCustom String (StateT ParserState IO) ()
PU.sc
[Program]
components <- Parser Program
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [Program]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many (Parser Program
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [Program])
-> Parser Program
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) [Program]
forall a b. (a -> b) -> a -> b
$ [Parser Program] -> Parser Program
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice [Parser Program -> Parser Program
forall a.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser Program
parseTypeDefinition, Parser Program
parseExpr]
Program -> Parser Program
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> Parser Program) -> Program -> Parser Program
forall a b. (a -> b) -> a -> b
$ [(String, Expr)] -> [(String, Type)] -> String -> Program
AT.Program ((Program -> [(String, Expr)]) -> [Program] -> [(String, Expr)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Program -> [(String, Expr)]
AT.globals [Program]
components) ((Program -> [(String, Type)]) -> [Program] -> [(String, Type)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Program -> [(String, Type)]
AT.types [Program]
components) String
sourceFile
parseTypeDefinition :: PU.Parser AT.Program
parseTypeDefinition :: Parser Program
parseTypeDefinition = do
Type
type' <- Parser Type -> Parser Type
forall a.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
PU.lexeme Parser Type
PT.parseTypeDefinition
Program -> Parser Program
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> Parser Program) -> Program -> Parser Program
forall a b. (a -> b) -> a -> b
$ [(String, Expr)] -> [(String, Type)] -> String -> Program
AT.Program [] [Type -> (String, Type)
globalType Type
type'] String
""
parseExpr :: PU.Parser AT.Program
parseExpr :: Parser Program
parseExpr = do
Expr
expr <- Parser Expr
PE.parseExpr
Program -> Parser Program
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> Parser Program) -> Program -> Parser Program
forall a b. (a -> b) -> a -> b
$ [(String, Expr)] -> [(String, Type)] -> String -> Program
AT.Program [Expr -> (String, Expr)
globalExpr Expr
expr] [] String
""
globalExpr :: AT.Expr -> (String, AT.Expr)
globalExpr :: Expr -> (String, Expr)
globalExpr e :: Expr
e@(AT.Function {funcName :: Expr -> String
AT.funcName = String
name}) = (String
name, Expr
e)
globalExpr e :: Expr
e@(AT.ForeignFunction {funcName :: Expr -> String
AT.funcName = String
name}) = (String
name, Expr
e)
globalExpr e :: Expr
e@(AT.Declaration {declName :: Expr -> String
AT.declName = String
name}) = (String
name, Expr
e)
globalExpr e :: Expr
e@(AT.Assignment {assignTarget :: Expr -> Expr
AT.assignTarget = (AT.Var SrcLoc
_ String
name Type
_)}) = (String
name, Expr
e)
globalExpr Expr
e = String -> (String, Expr)
forall a. HasCallStack => String -> a
error (String -> (String, Expr)) -> String -> (String, Expr)
forall a b. (a -> b) -> a -> b
$ String
"invalid global expr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
e
globalType :: AT.Type -> (String, AT.Type)
globalType :: Type -> (String, Type)
globalType t :: Type
t@(AT.TStruct {structName :: Type -> String
AT.structName = String
name}) = (String
name, Type
t)
globalType t :: Type
t@(AT.TUnion {unionName :: Type -> String
AT.unionName = String
name}) = (String
name, Type
t)
globalType t :: Type
t@(AT.TTypedef String
name Type
_) = (String
name, Type
t)
globalType Type
t = String -> (String, Type)
forall a. HasCallStack => String -> a
error (String -> (String, Type)) -> String -> (String, Type)
forall a b. (a -> b) -> a -> b
$ String
"invalid global type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t