diff --git a/lib/Language/Elna/Backend/Allocator.hs b/lib/Language/Elna/Backend/Allocator.hs index bdbccab..2b410a3 100644 --- a/lib/Language/Elna/Backend/Allocator.hs +++ b/lib/Language/Elna/Backend/Allocator.hs @@ -54,6 +54,16 @@ allocate MachineConfiguration{..} = fmap function quadruple (GoToQuadruple label) = GoToQuadruple label quadruple (EqualQuadruple operand1 operand2 goToLabel) = EqualQuadruple (operand operand1) (operand operand2) goToLabel + quadruple (NonEqualQuadruple operand1 operand2 goToLabel) = + NonEqualQuadruple (operand operand1) (operand operand2) goToLabel + quadruple (LessQuadruple operand1 operand2 goToLabel) = + LessQuadruple (operand operand1) (operand operand2) goToLabel + quadruple (GreaterQuadruple operand1 operand2 goToLabel) = + GreaterQuadruple (operand operand1) (operand operand2) goToLabel + quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) = + LessOrEqualQuadruple (operand operand1) (operand operand2) goToLabel + quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) = + GreaterOrEqualQuadruple (operand operand1) (operand operand2) goToLabel operand :: Operand Variable -> Operand (Store r) operand (IntOperand x) = IntOperand x operand (VariableOperand (TempVariable index)) diff --git a/lib/Language/Elna/Backend/Intermediate.hs b/lib/Language/Elna/Backend/Intermediate.hs index 6d3a1af..f1a5d7a 100644 --- a/lib/Language/Elna/Backend/Intermediate.hs +++ b/lib/Language/Elna/Backend/Intermediate.hs @@ -43,12 +43,12 @@ data Quadruple v | GoToQuadruple Label {-| AssignQuadruple Operand Variable | ArrayQuadruple Variable Operand Variable - | ArrayAssignQuadruple Operand Operand Variable - | NonEqualQuadruple Operand Operand Label - | LessQuadruple Operand Operand Label - | GreaterQuadruple Operand Operand Label - | LessOrEqualQuadruple Operand Operand Label - | GreaterOrEqualQuadruple Operand Operand Label -} + | ArrayAssignQuadruple Operand Operand Variable -} + | LessOrEqualQuadruple (Operand v) (Operand v) Label + | GreaterOrEqualQuadruple (Operand v) (Operand v) Label + | GreaterQuadruple (Operand v) (Operand v) Label + | LessQuadruple (Operand v) (Operand v) Label + | NonEqualQuadruple (Operand v) (Operand v) Label | EqualQuadruple (Operand v) (Operand v) Label | LabelQuadruple Label deriving (Eq, Show) diff --git a/lib/Language/Elna/Frontend/AST.hs b/lib/Language/Elna/Frontend/AST.hs index 68ac581..5918e8e 100644 --- a/lib/Language/Elna/Frontend/AST.hs +++ b/lib/Language/Elna/Frontend/AST.hs @@ -146,18 +146,18 @@ instance Show VariableAccess -} data Condition = EqualCondition Expression Expression - -- | NonEqualCondition Expression Expression - -- | LessCondition Expression Expression - -- | GreaterCondition Expression Expression - -- | LessOrEqualCondition Expression Expression - -- | GreaterOrEqualCondition Expression Expression + | NonEqualCondition Expression Expression + | LessCondition Expression Expression + | GreaterCondition Expression Expression + | LessOrEqualCondition Expression Expression + | GreaterOrEqualCondition Expression Expression deriving Eq instance Show Condition where show (EqualCondition lhs rhs) = concat [show lhs, " = ", show rhs] - -- show (NonEqualCondition lhs rhs) = concat [show lhs, " # ", show rhs] - -- show (LessCondition lhs rhs) = concat [show lhs, " < ", show rhs] - -- show (GreaterCondition lhs rhs) = concat [show lhs, " > ", show rhs] - -- show (LessOrEqualCondition lhs rhs) = concat [show lhs, " <= ", show rhs] - -- show (GreaterOrEqualCondition lhs rhs) = concat [show lhs, " >= ", show rhs] + show (NonEqualCondition lhs rhs) = concat [show lhs, " # ", show rhs] + show (LessCondition lhs rhs) = concat [show lhs, " < ", show rhs] + show (GreaterCondition lhs rhs) = concat [show lhs, " > ", show rhs] + show (LessOrEqualCondition lhs rhs) = concat [show lhs, " <= ", show rhs] + show (GreaterOrEqualCondition lhs rhs) = concat [show lhs, " >= ", show rhs] diff --git a/lib/Language/Elna/Frontend/NameAnalysis.hs b/lib/Language/Elna/Frontend/NameAnalysis.hs index 12e51f8..393ab0d 100644 --- a/lib/Language/Elna/Frontend/NameAnalysis.hs +++ b/lib/Language/Elna/Frontend/NameAnalysis.hs @@ -175,21 +175,21 @@ condition :: SymbolTable -> AST.Condition -> NameAnalysis () condition globalTable (AST.EqualCondition lhs rhs) = expression globalTable lhs >> expression globalTable rhs ---condition globalTable (AST.NonEqualCondition lhs rhs) --- = expression globalTable lhs --- >> expression globalTable rhs ---condition globalTable (AST.LessCondition lhs rhs) --- = expression globalTable lhs --- >> expression globalTable rhs ---condition globalTable (AST.GreaterCondition lhs rhs) --- = expression globalTable lhs --- >> expression globalTable rhs ---condition globalTable (AST.LessOrEqualCondition lhs rhs) --- = expression globalTable lhs --- >> expression globalTable rhs ---condition globalTable (AST.GreaterOrEqualCondition lhs rhs) --- = expression globalTable lhs --- >> expression globalTable rhs +condition globalTable (AST.NonEqualCondition lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +condition globalTable (AST.LessCondition lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +condition globalTable (AST.GreaterCondition lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +condition globalTable (AST.LessOrEqualCondition lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +condition globalTable (AST.GreaterOrEqualCondition lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs {- variableAccess :: SymbolTable -> AST.VariableAccess -> NameAnalysis () variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression) diff --git a/lib/Language/Elna/Frontend/Parser.hs b/lib/Language/Elna/Frontend/Parser.hs index 9dd3206..e85f3b1 100644 --- a/lib/Language/Elna/Frontend/Parser.hs +++ b/lib/Language/Elna/Frontend/Parser.hs @@ -105,12 +105,12 @@ conditionP = do conditionCons lhs <$> expressionP where comparisonOperator = - --, symbol "<" >> pure LessCondition - --, symbol "<=" >> pure LessOrEqualCondition - --, symbol ">" >> pure GreaterCondition - --, symbol ">=" >> pure GreaterOrEqualCondition - [ symbol "=" >> pure EqualCondition - --, symbol "#" >> pure NonEqualCondition + [ symbol "<=" >> pure LessOrEqualCondition + , symbol "<" >> pure LessCondition + , symbol ">=" >> pure GreaterOrEqualCondition + , symbol ">" >> pure GreaterCondition + , symbol "=" >> pure EqualCondition + , symbol "#" >> pure NonEqualCondition ] symbol :: Text -> Parser Text @@ -183,8 +183,8 @@ statementP :: Parser Statement statementP = EmptyStatement <$ semicolonP <|> ifElseP - {-<|> CompoundStatement <$> blockP (many statementP) - <|> try assignmentP + <|> CompoundStatement <$> blockP (many statementP) + {-<|> try assignmentP <|> try whileP -} <|> callP "statement" diff --git a/lib/Language/Elna/Glue.hs b/lib/Language/Elna/Glue.hs index 6b883d7..094254a 100644 --- a/lib/Language/Elna/Glue.hs +++ b/lib/Language/Elna/Glue.hs @@ -157,7 +157,7 @@ condition localTable (AST.EqualCondition lhs rhs) = do ( lhsStatements <> rhsStatements , EqualQuadruple lhsOperand rhsOperand ) -{- condition localTable (AST.NonEqualCondition lhs rhs) = do +condition localTable (AST.NonEqualCondition lhs rhs) = do (lhsOperand, lhsStatements) <- expression localTable lhs (rhsOperand, rhsStatements) <- expression localTable rhs pure @@ -189,7 +189,7 @@ condition localTable (AST.GreaterOrEqualCondition lhs rhs) = do ( lhsStatements <> rhsStatements , GreaterOrEqualQuadruple lhsOperand rhsOperand ) --}{- +{- import Language.Elna.Types (Type(..)) import qualified Language.Elna.SymbolTable as SymbolTable diff --git a/lib/Language/Elna/RiscV/CodeGenerator.hs b/lib/Language/Elna/RiscV/CodeGenerator.hs index 659e0e6..c364ae6 100644 --- a/lib/Language/Elna/RiscV/CodeGenerator.hs +++ b/lib/Language/Elna/RiscV/CodeGenerator.hs @@ -259,11 +259,11 @@ quadruple (EqualQuadruple operand1 operand2 goToLabel) , VariableOperand variableOperand2 <- operand2 = do let Store operandRegister1 = variableOperand1 Store operandRegister2 = variableOperand2 - branchLabel <- createLabel + Label goToLabel' = goToLabel pure $ Vector.singleton $ Instruction $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch branchLabel RiscV.BEQ operandRegister1 operandRegister2 + $ RiscV.RBranch goToLabel' RiscV.BEQ operandRegister1 operandRegister2 | VariableOperand variableOperand1 <- operand1 , IntOperand immediateOperand2 <- operand2 = compareImmediateRegister variableOperand1 immediateOperand2 @@ -279,6 +279,168 @@ quadruple (EqualQuadruple operand1 operand2 goToLabel) $ Instruction $ RiscV.RelocatableInstruction RiscV.Branch $ RiscV.RBranch goToLabel' RiscV.BEQ operandRegister immediateRegister +quadruple (NonEqualQuadruple operand1 operand2 goToLabel) + | IntOperand immediateOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + if immediateOperand1 /= immediateOperand2 + then pure $ Vector.singleton $ unconditionalJal goToLabel + else pure Vector.empty + | VariableOperand variableOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = do + let Store operandRegister1 = variableOperand1 + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + pure $ Vector.singleton + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BNE operandRegister1 operandRegister2 + | VariableOperand variableOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + compareImmediateRegister variableOperand1 immediateOperand2 + | IntOperand immediateOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = + compareImmediateRegister variableOperand2 immediateOperand1 + where + compareImmediateRegister variableOperand immediateOperand = + let statements = lui immediateOperand immediateRegister + Store operandRegister = variableOperand + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BNE operandRegister immediateRegister +quadruple (LessQuadruple operand1 operand2 goToLabel) + | IntOperand immediateOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + if immediateOperand1 < immediateOperand2 + then pure $ Vector.singleton $ unconditionalJal goToLabel + else pure Vector.empty + | VariableOperand variableOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = do + let Store operandRegister1 = variableOperand1 + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + pure $ Vector.singleton + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 operandRegister2 + | VariableOperand variableOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + let statements2 = lui immediateOperand2 immediateRegister + Store operandRegister1 = variableOperand1 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements2 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 immediateRegister + | IntOperand immediateOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = + let statements1 = lui immediateOperand1 immediateRegister + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements1 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BLT immediateRegister operandRegister2 +quadruple (GreaterQuadruple operand1 operand2 goToLabel) + | IntOperand immediateOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + if immediateOperand1 > immediateOperand2 + then pure $ Vector.singleton $ unconditionalJal goToLabel + else pure Vector.empty + | VariableOperand variableOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = do + let Store operandRegister1 = variableOperand1 + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + pure $ Vector.singleton + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister2 operandRegister1 + | VariableOperand variableOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + let statements2 = lui immediateOperand2 immediateRegister + Store operandRegister1 = variableOperand1 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements2 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BLT immediateRegister operandRegister1 + | IntOperand immediateOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = + let statements1 = lui immediateOperand1 immediateRegister + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements1 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister2 immediateRegister +quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) + | IntOperand immediateOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + if immediateOperand1 <= immediateOperand2 + then pure $ Vector.singleton $ unconditionalJal goToLabel + else pure Vector.empty + | VariableOperand variableOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = do + let Store operandRegister1 = variableOperand1 + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + pure $ Vector.singleton + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 operandRegister1 + | VariableOperand variableOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + let statements2 = lui immediateOperand2 immediateRegister + Store operandRegister1 = variableOperand1 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements2 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister1 + | IntOperand immediateOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = + let statements1 = lui immediateOperand1 immediateRegister + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements1 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 immediateRegister +quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) + | IntOperand immediateOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + if immediateOperand1 >= immediateOperand2 + then pure $ Vector.singleton $ unconditionalJal goToLabel + else pure Vector.empty + | VariableOperand variableOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = do + let Store operandRegister1 = variableOperand1 + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + pure $ Vector.singleton + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister1 operandRegister2 + | VariableOperand variableOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + let statements2 = lui immediateOperand2 immediateRegister + Store operandRegister1 = variableOperand1 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements2 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister1 immediateRegister + | IntOperand immediateOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = + let statements1 = lui immediateOperand1 immediateRegister + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements1 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister2 unconditionalJal :: Label -> Statement unconditionalJal (Label goToLabel) = Instruction diff --git a/tests/expectations/printi_if_greater.txt b/tests/expectations/printi_if_greater.txt new file mode 100644 index 0000000..7ed6ff8 --- /dev/null +++ b/tests/expectations/printi_if_greater.txt @@ -0,0 +1 @@ +5 diff --git a/tests/expectations/printi_if_greater_equal.txt b/tests/expectations/printi_if_greater_equal.txt new file mode 100644 index 0000000..7ed6ff8 --- /dev/null +++ b/tests/expectations/printi_if_greater_equal.txt @@ -0,0 +1 @@ +5 diff --git a/tests/expectations/printi_if_less.txt b/tests/expectations/printi_if_less.txt new file mode 100644 index 0000000..00750ed --- /dev/null +++ b/tests/expectations/printi_if_less.txt @@ -0,0 +1 @@ +3 diff --git a/tests/expectations/printi_if_less_equal.txt b/tests/expectations/printi_if_less_equal.txt new file mode 100644 index 0000000..00750ed --- /dev/null +++ b/tests/expectations/printi_if_less_equal.txt @@ -0,0 +1 @@ +3 diff --git a/tests/expectations/printi_if_not.txt b/tests/expectations/printi_if_not.txt new file mode 100644 index 0000000..00750ed --- /dev/null +++ b/tests/expectations/printi_if_not.txt @@ -0,0 +1 @@ +3 diff --git a/tests/expectations/printi_if_not_compound.txt b/tests/expectations/printi_if_not_compound.txt new file mode 100644 index 0000000..dde5d5d --- /dev/null +++ b/tests/expectations/printi_if_not_compound.txt @@ -0,0 +1,2 @@ +3 +7 diff --git a/tests/vm/printi_if_greater.elna b/tests/vm/printi_if_greater.elna new file mode 100644 index 0000000..57d5ba5 --- /dev/null +++ b/tests/vm/printi_if_greater.elna @@ -0,0 +1,6 @@ +proc main() { + if ((1 + 1) > 2) + printi(3); + else + printi(5); +} diff --git a/tests/vm/printi_if_greater_equal.elna b/tests/vm/printi_if_greater_equal.elna new file mode 100644 index 0000000..95eb503 --- /dev/null +++ b/tests/vm/printi_if_greater_equal.elna @@ -0,0 +1,6 @@ +proc main() { + if ((1 + 1) >= (2 + 3)) + printi(3); + else + printi(5); +} diff --git a/tests/vm/printi_if_less.elna b/tests/vm/printi_if_less.elna new file mode 100644 index 0000000..2cee6d8 --- /dev/null +++ b/tests/vm/printi_if_less.elna @@ -0,0 +1,6 @@ +proc main() { + if (1 < 2) + printi(3); + else + printi(5); +} diff --git a/tests/vm/printi_if_less_equal.elna b/tests/vm/printi_if_less_equal.elna new file mode 100644 index 0000000..06a162d --- /dev/null +++ b/tests/vm/printi_if_less_equal.elna @@ -0,0 +1,6 @@ +proc main() { + if (2 <= (2 + 1)) + printi(3); + else + printi(5); +} diff --git a/tests/vm/printi_if_not.elna b/tests/vm/printi_if_not.elna new file mode 100644 index 0000000..aafe182 --- /dev/null +++ b/tests/vm/printi_if_not.elna @@ -0,0 +1,6 @@ +proc main() { + if (1 # 2) + printi(3); + else + printi(5); +} diff --git a/tests/vm/printi_if_not_compound.elna b/tests/vm/printi_if_not_compound.elna new file mode 100644 index 0000000..1149a35 --- /dev/null +++ b/tests/vm/printi_if_not_compound.elna @@ -0,0 +1,9 @@ +proc main() { + if (1 # 2) { + printi(3); + printi(7); + } else { + printi(5); + printi(9); + } +}