81 lines
3.4 KiB
Haskell
81 lines
3.4 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
|
|
( 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)
|