Merge branch 'typedAST' of ssh://gitea.hb.dhbw-stuttgart.de:2222/MisterChaos69/MiniJavaCompiler into bytecode

This commit is contained in:
mrab 2024-06-12 16:55:31 +02:00
commit 7317895800
4 changed files with 72 additions and 35 deletions

View File

@ -200,6 +200,9 @@ testExpressionSimpleFieldAccess = TestCase $
testExpressionFieldSubAccess = TestCase $ testExpressionFieldSubAccess = TestCase $
assertEqual "expect NameResolution without this" (BinaryOperation NameResolution (Reference "a") (Reference "b")) $ assertEqual "expect NameResolution without this" (BinaryOperation NameResolution (Reference "a") (Reference "b")) $
parseExpression [IDENTIFIER "a",DOT,IDENTIFIER "b"] parseExpression [IDENTIFIER "a",DOT,IDENTIFIER "b"]
testExpressionConstructorCall = TestCase $
assertEqual "expect constructor call" (StatementExpressionExpression (ConstructorCall "Foo" [])) $
parseExpression [NEW,IDENTIFIER "Foo",LBRACE,RBRACE]
testStatementIfThen = TestCase $ testStatementIfThen = TestCase $
assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $ assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $
@ -217,7 +220,16 @@ testStatementAssign = TestCase $
testStatementMethodCallNoParams = TestCase $ testStatementMethodCallNoParams = TestCase $
assertEqual "expect methodcall statement no params" [StatementExpressionStatement (MethodCall (Reference "this") "foo" [])] $ assertEqual "expect methodcall statement no params" [StatementExpressionStatement (MethodCall (Reference "this") "foo" [])] $
parseStatement [IDENTIFIER "foo",LBRACE,RBRACE,SEMICOLON] parseStatement [IDENTIFIER "foo",LBRACE,RBRACE,SEMICOLON]
testStatementConstructorCall = TestCase $
assertEqual "expect constructor call" [StatementExpressionStatement (ConstructorCall "Foo" [])] $
parseStatement [NEW,IDENTIFIER "Foo",LBRACE,RBRACE,SEMICOLON]
testStatementConstructorCallWithArgs = TestCase $
assertEqual "expect constructor call" [StatementExpressionStatement (ConstructorCall "Foo" [Reference "b"])] $
parseStatement [NEW,IDENTIFIER "Foo",LBRACE,IDENTIFIER "b",RBRACE,SEMICOLON]
testStatementPreIncrement = TestCase $
assertEqual "expect increment" [StatementExpressionStatement $ PostIncrement $ Reference "a"] $
parseStatement [IDENTIFIER "a",INCREMENT,SEMICOLON]
tests = TestList [ tests = TestList [
@ -279,9 +291,13 @@ tests = TestList [
testExpressionFieldAccess, testExpressionFieldAccess,
testExpressionSimpleFieldAccess, testExpressionSimpleFieldAccess,
testExpressionFieldSubAccess, testExpressionFieldSubAccess,
testExpressionConstructorCall,
testStatementIfThen, testStatementIfThen,
testStatementIfThenElse, testStatementIfThenElse,
testStatementWhile, testStatementWhile,
testStatementAssign, testStatementAssign,
testStatementMethodCallNoParams testStatementMethodCallNoParams,
testStatementConstructorCall,
testStatementConstructorCallWithArgs,
testStatementPreIncrement
] ]

View File

@ -117,7 +117,7 @@ modifier : PUBLIC { }
| STATIC { } | STATIC { }
| ABSTRACT { } | ABSTRACT { }
classtype : classorinterfacetype{ } classtype : classorinterfacetype { $1 }
classbodydeclaration : classmemberdeclaration { $1 } classbodydeclaration : classmemberdeclaration { $1 }
| constructordeclaration { $1 } | constructordeclaration { $1 }
@ -249,12 +249,12 @@ assignment : lefthandside assignmentoperator assignmentexpression {
statementexpression : assignment { $1 } statementexpression : assignment { $1 }
-- | preincrementexpression { } | preincrementexpression { $1 }
-- | predecrementexpression { } | predecrementexpression { $1 }
-- | postincrementexpression { } | postincrementexpression { $1 }
-- | postdecrementexpression { } | postdecrementexpression { $1 }
| methodinvocation { $1 } | methodinvocation { $1 }
-- | classinstancecreationexpression { } | classinstancecreationexpression { $1 }
ifthenelsestatementnoshortif :IF LBRACE expression RBRACE statementnoshortif ifthenelsestatementnoshortif :IF LBRACE expression RBRACE statementnoshortif
ELSE statementnoshortif { } ELSE statementnoshortif { }
@ -292,8 +292,8 @@ methodinvocation : simplename LBRACE RBRACE { MethodCall (Reference "this") $
| primary DOT IDENTIFIER LBRACE RBRACE { MethodCall $1 $3 [] } | primary DOT IDENTIFIER LBRACE RBRACE { MethodCall $1 $3 [] }
| primary DOT IDENTIFIER LBRACE argumentlist RBRACE { MethodCall $1 $3 $5 } | primary DOT IDENTIFIER LBRACE argumentlist RBRACE { MethodCall $1 $3 $5 }
classinstancecreationexpression : NEW classtype LBRACE RBRACE { } classinstancecreationexpression : NEW classtype LBRACE RBRACE { ConstructorCall $2 [] }
| NEW classtype LBRACE argumentlist RBRACE { } | NEW classtype LBRACE argumentlist RBRACE { ConstructorCall $2 $4 }
conditionalandexpression : inclusiveorexpression { $1 } conditionalandexpression : inclusiveorexpression { $1 }
@ -318,7 +318,7 @@ inclusiveorexpression : exclusiveorexpression { $1 }
primarynonewarray : literal { $1 } primarynonewarray : literal { $1 }
| THIS { Reference "this" } | THIS { Reference "this" }
| LBRACE expression RBRACE { $2 } | LBRACE expression RBRACE { $2 }
-- | classinstancecreationexpression { } | classinstancecreationexpression { StatementExpressionExpression $1 }
| fieldaccess { $1 } | fieldaccess { $1 }
| methodinvocation { StatementExpressionExpression $1 } | methodinvocation { StatementExpressionExpression $1 }

View File

@ -72,7 +72,7 @@ tokens :-
-- end keywords -- end keywords
$JavaLetter$JavaLetterOrDigit* { \s -> IDENTIFIER s } $JavaLetter$JavaLetterOrDigit* { \s -> IDENTIFIER s }
-- Literals -- Literals
[1-9]([0-9\_]*[0-9])* { \s -> case readMaybe $ filter ((/=) '_') s of Just a -> INTEGERLITERAL a; Nothing -> error ("failed to parse INTLITERAL " ++ s) } [0-9]([0-9\_]*[0-9])* { \s -> case readMaybe $ filter ((/=) '_') s of Just a -> INTEGERLITERAL a; Nothing -> error ("failed to parse INTLITERAL " ++ s) }
"'"."'" { \s -> case (s) of _ : c : _ -> CHARLITERAL c; _ -> error ("failed to parse CHARLITERAL " ++ s) } "'"."'" { \s -> case (s) of _ : c : _ -> CHARLITERAL c; _ -> error ("failed to parse CHARLITERAL " ++ s) }
-- separators -- separators
"(" { \_ -> LBRACE } "(" { \_ -> LBRACE }

View File

@ -19,15 +19,14 @@ typeCheckClass (Class className methods fields) classes =
typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration
typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFields classes = typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFields classes =
let let
-- Combine class fields with method parameters to form the initial symbol table for the method
methodParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params] methodParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params]
initialSymtab = classFields ++ methodParams initialSymtab = ("thisMeth", retType) : classFields ++ methodParams
checkedBody = typeCheckStatement body initialSymtab classes checkedBody = typeCheckStatement body initialSymtab classes
bodyType = getTypeFromStmt checkedBody bodyType = getTypeFromStmt checkedBody
-- Check if the type of the body matches the declared return type in if bodyType == retType || (bodyType == "void" && retType == "void") || (bodyType == "null" && isObjectType retType) || isSubtype bodyType retType classes
in if bodyType == retType || (bodyType == "void" && retType == "void") || (bodyType == "null" && isObjectType retType)
then MethodDeclaration retType name params checkedBody then MethodDeclaration retType name params checkedBody
else error $ "Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType else error $ "Method Declaration: Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType
-- ********************************** Type Checking: Expressions ********************************** -- ********************************** Type Checking: Expressions **********************************
@ -37,6 +36,7 @@ typeCheckExpression (CharacterLiteral c) _ _ = TypedExpression "char" (Character
typeCheckExpression (BooleanLiteral b) _ _ = TypedExpression "boolean" (BooleanLiteral b) typeCheckExpression (BooleanLiteral b) _ _ = TypedExpression "boolean" (BooleanLiteral b)
typeCheckExpression NullLiteral _ _ = TypedExpression "null" NullLiteral typeCheckExpression NullLiteral _ _ = TypedExpression "null" NullLiteral
typeCheckExpression (Reference id) symtab classes = typeCheckExpression (Reference id) symtab classes =
-- TODO: maybe maje exception for "this" in first lookup?
case lookup id symtab of case lookup id symtab of
Just t -> TypedExpression t (LocalVariable id) Just t -> TypedExpression t (LocalVariable id)
Nothing -> Nothing ->
@ -118,7 +118,7 @@ typeCheckStatementExpression (ConstructorCall className args) symtab classes =
Nothing -> error $ "Class '" ++ className ++ "' not found." Nothing -> error $ "Class '" ++ className ++ "' not found."
Just (Class _ methods fields) -> Just (Class _ methods fields) ->
-- Constructor needs the same name as the class -- Constructor needs the same name as the class
case find (\(MethodDeclaration retType name params _) -> name == className && retType == className) methods of case find (\(MethodDeclaration retType name params _) -> name == "<init>" && retType == "void") methods of
Nothing -> error $ "No valid constructor found for class '" ++ className ++ "'." Nothing -> error $ "No valid constructor found for class '" ++ className ++ "'."
Just (MethodDeclaration _ _ params _) -> Just (MethodDeclaration _ _ params _) ->
let let
@ -203,16 +203,22 @@ typeCheckStatementExpression (PreDecrement expr) symtab classes =
typeCheckStatement :: Statement -> [(Identifier, DataType)] -> [Class] -> Statement typeCheckStatement :: Statement -> [(Identifier, DataType)] -> [Class] -> Statement
typeCheckStatement (If cond thenStmt elseStmt) symtab classes = typeCheckStatement (If cond thenStmt elseStmt) symtab classes =
let cond' = typeCheckExpression cond symtab classes let
cond' = typeCheckExpression cond symtab classes
thenStmt' = typeCheckStatement thenStmt symtab classes thenStmt' = typeCheckStatement thenStmt symtab classes
elseStmt' = case elseStmt of elseStmt' = fmap (\stmt -> typeCheckStatement stmt symtab classes) elseStmt
Just stmt -> Just (typeCheckStatement stmt symtab classes)
Nothing -> Nothing thenType = getTypeFromStmt thenStmt'
elseType = maybe "void" getTypeFromStmt elseStmt'
ifType = if thenType == "void" || elseType == "void"
then "void"
else unifyReturnTypes thenType elseType
in if getTypeFromExpr cond' == "boolean" in if getTypeFromExpr cond' == "boolean"
then then TypedStatement ifType (If cond' thenStmt' elseStmt')
TypedStatement (getTypeFromStmt thenStmt') (If cond' thenStmt' elseStmt') else error "If condition must be of type boolean"
else
error "If condition must be of type boolean"
typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)) symtab classes = typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)) symtab classes =
-- Check for redefinition in the current scope -- Check for redefinition in the current scope
@ -267,12 +273,14 @@ typeCheckStatement (Block statements) symtab classes =
in TypedStatement blockType (Block checkedStatements) in TypedStatement blockType (Block checkedStatements)
typeCheckStatement (Return expr) symtab classes = typeCheckStatement (Return expr) symtab classes =
let expr' = case expr of let methodReturnType = fromMaybe (error "Method return type not found in symbol table") (lookup "thisMeth" symtab)
expr' = case expr of
Just e -> Just (typeCheckExpression e symtab classes) Just e -> Just (typeCheckExpression e symtab classes)
Nothing -> Nothing Nothing -> Nothing
in case expr' of returnType = maybe "void" getTypeFromExpr expr'
Just e' -> TypedStatement (getTypeFromExpr e') (Return (Just e')) in if returnType == methodReturnType || isSubtype returnType methodReturnType classes
Nothing -> TypedStatement "void" (Return Nothing) then TypedStatement returnType (Return expr')
else error $ "Return: Return type mismatch: expected " ++ methodReturnType ++ ", found " ++ returnType
typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes = typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes =
let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
@ -280,6 +288,17 @@ typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes =
-- ********************************** Type Checking: Helpers ********************************** -- ********************************** Type Checking: Helpers **********************************
isSubtype :: DataType -> DataType -> [Class] -> Bool
isSubtype subType superType classes
| subType == superType = True
| subType == "null" && isObjectType superType = True
| superType == "Object" && isObjectType subType = True
| superType == "Object" && isUserDefinedClass subType classes = True
| otherwise = False
isUserDefinedClass :: DataType -> [Class] -> Bool
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"
@ -298,6 +317,8 @@ getTypeFromStmtExpr _ = error "Untyped statement expression found where typed wa
unifyReturnTypes :: DataType -> DataType -> DataType unifyReturnTypes :: DataType -> DataType -> DataType
unifyReturnTypes dt1 dt2 unifyReturnTypes dt1 dt2
| dt1 == dt2 = dt1 | dt1 == dt2 = dt1
| dt1 == "null" = dt2
| dt2 == "null" = dt1
| otherwise = "Object" | otherwise = "Object"
resolveResultType :: DataType -> DataType -> DataType resolveResultType :: DataType -> DataType -> DataType
@ -319,7 +340,7 @@ checkBitwiseOperation :: BinaryOperator -> Expression -> Expression -> DataType
checkBitwiseOperation op expr1' expr2' type1 type2 checkBitwiseOperation op expr1' expr2' type1 type2
| type1 == "int" && type2 == "int" = | type1 == "int" && type2 == "int" =
TypedExpression "int" (BinaryOperation op expr1' expr2') TypedExpression "int" (BinaryOperation op expr1' expr2')
| otherwise = error $ "Bitwise operation " ++ show op ++ " requires operands of type int" | otherwise = error $ "Bitwise operation " ++ show op ++ " requires operands of type int or char"
checkComparisonOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression checkComparisonOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression
checkComparisonOperation op expr1' expr2' type1 type2 checkComparisonOperation op expr1' expr2' type1 type2