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
    ( ProcedureQuadruples(..)
    , 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 (ProcedureQuadruples (Store r))
allocate MachineConfiguration{..} = fmap function
  where
    function :: Vector (Quadruple Variable) -> ProcedureQuadruples (Store r)
    function quadruples' = ProcedureQuadruples
        { quadruples = quadruple <$> quadruples'
        , stackSize = 0
        }
    quadruple :: Quadruple Variable -> Quadruple (Store r)
    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 variableOperand) =
        VariableOperand $ storeVariable variableOperand
    storeVariable (TempVariable index) = Store
        $ temporaryRegisters !! fromIntegral index
    storeVariable (LocalVariable index) = Store
        $ temporaryRegisters !! pred (length temporaryRegisters - fromIntegral index)