Add LVal to AST

src/QuickCheckTests.hs

@@ -35,6 +35,14 @@ instance Arbitrary AssignOp where
   arbitrary = elements [BaseAssign, AddAssign, SubAssign, MulAssign, DivAssign,
     ModAssign, BitAndAssign, BitOrAssign, BitXorAssign, ShiftLAssign, ShiftRAssign]
 
+instance Arbitrary LVal where
+  arbitrary = oneof
+    [ LId <$> arbitrary
+    , LIndex <$> arbitrary <*> arbitrary
+    , LDeref <$> arbitrary
+    , LMember <$> arbitrary <*> arbitrary
+    ]
+
 instance Arbitrary Expr where
   arbitrary = oneof
     [ Id <$> arbitrary

src/Windows12/Ast.hs

@@ -48,6 +48,13 @@ data AssignOp
   | ShiftRAssign
   deriving (Show, Eq)
 
+data LVal
+  = LId Text
+  | LIndex Expr Expr
+  | LDeref Expr
+  | LMember Expr Text
+  deriving (Show, Eq)
+
 data Expr
   = Id Text
   | IntLit Int
@@ -71,7 +78,7 @@ data Stmt
   | Return Expr
   | If Expr [Stmt] (Maybe [Stmt])
   | While Expr [Stmt]
-  | Assign AssignOp Expr Expr
+  | Assign AssignOp LVal Expr
   | Block [Stmt]
   | Var Text (Maybe Type) (Maybe Expr)
   deriving (Show, Eq)
@@ -149,6 +156,12 @@ instance Pretty AssignOp where
   pretty ShiftLAssign = "<<="
   pretty ShiftRAssign = ">>="
 
+instance Pretty LVal where
+  pretty (LId x) = pretty (Id x)
+  pretty (LIndex arr idx) = pretty (Index arr idx)
+  pretty (LDeref e) = pretty (UnOp Deref e)
+  pretty (LMember e m) = pretty (Member e m)
+
 instance Pretty Expr where
   pretty (Id x) = pretty x
   pretty (IntLit x) = pretty x

src/Windows12/CodeGen.hs

@@ -101,15 +101,15 @@ size VoidType = return 0
 
 
 -- CodeGen for LValues
-codegenLVal :: Expr -> IRBuilder Operand
-codegenLVal (Id name) = do
+codegenLVal :: LVal -> IRBuilder Operand
+codegenLVal (LId name) = do
   ctx <- get
   case lookup name (operands ctx) of
     Just (_type, op) -> return op
     Nothing -> error $ "Variable " ++ show name ++ " not found"
 
 -- TODO support members of members
-codegenLVal (Member (Id sName) field) = do
+codegenLVal (LMember (Id sName) field) = do
     ctx <- get
     case lookup sName (operands ctx) of
         Just ((Just (StructType op_type)), struct) -> do
@@ -128,7 +128,7 @@ structFieldOffset (Struct name fields) field = do
 
 -- CodeGen for expressions
 codegenExpr :: Expr -> IRBuilder Operand
-codegenExpr (Id name) = flip load 0 =<< codegenLVal (Id name)
+codegenExpr (Id name) = flip load 0 =<< codegenLVal (LId name) -- TODO (?)
 codegenExpr (IntLit i) = return $ ConstantOperand (C.Int 32 (fromIntegral i))
 codegenExpr (UIntLit i) = return $ ConstantOperand (C.Int 32 (fromIntegral i))
 codegenExpr (FloatLit f) = undefined -- TODO floats
@@ -287,7 +287,7 @@ codegenStmt (Assign SubAssign l e) = do
 codegenStmt (Block stmts) = mapM_ codegenStmt stmts
 
 -- Since the vars are already allocated by genBody, we just need to assign the value
-codegenStmt (Var name t (Just e)) = codegenStmt (Assign BaseAssign (Id name) e)
+codegenStmt (Var name t (Just e)) = codegenStmt (Assign BaseAssign (LId name) e) -- TODO (?)
 
 -- Do nothing with variable declaration if no expression is given
 -- This is because allocation is done already

src/Windows12/Parser.hs

@@ -6,6 +6,7 @@ import Control.Monad.Combinators.Expr
 import Text.Megaparsec
 import Windows12.Ast
 import Windows12.Lexer
+import Data.Text.Prettyprint.Doc (pretty)
 
 opTable :: [[Operator Parser Expr]]
 opTable =
@@ -82,6 +83,20 @@ termP =
 exprP :: Parser Expr
 exprP = makeExprParser termP opTable
 
+exprToLVal :: Expr -> Maybe LVal
+exprToLVal (Id x) = Just (LId x)
+exprToLVal (Index arr idx) = Just (LIndex arr idx)
+exprToLVal (UnOp Deref e) = Just (LDeref e)
+exprToLVal (Member e m) = Just (LMember e m)
+exprToLVal _ = Nothing
+
+lvalP :: Parser LVal
+lvalP = do
+  e <- exprP
+  case exprToLVal e of
+    Just lv -> pure lv
+    Nothing -> fail $ "Invalid l-value: " ++ show (pretty e) ++ " (" ++ show e ++ ")"
+
 structP :: Parser TLStruct
 structP = do
   reserved "struct"
@@ -104,7 +119,7 @@ typeP = do
 
 assignP :: Parser Stmt
 assignP = do
-  lhs <- exprP
+  lhs <- lvalP
   op <-
     AddAssign <$ symbol "+="
       <|> SubAssign <$ symbol "-="