add method overloading

This commit is contained in:
2 changed files with 42 additions and 24 deletions

View File

@ -0,0 +1,14 @@
public class TestMethodOverload {
public void MethodOverload() {
}
public void MethodOverload(int a) {
}
public void test() {
int a = 3;
MethodOverload(a);
}
}

View File

@ -178,31 +178,35 @@ typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
let objExprTyped = typeCheckExpression expr symtab classes let objExprTyped = typeCheckExpression expr symtab classes
in case objExprTyped of in case objExprTyped of
TypedExpression objType _ -> TypedExpression objType _ ->
case find (\(Class className _ _) -> className == objType) classes of case find (\(Class className _ _ _) -> className == objType) classes of
Just (Class _ methods _) -> Just (Class _ _ methods _) ->
case find (\(MethodDeclaration retType name params _) -> name == methodName) methods of let matchParams (ParameterDeclaration paramType _) arg =
Just (MethodDeclaration retType _ params _) ->
let args' = zipWith
(\arg (ParameterDeclaration paramType _) ->
let argTyped = typeCheckExpression arg symtab classes let argTyped = typeCheckExpression arg symtab classes
in if getTypeFromExpr argTyped == "null" && isObjectType paramType argType = getTypeFromExpr argTyped
then TypedExpression paramType NullLiteral in if argType == "null" && isObjectType paramType
else argTyped then Just (TypedExpression paramType NullLiteral)
) args params else if argType == paramType
expectedTypes = [dataType | ParameterDeclaration dataType _ <- params] then Just argTyped
argTypes = map getTypeFromExpr args' else Nothing
typeMatches = zipWith
(\expType argType -> (expType == argType || (argType == "null" && isObjectType expType), expType, argType)) matchMethod (MethodDeclaration retType name params _) =
expectedTypes argTypes let matchedArgs = sequence $ zipWith matchParams params args
mismatches = filter (not . fst3) typeMatches in fmap (\checkedArgs -> (MethodDeclaration retType name params (Block []), checkedArgs)) matchedArgs
fst3 (a, _, _) = a
in if null mismatches && length args == length params validMethods = filter (\(MethodDeclaration _ name params _, _) -> name == methodName && length params == length args) $ mapMaybe matchMethod methods
then TypedStatementExpression retType (MethodCall objExprTyped methodName args')
else if not (null mismatches) expectedSignatures = [ map (\(ParameterDeclaration t _) -> t) params | MethodDeclaration _ name params _ <- methods, name == methodName ]
then error $ unlines $ ("Argument type mismatches for method '" ++ methodName ++ "':") actualSignature = map (\arg -> getTypeFromExpr (typeCheckExpression arg symtab classes)) args
: [ "Expected: " ++ expType ++ ", Found: " ++ argType | (_, expType, argType) <- mismatches ] mismatchDetails = "Method not found for class '" ++ objType ++ "' with given arguments.\n" ++
else error $ "Incorrect number of arguments for method '" ++ methodName ++ "'. Expected " ++ show (length expectedTypes) ++ ", found " ++ show (length args) ++ "." "Expected signatures for method '" ++ methodName ++ "':\n" ++ unlines (map show expectedSignatures) ++
Nothing -> error $ "Method '" ++ methodName ++ "' not found in class '" ++ objType ++ "'." "Actual arguments:\n" ++ show actualSignature
in case validMethods of
[(MethodDeclaration retType _ params _, checkedArgs)] ->
TypedStatementExpression retType (MethodCall objExprTyped methodName checkedArgs)
[] -> error mismatchDetails
_ -> error $ "Multiple matching methods found for class '" ++ objType ++ "' and method '" ++ methodName ++ "' with given arguments."
Nothing -> error $ "Class for object type '" ++ objType ++ "' not found." Nothing -> error $ "Class for object type '" ++ objType ++ "' not found."
_ -> error "Invalid object type for method call. Object must have a class type." _ -> error "Invalid object type for method call. Object must have a class type."