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

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

import Data.HashMap.Strict (HashMap)
import Data.Vector (Vector)
import Language.Elna.Backend.Intermediate (Operand(..), Quadruple(..), Variable(..))
import Language.Elna.Location (Identifier(..))

newtype Store r = Store r

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

allocate
    :: forall r
    . MachineConfiguration r
    -> HashMap Identifier (Vector (Quadruple Variable))
    -> HashMap Identifier (Vector (Quadruple (Store r)))
allocate MachineConfiguration{..} = fmap function
  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 (TempVariable index))
        = AddQuadruple (operand operand1) (operand operand2)
        $ Store
        $ temporaryRegisters !! fromIntegral index
    quadruple (SubtractionQuadruple operand1 operand2 (TempVariable index))
        = SubtractionQuadruple (operand operand1) (operand operand2)
        $ Store
        $ temporaryRegisters !! fromIntegral index
    quadruple (NegationQuadruple operand1 (TempVariable index))
        = NegationQuadruple (operand operand1)
        $ Store
        $ temporaryRegisters !! fromIntegral index
    quadruple (ProductQuadruple operand1 operand2 (TempVariable index))
        = ProductQuadruple (operand operand1) (operand operand2)
        $ Store
        $ temporaryRegisters !! fromIntegral index
    quadruple (DivisionQuadruple operand1 operand2 (TempVariable index))
        = DivisionQuadruple (operand operand1) (operand operand2)
        $ Store
        $ temporaryRegisters !! fromIntegral index
    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
    operand :: Operand Variable -> Operand (Store r)
    operand (IntOperand x) = IntOperand x
    operand (VariableOperand (TempVariable index))
        = VariableOperand
        $ Store
        $ temporaryRegisters !! fromIntegral index