Make IR for array access
This commit is contained in:
		| @@ -139,6 +139,10 @@ quadruple = \case | |||||||
|         operand1' <- operand operand1 |         operand1' <- operand operand1 | ||||||
|         operand2' <- operand operand2 |         operand2' <- operand operand2 | ||||||
|         ArrayAssignQuadruple operand1' operand2' <$> storeVariable variable |         ArrayAssignQuadruple operand1' operand2' <$> storeVariable variable | ||||||
|  |     ArrayQuadruple variable1 operand1 variable2 -> ArrayQuadruple  | ||||||
|  |         <$> storeVariable variable1 | ||||||
|  |         <*> operand operand1 | ||||||
|  |         <*> storeVariable variable2 | ||||||
|  |  | ||||||
| operand :: Operand Variable -> Allocator r (Operand (Store r)) | operand :: Operand Variable -> Allocator r (Operand (Store r)) | ||||||
| operand (IntOperand x) = pure $ IntOperand x | operand (IntOperand x) = pure $ IntOperand x | ||||||
|   | |||||||
| @@ -50,7 +50,7 @@ data Quadruple v | |||||||
|     | DivisionQuadruple (Operand v) (Operand v) v |     | DivisionQuadruple (Operand v) (Operand v) v | ||||||
|     | GoToQuadruple Label |     | GoToQuadruple Label | ||||||
|     | AssignQuadruple (Operand v) v |     | AssignQuadruple (Operand v) v | ||||||
|     {-| ArrayQuadruple Variable Operand Variable -} |     | ArrayQuadruple v (Operand v) v | ||||||
|     | ArrayAssignQuadruple (Operand v) (Operand v) v |     | ArrayAssignQuadruple (Operand v) (Operand v) v | ||||||
|     | LessOrEqualQuadruple (Operand v) (Operand v) Label |     | LessOrEqualQuadruple (Operand v) (Operand v) Label | ||||||
|     | GreaterOrEqualQuadruple (Operand v) (Operand v) Label |     | GreaterOrEqualQuadruple (Operand v) (Operand v) Label | ||||||
|   | |||||||
| @@ -26,6 +26,7 @@ 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(..)) | import Language.Elna.Frontend.AST (Identifier(..)) | ||||||
|  | import Debug.Trace (traceShow) | ||||||
|  |  | ||||||
| data Paste = Paste | data Paste = Paste | ||||||
|     { temporaryCounter :: Word32 |     { temporaryCounter :: Word32 | ||||||
| @@ -71,11 +72,12 @@ 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 parameters variableDeclarations statements) | declaration globalTable (AST.ProcedureDeclaration procedureName parameters variableDeclarations statements) = | ||||||
|     = Glue (modify' resetTemporaryCounter) |     let Just (ProcedureInfo localTable _) = SymbolTable.lookup procedureName globalTable | ||||||
|  |      in Glue (modify' resetTemporaryCounter) | ||||||
|         >> traverseWithIndex registerVariable variableDeclarations |         >> traverseWithIndex registerVariable variableDeclarations | ||||||
|         >> traverseWithIndex registerParameter (reverse parameters) |         >> traverseWithIndex registerParameter (reverse parameters) | ||||||
|     >> nameQuadruplesTuple <$> traverse (statement globalTable) statements |         >> nameQuadruplesTuple <$> traverse (statement localTable) statements | ||||||
|   where |   where | ||||||
|     traverseWithIndex f = traverse_ (uncurry f) . zip [0..] |     traverseWithIndex f = traverse_ (uncurry f) . zip [0..] | ||||||
|     registerParameter index (AST.Parameter identifier _ _) = |     registerParameter index (AST.Parameter identifier _ _) = | ||||||
| @@ -251,7 +253,8 @@ variableAccess _ _ _ _ _ = error "Array access operator doesn't match the type." | |||||||
| variableType :: AST.VariableAccess -> SymbolTable -> Type | variableType :: AST.VariableAccess -> SymbolTable -> Type | ||||||
| variableType (AST.VariableAccess identifier) symbolTable | variableType (AST.VariableAccess identifier) symbolTable | ||||||
|     | Just (TypeInfo type') <- SymbolTable.lookup identifier symbolTable = type' |     | Just (TypeInfo type') <- SymbolTable.lookup identifier symbolTable = type' | ||||||
|     | otherwise = error "Undefined type." |     | Just (VariableInfo _ type') <- SymbolTable.lookup identifier symbolTable = type' | ||||||
|  |     | otherwise = traceShow identifier $ error "Undefined type." | ||||||
| variableType (AST.ArrayAccess arrayAccess' _) symbolTable = | variableType (AST.ArrayAccess arrayAccess' _) symbolTable = | ||||||
|     variableType arrayAccess' symbolTable |     variableType arrayAccess' symbolTable | ||||||
|  |  | ||||||
|   | |||||||
| @@ -295,6 +295,38 @@ quadruple _ (ArrayAssignQuadruple assigneeOperand indexOperand store) | |||||||
|                 , storeInstruction |                 , storeInstruction | ||||||
|                 ] |                 ] | ||||||
|         in (register, indexStatements <> statements) |         in (register, indexStatements <> statements) | ||||||
|  | quadruple _ (ArrayQuadruple assigneeVariable indexOperand store) = | ||||||
|  |     let (operandRegister1, statements1) = loadWithOffset assigneeVariable indexOperand | ||||||
|  |         (storeRegister, storeStatements) = storeToStore store | ||||||
|  |         instruction = Instruction | ||||||
|  |             $ RiscV.BaseInstruction RiscV.OpImm | ||||||
|  |             $ RiscV.I storeRegister RiscV.ADDI operandRegister1 0 | ||||||
|  |      in pure $ statements1 <> Vector.cons instruction storeStatements  | ||||||
|  |   where | ||||||
|  |     loadWithOffset :: RiscVStore -> Operand RiscVStore -> (RiscV.XRegister, Vector Statement) | ||||||
|  |     loadWithOffset (RegisterStore register) _ = (register, mempty) | ||||||
|  |     loadWithOffset (StackStore offset register) (IntOperand indexOffset) = | ||||||
|  |         let loadInstruction = Instruction | ||||||
|  |                 $ RiscV.BaseInstruction RiscV.Load | ||||||
|  |                 $ RiscV.I register RiscV.LW RiscV.S0 (fromIntegral $ offset + indexOffset) | ||||||
|  |         in (register, Vector.singleton loadInstruction) | ||||||
|  |     loadWithOffset (StackStore offset register) (VariableOperand indexOffset) = | ||||||
|  |         let baseRegisterInstruction = Instruction | ||||||
|  |                 $ RiscV.BaseInstruction RiscV.OpImm | ||||||
|  |                 $ RiscV.I immediateRegister RiscV.ADDI RiscV.S0 0 | ||||||
|  |             (indexRegister, indexStatements) = loadFromStore indexOffset | ||||||
|  |             registerWithOffset = Instruction | ||||||
|  |                 $ RiscV.BaseInstruction RiscV.OpImm | ||||||
|  |                 $ RiscV.I immediateRegister RiscV.ADDI indexRegister 0 | ||||||
|  |             loadInstruction = Instruction | ||||||
|  |                 $ RiscV.BaseInstruction RiscV.Load | ||||||
|  |                 $ RiscV.I register RiscV.SW immediateRegister (fromIntegral offset) | ||||||
|  |             statements = Vector.fromList | ||||||
|  |                 [ baseRegisterInstruction | ||||||
|  |                 , registerWithOffset | ||||||
|  |                 , loadInstruction | ||||||
|  |                 ] | ||||||
|  |         in (register, indexStatements <> statements) | ||||||
|  |  | ||||||
| unconditionalJal :: Label -> Statement | unconditionalJal :: Label -> Statement | ||||||
| unconditionalJal (Label goToLabel) = Instruction | unconditionalJal (Label goToLabel) = Instruction | ||||||
|   | |||||||
| @@ -0,0 +1 @@ | |||||||
|  | 5 | ||||||
|   | |||||||
							
								
								
									
										2
									
								
								tests/expectations/print_array_element.txt
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										2
									
								
								tests/expectations/print_array_element.txt
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,2 @@ | |||||||
|  | 5 | ||||||
|  | 7 | ||||||
| @@ -1,3 +1,6 @@ | |||||||
| proc main() { | proc main() { | ||||||
|   var a: array[1] of int; |   var a: array[1] of int; | ||||||
|  |   a[0] := 5; | ||||||
|  |  | ||||||
|  |   printi(a[0]); | ||||||
| } | } | ||||||
|   | |||||||
							
								
								
									
										8
									
								
								tests/vm/print_array_element.elna
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										8
									
								
								tests/vm/print_array_element.elna
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,8 @@ | |||||||
|  | proc main() { | ||||||
|  |   var a: array[2] of int; | ||||||
|  |   a[0] := 5; | ||||||
|  |   a[1] := 7; | ||||||
|  |  | ||||||
|  |   printi(a[0]); | ||||||
|  |   printi(a[1]); | ||||||
|  | } | ||||||
		Reference in New Issue
	
	Block a user