Implemented Basic Parser

src/Windows12/Parser.hs

@@ -0,0 +1,147 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Windows12.Parser (programP) where
+
+import Control.Monad (void)
+import Control.Monad.Combinators.Expr
+import Data.Text (Text)
+import Text.Megaparsec
+import Windows12.Ast
+import Windows12.Ast (Expr (UnOp))
+import Windows12.Lexer
+
+opTable :: [[Operator Parser Expr]]
+opTable =
+  [ [ InfixL $ Member <$ symbol ".",
+      InfixL $ (\l r -> Member (UnOp Deref l) r) <$ symbol "->",
+      Postfix $ Index <$> (symbol "[" *> exprP <* symbol "]")
+    ],
+    [ Prefix (UnOp Neg <$ symbol "-"),
+      Prefix (UnOp Not <$ symbol "!"),
+      Prefix (UnOp BitNot <$ symbol "~"),
+      Prefix (UnOp Deref <$ symbol "*"),
+      Prefix (UnOp AddrOf <$ symbol "&")
+    ],
+    [ InfixL (BinOp Mul <$ symbol "*"),
+      InfixL (BinOp Div <$ symbol "/"),
+      InfixL (BinOp Mod <$ symbol "%")
+    ],
+    [ InfixL (BinOp Add <$ symbol "+"),
+      InfixL (BinOp Sub <$ symbol "-")
+    ],
+    [ InfixL (BinOp ShiftL <$ symbol "<<"),
+      InfixL (BinOp ShiftR <$ symbol ">>")
+    ],
+    [ InfixL (BinOp Lt <$ symbol "<"),
+      InfixL (BinOp Gt <$ symbol ">"),
+      InfixL (BinOp Le <$ symbol "<="),
+      InfixL (BinOp Ge <$ symbol ">=")
+    ],
+    [ InfixL (BinOp Eq <$ symbol "=="),
+      InfixL (BinOp Ne <$ symbol "!=")
+    ],
+    [ InfixL (BinOp BitAnd <$ symbol "&")
+    ],
+    [ InfixL (BinOp BitXor <$ symbol "^")
+    ],
+    [ InfixL (BinOp BitOr <$ symbol "|")
+    ],
+    [ InfixL (BinOp And <$ symbol "&&")
+    ],
+    [ InfixL (BinOp Or <$ symbol "||")
+    ]
+  ]
+
+termP :: Parser Expr
+termP =
+  parens exprP
+    <|> IntLit <$> intLiteral
+    <|> UIntLit <$> uintLiteral
+    <|> try (FloatLit <$> floatLiteral)
+    <|> StrLit <$> stringLiteral
+    <|> BoolLit <$> (reserved "true" *> pure True <|> reserved "false" *> pure False)
+    <|> CharLit <$> charLiteral
+    <|> try (Sizeof <$> (reserved "sizeof" *> typeP))
+    <|> try (Cast <$> (reserved "cast" *> typeP) <*> parens exprP)
+    <|> try (Call <$> identifier <*> parens (sepBy exprP (symbol ",")))
+    <|> try (StructInit <$> identifier <*> braces (sepEndBy1 ((,) <$> identifier <* symbol ":" <*> exprP) (symbol ",")))
+    <|> Id <$> identifier
+
+exprP :: Parser Expr
+exprP = makeExprParser termP opTable
+
+structP :: Parser TLStruct
+structP = do
+  reserved "struct"
+  name <- identifier
+  fields <- braces (sepEndBy (Bind <$> identifier <* symbol ":" <*> typeP) (symbol ","))
+  return $ Struct name fields
+
+typeP :: Parser Type
+typeP = do
+  t <-
+    ArrayType <$> (brackets typeP)
+      <|> IntType <$ reserved "int"
+      <|> UIntType <$ reserved "uint"
+      <|> FloatType <$ reserved "float"
+      <|> StrType <$ reserved "str"
+      <|> BoolType <$ reserved "bool"
+      <|> CharType <$ reserved "char"
+      <|> StructType <$> identifier
+  foldr (const PtrType) t <$> many (symbol "*")
+
+stmtP :: Parser Stmt
+stmtP =
+  Return <$> (reserved "return" *> exprP <* symbol ";")
+    <|> (If <$> (reserved "if" *> parens exprP) <*> stmtP <*> optional (reserved "else" *> stmtP))
+    <|> (While <$> (reserved "while" *> parens exprP) <*> stmtP)
+    <|> ( For
+            <$> (reserved "for" *> symbol "(" *> optional stmtP <* symbol ";")
+            <*> (optional exprP <* symbol ";")
+            <*> (optional exprP <* symbol ")")
+            <*> stmtP
+        )
+    <|> (Var <$> (reserved "var" *> (Bind <$> identifier <* symbol ":" <*> typeP)) <* symbol "=" <*> exprP <* symbol ";")
+    <|> (Assign <$> exprP <* symbol "=" <*> exprP <* symbol ";")
+
+-- <|> Block <$> braces (many stmtP)
+
+funcP :: Parser TLFunc
+funcP = do
+  reserved "fn"
+  name <- identifier
+  args <- parens (sepBy (Bind <$> identifier <* symbol ":" <*> typeP) (symbol ","))
+  retType <- (symbol "->" *> typeP) <|> pure VoidType
+  body <- braces (many stmtP)
+  return $ Func name args retType body
+
+enumP :: Parser TLEnum
+enumP = do
+  reserved "enum"
+  name <- identifier
+  fields <- braces (sepEndBy1 identifier (symbol ","))
+  return $ Enum name fields
+
+memberFuncP :: Parser TLMemberFunc
+memberFuncP = do
+  reserved "fn"
+  reserved "on"
+  self <- typeP
+  name <- identifier
+  args <- parens (sepBy (Bind <$> identifier <* symbol ":" <*> typeP) (symbol ","))
+  retType <- (symbol "->" *> typeP) <|> pure VoidType
+  body <- braces (many stmtP)
+  return $ MemberFunc self name args retType body
+
+organize :: [TL] -> Program
+organize tls = Program structs enums funcs memberFuncs
+  where
+    structs = [s | TLStruct s <- tls]
+    enums = [e | TLEnum e <- tls]
+    funcs = [f | TLFunc f <- tls]
+    memberFuncs = [mf | TLMemberFunc mf <- tls]
+
+programP :: Parser Program
+programP = between sc eof $ do
+  tls <- many (TLStruct <$> structP <|> TLEnum <$> enumP <|> TLMemberFunc <$> memberFuncP <|> TLFunc <$> funcP)
+  return $ organize tls