Compare commits
9 Commits
1e59ba9e27
...
d4f474ba54
Author | SHA1 | Date | |
---|---|---|---|
d4f474ba54 | |||
0694dfb77d | |||
6ab64371b5 | |||
067bf8d796 | |||
e95377ee72 | |||
2a502a6c67 | |||
07837f7d5f | |||
a80dc1d34b | |||
a7b4c7e58e |
@ -139,16 +139,16 @@ testExpressionOr = TestCase $
|
||||
assertEqual "expect or expression" (BinaryOperation Or (Reference "bar") (Reference "baz")) $
|
||||
parseExpression [IDENTIFIER "bar",OR,IDENTIFIER "baz"]
|
||||
testExpressionPostIncrement = TestCase $
|
||||
assertEqual "expect PostIncrement" (UnaryOperation PostIncrement (Reference "a")) $
|
||||
assertEqual "expect PostIncrement" (StatementExpressionExpression $ PostIncrement (Reference "a")) $
|
||||
parseExpression [IDENTIFIER "a",INCREMENT]
|
||||
testExpressionPostDecrement = TestCase $
|
||||
assertEqual "expect PostDecrement" (UnaryOperation PostDecrement (Reference "a")) $
|
||||
assertEqual "expect PostDecrement" (StatementExpressionExpression $ PostDecrement (Reference "a")) $
|
||||
parseExpression [IDENTIFIER "a",DECREMENT]
|
||||
testExpressionPreIncrement = TestCase $
|
||||
assertEqual "expect PreIncrement" (UnaryOperation PreIncrement (Reference "a")) $
|
||||
assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreIncrement (Reference "a")) $
|
||||
parseExpression [INCREMENT,IDENTIFIER "a"]
|
||||
testExpressionPreDecrement = TestCase $
|
||||
assertEqual "expect PreIncrement" (UnaryOperation PreDecrement (Reference "a")) $
|
||||
assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreDecrement (Reference "a")) $
|
||||
parseExpression [DECREMENT,IDENTIFIER "a"]
|
||||
testExpressionAssign = TestCase $
|
||||
assertEqual "expect assign 5 to a" (StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 5))) $
|
||||
|
@ -24,6 +24,10 @@ data StatementExpression
|
||||
| ConstructorCall DataType [Expression]
|
||||
| MethodCall Expression Identifier [Expression]
|
||||
| TypedStatementExpression DataType StatementExpression
|
||||
| PostIncrement Expression
|
||||
| PostDecrement Expression
|
||||
| PreIncrement Expression
|
||||
| PreDecrement Expression
|
||||
deriving (Show, Eq)
|
||||
|
||||
data BinaryOperator
|
||||
@ -49,10 +53,6 @@ data BinaryOperator
|
||||
data UnaryOperator
|
||||
= Not
|
||||
| Minus
|
||||
| PostIncrement
|
||||
| PostDecrement
|
||||
| PreIncrement
|
||||
| PreDecrement
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Expression
|
||||
|
@ -101,6 +101,18 @@ exampleNameResolutionAssignment = Block [
|
||||
exampleCharIntOperation :: Expression
|
||||
exampleCharIntOperation = BinaryOperation Addition (CharacterLiteral 'a') (IntegerLiteral 1)
|
||||
|
||||
exampleNullDeclaration :: Statement
|
||||
exampleNullDeclaration = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just NullLiteral))
|
||||
|
||||
exampleNullDeclarationFail :: Statement
|
||||
exampleNullDeclarationFail = LocalVariableDeclaration (VariableDeclaration "int" "a" (Just NullLiteral))
|
||||
|
||||
exampleNullAssignment :: Statement
|
||||
exampleNullAssignment = StatementExpressionStatement (Assignment (Reference "a") NullLiteral)
|
||||
|
||||
exampleIncrement :: Statement
|
||||
exampleIncrement = StatementExpressionStatement (PostIncrement (Reference "a"))
|
||||
|
||||
testClasses :: [Class]
|
||||
testClasses = [
|
||||
Class "Person" [
|
||||
@ -226,3 +238,30 @@ runTypeCheck = do
|
||||
printResult "Result Char Int Operation:" evaluatedCharIntOperation
|
||||
) handleError
|
||||
|
||||
catch (do
|
||||
print "====================================================================================="
|
||||
evaluatedNullDeclaration <- evaluate (typeCheckStatement exampleNullDeclaration [] sampleClasses)
|
||||
printSuccess "Type checking of null declaration completed successfully"
|
||||
printResult "Result Null Declaration:" evaluatedNullDeclaration
|
||||
) handleError
|
||||
|
||||
catch (do
|
||||
print "====================================================================================="
|
||||
evaluatedNullDeclarationFail <- evaluate (typeCheckStatement exampleNullDeclarationFail [] sampleClasses)
|
||||
printSuccess "Type checking of null declaration failed"
|
||||
printResult "Result Null Declaration:" evaluatedNullDeclarationFail
|
||||
) handleError
|
||||
|
||||
catch (do
|
||||
print "====================================================================================="
|
||||
evaluatedNullAssignment <- evaluate (typeCheckStatement exampleNullAssignment [("a", "Person")] sampleClasses)
|
||||
printSuccess "Type checking of null assignment completed successfully"
|
||||
printResult "Result Null Assignment:" evaluatedNullAssignment
|
||||
) handleError
|
||||
|
||||
catch (do
|
||||
print "====================================================================================="
|
||||
evaluatedIncrement <- evaluate (typeCheckStatement exampleIncrement [("a", "int")] sampleClasses)
|
||||
printSuccess "Type checking of increment completed successfully"
|
||||
printResult "Result Increment:" evaluatedIncrement
|
||||
) handleError
|
||||
|
@ -279,13 +279,13 @@ assignmentoperator : ASSIGN { Nothing }
|
||||
| XOREQUAL { Just BitwiseXor }
|
||||
| OREQUAL{ Just BitwiseOr }
|
||||
|
||||
preincrementexpression : INCREMENT unaryexpression { UnaryOperation PreIncrement $2 }
|
||||
preincrementexpression : INCREMENT unaryexpression { PreIncrement $2 }
|
||||
|
||||
predecrementexpression : DECREMENT unaryexpression { UnaryOperation PreDecrement $2 }
|
||||
predecrementexpression : DECREMENT unaryexpression { PreDecrement $2 }
|
||||
|
||||
postincrementexpression : postfixexpression INCREMENT { UnaryOperation PostIncrement $1 }
|
||||
postincrementexpression : postfixexpression INCREMENT { PostIncrement $1 }
|
||||
|
||||
postdecrementexpression : postfixexpression DECREMENT { UnaryOperation PostDecrement $1 }
|
||||
postdecrementexpression : postfixexpression DECREMENT { PostDecrement $1 }
|
||||
|
||||
methodinvocation : simplename LBRACE RBRACE { MethodCall (Reference "this") $1 [] }
|
||||
| simplename LBRACE argumentlist RBRACE { MethodCall (Reference "this") $1 $3 }
|
||||
@ -300,15 +300,15 @@ conditionalandexpression : inclusiveorexpression { $1 }
|
||||
fieldaccess : primary DOT IDENTIFIER { }
|
||||
|
||||
unaryexpression : unaryexpressionnotplusminus { $1 }
|
||||
| predecrementexpression { $1 }
|
||||
| predecrementexpression { StatementExpressionExpression $1 }
|
||||
| PLUS unaryexpression { $2 }
|
||||
| MINUS unaryexpression { UnaryOperation Minus $2 }
|
||||
| preincrementexpression { $1 }
|
||||
| preincrementexpression { StatementExpressionExpression $1 }
|
||||
|
||||
postfixexpression : primary { $1 }
|
||||
| name { $1 }
|
||||
| postincrementexpression { $1 }
|
||||
| postdecrementexpression{ $1 }
|
||||
| postincrementexpression { StatementExpressionExpression $1 }
|
||||
| postdecrementexpression { StatementExpressionExpression $1 }
|
||||
|
||||
primary : primarynonewarray { $1 }
|
||||
|
||||
|
@ -25,7 +25,7 @@ typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFie
|
||||
checkedBody = typeCheckStatement body initialSymtab classes
|
||||
bodyType = getTypeFromStmt checkedBody
|
||||
-- Check if the type of the body matches the declared return type
|
||||
in if bodyType == retType || (bodyType == "void" && retType == "void")
|
||||
in if bodyType == retType || (bodyType == "void" && retType == "void") || (bodyType == "null" && isObjectType retType)
|
||||
then MethodDeclaration retType name params checkedBody
|
||||
else error $ "Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType
|
||||
|
||||
@ -89,50 +89,11 @@ typeCheckExpression (UnaryOperation op expr) symtab classes =
|
||||
else
|
||||
error "Logical NOT operation requires an operand of type boolean"
|
||||
Minus ->
|
||||
if type' == "int"
|
||||
if type' == "int" || type' == "char"
|
||||
then
|
||||
TypedExpression "int" (UnaryOperation op expr')
|
||||
else if type' == "char"
|
||||
then
|
||||
TypedExpression "char" (UnaryOperation op expr')
|
||||
TypedExpression type' (UnaryOperation op expr')
|
||||
else
|
||||
error "Unary minus operation requires an operand of type int or char"
|
||||
PostIncrement ->
|
||||
if type' == "int"
|
||||
then
|
||||
TypedExpression "int" (UnaryOperation op expr')
|
||||
else if type' == "char"
|
||||
then
|
||||
TypedExpression "char" (UnaryOperation op expr')
|
||||
else
|
||||
error "Post-increment operation requires an operand of type int or char"
|
||||
PostDecrement ->
|
||||
if type' == "int"
|
||||
then
|
||||
TypedExpression "int" (UnaryOperation op expr')
|
||||
else if type' == "char"
|
||||
then
|
||||
TypedExpression "char" (UnaryOperation op expr')
|
||||
else
|
||||
error "Post-decrement operation requires an operand of type int or char"
|
||||
PreIncrement ->
|
||||
if type' == "int"
|
||||
then
|
||||
TypedExpression "int" (UnaryOperation op expr')
|
||||
else if type' == "char"
|
||||
then
|
||||
TypedExpression "char" (UnaryOperation op expr')
|
||||
else
|
||||
error "Pre-increment operation requires an operand of type int or char"
|
||||
PreDecrement ->
|
||||
if type' == "int"
|
||||
then
|
||||
TypedExpression "int" (UnaryOperation op expr')
|
||||
else if type' == "char"
|
||||
then
|
||||
TypedExpression "char" (UnaryOperation op expr')
|
||||
else
|
||||
error "Pre-decrement operation requires an operand of type int or char"
|
||||
|
||||
typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
|
||||
let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
|
||||
@ -147,8 +108,8 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes =
|
||||
type' = getTypeFromExpr expr'
|
||||
type'' = getTypeFromExpr ref'
|
||||
in
|
||||
if type'' == type' then
|
||||
TypedStatementExpression type' (Assignment ref' expr')
|
||||
if type'' == type' || (type' == "null" && isObjectType type'') then
|
||||
TypedStatementExpression type'' (Assignment ref' expr')
|
||||
else
|
||||
error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type'
|
||||
|
||||
@ -202,6 +163,42 @@ typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
|
||||
Nothing -> error $ "Class for object type '" ++ objType ++ "' not found."
|
||||
_ -> error "Invalid object type for method call. Object must have a class type."
|
||||
|
||||
typeCheckStatementExpression (PostIncrement expr) symtab classes =
|
||||
let expr' = typeCheckExpression expr symtab classes
|
||||
type' = getTypeFromExpr expr'
|
||||
in if type' == "int" || type' == "char"
|
||||
then
|
||||
TypedStatementExpression type' (PostIncrement expr')
|
||||
else
|
||||
error "Post-increment operation requires an operand of type int or char"
|
||||
|
||||
typeCheckStatementExpression (PostDecrement expr) symtab classes =
|
||||
let expr' = typeCheckExpression expr symtab classes
|
||||
type' = getTypeFromExpr expr'
|
||||
in if type' == "int" || type' == "char"
|
||||
then
|
||||
TypedStatementExpression type' (PostDecrement expr')
|
||||
else
|
||||
error "Post-decrement operation requires an operand of type int or char"
|
||||
|
||||
typeCheckStatementExpression (PreIncrement expr) symtab classes =
|
||||
let expr' = typeCheckExpression expr symtab classes
|
||||
type' = getTypeFromExpr expr'
|
||||
in if type' == "int" || type' == "char"
|
||||
then
|
||||
TypedStatementExpression type' (PreIncrement expr')
|
||||
else
|
||||
error "Pre-increment operation requires an operand of type int or char"
|
||||
|
||||
typeCheckStatementExpression (PreDecrement expr) symtab classes =
|
||||
let expr' = typeCheckExpression expr symtab classes
|
||||
type' = getTypeFromExpr expr'
|
||||
in if type' == "int" || type' == "char"
|
||||
then
|
||||
TypedStatementExpression type' (PreDecrement expr')
|
||||
else
|
||||
error "Pre-decrement operation requires an operand of type int or char"
|
||||
|
||||
-- ********************************** Type Checking: Statements **********************************
|
||||
|
||||
typeCheckStatement :: Statement -> [(Identifier, DataType)] -> [Class] -> Statement
|
||||
@ -226,8 +223,12 @@ typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType ident
|
||||
let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr
|
||||
exprType = fmap getTypeFromExpr checkedExpr
|
||||
in case exprType of
|
||||
Just t | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
|
||||
_ -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
|
||||
Just t
|
||||
| t == "null" && isObjectType dataType ->
|
||||
TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
|
||||
| t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
|
||||
| otherwise -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
|
||||
Nothing -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
|
||||
|
||||
typeCheckStatement (While cond stmt) symtab classes =
|
||||
let cond' = typeCheckExpression cond symtab classes
|
||||
@ -254,6 +255,7 @@ typeCheckStatement (Block statements) symtab classes =
|
||||
If {} -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||
While _ _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||
Return _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||
Block _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||
_ -> (accSts ++ [checkedStmt], currentSymtab, types)
|
||||
|
||||
-- Initial accumulator: empty statements list, initial symbol table, empty types list
|
||||
@ -278,6 +280,9 @@ typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes =
|
||||
|
||||
-- ********************************** Type Checking: Helpers **********************************
|
||||
|
||||
isObjectType :: DataType -> Bool
|
||||
isObjectType dt = dt /= "int" && dt /= "boolean" && dt /= "char"
|
||||
|
||||
getTypeFromExpr :: Expression -> DataType
|
||||
getTypeFromExpr (TypedExpression t _) = t
|
||||
getTypeFromExpr _ = error "Untyped expression found where typed was expected"
|
||||
|
Loading…
Reference in New Issue
Block a user