Compare commits
9 Commits
1e59ba9e27
...
d4f474ba54
Author | SHA1 | Date | |
---|---|---|---|
d4f474ba54 | |||
0694dfb77d | |||
6ab64371b5 | |||
067bf8d796 | |||
e95377ee72 | |||
2a502a6c67 | |||
07837f7d5f | |||
a80dc1d34b | |||
a7b4c7e58e |
@ -52,6 +52,12 @@ testClassWithMethodAndField = TestCase $
|
|||||||
testClassWithConstructor = TestCase $
|
testClassWithConstructor = TestCase $
|
||||||
assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "void" "<init>" [] (Block [])] []] $
|
assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "void" "<init>" [] (Block [])] []] $
|
||||||
parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET]
|
parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET]
|
||||||
|
testConstructorWithParams = TestCase $
|
||||||
|
assertEqual "expect constructor with params" [Class "WithParams" [MethodDeclaration "void" "<init>" [ParameterDeclaration "int" "p1"] (Block [])] []] $
|
||||||
|
parse [CLASS,IDENTIFIER "WithParams",LBRACKET,IDENTIFIER "WithParams",LBRACE,INT,IDENTIFIER "p1",RBRACE,LBRACKET,RBRACKET,RBRACKET]
|
||||||
|
testConstructorWithStatements = TestCase $
|
||||||
|
assertEqual "expect constructor with statement" [Class "WithConstructor" [MethodDeclaration "void" "<init>" [] (Block [Return Nothing])] []] $
|
||||||
|
parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RETURN,SEMICOLON,RBRACKET,RBRACKET]
|
||||||
|
|
||||||
|
|
||||||
testEmptyBlock = TestCase $ assertEqual "expect empty block" [Block []] $ parseStatement [LBRACKET,RBRACKET]
|
testEmptyBlock = TestCase $ assertEqual "expect empty block" [Block []] $ parseStatement [LBRACKET,RBRACKET]
|
||||||
@ -133,16 +139,16 @@ testExpressionOr = TestCase $
|
|||||||
assertEqual "expect or expression" (BinaryOperation Or (Reference "bar") (Reference "baz")) $
|
assertEqual "expect or expression" (BinaryOperation Or (Reference "bar") (Reference "baz")) $
|
||||||
parseExpression [IDENTIFIER "bar",OR,IDENTIFIER "baz"]
|
parseExpression [IDENTIFIER "bar",OR,IDENTIFIER "baz"]
|
||||||
testExpressionPostIncrement = TestCase $
|
testExpressionPostIncrement = TestCase $
|
||||||
assertEqual "expect PostIncrement" (UnaryOperation PostIncrement (Reference "a")) $
|
assertEqual "expect PostIncrement" (StatementExpressionExpression $ PostIncrement (Reference "a")) $
|
||||||
parseExpression [IDENTIFIER "a",INCREMENT]
|
parseExpression [IDENTIFIER "a",INCREMENT]
|
||||||
testExpressionPostDecrement = TestCase $
|
testExpressionPostDecrement = TestCase $
|
||||||
assertEqual "expect PostDecrement" (UnaryOperation PostDecrement (Reference "a")) $
|
assertEqual "expect PostDecrement" (StatementExpressionExpression $ PostDecrement (Reference "a")) $
|
||||||
parseExpression [IDENTIFIER "a",DECREMENT]
|
parseExpression [IDENTIFIER "a",DECREMENT]
|
||||||
testExpressionPreIncrement = TestCase $
|
testExpressionPreIncrement = TestCase $
|
||||||
assertEqual "expect PreIncrement" (UnaryOperation PreIncrement (Reference "a")) $
|
assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreIncrement (Reference "a")) $
|
||||||
parseExpression [INCREMENT,IDENTIFIER "a"]
|
parseExpression [INCREMENT,IDENTIFIER "a"]
|
||||||
testExpressionPreDecrement = TestCase $
|
testExpressionPreDecrement = TestCase $
|
||||||
assertEqual "expect PreIncrement" (UnaryOperation PreDecrement (Reference "a")) $
|
assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreDecrement (Reference "a")) $
|
||||||
parseExpression [DECREMENT,IDENTIFIER "a"]
|
parseExpression [DECREMENT,IDENTIFIER "a"]
|
||||||
testExpressionAssign = TestCase $
|
testExpressionAssign = TestCase $
|
||||||
assertEqual "expect assign 5 to a" (StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 5))) $
|
assertEqual "expect assign 5 to a" (StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 5))) $
|
||||||
@ -159,6 +165,32 @@ testExpressionPlusEqual = TestCase $
|
|||||||
testExpressionMinusEqual = TestCase $
|
testExpressionMinusEqual = TestCase $
|
||||||
assertEqual "expect assign and subtraction" (StatementExpressionExpression (Assignment (Reference "a") (BinaryOperation Subtraction (Reference "a") (IntegerLiteral 5)))) $
|
assertEqual "expect assign and subtraction" (StatementExpressionExpression (Assignment (Reference "a") (BinaryOperation Subtraction (Reference "a") (IntegerLiteral 5)))) $
|
||||||
parseExpression [IDENTIFIER "a",MINUSEQUAL,INTEGERLITERAL 5]
|
parseExpression [IDENTIFIER "a",MINUSEQUAL,INTEGERLITERAL 5]
|
||||||
|
testExpressionThis = TestCase $
|
||||||
|
assertEqual "expect this" (Reference "this") $
|
||||||
|
parseExpression [THIS]
|
||||||
|
testExpressionBraced = TestCase $
|
||||||
|
assertEqual "expect braced expresssion" (BinaryOperation Multiplication (Reference "b") (BinaryOperation Addition (Reference "a") (IntegerLiteral 3))) $
|
||||||
|
parseExpression [IDENTIFIER "b",TIMES,LBRACE,IDENTIFIER "a",PLUS,INTEGERLITERAL 3,RBRACE]
|
||||||
|
|
||||||
|
testExpressionPrecedence = TestCase $
|
||||||
|
assertEqual "expect times to be inner expression" (BinaryOperation Addition (BinaryOperation Multiplication (Reference "b") (Reference "a")) (IntegerLiteral 3)) $
|
||||||
|
parseExpression [IDENTIFIER "b",TIMES,IDENTIFIER "a",PLUS,INTEGERLITERAL 3]
|
||||||
|
|
||||||
|
testExpressionMethodCallNoParams = TestCase $
|
||||||
|
assertEqual "expect methodcall no params" (StatementExpressionExpression (MethodCall (Reference "this") "foo" [])) $
|
||||||
|
parseExpression [IDENTIFIER "foo",LBRACE,RBRACE]
|
||||||
|
testExpressionMethodCallOneParam = TestCase $
|
||||||
|
assertEqual "expect methodcall one param" (StatementExpressionExpression (MethodCall (Reference "this") "foo" [Reference "a"])) $
|
||||||
|
parseExpression [IDENTIFIER "foo",LBRACE,IDENTIFIER "a",RBRACE]
|
||||||
|
testExpressionMethodCallTwoParams = TestCase $
|
||||||
|
assertEqual "expect methocall two params" (StatementExpressionExpression (MethodCall (Reference "this") "foo" [Reference "a", IntegerLiteral 5])) $
|
||||||
|
parseExpression [IDENTIFIER "foo",LBRACE,IDENTIFIER "a",COMMA,INTEGERLITERAL 5,RBRACE]
|
||||||
|
testExpressionThisMethodCall = TestCase $
|
||||||
|
assertEqual "expect this methocall" (StatementExpressionExpression (MethodCall (Reference "this") "foo" [])) $
|
||||||
|
parseExpression [THIS,DOT,IDENTIFIER "foo",LBRACE,RBRACE]
|
||||||
|
testExpressionThisMethodCallParam = TestCase $
|
||||||
|
assertEqual "expect this methocall" (StatementExpressionExpression (MethodCall (Reference "this") "foo" [Reference "x"])) $
|
||||||
|
parseExpression [THIS,DOT,IDENTIFIER "foo",LBRACE,IDENTIFIER "x",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] $
|
||||||
@ -169,6 +201,13 @@ testStatementIfThenElse = TestCase $
|
|||||||
testStatementWhile = TestCase $
|
testStatementWhile = TestCase $
|
||||||
assertEqual "expect while" [While (Reference "a") (Block [Block []])] $
|
assertEqual "expect while" [While (Reference "a") (Block [Block []])] $
|
||||||
parseStatement [WHILE,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET]
|
parseStatement [WHILE,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET]
|
||||||
|
testStatementAssign = TestCase $
|
||||||
|
assertEqual "expect assign 5" [StatementExpressionStatement (Assignment (Reference "a") (IntegerLiteral 5))] $
|
||||||
|
parseStatement [IDENTIFIER "a",ASSIGN,INTEGERLITERAL 5,SEMICOLON]
|
||||||
|
|
||||||
|
testStatementMethodCallNoParams = TestCase $
|
||||||
|
assertEqual "expect methodcall statement no params" [StatementExpressionStatement (MethodCall (Reference "this") "foo" [])] $
|
||||||
|
parseStatement [IDENTIFIER "foo",LBRACE,RBRACE,SEMICOLON]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -187,6 +226,8 @@ tests = TestList [
|
|||||||
testEmptyMethodWithParams,
|
testEmptyMethodWithParams,
|
||||||
testClassWithMethodAndField,
|
testClassWithMethodAndField,
|
||||||
testClassWithConstructor,
|
testClassWithConstructor,
|
||||||
|
testConstructorWithParams,
|
||||||
|
testConstructorWithStatements,
|
||||||
testEmptyBlock,
|
testEmptyBlock,
|
||||||
testBlockWithLocalVarDecl,
|
testBlockWithLocalVarDecl,
|
||||||
testBlockWithMultipleLocalVarDecls,
|
testBlockWithMultipleLocalVarDecls,
|
||||||
@ -218,7 +259,17 @@ tests = TestList [
|
|||||||
testExpressionDivideEqual,
|
testExpressionDivideEqual,
|
||||||
testExpressionPlusEqual,
|
testExpressionPlusEqual,
|
||||||
testExpressionMinusEqual,
|
testExpressionMinusEqual,
|
||||||
|
testExpressionBraced,
|
||||||
|
testExpressionThis,
|
||||||
|
testExpressionPrecedence,
|
||||||
|
testExpressionMethodCallNoParams,
|
||||||
|
testExpressionMethodCallOneParam,
|
||||||
|
testExpressionMethodCallTwoParams,
|
||||||
|
testExpressionThisMethodCall,
|
||||||
|
testExpressionThisMethodCallParam,
|
||||||
testStatementIfThen,
|
testStatementIfThen,
|
||||||
testStatementIfThenElse,
|
testStatementIfThenElse,
|
||||||
testStatementWhile
|
testStatementWhile,
|
||||||
|
testStatementAssign,
|
||||||
|
testStatementMethodCallNoParams
|
||||||
]
|
]
|
@ -24,6 +24,10 @@ data StatementExpression
|
|||||||
| ConstructorCall DataType [Expression]
|
| ConstructorCall DataType [Expression]
|
||||||
| MethodCall Expression Identifier [Expression]
|
| MethodCall Expression Identifier [Expression]
|
||||||
| TypedStatementExpression DataType StatementExpression
|
| TypedStatementExpression DataType StatementExpression
|
||||||
|
| PostIncrement Expression
|
||||||
|
| PostDecrement Expression
|
||||||
|
| PreIncrement Expression
|
||||||
|
| PreDecrement Expression
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data BinaryOperator
|
data BinaryOperator
|
||||||
@ -49,10 +53,6 @@ data BinaryOperator
|
|||||||
data UnaryOperator
|
data UnaryOperator
|
||||||
= Not
|
= Not
|
||||||
| Minus
|
| Minus
|
||||||
| PostIncrement
|
|
||||||
| PostDecrement
|
|
||||||
| PreIncrement
|
|
||||||
| PreDecrement
|
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data Expression
|
data Expression
|
||||||
|
@ -101,24 +101,36 @@ exampleNameResolutionAssignment = Block [
|
|||||||
exampleCharIntOperation :: Expression
|
exampleCharIntOperation :: Expression
|
||||||
exampleCharIntOperation = BinaryOperation Addition (CharacterLiteral 'a') (IntegerLiteral 1)
|
exampleCharIntOperation = BinaryOperation Addition (CharacterLiteral 'a') (IntegerLiteral 1)
|
||||||
|
|
||||||
|
exampleNullDeclaration :: Statement
|
||||||
|
exampleNullDeclaration = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just NullLiteral))
|
||||||
|
|
||||||
|
exampleNullDeclarationFail :: Statement
|
||||||
|
exampleNullDeclarationFail = LocalVariableDeclaration (VariableDeclaration "int" "a" (Just NullLiteral))
|
||||||
|
|
||||||
|
exampleNullAssignment :: Statement
|
||||||
|
exampleNullAssignment = StatementExpressionStatement (Assignment (Reference "a") NullLiteral)
|
||||||
|
|
||||||
|
exampleIncrement :: Statement
|
||||||
|
exampleIncrement = StatementExpressionStatement (PostIncrement (Reference "a"))
|
||||||
|
|
||||||
testClasses :: [Class]
|
testClasses :: [Class]
|
||||||
testClasses = [
|
testClasses = [
|
||||||
Class "Person" [
|
Class "Person" [
|
||||||
MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"]
|
MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"]
|
||||||
(Block [
|
(Block [
|
||||||
Return (Just (Reference "this"))
|
Return (Just (Reference "this"))
|
||||||
]),
|
]),
|
||||||
MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"]
|
MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"]
|
||||||
(Block [
|
(Block [
|
||||||
LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge")))
|
LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge")))
|
||||||
]),
|
]),
|
||||||
MethodDeclaration "int" "getAge" []
|
MethodDeclaration "int" "getAge" []
|
||||||
(Return (Just (Reference "age")))
|
(Return (Just (Reference "age")))
|
||||||
] [
|
] [
|
||||||
VariableDeclaration "int" "age" Nothing -- initially unassigned
|
VariableDeclaration "int" "age" Nothing -- initially unassigned
|
||||||
],
|
],
|
||||||
Class "Main" [
|
Class "Main" [
|
||||||
MethodDeclaration "int" "main" []
|
MethodDeclaration "int" "main" []
|
||||||
(Block [
|
(Block [
|
||||||
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 25])))),
|
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 25])))),
|
||||||
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
|
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
|
||||||
@ -211,7 +223,7 @@ runTypeCheck = do
|
|||||||
printSuccess "Type checking of Program completed successfully"
|
printSuccess "Type checking of Program completed successfully"
|
||||||
printResult "Typed Program:" typedProgram
|
printResult "Typed Program:" typedProgram
|
||||||
) handleError
|
) handleError
|
||||||
|
|
||||||
catch (do
|
catch (do
|
||||||
print "====================================================================================="
|
print "====================================================================================="
|
||||||
typedAssignment <- evaluate (typeCheckStatement exampleNameResolutionAssignment [] sampleClasses)
|
typedAssignment <- evaluate (typeCheckStatement exampleNameResolutionAssignment [] sampleClasses)
|
||||||
@ -226,3 +238,30 @@ runTypeCheck = do
|
|||||||
printResult "Result Char Int Operation:" evaluatedCharIntOperation
|
printResult "Result Char Int Operation:" evaluatedCharIntOperation
|
||||||
) handleError
|
) handleError
|
||||||
|
|
||||||
|
catch (do
|
||||||
|
print "====================================================================================="
|
||||||
|
evaluatedNullDeclaration <- evaluate (typeCheckStatement exampleNullDeclaration [] sampleClasses)
|
||||||
|
printSuccess "Type checking of null declaration completed successfully"
|
||||||
|
printResult "Result Null Declaration:" evaluatedNullDeclaration
|
||||||
|
) handleError
|
||||||
|
|
||||||
|
catch (do
|
||||||
|
print "====================================================================================="
|
||||||
|
evaluatedNullDeclarationFail <- evaluate (typeCheckStatement exampleNullDeclarationFail [] sampleClasses)
|
||||||
|
printSuccess "Type checking of null declaration failed"
|
||||||
|
printResult "Result Null Declaration:" evaluatedNullDeclarationFail
|
||||||
|
) handleError
|
||||||
|
|
||||||
|
catch (do
|
||||||
|
print "====================================================================================="
|
||||||
|
evaluatedNullAssignment <- evaluate (typeCheckStatement exampleNullAssignment [("a", "Person")] sampleClasses)
|
||||||
|
printSuccess "Type checking of null assignment completed successfully"
|
||||||
|
printResult "Result Null Assignment:" evaluatedNullAssignment
|
||||||
|
) handleError
|
||||||
|
|
||||||
|
catch (do
|
||||||
|
print "====================================================================================="
|
||||||
|
evaluatedIncrement <- evaluate (typeCheckStatement exampleIncrement [("a", "int")] sampleClasses)
|
||||||
|
printSuccess "Type checking of increment completed successfully"
|
||||||
|
printResult "Result Increment:" evaluatedIncrement
|
||||||
|
) handleError
|
||||||
|
@ -127,8 +127,8 @@ classorinterfacetype : simplename { $1 }
|
|||||||
classmemberdeclaration : fielddeclaration { $1 }
|
classmemberdeclaration : fielddeclaration { $1 }
|
||||||
| methoddeclaration { $1 }
|
| methoddeclaration { $1 }
|
||||||
|
|
||||||
constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "<init>" parameters $2 }
|
constructordeclaration : constructordeclarator constructorbody { MethodDecl $ MethodDeclaration "void" "<init>" $1 $2 }
|
||||||
| modifiers constructordeclarator constructorbody { case $2 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "<init>" parameters $3 }
|
| modifiers constructordeclarator constructorbody { MethodDecl $ MethodDeclaration "void" "<init>" $2 $3 }
|
||||||
|
|
||||||
fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $1) $2 }
|
fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $1) $2 }
|
||||||
| modifiers type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $2) $3 }
|
| modifiers type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $2) $3 }
|
||||||
@ -138,12 +138,12 @@ methoddeclaration : methodheader methodbody { case $1 of (returnType, (name, par
|
|||||||
block : LBRACKET RBRACKET { Block [] }
|
block : LBRACKET RBRACKET { Block [] }
|
||||||
| LBRACKET blockstatements RBRACKET { Block $2 }
|
| LBRACKET blockstatements RBRACKET { Block $2 }
|
||||||
|
|
||||||
constructordeclarator : simplename LBRACE RBRACE { ($1, []) }
|
constructordeclarator : simplename LBRACE RBRACE { [] }
|
||||||
| simplename LBRACE formalparameterlist RBRACE { ($1, $3) }
|
| simplename LBRACE formalparameterlist RBRACE { $3 }
|
||||||
|
|
||||||
constructorbody : LBRACKET RBRACKET { Block [] }
|
constructorbody : LBRACKET RBRACKET { Block [] }
|
||||||
-- | LBRACKET explicitconstructorinvocation RBRACKET { }
|
-- | LBRACKET explicitconstructorinvocation RBRACKET { }
|
||||||
-- | LBRACKET blockstatements RBRACKET { }
|
| LBRACKET blockstatements RBRACKET { Block $2 }
|
||||||
-- | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { }
|
-- | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { }
|
||||||
|
|
||||||
methodheader : type methoddeclarator { ($1, $2) }
|
methodheader : type methoddeclarator { ($1, $2) }
|
||||||
@ -189,8 +189,8 @@ blockstatement : localvariabledeclarationstatement { $1 } -- expected ty
|
|||||||
|
|
||||||
formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 }
|
formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 }
|
||||||
|
|
||||||
argumentlist : expression { }
|
argumentlist : expression { [$1] }
|
||||||
| argumentlist COMMA expression { }
|
| argumentlist COMMA expression { $1 ++ [$3] }
|
||||||
|
|
||||||
numerictype : integraltype { $1 }
|
numerictype : integraltype { $1 }
|
||||||
|
|
||||||
@ -215,7 +215,7 @@ localvariabledeclaration : type variabledeclarators { map LocalVariableDeclarati
|
|||||||
|
|
||||||
statementwithouttrailingsubstatement : block { [$1] }
|
statementwithouttrailingsubstatement : block { [$1] }
|
||||||
| emptystatement { [] }
|
| emptystatement { [] }
|
||||||
-- | expressionstatement { }
|
| expressionstatement { [$1] }
|
||||||
| returnstatement { [$1] }
|
| returnstatement { [$1] }
|
||||||
|
|
||||||
ifthenstatement : IF LBRACE expression RBRACE statement { If $3 (Block $5) Nothing }
|
ifthenstatement : IF LBRACE expression RBRACE statement { If $3 (Block $5) Nothing }
|
||||||
@ -229,7 +229,7 @@ assignmentexpression : conditionalexpression { $1 }
|
|||||||
|
|
||||||
emptystatement : SEMICOLON { Block [] }
|
emptystatement : SEMICOLON { Block [] }
|
||||||
|
|
||||||
expressionstatement : statementexpression SEMICOLON { }
|
expressionstatement : statementexpression SEMICOLON { StatementExpressionStatement $1 }
|
||||||
|
|
||||||
returnstatement : RETURN SEMICOLON { Return Nothing }
|
returnstatement : RETURN SEMICOLON { Return Nothing }
|
||||||
| RETURN expression SEMICOLON { Return $ Just $2 }
|
| RETURN expression SEMICOLON { Return $ Just $2 }
|
||||||
@ -248,13 +248,13 @@ assignment : lefthandside assignmentoperator assignmentexpression {
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
statementexpression : assignment { }
|
statementexpression : assignment { $1 }
|
||||||
| preincrementexpression { }
|
-- | preincrementexpression { }
|
||||||
| predecrementexpression { }
|
-- | predecrementexpression { }
|
||||||
| postincrementexpression { }
|
-- | postincrementexpression { }
|
||||||
| postdecrementexpression { }
|
-- | postdecrementexpression { }
|
||||||
| methodinvocation { }
|
| methodinvocation { $1 }
|
||||||
| classinstancecreationexpression { }
|
-- | classinstancecreationexpression { }
|
||||||
|
|
||||||
ifthenelsestatementnoshortif :IF LBRACE expression RBRACE statementnoshortif
|
ifthenelsestatementnoshortif :IF LBRACE expression RBRACE statementnoshortif
|
||||||
ELSE statementnoshortif { }
|
ELSE statementnoshortif { }
|
||||||
@ -279,18 +279,18 @@ assignmentoperator : ASSIGN { Nothing }
|
|||||||
| XOREQUAL { Just BitwiseXor }
|
| XOREQUAL { Just BitwiseXor }
|
||||||
| OREQUAL{ Just BitwiseOr }
|
| OREQUAL{ Just BitwiseOr }
|
||||||
|
|
||||||
preincrementexpression : INCREMENT unaryexpression { UnaryOperation PreIncrement $2 }
|
preincrementexpression : INCREMENT unaryexpression { PreIncrement $2 }
|
||||||
|
|
||||||
predecrementexpression : DECREMENT unaryexpression { UnaryOperation PreDecrement $2 }
|
predecrementexpression : DECREMENT unaryexpression { PreDecrement $2 }
|
||||||
|
|
||||||
postincrementexpression : postfixexpression INCREMENT { UnaryOperation PostIncrement $1 }
|
postincrementexpression : postfixexpression INCREMENT { PostIncrement $1 }
|
||||||
|
|
||||||
postdecrementexpression : postfixexpression DECREMENT { UnaryOperation PostDecrement $1 }
|
postdecrementexpression : postfixexpression DECREMENT { PostDecrement $1 }
|
||||||
|
|
||||||
methodinvocation : name LBRACE RBRACE { }
|
methodinvocation : simplename LBRACE RBRACE { MethodCall (Reference "this") $1 [] }
|
||||||
| name LBRACE argumentlist RBRACE { }
|
| simplename LBRACE argumentlist RBRACE { MethodCall (Reference "this") $1 $3 }
|
||||||
| primary DOT IDENTIFIER LBRACE RBRACE { }
|
| primary DOT IDENTIFIER LBRACE RBRACE { MethodCall $1 $3 [] }
|
||||||
| primary DOT IDENTIFIER LBRACE argumentlist RBRACE { }
|
| primary DOT IDENTIFIER LBRACE argumentlist RBRACE { MethodCall $1 $3 $5 }
|
||||||
|
|
||||||
classinstancecreationexpression : NEW classtype LBRACE RBRACE { }
|
classinstancecreationexpression : NEW classtype LBRACE RBRACE { }
|
||||||
| NEW classtype LBRACE argumentlist RBRACE { }
|
| NEW classtype LBRACE argumentlist RBRACE { }
|
||||||
@ -300,15 +300,15 @@ conditionalandexpression : inclusiveorexpression { $1 }
|
|||||||
fieldaccess : primary DOT IDENTIFIER { }
|
fieldaccess : primary DOT IDENTIFIER { }
|
||||||
|
|
||||||
unaryexpression : unaryexpressionnotplusminus { $1 }
|
unaryexpression : unaryexpressionnotplusminus { $1 }
|
||||||
| predecrementexpression { $1 }
|
| predecrementexpression { StatementExpressionExpression $1 }
|
||||||
| PLUS unaryexpression { $2 }
|
| PLUS unaryexpression { $2 }
|
||||||
| MINUS unaryexpression { UnaryOperation Minus $2 }
|
| MINUS unaryexpression { UnaryOperation Minus $2 }
|
||||||
| preincrementexpression { $1 }
|
| preincrementexpression { StatementExpressionExpression $1 }
|
||||||
|
|
||||||
postfixexpression : primary { $1 }
|
postfixexpression : primary { $1 }
|
||||||
| name { $1 }
|
| name { $1 }
|
||||||
| postincrementexpression { $1 }
|
| postincrementexpression { StatementExpressionExpression $1 }
|
||||||
| postdecrementexpression{ $1 }
|
| postdecrementexpression { StatementExpressionExpression $1 }
|
||||||
|
|
||||||
primary : primarynonewarray { $1 }
|
primary : primarynonewarray { $1 }
|
||||||
|
|
||||||
@ -316,11 +316,11 @@ inclusiveorexpression : exclusiveorexpression { $1 }
|
|||||||
| inclusiveorexpression OR exclusiveorexpression { BinaryOperation Or $1 $3 }
|
| inclusiveorexpression OR exclusiveorexpression { BinaryOperation Or $1 $3 }
|
||||||
|
|
||||||
primarynonewarray : literal { $1 }
|
primarynonewarray : literal { $1 }
|
||||||
-- | THIS { }
|
| THIS { Reference "this" }
|
||||||
-- | LBRACE expression RBRACE { }
|
| LBRACE expression RBRACE { $2 }
|
||||||
-- | classinstancecreationexpression { }
|
-- | classinstancecreationexpression { }
|
||||||
-- | fieldaccess { }
|
-- | fieldaccess { }
|
||||||
-- | methodinvocation { }
|
| methodinvocation { StatementExpressionExpression $1 }
|
||||||
|
|
||||||
unaryexpressionnotplusminus : postfixexpression { $1 }
|
unaryexpressionnotplusminus : postfixexpression { $1 }
|
||||||
-- | TILDE unaryexpression { }
|
-- | TILDE unaryexpression { }
|
||||||
|
103
src/Typecheck.hs
103
src/Typecheck.hs
@ -25,7 +25,7 @@ typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFie
|
|||||||
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
|
-- Check if the type of the body matches the declared return type
|
||||||
in if bodyType == retType || (bodyType == "void" && retType == "void")
|
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 $ "Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType
|
||||||
|
|
||||||
@ -89,50 +89,11 @@ typeCheckExpression (UnaryOperation op expr) symtab classes =
|
|||||||
else
|
else
|
||||||
error "Logical NOT operation requires an operand of type boolean"
|
error "Logical NOT operation requires an operand of type boolean"
|
||||||
Minus ->
|
Minus ->
|
||||||
if type' == "int"
|
if type' == "int" || type' == "char"
|
||||||
then
|
then
|
||||||
TypedExpression "int" (UnaryOperation op expr')
|
TypedExpression type' (UnaryOperation op expr')
|
||||||
else if type' == "char"
|
|
||||||
then
|
|
||||||
TypedExpression "char" (UnaryOperation op expr')
|
|
||||||
else
|
else
|
||||||
error "Unary minus operation requires an operand of type int or char"
|
error "Unary minus operation requires an operand of type int or char"
|
||||||
PostIncrement ->
|
|
||||||
if type' == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "int" (UnaryOperation op expr')
|
|
||||||
else if type' == "char"
|
|
||||||
then
|
|
||||||
TypedExpression "char" (UnaryOperation op expr')
|
|
||||||
else
|
|
||||||
error "Post-increment operation requires an operand of type int or char"
|
|
||||||
PostDecrement ->
|
|
||||||
if type' == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "int" (UnaryOperation op expr')
|
|
||||||
else if type' == "char"
|
|
||||||
then
|
|
||||||
TypedExpression "char" (UnaryOperation op expr')
|
|
||||||
else
|
|
||||||
error "Post-decrement operation requires an operand of type int or char"
|
|
||||||
PreIncrement ->
|
|
||||||
if type' == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "int" (UnaryOperation op expr')
|
|
||||||
else if type' == "char"
|
|
||||||
then
|
|
||||||
TypedExpression "char" (UnaryOperation op expr')
|
|
||||||
else
|
|
||||||
error "Pre-increment operation requires an operand of type int or char"
|
|
||||||
PreDecrement ->
|
|
||||||
if type' == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "int" (UnaryOperation op expr')
|
|
||||||
else if type' == "char"
|
|
||||||
then
|
|
||||||
TypedExpression "char" (UnaryOperation op expr')
|
|
||||||
else
|
|
||||||
error "Pre-decrement operation requires an operand of type int or char"
|
|
||||||
|
|
||||||
typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
|
typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
|
||||||
let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
|
let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
|
||||||
@ -146,11 +107,11 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes =
|
|||||||
ref' = typeCheckExpression ref symtab classes
|
ref' = typeCheckExpression ref symtab classes
|
||||||
type' = getTypeFromExpr expr'
|
type' = getTypeFromExpr expr'
|
||||||
type'' = getTypeFromExpr ref'
|
type'' = getTypeFromExpr ref'
|
||||||
in
|
in
|
||||||
if type'' == type' then
|
if type'' == type' || (type' == "null" && isObjectType type'') then
|
||||||
TypedStatementExpression type' (Assignment ref' expr')
|
TypedStatementExpression type'' (Assignment ref' expr')
|
||||||
else
|
else
|
||||||
error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type'
|
error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type'
|
||||||
|
|
||||||
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
|
||||||
@ -202,6 +163,42 @@ typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
|
|||||||
Nothing -> error $ "Class for object type '" ++ objType ++ "' not found."
|
Nothing -> error $ "Class for object type '" ++ objType ++ "' not found."
|
||||||
_ -> error "Invalid object type for method call. Object must have a class type."
|
_ -> error "Invalid object type for method call. Object must have a class type."
|
||||||
|
|
||||||
|
typeCheckStatementExpression (PostIncrement expr) symtab classes =
|
||||||
|
let expr' = typeCheckExpression expr symtab classes
|
||||||
|
type' = getTypeFromExpr expr'
|
||||||
|
in if type' == "int" || type' == "char"
|
||||||
|
then
|
||||||
|
TypedStatementExpression type' (PostIncrement expr')
|
||||||
|
else
|
||||||
|
error "Post-increment operation requires an operand of type int or char"
|
||||||
|
|
||||||
|
typeCheckStatementExpression (PostDecrement expr) symtab classes =
|
||||||
|
let expr' = typeCheckExpression expr symtab classes
|
||||||
|
type' = getTypeFromExpr expr'
|
||||||
|
in if type' == "int" || type' == "char"
|
||||||
|
then
|
||||||
|
TypedStatementExpression type' (PostDecrement expr')
|
||||||
|
else
|
||||||
|
error "Post-decrement operation requires an operand of type int or char"
|
||||||
|
|
||||||
|
typeCheckStatementExpression (PreIncrement expr) symtab classes =
|
||||||
|
let expr' = typeCheckExpression expr symtab classes
|
||||||
|
type' = getTypeFromExpr expr'
|
||||||
|
in if type' == "int" || type' == "char"
|
||||||
|
then
|
||||||
|
TypedStatementExpression type' (PreIncrement expr')
|
||||||
|
else
|
||||||
|
error "Pre-increment operation requires an operand of type int or char"
|
||||||
|
|
||||||
|
typeCheckStatementExpression (PreDecrement expr) symtab classes =
|
||||||
|
let expr' = typeCheckExpression expr symtab classes
|
||||||
|
type' = getTypeFromExpr expr'
|
||||||
|
in if type' == "int" || type' == "char"
|
||||||
|
then
|
||||||
|
TypedStatementExpression type' (PreDecrement expr')
|
||||||
|
else
|
||||||
|
error "Pre-decrement operation requires an operand of type int or char"
|
||||||
|
|
||||||
-- ********************************** Type Checking: Statements **********************************
|
-- ********************************** Type Checking: Statements **********************************
|
||||||
|
|
||||||
typeCheckStatement :: Statement -> [(Identifier, DataType)] -> [Class] -> Statement
|
typeCheckStatement :: Statement -> [(Identifier, DataType)] -> [Class] -> Statement
|
||||||
@ -226,8 +223,12 @@ typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType ident
|
|||||||
let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr
|
let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr
|
||||||
exprType = fmap getTypeFromExpr checkedExpr
|
exprType = fmap getTypeFromExpr checkedExpr
|
||||||
in case exprType of
|
in case exprType of
|
||||||
Just t | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
|
Just t
|
||||||
_ -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
|
| t == "null" && isObjectType dataType ->
|
||||||
|
TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
|
||||||
|
| t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
|
||||||
|
| otherwise -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
|
||||||
|
Nothing -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
|
||||||
|
|
||||||
typeCheckStatement (While cond stmt) symtab classes =
|
typeCheckStatement (While cond stmt) symtab classes =
|
||||||
let cond' = typeCheckExpression cond symtab classes
|
let cond' = typeCheckExpression cond symtab classes
|
||||||
@ -254,6 +255,7 @@ typeCheckStatement (Block statements) symtab classes =
|
|||||||
If {} -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
If {} -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||||
While _ _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
While _ _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||||
Return _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
Return _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||||
|
Block _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
|
||||||
_ -> (accSts ++ [checkedStmt], currentSymtab, types)
|
_ -> (accSts ++ [checkedStmt], currentSymtab, types)
|
||||||
|
|
||||||
-- Initial accumulator: empty statements list, initial symbol table, empty types list
|
-- Initial accumulator: empty statements list, initial symbol table, empty types list
|
||||||
@ -278,6 +280,9 @@ typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes =
|
|||||||
|
|
||||||
-- ********************************** Type Checking: Helpers **********************************
|
-- ********************************** Type Checking: Helpers **********************************
|
||||||
|
|
||||||
|
isObjectType :: DataType -> Bool
|
||||||
|
isObjectType dt = dt /= "int" && dt /= "boolean" && dt /= "char"
|
||||||
|
|
||||||
getTypeFromExpr :: Expression -> DataType
|
getTypeFromExpr :: Expression -> DataType
|
||||||
getTypeFromExpr (TypedExpression t _) = t
|
getTypeFromExpr (TypedExpression t _) = t
|
||||||
getTypeFromExpr _ = error "Untyped expression found where typed was expected"
|
getTypeFromExpr _ = error "Untyped expression found where typed was expected"
|
||||||
|
Loading…
Reference in New Issue
Block a user