Implement comparison operators

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

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
+    | ArrayAssignQuadruple Operand Operand Variable -}
-    | NonEqualQuadruple Operand Operand Label
+    | LessOrEqualQuadruple (Operand v) (Operand v) Label
-    | LessQuadruple Operand Operand Label
+    | GreaterOrEqualQuadruple (Operand v) (Operand v) Label
-    | GreaterQuadruple Operand Operand Label
+    | GreaterQuadruple (Operand v) (Operand v) Label
-    | LessOrEqualQuadruple Operand Operand Label
+    | LessQuadruple (Operand v) (Operand v) Label
-    | GreaterOrEqualQuadruple Operand Operand Label -}
+    | NonEqualQuadruple (Operand v) (Operand v) Label
     | EqualQuadruple (Operand v) (Operand v) Label
     | LabelQuadruple Label
     deriving (Eq, Show)

lib/Language/Elna/Frontend/AST.hs

@@ -146,18 +146,18 @@ instance Show VariableAccess
 -}
 data Condition
     = EqualCondition Expression Expression
-    -- | NonEqualCondition Expression Expression
+    | NonEqualCondition Expression Expression
-    -- | LessCondition Expression Expression
+    | LessCondition Expression Expression
-    -- | GreaterCondition Expression Expression
+    | GreaterCondition Expression Expression
-    -- | LessOrEqualCondition Expression Expression
+    | LessOrEqualCondition Expression Expression
-    -- | GreaterOrEqualCondition 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 (NonEqualCondition lhs rhs) = concat [show lhs, " # ", show rhs]
-    -- show (LessCondition 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 (GreaterCondition lhs rhs) = concat [show lhs, " > ", show rhs]
-    -- show (LessOrEqualCondition 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 (GreaterOrEqualCondition lhs rhs) = concat [show lhs, " >= ", show rhs]

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)
+condition globalTable (AST.NonEqualCondition lhs rhs)
---    = expression globalTable lhs
+    = expression globalTable lhs
---    >> expression globalTable rhs
+    >> expression globalTable rhs
---condition globalTable (AST.LessCondition lhs rhs)
+condition globalTable (AST.LessCondition lhs rhs)
---    = expression globalTable lhs
+    = expression globalTable lhs
---    >> expression globalTable rhs
+    >> expression globalTable rhs
---condition globalTable (AST.GreaterCondition lhs rhs)
+condition globalTable (AST.GreaterCondition lhs rhs)
---    = expression globalTable lhs
+    = expression globalTable lhs
---    >> expression globalTable rhs
+    >> expression globalTable rhs
---condition globalTable (AST.LessOrEqualCondition lhs rhs)
+condition globalTable (AST.LessOrEqualCondition lhs rhs)
---    = expression globalTable lhs
+    = expression globalTable lhs
---    >> expression globalTable rhs
+    >> expression globalTable rhs
---condition globalTable (AST.GreaterOrEqualCondition lhs rhs)
+condition globalTable (AST.GreaterOrEqualCondition lhs rhs)
---    = expression globalTable lhs
+    = expression globalTable lhs
---    >> expression globalTable rhs
+    >> expression globalTable rhs
 {-
 variableAccess :: SymbolTable -> AST.VariableAccess -> NameAnalysis ()
 variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression)

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 LessOrEqualCondition
+        , symbol "<" >> pure LessCondition
-        --, symbol ">" >> pure GreaterCondition
+        , symbol ">=" >> pure GreaterOrEqualCondition
-        --, symbol ">=" >> pure GreaterOrEqualCondition
+        , symbol ">" >> pure GreaterCondition
-        [ symbol "=" >> pure EqualCondition
+        , symbol "=" >> pure EqualCondition
-        --, symbol "#" >> pure NonEqualCondition
+        , symbol "#" >> pure NonEqualCondition
         ]
 
 symbol :: Text -> Parser Text
@@ -183,8 +183,8 @@ statementP :: Parser Statement
 statementP
     = EmptyStatement <$ semicolonP
     <|> ifElseP
-    {-<|> CompoundStatement <$> blockP (many statementP)
+    <|> CompoundStatement <$> blockP (many statementP)
-    <|> try assignmentP
+    {-<|> try assignmentP
     <|> try whileP -}
     <|> callP
     <?> "statement"

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
 

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

tests/expectations/printi_if_greater.txt

@@ -0,0 +1 @@
+5

tests/expectations/printi_if_greater_equal.txt

@@ -0,0 +1 @@
+5

tests/expectations/printi_if_less.txt

@@ -0,0 +1 @@
+3

tests/expectations/printi_if_less_equal.txt

@@ -0,0 +1 @@
+3

tests/expectations/printi_if_not.txt

@@ -0,0 +1 @@
+3

tests/expectations/printi_if_not_compound.txt

@@ -0,0 +1,2 @@
+3
+7

tests/vm/printi_if_greater.elna

@@ -0,0 +1,6 @@
+proc main() {
+  if ((1 + 1) > 2)
+    printi(3);
+  else
+    printi(5);
+}

tests/vm/printi_if_greater_equal.elna

@@ -0,0 +1,6 @@
+proc main() {
+  if ((1 + 1) >= (2 + 3))
+    printi(3);
+  else
+    printi(5);
+}

tests/vm/printi_if_less.elna

@@ -0,0 +1,6 @@
+proc main() {
+  if (1 < 2)
+    printi(3);
+  else
+    printi(5);
+}

tests/vm/printi_if_less_equal.elna

@@ -0,0 +1,6 @@
+proc main() {
+  if (2 <= (2 + 1))
+    printi(3);
+  else
+    printi(5);
+}

tests/vm/printi_if_not.elna

@@ -0,0 +1,6 @@
+proc main() {
+  if (1 # 2)
+    printi(3);
+  else
+    printi(5);
+}

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);
+  }
+}