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