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
@@ -60,7 +67,7 @@ data Expr
   | UnOp UnOp Expr
   | Call Expr [Expr]
   | Index Expr Expr
-  | Member Expr Expr
+  | Member Expr Text
   | Cast Type Expr
   | Sizeof Type
   | StructInit Text [(Text, Expr)]
@@ -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

@@ -20,6 +20,7 @@ import qualified LLVM.AST.FloatingPointPredicate as FP
 
 import Control.Monad.State hiding (void)
 
+import Data.Text.Prettyprint.Doc (pretty)
 import Data.Text (Text, unpack)
 import Data.String.Conversions
 import Data.String
@@ -100,15 +101,15 @@ size VoidType = return 0
 
 
 -- CodeGen for LValues
-codegenLVal :: Expr -> IRBuilder Operand
+codegenLVal :: LVal -> IRBuilder Operand
-codegenLVal (Id name) = do
+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) (Id field)) = do
+codegenLVal (LMember (Id sName) field) = do
     ctx <- get
     case lookup sName (operands ctx) of
         Just ((Just (StructType op_type)), struct) -> do
@@ -117,7 +118,7 @@ codegenLVal (Member (Id sName) (Id field)) = do
             gep struct [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 (fromIntegral offset))]
         Nothing -> error $ "Struct " ++ show sName ++ " not found"
 
-codeGenLVal _ = error "Unimplemented or invalid LValue"
+codegenLVal e = error $ "Unimplemented or invalid LValue " ++ show (pretty e) ++ " (" ++ show e ++ ")"
 
 -- Given a struct and a field name, return the offset of the field in the struct.
 -- In LLVM each field is actually size 1
@@ -127,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
@@ -202,7 +203,7 @@ codegenExpr (Call (Id f) args) = do
 codegenExpr (Index arr idx)  = undefined -- TODO arrays
 
 -- Get the address of the struct field and load it
-codegenExpr (Member (Id sVarName) (Id field)) = do
+codegenExpr (Member (Id sVarName) field) = do
     ctx <- get
     case lookup sVarName (operands ctx) of
         Just ((Just (StructType op_type)), struct) -> do
@@ -216,6 +217,8 @@ codegenExpr (Cast t e) = undefined -- TODO casts
 
 codegenExpr (Sizeof t) = ConstantOperand . C.Int 32 . fromIntegral <$> size t
 
+codegenExpr e = error $ "Unimplemented or invalid Expression " ++ show (pretty e) ++ " (" ++ show e ++ ")"
+
 mkTerminator :: IRBuilder () -> IRBuilder ()
 mkTerminator instr = do
  check <- hasTerminator
@@ -284,13 +287,13 @@ 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
 codegenStmt (Var name _ Nothing) = return ()
 
-codegenStmt s = error $ "Unimplemented or invalid statement " ++ show s
+codegenStmt s = error $ "Unimplemented or invalid statement " ++ show (pretty s) ++ " (" ++ show s ++ ")"
 
 -- Generate code for a function
 -- First create the function, then allocate space for the arguments and locals

src/Windows12/Parser.hs

@@ -6,11 +6,18 @@ 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 =
-  [ [ InfixL $ Member <$ symbol ".",
+  [ [ Postfix $ do
-      InfixL $ (\l r -> Member (UnOp Deref l) r) <$ symbol "->"
+        _ <- symbol "."
+        field <- identifier
+        pure (\expr -> Member expr field),
+      Postfix $ do
+        _ <- symbol "->"
+        field <- identifier
+        pure (\expr -> Member (UnOp Deref expr) field)
     ],
     [ unary (UnOp Neg) "-",
       unary (UnOp Not) "!",
@@ -76,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"
@@ -98,7 +119,7 @@ typeP = do
 
 assignP :: Parser Stmt
 assignP = do
-  lhs <- exprP
+  lhs <- lvalP
   op <-
     AddAssign <$ symbol "+="
       <|> SubAssign <$ symbol "-="