Map local variables in IR to their original names

TODO

@@ -3,10 +3,6 @@
 - 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.
-- Glue always generates the same intermediate variable (LocalVariable 0) for
-  local variables. (LocalVariable 0) is handled the same as temporary variables
-  that are currently saved only in registers. There space on the stack allocated
-  for local variables.
 
 # ELF generation
 

lib/Language/Elna/Backend/Allocator.hs

@@ -5,11 +5,19 @@ module Language.Elna.Backend.Allocator
     ) where
 
 import Data.HashMap.Strict (HashMap)
+import Data.Word (Word32)
 import Data.Vector (Vector)
-import Language.Elna.Backend.Intermediate (Operand(..), Quadruple(..), Variable(..))
+import Language.Elna.Backend.Intermediate
+    ( ProcedureQuadruples(..)
+    , Operand(..)
+    , Quadruple(..)
+    , Variable(..)
+    )
 import Language.Elna.Location (Identifier(..))
 
-newtype Store r = Store r
+data Store r
+    = RegisterStore r
+    | StackStore Word32 r
 
 newtype MachineConfiguration r = MachineConfiguration
     { temporaryRegisters :: [r]
@@ -19,60 +27,57 @@ allocate
     :: forall r
     . MachineConfiguration r
     -> HashMap Identifier (Vector (Quadruple Variable))
-    -> HashMap Identifier (Vector (Quadruple (Store r)))
+    -> HashMap Identifier (ProcedureQuadruples (Store r))
 allocate MachineConfiguration{..} = fmap function
   where
-    function :: Vector (Quadruple Variable) -> Vector (Quadruple (Store r))
+    function :: Vector (Quadruple Variable) -> ProcedureQuadruples (Store r)
-    function = fmap quadruple
+    function quadruples' = ProcedureQuadruples
+        { quadruples = quadruple <$> quadruples'
+        , stackSize = 0
+        }
     quadruple :: Quadruple Variable -> Quadruple (Store r)
-    quadruple StartQuadruple = StartQuadruple
+    quadruple = \case
-    quadruple StopQuadruple = StopQuadruple
+        StartQuadruple -> StartQuadruple
-    quadruple (ParameterQuadruple operand1) =
+        StopQuadruple -> StopQuadruple
+        ParameterQuadruple operand1 ->
             ParameterQuadruple (operand operand1)
-    quadruple (CallQuadruple name count) = CallQuadruple name count
+        CallQuadruple name count -> CallQuadruple name count
-    quadruple (AddQuadruple operand1 operand2 variable)
+        AddQuadruple operand1 operand2 variable
-        = AddQuadruple (operand operand1) (operand operand2)
+            -> AddQuadruple (operand operand1) (operand operand2)
             $ storeVariable variable
-    quadruple (SubtractionQuadruple operand1 operand2 variable)
+        SubtractionQuadruple operand1 operand2 variable
-        = SubtractionQuadruple (operand operand1) (operand operand2)
+            -> SubtractionQuadruple (operand operand1) (operand operand2)
             $ storeVariable variable
-    quadruple (NegationQuadruple operand1 variable)
+        NegationQuadruple operand1 variable
-        = NegationQuadruple (operand operand1)
+            -> NegationQuadruple (operand operand1)
             $ storeVariable variable
-    quadruple (ProductQuadruple operand1 operand2 variable)
+        ProductQuadruple operand1 operand2 variable
-        = ProductQuadruple (operand operand1) (operand operand2)
+            -> ProductQuadruple (operand operand1) (operand operand2)
             $ storeVariable variable
-    quadruple (DivisionQuadruple operand1 operand2 variable)
+        DivisionQuadruple operand1 operand2 variable
-        = DivisionQuadruple (operand operand1) (operand operand2)
+            -> DivisionQuadruple (operand operand1) (operand operand2)
             $ storeVariable variable
-    quadruple (LabelQuadruple label) = LabelQuadruple label
+        LabelQuadruple label -> LabelQuadruple label
-    quadruple (GoToQuadruple label) = GoToQuadruple label
+        GoToQuadruple label -> GoToQuadruple label
-    quadruple (EqualQuadruple operand1 operand2 goToLabel) =
+        EqualQuadruple operand1 operand2 goToLabel ->
             EqualQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (NonEqualQuadruple operand1 operand2 goToLabel) =
+        NonEqualQuadruple operand1 operand2 goToLabel ->
             NonEqualQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (LessQuadruple operand1 operand2 goToLabel) =
+        LessQuadruple operand1 operand2 goToLabel ->
             LessQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (GreaterQuadruple operand1 operand2 goToLabel) =
+        GreaterQuadruple operand1 operand2 goToLabel ->
             GreaterQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) =
+        LessOrEqualQuadruple operand1 operand2 goToLabel ->
             LessOrEqualQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) =
+        GreaterOrEqualQuadruple operand1 operand2 goToLabel ->
             GreaterOrEqualQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (AssignQuadruple operand1 variable)
+        AssignQuadruple operand1 variable ->
-        = AssignQuadruple (operand operand1)
+            AssignQuadruple (operand operand1) $ storeVariable variable
-        $ storeVariable variable
     operand :: Operand Variable -> Operand (Store r)
     operand (IntOperand x) = IntOperand x
-    operand (VariableOperand (TempVariable index))
+    operand (VariableOperand variableOperand) =
-        = VariableOperand
+        VariableOperand $ storeVariable variableOperand
-        $ Store
+    storeVariable (TempVariable index) = RegisterStore
         $ temporaryRegisters !! fromIntegral index
-    operand (VariableOperand (LocalVariable index))
+    storeVariable (LocalVariable index) = RegisterStore
-        = VariableOperand
+        $ temporaryRegisters !! pred (length temporaryRegisters - fromIntegral index)
-        $ Store
-        $ temporaryRegisters !! fromIntegral index
-    storeVariable (TempVariable index) =
-        Store $ temporaryRegisters !! fromIntegral index
-    storeVariable (LocalVariable index) =
-        Store $ temporaryRegisters !! fromIntegral index

lib/Language/Elna/Backend/Intermediate.hs

@@ -1,11 +1,13 @@
 module Language.Elna.Backend.Intermediate
-    ( Operand(..)
+    ( ProcedureQuadruples(..)
+    , Operand(..)
     , Quadruple(..)
     , Label(..)
     , Variable(..)
     ) where
 
 import Data.Int (Int32)
+import Data.Vector (Vector)
 import Data.Word (Word32)
 import Data.Text (Text)
 import qualified Data.Text as Text
@@ -30,6 +32,11 @@ data Operand v
     | VariableOperand v
     deriving (Eq, Show)
 
+data ProcedureQuadruples v = ProcedureQuadruples
+    { quadruples :: Vector (Quadruple v)
+    , stackSize :: Word32
+    } deriving (Eq, Show)
+
 data Quadruple v
     = StartQuadruple
     | StopQuadruple

lib/Language/Elna/Glue.hs

@@ -4,7 +4,7 @@ module Language.Elna.Glue
 
 import Control.Monad.Trans.State (State, gets, modify', runState)
 import Data.Bifunctor (Bifunctor(..))
-import Data.Foldable (Foldable(..))
+import Data.Foldable (Foldable(..), traverse_)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (catMaybes)
@@ -25,10 +25,12 @@ import Language.Elna.Backend.Intermediate
 import Language.Elna.Frontend.SymbolTable (Info(..), SymbolTable)
 import qualified Language.Elna.Frontend.SymbolTable as SymbolTable
 import GHC.Records (HasField(..))
+import Language.Elna.Frontend.AST (Identifier(..))
 
 data Paste = Paste
     { temporaryCounter :: Word32
     , labelCounter :: Word32
+    , localMap :: HashMap Identifier Variable
     }
 
 newtype Glue a = Glue
@@ -47,31 +49,46 @@ instance Monad Glue
   where
     (Glue x) >>= f = Glue $ x >>= (runGlue . f)
 
-glue :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector (Quadruple Variable))
+glue :: SymbolTable -> AST.Program -> HashMap Identifier (Vector (Quadruple Variable))
 glue globalTable
     = fst
-    . flip runState Paste{ temporaryCounter = 0, labelCounter = 0 }
+    . flip runState emptyPaste
     . runGlue
     . program globalTable
+  where
+    emptyPaste = Paste
+        { temporaryCounter = 0
+        , labelCounter = 0
+        , localMap = mempty
+        }
 
-program
+program :: SymbolTable -> AST.Program -> Glue (HashMap Identifier (Vector (Quadruple Variable)))
-    :: SymbolTable
+program globalTable (AST.Program declarations)
-    -> AST.Program
+    = HashMap.fromList . catMaybes
-    -> Glue (HashMap AST.Identifier (Vector (Quadruple Variable)))
-program globalTable (AST.Program declarations) = HashMap.fromList . catMaybes
     <$> traverse (declaration globalTable) declarations
 
 declaration
     :: SymbolTable
     -> AST.Declaration
     -> Glue (Maybe (AST.Identifier, Vector (Quadruple Variable)))
-declaration globalTable (AST.ProcedureDeclaration procedureName _ _ statements)
+declaration globalTable (AST.ProcedureDeclaration procedureName _ variableDeclarations statements)
-    = Just
+    = traverse_ registerVariable variableDeclarations
-    . (procedureName,)
+    >> nameQuadruplesTuple <$> traverse (statement globalTable) statements
-    . Vector.cons StartQuadruple
+  where
-    . flip Vector.snoc StopQuadruple
+    registerVariable (AST.VariableDeclaration identifier _) = do
-    . fold
+        currentCounter <- fmap (fromIntegral . HashMap.size)
-    <$> traverse (statement globalTable) statements
+            $ Glue $ gets $ getField @"localMap"
+        Glue $ modify' $ modifier identifier $ LocalVariable currentCounter
+    modifier identifier currentCounter generator = generator
+        { localMap = HashMap.insert identifier currentCounter
+            $ getField @"localMap" generator
+        }
+    nameQuadruplesTuple quadrupleList = Just
+        ( procedureName
+        , Vector.cons StartQuadruple
+            $ flip Vector.snoc StopQuadruple
+            $ fold quadrupleList
+        )
 declaration _ (AST.TypeDefinition _ _) = pure Nothing
 
 statement :: SymbolTable -> AST.Statement -> Glue (Vector (Quadruple Variable))
@@ -104,15 +121,16 @@ statement localTable (AST.AssignmentStatement variableAccess' assignee) = do
     (rhsOperand, rhsStatements) <- expression localTable assignee
     let variableType' = variableType variableAccess' localTable
     accessResult <- variableAccess localTable variableAccess' Nothing variableType' mempty
-    pure $ rhsStatements <> case accessResult of
+    lhsStatements <- case accessResult of
             {-(AST.Identifier identifier, Just accumulatedIndex, accumulatedStatements) ->
                 Vector.snoc accumulatedStatements
                     $ ArrayAssignQuadruple rhsOperand accumulatedIndex
                     $ LocalVariable identifier -}
-            (AST.Identifier identifier, Nothing, accumulatedStatements) ->
+            (identifier, _Nothing, accumulatedStatements)
-                Vector.snoc accumulatedStatements
+                -> Vector.snoc accumulatedStatements
-                    $ AssignQuadruple rhsOperand
+                . AssignQuadruple rhsOperand
-                    $ LocalVariable 0
+                <$> lookupLocal identifier
+    pure $ rhsStatements <> lhsStatements
 {- statement localTable (AST.WhileStatement whileCondition whileStatement) = do
     (conditionStatements, jumpConstructor) <- condition localTable whileCondition
     startLabel <- createLabel
@@ -135,6 +153,10 @@ createTemporary = do
         { temporaryCounter = getField @"temporaryCounter" generator + 1
         }
 
+lookupLocal :: Identifier -> Glue Variable
+lookupLocal identifier =
+    fmap (HashMap.! identifier) $ Glue $ gets $ getField @"localMap"
+
 createLabel :: Glue Label
 createLabel = do
     currentCounter <- Glue $ gets $ getField @"labelCounter"
@@ -242,13 +264,13 @@ expression localTable = \case
     (AST.DivisionExpression lhs rhs) ->
         binaryExpression DivisionQuadruple lhs rhs
     (AST.VariableExpression variableExpression) -> do
-        pure (VariableOperand (LocalVariable 0), mempty)
+        let variableType' = variableType variableExpression localTable
-        {- let variableType' = variableType variableExpression localTable
         variableAccess' <- variableAccess localTable variableExpression Nothing variableType' mempty
         case variableAccess' of
-            (AST.Identifier identifier, Nothing, statements) ->
+            (identifier, _Nothing, statements)
-                pure (VariableOperand (Variable identifier), statements)
+                -> (, statements) . VariableOperand 
-            (AST.Identifier identifier, Just operand, statements) -> do
+                <$> lookupLocal identifier
+            {-(AST.Identifier identifier, Just operand, statements) -> do
                 arrayAddress <- createTemporary
                 let arrayStatement = ArrayQuadruple (Variable identifier) operand arrayAddress
                 pure

lib/Language/Elna/RiscV/CodeGenerator.hs

@@ -14,7 +14,12 @@ import Data.Vector (Vector)
 import qualified Data.Vector as Vector
 import qualified Language.Elna.Architecture.RiscV as RiscV
 import Language.Elna.Backend.Allocator (MachineConfiguration(..), Store(..))
-import Language.Elna.Backend.Intermediate (Label(..), Operand(..), Quadruple(..))
+import Language.Elna.Backend.Intermediate
+    ( Label(..)
+    , Operand(..)
+    , ProcedureQuadruples(..)
+    , Quadruple(..)
+    )
 import Language.Elna.Location (Identifier(..))
 import Data.Bits (Bits(..))
 import Data.Foldable (Foldable(..), foldlM)
@@ -80,13 +85,13 @@ createLabel = do
         $ Text.Builder.toLazyText
         $ Text.Builder.decimal currentCounter
 
-generateRiscV :: HashMap Identifier (Vector RiscVQuadruple) -> Vector Statement
+generateRiscV :: HashMap Identifier (ProcedureQuadruples RiscVStore) -> Vector Statement
 generateRiscV = flip evalState 0
     . runRiscVGenerator
     . foldlM go Vector.empty
     . HashMap.toList
   where
-    go accumulator (Identifier key, value) =
+    go accumulator (Identifier key, ProcedureQuadruples{ quadruples = value }) =
         let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective])
                 . fold <$> mapM quadruple value
          in (accumulator <>) <$> code
@@ -114,354 +119,140 @@ quadruple StopQuadruple = pure $ Vector.fromList
     , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP 4)
     , Instruction (RiscV.BaseInstruction RiscV.Jalr $ RiscV.I RiscV.RA RiscV.JALR RiscV.Zero 0)
     ]
-quadruple (AddQuadruple operand1 operand2 (Store register))
+quadruple (AddQuadruple operand1 operand2 store) =
+    commutativeBinary (+) RiscV.ADD (RiscV.Funct7 0b0000000) (operand1, operand2) store
+quadruple (ProductQuadruple operand1 operand2 store) =
+    commutativeBinary (*) RiscV.MUL (RiscV.Funct7 0b0000001) (operand1, operand2) store
+quadruple (SubtractionQuadruple operand1 operand2 store)
     | IntOperand immediateOperand1 <- operand1
     , IntOperand immediateOperand2 <- operand2 =
-        pure $ lui (immediateOperand1 + immediateOperand2) register
+        let (storeRegister, storeStatements) = storeToStore store
+         in pure $ lui (immediateOperand1 - immediateOperand2) storeRegister <> storeStatements
     | VariableOperand variableOperand1 <- operand1
     , VariableOperand variableOperand2 <- operand2 =
-        let Store operandRegister1 = variableOperand1
+        let (storeRegister, storeStatements) = storeToStore store
-            Store operandRegister2 = variableOperand2
+            (operandRegister1, statements1) = loadFromStore variableOperand1
-        in pure $ Vector.singleton $ Instruction
+            (operandRegister2, statements2) = loadFromStore variableOperand2
+            instruction = Instruction
                 $ RiscV.BaseInstruction RiscV.Op
-            $ RiscV.R register RiscV.ADD operandRegister1 operandRegister2 (RiscV.Funct7 0b0000000)
+                $ RiscV.R storeRegister RiscV.SUB operandRegister1 operandRegister2
-    | VariableOperand variableOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        addImmediateRegister variableOperand1 immediateOperand2
-    | IntOperand immediateOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
-        addImmediateRegister variableOperand2 immediateOperand1
-  where
-    addImmediateRegister variableOperand immediateOperand = 
-        let statements = lui immediateOperand register
-            Store operandRegister = variableOperand
-        in pure $ Vector.snoc statements
-            $ Instruction
-            $ RiscV.BaseInstruction RiscV.Op
-            $ RiscV.R register RiscV.ADD register operandRegister
-            $ RiscV.Funct7 0b0000000
-quadruple (SubtractionQuadruple operand1 operand2 (Store register))
-    | IntOperand immediateOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        pure $ lui (immediateOperand1 - immediateOperand2) register
-    | VariableOperand variableOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
-        let Store operandRegister1 = variableOperand1
-            Store operandRegister2 = variableOperand2
-        in pure $ Vector.singleton $ Instruction
-            $ RiscV.BaseInstruction RiscV.Op
-            $ RiscV.R register RiscV.SUB operandRegister1 operandRegister2
                 $ RiscV.Funct7 0b0100000
+        in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements
     | IntOperand immediateOperand1 <- operand1
     , VariableOperand variableOperand2 <- operand2 =
-        let statements1 = lui immediateOperand1 register
+        let (storeRegister, storeStatements) = storeToStore store
-            Store operandRegister2 = variableOperand2
+            statements1 = lui immediateOperand1 storeRegister
-         in pure $ Vector.snoc statements1
+            (operandRegister2, statements2) = loadFromStore variableOperand2
-            $ Instruction
+            instruction = Instruction
                 $ RiscV.BaseInstruction RiscV.Op
-            $ RiscV.R register RiscV.SUB register operandRegister2
+                $ RiscV.R storeRegister RiscV.SUB storeRegister operandRegister2
                 $ RiscV.Funct7 0b0100000
+         in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements
     | VariableOperand variableOperand1 <- operand1
     , IntOperand immediateOperand2 <- operand2 =
-        let statements2 = lui (negate immediateOperand2) register
+        let (storeRegister, storeStatements) = storeToStore store
-            Store operandRegister1 = variableOperand1
+            statements2 = lui (negate immediateOperand2) storeRegister
-         in pure $ Vector.snoc statements2
+            (operandRegister1, statements1) = loadFromStore variableOperand1
-            $ Instruction
+            instruction = Instruction
                 $ RiscV.BaseInstruction RiscV.Op
-            $ RiscV.R register RiscV.ADD register operandRegister1
+                $ RiscV.R storeRegister RiscV.ADD storeRegister operandRegister1
                 $ RiscV.Funct7 0b0000000
-quadruple (NegationQuadruple operand1 (Store register))
+         in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements
+quadruple (NegationQuadruple operand1 store)
     | IntOperand immediateOperand1 <- operand1 =
-        pure $ lui (negate immediateOperand1) register
+        let (storeRegister, storeStatements) = storeToStore store
+         in pure $ lui (negate immediateOperand1) storeRegister <> storeStatements
     | VariableOperand variableOperand1 <- operand1 =
-        let Store operandRegister1 = variableOperand1
+        let (storeRegister, storeStatements) = storeToStore store
-         in pure $ Vector.singleton
+            (operandRegister1, statements1) = loadFromStore variableOperand1
-            $ Instruction
+            instruction = Instruction
                 $ RiscV.BaseInstruction RiscV.Op
-            $ RiscV.R register RiscV.SUB RiscV.Zero operandRegister1
+                $ RiscV.R storeRegister RiscV.SUB RiscV.Zero operandRegister1
                 $ RiscV.Funct7 0b0100000
-quadruple (ProductQuadruple operand1 operand2 (Store register))
+         in pure $ statements1 <> Vector.cons instruction storeStatements
-    | IntOperand immediateOperand1 <- operand1
+quadruple (DivisionQuadruple operand1 operand2 store)
-    , IntOperand immediateOperand2 <- operand2 =
-        pure $ lui (immediateOperand1 * immediateOperand2) register
-    | VariableOperand variableOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
-        let Store operandRegister1 = variableOperand1
-            Store operandRegister2 = variableOperand2
-        in pure $ Vector.singleton $ Instruction
-            $ RiscV.BaseInstruction RiscV.Op
-            $ RiscV.R register RiscV.MUL operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001)
-    | VariableOperand variableOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        multiplyImmediateRegister variableOperand1 immediateOperand2
-    | IntOperand immediateOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
-        multiplyImmediateRegister variableOperand2 immediateOperand1
-  where
-    multiplyImmediateRegister variableOperand immediateOperand = 
-        let statements = lui immediateOperand register
-            Store operandRegister = variableOperand
-        in pure $ Vector.snoc statements
-            $ Instruction
-            $ RiscV.BaseInstruction RiscV.Op
-            $ RiscV.R register RiscV.MUL register operandRegister
-            $ RiscV.Funct7 0b0000001
-quadruple (DivisionQuadruple operand1 operand2 (Store register))
     | IntOperand immediateOperand1 <- operand1
     , IntOperand immediateOperand2 <- operand2 =
         if immediateOperand2 == 0
         then pure $ Vector.singleton
             $ Instruction (RiscV.CallInstruction "_divide_by_zero_error")
-        else pure $ lui (quot immediateOperand1 immediateOperand2) register
+        else
+            let (storeRegister, storeStatements) = storeToStore store
+            in pure $ lui (quot immediateOperand1 immediateOperand2) storeRegister <> storeStatements
     | VariableOperand variableOperand1 <- operand1
     , VariableOperand variableOperand2 <- operand2 = do
-        let Store operandRegister1 = variableOperand1
+        let (storeRegister, storeStatements) = storeToStore store
-            Store operandRegister2 = variableOperand2
+            (operandRegister1, statements1) = loadFromStore variableOperand1
+            (operandRegister2, statements2) = loadFromStore variableOperand2
             divisionInstruction = Instruction
                 $ RiscV.BaseInstruction RiscV.Op
-                $ RiscV.R register RiscV.DIV operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001)
+                $ RiscV.R storeRegister RiscV.DIV operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001)
         branchLabel <- createLabel
         let branchInstruction = Instruction
                 $ RiscV.RelocatableInstruction RiscV.Branch
                 $ RiscV.RBranch branchLabel RiscV.BNE RiscV.Zero operandRegister2
-        pure $ Vector.fromList
+        pure $ statements1 <> statements2 <> Vector.fromList
             [ branchInstruction
             , Instruction (RiscV.CallInstruction "_divide_by_zero_error")
             , JumpLabel branchLabel []
             , divisionInstruction
-            ]
+            ] <> storeStatements
     | VariableOperand variableOperand1 <- operand1
     , IntOperand immediateOperand2 <- operand2 =
-        let statements2 = lui immediateOperand2 register
+        let (storeRegister, storeStatements) = storeToStore store
-            Store operandRegister1 = variableOperand1
+            statements2 = lui immediateOperand2 storeRegister
+            (operandRegister1, statements1) = loadFromStore variableOperand1
             operationInstruction
                 | immediateOperand2 == 0 =
                     RiscV.CallInstruction "_divide_by_zero_error"
                 | otherwise = RiscV.BaseInstruction RiscV.Op
-                    $ RiscV.R register RiscV.DIV operandRegister1 register
+                    $ RiscV.R storeRegister RiscV.DIV operandRegister1 storeRegister
                     $ RiscV.Funct7 0b0000001
-         in pure $ Vector.snoc statements2
+         in pure $ statements1 <> statements2
-            $ Instruction operationInstruction
+            <> Vector.cons (Instruction operationInstruction) storeStatements
     | IntOperand immediateOperand1 <- operand1
     , VariableOperand variableOperand2 <- operand2 = do
-        let statements1 = lui immediateOperand1 register
+        let (storeRegister, storeStatements) = storeToStore store
-            Store operandRegister2 = variableOperand2
+            statements1 = lui immediateOperand1 storeRegister
+            (operandRegister2, statements2) = loadFromStore variableOperand2
             divisionInstruction = Instruction
                 $ RiscV.BaseInstruction RiscV.Op
-                $ RiscV.R register RiscV.DIV register operandRegister2 (RiscV.Funct7 0b0000001)
+                $ RiscV.R storeRegister RiscV.DIV storeRegister operandRegister2 (RiscV.Funct7 0b0000001)
         branchLabel <- createLabel
         let branchInstruction = Instruction
                 $ RiscV.RelocatableInstruction RiscV.Branch
                 $ RiscV.RBranch branchLabel RiscV.BNE RiscV.Zero operandRegister2
-        pure $ mappend statements1 $ Vector.fromList 
+        pure $ statements1 <> statements2 <> Vector.fromList 
             [ branchInstruction
             , Instruction (RiscV.CallInstruction "_divide_by_zero_error")
             , JumpLabel branchLabel []
             , divisionInstruction
-            ]
+            ] <> storeStatements
 quadruple (LabelQuadruple (Label label)) = pure $ Vector.singleton $ JumpLabel label mempty
 quadruple (GoToQuadruple label) = pure $ Vector.singleton $ unconditionalJal label
-quadruple (EqualQuadruple operand1 operand2 goToLabel)
+quadruple (EqualQuadruple operand1 operand2 goToLabel) =
-    | IntOperand immediateOperand1 <- operand1
+    commutativeComparison (==) RiscV.BEQ (operand1, operand2) goToLabel
-    , IntOperand immediateOperand2 <- operand2 =
+quadruple (NonEqualQuadruple operand1 operand2 goToLabel) =
-        if immediateOperand1 == immediateOperand2
+    commutativeComparison (/=) RiscV.BNE (operand1, operand2) goToLabel
-        then pure $ Vector.singleton $ unconditionalJal goToLabel
+quadruple (LessQuadruple operand1 operand2 goToLabel) =
-        else pure Vector.empty
+    lessThan (operand1, operand2) goToLabel
-    | VariableOperand variableOperand1 <- operand1
+quadruple (GreaterQuadruple operand1 operand2 goToLabel) =
-    , VariableOperand variableOperand2 <- operand2 = do
+    lessThan (operand2, operand1) goToLabel
-        let Store operandRegister1 = variableOperand1
+quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) =
-            Store operandRegister2 = variableOperand2
+    lessOrEqualThan (operand1, operand2) goToLabel
-            Label goToLabel' = goToLabel
+quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) =
-        pure $ Vector.singleton
+    lessOrEqualThan (operand2, operand1) goToLabel
-            $ Instruction
+quadruple (AssignQuadruple operand1 store)
-            $ RiscV.RelocatableInstruction RiscV.Branch
+    | IntOperand immediateOperand1 <- operand1 =
-            $ RiscV.RBranch goToLabel' RiscV.BEQ operandRegister1 operandRegister2
+        let (storeRegister, storeStatements) = storeToStore store
-    | VariableOperand variableOperand1 <- operand1
+         in pure $ lui immediateOperand1 storeRegister <> storeStatements
-    , IntOperand immediateOperand2 <- operand2 =
-        compareImmediateRegister variableOperand1 immediateOperand2
-    | IntOperand immediateOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
-        compareImmediateRegister variableOperand2 immediateOperand1
-  where
-    compareImmediateRegister variableOperand immediateOperand = 
-        let statements = lui immediateOperand immediateRegister
-            Store operandRegister = variableOperand
-            Label goToLabel' = goToLabel
-        in pure $ Vector.snoc statements
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BEQ operandRegister immediateRegister
-quadruple (NonEqualQuadruple operand1 operand2 goToLabel)
-    | IntOperand immediateOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        if immediateOperand1 /= immediateOperand2
-        then pure $ Vector.singleton $ unconditionalJal goToLabel
-        else pure Vector.empty
-    | VariableOperand variableOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 = do
-        let Store operandRegister1 = variableOperand1
-            Store operandRegister2 = variableOperand2
-            Label goToLabel' = goToLabel
-        pure $ Vector.singleton
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BNE operandRegister1 operandRegister2
-    | VariableOperand variableOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        compareImmediateRegister variableOperand1 immediateOperand2
-    | IntOperand immediateOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
-        compareImmediateRegister variableOperand2 immediateOperand1
-  where
-    compareImmediateRegister variableOperand immediateOperand = 
-        let statements = lui immediateOperand immediateRegister
-            Store operandRegister = variableOperand
-            Label goToLabel' = goToLabel
-        in pure $ Vector.snoc statements
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BNE operandRegister immediateRegister
-quadruple (LessQuadruple operand1 operand2 goToLabel)
-    | IntOperand immediateOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        if immediateOperand1 < immediateOperand2
-        then pure $ Vector.singleton $ unconditionalJal goToLabel
-        else pure Vector.empty
-    | VariableOperand variableOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 = do
-        let Store operandRegister1 = variableOperand1
-            Store operandRegister2 = variableOperand2
-            Label goToLabel' = goToLabel
-        pure $ Vector.singleton
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 operandRegister2
-    | VariableOperand variableOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        let statements2 = lui immediateOperand2 immediateRegister
-            Store operandRegister1 = variableOperand1
-            Label goToLabel' = goToLabel
-        in pure $ Vector.snoc statements2
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 immediateRegister
-    | IntOperand immediateOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
-        let statements1 = lui immediateOperand1 immediateRegister
-            Store operandRegister2 = variableOperand2
-            Label goToLabel' = goToLabel
-        in pure $ Vector.snoc statements1
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BLT immediateRegister operandRegister2
-quadruple (GreaterQuadruple operand1 operand2 goToLabel)
-    | IntOperand immediateOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        if immediateOperand1 > immediateOperand2
-        then pure $ Vector.singleton $ unconditionalJal goToLabel
-        else pure Vector.empty
-    | VariableOperand variableOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 = do
-        let Store operandRegister1 = variableOperand1
-            Store operandRegister2 = variableOperand2
-            Label goToLabel' = goToLabel
-        pure $ Vector.singleton
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister2 operandRegister1
-    | VariableOperand variableOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        let statements2 = lui immediateOperand2 immediateRegister
-            Store operandRegister1 = variableOperand1
-            Label goToLabel' = goToLabel
-        in pure $ Vector.snoc statements2
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BLT immediateRegister operandRegister1
-    | IntOperand immediateOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
-        let statements1 = lui immediateOperand1 immediateRegister
-            Store operandRegister2 = variableOperand2
-            Label goToLabel' = goToLabel
-        in pure $ Vector.snoc statements1
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister2 immediateRegister
-quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel)
-    | IntOperand immediateOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        if immediateOperand1 <= immediateOperand2
-        then pure $ Vector.singleton $ unconditionalJal goToLabel
-        else pure Vector.empty
-    | VariableOperand variableOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 = do
-        let Store operandRegister1 = variableOperand1
-            Store operandRegister2 = variableOperand2
-            Label goToLabel' = goToLabel
-        pure $ Vector.singleton
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 operandRegister1
-    | VariableOperand variableOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        let statements2 = lui immediateOperand2 immediateRegister
-            Store operandRegister1 = variableOperand1
-            Label goToLabel' = goToLabel
-        in pure $ Vector.snoc statements2
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister1
-    | IntOperand immediateOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
-        let statements1 = lui immediateOperand1 immediateRegister
-            Store operandRegister2 = variableOperand2
-            Label goToLabel' = goToLabel
-        in pure $ Vector.snoc statements1
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 immediateRegister
-quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel)
-    | IntOperand immediateOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        if immediateOperand1 >= immediateOperand2
-        then pure $ Vector.singleton $ unconditionalJal goToLabel
-        else pure Vector.empty
-    | VariableOperand variableOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
-        let Store operandRegister1 = variableOperand1
-            Store operandRegister2 = variableOperand2
-            Label goToLabel' = goToLabel
-         in pure $ Vector.singleton
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister1 operandRegister2
-    | VariableOperand variableOperand1 <- operand1
-    , IntOperand immediateOperand2 <- operand2 =
-        let statements2 = lui immediateOperand2 immediateRegister
-            Store operandRegister1 = variableOperand1
-            Label goToLabel' = goToLabel
-        in pure $ Vector.snoc statements2
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister1 immediateRegister
-    | IntOperand immediateOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
-        let statements1 = lui immediateOperand1 immediateRegister
-            Store operandRegister2 = variableOperand2
-            Label goToLabel' = goToLabel
-        in pure $ Vector.snoc statements1
-            $ Instruction
-            $ RiscV.RelocatableInstruction RiscV.Branch
-            $ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister2
-quadruple (AssignQuadruple operand1 (Store register))
-    | IntOperand immediateOperand1 <- operand1 = pure
-        $ lui immediateOperand1 register
     | VariableOperand variableOperand1 <- operand1 =
-        let Store operandRegister1 = variableOperand1
+        let (operandRegister1, statements1) = loadFromStore variableOperand1
-         in pure $ Vector.singleton
+            (storeRegister, storeStatements) = storeToStore store
-            $ Instruction
+            instruction = Instruction
                 $ RiscV.BaseInstruction RiscV.OpImm
-            $ RiscV.I register RiscV.ADDI operandRegister1 0
+                $ RiscV.I storeRegister RiscV.ADDI operandRegister1 0
+         in pure $ statements1 <> Vector.cons instruction storeStatements 
 
 unconditionalJal :: Label -> Statement
 unconditionalJal (Label goToLabel) = Instruction
@@ -471,7 +262,7 @@ unconditionalJal (Label goToLabel) = Instruction
 loadImmediateOrRegister :: RiscVOperand -> RiscV.XRegister -> (RiscV.XRegister, Vector Statement)
 loadImmediateOrRegister (IntOperand intValue) targetRegister =
     (targetRegister, lui intValue targetRegister)
-loadImmediateOrRegister (VariableOperand (Store register)) _ = (register, Vector.empty)
+loadImmediateOrRegister (VariableOperand store) _ = loadFromStore store
 
 lui :: Int32 -> RiscV.XRegister -> Vector Statement
 lui intValue targetRegister
@@ -489,3 +280,165 @@ lui intValue targetRegister
   where
     hi = intValue `shiftR` 12
     lo = fromIntegral intValue
+
+commutativeBinary
+    :: (Int32 -> Int32 -> Int32)
+    -> RiscV.Funct3
+    -> RiscV.Funct7
+    -> (Operand RiscVStore, Operand RiscVStore)
+    -> Store RiscV.XRegister
+    -> RiscVGenerator (Vector Statement)
+commutativeBinary immediateOperation funct3 funct7 (operand1, operand2) store
+    | IntOperand immediateOperand1 <- operand1
+    , IntOperand immediateOperand2 <- operand2 =
+        let (storeRegister, storeStatements) = storeToStore store
+            immediateOperation' = immediateOperation immediateOperand1 immediateOperand2
+         in pure $ lui immediateOperation' storeRegister <> storeStatements
+    | VariableOperand variableOperand1 <- operand1
+    , VariableOperand variableOperand2 <- operand2 =
+        let (operandRegister1, statements1) = loadFromStore variableOperand1
+            (operandRegister2, statements2) = loadFromStore variableOperand2
+            (storeRegister, storeStatements) = storeToStore store
+            instruction = Instruction $ RiscV.BaseInstruction RiscV.Op
+                $ RiscV.R storeRegister funct3 operandRegister1 operandRegister2 funct7
+         in pure $ statements1 <> statements2
+            <> Vector.cons instruction storeStatements
+    | VariableOperand variableOperand1 <- operand1
+    , IntOperand immediateOperand2 <- operand2 =
+        commutativeImmediateRegister variableOperand1 immediateOperand2
+    | IntOperand immediateOperand1 <- operand1
+    , VariableOperand variableOperand2 <- operand2 =
+        commutativeImmediateRegister variableOperand2 immediateOperand1
+  where
+    commutativeImmediateRegister variableOperand immediateOperand = 
+        let (storeRegister, storeStatements) = storeToStore store
+            immediateStatements = lui immediateOperand storeRegister
+            (operandRegister, registerStatements) = loadFromStore variableOperand
+            instruction = Instruction
+                $ RiscV.BaseInstruction RiscV.Op
+                $ RiscV.R storeRegister funct3 storeRegister operandRegister funct7
+        in pure $ immediateStatements <> registerStatements
+            <> Vector.cons instruction storeStatements
+
+commutativeComparison
+    :: (Int32 -> Int32 -> Bool)
+    -> RiscV.Funct3
+    -> (Operand RiscVStore, Operand RiscVStore)
+    -> Label
+    -> RiscVGenerator (Vector Statement)
+commutativeComparison immediateOperation funct3 (operand1, operand2) goToLabel
+    | IntOperand immediateOperand1 <- operand1
+    , IntOperand immediateOperand2 <- operand2 =
+        if immediateOperation immediateOperand1 immediateOperand2
+        then pure $ Vector.singleton $ unconditionalJal goToLabel
+        else pure Vector.empty
+    | VariableOperand variableOperand1 <- operand1
+    , VariableOperand variableOperand2 <- operand2 = do
+        let (operandRegister1, statements1) = loadFromStore variableOperand1
+            (operandRegister2, statements2) = loadFromStore variableOperand2
+            Label goToLabel' = goToLabel
+        pure $ Vector.snoc (statements1 <> statements2)
+            $ Instruction
+            $ RiscV.RelocatableInstruction RiscV.Branch
+            $ RiscV.RBranch goToLabel' funct3 operandRegister1 operandRegister2
+    | VariableOperand variableOperand1 <- operand1
+    , IntOperand immediateOperand2 <- operand2 =
+        compareImmediateRegister variableOperand1 immediateOperand2
+    | IntOperand immediateOperand1 <- operand1
+    , VariableOperand variableOperand2 <- operand2 =
+        compareImmediateRegister variableOperand2 immediateOperand1
+  where
+    compareImmediateRegister variableOperand immediateOperand = 
+        let immediateStatements = lui immediateOperand immediateRegister
+            (operandRegister, registerStatements) = loadFromStore variableOperand
+            Label goToLabel' = goToLabel
+        in pure $ Vector.snoc (immediateStatements <> registerStatements)
+            $ Instruction
+            $ RiscV.RelocatableInstruction RiscV.Branch
+            $ RiscV.RBranch goToLabel' funct3 operandRegister immediateRegister
+
+lessThan :: (Operand RiscVStore, Operand RiscVStore) -> Label -> RiscVGenerator (Vector Statement)
+lessThan (operand1, operand2) goToLabel
+    | IntOperand immediateOperand1 <- operand1
+    , IntOperand immediateOperand2 <- operand2 =
+        if immediateOperand1 < immediateOperand2
+        then pure $ Vector.singleton $ unconditionalJal goToLabel
+        else pure Vector.empty
+    | VariableOperand variableOperand1 <- operand1
+    , VariableOperand variableOperand2 <- operand2 = do
+        let (operandRegister1, statements1) = loadFromStore variableOperand1
+            (operandRegister2, statements2) = loadFromStore variableOperand2
+            Label goToLabel' = goToLabel
+        pure $ Vector.snoc (statements1 <> statements2)
+            $ Instruction
+            $ RiscV.RelocatableInstruction RiscV.Branch
+            $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 operandRegister2
+    | VariableOperand variableOperand1 <- operand1
+    , IntOperand immediateOperand2 <- operand2 =
+        let statements2 = lui immediateOperand2 immediateRegister
+            (operandRegister1, statements1) = loadFromStore variableOperand1
+            Label goToLabel' = goToLabel
+        in pure $ Vector.snoc (statements1 <> statements2)
+            $ Instruction
+            $ RiscV.RelocatableInstruction RiscV.Branch
+            $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 immediateRegister
+    | IntOperand immediateOperand1 <- operand1
+    , VariableOperand variableOperand2 <- operand2 =
+        let statements1 = lui immediateOperand1 immediateRegister
+            (operandRegister2, statements2) = loadFromStore variableOperand2
+            Label goToLabel' = goToLabel
+        in pure $ Vector.snoc (statements1 <> statements2)
+            $ Instruction
+            $ RiscV.RelocatableInstruction RiscV.Branch
+            $ RiscV.RBranch goToLabel' RiscV.BLT immediateRegister operandRegister2
+
+lessOrEqualThan :: (Operand RiscVStore, Operand RiscVStore) -> Label -> RiscVGenerator (Vector Statement)
+lessOrEqualThan (operand1, operand2) goToLabel
+    | IntOperand immediateOperand1 <- operand1
+    , IntOperand immediateOperand2 <- operand2 =
+        if immediateOperand1 <= immediateOperand2
+        then pure $ Vector.singleton $ unconditionalJal goToLabel
+        else pure Vector.empty
+    | VariableOperand variableOperand1 <- operand1
+    , VariableOperand variableOperand2 <- operand2 = do
+        let (operandRegister1, statements1) = loadFromStore variableOperand1
+            (operandRegister2, statements2) = loadFromStore variableOperand2
+            Label goToLabel' = goToLabel
+        pure $ Vector.snoc (statements1 <> statements2)
+            $ Instruction
+            $ RiscV.RelocatableInstruction RiscV.Branch
+            $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 operandRegister1
+    | VariableOperand variableOperand1 <- operand1
+    , IntOperand immediateOperand2 <- operand2 =
+        let statements2 = lui immediateOperand2 immediateRegister
+            (operandRegister1, statements1) = loadFromStore variableOperand1
+            Label goToLabel' = goToLabel
+        in pure $ Vector.snoc (statements1 <> statements2)
+            $ Instruction
+            $ RiscV.RelocatableInstruction RiscV.Branch
+            $ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister1
+    | IntOperand immediateOperand1 <- operand1
+    , VariableOperand variableOperand2 <- operand2 =
+        let statements1 = lui immediateOperand1 immediateRegister
+            (operandRegister2, statements2) = loadFromStore variableOperand2
+            Label goToLabel' = goToLabel
+        in pure $ Vector.snoc (statements1 <> statements2)
+            $ Instruction
+            $ RiscV.RelocatableInstruction RiscV.Branch
+            $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 immediateRegister
+
+loadFromStore :: RiscVStore -> (RiscV.XRegister, Vector Statement)
+loadFromStore (RegisterStore register) = (register, mempty)
+loadFromStore (StackStore offset register) =
+    let loadInstruction = Instruction
+            $ RiscV.BaseInstruction RiscV.Load
+            $ RiscV.I register RiscV.LW RiscV.SP offset
+     in (register, Vector.singleton loadInstruction)
+
+storeToStore :: RiscVStore -> (RiscV.XRegister, Vector Statement)
+storeToStore (RegisterStore register) = (register, mempty)
+storeToStore (StackStore offset register) =
+    let storeInstruction = Instruction
+            $ RiscV.BaseInstruction RiscV.Store
+            $ RiscV.S offset RiscV.SW RiscV.SP register
+     in (register, Vector.singleton storeInstruction)

tests/expectations/add_to_variable.txt

@@ -0,0 +1 @@
+58

tests/vm/add_to_variable.elna

@@ -0,0 +1,6 @@
+proc main() {
+  var i: int;
+  i := 28;
+
+  printi(i + 30);
+}