apply pull and add tests

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

View File

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

View File

@ -1,19 +1,41 @@
module Example where module Example where
import Ast 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 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 -- 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 [])
] [ ] [
VariableDeclaration "Int" "age" (Just (IntegerLiteral 25)), VariableDeclaration "Int" "age" (Just (IntegerLiteral 25)),
VariableDeclaration "String" "name" (Just (CharacterLiteral 'A')) VariableDeclaration "String" "name" (Just (CharacterLiteral 'A'))
@ -24,17 +46,25 @@ sampleClasses = [
initialSymtab :: [(DataType, Identifier)] initialSymtab :: [(DataType, Identifier)]
initialSymtab = [] initialSymtab = []
-- An example block of statements to type check
exampleBlock :: Statement exampleBlock :: Statement
exampleBlock = Block [ exampleBlock = Block [
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [])))), 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" []))) Return (Just (StatementExpressionExpression (MethodCall "getAge" [])))
] ]
exampleExpression :: Expression exampleExpression :: Expression
exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age") 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 -- Function to perform type checking and handle errors
runTypeCheck :: IO () runTypeCheck :: IO ()
runTypeCheck = do runTypeCheck = do
@ -44,7 +74,31 @@ runTypeCheck = do
--print evaluatedBlock --print evaluatedBlock
-- Evaluate the expression -- Evaluate the expression
evaluatedExpression <- evaluate (typeCheckExpression exampleExpression [("bob", "Person"), ("age", "int")] sampleClasses) catch (do
putStrLn "Type checking of expression completed successfully:" print "====================================================================================="
print evaluatedExpression 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