apply pull and add tests

This commit is contained in:
2 changed files with 65 additions and 12 deletions

View File

@ -1,9 +1,8 @@
module Ast where
type CompilationUnit = [Class]
type CompilationUnit = [Class]
type DataType = String
type Identifier = String
type Identifier = String
data ParameterDeclaration = ParameterDeclaration DataType Identifier deriving (Show)
data VariableDeclaration = VariableDeclaration DataType Identifier (Maybe Expression) deriving (Show)
data Class = Class DataType [MethodDeclaration] [VariableDeclaration] deriving (Show)

View File

@ -1,19 +1,41 @@
module Example where
import Ast
import Typecheck
import Control.Exception (catch, evaluate, SomeException, displayException)
import Control.Exception.Base
import Typecheck
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"
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"
-- Custom print function
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
-- Example classes and their methods and fields
sampleClasses :: [Class]
sampleClasses = [
Class "Person" [
MethodDeclaration "void" "setAge" [ParameterDeclaration "Int" "newAge"]
MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"]
(Block [
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'))
@ -24,17 +46,25 @@ sampleClasses = [
initialSymtab :: [(DataType, Identifier)]
initialSymtab = []
-- An example block of statements to type check
exampleBlock :: Statement
exampleBlock = Block [
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [])))),
StatementExpressionStatement (MethodCall "setAge" [IntegerLiteral 30]),
BinaryOperation NameResolution (Reference "bob") (StatementExpressionExpression (MethodCall "setAge" [IntegerLiteral 30])),
Return (Just (StatementExpressionExpression (MethodCall "getAge" [])))
]
exampleExpression :: Expression
exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age")
exampleAssignment :: Expression
exampleAssignment = StatementExpressionExpression (Assignment "a" (IntegerLiteral 30))
exampleMethodCall :: Statement
exampleMethodCall = StatementExpressionStatement (MethodCall "setAge" [IntegerLiteral 30])
exampleConstructorCall :: Statement
exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30]))))
-- Function to perform type checking and handle errors
runTypeCheck :: IO ()
runTypeCheck = do
@ -44,7 +74,31 @@ runTypeCheck = do
--print evaluatedBlock
-- Evaluate the expression
evaluatedExpression <- evaluate (typeCheckExpression exampleExpression [("bob", "Person"), ("age", "int")] sampleClasses)
putStrLn "Type checking of expression completed successfully:"
print evaluatedExpression
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