summaryrefslogtreecommitdiff
path: root/lib/Language/Elna/Backend
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Language/Elna/Backend')
-rw-r--r--lib/Language/Elna/Backend/Allocator.hs127
-rw-r--r--lib/Language/Elna/Backend/Intermediate.hs2
2 files changed, 68 insertions, 61 deletions
diff --git a/lib/Language/Elna/Backend/Allocator.hs b/lib/Language/Elna/Backend/Allocator.hs
index acdf3e5..df50d6e 100644
--- a/lib/Language/Elna/Backend/Allocator.hs
+++ b/lib/Language/Elna/Backend/Allocator.hs
@@ -5,6 +5,7 @@ module Language.Elna.Backend.Allocator
) where
import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
import Data.Int (Int32)
import Data.Word (Word32)
import Data.Vector (Vector)
@@ -16,11 +17,13 @@ import Language.Elna.Backend.Intermediate
)
import Language.Elna.Location (Identifier(..))
import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT)
-import Control.Monad.Trans.State (State, runState, modify')
+import Control.Monad.Trans.State (State, runState)
import GHC.Records (HasField(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE)
import Data.List ((!?))
+import Language.Elna.Frontend.SymbolTable (Info(..), SymbolTable)
+import qualified Language.Elna.Frontend.SymbolTable as SymbolTable
data Store r
= RegisterStore r
@@ -38,7 +41,7 @@ newtype MachineConfiguration r = MachineConfiguration
}
newtype MachineState = MachineState
- { stackSize :: Word32
+ { symbolTable :: SymbolTable
} deriving (Eq, Show)
newtype Allocator r a = Allocator
@@ -61,87 +64,92 @@ instance forall r. Monad (Allocator r)
allocate
:: forall r
. MachineConfiguration r
+ -> SymbolTable
-> HashMap Identifier (Vector (Quadruple Variable))
-> Either AllocationError (HashMap Identifier (ProcedureQuadruples (Store r)))
-allocate machineConfiguration = traverse function
+allocate machineConfiguration globalTable = HashMap.traverseWithKey function
where
- run = flip runState (MachineState{ stackSize = 0 })
+ run localTable = flip runState (MachineState{ symbolTable = localTable })
. flip runReaderT machineConfiguration
. runExceptT
. runAllocator
. mapM quadruple
- function :: Vector (Quadruple Variable) -> Either AllocationError (ProcedureQuadruples (Store r))
- function quadruples' =
- let (result, lastState) = run quadruples'
+ function :: Identifier -> Vector (Quadruple Variable) -> Either AllocationError (ProcedureQuadruples (Store r))
+ function identifier quadruples' =
+ let Just (ProcedureInfo localTable _) = SymbolTable.lookup identifier globalTable
+ (result, lastState) = run localTable quadruples'
in makeResult lastState <$> result
- makeResult MachineState{ stackSize } result = ProcedureQuadruples
+ makeResult MachineState{ symbolTable } result = ProcedureQuadruples
{ quadruples = result
- , stackSize = stackSize
+ , stackSize = fromIntegral $ SymbolTable.size symbolTable * 4
}
quadruple :: Quadruple Variable -> Allocator r (Quadruple (Store r))
quadruple = \case
StartQuadruple -> pure StartQuadruple
StopQuadruple -> pure StopQuadruple
- ParameterQuadruple operand1 -> do
- operand1' <- operand operand1
- pure $ ParameterQuadruple operand1'
+ ParameterQuadruple operand1 -> ParameterQuadruple
+ <$> operand operand1
CallQuadruple name count -> pure $ CallQuadruple name count
- AddQuadruple operand1 operand2 variable -> do
- operand1' <- operand operand1
- operand2' <- operand operand2
- AddQuadruple operand1' operand2' <$> storeVariable variable
- SubtractionQuadruple operand1 operand2 variable -> do
- operand1' <- operand operand1
- operand2' <- operand operand2
- SubtractionQuadruple operand1' operand2' <$> storeVariable variable
- NegationQuadruple operand1 variable -> do
- operand1' <- operand operand1
- NegationQuadruple operand1' <$> storeVariable variable
- ProductQuadruple operand1 operand2 variable -> do
- operand1' <- operand operand1
- operand2' <- operand operand2
- ProductQuadruple operand1' operand2' <$> storeVariable variable
- DivisionQuadruple operand1 operand2 variable -> do
- operand1' <- operand operand1
- operand2' <- operand operand2
- DivisionQuadruple operand1' operand2' <$> storeVariable variable
+ 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 -> pure $ LabelQuadruple label
GoToQuadruple label -> pure $ GoToQuadruple label
- EqualQuadruple operand1 operand2 goToLabel -> do
- operand1' <- operand operand1
- operand2' <- operand operand2
- pure $ EqualQuadruple operand1' operand2' goToLabel
- NonEqualQuadruple operand1 operand2 goToLabel -> do
- operand1' <- operand operand1
- operand2' <- operand operand2
- pure $ NonEqualQuadruple operand1' operand2' goToLabel
- LessQuadruple operand1 operand2 goToLabel -> do
- operand1' <- operand operand1
- operand2' <- operand operand2
- pure $ LessQuadruple operand1' operand2' goToLabel
+ EqualQuadruple operand1 operand2 goToLabel -> EqualQuadruple
+ <$> operand operand1
+ <*> operand operand2
+ <*> pure goToLabel
+ NonEqualQuadruple operand1 operand2 goToLabel -> NonEqualQuadruple
+ <$> operand operand1
+ <*> operand operand2
+ <*> pure goToLabel
+ LessQuadruple operand1 operand2 goToLabel -> LessQuadruple
+ <$> operand operand1
+ <*> operand operand2
+ <*> pure goToLabel
GreaterQuadruple operand1 operand2 goToLabel -> do
operand1' <- operand operand1
operand2' <- operand operand2
pure $ GreaterQuadruple operand1' operand2' goToLabel
- LessOrEqualQuadruple operand1 operand2 goToLabel -> do
- operand1' <- operand operand1
- operand2' <- operand operand2
- pure $ LessOrEqualQuadruple operand1' operand2' goToLabel
- GreaterOrEqualQuadruple operand1 operand2 goToLabel -> do
- operand1' <- operand operand1
- operand2' <- operand operand2
- pure $ GreaterOrEqualQuadruple operand1' operand2' goToLabel
- AssignQuadruple operand1 variable -> do
- operand1' <- operand operand1
- AssignQuadruple operand1' <$> storeVariable variable
- ArrayAssignQuadruple operand1 operand2 variable -> do
- operand1' <- operand operand1
- operand2' <- operand operand2
- ArrayAssignQuadruple operand1' operand2' <$> storeVariable variable
+ LessOrEqualQuadruple operand1 operand2 goToLabel -> LessOrEqualQuadruple
+ <$> operand operand1
+ <*> operand operand2
+ <*> pure goToLabel
+ GreaterOrEqualQuadruple operand1 operand2 goToLabel -> GreaterOrEqualQuadruple
+ <$> operand operand1
+ <*> operand operand2
+ <*> pure goToLabel
+ AssignQuadruple operand1 variable -> AssignQuadruple
+ <$> operand operand1
+ <*> storeVariable variable
+ ArrayAssignQuadruple operand1 operand2 variable -> ArrayAssignQuadruple
+ <$> operand operand1
+ <*> operand operand2
+ <*> storeVariable variable
+ ArrayQuadruple variable1 operand1 variable2 -> ArrayQuadruple
+ <$> storeVariable variable1
+ <*> operand operand1
+ <*> storeVariable variable2
operand :: Operand Variable -> Allocator r (Operand (Store r))
-operand (IntOperand x) = pure $ IntOperand x
+operand (IntOperand literalOperand) = pure $ IntOperand literalOperand
operand (VariableOperand variableOperand) =
VariableOperand <$> storeVariable variableOperand
@@ -152,7 +160,6 @@ storeVariable (TempVariable index) = do
$ temporaryRegisters' !? fromIntegral index
storeVariable (LocalVariable index) = do
temporaryRegisters' <- Allocator $ lift $ asks $ getField @"temporaryRegisters"
- Allocator $ lift $ lift $ modify' $ MachineState . (+ 4) . getField @"stackSize"
maybe (Allocator $ throwE AllocationError) (pure . StackStore (fromIntegral (succ index) * (-4)))
$ temporaryRegisters' !? pred (length temporaryRegisters' - fromIntegral index)
storeVariable (ParameterVariable index) = do
diff --git a/lib/Language/Elna/Backend/Intermediate.hs b/lib/Language/Elna/Backend/Intermediate.hs
index dcf0ede..bb0ae7e 100644
--- a/lib/Language/Elna/Backend/Intermediate.hs
+++ b/lib/Language/Elna/Backend/Intermediate.hs
@@ -50,7 +50,7 @@ data Quadruple v
| DivisionQuadruple (Operand v) (Operand v) v
| GoToQuadruple Label
| AssignQuadruple (Operand v) v
- {-| ArrayQuadruple Variable Operand Variable -}
+ | ArrayQuadruple v (Operand v) v
| ArrayAssignQuadruple (Operand v) (Operand v) v
| LessOrEqualQuadruple (Operand v) (Operand v) Label
| GreaterOrEqualQuadruple (Operand v) (Operand v) Label
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 22:29:55 +0000