73 lines
3.2 KiB
Haskell
73 lines
3.2 KiB
Haskell
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
|