Merge branch 'typedAST' of https://gitea.hb.dhbw-stuttgart.de/MisterChaos69/MiniJavaCompiler into bytecode
This commit is contained in:
Matthias Raba
commit
25dd0802ad
267
src/Example.hs
267
src/Example.hs
@ -1,267 +0,0 @@
|
|||||||
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
|
|
||||||
@ -10,10 +10,14 @@ typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
|
|||||||
typeCheckClass :: Class -> [Class] -> Class
|
typeCheckClass :: Class -> [Class] -> Class
|
||||||
typeCheckClass (Class className constructors methods fields) classes =
|
typeCheckClass (Class className constructors methods fields) classes =
|
||||||
let
|
let
|
||||||
|
-- Add a default constructor if none are present
|
||||||
|
defaultConstructor = ConstructorDeclaration className [] (Block [])
|
||||||
|
constructorsWithDefault = if null constructors then [defaultConstructor] else constructors
|
||||||
|
|
||||||
-- Fields and methods dont need to be added to the symtab because they are looked upon automatically under "this"
|
-- Fields and methods dont need to be added to the symtab because they are looked upon automatically under "this"
|
||||||
-- if its not a declared local variable. Also shadowing wouldnt be possible then.
|
-- if its not a declared local variable. Also shadowing wouldnt be possible then.
|
||||||
initalSymTab = [("this", className)]
|
initalSymTab = [("this", className)]
|
||||||
checkedConstructors = map (\constructor -> typeCheckConstructorDeclaration constructor initalSymTab classes) constructors
|
checkedConstructors = map (\constructor -> typeCheckConstructorDeclaration constructor initalSymTab classes) constructorsWithDefault
|
||||||
checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods
|
checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods
|
||||||
checkedFields = map (\field -> typeCheckVariableDeclaration field initalSymTab classes) fields
|
checkedFields = map (\field -> typeCheckVariableDeclaration field initalSymTab classes) fields
|
||||||
in Class className checkedConstructors checkedMethods checkedFields
|
in Class className checkedConstructors checkedMethods checkedFields
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user