add differentiation between local and field variable
This commit is contained in:
Maybe Fabian Noll aber vielleicht auch nicht. Ist ein bisschen ne Glaubenssache :)
parent
7bfdeed620
commit
1d5463582f
@ -58,7 +58,7 @@ exampleConstructorCall :: Statement
|
||||
exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30]))))
|
||||
|
||||
exampleNameResolution :: Expression
|
||||
exampleNameResolution = BinaryOperation NameResolution (Reference "b") (Reference "age")
|
||||
exampleNameResolution = BinaryOperation NameResolution (Reference "bob2") (Reference "age")
|
||||
|
||||
exampleBlockResolution :: Statement
|
||||
exampleBlockResolution = Block [
|
||||
@ -113,10 +113,12 @@ testClasses = [
|
||||
(Block [
|
||||
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 25])))),
|
||||
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
|
||||
LocalVariableDeclaration (VariableDeclaration "int" "bobAge" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
|
||||
LocalVariableDeclaration (VariableDeclaration "int" "bobAge" (Just (StatementExpressionExpression (MethodCall (Reference "bob2") "getAge" [])))),
|
||||
Return (Just (Reference "bobAge"))
|
||||
])
|
||||
] []
|
||||
] [
|
||||
VariableDeclaration "Person" "bob2" Nothing
|
||||
]
|
||||
]
|
||||
|
||||
runTypeCheck :: IO ()
|
||||
@ -151,7 +153,7 @@ runTypeCheck = do
|
||||
|
||||
catch (do
|
||||
print "====================================================================================="
|
||||
evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("b", "Person")] sampleClasses)
|
||||
evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("this", "Main")] testClasses)
|
||||
printSuccess "Type checking of name resolution completed successfully"
|
||||
printResult "Result Name Resolution:" evaluatedNameResolution
|
||||
) handleError
|
||||
@ -189,7 +191,7 @@ runTypeCheck = do
|
||||
let mainClass = fromJust $ find (\(Class className _ _) -> className == "Main") testClasses
|
||||
case mainClass of
|
||||
Class _ [mainMethod] _ -> do
|
||||
let result = typeCheckMethodDeclaration mainMethod [] testClasses
|
||||
let result = typeCheckMethodDeclaration mainMethod [("this", "Main")] testClasses
|
||||
printSuccess "Full program type checking completed successfully."
|
||||
printResult "Main method result:" result
|
||||
) handleError
|
||||
|
||||
@ -10,9 +10,9 @@ typeCheckClass :: Class -> [Class] -> Class
|
||||
typeCheckClass (Class className methods fields) classes =
|
||||
let
|
||||
-- Create a symbol table from class fields and method entries
|
||||
classFields = [(id, dt) | VariableDeclaration dt id _ <- fields]
|
||||
-- TODO: Maybe remove method entries from the symbol table?
|
||||
methodEntries = [(methodName, className) | MethodDeclaration _ methodName _ _ <- methods]
|
||||
initalSymTab = ("this", className) : classFields ++ methodEntries
|
||||
initalSymTab = ("this", className) : methodEntries
|
||||
checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods
|
||||
in Class className checkedMethods fields
|
||||
|
||||
@ -37,8 +37,21 @@ typeCheckExpression (CharacterLiteral c) _ _ = TypedExpression "char" (Character
|
||||
typeCheckExpression (BooleanLiteral b) _ _ = TypedExpression "boolean" (BooleanLiteral b)
|
||||
typeCheckExpression NullLiteral _ _ = TypedExpression "null" NullLiteral
|
||||
typeCheckExpression (Reference id) symtab classes =
|
||||
let type' = lookupType id symtab
|
||||
in TypedExpression type' (Reference id)
|
||||
case lookup id symtab of
|
||||
Just t -> TypedExpression t (LocalVariable id)
|
||||
Nothing ->
|
||||
case lookup "this" symtab of
|
||||
Just className ->
|
||||
let classDetails = find (\(Class name _ _) -> name == className) classes
|
||||
in case classDetails of
|
||||
Just (Class _ _ fields) ->
|
||||
let fieldTypes = [dt | VariableDeclaration dt fieldId _ <- fields, fieldId == id]
|
||||
in case fieldTypes of
|
||||
[fieldType] -> TypedExpression fieldType (FieldVariable id)
|
||||
[] -> error $ "Field '" ++ id ++ "' not found in class '" ++ className ++ "'"
|
||||
_ -> error $ "Ambiguous reference to field '" ++ id ++ "' in class '" ++ className ++ "'"
|
||||
Nothing -> error $ "Class '" ++ className ++ "' not found for 'this'"
|
||||
Nothing -> error $ "Context for 'this' not found in symbol table, unable to resolve '" ++ id ++ "'"
|
||||
typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
|
||||
let expr1' = typeCheckExpression expr1 symtab classes
|
||||
expr2' = typeCheckExpression expr2 symtab classes
|
||||
@ -137,18 +150,25 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
|
||||
error "Logical OR operation requires two operands of type boolean"
|
||||
NameResolution ->
|
||||
case (expr1', expr2) of
|
||||
(TypedExpression t1 (Reference obj), Reference member) ->
|
||||
let objectType = lookupType obj symtab
|
||||
classDetails = find (\(Class className _ _) -> className == objectType) classes
|
||||
in case classDetails of
|
||||
Just (Class _ _ fields) ->
|
||||
let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == member]
|
||||
in case fieldTypes of
|
||||
[resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType expr2))
|
||||
[] -> error $ "Field '" ++ member ++ "' not found in class '" ++ objectType ++ "'"
|
||||
_ -> error $ "Ambiguous reference to field '" ++ member ++ "' in class '" ++ objectType ++ "'"
|
||||
Nothing -> error $ "Object '" ++ obj ++ "' does not correspond to a known class"
|
||||
_ -> error "Name resolution requires object reference and field name"
|
||||
(TypedExpression objType (LocalVariable ident), Reference ident2) ->
|
||||
case find (\(Class className _ _) -> className == objType) classes of
|
||||
Just (Class _ _ fields) ->
|
||||
let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2]
|
||||
in case fieldTypes of
|
||||
[resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2)))
|
||||
[] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'"
|
||||
_ -> error $ "Ambiguous reference to field '" ++ ident ++ "' in class '" ++ objType ++ "'"
|
||||
Nothing -> error $ "Class '" ++ objType ++ "' not found"
|
||||
(TypedExpression objType (FieldVariable ident), Reference ident2) ->
|
||||
case find (\(Class className _ _) -> className == objType) classes of
|
||||
Just (Class _ _ fields) ->
|
||||
let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2]
|
||||
in case fieldTypes of
|
||||
[resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2)))
|
||||
[] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'"
|
||||
_ -> error $ "Ambiguous reference to field '" ++ ident ++ "' in class '" ++ objType ++ "'"
|
||||
Nothing -> error $ "Class '" ++ objType ++ "' not found"
|
||||
_ -> error "Name resolution requires object reference and field name"
|
||||
|
||||
typeCheckExpression (UnaryOperation op expr) symtab classes =
|
||||
let expr' = typeCheckExpression expr symtab classes
|
||||
@ -177,12 +197,14 @@ typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)]
|
||||
typeCheckStatementExpression (Assignment id expr) symtab classes =
|
||||
let expr' = typeCheckExpression expr symtab classes
|
||||
type' = getTypeFromExpr expr'
|
||||
type'' = lookupType id symtab
|
||||
in if type' == type''
|
||||
then
|
||||
TypedStatementExpression type' (Assignment id expr')
|
||||
else
|
||||
error "Assignment type mismatch"
|
||||
maybeType'' = lookupType id symtab
|
||||
in case maybeType'' of
|
||||
Just type'' ->
|
||||
if type' == type'' then
|
||||
TypedStatementExpression type' (Assignment id expr')
|
||||
else
|
||||
error $ "Assignment type mismatch: expected " ++ type'' ++ ", found " ++ type'
|
||||
Nothing -> error $ "Identifier '" ++ id ++ "' not found in symbol table"
|
||||
|
||||
typeCheckStatementExpression (ConstructorCall className args) symtab classes =
|
||||
case find (\(Class name _ _) -> name == className) classes of
|
||||
@ -327,8 +349,8 @@ unifyReturnTypes dt1 dt2
|
||||
| dt1 == dt2 = dt1
|
||||
| otherwise = "Object"
|
||||
|
||||
lookupType :: Identifier -> [(Identifier, DataType)] -> DataType
|
||||
lookupType :: Identifier -> [(Identifier, DataType)] -> Maybe DataType
|
||||
lookupType id symtab =
|
||||
case lookup id symtab of
|
||||
Just t -> t
|
||||
Nothing -> error ("Identifier " ++ id ++ " not found in symbol table")
|
||||
Just t -> Just t
|
||||
Nothing -> Nothing
|
||||
|
||||
Loading…
Reference in New Issue
Block a user