Map local variables in IR to their original names
This commit is contained in:
		
							
								
								
									
										4
									
								
								TODO
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								TODO
									
									
									
									
									
								
							| @@ -3,10 +3,6 @@ | |||||||
| - To access named parameters inside a procedure, IR should be able to reference | - To access named parameters inside a procedure, IR should be able to reference | ||||||
|   them. During the generation the needed information (e.g. offsets or registers) |   them. During the generation the needed information (e.g. offsets or registers) | ||||||
|   can be extracted from the symbol table and saved in the operands. |   can be extracted from the symbol table and saved in the operands. | ||||||
| - Glue always generates the same intermediate variable (LocalVariable 0) for |  | ||||||
|   local variables. (LocalVariable 0) is handled the same as temporary variables |  | ||||||
|   that are currently saved only in registers. There space on the stack allocated |  | ||||||
|   for local variables. |  | ||||||
|  |  | ||||||
| # ELF generation | # ELF generation | ||||||
|  |  | ||||||
|   | |||||||
| @@ -5,11 +5,19 @@ module Language.Elna.Backend.Allocator | |||||||
|     ) where |     ) where | ||||||
|  |  | ||||||
| import Data.HashMap.Strict (HashMap) | import Data.HashMap.Strict (HashMap) | ||||||
|  | import Data.Word (Word32) | ||||||
| import Data.Vector (Vector) | import Data.Vector (Vector) | ||||||
| import Language.Elna.Backend.Intermediate (Operand(..), Quadruple(..), Variable(..)) | import Language.Elna.Backend.Intermediate | ||||||
|  |     ( ProcedureQuadruples(..) | ||||||
|  |     , Operand(..) | ||||||
|  |     , Quadruple(..) | ||||||
|  |     , Variable(..) | ||||||
|  |     ) | ||||||
| import Language.Elna.Location (Identifier(..)) | import Language.Elna.Location (Identifier(..)) | ||||||
|  |  | ||||||
| newtype Store r = Store r | data Store r | ||||||
|  |     = RegisterStore r | ||||||
|  |     | StackStore Word32 r | ||||||
|  |  | ||||||
| newtype MachineConfiguration r = MachineConfiguration | newtype MachineConfiguration r = MachineConfiguration | ||||||
|     { temporaryRegisters :: [r] |     { temporaryRegisters :: [r] | ||||||
| @@ -19,60 +27,57 @@ allocate | |||||||
|     :: forall r |     :: forall r | ||||||
|     . MachineConfiguration r |     . MachineConfiguration r | ||||||
|     -> HashMap Identifier (Vector (Quadruple Variable)) |     -> HashMap Identifier (Vector (Quadruple Variable)) | ||||||
|     -> HashMap Identifier (Vector (Quadruple (Store r))) |     -> HashMap Identifier (ProcedureQuadruples (Store r)) | ||||||
| allocate MachineConfiguration{..} = fmap function | allocate MachineConfiguration{..} = fmap function | ||||||
|   where |   where | ||||||
|     function :: Vector (Quadruple Variable) -> Vector (Quadruple (Store r)) |     function :: Vector (Quadruple Variable) -> ProcedureQuadruples (Store r) | ||||||
|     function = fmap quadruple |     function quadruples' = ProcedureQuadruples | ||||||
|  |         { quadruples = quadruple <$> quadruples' | ||||||
|  |         , stackSize = 0 | ||||||
|  |         } | ||||||
|     quadruple :: Quadruple Variable -> Quadruple (Store r) |     quadruple :: Quadruple Variable -> Quadruple (Store r) | ||||||
|     quadruple StartQuadruple = StartQuadruple |     quadruple = \case | ||||||
|     quadruple StopQuadruple = StopQuadruple |         StartQuadruple -> StartQuadruple | ||||||
|     quadruple (ParameterQuadruple operand1) = |         StopQuadruple -> StopQuadruple | ||||||
|         ParameterQuadruple (operand operand1) |         ParameterQuadruple operand1 -> | ||||||
|     quadruple (CallQuadruple name count) = CallQuadruple name count |             ParameterQuadruple (operand operand1) | ||||||
|     quadruple (AddQuadruple operand1 operand2 variable) |         CallQuadruple name count -> CallQuadruple name count | ||||||
|         = AddQuadruple (operand operand1) (operand operand2) |         AddQuadruple operand1 operand2 variable | ||||||
|         $ storeVariable variable |             -> AddQuadruple (operand operand1) (operand operand2) | ||||||
|     quadruple (SubtractionQuadruple operand1 operand2 variable) |             $ storeVariable variable | ||||||
|         = SubtractionQuadruple (operand operand1) (operand operand2) |         SubtractionQuadruple operand1 operand2 variable | ||||||
|         $ storeVariable variable |             -> SubtractionQuadruple (operand operand1) (operand operand2) | ||||||
|     quadruple (NegationQuadruple operand1 variable) |             $ storeVariable variable | ||||||
|         = NegationQuadruple (operand operand1) |         NegationQuadruple operand1 variable | ||||||
|         $ storeVariable variable |             -> NegationQuadruple (operand operand1) | ||||||
|     quadruple (ProductQuadruple operand1 operand2 variable) |             $ storeVariable variable | ||||||
|         = ProductQuadruple (operand operand1) (operand operand2) |         ProductQuadruple operand1 operand2 variable | ||||||
|         $ storeVariable variable |             -> ProductQuadruple (operand operand1) (operand operand2) | ||||||
|     quadruple (DivisionQuadruple operand1 operand2 variable) |             $ storeVariable variable | ||||||
|         = DivisionQuadruple (operand operand1) (operand operand2) |         DivisionQuadruple operand1 operand2 variable | ||||||
|         $ storeVariable variable |             -> DivisionQuadruple (operand operand1) (operand operand2) | ||||||
|     quadruple (LabelQuadruple label) = LabelQuadruple label |             $ storeVariable variable | ||||||
|     quadruple (GoToQuadruple label) = GoToQuadruple label |         LabelQuadruple label -> LabelQuadruple label | ||||||
|     quadruple (EqualQuadruple operand1 operand2 goToLabel) = |         GoToQuadruple label -> GoToQuadruple label | ||||||
|         EqualQuadruple (operand operand1) (operand operand2) goToLabel |         EqualQuadruple operand1 operand2 goToLabel -> | ||||||
|     quadruple (NonEqualQuadruple operand1 operand2 goToLabel) = |             EqualQuadruple (operand operand1) (operand operand2) goToLabel | ||||||
|         NonEqualQuadruple (operand operand1) (operand operand2) goToLabel |         NonEqualQuadruple operand1 operand2 goToLabel -> | ||||||
|     quadruple (LessQuadruple operand1 operand2 goToLabel) = |             NonEqualQuadruple (operand operand1) (operand operand2) goToLabel | ||||||
|         LessQuadruple (operand operand1) (operand operand2) goToLabel |         LessQuadruple operand1 operand2 goToLabel -> | ||||||
|     quadruple (GreaterQuadruple operand1 operand2 goToLabel) = |             LessQuadruple (operand operand1) (operand operand2) goToLabel | ||||||
|         GreaterQuadruple (operand operand1) (operand operand2) goToLabel |         GreaterQuadruple operand1 operand2 goToLabel -> | ||||||
|     quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) = |             GreaterQuadruple (operand operand1) (operand operand2) goToLabel | ||||||
|         LessOrEqualQuadruple (operand operand1) (operand operand2) goToLabel |         LessOrEqualQuadruple operand1 operand2 goToLabel -> | ||||||
|     quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) = |             LessOrEqualQuadruple (operand operand1) (operand operand2) goToLabel | ||||||
|         GreaterOrEqualQuadruple (operand operand1) (operand operand2) goToLabel |         GreaterOrEqualQuadruple operand1 operand2 goToLabel -> | ||||||
|     quadruple (AssignQuadruple operand1 variable) |             GreaterOrEqualQuadruple (operand operand1) (operand operand2) goToLabel | ||||||
|         = AssignQuadruple (operand operand1) |         AssignQuadruple operand1 variable -> | ||||||
|         $ storeVariable variable |             AssignQuadruple (operand operand1) $ storeVariable variable | ||||||
|     operand :: Operand Variable -> Operand (Store r) |     operand :: Operand Variable -> Operand (Store r) | ||||||
|     operand (IntOperand x) = IntOperand x |     operand (IntOperand x) = IntOperand x | ||||||
|     operand (VariableOperand (TempVariable index)) |     operand (VariableOperand variableOperand) = | ||||||
|         = VariableOperand |         VariableOperand $ storeVariable variableOperand | ||||||
|         $ Store |     storeVariable (TempVariable index) = RegisterStore | ||||||
|         $ temporaryRegisters !! fromIntegral index |         $ temporaryRegisters !! fromIntegral index | ||||||
|     operand (VariableOperand (LocalVariable index)) |     storeVariable (LocalVariable index) = RegisterStore | ||||||
|         = VariableOperand |         $ temporaryRegisters !! pred (length temporaryRegisters - fromIntegral index) | ||||||
|         $ Store |  | ||||||
|         $ temporaryRegisters !! fromIntegral index |  | ||||||
|     storeVariable (TempVariable index) = |  | ||||||
|         Store $ temporaryRegisters !! fromIntegral index |  | ||||||
|     storeVariable (LocalVariable index) = |  | ||||||
|         Store $ temporaryRegisters !! fromIntegral index |  | ||||||
|   | |||||||
| @@ -1,11 +1,13 @@ | |||||||
| module Language.Elna.Backend.Intermediate | module Language.Elna.Backend.Intermediate | ||||||
|     ( Operand(..) |     ( ProcedureQuadruples(..) | ||||||
|  |     , Operand(..) | ||||||
|     , Quadruple(..) |     , Quadruple(..) | ||||||
|     , Label(..) |     , Label(..) | ||||||
|     , Variable(..) |     , Variable(..) | ||||||
|     ) where |     ) where | ||||||
|  |  | ||||||
| import Data.Int (Int32) | import Data.Int (Int32) | ||||||
|  | import Data.Vector (Vector) | ||||||
| import Data.Word (Word32) | import Data.Word (Word32) | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
| import qualified Data.Text as Text | import qualified Data.Text as Text | ||||||
| @@ -30,6 +32,11 @@ data Operand v | |||||||
|     | VariableOperand v |     | VariableOperand v | ||||||
|     deriving (Eq, Show) |     deriving (Eq, Show) | ||||||
|  |  | ||||||
|  | data ProcedureQuadruples v = ProcedureQuadruples | ||||||
|  |     { quadruples :: Vector (Quadruple v) | ||||||
|  |     , stackSize :: Word32 | ||||||
|  |     } deriving (Eq, Show) | ||||||
|  |  | ||||||
| data Quadruple v | data Quadruple v | ||||||
|     = StartQuadruple |     = StartQuadruple | ||||||
|     | StopQuadruple |     | StopQuadruple | ||||||
|   | |||||||
| @@ -4,7 +4,7 @@ module Language.Elna.Glue | |||||||
|  |  | ||||||
| import Control.Monad.Trans.State (State, gets, modify', runState) | import Control.Monad.Trans.State (State, gets, modify', runState) | ||||||
| import Data.Bifunctor (Bifunctor(..)) | import Data.Bifunctor (Bifunctor(..)) | ||||||
| import Data.Foldable (Foldable(..)) | import Data.Foldable (Foldable(..), traverse_) | ||||||
| import Data.HashMap.Strict (HashMap) | import Data.HashMap.Strict (HashMap) | ||||||
| import qualified Data.HashMap.Strict as HashMap | import qualified Data.HashMap.Strict as HashMap | ||||||
| import Data.Maybe (catMaybes) | import Data.Maybe (catMaybes) | ||||||
| @@ -25,10 +25,12 @@ import Language.Elna.Backend.Intermediate | |||||||
| import Language.Elna.Frontend.SymbolTable (Info(..), SymbolTable) | import Language.Elna.Frontend.SymbolTable (Info(..), SymbolTable) | ||||||
| import qualified Language.Elna.Frontend.SymbolTable as SymbolTable | import qualified Language.Elna.Frontend.SymbolTable as SymbolTable | ||||||
| import GHC.Records (HasField(..)) | import GHC.Records (HasField(..)) | ||||||
|  | import Language.Elna.Frontend.AST (Identifier(..)) | ||||||
|  |  | ||||||
| data Paste = Paste | data Paste = Paste | ||||||
|     { temporaryCounter :: Word32 |     { temporaryCounter :: Word32 | ||||||
|     , labelCounter :: Word32 |     , labelCounter :: Word32 | ||||||
|  |     , localMap :: HashMap Identifier Variable | ||||||
|     } |     } | ||||||
|  |  | ||||||
| newtype Glue a = Glue | newtype Glue a = Glue | ||||||
| @@ -47,31 +49,46 @@ instance Monad Glue | |||||||
|   where |   where | ||||||
|     (Glue x) >>= f = Glue $ x >>= (runGlue . f) |     (Glue x) >>= f = Glue $ x >>= (runGlue . f) | ||||||
|  |  | ||||||
| glue :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector (Quadruple Variable)) | glue :: SymbolTable -> AST.Program -> HashMap Identifier (Vector (Quadruple Variable)) | ||||||
| glue globalTable | glue globalTable | ||||||
|     = fst |     = fst | ||||||
|     . flip runState Paste{ temporaryCounter = 0, labelCounter = 0 } |     . flip runState emptyPaste | ||||||
|     . runGlue |     . runGlue | ||||||
|     . program globalTable |     . program globalTable | ||||||
|  |   where | ||||||
|  |     emptyPaste = Paste | ||||||
|  |         { temporaryCounter = 0 | ||||||
|  |         , labelCounter = 0 | ||||||
|  |         , localMap = mempty | ||||||
|  |         } | ||||||
|  |  | ||||||
| program | program :: SymbolTable -> AST.Program -> Glue (HashMap Identifier (Vector (Quadruple Variable))) | ||||||
|     :: SymbolTable | program globalTable (AST.Program declarations) | ||||||
|     -> AST.Program |     = HashMap.fromList . catMaybes | ||||||
|     -> Glue (HashMap AST.Identifier (Vector (Quadruple Variable))) |  | ||||||
| program globalTable (AST.Program declarations) = HashMap.fromList . catMaybes |  | ||||||
|     <$> traverse (declaration globalTable) declarations |     <$> traverse (declaration globalTable) declarations | ||||||
|  |  | ||||||
| declaration | declaration | ||||||
|     :: SymbolTable |     :: SymbolTable | ||||||
|     -> AST.Declaration |     -> AST.Declaration | ||||||
|     -> Glue (Maybe (AST.Identifier, Vector (Quadruple Variable))) |     -> Glue (Maybe (AST.Identifier, Vector (Quadruple Variable))) | ||||||
| declaration globalTable (AST.ProcedureDeclaration procedureName _ _ statements) | declaration globalTable (AST.ProcedureDeclaration procedureName _ variableDeclarations statements) | ||||||
|     = Just |     = traverse_ registerVariable variableDeclarations | ||||||
|     . (procedureName,) |     >> nameQuadruplesTuple <$> traverse (statement globalTable) statements | ||||||
|     . Vector.cons StartQuadruple |   where | ||||||
|     . flip Vector.snoc StopQuadruple |     registerVariable (AST.VariableDeclaration identifier _) = do | ||||||
|     . fold |         currentCounter <- fmap (fromIntegral . HashMap.size) | ||||||
|     <$> traverse (statement globalTable) statements |             $ Glue $ gets $ getField @"localMap" | ||||||
|  |         Glue $ modify' $ modifier identifier $ LocalVariable currentCounter | ||||||
|  |     modifier identifier currentCounter generator = generator | ||||||
|  |         { localMap = HashMap.insert identifier currentCounter | ||||||
|  |             $ getField @"localMap" generator | ||||||
|  |         } | ||||||
|  |     nameQuadruplesTuple quadrupleList = Just | ||||||
|  |         ( procedureName | ||||||
|  |         , Vector.cons StartQuadruple | ||||||
|  |             $ flip Vector.snoc StopQuadruple | ||||||
|  |             $ fold quadrupleList | ||||||
|  |         ) | ||||||
| declaration _ (AST.TypeDefinition _ _) = pure Nothing | declaration _ (AST.TypeDefinition _ _) = pure Nothing | ||||||
|  |  | ||||||
| statement :: SymbolTable -> AST.Statement -> Glue (Vector (Quadruple Variable)) | statement :: SymbolTable -> AST.Statement -> Glue (Vector (Quadruple Variable)) | ||||||
| @@ -104,15 +121,16 @@ statement localTable (AST.AssignmentStatement variableAccess' assignee) = do | |||||||
|     (rhsOperand, rhsStatements) <- expression localTable assignee |     (rhsOperand, rhsStatements) <- expression localTable assignee | ||||||
|     let variableType' = variableType variableAccess' localTable |     let variableType' = variableType variableAccess' localTable | ||||||
|     accessResult <- variableAccess localTable variableAccess' Nothing variableType' mempty |     accessResult <- variableAccess localTable variableAccess' Nothing variableType' mempty | ||||||
|     pure $ rhsStatements <> case accessResult of |     lhsStatements <- case accessResult of | ||||||
|             {-(AST.Identifier identifier, Just accumulatedIndex, accumulatedStatements) -> |             {-(AST.Identifier identifier, Just accumulatedIndex, accumulatedStatements) -> | ||||||
|                 Vector.snoc accumulatedStatements |                 Vector.snoc accumulatedStatements | ||||||
|                     $ ArrayAssignQuadruple rhsOperand accumulatedIndex |                     $ ArrayAssignQuadruple rhsOperand accumulatedIndex | ||||||
|                     $ LocalVariable identifier -} |                     $ LocalVariable identifier -} | ||||||
|             (AST.Identifier identifier, Nothing, accumulatedStatements) -> |             (identifier, _Nothing, accumulatedStatements) | ||||||
|                 Vector.snoc accumulatedStatements |                 -> Vector.snoc accumulatedStatements | ||||||
|                     $ AssignQuadruple rhsOperand |                 . AssignQuadruple rhsOperand | ||||||
|                     $ LocalVariable 0 |                 <$> lookupLocal identifier | ||||||
|  |     pure $ rhsStatements <> lhsStatements | ||||||
| {- statement localTable (AST.WhileStatement whileCondition whileStatement) = do | {- statement localTable (AST.WhileStatement whileCondition whileStatement) = do | ||||||
|     (conditionStatements, jumpConstructor) <- condition localTable whileCondition |     (conditionStatements, jumpConstructor) <- condition localTable whileCondition | ||||||
|     startLabel <- createLabel |     startLabel <- createLabel | ||||||
| @@ -135,6 +153,10 @@ createTemporary = do | |||||||
|         { temporaryCounter = getField @"temporaryCounter" generator + 1 |         { temporaryCounter = getField @"temporaryCounter" generator + 1 | ||||||
|         } |         } | ||||||
|  |  | ||||||
|  | lookupLocal :: Identifier -> Glue Variable | ||||||
|  | lookupLocal identifier = | ||||||
|  |     fmap (HashMap.! identifier) $ Glue $ gets $ getField @"localMap" | ||||||
|  |  | ||||||
| createLabel :: Glue Label | createLabel :: Glue Label | ||||||
| createLabel = do | createLabel = do | ||||||
|     currentCounter <- Glue $ gets $ getField @"labelCounter" |     currentCounter <- Glue $ gets $ getField @"labelCounter" | ||||||
| @@ -242,13 +264,13 @@ expression localTable = \case | |||||||
|     (AST.DivisionExpression lhs rhs) -> |     (AST.DivisionExpression lhs rhs) -> | ||||||
|         binaryExpression DivisionQuadruple lhs rhs |         binaryExpression DivisionQuadruple lhs rhs | ||||||
|     (AST.VariableExpression variableExpression) -> do |     (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 |         variableAccess' <- variableAccess localTable variableExpression Nothing variableType' mempty | ||||||
|         case variableAccess' of |         case variableAccess' of | ||||||
|             (AST.Identifier identifier, Nothing, statements) -> |             (identifier, _Nothing, statements) | ||||||
|                 pure (VariableOperand (Variable identifier), statements) |                 -> (, statements) . VariableOperand  | ||||||
|             (AST.Identifier identifier, Just operand, statements) -> do |                 <$> lookupLocal identifier | ||||||
|  |             {-(AST.Identifier identifier, Just operand, statements) -> do | ||||||
|                 arrayAddress <- createTemporary |                 arrayAddress <- createTemporary | ||||||
|                 let arrayStatement = ArrayQuadruple (Variable identifier) operand arrayAddress |                 let arrayStatement = ArrayQuadruple (Variable identifier) operand arrayAddress | ||||||
|                 pure |                 pure | ||||||
|   | |||||||
| @@ -14,7 +14,12 @@ import Data.Vector (Vector) | |||||||
| import qualified Data.Vector as Vector | import qualified Data.Vector as Vector | ||||||
| import qualified Language.Elna.Architecture.RiscV as RiscV | import qualified Language.Elna.Architecture.RiscV as RiscV | ||||||
| import Language.Elna.Backend.Allocator (MachineConfiguration(..), Store(..)) | import Language.Elna.Backend.Allocator (MachineConfiguration(..), Store(..)) | ||||||
| import Language.Elna.Backend.Intermediate (Label(..), Operand(..), Quadruple(..)) | import Language.Elna.Backend.Intermediate | ||||||
|  |     ( Label(..) | ||||||
|  |     , Operand(..) | ||||||
|  |     , ProcedureQuadruples(..) | ||||||
|  |     , Quadruple(..) | ||||||
|  |     ) | ||||||
| import Language.Elna.Location (Identifier(..)) | import Language.Elna.Location (Identifier(..)) | ||||||
| import Data.Bits (Bits(..)) | import Data.Bits (Bits(..)) | ||||||
| import Data.Foldable (Foldable(..), foldlM) | import Data.Foldable (Foldable(..), foldlM) | ||||||
| @@ -80,13 +85,13 @@ createLabel = do | |||||||
|         $ Text.Builder.toLazyText |         $ Text.Builder.toLazyText | ||||||
|         $ Text.Builder.decimal currentCounter |         $ Text.Builder.decimal currentCounter | ||||||
|  |  | ||||||
| generateRiscV :: HashMap Identifier (Vector RiscVQuadruple) -> Vector Statement | generateRiscV :: HashMap Identifier (ProcedureQuadruples RiscVStore) -> Vector Statement | ||||||
| generateRiscV = flip evalState 0 | generateRiscV = flip evalState 0 | ||||||
|     . runRiscVGenerator |     . runRiscVGenerator | ||||||
|     . foldlM go Vector.empty |     . foldlM go Vector.empty | ||||||
|     . HashMap.toList |     . HashMap.toList | ||||||
|   where |   where | ||||||
|     go accumulator (Identifier key, value) = |     go accumulator (Identifier key, ProcedureQuadruples{ quadruples = value }) = | ||||||
|         let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective]) |         let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective]) | ||||||
|                 . fold <$> mapM quadruple value |                 . fold <$> mapM quadruple value | ||||||
|          in (accumulator <>) <$> code |          in (accumulator <>) <$> code | ||||||
| @@ -114,354 +119,140 @@ quadruple StopQuadruple = pure $ Vector.fromList | |||||||
|     , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI 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) |     , Instruction (RiscV.BaseInstruction RiscV.Jalr $ RiscV.I RiscV.RA RiscV.JALR RiscV.Zero 0) | ||||||
|     ] |     ] | ||||||
| quadruple (AddQuadruple operand1 operand2 (Store register)) | 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) | ||||||
|     | IntOperand immediateOperand1 <- operand1 |     | IntOperand immediateOperand1 <- operand1 | ||||||
|     , IntOperand immediateOperand2 <- operand2 = |     , IntOperand immediateOperand2 <- operand2 = | ||||||
|         pure $ lui (immediateOperand1 + immediateOperand2) register |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|  |          in pure $ lui (immediateOperand1 - immediateOperand2) storeRegister <> storeStatements | ||||||
|     | VariableOperand variableOperand1 <- operand1 |     | VariableOperand variableOperand1 <- operand1 | ||||||
|     , VariableOperand variableOperand2 <- operand2 = |     , VariableOperand variableOperand2 <- operand2 = | ||||||
|         let Store operandRegister1 = variableOperand1 |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|             Store operandRegister2 = variableOperand2 |             (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|         in pure $ Vector.singleton $ Instruction |             (operandRegister2, statements2) = loadFromStore variableOperand2 | ||||||
|             $ RiscV.BaseInstruction RiscV.Op |             instruction = Instruction | ||||||
|             $ RiscV.R register RiscV.ADD operandRegister1 operandRegister2 (RiscV.Funct7 0b0000000) |                 $ RiscV.BaseInstruction RiscV.Op | ||||||
|     | VariableOperand variableOperand1 <- operand1 |                 $ RiscV.R storeRegister RiscV.SUB operandRegister1 operandRegister2 | ||||||
|     , IntOperand immediateOperand2 <- operand2 = |                 $ RiscV.Funct7 0b0100000 | ||||||
|         addImmediateRegister variableOperand1 immediateOperand2 |         in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements | ||||||
|     | IntOperand immediateOperand1 <- operand1 |     | IntOperand immediateOperand1 <- operand1 | ||||||
|     , VariableOperand variableOperand2 <- operand2 = |     , VariableOperand variableOperand2 <- operand2 = | ||||||
|         addImmediateRegister variableOperand2 immediateOperand1 |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|   where |             statements1 = lui immediateOperand1 storeRegister | ||||||
|     addImmediateRegister variableOperand immediateOperand =  |             (operandRegister2, statements2) = loadFromStore variableOperand2 | ||||||
|         let statements = lui immediateOperand register |             instruction = Instruction | ||||||
|             Store operandRegister = variableOperand |                 $ RiscV.BaseInstruction RiscV.Op | ||||||
|         in pure $ Vector.snoc statements |                 $ RiscV.R storeRegister RiscV.SUB storeRegister operandRegister2 | ||||||
|             $ Instruction |                 $ RiscV.Funct7 0b0100000 | ||||||
|             $ RiscV.BaseInstruction RiscV.Op |          in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements | ||||||
|             $ RiscV.R register RiscV.ADD register operandRegister |  | ||||||
|             $ RiscV.Funct7 0b0000000 |  | ||||||
| quadruple (SubtractionQuadruple 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.SUB operandRegister1 operandRegister2 |  | ||||||
|             $ RiscV.Funct7 0b0100000 |  | ||||||
|     | IntOperand immediateOperand1 <- operand1 |  | ||||||
|     , VariableOperand variableOperand2 <- operand2 = |  | ||||||
|         let statements1 = lui immediateOperand1 register |  | ||||||
|             Store operandRegister2 = variableOperand2 |  | ||||||
|          in pure $ Vector.snoc statements1 |  | ||||||
|             $ Instruction |  | ||||||
|             $ RiscV.BaseInstruction RiscV.Op |  | ||||||
|             $ RiscV.R register RiscV.SUB register operandRegister2 |  | ||||||
|             $ RiscV.Funct7 0b0100000 |  | ||||||
|     | VariableOperand variableOperand1 <- operand1 |     | VariableOperand variableOperand1 <- operand1 | ||||||
|     , IntOperand immediateOperand2 <- operand2 = |     , IntOperand immediateOperand2 <- operand2 = | ||||||
|         let statements2 = lui (negate immediateOperand2) register |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|             Store operandRegister1 = variableOperand1 |             statements2 = lui (negate immediateOperand2) storeRegister | ||||||
|          in pure $ Vector.snoc statements2 |             (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|             $ Instruction |             instruction = Instruction | ||||||
|             $ RiscV.BaseInstruction RiscV.Op |                 $ RiscV.BaseInstruction RiscV.Op | ||||||
|             $ RiscV.R register RiscV.ADD register operandRegister1 |                 $ RiscV.R storeRegister RiscV.ADD storeRegister operandRegister1 | ||||||
|             $ RiscV.Funct7 0b0000000 |                 $ RiscV.Funct7 0b0000000 | ||||||
| quadruple (NegationQuadruple operand1 (Store register)) |          in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements | ||||||
|  | quadruple (NegationQuadruple operand1 store) | ||||||
|     | IntOperand immediateOperand1 <- operand1 = |     | IntOperand immediateOperand1 <- operand1 = | ||||||
|         pure $ lui (negate immediateOperand1) register |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|  |          in pure $ lui (negate immediateOperand1) storeRegister <> storeStatements | ||||||
|     | VariableOperand variableOperand1 <- operand1 = |     | VariableOperand variableOperand1 <- operand1 = | ||||||
|         let Store operandRegister1 = variableOperand1 |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|          in pure $ Vector.singleton |             (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|             $ Instruction |             instruction = Instruction | ||||||
|             $ RiscV.BaseInstruction RiscV.Op |                 $ RiscV.BaseInstruction RiscV.Op | ||||||
|             $ RiscV.R register RiscV.SUB RiscV.Zero operandRegister1 |                 $ RiscV.R storeRegister RiscV.SUB RiscV.Zero operandRegister1 | ||||||
|             $ RiscV.Funct7 0b0100000 |                 $ RiscV.Funct7 0b0100000 | ||||||
| quadruple (ProductQuadruple operand1 operand2 (Store register)) |          in pure $ statements1 <> Vector.cons instruction storeStatements | ||||||
|     | IntOperand immediateOperand1 <- operand1 | quadruple (DivisionQuadruple operand1 operand2 store) | ||||||
|     , 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 immediateOperand1 <- operand1 | ||||||
|     , IntOperand immediateOperand2 <- operand2 = |     , IntOperand immediateOperand2 <- operand2 = | ||||||
|         if immediateOperand2 == 0 |         if immediateOperand2 == 0 | ||||||
|         then pure $ Vector.singleton |         then pure $ Vector.singleton | ||||||
|             $ Instruction (RiscV.CallInstruction "_divide_by_zero_error") |             $ Instruction (RiscV.CallInstruction "_divide_by_zero_error") | ||||||
|         else pure $ lui (quot immediateOperand1 immediateOperand2) register |         else | ||||||
|  |             let (storeRegister, storeStatements) = storeToStore store | ||||||
|  |             in pure $ lui (quot immediateOperand1 immediateOperand2) storeRegister <> storeStatements | ||||||
|     | VariableOperand variableOperand1 <- operand1 |     | VariableOperand variableOperand1 <- operand1 | ||||||
|     , VariableOperand variableOperand2 <- operand2 = do |     , VariableOperand variableOperand2 <- operand2 = do | ||||||
|         let Store operandRegister1 = variableOperand1 |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|             Store operandRegister2 = variableOperand2 |             (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|  |             (operandRegister2, statements2) = loadFromStore variableOperand2 | ||||||
|             divisionInstruction = Instruction |             divisionInstruction = Instruction | ||||||
|                 $ RiscV.BaseInstruction RiscV.Op |                 $ RiscV.BaseInstruction RiscV.Op | ||||||
|                 $ RiscV.R register RiscV.DIV operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001) |                 $ RiscV.R storeRegister RiscV.DIV operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001) | ||||||
|         branchLabel <- createLabel |         branchLabel <- createLabel | ||||||
|         let branchInstruction = Instruction |         let branchInstruction = Instruction | ||||||
|                 $ RiscV.RelocatableInstruction RiscV.Branch |                 $ RiscV.RelocatableInstruction RiscV.Branch | ||||||
|                 $ RiscV.RBranch branchLabel RiscV.BNE RiscV.Zero operandRegister2 |                 $ RiscV.RBranch branchLabel RiscV.BNE RiscV.Zero operandRegister2 | ||||||
|         pure $ Vector.fromList |         pure $ statements1 <> statements2 <> Vector.fromList | ||||||
|             [ branchInstruction |             [ branchInstruction | ||||||
|             , Instruction (RiscV.CallInstruction "_divide_by_zero_error") |             , Instruction (RiscV.CallInstruction "_divide_by_zero_error") | ||||||
|             , JumpLabel branchLabel [] |             , JumpLabel branchLabel [] | ||||||
|             , divisionInstruction |             , divisionInstruction | ||||||
|             ] |             ] <> storeStatements | ||||||
|     | VariableOperand variableOperand1 <- operand1 |     | VariableOperand variableOperand1 <- operand1 | ||||||
|     , IntOperand immediateOperand2 <- operand2 = |     , IntOperand immediateOperand2 <- operand2 = | ||||||
|         let statements2 = lui immediateOperand2 register |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|             Store operandRegister1 = variableOperand1 |             statements2 = lui immediateOperand2 storeRegister | ||||||
|  |             (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|             operationInstruction |             operationInstruction | ||||||
|                 | immediateOperand2 == 0 = |                 | immediateOperand2 == 0 = | ||||||
|                     RiscV.CallInstruction "_divide_by_zero_error" |                     RiscV.CallInstruction "_divide_by_zero_error" | ||||||
|                 | otherwise = RiscV.BaseInstruction RiscV.Op |                 | otherwise = RiscV.BaseInstruction RiscV.Op | ||||||
|                     $ RiscV.R register RiscV.DIV operandRegister1 register |                     $ RiscV.R storeRegister RiscV.DIV operandRegister1 storeRegister | ||||||
|                     $ RiscV.Funct7 0b0000001 |                     $ RiscV.Funct7 0b0000001 | ||||||
|          in pure $ Vector.snoc statements2 |          in pure $ statements1 <> statements2 | ||||||
|             $ Instruction operationInstruction |             <> Vector.cons (Instruction operationInstruction) storeStatements | ||||||
|     | IntOperand immediateOperand1 <- operand1 |     | IntOperand immediateOperand1 <- operand1 | ||||||
|     , VariableOperand variableOperand2 <- operand2 = do |     , VariableOperand variableOperand2 <- operand2 = do | ||||||
|         let statements1 = lui immediateOperand1 register |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|             Store operandRegister2 = variableOperand2 |             statements1 = lui immediateOperand1 storeRegister | ||||||
|  |             (operandRegister2, statements2) = loadFromStore variableOperand2 | ||||||
|             divisionInstruction = Instruction |             divisionInstruction = Instruction | ||||||
|                 $ RiscV.BaseInstruction RiscV.Op |                 $ RiscV.BaseInstruction RiscV.Op | ||||||
|                 $ RiscV.R register RiscV.DIV register operandRegister2 (RiscV.Funct7 0b0000001) |                 $ RiscV.R storeRegister RiscV.DIV storeRegister operandRegister2 (RiscV.Funct7 0b0000001) | ||||||
|         branchLabel <- createLabel |         branchLabel <- createLabel | ||||||
|         let branchInstruction = Instruction |         let branchInstruction = Instruction | ||||||
|                 $ RiscV.RelocatableInstruction RiscV.Branch |                 $ RiscV.RelocatableInstruction RiscV.Branch | ||||||
|                 $ RiscV.RBranch branchLabel RiscV.BNE RiscV.Zero operandRegister2 |                 $ RiscV.RBranch branchLabel RiscV.BNE RiscV.Zero operandRegister2 | ||||||
|         pure $ mappend statements1 $ Vector.fromList  |         pure $ statements1 <> statements2 <> Vector.fromList  | ||||||
|             [ branchInstruction |             [ branchInstruction | ||||||
|             , Instruction (RiscV.CallInstruction "_divide_by_zero_error") |             , Instruction (RiscV.CallInstruction "_divide_by_zero_error") | ||||||
|             , JumpLabel branchLabel [] |             , JumpLabel branchLabel [] | ||||||
|             , divisionInstruction |             , divisionInstruction | ||||||
|             ] |             ] <> storeStatements | ||||||
| quadruple (LabelQuadruple (Label label)) = pure $ Vector.singleton $ JumpLabel label mempty | quadruple (LabelQuadruple (Label label)) = pure $ Vector.singleton $ JumpLabel label mempty | ||||||
| quadruple (GoToQuadruple label) = pure $ Vector.singleton $ unconditionalJal label | quadruple (GoToQuadruple label) = pure $ Vector.singleton $ unconditionalJal label | ||||||
| quadruple (EqualQuadruple operand1 operand2 goToLabel) | quadruple (EqualQuadruple operand1 operand2 goToLabel) = | ||||||
|     | IntOperand immediateOperand1 <- operand1 |     commutativeComparison (==) RiscV.BEQ (operand1, operand2) goToLabel | ||||||
|     , IntOperand immediateOperand2 <- operand2 = | quadruple (NonEqualQuadruple operand1 operand2 goToLabel) = | ||||||
|         if immediateOperand1 == immediateOperand2 |     commutativeComparison (/=) RiscV.BNE (operand1, operand2) goToLabel | ||||||
|         then pure $ Vector.singleton $ unconditionalJal goToLabel | quadruple (LessQuadruple operand1 operand2 goToLabel) = | ||||||
|         else pure Vector.empty |     lessThan (operand1, operand2) goToLabel | ||||||
|     | VariableOperand variableOperand1 <- operand1 | quadruple (GreaterQuadruple operand1 operand2 goToLabel) = | ||||||
|     , VariableOperand variableOperand2 <- operand2 = do |     lessThan (operand2, operand1) goToLabel | ||||||
|         let Store operandRegister1 = variableOperand1 | quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) = | ||||||
|             Store operandRegister2 = variableOperand2 |     lessOrEqualThan (operand1, operand2) goToLabel | ||||||
|             Label goToLabel' = goToLabel | quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) = | ||||||
|         pure $ Vector.singleton |     lessOrEqualThan (operand2, operand1) goToLabel | ||||||
|             $ Instruction | quadruple (AssignQuadruple operand1 store) | ||||||
|             $ RiscV.RelocatableInstruction RiscV.Branch |     | IntOperand immediateOperand1 <- operand1 = | ||||||
|             $ RiscV.RBranch goToLabel' RiscV.BEQ operandRegister1 operandRegister2 |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|     | VariableOperand variableOperand1 <- operand1 |          in pure $ lui immediateOperand1 storeRegister <> storeStatements | ||||||
|     , 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 (AssignQuadruple operand1 (Store register)) |  | ||||||
|     | IntOperand immediateOperand1 <- operand1 = pure |  | ||||||
|         $ lui immediateOperand1 register |  | ||||||
|     | VariableOperand variableOperand1 <- operand1 = |     | VariableOperand variableOperand1 <- operand1 = | ||||||
|         let Store operandRegister1 = variableOperand1 |         let (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|          in pure $ Vector.singleton |             (storeRegister, storeStatements) = storeToStore store | ||||||
|             $ Instruction |             instruction = Instruction | ||||||
|             $ RiscV.BaseInstruction RiscV.OpImm |                 $ RiscV.BaseInstruction RiscV.OpImm | ||||||
|             $ RiscV.I register RiscV.ADDI operandRegister1 0 |                 $ RiscV.I storeRegister RiscV.ADDI operandRegister1 0 | ||||||
|  |          in pure $ statements1 <> Vector.cons instruction storeStatements  | ||||||
|  |  | ||||||
| unconditionalJal :: Label -> Statement | unconditionalJal :: Label -> Statement | ||||||
| unconditionalJal (Label goToLabel) = Instruction | unconditionalJal (Label goToLabel) = Instruction | ||||||
| @@ -471,7 +262,7 @@ unconditionalJal (Label goToLabel) = Instruction | |||||||
| loadImmediateOrRegister :: RiscVOperand -> RiscV.XRegister -> (RiscV.XRegister, Vector Statement) | loadImmediateOrRegister :: RiscVOperand -> RiscV.XRegister -> (RiscV.XRegister, Vector Statement) | ||||||
| loadImmediateOrRegister (IntOperand intValue) targetRegister = | loadImmediateOrRegister (IntOperand intValue) targetRegister = | ||||||
|     (targetRegister, lui intValue targetRegister) |     (targetRegister, lui intValue targetRegister) | ||||||
| loadImmediateOrRegister (VariableOperand (Store register)) _ = (register, Vector.empty) | loadImmediateOrRegister (VariableOperand store) _ = loadFromStore store | ||||||
|  |  | ||||||
| lui :: Int32 -> RiscV.XRegister -> Vector Statement | lui :: Int32 -> RiscV.XRegister -> Vector Statement | ||||||
| lui intValue targetRegister | lui intValue targetRegister | ||||||
| @@ -489,3 +280,165 @@ lui intValue targetRegister | |||||||
|   where |   where | ||||||
|     hi = intValue `shiftR` 12 |     hi = intValue `shiftR` 12 | ||||||
|     lo = fromIntegral intValue |     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 | ||||||
|  |     | IntOperand immediateOperand1 <- operand1 | ||||||
|  |     , IntOperand immediateOperand2 <- operand2 = | ||||||
|  |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|  |             immediateOperation' = immediateOperation immediateOperand1 immediateOperand2 | ||||||
|  |          in pure $ lui immediateOperation' storeRegister <> storeStatements | ||||||
|  |     | VariableOperand variableOperand1 <- operand1 | ||||||
|  |     , VariableOperand variableOperand2 <- operand2 = | ||||||
|  |         let (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|  |             (operandRegister2, statements2) = loadFromStore variableOperand2 | ||||||
|  |             (storeRegister, storeStatements) = storeToStore store | ||||||
|  |             instruction = Instruction $ RiscV.BaseInstruction RiscV.Op | ||||||
|  |                 $ RiscV.R storeRegister funct3 operandRegister1 operandRegister2 funct7 | ||||||
|  |          in pure $ statements1 <> statements2 | ||||||
|  |             <> Vector.cons instruction storeStatements | ||||||
|  |     | VariableOperand variableOperand1 <- operand1 | ||||||
|  |     , IntOperand immediateOperand2 <- operand2 = | ||||||
|  |         commutativeImmediateRegister variableOperand1 immediateOperand2 | ||||||
|  |     | IntOperand immediateOperand1 <- operand1 | ||||||
|  |     , VariableOperand variableOperand2 <- operand2 = | ||||||
|  |         commutativeImmediateRegister variableOperand2 immediateOperand1 | ||||||
|  |   where | ||||||
|  |     commutativeImmediateRegister variableOperand immediateOperand =  | ||||||
|  |         let (storeRegister, storeStatements) = storeToStore store | ||||||
|  |             immediateStatements = lui immediateOperand storeRegister | ||||||
|  |             (operandRegister, registerStatements) = loadFromStore variableOperand | ||||||
|  |             instruction = Instruction | ||||||
|  |                 $ RiscV.BaseInstruction RiscV.Op | ||||||
|  |                 $ RiscV.R storeRegister funct3 storeRegister operandRegister funct7 | ||||||
|  |         in pure $ immediateStatements <> registerStatements | ||||||
|  |             <> Vector.cons instruction storeStatements | ||||||
|  |  | ||||||
|  | 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 (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|  |             (operandRegister2, statements2) = loadFromStore variableOperand2 | ||||||
|  |             Label goToLabel' = goToLabel | ||||||
|  |         pure $ Vector.snoc (statements1 <> statements2) | ||||||
|  |             $ 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 immediateStatements = lui immediateOperand immediateRegister | ||||||
|  |             (operandRegister, registerStatements) = loadFromStore variableOperand | ||||||
|  |             Label goToLabel' = goToLabel | ||||||
|  |         in pure $ Vector.snoc (immediateStatements <> registerStatements) | ||||||
|  |             $ 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 (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|  |             (operandRegister2, statements2) = loadFromStore variableOperand2 | ||||||
|  |             Label goToLabel' = goToLabel | ||||||
|  |         pure $ Vector.snoc (statements1 <> statements2) | ||||||
|  |             $ Instruction | ||||||
|  |             $ RiscV.RelocatableInstruction RiscV.Branch | ||||||
|  |             $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 operandRegister2 | ||||||
|  |     | VariableOperand variableOperand1 <- operand1 | ||||||
|  |     , IntOperand immediateOperand2 <- operand2 = | ||||||
|  |         let statements2 = lui immediateOperand2 immediateRegister | ||||||
|  |             (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|  |             Label goToLabel' = goToLabel | ||||||
|  |         in pure $ Vector.snoc (statements1 <> statements2) | ||||||
|  |             $ Instruction | ||||||
|  |             $ RiscV.RelocatableInstruction RiscV.Branch | ||||||
|  |             $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 immediateRegister | ||||||
|  |     | IntOperand immediateOperand1 <- operand1 | ||||||
|  |     , VariableOperand variableOperand2 <- operand2 = | ||||||
|  |         let statements1 = lui immediateOperand1 immediateRegister | ||||||
|  |             (operandRegister2, statements2) = loadFromStore variableOperand2 | ||||||
|  |             Label goToLabel' = goToLabel | ||||||
|  |         in pure $ Vector.snoc (statements1 <> statements2) | ||||||
|  |             $ 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 (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|  |             (operandRegister2, statements2) = loadFromStore variableOperand2 | ||||||
|  |             Label goToLabel' = goToLabel | ||||||
|  |         pure $ Vector.snoc (statements1 <> statements2) | ||||||
|  |             $ Instruction | ||||||
|  |             $ RiscV.RelocatableInstruction RiscV.Branch | ||||||
|  |             $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 operandRegister1 | ||||||
|  |     | VariableOperand variableOperand1 <- operand1 | ||||||
|  |     , IntOperand immediateOperand2 <- operand2 = | ||||||
|  |         let statements2 = lui immediateOperand2 immediateRegister | ||||||
|  |             (operandRegister1, statements1) = loadFromStore variableOperand1 | ||||||
|  |             Label goToLabel' = goToLabel | ||||||
|  |         in pure $ Vector.snoc (statements1 <> statements2) | ||||||
|  |             $ Instruction | ||||||
|  |             $ RiscV.RelocatableInstruction RiscV.Branch | ||||||
|  |             $ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister1 | ||||||
|  |     | IntOperand immediateOperand1 <- operand1 | ||||||
|  |     , VariableOperand variableOperand2 <- operand2 = | ||||||
|  |         let statements1 = lui immediateOperand1 immediateRegister | ||||||
|  |             (operandRegister2, statements2) = loadFromStore variableOperand2 | ||||||
|  |             Label goToLabel' = goToLabel | ||||||
|  |         in pure $ Vector.snoc (statements1 <> statements2) | ||||||
|  |             $ Instruction | ||||||
|  |             $ RiscV.RelocatableInstruction RiscV.Branch | ||||||
|  |             $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 immediateRegister | ||||||
|  |  | ||||||
|  | loadFromStore :: RiscVStore -> (RiscV.XRegister, Vector Statement) | ||||||
|  | loadFromStore (RegisterStore register) = (register, mempty) | ||||||
|  | loadFromStore (StackStore offset register) = | ||||||
|  |     let loadInstruction = Instruction | ||||||
|  |             $ RiscV.BaseInstruction RiscV.Load | ||||||
|  |             $ RiscV.I register RiscV.LW RiscV.SP offset | ||||||
|  |      in (register, Vector.singleton loadInstruction) | ||||||
|  |  | ||||||
|  | storeToStore :: RiscVStore -> (RiscV.XRegister, Vector Statement) | ||||||
|  | storeToStore (RegisterStore register) = (register, mempty) | ||||||
|  | storeToStore (StackStore offset register) = | ||||||
|  |     let storeInstruction = Instruction | ||||||
|  |             $ RiscV.BaseInstruction RiscV.Store | ||||||
|  |             $ RiscV.S offset RiscV.SW RiscV.SP register | ||||||
|  |      in (register, Vector.singleton storeInstruction) | ||||||
|   | |||||||
							
								
								
									
										1
									
								
								tests/expectations/add_to_variable.txt
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										1
									
								
								tests/expectations/add_to_variable.txt
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1 @@ | |||||||
|  | 58 | ||||||
							
								
								
									
										6
									
								
								tests/vm/add_to_variable.elna
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										6
									
								
								tests/vm/add_to_variable.elna
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,6 @@ | |||||||
|  | proc main() { | ||||||
|  |   var i: int; | ||||||
|  |   i := 28; | ||||||
|  |  | ||||||
|  |   printi(i + 30); | ||||||
|  | } | ||||||
		Reference in New Issue
	
	Block a user