Add allocator convertion functions

TODO

@@ -25,4 +25,7 @@
 - Temporary variables always use the same register, t0. Allocate registers for
   temporaries.
 
-# Type analysis
+# Other
+
+- Type analysis.
+- Move platform dependent code generation into a submodule.

lib/Language/Elna/Allocator.hs

@@ -1,3 +1,39 @@
 module Language.Elna.Allocator
-    (
+    ( MachineConfiguration(..)
+    , Store(..)
+    , allocate
     ) where
+
+import Data.HashMap.Strict (HashMap)
+import Data.Vector (Vector)
+import Language.Elna.Intermediate (Operand(..), Quadruple(..), Variable(..))
+import Language.Elna.Location (Identifier(..))
+
+newtype Store r = Store r
+
+newtype MachineConfiguration r = MachineConfiguration
+    { temporaryRegister :: r
+    }
+
+allocate
+    :: forall r
+    . MachineConfiguration r
+    -> HashMap Identifier (Vector (Quadruple Variable))
+    -> HashMap Identifier (Vector (Quadruple (Store r)))
+allocate MachineConfiguration{..} = fmap function
+  where
+    function :: Vector (Quadruple Variable) -> Vector (Quadruple (Store r))
+    function = fmap quadruple
+    quadruple :: Quadruple Variable -> Quadruple (Store r)
+    quadruple StartQuadruple = StartQuadruple
+    quadruple StopQuadruple = StopQuadruple
+    quadruple (ParameterQuadruple operand1) =
+        ParameterQuadruple (operand operand1)
+    quadruple (CallQuadruple name count) = CallQuadruple name count
+    quadruple (AddQuadruple operand1 operand2 _) =
+        AddQuadruple (operand operand1) (operand operand2) (Store temporaryRegister)
+    quadruple (SubtractionQuadruple operand1 operand2 _) =
+        SubtractionQuadruple (operand operand1) (operand operand2) (Store temporaryRegister)
+    operand :: Operand Variable -> Operand (Store r)
+    operand (IntOperand x) = IntOperand x
+    operand (VariableOperand _) = VariableOperand (Store temporaryRegister)

lib/Language/Elna/CodeGenerator.hs

@@ -1,6 +1,7 @@
 module Language.Elna.CodeGenerator
     ( Statement(..)
-    , generateCode
+    , generateRiscV
+    , riscVConfiguration
     ) where
 
 import Data.ByteString (ByteString)
@@ -10,10 +11,10 @@ import Data.Int (Int32)
 import Data.Vector (Vector)
 import qualified Data.Vector as Vector
 import qualified Data.Text.Encoding as Text.Encoding
+import Language.Elna.Allocator (MachineConfiguration(..), Store(..))
 import Language.Elna.Location (Identifier(..))
-import Language.Elna.Intermediate (Operand(..), Quadruple(..), Variable(..))
+import Language.Elna.Intermediate (Operand(..), Quadruple(..))
 import qualified Language.Elna.Architecture.RiscV as RiscV
-import Language.Elna.SymbolTable (SymbolTable)
 import Data.Bits (Bits(..))
 
 data Directive
@@ -26,15 +27,24 @@ data Statement
     | JumpLabel ByteString [Directive]
     deriving Eq
 
-generateCode :: SymbolTable -> HashMap Identifier (Vector Quadruple) -> Vector Statement
-generateCode _ = HashMap.foldlWithKey' go Vector.empty
+riscVConfiguration :: MachineConfiguration RiscV.XRegister
+riscVConfiguration = MachineConfiguration
+    { temporaryRegister = RiscV.T0
+    }
+
+type RiscVStore = Store RiscV.XRegister
+type RiscVQuadruple = Quadruple RiscVStore
+type RiscVOperand = Operand RiscVStore
+
+generateRiscV :: HashMap Identifier (Vector RiscVQuadruple) -> Vector Statement
+generateRiscV = 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 :: RiscVQuadruple -> 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)
@@ -57,25 +67,25 @@ quadruple StopQuadruple = Vector.fromList
     , 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)
     ]
-quadruple (AddQuadruple operand1 operand2 (TempVariable _)) =
+quadruple (AddQuadruple operand1 operand2 (Store register)) =
     let (operandRegister1, statements1) = loadImmediateOrRegister operand1 RiscV.A0
         (operandRegister2, statements2) = loadImmediateOrRegister operand2 RiscV.A1
      in Vector.snoc (statements1 <> statements2)
         $ Instruction
         $ RiscV.BaseInstruction RiscV.Op
-        $ RiscV.R RiscV.T0 RiscV.ADD operandRegister1 operandRegister2 (RiscV.Funct7 0b0000000)
-quadruple (SubtractionQuadruple operand1 operand2 (TempVariable _)) =
+        $ RiscV.R register RiscV.ADD operandRegister1 operandRegister2 (RiscV.Funct7 0b0000000)
+quadruple (SubtractionQuadruple operand1 operand2 (Store register)) =
     let (operandRegister1, statements1) = loadImmediateOrRegister operand1 RiscV.A0
         (operandRegister2, statements2) = loadImmediateOrRegister operand2 RiscV.A1
      in Vector.snoc (statements1 <> statements2)
         $ Instruction
         $ RiscV.BaseInstruction RiscV.Op
-        $ RiscV.R RiscV.T0 RiscV.SUB operandRegister1 operandRegister2 (RiscV.Funct7 0b0100000)
+        $ RiscV.R register RiscV.SUB operandRegister1 operandRegister2 (RiscV.Funct7 0b0100000)
 
-loadImmediateOrRegister :: Operand -> RiscV.XRegister -> (RiscV.XRegister, Vector Statement)
+loadImmediateOrRegister :: RiscVOperand -> RiscV.XRegister -> (RiscV.XRegister, Vector Statement)
 loadImmediateOrRegister (IntOperand intValue) targetRegister =
     (targetRegister, lui intValue targetRegister)
-loadImmediateOrRegister (VariableOperand _) _ = (RiscV.T0, Vector.empty)
+loadImmediateOrRegister (VariableOperand (Store register)) _ = (register, Vector.empty)
 
 lui :: Int32 -> RiscV.XRegister -> Vector Statement
 lui intValue targetRegister

lib/Language/Elna/Intermediate.hs

@@ -28,18 +28,18 @@ instance Show Variable
     -- show (Variable variable) = '$' : Text.unpack variable
     show (TempVariable variable) = '$' : show variable
 
-data Operand
+data Operand v
     = IntOperand Int32
-    | VariableOperand Variable
+    | VariableOperand v
     deriving (Eq, Show)
 
-data Quadruple
+data Quadruple v
     = StartQuadruple
     | StopQuadruple
-    | ParameterQuadruple Operand
+    | ParameterQuadruple (Operand v)
     | CallQuadruple Text Word32
-    | AddQuadruple Operand Operand Variable
-    | SubtractionQuadruple Operand Operand Variable
+    | AddQuadruple (Operand v) (Operand v) v
+    | SubtractionQuadruple (Operand v) (Operand v) v
     {-| GoToQuadruple Label
     | AssignQuadruple Operand Variable
     | ArrayQuadruple Variable Operand Variable
@@ -72,7 +72,7 @@ instance Monad Intermediate
   where
     (Intermediate x) >>= f = Intermediate $ x >>= (runIntermediate . f)
 
-intermediate :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector Quadruple)
+intermediate :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector (Quadruple Variable))
 intermediate globalTable
     = fst
     . flip runState 0
@@ -82,14 +82,14 @@ intermediate globalTable
 program
     :: SymbolTable
     -> AST.Program
-    -> Intermediate (HashMap AST.Identifier (Vector Quadruple))
+    -> Intermediate (HashMap AST.Identifier (Vector (Quadruple Variable)))
 program globalTable (AST.Program declarations) = HashMap.fromList . catMaybes
     <$> traverse (declaration globalTable) declarations
 
 declaration
     :: SymbolTable
     -> AST.Declaration
-    -> Intermediate (Maybe (AST.Identifier, Vector Quadruple))
+    -> Intermediate (Maybe (AST.Identifier, Vector (Quadruple Variable)))
 declaration globalTable (AST.ProcedureDeclaration procedureName _ _ statements)
     = Just
     . (procedureName,)
@@ -99,7 +99,7 @@ declaration globalTable (AST.ProcedureDeclaration procedureName _ _ statements)
     <$> traverse (statement globalTable) statements
 -- declaration (AST.TypeDefinition _ _) accumulator = pure accumulator
 
-statement :: SymbolTable -> AST.Statement -> Intermediate (Vector Quadruple)
+statement :: SymbolTable -> AST.Statement -> Intermediate (Vector (Quadruple Variable))
 statement _ AST.EmptyStatement = pure mempty
 statement localTable (AST.CallStatement (AST.Identifier callName) arguments) = do
     visitedArguments <- traverse (expression localTable) arguments
@@ -260,7 +260,7 @@ variableType (AST.VariableAccess identifier) symbolTable
 variableType (AST.ArrayAccess arrayAccess' _) symbolTable =
     variableType arrayAccess' symbolTable
 -}
-expression :: SymbolTable -> AST.Expression -> Intermediate (Operand, Vector Quadruple)
+expression :: SymbolTable -> AST.Expression -> Intermediate (Operand Variable, Vector (Quadruple Variable))
 expression localTable = \case
     (AST.LiteralExpression literal') -> pure (literal literal', mempty)
     (AST.SumExpression lhs rhs) -> binaryExpression AddQuadruple lhs rhs
@@ -302,7 +302,7 @@ expression localTable = \case
             , Vector.snoc (lhsStatements <> rhsStatements) newQuadruple
             )
 
-literal :: AST.Literal -> Operand
+literal :: AST.Literal -> Operand Variable
 literal (AST.IntegerLiteral integer) = IntOperand integer
 {-literal (AST.HexadecimalLiteral integer) = IntOperand integer
 literal (AST.CharacterLiteral character) = IntOperand $ fromIntegral character

src/Main.hs

@@ -5,11 +5,12 @@ module Main
 import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser)
 import Language.Elna.PrinterWriter (riscv32Elf)
 import Language.Elna.Object.Elf (elfObject)
+import Language.Elna.Allocator (allocate)
 import Language.Elna.Parser (programP)
 import Language.Elna.NameAnalysis (nameAnalysis)
 import Language.Elna.TypeAnalysis (typeAnalysis)
 import Language.Elna.Intermediate (intermediate)
-import Language.Elna.CodeGenerator (generateCode)
+import Language.Elna.CodeGenerator (generateRiscV, riscVConfiguration)
 import Data.Maybe (fromMaybe)
 import System.FilePath (replaceExtension, takeFileName)
 import Text.Megaparsec (runParser, errorBundlePretty)
@@ -31,7 +32,8 @@ main  = execParser commandLine >>= withCommandLine
         $ errorBundlePretty errorBundle
     withSymbolTable output program symbolTable =
         let _ = typeAnalysis symbolTable program
-            intermediate' = intermediate symbolTable program
-            instructions = generateCode symbolTable intermediate'
+            instructions = generateRiscV
+                $ allocate riscVConfiguration
+                $ intermediate symbolTable program
          in elfObject output
             $ riscv32Elf instructions