diff --git a/Test/TestParser.hs b/Test/TestParser.hs index b7cd93e..873f438 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -144,6 +144,21 @@ testExpressionPreIncrement = TestCase $ testExpressionPreDecrement = TestCase $ assertEqual "expect PreIncrement" (UnaryOperation PreDecrement (Reference "a")) $ parseExpression [DECREMENT,IDENTIFIER "a"] +testExpressionAssign = TestCase $ + assertEqual "expect assign 5 to a" (StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 5))) $ + parseExpression [IDENTIFIER "a",ASSIGN,INTEGERLITERAL 5] +testExpressionTimesEqual = TestCase $ + assertEqual "expect assign and multiplication" (StatementExpressionExpression (Assignment (Reference "a") (BinaryOperation Multiplication (Reference "a") (IntegerLiteral 5)))) $ + parseExpression [IDENTIFIER "a",TIMESEQUAL,INTEGERLITERAL 5] +testExpressionDivideEqual = TestCase $ + assertEqual "expect assign and division" (StatementExpressionExpression (Assignment (Reference "a") (BinaryOperation Division (Reference "a") (IntegerLiteral 5)))) $ + parseExpression [IDENTIFIER "a",DIVEQUAL,INTEGERLITERAL 5] +testExpressionPlusEqual = TestCase $ + assertEqual "expect assign and addition" (StatementExpressionExpression (Assignment (Reference "a") (BinaryOperation Addition (Reference "a") (IntegerLiteral 5)))) $ + parseExpression [IDENTIFIER "a",PLUSEQUAL,INTEGERLITERAL 5] +testExpressionMinusEqual = TestCase $ + assertEqual "expect assign and subtraction" (StatementExpressionExpression (Assignment (Reference "a") (BinaryOperation Subtraction (Reference "a") (IntegerLiteral 5)))) $ + parseExpression [IDENTIFIER "a",MINUSEQUAL,INTEGERLITERAL 5] testStatementIfThen = TestCase $ assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $ @@ -151,6 +166,10 @@ testStatementIfThen = TestCase $ testStatementIfThenElse = TestCase $ assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) (Just (Block [Block []]))] $ parseStatement [IF,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET,ELSE,LBRACKET,RBRACKET] +testStatementWhile = TestCase $ + assertEqual "expect while" [While (Reference "a") (Block [Block []])] $ + parseStatement [WHILE,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET] + tests = TestList [ @@ -193,6 +212,13 @@ tests = TestList [ testExpressionPostDecrement, testExpressionPreIncrement, testExpressionPreDecrement, + testExpressionAssign, + testExpressionTimesEqual, + testExpressionTimesEqual, + testExpressionDivideEqual, + testExpressionPlusEqual, + testExpressionMinusEqual, testStatementIfThen, - testStatementIfThenElse + testStatementIfThenElse, + testStatementWhile ] \ No newline at end of file diff --git a/src/Ast.hs b/src/Ast.hs index 9634ab8..a20b8e8 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -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 diff --git a/src/Example.hs b/src/Example.hs index db4213f..03ff209 100644 --- a/src/Example.hs +++ b/src/Example.hs @@ -101,24 +101,36 @@ 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" [ - MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] + MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] (Block [ Return (Just (Reference "this")) ]), - MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"] + MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"] (Block [ LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge"))) ]), - MethodDeclaration "int" "getAge" [] + MethodDeclaration "int" "getAge" [] (Return (Just (Reference "age"))) ] [ VariableDeclaration "int" "age" Nothing -- initially unassigned ], Class "Main" [ - MethodDeclaration "int" "main" [] + MethodDeclaration "int" "main" [] (Block [ LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 25])))), StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]), @@ -211,7 +223,7 @@ runTypeCheck = do printSuccess "Type checking of Program completed successfully" printResult "Typed Program:" typedProgram ) handleError - + catch (do print "=====================================================================================" typedAssignment <- evaluate (typeCheckStatement exampleNameResolutionAssignment [] sampleClasses) @@ -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 diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 2e80289..4e66850 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -82,7 +82,7 @@ compilationunit : typedeclarations { $1 } typedeclarations : typedeclaration { [$1] } | typedeclarations typedeclaration { $1 ++ [$2] } -name : simplename { $1 } +name : simplename { Reference $1 } -- | qualifiedname { } typedeclaration : classdeclaration { $1 } @@ -122,7 +122,7 @@ classtype : classorinterfacetype{ } classbodydeclaration : classmemberdeclaration { $1 } | constructordeclaration { $1 } -classorinterfacetype : name { $1 } +classorinterfacetype : simplename { $1 } classmemberdeclaration : fielddeclaration { $1 } | methoddeclaration { $1 } @@ -203,7 +203,7 @@ localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { $1 } statement : statementwithouttrailingsubstatement{ $1 } -- statement returns a list of statements | ifthenstatement { [$1] } | ifthenelsestatement { [$1] } - -- | whilestatement { } + | whilestatement { [$1] } expression : assignmentexpression { $1 } @@ -222,10 +222,10 @@ ifthenstatement : IF LBRACE expression RBRACE statement { If $3 (Block $5) No ifthenelsestatement : IF LBRACE expression RBRACE statementnoshortif ELSE statement { If $3 (Block $5) (Just (Block $7)) } -whilestatement : WHILE LBRACE expression RBRACE statement { } +whilestatement : WHILE LBRACE expression RBRACE statement { While $3 (Block $5) } assignmentexpression : conditionalexpression { $1 } - -- | assignment { } + | assignment { StatementExpressionExpression $1 } emptystatement : SEMICOLON { Block [] } @@ -241,7 +241,11 @@ statementnoshortif : statementwithouttrailingsubstatement { $1 } conditionalexpression : conditionalorexpression { $1 } -- | conditionalorexpression QUESMARK expression COLON conditionalexpression { } -assignment : lefthandside assignmentoperator assignmentexpression { } +assignment : lefthandside assignmentoperator assignmentexpression { + case $2 of + Nothing -> Assignment $1 $3 + Just operator -> Assignment $1 (BinaryOperation operator $1 $3) + } statementexpression : assignment { } @@ -262,18 +266,18 @@ conditionalorexpression : conditionalandexpression { $1 } lefthandside : name { $1 } -assignmentoperator : ASSIGN{ } - -- | TIMESEQUAL { } - -- | DIVIDEEQUAL { } - -- | MODULOEQUAL { } - -- | PLUSEQUAL { } - -- | MINUSEQUAL { } +assignmentoperator : ASSIGN { Nothing } + | TIMESEQUAL { Just Multiplication } + | DIVIDEEQUAL { Just Division } + | MODULOEQUAL { Just Modulo } + | PLUSEQUAL { Just Addition } + | MINUSEQUAL { Just Subtraction } -- | SHIFTLEFTEQUAL { } -- | SIGNEDSHIFTRIGHTEQUAL { } -- | UNSIGNEDSHIFTRIGHTEQUAL { } - -- | ANDEQUAL { } - -- | XOREQUAL { } - -- | OREQUAL{ } + | ANDEQUAL { Just BitwiseAnd } + | XOREQUAL { Just BitwiseXor } + | OREQUAL{ Just BitwiseOr } preincrementexpression : INCREMENT unaryexpression { UnaryOperation PreIncrement $2 } @@ -302,7 +306,7 @@ unaryexpression : unaryexpressionnotplusminus { $1 } | preincrementexpression { $1 } postfixexpression : primary { $1 } - | name { Reference $1 } + | name { $1 } | postincrementexpression { $1 } | postdecrementexpression{ $1 } diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 0032d46..ba49157 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -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 @@ -146,11 +107,11 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes = ref' = typeCheckExpression ref symtab classes type' = getTypeFromExpr expr' 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' + in + 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' typeCheckStatementExpression (ConstructorCall className args) symtab classes = case find (\(Class name _ _) -> name == className) classes of @@ -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"