bytecode #9
13
Test/JavaSources/TestConstructorOverload.java
Normal file
13
Test/JavaSources/TestConstructorOverload.java
Normal file
@ -0,0 +1,13 @@
|
|||||||
|
public class TestConstructorOverload {
|
||||||
|
|
||||||
|
TestConstructorOverload() {
|
||||||
|
}
|
||||||
|
|
||||||
|
TestConstructorOverload(int a) {
|
||||||
|
}
|
||||||
|
|
||||||
|
public void test() {
|
||||||
|
int a = 3;
|
||||||
|
TestConstructorOverload test = new TestConstructorOverload(a);
|
||||||
|
}
|
||||||
|
}
|
15
Test/JavaSources/TestSingleton.java
Normal file
15
Test/JavaSources/TestSingleton.java
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
public class TestSingleton {
|
||||||
|
|
||||||
|
TestSingleton instance;
|
||||||
|
|
||||||
|
TestSingleton() {
|
||||||
|
}
|
||||||
|
|
||||||
|
public TestSingleton getInstance() {
|
||||||
|
if (instance == null) {
|
||||||
|
instance = new TestSingleton();
|
||||||
|
}
|
||||||
|
return instance;
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
@ -3,18 +3,35 @@ import Data.List (find)
|
|||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Ast
|
import Ast
|
||||||
|
|
||||||
|
|
||||||
typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
|
typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
|
||||||
typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
|
typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
|
||||||
|
|
||||||
typeCheckClass :: Class -> [Class] -> Class
|
typeCheckClass :: Class -> [Class] -> Class
|
||||||
typeCheckClass (Class className methods fields) classes =
|
typeCheckClass (Class className constructors methods fields) classes =
|
||||||
let
|
let
|
||||||
-- Fields and methods dont need to be added to the symtab because they are looked upon automatically under "this"
|
-- Fields and methods dont need to be added to the symtab because they are looked upon automatically under "this"
|
||||||
-- if its not a declared local variable. Also shadowing wouldnt be possible then.
|
-- if its not a declared local variable. Also shadowing wouldnt be possible then.
|
||||||
initalSymTab = [("this", className)]
|
initalSymTab = [("this", className)]
|
||||||
|
checkedConstructors = map (\constructor -> typeCheckConstructorDeclaration constructor initalSymTab classes) constructors
|
||||||
checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods
|
checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods
|
||||||
checkedFields = map (\field -> typeCheckVariableDeclaration field initalSymTab classes) fields
|
checkedFields = map (\field -> typeCheckVariableDeclaration field initalSymTab classes) fields
|
||||||
in Class className checkedMethods checkedFields
|
in Class className checkedConstructors checkedMethods checkedFields
|
||||||
|
|
||||||
|
typeCheckConstructorDeclaration :: ConstructorDeclaration -> [(Identifier, DataType)] -> [Class] -> ConstructorDeclaration
|
||||||
|
typeCheckConstructorDeclaration (ConstructorDeclaration name params body) symtab classes =
|
||||||
|
let
|
||||||
|
constructorParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params]
|
||||||
|
initialSymtab = symtab ++ constructorParams
|
||||||
|
className = fromMaybe (error "Constructor Declaration: 'this' not found in symtab") (lookup "this" symtab)
|
||||||
|
checkedBody = typeCheckStatement body initialSymtab classes
|
||||||
|
bodyType = getTypeFromStmt checkedBody
|
||||||
|
in if name == className
|
||||||
|
then if bodyType == "void"
|
||||||
|
then ConstructorDeclaration name params checkedBody
|
||||||
|
else error $ "Constructor Declaration: Return type mismatch in constructor " ++ name ++ ": expected void, found " ++ bodyType
|
||||||
|
else error $ "Constructor Declaration: Constructor name " ++ name ++ " does not match class name " ++ className
|
||||||
|
|
||||||
|
|
||||||
typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration
|
typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration
|
||||||
typeCheckMethodDeclaration (MethodDeclaration retType name params body) symtab classes =
|
typeCheckMethodDeclaration (MethodDeclaration retType name params body) symtab classes =
|
||||||
@ -63,9 +80,9 @@ typeCheckExpression (Reference id) symtab classes =
|
|||||||
Nothing ->
|
Nothing ->
|
||||||
case lookup "this" symtab of
|
case lookup "this" symtab of
|
||||||
Just className ->
|
Just className ->
|
||||||
let classDetails = find (\(Class name _ _) -> name == className) classes
|
let classDetails = find (\(Class name _ _ _) -> name == className) classes
|
||||||
in case classDetails of
|
in case classDetails of
|
||||||
Just (Class _ _ fields) ->
|
Just (Class _ _ _ fields) ->
|
||||||
let fieldTypes = [dt | VariableDeclaration dt fieldId _ <- fields, fieldId == id]
|
let fieldTypes = [dt | VariableDeclaration dt fieldId _ <- fields, fieldId == id]
|
||||||
-- this case only happens when its a field of its own class so the implicit this will be converted to explicit this
|
-- this case only happens when its a field of its own class so the implicit this will be converted to explicit this
|
||||||
in case fieldTypes of
|
in case fieldTypes of
|
||||||
@ -139,40 +156,36 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes =
|
|||||||
|
|
||||||
|
|
||||||
typeCheckStatementExpression (ConstructorCall className args) symtab classes =
|
typeCheckStatementExpression (ConstructorCall className args) symtab classes =
|
||||||
case find (\(Class name _ _) -> name == className) classes of
|
case find (\(Class name _ _ _) -> name == className) classes of
|
||||||
Nothing -> error $ "Class '" ++ className ++ "' not found."
|
Nothing -> error $ "Class '" ++ className ++ "' not found."
|
||||||
Just (Class _ methods _) ->
|
Just (Class _ constructors _ _) ->
|
||||||
-- Find constructor matching the class name with void return type
|
let
|
||||||
case find (\(MethodDeclaration _ name params _) -> name == "<init>") methods of
|
matchParams (ParameterDeclaration paramType _) arg =
|
||||||
-- If no constructor is found, assume standard constructor with no parameters
|
|
||||||
Nothing ->
|
|
||||||
if null args then
|
|
||||||
TypedStatementExpression className (ConstructorCall className args)
|
|
||||||
else
|
|
||||||
error $ "No valid constructor found for class '" ++ className ++ "', but arguments were provided."
|
|
||||||
Just (MethodDeclaration _ _ 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))
|
matchConstructor (ConstructorDeclaration name params _) =
|
||||||
expectedTypes argTypes
|
let matchedArgs = sequence $ zipWith matchParams params args
|
||||||
mismatches = filter (not . fst3) typeMatches
|
in fmap (\checkedArgs -> (params, checkedArgs)) matchedArgs
|
||||||
fst3 (a, _, _) = a
|
|
||||||
in
|
validConstructors = filter (\(params, _) -> length params == length args) $ mapMaybe matchConstructor constructors
|
||||||
if null mismatches && length args == length params then
|
|
||||||
TypedStatementExpression className (ConstructorCall className args')
|
expectedSignatures = [ map (\(ParameterDeclaration t _) -> t) params | ConstructorDeclaration _ params _ <- constructors ]
|
||||||
else if not (null mismatches) then
|
actualSignature = map (\arg -> getTypeFromExpr (typeCheckExpression arg symtab classes)) args
|
||||||
error $ unlines $ ("Type mismatch in constructor arguments for class '" ++ className ++ "':")
|
mismatchDetails = "Constructor not found for class '" ++ className ++ "' with given arguments.\n" ++
|
||||||
: [ "Expected: " ++ expType ++ ", Found: " ++ argType | (_, expType, argType) <- mismatches ]
|
"Expected signatures:\n" ++ show expectedSignatures ++
|
||||||
else
|
"\nActual arguments:" ++ show actualSignature
|
||||||
error $ "Incorrect number of arguments for constructor of class '" ++ className ++ "'. Expected " ++ show (length expectedTypes) ++ ", found " ++ show (length args) ++ "."
|
|
||||||
|
in case validConstructors of
|
||||||
|
[(_, checkedArgs)] ->
|
||||||
|
TypedStatementExpression className (ConstructorCall className checkedArgs)
|
||||||
|
[] -> error mismatchDetails
|
||||||
|
_ -> error $ "Multiple matching constructors found for class '" ++ className ++ "' with given arguments."
|
||||||
|
|
||||||
typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
|
typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
|
||||||
let objExprTyped = typeCheckExpression expr symtab classes
|
let objExprTyped = typeCheckExpression expr symtab classes
|
||||||
@ -359,7 +372,7 @@ isSubtype subType superType classes
|
|||||||
| otherwise = False
|
| otherwise = False
|
||||||
|
|
||||||
isUserDefinedClass :: DataType -> [Class] -> Bool
|
isUserDefinedClass :: DataType -> [Class] -> Bool
|
||||||
isUserDefinedClass dt classes = dt `elem` map (\(Class name _ _) -> name) classes
|
isUserDefinedClass dt classes = dt `elem` map (\(Class name _ _ _) -> name) classes
|
||||||
|
|
||||||
isObjectType :: DataType -> Bool
|
isObjectType :: DataType -> Bool
|
||||||
isObjectType dt = dt /= "int" && dt /= "boolean" && dt /= "char"
|
isObjectType dt = dt /= "int" && dt /= "boolean" && dt /= "char"
|
||||||
@ -431,8 +444,8 @@ resolveNameResolution :: Expression -> Expression -> [(Identifier, DataType)] ->
|
|||||||
resolveNameResolution expr1' (Reference ident2) symtab classes =
|
resolveNameResolution expr1' (Reference ident2) symtab classes =
|
||||||
case getTypeFromExpr expr1' of
|
case getTypeFromExpr expr1' of
|
||||||
objType ->
|
objType ->
|
||||||
case find (\(Class className _ _) -> className == objType) classes of
|
case find (\(Class className _ _ _) -> className == objType) classes of
|
||||||
Just (Class _ _ fields) ->
|
Just (Class _ _ _ fields) ->
|
||||||
let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2]
|
let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2]
|
||||||
in case fieldTypes of
|
in case fieldTypes of
|
||||||
[resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2)))
|
[resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2)))
|
||||||
|
Loading…
Reference in New Issue
Block a user