summaryrefslogtreecommitdiff
path: root/lib/Language
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Language')
-rw-r--r--lib/Language/Elna/Backend/Allocator.hs36
-rw-r--r--lib/Language/Elna/Backend/Intermediate.hs8
-rw-r--r--lib/Language/Elna/Frontend/AST.hs26
-rw-r--r--lib/Language/Elna/Frontend/NameAnalysis.hs23
-rw-r--r--lib/Language/Elna/Frontend/Parser.hs20
-rw-r--r--lib/Language/Elna/Frontend/TypeAnalysis.hs18
-rw-r--r--lib/Language/Elna/Glue.hs38
-rw-r--r--lib/Language/Elna/RiscV/CodeGenerator.hs13
8 files changed, 95 insertions, 87 deletions
diff --git a/lib/Language/Elna/Backend/Allocator.hs b/lib/Language/Elna/Backend/Allocator.hs
index 2b410a3..0c3e5c3 100644
--- a/lib/Language/Elna/Backend/Allocator.hs
+++ b/lib/Language/Elna/Backend/Allocator.hs
@@ -30,26 +30,21 @@ allocate MachineConfiguration{..} = fmap function
quadruple (ParameterQuadruple operand1) =
ParameterQuadruple (operand operand1)
quadruple (CallQuadruple name count) = CallQuadruple name count
- quadruple (AddQuadruple operand1 operand2 (TempVariable index))
+ quadruple (AddQuadruple operand1 operand2 variable)
= AddQuadruple (operand operand1) (operand operand2)
- $ Store
- $ temporaryRegisters !! fromIntegral index
- quadruple (SubtractionQuadruple operand1 operand2 (TempVariable index))
+ $ storeVariable variable
+ quadruple (SubtractionQuadruple operand1 operand2 variable)
= SubtractionQuadruple (operand operand1) (operand operand2)
- $ Store
- $ temporaryRegisters !! fromIntegral index
- quadruple (NegationQuadruple operand1 (TempVariable index))
+ $ storeVariable variable
+ quadruple (NegationQuadruple operand1 variable)
= NegationQuadruple (operand operand1)
- $ Store
- $ temporaryRegisters !! fromIntegral index
- quadruple (ProductQuadruple operand1 operand2 (TempVariable index))
+ $ storeVariable variable
+ quadruple (ProductQuadruple operand1 operand2 variable)
= ProductQuadruple (operand operand1) (operand operand2)
- $ Store
- $ temporaryRegisters !! fromIntegral index
- quadruple (DivisionQuadruple operand1 operand2 (TempVariable index))
+ $ storeVariable variable
+ quadruple (DivisionQuadruple operand1 operand2 variable)
= DivisionQuadruple (operand operand1) (operand operand2)
- $ Store
- $ temporaryRegisters !! fromIntegral index
+ $ storeVariable variable
quadruple (LabelQuadruple label) = LabelQuadruple label
quadruple (GoToQuadruple label) = GoToQuadruple label
quadruple (EqualQuadruple operand1 operand2 goToLabel) =
@@ -64,9 +59,20 @@ allocate MachineConfiguration{..} = fmap function
LessOrEqualQuadruple (operand operand1) (operand operand2) goToLabel
quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) =
GreaterOrEqualQuadruple (operand operand1) (operand operand2) goToLabel
+ quadruple (AssignQuadruple operand1 variable)
+ = AssignQuadruple (operand operand1)
+ $ storeVariable variable
operand :: Operand Variable -> Operand (Store r)
operand (IntOperand x) = IntOperand x
operand (VariableOperand (TempVariable index))
= VariableOperand
$ Store
$ temporaryRegisters !! fromIntegral index
+ operand (VariableOperand (LocalVariable index))
+ = VariableOperand
+ $ Store
+ $ temporaryRegisters !! fromIntegral index
+ storeVariable (TempVariable index) =
+ Store $ temporaryRegisters !! fromIntegral index
+ storeVariable (LocalVariable index) =
+ Store $ temporaryRegisters !! fromIntegral index
diff --git a/lib/Language/Elna/Backend/Intermediate.hs b/lib/Language/Elna/Backend/Intermediate.hs
index f1a5d7a..c4dcf18 100644
--- a/lib/Language/Elna/Backend/Intermediate.hs
+++ b/lib/Language/Elna/Backend/Intermediate.hs
@@ -17,12 +17,12 @@ instance Show Label
where
show (Label label) = '.' : Text.unpack label
-newtype Variable = TempVariable Word32 -- | Variable Text
+data Variable = TempVariable Word32 | LocalVariable Word32
deriving Eq
instance Show Variable
where
- -- show (Variable variable) = '$' : Text.unpack variable
+ show (LocalVariable variable) = '@' : show variable
show (TempVariable variable) = '$' : show variable
data Operand v
@@ -41,8 +41,8 @@ data Quadruple v
| ProductQuadruple (Operand v) (Operand v) v
| DivisionQuadruple (Operand v) (Operand v) v
| GoToQuadruple Label
- {-| AssignQuadruple Operand Variable
- | ArrayQuadruple Variable Operand Variable
+ | AssignQuadruple (Operand v) v
+ {-| ArrayQuadruple Variable Operand Variable
| ArrayAssignQuadruple Operand Operand Variable -}
| LessOrEqualQuadruple (Operand v) (Operand v) Label
| GreaterOrEqualQuadruple (Operand v) (Operand v) Label
diff --git a/lib/Language/Elna/Frontend/AST.hs b/lib/Language/Elna/Frontend/AST.hs
index 037e6ca..e334370 100644
--- a/lib/Language/Elna/Frontend/AST.hs
+++ b/lib/Language/Elna/Frontend/AST.hs
@@ -6,7 +6,7 @@ module Language.Elna.Frontend.AST
, Statement(..)
, TypeExpression(..)
, VariableDeclaration(..)
- --, VariableAccess(..)
+ , VariableAccess(..)
, Condition(..)
, Expression(..)
, Literal(..)
@@ -70,8 +70,8 @@ instance Show TypeExpression
data Statement
= EmptyStatement
| IfStatement Condition Statement (Maybe Statement)
- {-| AssignmentStatement VariableAccess Expression
- | WhileStatement Condition Statement -}
+ | AssignmentStatement VariableAccess Expression
+ -- | WhileStatement Condition Statement
| CompoundStatement [Statement]
| CallStatement Identifier [Expression]
deriving Eq
@@ -84,9 +84,9 @@ instance Show Statement
, show if'
, maybe "" ((<> " else ") . show) else'
]
- {-show (AssignmentStatement lhs rhs) =
+ show (AssignmentStatement lhs rhs) =
concat [show lhs, " := ", show rhs, ";"]
- show (WhileStatement expression statement) =
+ {-show (WhileStatement expression statement) =
concat ["while (", show expression, ") ", show statement, ";"]-}
show (CompoundStatement statements) =
concat ["{\n", unlines (show <$> statements), " }"]
@@ -163,7 +163,7 @@ data Expression
| NegationExpression Expression
| ProductExpression Expression Expression
| DivisionExpression Expression Expression
- -- | VariableExpression VariableAccess
+ | VariableExpression VariableAccess
deriving Eq
instance Show Expression
@@ -174,19 +174,19 @@ instance Show Expression
show (NegationExpression negation) = '-' : show negation
show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs]
- -- show (VariableExpression variable) = show variable
-{-
-data VariableAccess
+ show (VariableExpression variable) = show variable
+
+newtype VariableAccess
= VariableAccess Identifier
- | ArrayAccess VariableAccess Expression
+ -- | ArrayAccess VariableAccess Expression
deriving Eq
instance Show VariableAccess
where
show (VariableAccess variableName) = show variableName
- show (ArrayAccess arrayAccess elementIndex) =
- concat [show arrayAccess, "[", show elementIndex, "]"]
--}
+ {- show (ArrayAccess arrayAccess elementIndex) =
+ concat [show arrayAccess, "[", show elementIndex, "]"] -}
+
data Condition
= EqualCondition Expression Expression
| NonEqualCondition Expression Expression
diff --git a/lib/Language/Elna/Frontend/NameAnalysis.hs b/lib/Language/Elna/Frontend/NameAnalysis.hs
index 89b1b3b..97a79e3 100644
--- a/lib/Language/Elna/Frontend/NameAnalysis.hs
+++ b/lib/Language/Elna/Frontend/NameAnalysis.hs
@@ -158,9 +158,9 @@ expression globalTable (AST.ProductExpression lhs rhs)
expression globalTable (AST.DivisionExpression lhs rhs)
= expression globalTable lhs
>> expression globalTable rhs
-{- expression globalTable (AST.VariableExpression variableExpression) =
+expression globalTable (AST.VariableExpression variableExpression) =
variableAccess globalTable variableExpression
--}
+
statement :: SymbolTable -> AST.Statement -> NameAnalysis ()
statement _ AST.EmptyStatement = pure ()
statement globalTable (AST.CallStatement name arguments)
@@ -172,9 +172,9 @@ statement globalTable (AST.IfStatement ifCondition ifStatement elseStatement)
= condition globalTable ifCondition
>> statement globalTable ifStatement
>> maybe (pure ()) (statement globalTable) elseStatement
--- statement globalTable (AST.AssignmentStatement lvalue rvalue)
--- = variableAccess globalTable lvalue
--- >> expression globalTable rvalue
+statement globalTable (AST.AssignmentStatement lvalue rvalue)
+ = variableAccess globalTable lvalue
+ >> expression globalTable rvalue
--statement globalTable (AST.WhileStatement whileCondition loop)
-- = condition globalTable whileCondition
-- >> statement globalTable loop
@@ -198,13 +198,13 @@ condition globalTable (AST.LessOrEqualCondition lhs rhs)
condition globalTable (AST.GreaterOrEqualCondition lhs rhs)
= expression globalTable lhs
>> expression globalTable rhs
-{-
+
variableAccess :: SymbolTable -> AST.VariableAccess -> NameAnalysis ()
-variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression)
- = variableAccess globalTable arrayExpression
- >> expression globalTable indexExpression
variableAccess globalTable (AST.VariableAccess identifier) =
checkSymbol globalTable identifier
+{- variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression)
+ = variableAccess globalTable arrayExpression
+ >> expression globalTable indexExpression
enter :: Identifier -> Info -> SymbolTable -> NameAnalysis SymbolTable
enter identifier info table
@@ -216,9 +216,4 @@ identifierAlreadyDefinedError = NameAnalysis
. lift
. throwE
. IdentifierAlreadyDefinedError
-
-variableDeclaration :: AST.VariableDeclaration -> NameAnalysis (Identifier, Info)
-variableDeclaration (AST.VariableDeclaration identifier typeExpression)
- = (identifier,) . VariableInfo False
- <$> dataType typeExpression
-}
diff --git a/lib/Language/Elna/Frontend/Parser.hs b/lib/Language/Elna/Frontend/Parser.hs
index a8e61d2..98638f7 100644
--- a/lib/Language/Elna/Frontend/Parser.hs
+++ b/lib/Language/Elna/Frontend/Parser.hs
@@ -16,7 +16,7 @@ import Language.Elna.Frontend.AST
, Statement(..)
, TypeExpression(..)
, VariableDeclaration(..)
- --, VariableAccess(..)
+ , VariableAccess(..)
, Condition(..)
, Expression(..)
, Literal(..)
@@ -64,7 +64,7 @@ termP :: Parser Expression
termP = choice
[ parensP expressionP
, LiteralExpression <$> literalP
- -- , VariableExpression <$> variableAccessP
+ , VariableExpression <$> variableAccessP
]
operatorTable :: [[Operator Parser Expression]]
@@ -91,13 +91,13 @@ operatorTable =
expressionP :: Parser Expression
expressionP = makeExprParser termP operatorTable
-{-
+
variableAccessP :: Parser VariableAccess
-variableAccessP = do
+variableAccessP = VariableAccess <$> identifierP {- do
identifier <- identifierP
indices <- many $ bracketsP expressionP
- pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices
--}
+ pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices -}
+
conditionP :: Parser Condition
conditionP = do
lhs <- expressionP
@@ -187,8 +187,8 @@ statementP
= EmptyStatement <$ semicolonP
<|> ifElseP
<|> CompoundStatement <$> blockP (many statementP)
- {-<|> try assignmentP
- <|> try whileP -}
+ <|> try assignmentP
+ -- <|> try whileP
<|> callP
<?> "statement"
where
@@ -202,12 +202,12 @@ statementP
<*> optional (symbol "else" *> statementP)
{-whileP = WhileStatement
<$> (symbol "while" *> parensP conditionP)
- <*> statementP
+ <*> statementP -}
assignmentP = AssignmentStatement
<$> variableAccessP
<* symbol ":="
<*> expressionP
- <* semicolonP -}
+ <* semicolonP
variableDeclarationP :: Parser VariableDeclaration
variableDeclarationP = VariableDeclaration
diff --git a/lib/Language/Elna/Frontend/TypeAnalysis.hs b/lib/Language/Elna/Frontend/TypeAnalysis.hs
index 2ddbd1c..b9dcac1 100644
--- a/lib/Language/Elna/Frontend/TypeAnalysis.hs
+++ b/lib/Language/Elna/Frontend/TypeAnalysis.hs
@@ -3,10 +3,11 @@ module Language.Elna.Frontend.TypeAnalysis
, -- Error(..)
) where
+import Control.Applicative (Alternative(..))
import Control.Monad (unless)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Except (Except, runExcept, throwE)
-import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT, ask)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT, ask, asks)
import Data.Foldable (traverse_)
import qualified Data.Vector as Vector
import qualified Language.Elna.Frontend.AST as AST
@@ -22,9 +23,6 @@ typeAnalysis globalTable = either Just (const Nothing)
. runTypeAnalysis
. program
-{-
-import Control.Applicative (Alternative(..))
--}
data Error
= UnexpectedProcedureInfoError Info
| UndefinedSymbolError Identifier
@@ -96,14 +94,14 @@ declaration (AST.TypeDefinition _ _) = pure ()
statement :: SymbolTable -> AST.Statement -> TypeAnalysis ()
statement globalTable = \case
AST.EmptyStatement -> pure ()
- {- AST.AssignmentStatement lhs rhs -> do
+ AST.AssignmentStatement lhs rhs -> do
lhsType <- variableAccess globalTable lhs
rhsType <- expression globalTable rhs
unless (lhsType == intType)
$ 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
@@ -136,7 +134,7 @@ statement globalTable = \case
when (isReferenceParameter && not (isLvalue argument))
$ TypeAnalysis $ lift $ throwE $ ExpectedLvalueError argument
isLvalue (AST.VariableExpression _) = True
- isLvalue _ = False
+ isLvalue _ = False -}
variableAccess :: SymbolTable -> AST.VariableAccess -> TypeAnalysis Type
variableAccess globalTable (AST.VariableAccess identifier) = do
@@ -147,7 +145,7 @@ variableAccess globalTable (AST.VariableAccess identifier) = do
$ UnexpectedVariableInfoError anotherInfo
Nothing -> TypeAnalysis $ lift $ throwE
$ UndefinedSymbolError identifier
-variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression) = do
+{-variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression) = do
arrayType <- variableAccess globalTable arrayExpression
indexType <- expression globalTable indexExpression
unless (indexType == intType)
@@ -159,8 +157,8 @@ variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression) = d
-}
expression :: SymbolTable -> AST.Expression -> TypeAnalysis Type
expression globalTable = \case
- {- AST.VariableExpression variableExpression -> do
- variableAccess globalTable variableExpression -}
+ AST.VariableExpression variableExpression ->
+ variableAccess globalTable variableExpression
AST.LiteralExpression literal' -> literal literal'
AST.NegationExpression negation -> do
operandType <- expression globalTable negation
diff --git a/lib/Language/Elna/Glue.hs b/lib/Language/Elna/Glue.hs
index 880bb1e..8f28696 100644
--- a/lib/Language/Elna/Glue.hs
+++ b/lib/Language/Elna/Glue.hs
@@ -15,13 +15,15 @@ import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Vector as Vector
import Data.Word (Word32)
import qualified Language.Elna.Frontend.AST as AST
+import Language.Elna.Frontend.Types (Type(..))
import Language.Elna.Backend.Intermediate
( Label(..)
, Operand(..)
, Quadruple(..)
, Variable(..)
)
-import Language.Elna.Frontend.SymbolTable (SymbolTable)
+import Language.Elna.Frontend.SymbolTable (Info(..), SymbolTable)
+import qualified Language.Elna.Frontend.SymbolTable as SymbolTable
import GHC.Records (HasField(..))
data Paste = Paste
@@ -98,20 +100,20 @@ statement localTable (AST.IfStatement ifCondition ifStatement elseStatement) = d
<> Vector.snoc ifStatements (LabelQuadruple endLabel)
Nothing -> Vector.fromList [jumpConstructor ifLabel, GoToQuadruple endLabel, LabelQuadruple ifLabel]
<> Vector.snoc ifStatements (LabelQuadruple endLabel)
-{- statement localTable (AST.AssignmentStatement variableAccess' assignee) = do
+statement localTable (AST.AssignmentStatement variableAccess' assignee) = do
(rhsOperand, rhsStatements) <- expression localTable assignee
let variableType' = variableType variableAccess' localTable
accessResult <- variableAccess localTable variableAccess' Nothing variableType' mempty
pure $ rhsStatements <> case accessResult of
- (AST.Identifier identifier, Just accumulatedIndex, accumulatedStatements) ->
+ {-(AST.Identifier identifier, Just accumulatedIndex, accumulatedStatements) ->
Vector.snoc accumulatedStatements
$ ArrayAssignQuadruple rhsOperand accumulatedIndex
- $ Variable identifier
+ $ LocalVariable identifier -}
(AST.Identifier identifier, Nothing, accumulatedStatements) ->
Vector.snoc accumulatedStatements
$ AssignQuadruple rhsOperand
- $ Variable identifier
-statement localTable (AST.WhileStatement whileCondition whileStatement) = do
+ $ LocalVariable 0
+{- statement localTable (AST.WhileStatement whileCondition whileStatement) = do
(conditionStatements, jumpConstructor) <- condition localTable whileCondition
startLabel <- createLabel
endLabel <- createLabel
@@ -189,20 +191,17 @@ condition localTable (AST.GreaterOrEqualCondition lhs rhs) = do
( lhsStatements <> rhsStatements
, GreaterOrEqualQuadruple lhsOperand rhsOperand
)
-{-
-import Language.Elna.Types (Type(..))
-import qualified Language.Elna.SymbolTable as SymbolTable
variableAccess
:: SymbolTable
-> AST.VariableAccess
- -> Maybe Operand
+ -> Maybe (Operand Variable)
-> Type
- -> Vector Quadruple
- -> Glue (AST.Identifier, Maybe Operand, Vector Quadruple)
+ -> Vector (Quadruple Variable)
+ -> Glue (AST.Identifier, Maybe (Operand Variable), Vector (Quadruple Variable))
variableAccess _ (AST.VariableAccess identifier) accumulatedIndex _ accumulatedStatements =
pure (identifier, accumulatedIndex, accumulatedStatements)
-variableAccess localTable (AST.ArrayAccess access1 index1) Nothing (ArrayType _ baseType) _ = do
+{- variableAccess localTable (AST.ArrayAccess access1 index1) Nothing (ArrayType _ baseType) _ = do
(indexPlace, statements) <- expression localTable index1
variableAccess localTable access1 (Just indexPlace) baseType statements
variableAccess localTable (AST.ArrayAccess arrayAccess' arrayIndex) (Just baseIndex) (ArrayType arraySize baseType) statements = do
@@ -216,14 +215,14 @@ variableAccess localTable (AST.ArrayAccess arrayAccess' arrayIndex) (Just baseIn
in variableAccess localTable arrayAccess' (Just resultOperand) baseType
$ statements <> indexCalculation <> statements'
variableAccess _ _ _ _ _ = error "Array access operator doesn't match the type."
-
+-}
variableType :: AST.VariableAccess -> SymbolTable -> Type
variableType (AST.VariableAccess identifier) symbolTable
| Just (TypeInfo type') <- SymbolTable.lookup identifier symbolTable = type'
| otherwise = error "Undefined type."
-variableType (AST.ArrayAccess arrayAccess' _) symbolTable =
- variableType arrayAccess' symbolTable
--}
+{-variableType (AST.ArrayAccess arrayAccess' _) symbolTable =
+ variableType arrayAccess' symbolTable -}
+
expression :: SymbolTable -> AST.Expression -> Glue (Operand Variable, Vector (Quadruple Variable))
expression localTable = \case
(AST.LiteralExpression literal') -> pure (literal literal', mempty)
@@ -242,8 +241,9 @@ expression localTable = \case
binaryExpression ProductQuadruple lhs rhs
(AST.DivisionExpression lhs rhs) ->
binaryExpression DivisionQuadruple lhs rhs
-{- (AST.VariableExpression variableExpression) -> do
- let variableType' = variableType variableExpression localTable
+ (AST.VariableExpression variableExpression) -> do
+ pure (VariableOperand (LocalVariable 0), mempty)
+ {- let variableType' = variableType variableExpression localTable
variableAccess' <- variableAccess localTable variableExpression Nothing variableType' mempty
case variableAccess' of
(AST.Identifier identifier, Nothing, statements) ->
diff --git a/lib/Language/Elna/RiscV/CodeGenerator.hs b/lib/Language/Elna/RiscV/CodeGenerator.hs
index 4be7dfd..c082812 100644
--- a/lib/Language/Elna/RiscV/CodeGenerator.hs
+++ b/lib/Language/Elna/RiscV/CodeGenerator.hs
@@ -427,11 +427,11 @@ quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel)
then pure $ Vector.singleton $ unconditionalJal goToLabel
else pure Vector.empty
| VariableOperand variableOperand1 <- operand1
- , VariableOperand variableOperand2 <- operand2 = do
+ , VariableOperand variableOperand2 <- operand2 =
let Store operandRegister1 = variableOperand1
Store operandRegister2 = variableOperand2
Label goToLabel' = goToLabel
- pure $ Vector.singleton
+ in pure $ Vector.singleton
$ Instruction
$ RiscV.RelocatableInstruction RiscV.Branch
$ RiscV.RBranch goToLabel' RiscV.BGE operandRegister1 operandRegister2
@@ -453,6 +453,15 @@ quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel)
$ Instruction
$ RiscV.RelocatableInstruction RiscV.Branch
$ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister2
+quadruple (AssignQuadruple operand1 (Store register))
+ | IntOperand immediateOperand1 <- operand1 = pure
+ $ lui immediateOperand1 register
+ | VariableOperand variableOperand1 <- operand1 =
+ let Store operandRegister1 = variableOperand1
+ in pure $ Vector.singleton
+ $ Instruction
+ $ RiscV.BaseInstruction RiscV.OpImm
+ $ RiscV.I register RiscV.ADDI operandRegister1 0
unconditionalJal :: Label -> Statement
unconditionalJal (Label goToLabel) = Instruction
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 22:25:56 +0000