lib/Language/Elna/Backend/Allocator.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

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

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

data Store r
    = RegisterStore r
    | StackStore Word32 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) = RegisterStore
        $ temporaryRegisters !! fromIntegral index
    storeVariable (LocalVariable index) = RegisterStore
        $ temporaryRegisters !! pred (length temporaryRegisters - fromIntegral index)