added tests
This commit is contained in:
parent
8c3c3625b9
commit
d47c7f5a45
@ -1,10 +1,11 @@
|
||||
module Example where
|
||||
|
||||
import Ast
|
||||
import Typecheck
|
||||
import Control.Exception (catch, evaluate, SomeException, displayException)
|
||||
import Control.Exception.Base
|
||||
import System.IO (stderr, hPutStrLn)
|
||||
-- ANSI color codes
|
||||
|
||||
green, red, yellow, blue, magenta, cyan, white :: String -> String
|
||||
green str = "\x1b[32m" ++ 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"
|
||||
white str = "\x1b[37m" ++ str ++ "\x1b[0m"
|
||||
|
||||
-- Custom print function
|
||||
printSuccess :: String -> IO ()
|
||||
printSuccess msg = putStrLn $ green "Success:" ++ white msg
|
||||
|
||||
@ -26,33 +26,23 @@ printResult title result = do
|
||||
putStrLn $ green title
|
||||
print result
|
||||
|
||||
-- Example classes and their methods and fields
|
||||
sampleClasses :: [Class]
|
||||
sampleClasses = [
|
||||
Class "Person" [
|
||||
MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"]
|
||||
(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 [])
|
||||
] [
|
||||
VariableDeclaration "Int" "age" (Just (IntegerLiteral 25)),
|
||||
VariableDeclaration "String" "name" (Just (CharacterLiteral 'A'))
|
||||
VariableDeclaration "int" "age" (Just (IntegerLiteral 25))
|
||||
]
|
||||
]
|
||||
|
||||
-- Symbol table, mapping identifiers to their data types
|
||||
initialSymtab :: [(DataType, Identifier)]
|
||||
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 = BinaryOperation NameResolution (Reference "bob") (Reference "age")
|
||||
|
||||
@ -60,20 +50,30 @@ exampleAssignment :: Expression
|
||||
exampleAssignment = StatementExpressionExpression (Assignment "a" (IntegerLiteral 30))
|
||||
|
||||
exampleMethodCall :: Statement
|
||||
exampleMethodCall = StatementExpressionStatement (MethodCall "setAge" [IntegerLiteral 30])
|
||||
exampleMethodCall = StatementExpressionStatement (MethodCall (Reference "this") "setAge" [IntegerLiteral 30])
|
||||
|
||||
exampleConstructorCall :: Statement
|
||||
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 = 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
|
||||
print "====================================================================================="
|
||||
evaluatedExpression <- evaluate (typeCheckExpression exampleExpression [("bob", "Person")] sampleClasses)
|
||||
@ -102,3 +102,24 @@ runTypeCheck = do
|
||||
printResult "Result Constructor Call:" evaluatedConstructorCall
|
||||
) 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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user