Add array assignment to the IR

TODO

@@ -1,9 +1,3 @@
-# Intermediate code generation
-
-- To access named parameters inside a procedure, IR should be able to reference
-  them. During the generation the needed information (e.g. offsets or registers)
-  can be extracted from the symbol table and saved in the operands.
-
 # ELF generation
 
 - Don't ignore relocations where the symbol is not defined in the symbol table.
@@ -14,7 +8,3 @@
 - Each temporary variable gets a tn register where n is the variable index. If
   there more variables the allocation will fail with out of bounds runtime
   error. Implement spill over.
-
-# Language
-
-- Array support.

lib/Language/Elna/Backend/Allocator.hs

@@ -135,6 +135,10 @@ quadruple = \case
     AssignQuadruple operand1 variable -> do
         operand1' <- operand operand1
         AssignQuadruple operand1' <$> storeVariable variable
+    ArrayAssignQuadruple operand1 operand2 variable -> do
+        operand1' <- operand operand1
+        operand2' <- operand operand2
+        ArrayAssignQuadruple operand1' operand2' <$> storeVariable variable
 
 operand :: Operand Variable -> Allocator r (Operand (Store r))
 operand (IntOperand x) = pure $ IntOperand x

lib/Language/Elna/Backend/Intermediate.hs

@@ -50,8 +50,8 @@ data Quadruple v
     | DivisionQuadruple (Operand v) (Operand v) v
     | GoToQuadruple Label
     | AssignQuadruple (Operand v) v
-    {-| ArrayQuadruple Variable Operand Variable
+    {-| ArrayQuadruple Variable Operand Variable -}
-    | ArrayAssignQuadruple Operand Operand Variable -}
+    | ArrayAssignQuadruple (Operand v) (Operand v) v
     | LessOrEqualQuadruple (Operand v) (Operand v) Label
     | GreaterOrEqualQuadruple (Operand v) (Operand v) Label
     | GreaterQuadruple (Operand v) (Operand v) Label

lib/Language/Elna/Frontend/AST.hs

@@ -176,16 +176,16 @@ instance Show Expression
     show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs]
     show (VariableExpression variable) = show variable
 
-newtype VariableAccess
+data VariableAccess
     = VariableAccess Identifier
-    -- | ArrayAccess VariableAccess Expression
+    | ArrayAccess VariableAccess Expression
     deriving Eq
 
 instance Show VariableAccess
   where
     show (VariableAccess variableName) = show variableName
-    {- show (ArrayAccess arrayAccess elementIndex) =
+    show (ArrayAccess arrayAccess elementIndex) =
-        concat [show arrayAccess, "[", show elementIndex, "]"] -}
+        concat [show arrayAccess, "[", show elementIndex, "]"]
 
 data Condition
     = EqualCondition Expression Expression

lib/Language/Elna/Frontend/NameAnalysis.hs

@@ -202,18 +202,6 @@ condition globalTable (AST.GreaterOrEqualCondition lhs rhs)
 variableAccess :: SymbolTable -> AST.VariableAccess -> NameAnalysis ()
 variableAccess globalTable (AST.VariableAccess identifier) =
     checkSymbol globalTable identifier
-{- variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression)
+variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression)
     = variableAccess globalTable arrayExpression
     >> expression globalTable indexExpression
-
-enter :: Identifier -> Info -> SymbolTable -> NameAnalysis SymbolTable
-enter identifier info table
-    = maybe (identifierAlreadyDefinedError identifier) pure
-    $ SymbolTable.enter identifier info table
-
-identifierAlreadyDefinedError :: Identifier -> NameAnalysis a
-identifierAlreadyDefinedError = NameAnalysis
-    . lift
-    . throwE
-    . IdentifierAlreadyDefinedError
--}

lib/Language/Elna/Frontend/Parser.hs

@@ -93,10 +93,10 @@ expressionP :: Parser Expression
 expressionP = makeExprParser termP operatorTable
 
 variableAccessP :: Parser VariableAccess
-variableAccessP = VariableAccess <$> identifierP {- do
+variableAccessP = do
     identifier <- identifierP
     indices <- many $ bracketsP expressionP
-    pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices -}
+    pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices
 
 conditionP :: Parser Condition
 conditionP = do

lib/Language/Elna/Frontend/TypeAnalysis.hs

@@ -11,7 +11,7 @@ import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT, ask, asks)
 import Data.Foldable (traverse_)
 import qualified Data.Vector as Vector
 import qualified Language.Elna.Frontend.AST as AST
-import Language.Elna.Frontend.SymbolTable (Info(..), {-ParameterInfo(..), -}SymbolTable)
+import Language.Elna.Frontend.SymbolTable (Info(..), ParameterInfo(..), SymbolTable)
 import qualified Language.Elna.Frontend.SymbolTable as SymbolTable
 import Language.Elna.Frontend.Types (Type(..), booleanType, intType)
 import Language.Elna.Location (Identifier(..))
@@ -31,11 +31,10 @@ data Error
     | ArithmeticExpressionError Type
     | ComparisonExpressionError Type Type
     | InvalidConditionTypeError Type
-{-    | InvalidAssignmentError Type
+    {- | ExpectedLvalueError AST.Expression
-    | ExpectedLvalueError AST.Expression
+    | ArgumentTypeMismatchError Type Type -}
-    | ArgumentTypeMismatchError Type Type
     | ArrayIndexError Type
-    | ArrayAccessError Type -}
+    | ArrayAccessError Type
     deriving Eq
 
 instance Show Error
@@ -56,6 +55,10 @@ instance Show Error
         <> show lhs <> "\" and \"" <> show rhs <> "\""
     show (InvalidConditionTypeError got) =
         "Expected a condition to be a boolean, got: " <> show got
+    show (ArrayIndexError got) =
+        "Expected an array index expression to be an integer, got: " <> show got
+    show (ArrayAccessError got) =
+        "Expected to encounter an array, got: " <> show got
 
 newtype TypeAnalysis a = TypeAnalysis
     { runTypeAnalysis :: ReaderT SymbolTable (Except Error) a
@@ -127,7 +130,7 @@ statement globalTable = \case
             Nothing -> TypeAnalysis $ lift $ throwE
                 $ UndefinedSymbolError procedureName
   where
-    checkArgument SymbolTable.ParameterInfo{} _argument = pure () {-
+    checkArgument ParameterInfo{} _argument = pure () {-
         argumentType <- expression globalTable argument
         unless (argumentType == type')
             $ TypeAnalysis $ lift $ throwE $ ArgumentTypeMismatchError type' argumentType
@@ -145,7 +148,7 @@ variableAccess globalTable (AST.VariableAccess identifier) = do
             $ UnexpectedVariableInfoError anotherInfo
         Nothing -> TypeAnalysis $ lift $ throwE
             $ UndefinedSymbolError identifier
-{-variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression) = do
+variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression) = do
         arrayType <- variableAccess globalTable arrayExpression
         indexType <- expression globalTable indexExpression
         unless (indexType == intType)
@@ -154,7 +157,7 @@ variableAccess globalTable (AST.VariableAccess identifier) = do
             ArrayType _ baseType -> pure baseType
             nonArrayType -> TypeAnalysis $ lift $ throwE
                 $ ArrayAccessError nonArrayType
--}
+
 expression :: SymbolTable -> AST.Expression -> TypeAnalysis Type
 expression globalTable = \case
     AST.VariableExpression variableExpression ->

lib/Language/Elna/Glue.hs

@@ -230,27 +230,30 @@ variableAccess
     -> Glue (AST.Identifier, Maybe (Operand Variable), Vector (Quadruple Variable))
 variableAccess _ (AST.VariableAccess identifier) accumulatedIndex _ accumulatedStatements =
     pure (identifier, accumulatedIndex, accumulatedStatements)
-{- variableAccess localTable (AST.ArrayAccess access1 index1) Nothing (ArrayType _ baseType) _ = do
+variableAccess localTable accessKind accumulatedIndex arrayType statements
-    (indexPlace, statements) <- expression localTable index1
+    | (AST.ArrayAccess access1 index1) <- accessKind
-    variableAccess localTable access1 (Just indexPlace) baseType statements
+    , (ArrayType arraySize baseType) <- arrayType = do
-variableAccess localTable (AST.ArrayAccess arrayAccess' arrayIndex) (Just baseIndex) (ArrayType arraySize baseType) statements = do
+        (indexPlace, statements') <- expression localTable index1
-    (indexPlace, statements') <- expression localTable arrayIndex
+        case accumulatedIndex  of
-    resultVariable <- createTemporary
+            Just baseIndex -> do
-    let resultOperand = VariableOperand resultVariable
+                resultVariable <- createTemporary
-        indexCalculation = Vector.fromList
+                let resultOperand = VariableOperand resultVariable
-            [ ProductQuadruple (IntOperand $ fromIntegral arraySize) baseIndex resultVariable
+                    indexCalculation = Vector.fromList
-            , AddQuadruple indexPlace resultOperand resultVariable
+                        [ ProductQuadruple (IntOperand $ fromIntegral arraySize) baseIndex resultVariable
-            ]
+                        , AddQuadruple indexPlace resultOperand resultVariable
-     in variableAccess localTable arrayAccess' (Just resultOperand) baseType
+                        ]
-        $ statements <> indexCalculation <> statements'
+                 in variableAccess localTable access1 (Just resultOperand) baseType
+                    $ statements <> indexCalculation <> statements'
+            Nothing ->
+                variableAccess localTable access1 (Just indexPlace) baseType statements'
 variableAccess _ _ _ _ _ = error "Array access operator doesn't match the type."
--}
+
 variableType :: AST.VariableAccess -> SymbolTable -> Type
 variableType (AST.VariableAccess identifier) symbolTable
     | Just (TypeInfo type') <- SymbolTable.lookup identifier symbolTable = type'
     | otherwise = error "Undefined type."
-{-variableType (AST.ArrayAccess arrayAccess' _) symbolTable =
+variableType (AST.ArrayAccess arrayAccess' _) symbolTable =
-    variableType arrayAccess' symbolTable -}
+    variableType arrayAccess' symbolTable
 
 expression :: SymbolTable -> AST.Expression -> Glue (Operand Variable, Vector (Quadruple Variable))
 expression localTable = \case

lib/Language/Elna/RiscV/CodeGenerator.hs

@@ -259,6 +259,42 @@ quadruple _ (AssignQuadruple operand1 store)
                 $ RiscV.BaseInstruction RiscV.OpImm
                 $ RiscV.I storeRegister RiscV.ADDI operandRegister1 0
          in pure $ statements1 <> Vector.cons instruction storeStatements 
+quadruple _ (ArrayAssignQuadruple assigneeOperand indexOperand store)
+    | IntOperand immediateAssigneeOperand <- assigneeOperand =
+        let (storeRegister, storeStatements) = storeWithOffset store indexOperand
+         in pure $ lui immediateAssigneeOperand storeRegister <> storeStatements
+    | VariableOperand variableAssigneeOperand <- assigneeOperand =
+        let (assigneeOperandRegister, assigneeStatements) = loadFromStore variableAssigneeOperand
+            (storeRegister, storeStatements) = storeWithOffset store indexOperand
+            instruction = Instruction
+                $ RiscV.BaseInstruction RiscV.OpImm
+                $ RiscV.I storeRegister RiscV.ADDI assigneeOperandRegister 0
+         in pure $ assigneeStatements <> Vector.cons instruction storeStatements 
+  where
+    storeWithOffset :: RiscVStore -> Operand RiscVStore -> (RiscV.XRegister, Vector Statement)
+    storeWithOffset (RegisterStore register) _ = (register, mempty)
+    storeWithOffset (StackStore offset register) (IntOperand indexOffset) =
+        let storeInstruction = Instruction
+                $ RiscV.BaseInstruction RiscV.Store
+                $ RiscV.S (fromIntegral $ offset + indexOffset) RiscV.SW RiscV.S0 register
+        in (register, Vector.singleton storeInstruction)
+    storeWithOffset (StackStore offset register) (VariableOperand indexOffset) =
+        let baseRegisterInstruction = Instruction
+                $ RiscV.BaseInstruction RiscV.OpImm
+                $ RiscV.I immediateRegister RiscV.ADDI RiscV.S0 0
+            (indexRegister, indexStatements) = loadFromStore indexOffset
+            registerWithOffset = Instruction
+                $ RiscV.BaseInstruction RiscV.OpImm
+                $ RiscV.I immediateRegister RiscV.ADDI indexRegister 0
+            storeInstruction = Instruction
+                $ RiscV.BaseInstruction RiscV.Store
+                $ RiscV.S (fromIntegral offset) RiscV.SW immediateRegister register
+            statements = Vector.fromList
+                [ baseRegisterInstruction
+                , registerWithOffset
+                , storeInstruction
+                ]
+        in (register, indexStatements <> statements)
 
 unconditionalJal :: Label -> Statement
 unconditionalJal (Label goToLabel) = Instruction

tests/vm/array_element_assignment.elna

@@ -0,0 +1,3 @@
+proc main() {
+  var a: array[1] of int;
+}