Make IR for array access
This commit is contained in:
parent
0c40bca60b
commit
b71d28201e
@ -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
|
||||||
>> traverseWithIndex registerVariable variableDeclarations
|
in Glue (modify' resetTemporaryCounter)
|
||||||
>> traverseWithIndex registerParameter (reverse parameters)
|
>> traverseWithIndex registerVariable variableDeclarations
|
||||||
>> nameQuadruplesTuple <$> traverse (statement globalTable) statements
|
>> traverseWithIndex registerParameter (reverse parameters)
|
||||||
|
>> 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]);
|
||||||
|
}
|
Loading…
Reference in New Issue
Block a user