Compare commits
12 Commits
06dad4d7f9
...
7317895800
Author | SHA1 | Date | |
---|---|---|---|
|
7317895800 | ||
b525d14192 | |||
a62fe50a0d | |||
7c52084bbe | |||
|
98b02446ba | ||
82b2b4a6e1 | |||
3d351ee02b | |||
05b599b8ff | |||
060321f323 | |||
fc96eba52e | |||
af093fa3bb | |||
666856b33a |
@ -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
|
||||||
]
|
]
|
@ -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 }
|
||||||
|
|
||||||
|
@ -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 }
|
||||||
|
@ -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
|
||||||
thenStmt' = typeCheckStatement thenStmt symtab classes
|
cond' = typeCheckExpression cond symtab classes
|
||||||
elseStmt' = case elseStmt of
|
thenStmt' = typeCheckStatement thenStmt symtab classes
|
||||||
Just stmt -> Just (typeCheckStatement stmt symtab classes)
|
elseStmt' = fmap (\stmt -> typeCheckStatement stmt symtab classes) elseStmt
|
||||||
Nothing -> Nothing
|
|
||||||
in if getTypeFromExpr cond' == "boolean"
|
thenType = getTypeFromStmt thenStmt'
|
||||||
then
|
elseType = maybe "void" getTypeFromStmt elseStmt'
|
||||||
TypedStatement (getTypeFromStmt thenStmt') (If cond' thenStmt' elseStmt')
|
|
||||||
else
|
ifType = if thenType == "void" || elseType == "void"
|
||||||
error "If condition must be of type boolean"
|
then "void"
|
||||||
|
else unifyReturnTypes thenType elseType
|
||||||
|
|
||||||
|
in if getTypeFromExpr cond' == "boolean"
|
||||||
|
then TypedStatement ifType (If cond' thenStmt' elseStmt')
|
||||||
|
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"
|
||||||
|
|
||||||
@ -297,8 +316,10 @@ 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
|
||||||
| otherwise = "Object"
|
| dt1 == "null" = dt2
|
||||||
|
| dt2 == "null" = dt1
|
||||||
|
| otherwise = "Object"
|
||||||
|
|
||||||
resolveResultType :: DataType -> DataType -> DataType
|
resolveResultType :: DataType -> DataType -> DataType
|
||||||
resolveResultType "char" "char" = "char"
|
resolveResultType "char" "char" = "char"
|
||||||
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user