summaryrefslogtreecommitdiff
path: root/lib/Language
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Language')
-rw-r--r--lib/Language/Elna/Backend/Allocator.hs60
-rw-r--r--lib/Language/Elna/Backend/Intermediate.hs3
-rw-r--r--lib/Language/Elna/Frontend/AST.hs6
-rw-r--r--lib/Language/Elna/Frontend/NameAnalysis.hs6
-rw-r--r--lib/Language/Elna/Frontend/Parser.hs6
-rw-r--r--lib/Language/Elna/Frontend/TypeAnalysis.hs4
-rw-r--r--lib/Language/Elna/Glue.hs18
-rw-r--r--lib/Language/Elna/RiscV/CodeGenerator.hs8
8 files changed, 65 insertions, 46 deletions
diff --git a/lib/Language/Elna/Backend/Allocator.hs b/lib/Language/Elna/Backend/Allocator.hs
index 9a85605..f0f285b 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 Data.Int (Int32)
import Data.Word (Word32)
import Data.Vector (Vector)
import Language.Elna.Backend.Intermediate
@@ -17,11 +18,20 @@ import Language.Elna.Location (Identifier(..))
import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT)
import Control.Monad.Trans.State (State, runState, modify')
import GHC.Records (HasField(..))
-import Control.Monad.Trans.Class (MonadTrans(lift))
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE)
+import Data.List ((!?))
data Store r
= RegisterStore r
- | StackStore Word32 r
+ | StackStore Int32 r
+
+data AllocationError = AllocationError
+ deriving Eq
+
+instance Show AllocationError
+ where
+ show = const "Ran out of registers during register allocation"
newtype MachineConfiguration r = MachineConfiguration
{ temporaryRegisters :: [r]
@@ -32,7 +42,7 @@ newtype MachineState = MachineState
} deriving (Eq, Show)
newtype Allocator r a = Allocator
- { runAllocator :: ReaderT (MachineConfiguration r) (State MachineState) a
+ { runAllocator :: ExceptT AllocationError (ReaderT (MachineConfiguration r) (State MachineState)) a
}
instance forall r. Functor (Allocator r)
@@ -52,20 +62,22 @@ allocate
:: forall r
. MachineConfiguration r
-> HashMap Identifier (Vector (Quadruple Variable))
- -> HashMap Identifier (ProcedureQuadruples (Store r))
-allocate machineConfiguration = fmap function
+ -> Either AllocationError (HashMap Identifier (ProcedureQuadruples (Store r)))
+allocate machineConfiguration = traverse function
where
- function :: Vector (Quadruple Variable) -> ProcedureQuadruples (Store r)
+ run = flip runState (MachineState{ stackSize = 0 })
+ . flip runReaderT machineConfiguration
+ . runExceptT
+ . runAllocator
+ . mapM quadruple
+ function :: Vector (Quadruple Variable) -> Either AllocationError (ProcedureQuadruples (Store r))
function quadruples' =
- let (result, lastState)
- = flip runState (MachineState{ stackSize = 0 })
- $ flip runReaderT machineConfiguration
- $ runAllocator
- $ mapM quadruple quadruples'
- in ProcedureQuadruples
- { quadruples = result
- , stackSize = getField @"stackSize" lastState
- }
+ let (result, lastState) = run quadruples'
+ in makeResult lastState <$> result
+ makeResult MachineState{ stackSize } result = ProcedureQuadruples
+ { quadruples = result
+ , stackSize = stackSize
+ }
quadruple :: Quadruple Variable -> Allocator r (Quadruple (Store r))
quadruple = \case
@@ -131,11 +143,15 @@ operand (VariableOperand variableOperand) =
storeVariable :: Variable -> Allocator r (Store r)
storeVariable (TempVariable index) = do
- temporaryRegisters' <- Allocator $ asks $ getField @"temporaryRegisters"
- pure $ RegisterStore
- $ temporaryRegisters' !! fromIntegral index
+ temporaryRegisters' <- Allocator $ lift $ asks $ getField @"temporaryRegisters"
+ maybe (Allocator $ throwE AllocationError) (pure . RegisterStore)
+ $ temporaryRegisters' !? fromIntegral index
storeVariable (LocalVariable index) = do
- temporaryRegisters' <- Allocator $ asks $ getField @"temporaryRegisters"
- Allocator $ lift $ modify' $ MachineState . (+ 4) . getField @"stackSize"
- pure $ StackStore (index * 4)
- $ temporaryRegisters' !! pred (length temporaryRegisters' - fromIntegral index)
+ 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
+ temporaryRegisters' <- Allocator $ lift $ asks $ getField @"temporaryRegisters"
+ maybe (Allocator $ throwE AllocationError) (pure . StackStore (fromIntegral index * 4))
+ $ temporaryRegisters' !? fromIntegral index
diff --git a/lib/Language/Elna/Backend/Intermediate.hs b/lib/Language/Elna/Backend/Intermediate.hs
index 624bba8..331d044 100644
--- a/lib/Language/Elna/Backend/Intermediate.hs
+++ b/lib/Language/Elna/Backend/Intermediate.hs
@@ -19,13 +19,14 @@ instance Show Label
where
show (Label label) = '.' : Text.unpack label
-data Variable = TempVariable Word32 | LocalVariable Word32
+data Variable = TempVariable Word32 | LocalVariable Word32 | ParameterVariable Word32
deriving Eq
instance Show Variable
where
show (LocalVariable variable) = '@' : show variable
show (TempVariable variable) = '$' : show variable
+ show (ParameterVariable variable) = '%' : show variable
data Operand v
= IntOperand Int32
diff --git a/lib/Language/Elna/Frontend/AST.hs b/lib/Language/Elna/Frontend/AST.hs
index e334370..df00d4b 100644
--- a/lib/Language/Elna/Frontend/AST.hs
+++ b/lib/Language/Elna/Frontend/AST.hs
@@ -71,7 +71,7 @@ data Statement
= EmptyStatement
| IfStatement Condition Statement (Maybe Statement)
| AssignmentStatement VariableAccess Expression
- -- | WhileStatement Condition Statement
+ | WhileStatement Condition Statement
| CompoundStatement [Statement]
| CallStatement Identifier [Expression]
deriving Eq
@@ -86,8 +86,8 @@ instance Show Statement
]
show (AssignmentStatement lhs rhs) =
concat [show lhs, " := ", show rhs, ";"]
- {-show (WhileStatement expression statement) =
- concat ["while (", show expression, ") ", show statement, ";"]-}
+ show (WhileStatement expression statement) =
+ concat ["while (", show expression, ") ", show statement, ";"]
show (CompoundStatement statements) =
concat ["{\n", unlines (show <$> statements), " }"]
show (CallStatement name parameters) = show name <> "("
diff --git a/lib/Language/Elna/Frontend/NameAnalysis.hs b/lib/Language/Elna/Frontend/NameAnalysis.hs
index 97a79e3..fbf5d51 100644
--- a/lib/Language/Elna/Frontend/NameAnalysis.hs
+++ b/lib/Language/Elna/Frontend/NameAnalysis.hs
@@ -175,9 +175,9 @@ statement globalTable (AST.IfStatement ifCondition ifStatement elseStatement)
statement globalTable (AST.AssignmentStatement lvalue rvalue)
= variableAccess globalTable lvalue
>> expression globalTable rvalue
---statement globalTable (AST.WhileStatement whileCondition loop)
--- = condition globalTable whileCondition
--- >> statement globalTable loop
+statement globalTable (AST.WhileStatement whileCondition loop)
+ = condition globalTable whileCondition
+ >> statement globalTable loop
condition :: SymbolTable -> AST.Condition -> NameAnalysis ()
condition globalTable (AST.EqualCondition lhs rhs)
diff --git a/lib/Language/Elna/Frontend/Parser.hs b/lib/Language/Elna/Frontend/Parser.hs
index 98638f7..570c91f 100644
--- a/lib/Language/Elna/Frontend/Parser.hs
+++ b/lib/Language/Elna/Frontend/Parser.hs
@@ -188,7 +188,7 @@ statementP
<|> ifElseP
<|> CompoundStatement <$> blockP (many statementP)
<|> try assignmentP
- -- <|> try whileP
+ <|> try whileP
<|> callP
<?> "statement"
where
@@ -200,9 +200,9 @@ statementP
<$> (symbol "if" *> parensP conditionP)
<*> statementP
<*> optional (symbol "else" *> statementP)
- {-whileP = WhileStatement
+ whileP = WhileStatement
<$> (symbol "while" *> parensP conditionP)
- <*> statementP -}
+ <*> statementP
assignmentP = AssignmentStatement
<$> variableAccessP
<* symbol ":="
diff --git a/lib/Language/Elna/Frontend/TypeAnalysis.hs b/lib/Language/Elna/Frontend/TypeAnalysis.hs
index b9dcac1..c43e80e 100644
--- a/lib/Language/Elna/Frontend/TypeAnalysis.hs
+++ b/lib/Language/Elna/Frontend/TypeAnalysis.hs
@@ -101,11 +101,11 @@ statement globalTable = \case
$ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError lhsType
unless (rhsType == intType)
$ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError rhsType
- {- AST.WhileStatement whileCondition whileStatement -> do
+ AST.WhileStatement whileCondition whileStatement -> do
conditionType <- condition globalTable whileCondition
unless (conditionType == booleanType)
$ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError conditionType
- statement globalTable whileStatement -}
+ statement globalTable whileStatement
AST.IfStatement ifCondition ifStatement elseStatement -> do
conditionType <- condition globalTable ifCondition
unless (conditionType == booleanType)
diff --git a/lib/Language/Elna/Glue.hs b/lib/Language/Elna/Glue.hs
index 02a9b9f..79ae461 100644
--- a/lib/Language/Elna/Glue.hs
+++ b/lib/Language/Elna/Glue.hs
@@ -71,14 +71,16 @@ declaration
:: SymbolTable
-> AST.Declaration
-> Glue (Maybe (AST.Identifier, Vector (Quadruple Variable)))
-declaration globalTable (AST.ProcedureDeclaration procedureName _ variableDeclarations statements)
- = traverse_ registerVariable variableDeclarations
+declaration globalTable (AST.ProcedureDeclaration procedureName parameters variableDeclarations statements)
+ = traverseWithIndex registerVariable variableDeclarations
+ >> traverseWithIndex registerParameter parameters
>> nameQuadruplesTuple <$> traverse (statement globalTable) statements
where
- registerVariable (AST.VariableDeclaration identifier _) = do
- currentCounter <- fmap (fromIntegral . HashMap.size)
- $ Glue $ gets $ getField @"localMap"
- Glue $ modify' $ modifier identifier $ LocalVariable currentCounter
+ traverseWithIndex f = traverse_ (uncurry f) . zip [0..]
+ registerParameter index (AST.Parameter identifier _ _) =
+ Glue $ modify' $ modifier identifier $ ParameterVariable index
+ registerVariable index (AST.VariableDeclaration identifier _) =
+ Glue $ modify' $ modifier identifier $ LocalVariable index
modifier identifier currentCounter generator = generator
{ localMap = HashMap.insert identifier currentCounter
$ getField @"localMap" generator
@@ -131,7 +133,7 @@ statement localTable (AST.AssignmentStatement variableAccess' assignee) = do
. AssignQuadruple rhsOperand
<$> lookupLocal identifier
pure $ rhsStatements <> lhsStatements
-{- statement localTable (AST.WhileStatement whileCondition whileStatement) = do
+statement localTable (AST.WhileStatement whileCondition whileStatement) = do
(conditionStatements, jumpConstructor) <- condition localTable whileCondition
startLabel <- createLabel
endLabel <- createLabel
@@ -141,7 +143,7 @@ statement localTable (AST.AssignmentStatement variableAccess' assignee) = do
<> conditionStatements
<> Vector.fromList [jumpConstructor startLabel, GoToQuadruple endLabel, LabelQuadruple startLabel]
<> whileStatements
- <> Vector.fromList [GoToQuadruple conditionLabel, LabelQuadruple endLabel] -}
+ <> Vector.fromList [GoToQuadruple conditionLabel, LabelQuadruple endLabel]
createTemporary :: Glue Variable
createTemporary = do
diff --git a/lib/Language/Elna/RiscV/CodeGenerator.hs b/lib/Language/Elna/RiscV/CodeGenerator.hs
index 15e8723..a0ad5f9 100644
--- a/lib/Language/Elna/RiscV/CodeGenerator.hs
+++ b/lib/Language/Elna/RiscV/CodeGenerator.hs
@@ -98,7 +98,7 @@ generateRiscV = flip evalState 0
quadruple :: Word32 -> RiscVQuadruple -> RiscVGenerator (Vector Statement)
quadruple stackSize StartQuadruple =
- let totalStackSize = stackSize + 4
+ let totalStackSize = stackSize + 8
in pure $ Vector.fromList
[ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (negate totalStackSize))
, Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 0 RiscV.SW RiscV.SP RiscV.S0)
@@ -106,7 +106,7 @@ quadruple stackSize StartQuadruple =
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.S0 RiscV.ADDI RiscV.SP totalStackSize)
]
quadruple stackSize StopQuadruple =
- let totalStackSize = stackSize + 4
+ let totalStackSize = stackSize + 8
in pure $ Vector.fromList
[ Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.S0 RiscV.LW RiscV.SP 0)
, Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.RA RiscV.LW RiscV.SP 4)
@@ -438,7 +438,7 @@ loadFromStore (RegisterStore register) = (register, mempty)
loadFromStore (StackStore offset register) =
let loadInstruction = Instruction
$ RiscV.BaseInstruction RiscV.Load
- $ RiscV.I register RiscV.LW RiscV.S0 offset
+ $ RiscV.I register RiscV.LW RiscV.S0 (fromIntegral offset)
in (register, Vector.singleton loadInstruction)
storeToStore :: RiscVStore -> (RiscV.XRegister, Vector Statement)
@@ -446,5 +446,5 @@ storeToStore (RegisterStore register) = (register, mempty)
storeToStore (StackStore offset register) =
let storeInstruction = Instruction
$ RiscV.BaseInstruction RiscV.Store
- $ RiscV.S offset RiscV.SW RiscV.S0 register
+ $ RiscV.S (fromIntegral offset) RiscV.SW RiscV.S0 register
in (register, Vector.singleton storeInstruction)
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 21:34:39 +0000