Assignment now rakes expression instead of identifier

This commit is contained in:
3 changed files with 26 additions and 14 deletions

View File

@ -19,7 +19,7 @@ data Statement
deriving (Show)
data StatementExpression
= Assignment Identifier Expression
= Assignment Expression Expression
| ConstructorCall DataType [Expression]
| MethodCall Expression Identifier [Expression]
| TypedStatementExpression DataType StatementExpression

View File

@ -49,7 +49,7 @@ exampleExpression :: Expression
exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age")
exampleAssignment :: Expression
exampleAssignment = StatementExpressionExpression (Assignment "a" (IntegerLiteral 30))
exampleAssignment = StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 30))
exampleMethodCall :: Statement
exampleMethodCall = StatementExpressionStatement (MethodCall (Reference "this") "setAge" [IntegerLiteral 30])
@ -80,7 +80,7 @@ exampleMethodCallAndAssignment = Block [
LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
LocalVariableDeclaration (VariableDeclaration "int" "a" Nothing),
StatementExpressionStatement (Assignment "a" (Reference "age"))
StatementExpressionStatement (Assignment (Reference "a") (Reference "age"))
]
@ -89,7 +89,13 @@ exampleMethodCallAndAssignmentFail = Block [
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))),
LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
StatementExpressionStatement (Assignment "a" (Reference "age"))
StatementExpressionStatement (Assignment (Reference "age") (Reference "age"))
]
exampleNameResolutionAssignment :: Statement
exampleNameResolutionAssignment = Block [
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))),
StatementExpressionStatement (Assignment (BinaryOperation NameResolution (Reference "bob") (Reference "age")) (IntegerLiteral 30))
]
testClasses :: [Class]
@ -202,4 +208,11 @@ runTypeCheck = do
printSuccess "Type checking of Program completed successfully"
printResult "Typed Program:" typedProgram
) handleError
catch (do
print "====================================================================================="
typedAssignment <- evaluate (typeCheckStatement exampleNameResolutionAssignment [] sampleClasses)
printSuccess "Type checking of name resolution assignment completed successfully"
printResult "Result Name Resolution Assignment:" typedAssignment
) handleError

View File

@ -200,18 +200,17 @@ typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
-- ********************************** Type Checking: StatementExpressions **********************************
typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression
typeCheckStatementExpression (Assignment id expr) symtab classes =
typeCheckStatementExpression (Assignment ref expr) symtab classes =
let expr' = typeCheckExpression expr symtab classes
ref' = typeCheckExpression ref symtab classes
type' = getTypeFromExpr expr'
maybeType'' = lookupType id symtab
in case maybeType'' of
Just type'' ->
if type' == type'' then
TypedStatementExpression type' (Assignment id expr')
else
error $ "Assignment type mismatch: expected " ++ type'' ++ ", found " ++ type'
Nothing -> error $ "Identifier '" ++ id ++ "' not found in symbol table"
type'' = getTypeFromExpr ref'
in
if type'' == type' then
TypedStatementExpression type' (Assignment ref' expr')
else
error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type'
typeCheckStatementExpression (ConstructorCall className args) symtab classes =
case find (\(Class name _ _) -> name == className) classes of
Nothing -> error $ "Class '" ++ className ++ "' not found."