83 lines
3.4 KiB
Haskell
83 lines
3.4 KiB
Haskell
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
|