MiniJavaCompiler/src/Example.hs

module Example where

import Ast
import Typecheck
import Control.Exception (catch, evaluate, SomeException, displayException)
import Control.Exception.Base
import System.IO (stderr, hPutStrLn)
import Data.Maybe
import Data.List

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 (Reference "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 "bob2") (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 (Reference "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 (Reference "a") (Reference "age"))
    ]

exampleNameResolutionAssignment :: Statement
exampleNameResolutionAssignment = Block [
    LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression  (ConstructorCall "Person" [IntegerLiteral 30])))),
    StatementExpressionStatement (Assignment (BinaryOperation NameResolution (Reference "bob") (Reference "age")) (IntegerLiteral 30))
    ]

exampleCharIntOperation :: Expression
exampleCharIntOperation = BinaryOperation Addition (CharacterLiteral 'a') (IntegerLiteral 1)

exampleNullDeclaration :: Statement
exampleNullDeclaration = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just NullLiteral))

exampleNullDeclarationFail :: Statement
exampleNullDeclarationFail = LocalVariableDeclaration (VariableDeclaration "int" "a" (Just NullLiteral))

exampleNullAssignment :: Statement
exampleNullAssignment = StatementExpressionStatement (Assignment (Reference "a") NullLiteral)

exampleIncrement :: Statement
exampleIncrement = StatementExpressionStatement (PostIncrement (Reference "a"))

testClasses :: [Class]
testClasses = [
    Class "Person" [
        MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"]
        (Block [
            Return (Just (Reference "this"))
        ]),
        MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"]
        (Block [
            LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge")))
        ]),
        MethodDeclaration "int" "getAge" []
        (Return (Just (Reference "age")))
    ] [
        VariableDeclaration "int" "age" Nothing  -- initially unassigned
    ],
    Class "Main" [
        MethodDeclaration "int" "main" []
        (Block [
            LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 25])))),
            StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
            LocalVariableDeclaration (VariableDeclaration "int" "bobAge" (Just (StatementExpressionExpression (MethodCall (Reference "bob2") "getAge" [])))),
            Return (Just (Reference "bobAge"))
        ])
    ] [
        VariableDeclaration "Person" "bob2" Nothing
    ]
 ]

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 [("this", "Main")] testClasses)
        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

    catch (do
        print "====================================================================================="
        let mainClass = fromJust $ find (\(Class className _ _) -> className == "Main") testClasses
        case mainClass of
            Class _ [mainMethod] _ -> do
                let result = typeCheckMethodDeclaration mainMethod [("this", "Main")] testClasses
                printSuccess "Full program type checking completed successfully."
                printResult "Main method result:" result
      ) handleError

    catch (do
        print "====================================================================================="
        let typedProgram = typeCheckCompilationUnit testClasses
        printSuccess "Type checking of Program completed successfully"
        printResult "Typed Program:" typedProgram
        ) handleError

    catch (do
        print "====================================================================================="
        typedAssignment <- evaluate (typeCheckStatement exampleNameResolutionAssignment [] sampleClasses)
        printSuccess "Type checking of name resolution assignment completed successfully"
        printResult "Result Name Resolution Assignment:" typedAssignment
        ) handleError

    catch (do
        print "====================================================================================="
        evaluatedCharIntOperation <- evaluate (typeCheckExpression exampleCharIntOperation [] sampleClasses)
        printSuccess "Type checking of char int operation completed successfully"
        printResult "Result Char Int Operation:" evaluatedCharIntOperation
        ) handleError

    catch (do
        print "====================================================================================="
        evaluatedNullDeclaration <- evaluate (typeCheckStatement exampleNullDeclaration [] sampleClasses)
        printSuccess "Type checking of null declaration completed successfully"
        printResult "Result Null Declaration:" evaluatedNullDeclaration
        ) handleError

    catch (do
        print "====================================================================================="
        evaluatedNullDeclarationFail <- evaluate (typeCheckStatement exampleNullDeclarationFail [] sampleClasses)
        printSuccess "Type checking of null declaration failed"
        printResult "Result Null Declaration:" evaluatedNullDeclarationFail
        ) handleError

    catch (do
        print "====================================================================================="
        evaluatedNullAssignment <- evaluate (typeCheckStatement exampleNullAssignment [("a", "Person")] sampleClasses)
        printSuccess "Type checking of null assignment completed successfully"
        printResult "Result Null Assignment:" evaluatedNullAssignment
        ) handleError

    catch (do
        print "====================================================================================="
        evaluatedIncrement <- evaluate (typeCheckStatement exampleIncrement [("a", "int")] sampleClasses)
        printSuccess "Type checking of increment completed successfully"
        printResult "Result Increment:" evaluatedIncrement
        ) handleError