belka/elna
1
0
Fork 0
Code Issues 34 Pull Requests Releases Activity

Implement the while loop

Browse Source
This commit is contained in:
Eugen Wissner
2024-11-24 13:05:11 +01:00
parent 0c9799b887
commit 57b51c5538
10 changed files with 62 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
.ruby-version
View File

@@ -1 +1 @@
3.3.5
3.3.6

50
lib/Language/Elna/Backend/Allocator.hs
View File

@@ -17,12 +17,21 @@ 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
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 +41,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,19 +61,21 @@ 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
let (result, lastState) = run quadruples'
in makeResult lastState <$> result
makeResult MachineState{ stackSize } result = ProcedureQuadruples
{ quadruples = result
, stackSize = getField @"stackSize" lastState
, stackSize = stackSize
}
quadruple :: Quadruple Variable -> Allocator r (Quadruple (Store r))
@@ -131,11 +142,12 @@ 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 (index * 4))
$ temporaryRegisters' !? pred (length temporaryRegisters' - fromIntegral index)

6
lib/Language/Elna/Frontend/AST.hs
View File

@@ -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 <> "("

6
lib/Language/Elna/Frontend/NameAnalysis.hs
View File

@@ -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)

6
lib/Language/Elna/Frontend/Parser.hs
View File

@@ -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 ":="

4
lib/Language/Elna/Frontend/TypeAnalysis.hs
View File

@@ -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)

4
lib/Language/Elna/Glue.hs
View File

@@ -131,7 +131,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 +141,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

5
src/Main.hs
View File

@@ -25,6 +25,7 @@ import Control.Exception (IOException, catch)
-- 3 - Parse error.
-- 4 - Name analysis error.
-- 5 - Type error.
-- 6 - Register allocation error.
main :: IO ()
main = execParser commandLine >>= withCommandLine
@@ -45,9 +46,9 @@ main = execParser commandLine >>= withCommandLine
| Just typeError <- typeAnalysis symbolTable program =
printAndExit 5 typeError
| otherwise =
let instructions = generateRiscV
let makeObject = elfObject output . riscv32Elf . generateRiscV
in either (printAndExit 6) makeObject
$ allocate riscVConfiguration
$ glue symbolTable program
in elfObject output $ riscv32Elf instructions
printAndExit :: Show b => forall a. Int -> b -> IO a
printAndExit failureCode e = print e >> exitWith (ExitFailure failureCode)

1
tests/expectations/print_after_loop.txt Normal file
View File

@@ -0,0 +1 @@
2

9
tests/vm/print_after_loop.elna Normal file
View File

@@ -0,0 +1,9 @@
proc main() {
var x: int;
x := 0;
while (x < 2) {
x := x + 1;
}
printi(x);
}