Map local variables in IR to their original names
This commit is contained in:
@ -4,7 +4,7 @@ module Language.Elna.Glue
|
||||
|
||||
import Control.Monad.Trans.State (State, gets, modify', runState)
|
||||
import Data.Bifunctor (Bifunctor(..))
|
||||
import Data.Foldable (Foldable(..))
|
||||
import Data.Foldable (Foldable(..), traverse_)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Maybe (catMaybes)
|
||||
@ -25,10 +25,12 @@ import Language.Elna.Backend.Intermediate
|
||||
import Language.Elna.Frontend.SymbolTable (Info(..), SymbolTable)
|
||||
import qualified Language.Elna.Frontend.SymbolTable as SymbolTable
|
||||
import GHC.Records (HasField(..))
|
||||
import Language.Elna.Frontend.AST (Identifier(..))
|
||||
|
||||
data Paste = Paste
|
||||
{ temporaryCounter :: Word32
|
||||
, labelCounter :: Word32
|
||||
, localMap :: HashMap Identifier Variable
|
||||
}
|
||||
|
||||
newtype Glue a = Glue
|
||||
@ -50,9 +52,15 @@ instance Monad Glue
|
||||
glue :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector (Quadruple Variable))
|
||||
glue globalTable
|
||||
= fst
|
||||
. flip runState Paste{ temporaryCounter = 0, labelCounter = 0 }
|
||||
. flip runState emptyPaste
|
||||
. runGlue
|
||||
. program globalTable
|
||||
where
|
||||
emptyPaste = Paste
|
||||
{ temporaryCounter = 0
|
||||
, labelCounter = 0
|
||||
, localMap = mempty
|
||||
}
|
||||
|
||||
program
|
||||
:: SymbolTable
|
||||
@ -65,13 +73,23 @@ declaration
|
||||
:: SymbolTable
|
||||
-> AST.Declaration
|
||||
-> Glue (Maybe (AST.Identifier, Vector (Quadruple Variable)))
|
||||
declaration globalTable (AST.ProcedureDeclaration procedureName _ _ statements)
|
||||
= Just
|
||||
. (procedureName,)
|
||||
. Vector.cons StartQuadruple
|
||||
. flip Vector.snoc StopQuadruple
|
||||
. fold
|
||||
<$> traverse (statement globalTable) statements
|
||||
declaration globalTable (AST.ProcedureDeclaration procedureName _ variableDeclarations statements)
|
||||
= traverse_ registerVariable variableDeclarations
|
||||
>> statements' <$> traverse (statement globalTable) statements
|
||||
where
|
||||
registerVariable (AST.VariableDeclaration identifier _) = do
|
||||
currentCounter <- fmap (fromIntegral . HashMap.size)
|
||||
$ Glue $ gets $ getField @"localMap"
|
||||
Glue $ modify' $ modifier identifier $ LocalVariable currentCounter
|
||||
modifier identifier currentCounter generator = generator
|
||||
{ localMap = HashMap.insert identifier currentCounter
|
||||
$ getField @"localMap" generator
|
||||
}
|
||||
statements' = Just
|
||||
. (procedureName,)
|
||||
. Vector.cons StartQuadruple
|
||||
. flip Vector.snoc StopQuadruple
|
||||
. fold
|
||||
declaration _ (AST.TypeDefinition _ _) = pure Nothing
|
||||
|
||||
statement :: SymbolTable -> AST.Statement -> Glue (Vector (Quadruple Variable))
|
||||
@ -104,15 +122,16 @@ statement localTable (AST.AssignmentStatement variableAccess' assignee) = do
|
||||
(rhsOperand, rhsStatements) <- expression localTable assignee
|
||||
let variableType' = variableType variableAccess' localTable
|
||||
accessResult <- variableAccess localTable variableAccess' Nothing variableType' mempty
|
||||
pure $ rhsStatements <> case accessResult of
|
||||
lhsStatements <- case accessResult of
|
||||
{-(AST.Identifier identifier, Just accumulatedIndex, accumulatedStatements) ->
|
||||
Vector.snoc accumulatedStatements
|
||||
$ ArrayAssignQuadruple rhsOperand accumulatedIndex
|
||||
$ LocalVariable identifier -}
|
||||
(AST.Identifier identifier, Nothing, accumulatedStatements) ->
|
||||
Vector.snoc accumulatedStatements
|
||||
$ AssignQuadruple rhsOperand
|
||||
$ LocalVariable 0
|
||||
(identifier, _Nothing, accumulatedStatements)
|
||||
-> Vector.snoc accumulatedStatements
|
||||
. AssignQuadruple rhsOperand
|
||||
<$> lookupLocal identifier
|
||||
pure $ rhsStatements <> lhsStatements
|
||||
{- statement localTable (AST.WhileStatement whileCondition whileStatement) = do
|
||||
(conditionStatements, jumpConstructor) <- condition localTable whileCondition
|
||||
startLabel <- createLabel
|
||||
@ -135,6 +154,10 @@ createTemporary = do
|
||||
{ temporaryCounter = getField @"temporaryCounter" generator + 1
|
||||
}
|
||||
|
||||
lookupLocal :: Identifier -> Glue Variable
|
||||
lookupLocal identifier =
|
||||
fmap (HashMap.! identifier) $ Glue $ gets $ getField @"localMap"
|
||||
|
||||
createLabel :: Glue Label
|
||||
createLabel = do
|
||||
currentCounter <- Glue $ gets $ getField @"labelCounter"
|
||||
@ -242,13 +265,13 @@ expression localTable = \case
|
||||
(AST.DivisionExpression lhs rhs) ->
|
||||
binaryExpression DivisionQuadruple lhs rhs
|
||||
(AST.VariableExpression variableExpression) -> do
|
||||
pure (VariableOperand (LocalVariable 0), mempty)
|
||||
{- let variableType' = variableType variableExpression localTable
|
||||
let variableType' = variableType variableExpression localTable
|
||||
variableAccess' <- variableAccess localTable variableExpression Nothing variableType' mempty
|
||||
case variableAccess' of
|
||||
(AST.Identifier identifier, Nothing, statements) ->
|
||||
pure (VariableOperand (Variable identifier), statements)
|
||||
(AST.Identifier identifier, Just operand, statements) -> do
|
||||
(identifier, _Nothing, statements)
|
||||
-> (, statements) . VariableOperand
|
||||
<$> lookupLocal identifier
|
||||
{-(AST.Identifier identifier, Just operand, statements) -> do
|
||||
arrayAddress <- createTemporary
|
||||
let arrayStatement = ArrayQuadruple (Variable identifier) operand arrayAddress
|
||||
pure
|
||||
|
||||
@ -114,32 +114,10 @@ quadruple StopQuadruple = pure $ 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 (Store register))
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
pure $ lui (immediateOperand1 + immediateOperand2) register
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
let Store operandRegister1 = variableOperand1
|
||||
Store operandRegister2 = variableOperand2
|
||||
in pure $ Vector.singleton $ Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R register RiscV.ADD operandRegister1 operandRegister2 (RiscV.Funct7 0b0000000)
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
addImmediateRegister variableOperand1 immediateOperand2
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
addImmediateRegister variableOperand2 immediateOperand1
|
||||
where
|
||||
addImmediateRegister variableOperand immediateOperand =
|
||||
let statements = lui immediateOperand register
|
||||
Store operandRegister = variableOperand
|
||||
in pure $ Vector.snoc statements
|
||||
$ Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R register RiscV.ADD register operandRegister
|
||||
$ RiscV.Funct7 0b0000000
|
||||
quadruple (AddQuadruple operand1 operand2 store) =
|
||||
commutativeBinary (+) RiscV.ADD (RiscV.Funct7 0b0000000) (operand1, operand2) store
|
||||
quadruple (ProductQuadruple operand1 operand2 store) =
|
||||
commutativeBinary (*) RiscV.MUL (RiscV.Funct7 0b0000001) (operand1, operand2) store
|
||||
quadruple (SubtractionQuadruple operand1 operand2 (Store register))
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
@ -180,32 +158,6 @@ quadruple (NegationQuadruple operand1 (Store register))
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R register RiscV.SUB RiscV.Zero operandRegister1
|
||||
$ RiscV.Funct7 0b0100000
|
||||
quadruple (ProductQuadruple operand1 operand2 (Store register))
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
pure $ lui (immediateOperand1 * immediateOperand2) register
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
let Store operandRegister1 = variableOperand1
|
||||
Store operandRegister2 = variableOperand2
|
||||
in pure $ Vector.singleton $ Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R register RiscV.MUL operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001)
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
multiplyImmediateRegister variableOperand1 immediateOperand2
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
multiplyImmediateRegister variableOperand2 immediateOperand1
|
||||
where
|
||||
multiplyImmediateRegister variableOperand immediateOperand =
|
||||
let statements = lui immediateOperand register
|
||||
Store operandRegister = variableOperand
|
||||
in pure $ Vector.snoc statements
|
||||
$ Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R register RiscV.MUL register operandRegister
|
||||
$ RiscV.Funct7 0b0000001
|
||||
quadruple (DivisionQuadruple operand1 operand2 (Store register))
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
@ -261,198 +213,18 @@ quadruple (DivisionQuadruple operand1 operand2 (Store register))
|
||||
]
|
||||
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
|
||||
Label goToLabel' = goToLabel
|
||||
pure $ Vector.singleton
|
||||
$ Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Branch
|
||||
$ RiscV.RBranch goToLabel' 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
|
||||
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 =
|
||||
let Store operandRegister1 = variableOperand1
|
||||
Store operandRegister2 = variableOperand2
|
||||
Label goToLabel' = goToLabel
|
||||
in 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
|
||||
quadruple (EqualQuadruple operand1 operand2 goToLabel) =
|
||||
commutativeComparison (==) RiscV.BEQ (operand1, operand2) goToLabel
|
||||
quadruple (NonEqualQuadruple operand1 operand2 goToLabel) =
|
||||
commutativeComparison (/=) RiscV.BNE (operand1, operand2) goToLabel
|
||||
quadruple (LessQuadruple operand1 operand2 goToLabel) =
|
||||
lessThan (operand1, operand2) goToLabel
|
||||
quadruple (GreaterQuadruple operand1 operand2 goToLabel) =
|
||||
lessThan (operand2, operand1) goToLabel
|
||||
quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) =
|
||||
lessOrEqualThan (operand1, operand2) goToLabel
|
||||
quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) =
|
||||
lessOrEqualThan (operand2, operand1) goToLabel
|
||||
quadruple (AssignQuadruple operand1 (Store register))
|
||||
| IntOperand immediateOperand1 <- operand1 = pure
|
||||
$ lui immediateOperand1 register
|
||||
@ -489,3 +261,143 @@ lui intValue targetRegister
|
||||
where
|
||||
hi = intValue `shiftR` 12
|
||||
lo = fromIntegral intValue
|
||||
|
||||
commutativeBinary
|
||||
:: (Int32 -> Int32 -> Int32)
|
||||
-> RiscV.Funct3
|
||||
-> RiscV.Funct7
|
||||
-> (Operand RiscVStore, Operand RiscVStore)
|
||||
-> Store RiscV.XRegister
|
||||
-> RiscVGenerator (Vector Statement)
|
||||
commutativeBinary immediateOperation funct3 funct7 (operand1, operand2) (Store register)
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 = pure
|
||||
$ lui (immediateOperation immediateOperand1 immediateOperand2) register
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
let Store operandRegister1 = variableOperand1
|
||||
Store operandRegister2 = variableOperand2
|
||||
in pure $ Vector.singleton $ Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R register funct3 operandRegister1 operandRegister2 funct7
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
commutativeImmediateRegister variableOperand1 immediateOperand2
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
commutativeImmediateRegister variableOperand2 immediateOperand1
|
||||
where
|
||||
commutativeImmediateRegister variableOperand immediateOperand =
|
||||
let statements = lui immediateOperand register
|
||||
Store operandRegister = variableOperand
|
||||
in pure $ Vector.snoc statements
|
||||
$ Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R register funct3 register operandRegister funct7
|
||||
|
||||
commutativeComparison
|
||||
:: (Int32 -> Int32 -> Bool)
|
||||
-> RiscV.Funct3
|
||||
-> (Operand RiscVStore, Operand RiscVStore)
|
||||
-> Label
|
||||
-> RiscVGenerator (Vector Statement)
|
||||
commutativeComparison immediateOperation funct3 (operand1, operand2) goToLabel
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
if immediateOperation 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' funct3 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' funct3 operandRegister immediateRegister
|
||||
|
||||
lessThan :: (Operand RiscVStore, Operand RiscVStore) -> Label -> RiscVGenerator (Vector Statement)
|
||||
lessThan (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
|
||||
|
||||
lessOrEqualThan :: (Operand RiscVStore, Operand RiscVStore) -> Label -> RiscVGenerator (Vector Statement)
|
||||
lessOrEqualThan (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
|
||||
|
||||
Reference in New Issue
Block a user