158 lines
7.9 KiB
Haskell
158 lines
7.9 KiB
Haskell
module Example where
|
|
|
|
import Ast
|
|
import Typecheck
|
|
import Control.Exception (catch, evaluate, SomeException, displayException)
|
|
import Control.Exception.Base
|
|
import System.IO (stderr, hPutStrLn)
|
|
|
|
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 "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 "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])
|
|
]
|
|
|
|
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 "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 "a" (Reference "age"))
|
|
]
|
|
|
|
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 [("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
|
|
|
|
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
|
|
|