Fixed Parser issues and simplified AST

src/Windows12/Parser.hs

@@ -2,55 +2,62 @@
 
 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 "]")
+      InfixL $ (\l r -> Member (UnOp Deref l) r) <$ symbol "->"
     ],
-    [ Prefix (UnOp Neg <$ symbol "-"),
-      Prefix (UnOp Not <$ symbol "!"),
-      Prefix (UnOp BitNot <$ symbol "~"),
-      Prefix (UnOp Deref <$ symbol "*"),
-      Prefix (UnOp AddrOf <$ symbol "&")
+    [ unary (UnOp Neg) "-",
+      unary (UnOp Not) "!",
+      unary (UnOp BitNot) "~",
+      unary (UnOp Deref) "*",
+      unary (UnOp AddrOf) "&"
     ],
-    [ InfixL (BinOp Mul <$ symbol "*"),
-      InfixL (BinOp Div <$ symbol "/"),
-      InfixL (BinOp Mod <$ symbol "%")
+    [ Postfix $ flip Index <$> (symbol "[" *> exprP <* symbol "]")
     ],
-    [ InfixL (BinOp Add <$ symbol "+"),
-      InfixL (BinOp Sub <$ symbol "-")
+    [ Postfix $ flip Call <$> parens (sepBy exprP (symbol ","))
     ],
-    [ InfixL (BinOp ShiftL <$ symbol "<<"),
-      InfixL (BinOp ShiftR <$ symbol ">>")
+    [ infixL' Mul "*",
+      infixL' Div "/",
+      infixL' Mod "%"
     ],
-    [ InfixL (BinOp Lt <$ symbol "<"),
-      InfixL (BinOp Gt <$ symbol ">"),
-      InfixL (BinOp Le <$ symbol "<="),
-      InfixL (BinOp Ge <$ symbol ">=")
+    [ infixL' Add "+",
+      infixL' Sub "-"
     ],
-    [ InfixL (BinOp Eq <$ symbol "=="),
-      InfixL (BinOp Ne <$ symbol "!=")
+    [ infixL' ShiftL "<<",
+      infixL' ShiftR ">>"
     ],
-    [ InfixL (BinOp BitAnd <$ symbol "&")
+    [ infixL Le "<=",
+      infixL Lt "<",
+      infixL Ge ">=",
+      infixL Gt ">"
     ],
-    [ InfixL (BinOp BitXor <$ symbol "^")
+    [ infixL Eq "==",
+      infixL Ne "!="
     ],
-    [ InfixL (BinOp BitOr <$ symbol "|")
+    [ infixL' BitAnd "&"
     ],
-    [ InfixL (BinOp And <$ symbol "&&")
+    [ infixL' BitXor "^"
     ],
-    [ InfixL (BinOp Or <$ symbol "||")
+    [ infixL' BitOr "|"
+    ],
+    [ infixL And "&&"
+    ],
+    [ infixL Or "||"
     ]
   ]
+  where
+    unary op sym = Prefix $ foldr1 (.) <$> some (op <$ symbol sym)
+    infixL op sym = InfixL $ BinOp op <$ symbol sym
+    infixL' op sym = InfixL $ BinOp op <$ operator sym
+    infixR op sym = InfixR $ BinOp op <$ symbol sym
+    operator sym = lexeme $ try $ (symbol sym <* notFollowedBy opChar)
+    opChar = oneOf ("+-*/%<>&|^=!~" :: [Char])
 
 termP :: Parser Expr
 termP =
@@ -62,8 +69,7 @@ termP =
     <|> 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 (Cast <$> (parens typeP) <*> termP)
     <|> try (StructInit <$> identifier <*> braces (sepEndBy1 ((,) <$> identifier <* symbol ":" <*> exprP) (symbol ",")))
     <|> Id <$> identifier
 
@@ -90,21 +96,32 @@ typeP = do
       <|> StructType <$> identifier
   foldr (const PtrType) t <$> many (symbol "*")
 
+assignP :: Parser Stmt
+assignP = do
+  lhs <- exprP
+  op <-
+    AddAssign <$ symbol "+="
+      <|> SubAssign <$ symbol "-="
+      <|> MulAssign <$ symbol "*="
+      <|> DivAssign <$ symbol "/="
+      <|> ModAssign <$ symbol "%="
+      <|> BitAndAssign <$ symbol "&="
+      <|> BitOrAssign <$ symbol "|="
+      <|> BitXorAssign <$ symbol "^="
+      <|> ShiftLAssign <$ symbol "<<="
+      <|> ShiftRAssign <$ symbol ">>="
+      <|> BaseAssign <$ symbol "="
+  Assign op lhs <$> exprP <* 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)
+    <|> (If <$> (reserved "if" *> exprP) <*> braces (many stmtP) <*> optional (reserved "else" *> braces (many stmtP)))
+    <|> (While <$> (reserved "while" *> parens exprP) <*> braces (many stmtP))
+    <|> (Var <$> (reserved "var" *> identifier) <*> optional (symbol ":" *> typeP) <*> optional (symbol "=" *> exprP) <* symbol ";")
+    <|> try assignP
+    <|> Expr <$> exprP <* symbol ";"
+    <|> Block <$> braces (many stmtP)
 
 funcP :: Parser TLFunc
 funcP = do
@@ -122,7 +139,7 @@ enumP = do
   fields <- braces (sepEndBy1 identifier (symbol ","))
   return $ Enum name fields
 
-memberFuncP :: Parser TLMemberFunc
+memberFuncP :: Parser TLFunc
 memberFuncP = do
   reserved "fn"
   reserved "on"
@@ -131,17 +148,16 @@ memberFuncP = do
   args <- parens (sepBy (Bind <$> identifier <* symbol ":" <*> typeP) (symbol ","))
   retType <- (symbol "->" *> typeP) <|> pure VoidType
   body <- braces (many stmtP)
-  return $ MemberFunc self name args retType body
+  return $ Func name (Bind "self" self : args) retType body
 
 organize :: [TL] -> Program
-organize tls = Program structs enums funcs memberFuncs
+organize tls = Program structs enums funcs
   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)
+  tls <- many (TLStruct <$> structP <|> TLEnum <$> enumP <|> try (TLFunc <$> memberFuncP) <|> TLFunc <$> funcP)
   return $ organize tls