Access multidimensional arrays
This commit is contained in:
parent
f78592378a
commit
d405072dbf
GPG Key ID:
A27FDC1E8EE902C0
@ -1,5 +1,7 @@
|
||||
module Language.Elna.AST
|
||||
( Declaration(..)
|
||||
( VariableAccess(..)
|
||||
, Condition(..)
|
||||
, Declaration(..)
|
||||
, Expression(..)
|
||||
, Identifier(..)
|
||||
, Literal(..)
|
||||
@ -44,21 +46,25 @@ instance Show Literal
|
||||
| boolean = "true"
|
||||
| otherwise = "false"
|
||||
|
||||
data VariableAccess
|
||||
= VariableAccess Identifier
|
||||
| ArrayAccess VariableAccess Expression
|
||||
deriving Eq
|
||||
|
||||
instance Show VariableAccess
|
||||
where
|
||||
show (VariableAccess variableName) = show variableName
|
||||
show (ArrayAccess arrayAccess elementIndex) =
|
||||
concat [show arrayAccess, "[", show elementIndex, "]"]
|
||||
|
||||
data Expression
|
||||
= VariableExpression Identifier
|
||||
= VariableExpression VariableAccess
|
||||
| LiteralExpression Literal
|
||||
| NegationExpression Expression
|
||||
| SumExpression Expression Expression
|
||||
| SubtractionExpression Expression Expression
|
||||
| ProductExpression Expression Expression
|
||||
| DivisionExpression Expression Expression
|
||||
| EqualExpression Expression Expression
|
||||
| NonEqualExpression Expression Expression
|
||||
| LessExpression Expression Expression
|
||||
| GreaterExpression Expression Expression
|
||||
| LessOrEqualExpression Expression Expression
|
||||
| GreaterOrEqualExpression Expression Expression
|
||||
| ArrayExpression Expression Expression
|
||||
deriving Eq
|
||||
|
||||
instance Show Expression
|
||||
@ -70,20 +76,30 @@ instance Show Expression
|
||||
show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs]
|
||||
show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
|
||||
show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs]
|
||||
show (EqualExpression lhs rhs) = concat [show lhs, " = ", show rhs]
|
||||
show (NonEqualExpression lhs rhs) = concat [show lhs, " # ", show rhs]
|
||||
show (LessExpression lhs rhs) = concat [show lhs, " < ", show rhs]
|
||||
show (GreaterExpression lhs rhs) = concat [show lhs, " > ", show rhs]
|
||||
show (LessOrEqualExpression lhs rhs) = concat [show lhs, " <= ", show rhs]
|
||||
show (GreaterOrEqualExpression lhs rhs) = concat [show lhs, " >= ", show rhs]
|
||||
show (ArrayExpression arrayExpression indexExpression) =
|
||||
concat [show arrayExpression, "[", show indexExpression, "]"]
|
||||
|
||||
data Condition
|
||||
= EqualCondition Expression Expression
|
||||
| NonEqualCondition Expression Expression
|
||||
| LessCondition Expression Expression
|
||||
| GreaterCondition Expression Expression
|
||||
| LessOrEqualCondition Expression Expression
|
||||
| GreaterOrEqualCondition Expression Expression
|
||||
deriving Eq
|
||||
|
||||
instance Show Condition
|
||||
where
|
||||
show (EqualCondition lhs rhs) = concat [show lhs, " = ", show rhs]
|
||||
show (NonEqualCondition lhs rhs) = concat [show lhs, " # ", show rhs]
|
||||
show (LessCondition lhs rhs) = concat [show lhs, " < ", show rhs]
|
||||
show (GreaterCondition lhs rhs) = concat [show lhs, " > ", show rhs]
|
||||
show (LessOrEqualCondition lhs rhs) = concat [show lhs, " <= ", show rhs]
|
||||
show (GreaterOrEqualCondition lhs rhs) = concat [show lhs, " >= ", show rhs]
|
||||
|
||||
data Statement
|
||||
= EmptyStatement
|
||||
| AssignmentStatement Expression Expression
|
||||
| IfStatement Expression Statement (Maybe Statement)
|
||||
| WhileStatement Expression Statement
|
||||
| AssignmentStatement VariableAccess Expression
|
||||
| IfStatement Condition Statement (Maybe Statement)
|
||||
| WhileStatement Condition Statement
|
||||
| CompoundStatement [Statement]
|
||||
| CallStatement Identifier [Expression]
|
||||
deriving Eq
|
||||
|
||||
@ -3,28 +3,37 @@ module Language.Elna.Intermediate
|
||||
, Operand(..)
|
||||
, Quadruple(..)
|
||||
, Variable(..)
|
||||
, intermediate
|
||||
) where
|
||||
|
||||
import Data.Int (Int32)
|
||||
import Data.Word (Word32)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Text (Text)
|
||||
import Data.Word (Word32)
|
||||
import Data.Vector (Vector)
|
||||
import qualified Data.Vector as Vector
|
||||
import qualified Language.Elna.AST as AST
|
||||
import Language.Elna.Types (Type(..))
|
||||
import Language.Elna.SymbolTable (SymbolTable, Info(..))
|
||||
import qualified Language.Elna.SymbolTable as SymbolTable
|
||||
|
||||
data Operand
|
||||
= VariableOperand Text
|
||||
= VariableOperand Variable
|
||||
| IntOperand Int32
|
||||
deriving (Eq, Show)
|
||||
|
||||
newtype Label = Label Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
newtype Variable = Variable Text
|
||||
data Variable = Variable Text | TempVariable
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Quadruple
|
||||
= StartQuadruple
|
||||
| GoToQuadruple Label
|
||||
| AssignQuadruple Operand Variable
|
||||
| ArrayQuadruple Variable Word32 Variable
|
||||
| ArrayQuadruple Variable Operand Variable
|
||||
| ArrayAssignQuadruple Operand Word32 Variable
|
||||
| AddQuadruple Operand Operand Variable
|
||||
| SubtractionQuadruple Operand Operand Variable
|
||||
@ -42,3 +51,91 @@ data Quadruple
|
||||
| CallQuadruple Variable Word32
|
||||
| StopQuadruple
|
||||
deriving (Eq, Show)
|
||||
|
||||
intermediate :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector Quadruple)
|
||||
intermediate globalTable (AST.Program declarations) =
|
||||
foldr go HashMap.empty declarations
|
||||
where
|
||||
go (AST.TypeDefinition _ _) accumulator = accumulator
|
||||
go (AST.ProcedureDefinition procedureName _ _ statements) accumulator =
|
||||
let translatedStatements
|
||||
= Vector.cons StartQuadruple
|
||||
$ flip Vector.snoc StopQuadruple
|
||||
$ foldMap (statement globalTable) statements
|
||||
in HashMap.insert procedureName translatedStatements accumulator
|
||||
|
||||
statement :: SymbolTable -> AST.Statement -> Vector Quadruple
|
||||
statement _ AST.EmptyStatement = mempty
|
||||
statement globalTable (AST.CompoundStatement statements) =
|
||||
foldMap (statement globalTable) statements
|
||||
|
||||
variableAccess
|
||||
:: SymbolTable
|
||||
-> AST.VariableAccess
|
||||
-> Maybe Operand
|
||||
-> Type
|
||||
-> Vector Quadruple
|
||||
-> (AST.Identifier, Maybe Operand, Vector Quadruple)
|
||||
variableAccess _ (AST.VariableAccess identifier) accumulatedIndex _ accumulatedStatements =
|
||||
(identifier, accumulatedIndex, accumulatedStatements)
|
||||
variableAccess localTable (AST.ArrayAccess access1 index1) Nothing (ArrayType _ baseType) _ =
|
||||
let (indexPlace, statements) = expression localTable index1
|
||||
in variableAccess localTable access1 (Just indexPlace) baseType statements
|
||||
variableAccess localTable (AST.ArrayAccess arrayAccess' arrayIndex) (Just baseIndex) (ArrayType arraySize baseType) statements =
|
||||
let (indexPlace, statements') = expression localTable arrayIndex
|
||||
resultVariable = TempVariable
|
||||
resultOperand = VariableOperand resultVariable
|
||||
indexCalculation = Vector.fromList
|
||||
[ ProductQuadruple (IntOperand $ fromIntegral arraySize) baseIndex resultVariable
|
||||
, AddQuadruple indexPlace resultOperand resultVariable
|
||||
]
|
||||
in variableAccess localTable arrayAccess' (Just resultOperand) baseType
|
||||
$ statements <> indexCalculation <> statements'
|
||||
variableAccess _ _ _ _ _ = error "Array access operator doesn't match the type."
|
||||
|
||||
variableType :: AST.VariableAccess -> SymbolTable -> Type
|
||||
variableType (AST.VariableAccess identifier) symbolTable
|
||||
| Just (TypeInfo type') <- SymbolTable.lookup identifier symbolTable = type'
|
||||
| otherwise = error "Undefined type."
|
||||
variableType (AST.ArrayAccess arrayAccess' _) symbolTable =
|
||||
variableType arrayAccess' symbolTable
|
||||
|
||||
expression :: SymbolTable -> AST.Expression -> (Operand, Vector Quadruple)
|
||||
expression localTable = \case
|
||||
(AST.VariableExpression variableExpression) ->
|
||||
let variableType' = variableType variableExpression localTable
|
||||
in case variableAccess localTable variableExpression Nothing variableType' mempty of
|
||||
(AST.Identifier identifier, Nothing, statements) ->
|
||||
(VariableOperand (Variable identifier), statements)
|
||||
(AST.Identifier identifier, Just operand, statements) ->
|
||||
let arrayAddress = TempVariable
|
||||
arrayStatement = ArrayQuadruple (Variable identifier) operand arrayAddress
|
||||
in (VariableOperand arrayAddress, Vector.snoc statements arrayStatement)
|
||||
(AST.LiteralExpression literal') -> (literal literal', mempty)
|
||||
(AST.NegationExpression negation) ->
|
||||
let (operand, statements) = expression localTable negation
|
||||
tempVariable = TempVariable
|
||||
negationQuadruple = NegationQuadruple operand tempVariable
|
||||
in (VariableOperand tempVariable, Vector.snoc statements negationQuadruple)
|
||||
(AST.SumExpression lhs rhs) -> binaryExpression AddQuadruple lhs rhs
|
||||
(AST.SubtractionExpression lhs rhs) ->
|
||||
binaryExpression SubtractionQuadruple lhs rhs
|
||||
(AST.ProductExpression lhs rhs) ->
|
||||
binaryExpression ProductQuadruple lhs rhs
|
||||
(AST.DivisionExpression lhs rhs) ->
|
||||
binaryExpression DivisionQuadruple lhs rhs
|
||||
where
|
||||
binaryExpression f lhs rhs =
|
||||
let (lhsOperand, lhsStatements) = expression localTable lhs
|
||||
(rhsOperand, rhsStatements) = expression localTable rhs
|
||||
tempVariable = TempVariable
|
||||
newQuadruple = f lhsOperand rhsOperand tempVariable
|
||||
in (VariableOperand tempVariable, Vector.snoc (lhsStatements <> rhsStatements) newQuadruple)
|
||||
|
||||
literal :: AST.Literal -> Operand
|
||||
literal (AST.IntegerLiteral integer) = IntOperand integer
|
||||
literal (AST.HexadecimalLiteral integer) = IntOperand integer
|
||||
literal (AST.CharacterLiteral character) = IntOperand $ fromIntegral character
|
||||
literal (AST.BooleanLiteral boolean)
|
||||
| boolean = IntOperand 1
|
||||
| otherwise = IntOperand 0
|
||||
|
||||
@ -83,23 +83,23 @@ declaration globalTable (AST.ProcedureDefinition identifier parameters variables
|
||||
statement :: SymbolTable -> AST.Statement -> NameAnalysis ()
|
||||
statement _ AST.EmptyStatement = pure ()
|
||||
statement globalTable (AST.AssignmentStatement lvalue rvalue)
|
||||
= expression globalTable lvalue
|
||||
= variableAccess globalTable lvalue
|
||||
>> expression globalTable rvalue
|
||||
statement globalTable (AST.IfStatement condition ifStatement elseStatement)
|
||||
= expression globalTable condition
|
||||
statement globalTable (AST.IfStatement ifCondition ifStatement elseStatement)
|
||||
= condition globalTable ifCondition
|
||||
>> statement globalTable ifStatement
|
||||
>> maybe (pure ()) (statement globalTable) elseStatement
|
||||
statement globalTable (AST.WhileStatement condition loop)
|
||||
= expression globalTable condition
|
||||
statement globalTable (AST.WhileStatement whileCondition loop)
|
||||
= condition globalTable whileCondition
|
||||
>> statement globalTable loop
|
||||
statement globalTable (AST.CompoundStatement statements) =
|
||||
traverse_ (statement globalTable) statements
|
||||
statement globalTable (AST.CallStatement name arguments)
|
||||
= checkSymbol name globalTable
|
||||
= checkSymbol globalTable name
|
||||
>> traverse_ (expression globalTable) arguments
|
||||
|
||||
checkSymbol :: Identifier -> SymbolTable -> NameAnalysis ()
|
||||
checkSymbol identifier globalTable =
|
||||
checkSymbol :: SymbolTable -> Identifier -> NameAnalysis ()
|
||||
checkSymbol globalTable identifier =
|
||||
let undefinedSymbolError = NameAnalysis
|
||||
$ lift
|
||||
$ throwE
|
||||
@ -109,8 +109,8 @@ checkSymbol identifier globalTable =
|
||||
>>= (flip unless undefinedSymbolError . (isDefined ||))
|
||||
|
||||
expression :: SymbolTable -> AST.Expression -> NameAnalysis ()
|
||||
expression globalTable (AST.VariableExpression identifier) =
|
||||
checkSymbol identifier globalTable
|
||||
expression globalTable (AST.VariableExpression variableExpression) =
|
||||
variableAccess globalTable variableExpression
|
||||
expression _ (AST.LiteralExpression _) = pure ()
|
||||
expression globalTable (AST.NegationExpression negation) =
|
||||
expression globalTable negation
|
||||
@ -126,27 +126,33 @@ expression globalTable (AST.ProductExpression lhs rhs)
|
||||
expression globalTable (AST.DivisionExpression lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
expression globalTable (AST.EqualExpression lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
expression globalTable (AST.NonEqualExpression lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
expression globalTable (AST.LessExpression lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
expression globalTable (AST.GreaterExpression lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
expression globalTable (AST.LessOrEqualExpression lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
expression globalTable (AST.GreaterOrEqualExpression lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
expression globalTable (AST.ArrayExpression arrayExpression indexExpression)
|
||||
= expression globalTable arrayExpression
|
||||
|
||||
variableAccess :: SymbolTable -> AST.VariableAccess -> NameAnalysis ()
|
||||
variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression)
|
||||
= variableAccess globalTable arrayExpression
|
||||
>> expression globalTable indexExpression
|
||||
variableAccess globalTable (AST.VariableAccess identifier) =
|
||||
checkSymbol globalTable identifier
|
||||
|
||||
condition :: SymbolTable -> AST.Condition -> NameAnalysis ()
|
||||
condition globalTable (AST.EqualCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
condition globalTable (AST.NonEqualCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
condition globalTable (AST.LessCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
condition globalTable (AST.GreaterCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
condition globalTable (AST.LessOrEqualCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
condition globalTable (AST.GreaterOrEqualCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
|
||||
enter :: Identifier -> Info -> SymbolTable -> NameAnalysis SymbolTable
|
||||
enter identifier info table
|
||||
|
||||
@ -9,7 +9,9 @@ import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Void (Void)
|
||||
import Language.Elna.AST
|
||||
( Declaration(..)
|
||||
( VariableAccess(..)
|
||||
, Condition(..)
|
||||
, Declaration(..)
|
||||
, Expression(..)
|
||||
, Identifier(..)
|
||||
, Literal(..)
|
||||
@ -21,12 +23,12 @@ import Language.Elna.AST
|
||||
)
|
||||
import Text.Megaparsec
|
||||
( Parsec
|
||||
, MonadParsec(..)
|
||||
, (<?>)
|
||||
, optional
|
||||
, between
|
||||
, sepBy
|
||||
, choice
|
||||
, MonadParsec(..)
|
||||
)
|
||||
import Text.Megaparsec.Char
|
||||
( alphaNumChar
|
||||
@ -124,19 +126,23 @@ termP :: Parser Expression
|
||||
termP = choice
|
||||
[ parensP expressionP
|
||||
, LiteralExpression <$> literalP
|
||||
, VariableExpression <$> identifierP
|
||||
, VariableExpression <$> variableAccessP
|
||||
]
|
||||
|
||||
variableAccessP :: Parser VariableAccess
|
||||
variableAccessP = do
|
||||
identifier <- identifierP
|
||||
indices <- many $ bracketsP expressionP
|
||||
pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices
|
||||
|
||||
operatorTable :: [[Operator Parser Expression]]
|
||||
operatorTable =
|
||||
[ [Postfix (flip ArrayExpression <$> bracketsP expressionP)]
|
||||
, unaryOperator
|
||||
[ unaryOperator
|
||||
, factorOperator
|
||||
, termOperator
|
||||
, comparisonOperator
|
||||
]
|
||||
where
|
||||
unaryOperator =
|
||||
unaryOperator =
|
||||
[ prefix "-" NegationExpression
|
||||
, prefix "+" id
|
||||
]
|
||||
@ -148,20 +154,27 @@ operatorTable =
|
||||
[ binary "+" SumExpression
|
||||
, binary "-" SubtractionExpression
|
||||
]
|
||||
comparisonOperator =
|
||||
[ binary "<" LessExpression
|
||||
, binary "<=" LessOrEqualExpression
|
||||
, binary ">" GreaterExpression
|
||||
, binary ">=" GreaterOrEqualExpression
|
||||
, binary "=" EqualExpression
|
||||
, binary "#" NonEqualExpression
|
||||
]
|
||||
prefix name f = Prefix (f <$ symbol name)
|
||||
binary name f = InfixL (f <$ symbol name)
|
||||
|
||||
expressionP :: Parser Expression
|
||||
expressionP = makeExprParser termP operatorTable
|
||||
|
||||
conditionP :: Parser Condition
|
||||
conditionP = do
|
||||
lhs <- expressionP
|
||||
conditionCons <- choice comparisonOperator
|
||||
conditionCons lhs <$> expressionP
|
||||
where
|
||||
comparisonOperator =
|
||||
[ symbol "<" >> pure LessCondition
|
||||
, symbol "<=" >> pure LessOrEqualCondition
|
||||
, symbol ">" >> pure GreaterCondition
|
||||
, symbol ">=" >> pure GreaterOrEqualCondition
|
||||
, symbol "=" >> pure EqualCondition
|
||||
, symbol "#" >> pure NonEqualCondition
|
||||
]
|
||||
|
||||
statementP :: Parser Statement
|
||||
statementP
|
||||
= EmptyStatement <$ semicolonP
|
||||
@ -173,18 +186,18 @@ statementP
|
||||
<?> "statement"
|
||||
where
|
||||
ifElseP = IfStatement
|
||||
<$> (symbol "if" *> parensP expressionP)
|
||||
<$> (symbol "if" *> parensP conditionP)
|
||||
<*> statementP
|
||||
<*> optional (symbol "else" *> statementP)
|
||||
whileP = WhileStatement
|
||||
<$> (symbol "while" *> parensP expressionP)
|
||||
<$> (symbol "while" *> parensP conditionP)
|
||||
<*> statementP
|
||||
callP = CallStatement
|
||||
<$> identifierP
|
||||
<*> parensP (sepBy expressionP commaP)
|
||||
<* semicolonP
|
||||
assignmentP = AssignmentStatement
|
||||
<$> expressionP
|
||||
<$> variableAccessP
|
||||
<* symbol ":="
|
||||
<*> expressionP
|
||||
<* semicolonP
|
||||
|
||||
@ -76,22 +76,20 @@ statement :: SymbolTable -> AST.Statement -> TypeAnalysis ()
|
||||
statement globalTable = \case
|
||||
AST.EmptyStatement -> pure ()
|
||||
AST.AssignmentStatement lhs rhs -> do
|
||||
lhsType <- expression globalTable lhs
|
||||
lhsType <- variableAccess globalTable lhs
|
||||
rhsType <- expression globalTable rhs
|
||||
unless (lhsType == intType)
|
||||
$ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError lhsType
|
||||
unless (rhsType == intType)
|
||||
$ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError rhsType
|
||||
unless (isLvalue lhs)
|
||||
$ TypeAnalysis $ lift $ throwE $ ExpectedLvalueError lhs
|
||||
AST.IfStatement condition ifStatement elseStatement -> do
|
||||
conditionType <- expression globalTable condition
|
||||
AST.IfStatement ifCondition ifStatement elseStatement -> do
|
||||
conditionType <- condition globalTable ifCondition
|
||||
unless (conditionType == booleanType)
|
||||
$ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError conditionType
|
||||
statement globalTable ifStatement
|
||||
maybe (pure ()) (statement globalTable) elseStatement
|
||||
AST.WhileStatement condition whileStatement -> do
|
||||
conditionType <- expression globalTable condition
|
||||
AST.WhileStatement whileCondition whileStatement -> do
|
||||
conditionType <- condition globalTable whileCondition
|
||||
unless (conditionType == booleanType)
|
||||
$ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError conditionType
|
||||
statement globalTable whileStatement
|
||||
@ -116,20 +114,32 @@ statement globalTable = \case
|
||||
$ TypeAnalysis $ lift $ throwE $ ArgumentTypeMismatchError type' argumentType
|
||||
when (isReferenceParameter && not (isLvalue argument))
|
||||
$ TypeAnalysis $ lift $ throwE $ ExpectedLvalueError argument
|
||||
isLvalue (AST.ArrayExpression arrayExpression _) = isLvalue arrayExpression
|
||||
isLvalue (AST.VariableExpression _) = True
|
||||
isLvalue _ = False
|
||||
|
||||
variableAccess :: SymbolTable -> AST.VariableAccess -> TypeAnalysis Type
|
||||
variableAccess globalTable (AST.VariableAccess identifier) = do
|
||||
localLookup <- TypeAnalysis $ asks $ SymbolTable.lookup identifier
|
||||
case localLookup <|> SymbolTable.lookup identifier globalTable of
|
||||
Just (VariableInfo _ variableType) -> pure variableType
|
||||
Just anotherInfo -> TypeAnalysis $ lift $ throwE
|
||||
$ UnexpectedVariableInfoError anotherInfo
|
||||
Nothing -> TypeAnalysis $ lift $ throwE
|
||||
$ UndefinedSymbolError identifier
|
||||
variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression) = do
|
||||
arrayType <- variableAccess globalTable arrayExpression
|
||||
indexType <- expression globalTable indexExpression
|
||||
unless (indexType == intType)
|
||||
$ TypeAnalysis $ lift $ throwE $ ArrayIndexError indexType
|
||||
case arrayType of
|
||||
ArrayType _ baseType -> pure baseType
|
||||
nonArrayType -> TypeAnalysis $ lift $ throwE
|
||||
$ ArrayAccessError nonArrayType
|
||||
|
||||
expression :: SymbolTable -> AST.Expression -> TypeAnalysis Type
|
||||
expression globalTable = \case
|
||||
AST.VariableExpression identifier -> do
|
||||
localLookup <- TypeAnalysis $ asks $ SymbolTable.lookup identifier
|
||||
case localLookup <|> SymbolTable.lookup identifier globalTable of
|
||||
Just (VariableInfo _ variableType) -> pure variableType
|
||||
Just anotherInfo -> TypeAnalysis $ lift $ throwE
|
||||
$ UnexpectedVariableInfoError anotherInfo
|
||||
Nothing -> TypeAnalysis $ lift $ throwE
|
||||
$ UndefinedSymbolError identifier
|
||||
AST.VariableExpression variableExpression -> do
|
||||
variableAccess globalTable variableExpression
|
||||
AST.LiteralExpression literal' -> literal literal'
|
||||
AST.NegationExpression negation -> do
|
||||
operandType <- expression globalTable negation
|
||||
@ -140,21 +150,6 @@ expression globalTable = \case
|
||||
AST.SubtractionExpression lhs rhs -> arithmeticExpression lhs rhs
|
||||
AST.ProductExpression lhs rhs -> arithmeticExpression lhs rhs
|
||||
AST.DivisionExpression lhs rhs -> arithmeticExpression lhs rhs
|
||||
AST.EqualExpression lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.NonEqualExpression lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.LessExpression lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.GreaterExpression lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.LessOrEqualExpression lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.GreaterOrEqualExpression lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.ArrayExpression arrayExpression indexExpression -> do
|
||||
arrayType <- expression globalTable arrayExpression
|
||||
indexType <- expression globalTable indexExpression
|
||||
unless (indexType == intType)
|
||||
$ TypeAnalysis $ lift $ throwE $ ArrayIndexError indexType
|
||||
case arrayType of
|
||||
ArrayType _ baseType -> pure baseType
|
||||
nonArrayType -> TypeAnalysis $ lift $ throwE
|
||||
$ ArrayAccessError nonArrayType
|
||||
where
|
||||
arithmeticExpression lhs rhs = do
|
||||
lhsType <- expression globalTable lhs
|
||||
@ -164,10 +159,20 @@ expression globalTable = \case
|
||||
unless (rhsType == intType)
|
||||
$ TypeAnalysis $ lift $ throwE $ ArithmeticExpressionError rhsType
|
||||
pure intType
|
||||
|
||||
condition :: SymbolTable -> AST.Condition -> TypeAnalysis Type
|
||||
condition globalTable = \case
|
||||
AST.EqualCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.NonEqualCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.LessCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.GreaterCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.LessOrEqualCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.GreaterOrEqualCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
where
|
||||
comparisonExpression lhs rhs = do
|
||||
lhsType <- expression globalTable lhs
|
||||
rhsType <- expression globalTable rhs
|
||||
if lhsType == intType && rhsType ==intType
|
||||
if lhsType == intType && rhsType == intType
|
||||
then pure booleanType
|
||||
else TypeAnalysis $ lift $ throwE $ ComparisonExpressionError lhsType rhsType
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user