Implement if statements with equality

TODO

@@ -14,7 +14,6 @@
 - Sort the symbols so that local symbols come first. Some table header had a
   number specifiying the index of the first non-local symbol. Adjust that number.
 
-
 # Name analysis
 
 - Format error messages.

lib/Language/Elna/Architecture/RiscV.hs

@@ -146,6 +146,7 @@ data RelocationType
     | RLower12S Text Funct3 XRegister XRegister
     | RHigher20 XRegister Text -- Type U.
     | RBranch Text Funct3 XRegister XRegister -- Type B.
+    | RJal XRegister Text -- Type J.
     deriving Eq
 
 data Instruction
@@ -304,6 +305,7 @@ relocationType (RLower12I rd funct3' rs1 _) = type' $ I rd funct3' rs1 0
 relocationType (RLower12S _ funct3' rs1 rs2) = type' $ S 0 funct3' rs1 rs2
 relocationType (RHigher20 rd _) = type' $ U rd 0
 relocationType (RBranch _ funct3' rs1 rs2) = type' $ B 0 funct3' rs1 rs2
+relocationType (RJal rd _) = type' $ J rd 0
 
 instruction :: Instruction -> ByteString.Builder.Builder
 instruction = \case

lib/Language/Elna/Backend/Allocator.hs

@@ -50,6 +50,10 @@ allocate MachineConfiguration{..} = fmap function
         = DivisionQuadruple (operand operand1) (operand operand2)
         $ Store
         $ temporaryRegisters !! fromIntegral index
+    quadruple (LabelQuadruple label) = LabelQuadruple label
+    quadruple (GoToQuadruple label) = GoToQuadruple label
+    quadruple (EqualQuadruple operand1 operand2 goToLabel) =
+        EqualQuadruple (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

@@ -1,13 +1,21 @@
 module Language.Elna.Backend.Intermediate
     ( Operand(..)
     , Quadruple(..)
-    {- , Label(..) -}
+    , Label(..)
     , Variable(..)
     ) where
 
 import Data.Int (Int32)
 import Data.Word (Word32)
 import Data.Text (Text)
+import qualified Data.Text as Text
+
+newtype Label = Label { unLabel :: Text }
+    deriving Eq
+
+instance Show Label
+  where
+    show (Label label) = '.' : Text.unpack label
 
 newtype Variable = TempVariable Word32 -- | Variable Text
     deriving Eq
@@ -32,15 +40,15 @@ data Quadruple v
     | NegationQuadruple (Operand v) v
     | ProductQuadruple (Operand v) (Operand v) v
     | DivisionQuadruple (Operand v) (Operand v) v
-    {-| GoToQuadruple Label
-    | AssignQuadruple Operand Variable
+    | GoToQuadruple Label
+    {-| AssignQuadruple Operand Variable
     | ArrayQuadruple Variable Operand Variable
     | ArrayAssignQuadruple Operand Operand Variable
-    | EqualQuadruple Operand Operand Label
     | NonEqualQuadruple Operand Operand Label
     | LessQuadruple Operand Operand Label
     | GreaterQuadruple Operand Operand Label
     | LessOrEqualQuadruple Operand Operand Label
-    | GreaterOrEqualQuadruple Operand Operand Label
-    | LabelQuadruple Label -}
+    | GreaterOrEqualQuadruple Operand Operand Label -}
+    | EqualQuadruple (Operand v) (Operand v) Label
+    | LabelQuadruple Label
     deriving (Eq, Show)

lib/Language/Elna/Frontend/AST.hs

@@ -6,8 +6,8 @@ module Language.Elna.Frontend.AST
     , Statement(..)
     , TypeExpression(..)
     , VariableDeclaration(..)
-    {-, VariableAccess(..)
-    , Condition(..)-}
+    --, VariableAccess(..)
+    , Condition(..)
     , Expression(..)
     , Literal(..)
     ) where
@@ -67,8 +67,8 @@ instance Show TypeExpression
 
 data Statement
     = EmptyStatement
-    {-| AssignmentStatement VariableAccess Expression
     | IfStatement Condition Statement (Maybe Statement)
+    {-| AssignmentStatement VariableAccess Expression
     | WhileStatement Condition Statement -}
     | CompoundStatement [Statement]
     | CallStatement Identifier [Expression]
@@ -77,13 +77,13 @@ data Statement
 instance Show Statement
   where
     show EmptyStatement = ";"
-    {-show (AssignmentStatement lhs rhs) =
-        concat [show lhs, " := ", show rhs, ";"]
     show (IfStatement condition if' else') = concat
         [ "if (", show condition, ") "
         , show if'
         , maybe "" ((<> " else ") . show) else'
         ]
+    {-show (AssignmentStatement lhs rhs) =
+        concat [show lhs, " := ", show rhs, ";"]
     show (WhileStatement expression statement) =
         concat ["while (", show expression, ") ", show statement, ";"]-}
     show (CompoundStatement statements) =
@@ -143,22 +143,21 @@ instance Show VariableAccess
     show (VariableAccess variableName) = show variableName
     show (ArrayAccess arrayAccess elementIndex) =
         concat [show arrayAccess, "[", show elementIndex, "]"]
-
+-}
 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]

lib/Language/Elna/Frontend/NameAnalysis.hs

@@ -160,17 +160,37 @@ statement globalTable (AST.CallStatement name arguments)
     >> traverse_ (expression globalTable) arguments
 statement globalTable (AST.CompoundStatement statements) =
     traverse_ (statement globalTable) statements
-{- statement globalTable (AST.AssignmentStatement lvalue rvalue)
-    = variableAccess globalTable lvalue
-    >> expression globalTable rvalue
 statement globalTable (AST.IfStatement ifCondition ifStatement elseStatement)
     = condition globalTable ifCondition
     >> statement globalTable ifStatement
     >> maybe (pure ()) (statement globalTable) elseStatement
-statement globalTable (AST.WhileStatement whileCondition loop)
-    = condition globalTable whileCondition
-    >> statement globalTable loop
+-- statement globalTable (AST.AssignmentStatement lvalue rvalue)
+--    = variableAccess globalTable lvalue
+--    >> expression globalTable rvalue
+--statement globalTable (AST.WhileStatement whileCondition loop)
+--    = condition globalTable whileCondition
+--    >> statement globalTable loop
 
+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
+{-
 variableAccess :: SymbolTable -> AST.VariableAccess -> NameAnalysis ()
 variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression)
     = variableAccess globalTable arrayExpression
@@ -178,26 +198,6 @@ variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression)
 variableAccess globalTable (AST.VariableAccess identifier) =
     checkSymbol globalTable identifier
 
-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
-
 enter :: Identifier -> Info -> SymbolTable -> NameAnalysis SymbolTable
 enter identifier info table
     = maybe (identifierAlreadyDefinedError identifier) pure

lib/Language/Elna/Frontend/Parser.hs

@@ -16,8 +16,8 @@ import Language.Elna.Frontend.AST
     , Statement(..)
     , TypeExpression(..)
     , VariableDeclaration(..)
-    {-, VariableAccess(..)
-    , Condition(..)-}
+    --, VariableAccess(..)
+    , Condition(..)
     , Expression(..)
     , Literal(..)
     )
@@ -97,7 +97,7 @@ variableAccessP = do
     identifier <- identifierP
     indices <- many $ bracketsP expressionP
     pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices
-
+-}
 conditionP :: Parser Condition
 conditionP = do
     lhs <- expressionP
@@ -105,14 +105,14 @@ 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 LessCondition
+        --, symbol "<=" >> pure LessOrEqualCondition
+        --, symbol ">" >> pure GreaterCondition
+        --, symbol ">=" >> pure GreaterOrEqualCondition
+        [ symbol "=" >> pure EqualCondition
+        --, symbol "#" >> pure NonEqualCondition
         ]
--}
+
 symbol :: Text -> Parser Text
 symbol = Lexer.symbol space
 
@@ -182,22 +182,22 @@ procedureDeclarationP = procedureCons
 statementP :: Parser Statement
 statementP
     = EmptyStatement <$ semicolonP
+    <|> ifElseP
     {-<|> CompoundStatement <$> blockP (many statementP)
     <|> try assignmentP
-    <|> try ifElseP
     <|> try whileP -}
-    <|> try callP
+    <|> callP
     <?> "statement"
   where
     callP = CallStatement
         <$> identifierP
         <*> parensP (sepBy expressionP commaP)
         <* semicolonP
-    {-ifElseP = IfStatement
+    ifElseP = IfStatement
         <$> (symbol "if" *> parensP conditionP)
         <*> statementP
         <*> optional (symbol "else" *> statementP)
-    whileP = WhileStatement
+    {-whileP = WhileStatement
         <$> (symbol "while" *> parensP conditionP)
         <*> statementP
     assignmentP = AssignmentStatement

lib/Language/Elna/Glue.hs

@@ -9,15 +9,24 @@ import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (catMaybes)
 import Data.Vector (Vector)
+import qualified Data.Text.Lazy.Builder.Int as Text.Builder
+import qualified Data.Text.Lazy.Builder as Text.Builder
+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.Backend.Intermediate (Operand(..), Quadruple(..), Variable(..))
+import Language.Elna.Backend.Intermediate
+    ( Label(..)
+    , Operand(..)
+    , Quadruple(..)
+    , Variable(..)
+    )
 import Language.Elna.Frontend.SymbolTable (SymbolTable)
 import GHC.Records (HasField(..))
 
-newtype Paste = Paste
+data Paste = Paste
     { temporaryCounter :: Word32
+    , labelCounter :: Word32
     }
 
 newtype Glue a = Glue
@@ -39,7 +48,7 @@ instance Monad Glue
 glue :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector (Quadruple Variable))
 glue globalTable
     = fst
-    . flip runState Paste{ temporaryCounter = 0 }
+    . flip runState Paste{ temporaryCounter = 0, labelCounter = 0 }
     . runGlue
     . program globalTable
 
@@ -77,6 +86,18 @@ statement localTable (AST.CallStatement (AST.Identifier callName) arguments) = d
         $ Vector.length argumentStatements
 statement localTable (AST.CompoundStatement statements) =
     fold <$> traverse (statement localTable) statements
+statement localTable (AST.IfStatement ifCondition ifStatement elseStatement) = do
+    (conditionStatements, jumpConstructor) <- condition localTable ifCondition
+    ifLabel <- createLabel
+    endLabel <- createLabel
+    ifStatements <- statement localTable ifStatement
+    possibleElseStatements <- traverse (statement localTable) elseStatement
+    pure $ conditionStatements <> case possibleElseStatements of
+        Just elseStatements -> Vector.cons (jumpConstructor ifLabel) elseStatements
+            <> Vector.fromList [GoToQuadruple endLabel, LabelQuadruple ifLabel]
+            <> 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
     (rhsOperand, rhsStatements) <- expression localTable assignee
     let variableType' = variableType variableAccess' localTable
@@ -90,18 +111,6 @@ statement localTable (AST.CompoundStatement statements) =
                 Vector.snoc accumulatedStatements
                     $ AssignQuadruple rhsOperand
                     $ Variable identifier
-statement localTable (AST.IfStatement ifCondition ifStatement elseStatement) = do
-    (conditionStatements, jumpConstructor) <- condition localTable ifCondition
-    ifLabel <- createLabel
-    endLabel <- createLabel
-    ifStatements <- statement localTable ifStatement
-    possibleElseStatements <- traverse (statement localTable) elseStatement
-    pure $ conditionStatements <> case possibleElseStatements of
-        Just elseStatements -> Vector.cons (jumpConstructor ifLabel) elseStatements
-            <> Vector.fromList [GoToQuadruple endLabel, LabelQuadruple ifLabel]
-            <> Vector.snoc ifStatements (LabelQuadruple endLabel)
-        Nothing -> Vector.fromList [jumpConstructor ifLabel, GoToQuadruple endLabel, LabelQuadruple ifLabel]
-            <> Vector.snoc ifStatements (LabelQuadruple endLabel)
 statement localTable (AST.WhileStatement whileCondition whileStatement) = do
     (conditionStatements, jumpConstructor) <- condition localTable whileCondition
     startLabel <- createLabel
@@ -124,21 +133,23 @@ createTemporary = do
         { temporaryCounter = getField @"temporaryCounter" generator + 1
         }
 
-{-
-import Language.Elna.Types (Type(..))
-import qualified Language.Elna.SymbolTable as SymbolTable
-
-newtype Label = Label Text
-    deriving Eq
-
-instance Show Label
+createLabel :: Glue Label
+createLabel = do
+    currentCounter <- Glue $ gets $ getField @"labelCounter"
+    Glue $ modify' modifier
+    pure $ Label
+        $ Text.Lazy.toStrict
+        $ Text.Builder.toLazyText
+        $ "L" <> Text.Builder.decimal currentCounter
   where
-    show (Label label) = '.' : Text.unpack label
+    modifier generator = generator
+        { labelCounter = getField @"labelCounter" generator + 1
+        }
 
 condition
     :: SymbolTable
     -> AST.Condition
-    -> Glue (Vector Quadruple, Label -> Quadruple)
+    -> Glue (Vector (Quadruple Variable), Label -> Quadruple Variable)
 condition localTable (AST.EqualCondition lhs rhs) = do
     (lhsOperand, lhsStatements) <- expression localTable lhs
     (rhsOperand, rhsStatements) <- expression localTable rhs
@@ -146,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
@@ -178,6 +189,9 @@ 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

lib/Language/Elna/RiscV/CodeGenerator.hs

@@ -13,7 +13,7 @@ import Data.Vector (Vector)
 import qualified Data.Vector as Vector
 import qualified Language.Elna.Architecture.RiscV as RiscV
 import Language.Elna.Backend.Allocator (MachineConfiguration(..), Store(..))
-import Language.Elna.Backend.Intermediate (Operand(..), Quadruple(..))
+import Language.Elna.Backend.Intermediate (Label(..), Operand(..), Quadruple(..))
 import Language.Elna.Location (Identifier(..))
 import Data.Bits (Bits(..))
 import Data.Foldable (Foldable(..), foldlM)
@@ -45,6 +45,10 @@ riscVConfiguration = MachineConfiguration
         ]
     }
 
+-- | Reserved register used for calculations to save an immediate temporary.
+immediateRegister :: RiscV.XRegister
+immediateRegister = RiscV.A7
+
 type RiscVStore = Store RiscV.XRegister
 type RiscVQuadruple = Quadruple RiscVStore
 type RiscVOperand = Operand RiscVStore
@@ -243,6 +247,43 @@ quadruple (DivisionQuadruple operand1 operand2 (Store register))
             $ RiscV.BaseInstruction RiscV.Op
             $ RiscV.R register RiscV.DIV register operandRegister2
             $ RiscV.Funct7 0b0000001
+quadruple (LabelQuadruple (Label label)) = pure $ Vector.singleton $ JumpLabel label mempty
+quadruple (GoToQuadruple label) = pure $ Vector.singleton $ unconditionalJal label
+quadruple (EqualQuadruple 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
+        branchLabel <- createLabel
+        pure $ Vector.singleton
+            $ Instruction
+            $ RiscV.RelocatableInstruction RiscV.Branch
+            $ RiscV.RBranch branchLabel RiscV.BEQ 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.BEQ operandRegister immediateRegister
+
+unconditionalJal :: Label -> Statement
+unconditionalJal (Label goToLabel) = Instruction
+    $ RiscV.RelocatableInstruction RiscV.Jal
+    $ RiscV.RJal RiscV.Zero goToLabel
 
 loadImmediateOrRegister :: RiscVOperand -> RiscV.XRegister -> (RiscV.XRegister, Vector Statement)
 loadImmediateOrRegister (IntOperand intValue) targetRegister =

lib/Language/Elna/RiscV/ElfWriter.hs

@@ -236,8 +236,8 @@ riscv32Elf code objectHandle = text
                             , st_info = stInfo STB_GLOBAL STT_FUNC
                             }
                         result =
-                            ( encoded <> encoded'
-                            , relocations <> relocations'
+                            ( encoded'
+                            , relocations'
                             , ElfHeaderResult (names <> Text.encodeUtf8 labelName <> "\0") (Vector.snoc symbols newEntry)
                             , definitions'
                             )
@@ -260,6 +260,9 @@ riscv32Elf code objectHandle = text
                         | RiscV.RBranch symbolName _ _ _ <- instructionType
                             -> Just -- R_RISCV_BRANCH
                             $ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 16
+                        | RiscV.RJal _ symbolName <- instructionType
+                            -> Just -- R_RISCV_JAL
+                            $ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 17
                     RiscV.CallInstruction symbolName
                         -> Just -- R_RISCV_CALL_PLT
                         $ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 19

tests/expectations/printi_if.txt

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

tests/vm/printi_if.elna

@@ -0,0 +1,4 @@
+proc main() {
+  if (1 = 1)
+    printi(3);
+}