added tests

This commit is contained in:

View File

@ -1,10 +1,11 @@
module Example where module Example where
import Ast
import Typecheck import Typecheck
import Control.Exception (catch, evaluate, SomeException, displayException) import Control.Exception (catch, evaluate, SomeException, displayException)
import Control.Exception.Base import Control.Exception.Base
import System.IO (stderr, hPutStrLn) import System.IO (stderr, hPutStrLn)
-- ANSI color codes
green, red, yellow, blue, magenta, cyan, white :: String -> String green, red, yellow, blue, magenta, cyan, white :: String -> String
green str = "\x1b[32m" ++ str ++ "\x1b[0m" green str = "\x1b[32m" ++ str ++ "\x1b[0m"
red str = "\x1b[31m" ++ str ++ "\x1b[0m" red str = "\x1b[31m" ++ str ++ "\x1b[0m"
@ -14,7 +15,6 @@ magenta str = "\x1b[35m" ++ str ++ "\x1b[0m"
cyan str = "\x1b[36m" ++ str ++ "\x1b[0m" cyan str = "\x1b[36m" ++ str ++ "\x1b[0m"
white str = "\x1b[37m" ++ str ++ "\x1b[0m" white str = "\x1b[37m" ++ str ++ "\x1b[0m"
-- Custom print function
printSuccess :: String -> IO () printSuccess :: String -> IO ()
printSuccess msg = putStrLn $ green "Success:" ++ white msg printSuccess msg = putStrLn $ green "Success:" ++ white msg
@ -26,33 +26,23 @@ printResult title result = do
putStrLn $ green title putStrLn $ green title
print result print result
-- Example classes and their methods and fields
sampleClasses :: [Class] sampleClasses :: [Class]
sampleClasses = [ sampleClasses = [
Class "Person" [ Class "Person" [
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" [] (Return (Just (Reference "age"))), MethodDeclaration "int" "getAge" [] (Return (Just (Reference "age"))),
MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] (Block []) MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] (Block [])
] [ ] [
VariableDeclaration "Int" "age" (Just (IntegerLiteral 25)), VariableDeclaration "int" "age" (Just (IntegerLiteral 25))
VariableDeclaration "String" "name" (Just (CharacterLiteral 'A'))
] ]
] ]
-- Symbol table, mapping identifiers to their data types
initialSymtab :: [(DataType, Identifier)] initialSymtab :: [(DataType, Identifier)]
initialSymtab = [] initialSymtab = []
exampleBlock :: Statement
exampleBlock = Block [
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [])))),
BinaryOperation NameResolution (Reference "bob") (StatementExpressionExpression (MethodCall "setAge" [IntegerLiteral 30])),
Return (Just (StatementExpressionExpression (MethodCall "getAge" [])))
]
exampleExpression :: Expression exampleExpression :: Expression
exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age") exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age")
@ -60,20 +50,30 @@ exampleAssignment :: Expression
exampleAssignment = StatementExpressionExpression (Assignment "a" (IntegerLiteral 30)) exampleAssignment = StatementExpressionExpression (Assignment "a" (IntegerLiteral 30))
exampleMethodCall :: Statement exampleMethodCall :: Statement
exampleMethodCall = StatementExpressionStatement (MethodCall "setAge" [IntegerLiteral 30]) exampleMethodCall = StatementExpressionStatement (MethodCall (Reference "this") "setAge" [IntegerLiteral 30])
exampleConstructorCall :: Statement exampleConstructorCall :: Statement
exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))) exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30]))))
-- Function to perform type checking and handle errors exampleNameResolution :: Expression
exampleNameResolution = BinaryOperation NameResolution (Reference "b") (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])
]
runTypeCheck :: IO () runTypeCheck :: IO ()
runTypeCheck = do runTypeCheck = do
-- Evaluate the block of statements
--evaluatedBlock <- evaluate (typeCheckStatement exampleBlock initialSymtab sampleClasses)
--putStrLn "Type checking of block completed successfully:"
--print evaluatedBlock
-- Evaluate the expression
catch (do catch (do
print "=====================================================================================" print "====================================================================================="
evaluatedExpression <- evaluate (typeCheckExpression exampleExpression [("bob", "Person")] sampleClasses) evaluatedExpression <- evaluate (typeCheckExpression exampleExpression [("bob", "Person")] sampleClasses)
@ -102,3 +102,24 @@ runTypeCheck = do
printResult "Result Constructor Call:" evaluatedConstructorCall printResult "Result Constructor Call:" evaluatedConstructorCall
) handleError ) handleError
catch (do
print "====================================================================================="
evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("b", "Person")] sampleClasses)
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