Generate IR and target code

4 files changed, 150 insertions, 109 deletions

diff --git a/TODO b/TODO
index 5f1d82f..e12d98e 100644
--- a/TODO
+++ b/TODO
@@ -1,6 +1,8 @@
 # Intermediate code generation
 
-- Traverse the AST and generate IR.
+- Calculate maximum number of arguments that a function can have. Put procedure
+  arguments onto the stack, above the stack pointer. Should the offsets be
+  calculated during IR generation or target code generation?
 
 # ELF generation
 
diff --git a/lib/Language/Elna/CodeGenerator.hs b/lib/Language/Elna/CodeGenerator.hs
index 832917f..3cb5c1d 100644
--- a/lib/Language/Elna/CodeGenerator.hs
+++ b/lib/Language/Elna/CodeGenerator.hs
@@ -4,8 +4,12 @@ module Language.Elna.CodeGenerator
     ) where
 
 import Data.ByteString (ByteString)
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
 import Data.Vector (Vector)
 import qualified Data.Vector as Vector
+import qualified Data.Text.Encoding as Text.Encoding
+import Language.Elna.Location (Identifier(..))
 import Language.Elna.Intermediate (Quadruple(..))
 import qualified Language.Elna.Architecture.RiscV as RiscV
 import Language.Elna.SymbolTable (SymbolTable)
@@ -20,9 +24,27 @@ data Statement
     | JumpLabel ByteString [Directive]
     deriving Eq
 
-generateCode :: SymbolTable -> Vector Quadruple -> Vector Statement
-generateCode _ _ = Vector.fromList
-    [ JumpLabel "main" [GlobalDirective, FunctionDirective]
-    , Instruction (RiscV.CallInstruction "printi")
+generateCode :: SymbolTable -> HashMap Identifier (Vector Quadruple) -> Vector Statement
+generateCode _ = HashMap.foldlWithKey' go Vector.empty
+  where
+    go accumulator (Identifier key) value =
+        let code = Vector.cons (JumpLabel (Text.Encoding.encodeUtf8 key) [GlobalDirective, FunctionDirective])
+                $ Vector.foldMap quadruple value
+         in accumulator <> code
+
+quadruple :: Quadruple -> Vector Statement
+quadruple StartQuadruple = Vector.fromList
+    [ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (negate 4))
+    , Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 0 RiscV.SW RiscV.SP RiscV.S0)
+    , Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 4 RiscV.SW RiscV.SP RiscV.RA)
+    , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.S0 RiscV.ADDI RiscV.SP 4)
+    ]
+quadruple (ParameterQuadruple _) = mempty
+quadruple (CallQuadruple callName _) = Vector.singleton
+    $ Instruction (RiscV.CallInstruction callName)
+quadruple StopQuadruple = Vector.fromList
+    [ Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.S0 RiscV.LW RiscV.SP 0)
+    , Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.RA RiscV.LW RiscV.SP 4)
+    , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP 4)
     , Instruction (RiscV.BaseInstruction RiscV.Jalr $ RiscV.I RiscV.RA RiscV.JALR RiscV.Zero 0)
     ]
diff --git a/lib/Language/Elna/Intermediate.hs b/lib/Language/Elna/Intermediate.hs
index ff2b115..35f5ad2 100644
--- a/lib/Language/Elna/Intermediate.hs
+++ b/lib/Language/Elna/Intermediate.hs
@@ -1,66 +1,36 @@
 module Language.Elna.Intermediate
-    ( Quadruple(..)
+    ( Operand(..)
+    , Quadruple(..)
     {- , Label(..)
-    , Operand(..)
     , Variable(..) -}
     , intermediate
     ) where
 
-import Data.Vector (Vector)
-import qualified Data.Vector as Vector
-import qualified Language.Elna.AST as AST
-import Language.Elna.SymbolTable (SymbolTable{-, Info(..) -})
-
-data Quadruple
-    = StartQuadruple
-    | StopQuadruple
-    deriving (Eq, Show)
-
-intermediate :: SymbolTable -> AST.Program -> {- HashMap AST.Identifier (-} Vector Quadruple --)
-intermediate _globalTable = const $ Vector.fromList [StartQuadruple, StopQuadruple]
-    {- = fst
-    . flip runState mempty
-    . runIntermediate
-    . program globalTable -}
-{-
 import Data.Bifunctor (Bifunctor(..))
-import Data.Int (Int32)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
-import Data.Text (Text)
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+import Data.Int (Int32)
 import Data.Word (Word32)
-import Language.Elna.Types (Type(..))
-import qualified Language.Elna.SymbolTable as SymbolTable
-import Data.Foldable (Foldable(..), foldrM)
-import GHC.Records (HasField(..))
-import qualified Data.Text as Text
-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 Data.Text (Text)
+import qualified Language.Elna.AST as AST
+import Language.Elna.SymbolTable (SymbolTable{-, Info(..) -})
+import Data.Foldable (Foldable(..))
+import Control.Monad.Trans.State (State, runState)
+import Data.Maybe (catMaybes)
 
-data Operand
-    = VariableOperand Variable
-    | IntOperand Int32
+newtype Operand
+    = IntOperand Int32
+    -- | VariableOperand Variable
     deriving (Eq, Show)
 
-newtype Label = Label Text
-    deriving Eq
-
-instance Show Label
-  where
-    show (Label label) = '.' : Text.unpack label
-
-data Variable = Variable Text | TempVariable Int32
-    deriving Eq
-
-instance Show Variable
-  where
-    show (Variable variable) = '$' : Text.unpack variable
-    show (TempVariable variable) = '$' : show variable
-
 data Quadruple
     = StartQuadruple
-    | GoToQuadruple Label
+    | StopQuadruple
+    | ParameterQuadruple Operand
+    | CallQuadruple Text Word32
+    {-| GoToQuadruple Label
     | AssignQuadruple Operand Variable
     | ArrayQuadruple Variable Operand Variable
     | ArrayAssignQuadruple Operand Operand Variable
@@ -75,54 +45,65 @@ data Quadruple
     | GreaterQuadruple Operand Operand Label
     | LessOrEqualQuadruple Operand Operand Label
     | GreaterOrEqualQuadruple Operand Operand Label
-    | LabelQuadruple Label
-    | ParameterQuadruple Operand
-    | CallQuadruple Variable Word32
-    | StopQuadruple
+    | LabelQuadruple Label -}
     deriving (Eq, Show)
 
-createLabel :: Intermediate Label
-createLabel = do
-    currentCounter <- Intermediate $ gets labelCounter
-    Intermediate $ modify' modifier
-    pure
-        $ Label
-        $ Text.Lazy.toStrict
-        $ Text.Builder.toLazyText
-        $ Text.Builder.decimal currentCounter
+newtype Intermediate a = Intermediate
+    { runIntermediate :: State Word32 a }
+
+instance Functor Intermediate
   where
-    modifier generator = generator
-        { labelCounter = getField @"labelCounter" generator + 1
-        }
+    fmap f (Intermediate x) = Intermediate $ f <$> x
 
-createTemporary :: Intermediate Variable
-createTemporary = do
-    currentCounter <- Intermediate $ gets temporaryCounter
-    Intermediate $ modify' modifier
-    pure $ TempVariable currentCounter
+instance Applicative Intermediate
   where
-    modifier generator = generator
-        { temporaryCounter = getField @"temporaryCounter" generator + 1
-        }
+    pure = Intermediate . pure
+    (Intermediate f) <*> (Intermediate x) = Intermediate $ f <*> x
+
+instance Monad Intermediate
+  where
+    (Intermediate x) >>= f = Intermediate $ x >>= (runIntermediate . f)
+
+intermediate :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector Quadruple)
+intermediate globalTable
+    = fst
+    . flip runState 0
+    . runIntermediate
+    . program globalTable
 
 program
     :: SymbolTable
     -> AST.Program
     -> Intermediate (HashMap AST.Identifier (Vector Quadruple))
-program globalTable (AST.Program declarations) =
-    foldrM go HashMap.empty declarations
-  where
-    go (AST.TypeDefinition _ _) accumulator = pure accumulator
-    go (AST.ProcedureDefinition procedureName _ _ statements) accumulator = do
-        translatedStatements <- Vector.cons StartQuadruple
-            . flip Vector.snoc StopQuadruple
-            . fold
-            <$> traverse (statement globalTable) statements
-        pure $ HashMap.insert procedureName translatedStatements accumulator
+program globalTable (AST.Program declarations) = HashMap.fromList . catMaybes
+    <$> traverse (declaration globalTable) declarations
+
+declaration
+    :: SymbolTable
+    -> AST.Declaration
+    -> Intermediate (Maybe (AST.Identifier, Vector Quadruple))
+declaration globalTable (AST.ProcedureDeclaration procedureName _ _ statements)
+    = Just
+    . (procedureName,)
+    . Vector.cons StartQuadruple
+    . flip Vector.snoc StopQuadruple
+    . fold
+    <$> traverse (statement globalTable) statements
+-- declaration (AST.TypeDefinition _ _) accumulator = pure accumulator
 
 statement :: SymbolTable -> AST.Statement -> Intermediate (Vector Quadruple)
 statement _ AST.EmptyStatement = pure mempty
-statement localTable (AST.AssignmentStatement variableAccess' assignee) = do
+statement localTable (AST.CallStatement (AST.Identifier callName) arguments) = do
+    visitedArguments <- traverse (expression localTable) arguments
+    let (parameterStatements, argumentStatements)
+            = bimap (Vector.fromList . fmap ParameterQuadruple) Vector.concat
+            $ unzip visitedArguments
+     in pure
+        $ Vector.snoc (argumentStatements <> parameterStatements)
+        $ CallQuadruple callName
+        $ fromIntegral
+        $ Vector.length argumentStatements
+{- statement localTable (AST.AssignmentStatement variableAccess' assignee) = do
     (rhsOperand, rhsStatements) <- expression localTable assignee
     let variableType' = variableType variableAccess' localTable
     accessResult <- variableAccess localTable variableAccess' Nothing variableType' mempty
@@ -158,18 +139,47 @@ statement localTable (AST.WhileStatement whileCondition whileStatement) = do
         <> Vector.fromList [jumpConstructor startLabel, GoToQuadruple endLabel, LabelQuadruple startLabel]
         <> whileStatements
         <> Vector.fromList [GoToQuadruple conditionLabel, LabelQuadruple endLabel]
-statement localTable (AST.CallStatement (AST.Identifier callName) arguments) = do
-    visitedArguments <- traverse (expression localTable) arguments
-    let (parameterStatements, argumentStatements)
-            = bimap (Vector.fromList . fmap ParameterQuadruple) Vector.concat
-            $ unzip visitedArguments
-     in pure
-        $ Vector.snoc (argumentStatements <> parameterStatements)
-        $ CallQuadruple (Variable callName)
-        $ fromIntegral
-        $ Vector.length argumentStatements
 statement localTable (AST.CompoundStatement statements) =
-    fold <$> traverse (statement localTable) statements
+    fold <$> traverse (statement localTable) statements -}
+
+{-
+import Language.Elna.Types (Type(..))
+import qualified Language.Elna.SymbolTable as SymbolTable
+import GHC.Records (HasField(..))
+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
+
+newtype Label = Label Text
+    deriving Eq
+
+instance Show Label
+  where
+    show (Label label) = '.' : Text.unpack label
+
+createLabel :: Intermediate Label
+createLabel = do
+    currentCounter <- Intermediate $ gets labelCounter
+    Intermediate $ modify' modifier
+    pure
+        $ Label
+        $ Text.Lazy.toStrict
+        $ Text.Builder.toLazyText
+        $ Text.Builder.decimal currentCounter
+  where
+    modifier generator = generator
+        { labelCounter = getField @"labelCounter" generator + 1
+        }
+
+createTemporary :: Intermediate Variable
+createTemporary = do
+    currentCounter <- Intermediate $ gets temporaryCounter
+    Intermediate $ modify' modifier
+    pure $ TempVariable currentCounter
+  where
+    modifier generator = generator
+        { temporaryCounter = getField @"temporaryCounter" generator + 1
+        }
 
 condition
     :: SymbolTable
@@ -245,10 +255,11 @@ variableType (AST.VariableAccess identifier) symbolTable
     | otherwise = error "Undefined type."
 variableType (AST.ArrayAccess arrayAccess' _) symbolTable =
     variableType arrayAccess' symbolTable
-
+-}
 expression :: SymbolTable -> AST.Expression -> Intermediate (Operand, Vector Quadruple)
-expression localTable = \case
-    (AST.VariableExpression variableExpression) -> do
+expression _localTable = \case
+    (AST.LiteralExpression literal') -> pure (literal literal', mempty)
+{-    (AST.VariableExpression variableExpression) -> do
         let variableType' = variableType variableExpression localTable
         variableAccess' <- variableAccess localTable variableExpression Nothing variableType' mempty
         case variableAccess' of
@@ -261,7 +272,6 @@ expression localTable = \case
                     ( VariableOperand arrayAddress
                     , Vector.snoc statements arrayStatement
                     )
-    (AST.LiteralExpression literal') -> pure (literal literal', mempty)
     (AST.NegationExpression negation) -> do
         (operand, statements) <- expression localTable negation
         tempVariable <- createTemporary
@@ -288,11 +298,18 @@ expression localTable = \case
             , Vector.snoc (lhsStatements <> rhsStatements) newQuadruple
             )
 
+data Variable = Variable Text | TempVariable Int32
+    deriving Eq
+
+instance Show Variable
+  where
+    show (Variable variable) = '$' : Text.unpack variable
+    show (TempVariable variable) = '$' : show variable
+-}
 literal :: AST.Literal -> Operand
 literal (AST.IntegerLiteral integer) = IntOperand integer
-literal (AST.HexadecimalLiteral integer) = IntOperand integer
+{-literal (AST.HexadecimalLiteral integer) = IntOperand integer
 literal (AST.CharacterLiteral character) = IntOperand $ fromIntegral character
 literal (AST.BooleanLiteral boolean)
     | boolean = IntOperand 1
-    | otherwise = IntOperand 0
--}
+    | otherwise = IntOperand 0 -}
diff --git a/tools/builtin.s b/tools/builtin.s
index e75aaea..17e262d 100644
--- a/tools/builtin.s
+++ b/tools/builtin.s
@@ -6,10 +6,10 @@
 
 .text
 printi:
-    addi sp, sp, -8
+    addi sp, sp, -4
     sw s0, 0(sp)
     sw ra, 4(sp)
-    addi s0, sp, 8
+    addi s0, sp, 4
 
     addi t0, a0, 0
     addi a0, a0, '0'
@@ -28,7 +28,7 @@ printi:
 
     lw s0, 0(sp)
     lw ra, 4(sp)
-    addi sp, sp, 8
+    addi sp, sp, 4
     ret
 
 _start: