Add initial typechecker for AST #2
@ -101,24 +101,30 @@ 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))
|
||||||
|
|
||||||
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 +217,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 +232,17 @@ 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
|
||||||
|
|
||||||
|
@ -226,8 +226,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
|
||||||
@ -278,6 +282,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