elna/lib/Language/Elna/CodeGenerator.hs

module Language.Elna.CodeGenerator
    ( Statement(..)
    , generateCode
    ) 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 (Operand(..), Quadruple(..))
import qualified Language.Elna.Architecture.RiscV as RiscV
import Language.Elna.SymbolTable (SymbolTable)
import Data.Bits (Bits(..))

data Directive
    = GlobalDirective
    | FunctionDirective
    deriving (Eq, Show)

data Statement
    = Instruction RiscV.Instruction
    | JumpLabel ByteString [Directive]
    deriving Eq

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 8))
    , Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 4 RiscV.SW RiscV.SP RiscV.S0)
    , Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 8 RiscV.SW RiscV.SP RiscV.RA)
    , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.S0 RiscV.ADDI RiscV.SP 8)
    ]
quadruple (ParameterQuadruple (IntOperand intValue))
    = Vector.snoc go
    $ Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 0 RiscV.SW RiscV.SP RiscV.A0)
  where
    hi = intValue `shiftR` 12
    lo = intValue
    go
        | intValue >= -2048
        , intValue <= 2047 = Vector.singleton
            $ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.A0 $ fromIntegral lo)
        | intValue .&. 0x800 /= 0 = Vector.fromList
            [ Instruction (RiscV.BaseInstruction RiscV.Lui $ RiscV.U RiscV.A0 $ fromIntegral $ succ hi)
            , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.A0 $ fromIntegral lo)
            ]
        | otherwise = Vector.fromList
            [ Instruction (RiscV.BaseInstruction RiscV.Lui $ RiscV.U RiscV.A0 $ fromIntegral hi)
            , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.A0 $ fromIntegral lo)
            ]
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 4)
    , Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.RA RiscV.LW RiscV.SP 8)
    , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP 8)
    , Instruction (RiscV.BaseInstruction RiscV.Jalr $ RiscV.I RiscV.RA RiscV.JALR RiscV.Zero 0)
    ]