Add initial typechecker for AST #2
@ -50,23 +50,23 @@ testClassWithMethodAndField = TestCase $
|
|||||||
assertEqual "expect class with method and field" [Class "WithMethodAndField" [MethodDeclaration "void" "foo" [] (Block []), MethodDeclaration "int" "bar" [] (Block [])] [VariableDeclaration "int" "value" Nothing]] $
|
assertEqual "expect class with method and field" [Class "WithMethodAndField" [MethodDeclaration "void" "foo" [] (Block []), MethodDeclaration "int" "bar" [] (Block [])] [VariableDeclaration "int" "value" Nothing]] $
|
||||||
parse [CLASS,IDENTIFIER "WithMethodAndField",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,INT,IDENTIFIER "value",SEMICOLON,INT,IDENTIFIER "bar",LBRACE,RBRACE,SEMICOLON,RBRACKET]
|
parse [CLASS,IDENTIFIER "WithMethodAndField",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,INT,IDENTIFIER "value",SEMICOLON,INT,IDENTIFIER "bar",LBRACE,RBRACE,SEMICOLON,RBRACKET]
|
||||||
testClassWithConstructor = TestCase $
|
testClassWithConstructor = TestCase $
|
||||||
assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "WithConstructor" "<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]
|
||||||
|
|
||||||
|
|
||||||
testEmptyBlock = TestCase $ assertEqual "expect empty block" (Block []) $ parseBlock [LBRACKET,RBRACKET]
|
testEmptyBlock = TestCase $ assertEqual "expect empty block" [Block []] $ parseStatement [LBRACKET,RBRACKET]
|
||||||
testBlockWithLocalVarDecl = TestCase $
|
testBlockWithLocalVarDecl = TestCase $
|
||||||
assertEqual "expect block with local var delcaration" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "localvar" Nothing]) $
|
assertEqual "expect block with local var delcaration" [Block [LocalVariableDeclaration $ VariableDeclaration "int" "localvar" Nothing]] $
|
||||||
parseBlock [LBRACKET,INT,IDENTIFIER "localvar",SEMICOLON,RBRACKET]
|
parseStatement [LBRACKET,INT,IDENTIFIER "localvar",SEMICOLON,RBRACKET]
|
||||||
testBlockWithMultipleLocalVarDecls = TestCase $
|
testBlockWithMultipleLocalVarDecls = TestCase $
|
||||||
assertEqual "expect block with multiple local var declarations" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "var1" Nothing, LocalVariableDeclaration $ VariableDeclaration "boolean" "var2" Nothing]) $
|
assertEqual "expect block with multiple local var declarations" [Block [LocalVariableDeclaration $ VariableDeclaration "int" "var1" Nothing, LocalVariableDeclaration $ VariableDeclaration "boolean" "var2" Nothing]] $
|
||||||
parseBlock [LBRACKET,INT,IDENTIFIER "var1",SEMICOLON,BOOLEAN,IDENTIFIER "var2",SEMICOLON,RBRACKET]
|
parseStatement [LBRACKET,INT,IDENTIFIER "var1",SEMICOLON,BOOLEAN,IDENTIFIER "var2",SEMICOLON,RBRACKET]
|
||||||
testNestedBlocks = TestCase $
|
testNestedBlocks = TestCase $
|
||||||
assertEqual "expect block with block inside" (Block [Block []]) $
|
assertEqual "expect block with block inside" [Block [Block []]] $
|
||||||
parseBlock [LBRACKET,LBRACKET,RBRACKET,RBRACKET]
|
parseStatement [LBRACKET,LBRACKET,RBRACKET,RBRACKET]
|
||||||
testBlockWithEmptyStatement = TestCase $
|
testBlockWithEmptyStatement = TestCase $
|
||||||
assertEqual "expect empty block" (Block []) $
|
assertEqual "expect empty block" [Block []] $
|
||||||
parseBlock [LBRACKET,SEMICOLON,SEMICOLON,RBRACKET]
|
parseStatement [LBRACKET,SEMICOLON,SEMICOLON,RBRACKET]
|
||||||
|
|
||||||
testExpressionIntLiteral = TestCase $
|
testExpressionIntLiteral = TestCase $
|
||||||
assertEqual "expect IntLiteral" (IntegerLiteral 3) $
|
assertEqual "expect IntLiteral" (IntegerLiteral 3) $
|
||||||
@ -75,14 +75,14 @@ testFieldWithInitialization = TestCase $
|
|||||||
assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "int" "number" $ Just $ IntegerLiteral 3]] $
|
assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "int" "number" $ Just $ IntegerLiteral 3]] $
|
||||||
parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,INT,IDENTIFIER "number",ASSIGN,INTEGERLITERAL 3,SEMICOLON,RBRACKET]
|
parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,INT,IDENTIFIER "number",ASSIGN,INTEGERLITERAL 3,SEMICOLON,RBRACKET]
|
||||||
testLocalBoolWithInitialization = TestCase $
|
testLocalBoolWithInitialization = TestCase $
|
||||||
assertEqual "expect block with with initialized local var" (Block [LocalVariableDeclaration $ VariableDeclaration "boolean" "b" $ Just $ BooleanLiteral False]) $
|
assertEqual "expect block with with initialized local var" [Block [LocalVariableDeclaration $ VariableDeclaration "boolean" "b" $ Just $ BooleanLiteral False]] $
|
||||||
parseBlock [LBRACKET,BOOLEAN,IDENTIFIER "b",ASSIGN,BOOLLITERAL False,SEMICOLON,RBRACKET]
|
parseStatement [LBRACKET,BOOLEAN,IDENTIFIER "b",ASSIGN,BOOLLITERAL False,SEMICOLON,RBRACKET]
|
||||||
testFieldNullWithInitialization = TestCase $
|
testFieldNullWithInitialization = TestCase $
|
||||||
assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "Object" "bar" $ Just NullLiteral]] $
|
assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "Object" "bar" $ Just NullLiteral]] $
|
||||||
parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,IDENTIFIER "Object",IDENTIFIER "bar",ASSIGN,NULLLITERAL,SEMICOLON,RBRACKET]
|
parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,IDENTIFIER "Object",IDENTIFIER "bar",ASSIGN,NULLLITERAL,SEMICOLON,RBRACKET]
|
||||||
testReturnVoid = TestCase $
|
testReturnVoid = TestCase $
|
||||||
assertEqual "expect block with return nothing" (Block [Return Nothing]) $
|
assertEqual "expect block with return nothing" [Block [Return Nothing]] $
|
||||||
parseBlock [LBRACKET,RETURN,SEMICOLON,RBRACKET]
|
parseStatement [LBRACKET,RETURN,SEMICOLON,RBRACKET]
|
||||||
|
|
||||||
testExpressionNot = TestCase $
|
testExpressionNot = TestCase $
|
||||||
assertEqual "expect expression not" (UnaryOperation Not (Reference "boar")) $
|
assertEqual "expect expression not" (UnaryOperation Not (Reference "boar")) $
|
||||||
@ -132,6 +132,18 @@ testExpressionXor = TestCase $
|
|||||||
testExpressionOr = TestCase $
|
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 $
|
||||||
|
assertEqual "expect PostIncrement" (UnaryOperation PostIncrement (Reference "a")) $
|
||||||
|
parseExpression [IDENTIFIER "a",INCREMENT]
|
||||||
|
testExpressionPostDecrement = TestCase $
|
||||||
|
assertEqual "expect PostDecrement" (UnaryOperation PostDecrement (Reference "a")) $
|
||||||
|
parseExpression [IDENTIFIER "a",DECREMENT]
|
||||||
|
testExpressionPreIncrement = TestCase $
|
||||||
|
assertEqual "expect PreIncrement" (UnaryOperation PreIncrement (Reference "a")) $
|
||||||
|
parseExpression [INCREMENT,IDENTIFIER "a"]
|
||||||
|
testExpressionPreDecrement = TestCase $
|
||||||
|
assertEqual "expect PreIncrement" (UnaryOperation PreDecrement (Reference "a")) $
|
||||||
|
parseExpression [DECREMENT,IDENTIFIER "a"]
|
||||||
|
|
||||||
|
|
||||||
tests = TestList [
|
tests = TestList [
|
||||||
@ -169,5 +181,9 @@ tests = TestList [
|
|||||||
testExpressionNotEqual,
|
testExpressionNotEqual,
|
||||||
testExpressionAnd,
|
testExpressionAnd,
|
||||||
testExpressionXor,
|
testExpressionXor,
|
||||||
testExpressionOr
|
testExpressionOr,
|
||||||
|
testExpressionPostIncrement,
|
||||||
|
testExpressionPostDecrement,
|
||||||
|
testExpressionPreIncrement,
|
||||||
|
testExpressionPreDecrement
|
||||||
]
|
]
|
@ -20,7 +20,7 @@ data Statement
|
|||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data StatementExpression
|
data StatementExpression
|
||||||
= Assignment Identifier Expression
|
= Assignment Expression Expression
|
||||||
| ConstructorCall DataType [Expression]
|
| ConstructorCall DataType [Expression]
|
||||||
| MethodCall Expression Identifier [Expression]
|
| MethodCall Expression Identifier [Expression]
|
||||||
| TypedStatementExpression DataType StatementExpression
|
| TypedStatementExpression DataType StatementExpression
|
||||||
@ -49,6 +49,10 @@ data BinaryOperator
|
|||||||
data UnaryOperator
|
data UnaryOperator
|
||||||
= Not
|
= Not
|
||||||
| Minus
|
| Minus
|
||||||
|
| PostIncrement
|
||||||
|
| PostDecrement
|
||||||
|
| PreIncrement
|
||||||
|
| PreDecrement
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data Expression
|
data Expression
|
||||||
|
@ -49,7 +49,7 @@ exampleExpression :: Expression
|
|||||||
exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age")
|
exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age")
|
||||||
|
|
||||||
exampleAssignment :: Expression
|
exampleAssignment :: Expression
|
||||||
exampleAssignment = StatementExpressionExpression (Assignment "a" (IntegerLiteral 30))
|
exampleAssignment = StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 30))
|
||||||
|
|
||||||
exampleMethodCall :: Statement
|
exampleMethodCall :: Statement
|
||||||
exampleMethodCall = StatementExpressionStatement (MethodCall (Reference "this") "setAge" [IntegerLiteral 30])
|
exampleMethodCall = StatementExpressionStatement (MethodCall (Reference "this") "setAge" [IntegerLiteral 30])
|
||||||
@ -58,7 +58,7 @@ exampleConstructorCall :: Statement
|
|||||||
exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30]))))
|
exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30]))))
|
||||||
|
|
||||||
exampleNameResolution :: Expression
|
exampleNameResolution :: Expression
|
||||||
exampleNameResolution = BinaryOperation NameResolution (Reference "b") (Reference "age")
|
exampleNameResolution = BinaryOperation NameResolution (Reference "bob2") (Reference "age")
|
||||||
|
|
||||||
exampleBlockResolution :: Statement
|
exampleBlockResolution :: Statement
|
||||||
exampleBlockResolution = Block [
|
exampleBlockResolution = Block [
|
||||||
@ -80,7 +80,7 @@ exampleMethodCallAndAssignment = Block [
|
|||||||
LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
|
LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
|
||||||
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
|
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
|
||||||
LocalVariableDeclaration (VariableDeclaration "int" "a" Nothing),
|
LocalVariableDeclaration (VariableDeclaration "int" "a" Nothing),
|
||||||
StatementExpressionStatement (Assignment "a" (Reference "age"))
|
StatementExpressionStatement (Assignment (Reference "a") (Reference "age"))
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
@ -89,9 +89,18 @@ exampleMethodCallAndAssignmentFail = Block [
|
|||||||
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))),
|
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))),
|
||||||
LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
|
LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
|
||||||
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
|
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
|
||||||
StatementExpressionStatement (Assignment "a" (Reference "age"))
|
StatementExpressionStatement (Assignment (Reference "a") (Reference "age"))
|
||||||
]
|
]
|
||||||
|
|
||||||
|
exampleNameResolutionAssignment :: Statement
|
||||||
|
exampleNameResolutionAssignment = Block [
|
||||||
|
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))),
|
||||||
|
StatementExpressionStatement (Assignment (BinaryOperation NameResolution (Reference "bob") (Reference "age")) (IntegerLiteral 30))
|
||||||
|
]
|
||||||
|
|
||||||
|
exampleCharIntOperation :: Expression
|
||||||
|
exampleCharIntOperation = BinaryOperation Addition (CharacterLiteral 'a') (IntegerLiteral 1)
|
||||||
|
|
||||||
testClasses :: [Class]
|
testClasses :: [Class]
|
||||||
testClasses = [
|
testClasses = [
|
||||||
Class "Person" [
|
Class "Person" [
|
||||||
@ -113,10 +122,12 @@ testClasses = [
|
|||||||
(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]),
|
||||||
LocalVariableDeclaration (VariableDeclaration "int" "bobAge" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
|
LocalVariableDeclaration (VariableDeclaration "int" "bobAge" (Just (StatementExpressionExpression (MethodCall (Reference "bob2") "getAge" [])))),
|
||||||
Return (Just (Reference "bobAge"))
|
Return (Just (Reference "bobAge"))
|
||||||
])
|
])
|
||||||
] []
|
] [
|
||||||
|
VariableDeclaration "Person" "bob2" Nothing
|
||||||
|
]
|
||||||
]
|
]
|
||||||
|
|
||||||
runTypeCheck :: IO ()
|
runTypeCheck :: IO ()
|
||||||
@ -151,7 +162,7 @@ runTypeCheck = do
|
|||||||
|
|
||||||
catch (do
|
catch (do
|
||||||
print "====================================================================================="
|
print "====================================================================================="
|
||||||
evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("b", "Person")] sampleClasses)
|
evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("this", "Main")] testClasses)
|
||||||
printSuccess "Type checking of name resolution completed successfully"
|
printSuccess "Type checking of name resolution completed successfully"
|
||||||
printResult "Result Name Resolution:" evaluatedNameResolution
|
printResult "Result Name Resolution:" evaluatedNameResolution
|
||||||
) handleError
|
) handleError
|
||||||
@ -189,7 +200,7 @@ runTypeCheck = do
|
|||||||
let mainClass = fromJust $ find (\(Class className _ _) -> className == "Main") testClasses
|
let mainClass = fromJust $ find (\(Class className _ _) -> className == "Main") testClasses
|
||||||
case mainClass of
|
case mainClass of
|
||||||
Class _ [mainMethod] _ -> do
|
Class _ [mainMethod] _ -> do
|
||||||
let result = typeCheckMethodDeclaration mainMethod [] testClasses
|
let result = typeCheckMethodDeclaration mainMethod [("this", "Main")] testClasses
|
||||||
printSuccess "Full program type checking completed successfully."
|
printSuccess "Full program type checking completed successfully."
|
||||||
printResult "Main method result:" result
|
printResult "Main method result:" result
|
||||||
) handleError
|
) handleError
|
||||||
@ -201,3 +212,17 @@ runTypeCheck = do
|
|||||||
printResult "Typed Program:" typedProgram
|
printResult "Typed Program:" typedProgram
|
||||||
) handleError
|
) handleError
|
||||||
|
|
||||||
|
catch (do
|
||||||
|
print "====================================================================================="
|
||||||
|
typedAssignment <- evaluate (typeCheckStatement exampleNameResolutionAssignment [] sampleClasses)
|
||||||
|
printSuccess "Type checking of name resolution assignment completed successfully"
|
||||||
|
printResult "Result Name Resolution Assignment:" typedAssignment
|
||||||
|
) handleError
|
||||||
|
|
||||||
|
catch (do
|
||||||
|
print "====================================================================================="
|
||||||
|
evaluatedCharIntOperation <- evaluate (typeCheckExpression exampleCharIntOperation [] sampleClasses)
|
||||||
|
printSuccess "Type checking of char int operation completed successfully"
|
||||||
|
printResult "Result Char Int Operation:" evaluatedCharIntOperation
|
||||||
|
) handleError
|
||||||
|
|
||||||
|
@ -1,11 +1,11 @@
|
|||||||
{
|
{
|
||||||
module Parser.JavaParser (parse, parseBlock, parseExpression) where
|
module Parser.JavaParser (parse, parseStatement, parseExpression) where
|
||||||
import Ast
|
import Ast
|
||||||
import Parser.Lexer
|
import Parser.Lexer
|
||||||
}
|
}
|
||||||
|
|
||||||
%name parse
|
%name parse
|
||||||
%name parseBlock block
|
%name parseStatement statement
|
||||||
%name parseExpression expression
|
%name parseExpression expression
|
||||||
%tokentype { Token }
|
%tokentype { Token }
|
||||||
%error { parseError }
|
%error { parseError }
|
||||||
@ -127,8 +127,8 @@ classorinterfacetype : name { $1 }
|
|||||||
classmemberdeclaration : fielddeclaration { $1 }
|
classmemberdeclaration : fielddeclaration { $1 }
|
||||||
| methoddeclaration { $1 }
|
| methoddeclaration { $1 }
|
||||||
|
|
||||||
constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration classname "<init>" parameters $2 }
|
constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "<init>" parameters $2 }
|
||||||
| modifiers constructordeclarator constructorbody { case $2 of (classname, parameters) -> MethodDecl $ MethodDeclaration classname "<init>" parameters $3 }
|
| modifiers constructordeclarator constructorbody { case $2 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "<init>" parameters $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 }
|
||||||
@ -275,13 +275,13 @@ assignmentoperator : ASSIGN{ }
|
|||||||
-- | XOREQUAL { }
|
-- | XOREQUAL { }
|
||||||
-- | OREQUAL{ }
|
-- | OREQUAL{ }
|
||||||
|
|
||||||
preincrementexpression : INCREMENT unaryexpression { }
|
preincrementexpression : INCREMENT unaryexpression { UnaryOperation PreIncrement $2 }
|
||||||
|
|
||||||
predecrementexpression : DECREMENT unaryexpression { }
|
predecrementexpression : DECREMENT unaryexpression { UnaryOperation PreDecrement $2 }
|
||||||
|
|
||||||
postincrementexpression : postfixexpression INCREMENT { }
|
postincrementexpression : postfixexpression INCREMENT { UnaryOperation PostIncrement $1 }
|
||||||
|
|
||||||
postdecrementexpression : postfixexpression DECREMENT { }
|
postdecrementexpression : postfixexpression DECREMENT { UnaryOperation PostDecrement $1 }
|
||||||
|
|
||||||
methodinvocation : name LBRACE RBRACE { }
|
methodinvocation : name LBRACE RBRACE { }
|
||||||
| name LBRACE argumentlist RBRACE { }
|
| name LBRACE argumentlist RBRACE { }
|
||||||
@ -296,15 +296,15 @@ conditionalandexpression : inclusiveorexpression { $1 }
|
|||||||
fieldaccess : primary DOT IDENTIFIER { }
|
fieldaccess : primary DOT IDENTIFIER { }
|
||||||
|
|
||||||
unaryexpression : unaryexpressionnotplusminus { $1 }
|
unaryexpression : unaryexpressionnotplusminus { $1 }
|
||||||
-- | predecrementexpression { }
|
| predecrementexpression { $1 }
|
||||||
| PLUS unaryexpression { $2 }
|
| PLUS unaryexpression { $2 }
|
||||||
| MINUS unaryexpression { UnaryOperation Minus $2 }
|
| MINUS unaryexpression { UnaryOperation Minus $2 }
|
||||||
-- | preincrementexpression { $1 }
|
| preincrementexpression { $1 }
|
||||||
|
|
||||||
postfixexpression : primary { $1 }
|
postfixexpression : primary { $1 }
|
||||||
| name { Reference $1 }
|
| name { Reference $1 }
|
||||||
-- | postincrementexpression { }
|
| postincrementexpression { $1 }
|
||||||
-- | postdecrementexpression{ }
|
| postdecrementexpression{ $1 }
|
||||||
|
|
||||||
primary : primarynonewarray { $1 }
|
primary : primarynonewarray { $1 }
|
||||||
|
|
||||||
|
257
src/Typecheck.hs
257
src/Typecheck.hs
@ -10,9 +10,9 @@ typeCheckClass :: Class -> [Class] -> Class
|
|||||||
typeCheckClass (Class className methods fields) classes =
|
typeCheckClass (Class className methods fields) classes =
|
||||||
let
|
let
|
||||||
-- Create a symbol table from class fields and method entries
|
-- 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]
|
methodEntries = [(methodName, className) | MethodDeclaration _ methodName _ _ <- methods]
|
||||||
initalSymTab = ("this", className) : classFields ++ methodEntries
|
initalSymTab = ("this", className) : methodEntries
|
||||||
checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods
|
checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods
|
||||||
in Class className checkedMethods fields
|
in Class className checkedMethods fields
|
||||||
|
|
||||||
@ -37,118 +37,46 @@ 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 =
|
||||||
let type' = lookupType id symtab
|
case lookup id symtab of
|
||||||
in TypedExpression type' (Reference id)
|
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 =
|
typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
|
||||||
let expr1' = typeCheckExpression expr1 symtab classes
|
let expr1' = typeCheckExpression expr1 symtab classes
|
||||||
expr2' = typeCheckExpression expr2 symtab classes
|
expr2' = typeCheckExpression expr2 symtab classes
|
||||||
type1 = getTypeFromExpr expr1'
|
type1 = getTypeFromExpr expr1'
|
||||||
type2 = getTypeFromExpr expr2'
|
type2 = getTypeFromExpr expr2'
|
||||||
|
resultType = resolveResultType type1 type2
|
||||||
in case op of
|
in case op of
|
||||||
Addition ->
|
Addition -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType
|
||||||
if type1 == "int" && type2 == "int"
|
Subtraction -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType
|
||||||
then
|
Multiplication -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType
|
||||||
TypedExpression "int" (BinaryOperation op expr1' expr2')
|
Division -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType
|
||||||
else
|
Modulo -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType
|
||||||
error "Addition operation requires two operands of type int"
|
BitwiseAnd -> checkBitwiseOperation op expr1' expr2' type1 type2
|
||||||
Subtraction ->
|
BitwiseOr -> checkBitwiseOperation op expr1' expr2' type1 type2
|
||||||
if type1 == "int" && type2 == "int"
|
BitwiseXor -> checkBitwiseOperation op expr1' expr2' type1 type2
|
||||||
then
|
CompareLessThan -> checkComparisonOperation op expr1' expr2' type1 type2
|
||||||
TypedExpression "int" (BinaryOperation op expr1' expr2')
|
CompareLessOrEqual -> checkComparisonOperation op expr1' expr2' type1 type2
|
||||||
else
|
CompareGreaterThan -> checkComparisonOperation op expr1' expr2' type1 type2
|
||||||
error "Subtraction operation requires two operands of type int"
|
CompareGreaterOrEqual -> checkComparisonOperation op expr1' expr2' type1 type2
|
||||||
Multiplication ->
|
CompareEqual -> checkEqualityOperation op expr1' expr2' type1 type2
|
||||||
if type1 == "int" && type2 == "int"
|
CompareNotEqual -> checkEqualityOperation op expr1' expr2' type1 type2
|
||||||
then
|
And -> checkLogicalOperation op expr1' expr2' type1 type2
|
||||||
TypedExpression "int" (BinaryOperation op expr1' expr2')
|
Or -> checkLogicalOperation op expr1' expr2' type1 type2
|
||||||
else
|
NameResolution -> resolveNameResolution expr1' expr2 symtab classes
|
||||||
error "Multiplication operation requires two operands of type int"
|
|
||||||
Division ->
|
|
||||||
if type1 == "int" && type2 == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "int" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
error "Division operation requires two operands of type int"
|
|
||||||
BitwiseAnd ->
|
|
||||||
if type1 == "int" && type2 == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "int" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
error "Bitwise AND operation requires two operands of type int"
|
|
||||||
BitwiseOr ->
|
|
||||||
if type1 == "int" && type2 == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "int" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
error "Bitwise OR operation requires two operands of type int"
|
|
||||||
BitwiseXor ->
|
|
||||||
if type1 == "int" && type2 == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "int" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
error "Bitwise XOR operation requires two operands of type int"
|
|
||||||
CompareLessThan ->
|
|
||||||
if type1 == "int" && type2 == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
error "Less than operation requires two operands of type int"
|
|
||||||
CompareLessOrEqual ->
|
|
||||||
if type1 == "int" && type2 == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
error "Less than or equal operation requires two operands of type int"
|
|
||||||
CompareGreaterThan ->
|
|
||||||
if type1 == "int" && type2 == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
error "Greater than operation requires two operands of type int"
|
|
||||||
CompareGreaterOrEqual ->
|
|
||||||
if type1 == "int" && type2 == "int"
|
|
||||||
then
|
|
||||||
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
error "Greater than or equal operation requires two operands of type int"
|
|
||||||
CompareEqual ->
|
|
||||||
if type1 == type2
|
|
||||||
then
|
|
||||||
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
error "Equality operation requires two operands of the same type"
|
|
||||||
CompareNotEqual ->
|
|
||||||
if type1 == type2
|
|
||||||
then
|
|
||||||
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
error "Inequality operation requires two operands of the same type"
|
|
||||||
And ->
|
|
||||||
if type1 == "boolean" && type2 == "boolean"
|
|
||||||
then
|
|
||||||
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
error "Logical AND operation requires two operands of type boolean"
|
|
||||||
Or ->
|
|
||||||
if type1 == "boolean" && type2 == "boolean"
|
|
||||||
then
|
|
||||||
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
|
||||||
else
|
|
||||||
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"
|
|
||||||
|
|
||||||
typeCheckExpression (UnaryOperation op expr) symtab classes =
|
typeCheckExpression (UnaryOperation op expr) symtab classes =
|
||||||
let expr' = typeCheckExpression expr symtab classes
|
let expr' = typeCheckExpression expr symtab classes
|
||||||
@ -164,8 +92,47 @@ typeCheckExpression (UnaryOperation op expr) symtab classes =
|
|||||||
if type' == "int"
|
if type' == "int"
|
||||||
then
|
then
|
||||||
TypedExpression "int" (UnaryOperation op expr')
|
TypedExpression "int" (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"
|
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
|
||||||
@ -174,15 +141,16 @@ typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
|
|||||||
-- ********************************** Type Checking: StatementExpressions **********************************
|
-- ********************************** Type Checking: StatementExpressions **********************************
|
||||||
|
|
||||||
typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression
|
typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression
|
||||||
typeCheckStatementExpression (Assignment id expr) symtab classes =
|
typeCheckStatementExpression (Assignment ref expr) symtab classes =
|
||||||
let expr' = typeCheckExpression expr symtab classes
|
let expr' = typeCheckExpression expr symtab classes
|
||||||
|
ref' = typeCheckExpression ref symtab classes
|
||||||
type' = getTypeFromExpr expr'
|
type' = getTypeFromExpr expr'
|
||||||
type'' = lookupType id symtab
|
type'' = getTypeFromExpr ref'
|
||||||
in if type' == type''
|
in
|
||||||
then
|
if type'' == type' then
|
||||||
TypedStatementExpression type' (Assignment id expr')
|
TypedStatementExpression type' (Assignment ref' expr')
|
||||||
else
|
else
|
||||||
error "Assignment type mismatch"
|
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
|
||||||
@ -327,8 +295,55 @@ unifyReturnTypes dt1 dt2
|
|||||||
| dt1 == dt2 = dt1
|
| dt1 == dt2 = dt1
|
||||||
| otherwise = "Object"
|
| otherwise = "Object"
|
||||||
|
|
||||||
lookupType :: Identifier -> [(Identifier, DataType)] -> DataType
|
resolveResultType :: DataType -> DataType -> DataType
|
||||||
lookupType id symtab =
|
resolveResultType "char" "char" = "char"
|
||||||
case lookup id symtab of
|
resolveResultType "int" "int" = "int"
|
||||||
Just t -> t
|
resolveResultType "char" "int" = "int"
|
||||||
Nothing -> error ("Identifier " ++ id ++ " not found in symbol table")
|
resolveResultType "int" "char" = "int"
|
||||||
|
resolveResultType t1 t2
|
||||||
|
| t1 == t2 = t1
|
||||||
|
| otherwise = error $ "Incompatible types: " ++ t1 ++ " and " ++ t2
|
||||||
|
|
||||||
|
checkArithmeticOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> DataType -> Expression
|
||||||
|
checkArithmeticOperation op expr1' expr2' type1 type2 resultType
|
||||||
|
| (type1 == "int" || type1 == "char") && (type2 == "int" || type2 == "char") =
|
||||||
|
TypedExpression resultType (BinaryOperation op expr1' expr2')
|
||||||
|
| otherwise = error $ "Arithmetic operation " ++ show op ++ " requires operands of type int or char"
|
||||||
|
|
||||||
|
checkBitwiseOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression
|
||||||
|
checkBitwiseOperation op expr1' expr2' type1 type2
|
||||||
|
| type1 == "int" && type2 == "int" =
|
||||||
|
TypedExpression "int" (BinaryOperation op expr1' expr2')
|
||||||
|
| otherwise = error $ "Bitwise operation " ++ show op ++ " requires operands of type int"
|
||||||
|
|
||||||
|
checkComparisonOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression
|
||||||
|
checkComparisonOperation op expr1' expr2' type1 type2
|
||||||
|
| (type1 == "int" || type1 == "char") && (type2 == "int" || type2 == "char") =
|
||||||
|
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
||||||
|
| otherwise = error $ "Comparison operation " ++ show op ++ " requires operands of type int or char"
|
||||||
|
|
||||||
|
checkEqualityOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression
|
||||||
|
checkEqualityOperation op expr1' expr2' type1 type2
|
||||||
|
| type1 == type2 =
|
||||||
|
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
||||||
|
| otherwise = error $ "Equality operation " ++ show op ++ " requires operands of the same type"
|
||||||
|
|
||||||
|
checkLogicalOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression
|
||||||
|
checkLogicalOperation op expr1' expr2' type1 type2
|
||||||
|
| type1 == "boolean" && type2 == "boolean" =
|
||||||
|
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
||||||
|
| otherwise = error $ "Logical operation " ++ show op ++ " requires operands of type boolean"
|
||||||
|
|
||||||
|
resolveNameResolution :: Expression -> Expression -> [(Identifier, DataType)] -> [Class] -> Expression
|
||||||
|
resolveNameResolution expr1' (Reference ident2) symtab classes =
|
||||||
|
case getTypeFromExpr expr1' of
|
||||||
|
objType ->
|
||||||
|
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 '" ++ ident2 ++ "' in class '" ++ objType ++ "'"
|
||||||
|
Nothing -> error $ "Class '" ++ objType ++ "' not found"
|
||||||
|
resolveNameResolution _ _ _ _ = error "Name resolution requires object reference and field name"
|
||||||
|
Loading…
Reference in New Issue
Block a user