diff --git a/src/Example.hs b/src/Example.hs deleted file mode 100644 index 03ff209..0000000 --- a/src/Example.hs +++ /dev/null @@ -1,267 +0,0 @@ -module Example where - -import Ast -import Typecheck -import Control.Exception (catch, evaluate, SomeException, displayException) -import Control.Exception.Base -import System.IO (stderr, hPutStrLn) -import Data.Maybe -import Data.List - -green, red, yellow, blue, magenta, cyan, white :: String -> String -green str = "\x1b[32m" ++ str ++ "\x1b[0m" -red str = "\x1b[31m" ++ str ++ "\x1b[0m" -yellow str = "\x1b[33m" ++ str ++ "\x1b[0m" -blue str = "\x1b[34m" ++ str ++ "\x1b[0m" -magenta str = "\x1b[35m" ++ str ++ "\x1b[0m" -cyan str = "\x1b[36m" ++ str ++ "\x1b[0m" -white str = "\x1b[37m" ++ str ++ "\x1b[0m" - -printSuccess :: String -> IO () -printSuccess msg = putStrLn $ green "Success:" ++ white msg - -handleError :: SomeException -> IO () -handleError e = hPutStrLn stderr $ red ("Error: " ++ displayException e) - -printResult :: Show a => String -> a -> IO () -printResult title result = do - putStrLn $ green title - print result - -sampleClasses :: [Class] -sampleClasses = [ - Class "Person" [ - MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"] - (Block [ - LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge"))) - ]), - MethodDeclaration "int" "getAge" [] (Return (Just (Reference "age"))), - MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] (Block []) - ] [ - VariableDeclaration "int" "age" (Just (IntegerLiteral 25)) - ] - ] - -initialSymtab :: [(DataType, Identifier)] -initialSymtab = [] - -exampleExpression :: Expression -exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age") - -exampleAssignment :: Expression -exampleAssignment = StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 30)) - -exampleMethodCall :: Statement -exampleMethodCall = StatementExpressionStatement (MethodCall (Reference "this") "setAge" [IntegerLiteral 30]) - -exampleConstructorCall :: Statement -exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))) - -exampleNameResolution :: Expression -exampleNameResolution = BinaryOperation NameResolution (Reference "bob2") (Reference "age") - -exampleBlockResolution :: Statement -exampleBlockResolution = Block [ - LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))), - LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))), - StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]) - ] - -exampleBlockResolutionFail :: Statement -exampleBlockResolutionFail = Block [ - LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))), - LocalVariableDeclaration (VariableDeclaration "bool" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))), - StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]) - ] - -exampleMethodCallAndAssignment :: Statement -exampleMethodCallAndAssignment = Block [ - LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))), - LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))), - StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]), - LocalVariableDeclaration (VariableDeclaration "int" "a" Nothing), - StatementExpressionStatement (Assignment (Reference "a") (Reference "age")) - ] - - -exampleMethodCallAndAssignmentFail :: Statement -exampleMethodCallAndAssignmentFail = Block [ - LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))), - LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))), - StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]), - 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) - -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 "Person" [ - MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] - (Block [ - Return (Just (Reference "this")) - ]), - MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"] - (Block [ - LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge"))) - ]), - MethodDeclaration "int" "getAge" [] - (Return (Just (Reference "age"))) - ] [ - VariableDeclaration "int" "age" Nothing -- initially unassigned - ], - Class "Main" [ - MethodDeclaration "int" "main" [] - (Block [ - LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 25])))), - StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]), - LocalVariableDeclaration (VariableDeclaration "int" "bobAge" (Just (StatementExpressionExpression (MethodCall (Reference "bob2") "getAge" [])))), - Return (Just (Reference "bobAge")) - ]) - ] [ - VariableDeclaration "Person" "bob2" Nothing - ] - ] - -runTypeCheck :: IO () -runTypeCheck = do - catch (do - print "=====================================================================================" - evaluatedExpression <- evaluate (typeCheckExpression exampleExpression [("bob", "Person")] sampleClasses) - printSuccess "Type checking of expression completed successfully" - printResult "Result Expression:" evaluatedExpression - ) handleError - - catch (do - print "=====================================================================================" - evaluatedAssignment <- evaluate (typeCheckExpression exampleAssignment [("a", "int")] sampleClasses) - printSuccess "Type checking of assignment completed successfully" - printResult "Result Assignment:" evaluatedAssignment - ) handleError - - catch (do - print "=====================================================================================" - evaluatedMethodCall <- evaluate (typeCheckStatement exampleMethodCall [("this", "Person"), ("setAge", "Person"), ("getAge", "Person")] sampleClasses) - printSuccess "Type checking of method call this completed successfully" - printResult "Result MethodCall:" evaluatedMethodCall - ) handleError - - catch (do - print "=====================================================================================" - evaluatedConstructorCall <- evaluate (typeCheckStatement exampleConstructorCall [] sampleClasses) - printSuccess "Type checking of constructor call completed successfully" - printResult "Result Constructor Call:" evaluatedConstructorCall - ) handleError - - catch (do - print "=====================================================================================" - evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("this", "Main")] testClasses) - printSuccess "Type checking of name resolution completed successfully" - printResult "Result Name Resolution:" evaluatedNameResolution - ) handleError - - catch (do - print "=====================================================================================" - evaluatedBlockResolution <- evaluate (typeCheckStatement exampleBlockResolution [] sampleClasses) - printSuccess "Type checking of block resolution completed successfully" - printResult "Result Block Resolution:" evaluatedBlockResolution - ) handleError - - catch (do - print "=====================================================================================" - evaluatedBlockResolutionFail <- evaluate (typeCheckStatement exampleBlockResolutionFail [] sampleClasses) - printSuccess "Type checking of block resolution failed" - printResult "Result Block Resolution:" evaluatedBlockResolutionFail - ) handleError - - catch (do - print "=====================================================================================" - evaluatedMethodCallAndAssignment <- evaluate (typeCheckStatement exampleMethodCallAndAssignment [] sampleClasses) - printSuccess "Type checking of method call and assignment completed successfully" - printResult "Result Method Call and Assignment:" evaluatedMethodCallAndAssignment - ) handleError - - catch (do - print "=====================================================================================" - evaluatedMethodCallAndAssignmentFail <- evaluate (typeCheckStatement exampleMethodCallAndAssignmentFail [] sampleClasses) - printSuccess "Type checking of method call and assignment failed" - printResult "Result Method Call and Assignment:" evaluatedMethodCallAndAssignmentFail - ) handleError - - catch (do - print "=====================================================================================" - let mainClass = fromJust $ find (\(Class className _ _) -> className == "Main") testClasses - case mainClass of - Class _ [mainMethod] _ -> do - let result = typeCheckMethodDeclaration mainMethod [("this", "Main")] testClasses - printSuccess "Full program type checking completed successfully." - printResult "Main method result:" result - ) handleError - - catch (do - print "=====================================================================================" - let typedProgram = typeCheckCompilationUnit testClasses - printSuccess "Type checking of Program completed successfully" - printResult "Typed Program:" typedProgram - ) 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 - - 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 diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 889ba6b..fe0588f 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -10,10 +10,14 @@ typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes typeCheckClass :: Class -> [Class] -> Class typeCheckClass (Class className constructors methods fields) classes = let + -- Add a default constructor if none are present + defaultConstructor = ConstructorDeclaration className [] (Block []) + constructorsWithDefault = if null constructors then [defaultConstructor] else constructors + -- Fields and methods dont need to be added to the symtab because they are looked upon automatically under "this" -- if its not a declared local variable. Also shadowing wouldnt be possible then. initalSymTab = [("this", className)] - checkedConstructors = map (\constructor -> typeCheckConstructorDeclaration constructor initalSymTab classes) constructors + checkedConstructors = map (\constructor -> typeCheckConstructorDeclaration constructor initalSymTab classes) constructorsWithDefault checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods checkedFields = map (\field -> typeCheckVariableDeclaration field initalSymTab classes) fields in Class className checkedConstructors checkedMethods checkedFields