elna/lib/Language/Elna/Backend/Allocator.hs

module Language.Elna.Backend.Allocator
    ( MachineConfiguration(..)
    , Store(..)
    , allocate
    ) where

import Data.Vector (Vector)
import Language.Elna.Backend.Intermediate
    ( ProcedureQuadruples(..)
    , Operand(..)
    , Quadruple(..)
    , Variable(..)
    )

newtype Store r = Store r

newtype MachineConfiguration r = MachineConfiguration
    { temporaryRegisters :: [r]
    }

allocate
    :: forall r
    . MachineConfiguration r
    -> ProcedureQuadruples Variable
    -> ProcedureQuadruples (Store r)
allocate MachineConfiguration{..} (ProcedureQuadruples quadruples) =
    ProcedureQuadruples $ function <$> quadruples
  where
    function :: Vector (Quadruple Variable) -> Vector (Quadruple (Store r))
    function = fmap quadruple
    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
    operand :: Operand Variable -> Operand (Store r)
    operand (IntOperand x) = IntOperand x
    operand (VariableOperand (TempVariable index))
        = VariableOperand
        $ Store
        $ 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