Map local variables in IR to their original names

1 files changed, 58 insertions, 53 deletions

diff --git a/lib/Language/Elna/Backend/Allocator.hs b/lib/Language/Elna/Backend/Allocator.hs
index 0c3e5c3..ac54c78 100644
--- a/lib/Language/Elna/Backend/Allocator.hs
+++ b/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 = fmap quadruple
+    function :: Vector (Quadruple Variable) -> ProcedureQuadruples (Store r)
+    function quadruples' = ProcedureQuadruples
+        { quadruples = quadruple <$> quadruples'
+        , stackSize = 0
+        }
     quadruple :: Quadruple Variable -> Quadruple (Store r)
-    quadruple StartQuadruple = StartQuadruple
-    quadruple StopQuadruple = StopQuadruple
-    quadruple (ParameterQuadruple operand1) =
-        ParameterQuadruple (operand operand1)
-    quadruple (CallQuadruple name count) = CallQuadruple name count
-    quadruple (AddQuadruple operand1 operand2 variable)
-        = AddQuadruple (operand operand1) (operand operand2)
-        $ storeVariable variable
-    quadruple (SubtractionQuadruple operand1 operand2 variable)
-        = SubtractionQuadruple (operand operand1) (operand operand2)
-        $ storeVariable variable
-    quadruple (NegationQuadruple operand1 variable)
-        = NegationQuadruple (operand operand1)
-        $ storeVariable variable
-    quadruple (ProductQuadruple operand1 operand2 variable)
-        = ProductQuadruple (operand operand1) (operand operand2)
-        $ storeVariable variable
-    quadruple (DivisionQuadruple operand1 operand2 variable)
-        = DivisionQuadruple (operand operand1) (operand operand2)
-        $ storeVariable variable
-    quadruple (LabelQuadruple label) = LabelQuadruple label
-    quadruple (GoToQuadruple label) = GoToQuadruple label
-    quadruple (EqualQuadruple operand1 operand2 goToLabel) =
-        EqualQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (NonEqualQuadruple operand1 operand2 goToLabel) =
-        NonEqualQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (LessQuadruple operand1 operand2 goToLabel) =
-        LessQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (GreaterQuadruple operand1 operand2 goToLabel) =
-        GreaterQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) =
-        LessOrEqualQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) =
-        GreaterOrEqualQuadruple (operand operand1) (operand operand2) goToLabel
-    quadruple (AssignQuadruple operand1 variable)
-        = AssignQuadruple (operand operand1)
-        $ storeVariable variable
+    quadruple = \case
+        StartQuadruple -> StartQuadruple
+        StopQuadruple -> StopQuadruple
+        ParameterQuadruple operand1 ->
+            ParameterQuadruple (operand operand1)
+        CallQuadruple name count -> CallQuadruple name count
+        AddQuadruple operand1 operand2 variable
+            -> AddQuadruple (operand operand1) (operand operand2)
+            $ storeVariable variable
+        SubtractionQuadruple operand1 operand2 variable
+            -> SubtractionQuadruple (operand operand1) (operand operand2)
+            $ storeVariable variable
+        NegationQuadruple operand1 variable
+            -> NegationQuadruple (operand operand1)
+            $ storeVariable variable
+        ProductQuadruple operand1 operand2 variable
+            -> ProductQuadruple (operand operand1) (operand operand2)
+            $ storeVariable variable
+        DivisionQuadruple operand1 operand2 variable
+            -> DivisionQuadruple (operand operand1) (operand operand2)
+            $ storeVariable variable
+        LabelQuadruple label -> LabelQuadruple label
+        GoToQuadruple label -> GoToQuadruple label
+        EqualQuadruple operand1 operand2 goToLabel ->
+            EqualQuadruple (operand operand1) (operand operand2) goToLabel
+        NonEqualQuadruple operand1 operand2 goToLabel ->
+            NonEqualQuadruple (operand operand1) (operand operand2) goToLabel
+        LessQuadruple operand1 operand2 goToLabel ->
+            LessQuadruple (operand operand1) (operand operand2) goToLabel
+        GreaterQuadruple operand1 operand2 goToLabel ->
+            GreaterQuadruple (operand operand1) (operand operand2) goToLabel
+        LessOrEqualQuadruple operand1 operand2 goToLabel ->
+            LessOrEqualQuadruple (operand operand1) (operand operand2) goToLabel
+        GreaterOrEqualQuadruple operand1 operand2 goToLabel ->
+            GreaterOrEqualQuadruple (operand operand1) (operand operand2) goToLabel
+        AssignQuadruple operand1 variable ->
+            AssignQuadruple (operand operand1) $ storeVariable variable
     operand :: Operand Variable -> Operand (Store r)
     operand (IntOperand x) = IntOperand x
-    operand (VariableOperand (TempVariable index))
-        = VariableOperand
-        $ Store
+    operand (VariableOperand variableOperand) =
+        VariableOperand $ storeVariable variableOperand
+    storeVariable (TempVariable index) = RegisterStore
         $ temporaryRegisters !! fromIntegral index
-    operand (VariableOperand (LocalVariable index))
-        = VariableOperand
-        $ Store
-        $ temporaryRegisters !! fromIntegral index
-    storeVariable (TempVariable index) =
-        Store $ temporaryRegisters !! fromIntegral index
-    storeVariable (LocalVariable index) =
-        Store $ temporaryRegisters !! fromIntegral index
+    storeVariable (LocalVariable index) = RegisterStore
+        $ temporaryRegisters !! pred (length temporaryRegisters - fromIntegral index)