moved type check to its own file

project.cabal

@@ -12,7 +12,7 @@ executable compiler
     default-language:   Haskell2010
     hs-source-dirs:     src
     build-tool-depends: alex:alex, happy:happy
-    other-modules:      Parser.Lexer, Ast, Example
+    other-modules:      Parser.Lexer, Ast, Example, Typecheck
 
 test-suite tests
     type:               exitcode-stdio-1.0

src/Ast.hs

@@ -1,19 +1,12 @@
 module Ast where
 
-import Data.List (find)
-
 type CompilationUnit = [Class] 
-
 type DataType = 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)
-
 data MethodDeclaration = MethodDeclaration DataType Identifier [ParameterDeclaration] Statement deriving (Show)
 
 data Statement
@@ -68,290 +61,3 @@ data Expression
   | StatementExpressionExpression StatementExpression
   | TypedExpression DataType Expression
   deriving (Show)
-
-typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
-typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
-
-typeCheckClass :: Class -> [Class] -> Class
-typeCheckClass (Class className methods fields) classes =
-    let
-        -- Create a symbol table from class fields
-        classFields = [(id, dt) | VariableDeclaration dt id _ <- fields]
-        checkedMethods = map (\method -> typeCheckMethodDeclaration method classFields classes) methods
-    in Class className checkedMethods fields
-
-typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration
-typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFields classes =
-    let
-        -- Combine class fields with method parameters to form the initial symbol table for the method
-        methodParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params]
-        -- Ensure method parameters shadow class fields if names collide
-        initialSymtab = classFields ++ methodParams
-        -- Type check the body of the method using the combined symbol table
-        checkedBody = typeCheckStatement body initialSymtab classes
-        bodyType = getTypeFromStmt checkedBody
-        -- Check if the type of the body matches the declared return type
-    in if bodyType == retType || (bodyType == "void" && retType == "void")
-       then MethodDeclaration retType name params checkedBody
-       else error $ "Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType
-
--- ********************************** Type Checking: Expressions **********************************
-
-typeCheckExpression :: Expression -> [(Identifier, DataType)] -> [Class] -> Expression
-typeCheckExpression (IntegerLiteral i) _ _ = TypedExpression "int" (IntegerLiteral i)
-typeCheckExpression (CharacterLiteral c) _ _ = TypedExpression "char" (CharacterLiteral c)
-typeCheckExpression (BooleanLiteral b) _ _ = TypedExpression "boolean" (BooleanLiteral b)
-typeCheckExpression NullLiteral _ _ = TypedExpression "null" NullLiteral
-typeCheckExpression (Reference id) symtab classes =
-  let type' = lookupType id symtab
-   in TypedExpression type' (Reference id)
-typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
-  let expr1' = typeCheckExpression expr1 symtab classes
-      expr2' = typeCheckExpression expr2 symtab classes
-      type1 = getTypeFromExpr expr1'
-      type2 = getTypeFromExpr expr2'
-   in case op of
-        Addition ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "int" (BinaryOperation op expr1' expr2')
-            else
-              error "Addition operation requires two operands of type int"
-        Subtraction ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "int" (BinaryOperation op expr1' expr2')
-            else
-              error "Subtraction operation requires two operands of type int"
-        Multiplication ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "int" (BinaryOperation op expr1' expr2')
-            else
-              error "Multiplication operation requires two operands of type int"
-        Division ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "int" (BinaryOperation op expr1' expr2')
-            else
-              error "Division operation requires two operands of type int"
-        BitwiseAnd ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "int" (BinaryOperation op expr1' expr2')
-            else
-              error "Bitwise AND operation requires two operands of type int"
-        BitwiseOr ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "int" (BinaryOperation op expr1' expr2')
-            else
-              error "Bitwise OR operation requires two operands of type int"
-        BitwiseXor ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "int" (BinaryOperation op expr1' expr2')
-            else
-              error "Bitwise XOR operation requires two operands of type int"
-        CompareLessThan ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
-            else
-              error "Less than operation requires two operands of type int"
-        CompareLessOrEqual ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
-            else
-              error "Less than or equal operation requires two operands of type int"
-        CompareGreaterThan ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
-            else
-              error "Greater than operation requires two operands of type int"
-        CompareGreaterOrEqual ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
-            else
-              error "Greater than or equal operation requires two operands of type int"
-        CompareEqual ->
-          if type1 == type2
-            then
-              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
-            else
-              error "Equality operation requires two operands of the same type"
-        CompareNotEqual ->
-          if type1 == type2
-            then
-              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
-            else
-              error "Inequality operation requires two operands of the same type"
-        And ->
-          if type1 == "boolean" && type2 == "boolean"
-            then
-              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
-            else
-              error "Logical AND operation requires two operands of type boolean"
-        Or ->
-          if type1 == "boolean" && type2 == "boolean"
-            then
-              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
-            else
-              error "Logical OR operation requires two operands of type boolean"
-        NameResolution ->
-          case (expr1', expr2) of
-            (TypedExpression t1 (Reference obj), Reference member) ->
-                -- Lookup the class type of obj from the symbol table
-                let objectType = lookupType obj symtab
-                    classDetails = find (\(Class className _ _) -> className == objectType) classes
-                in case classDetails of
-                    Just (Class _ methods fields) ->
-                        -- Check both fields and methods to find a match for member
-                        let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == member]
-                            methodTypes = [dt | MethodDeclaration dt id _ _ <- methods, id == member]
-                        in case fieldTypes ++ methodTypes of
-                            [resolvedType] -> TypedExpression resolvedType (BinaryOperation op expr1' (TypedExpression resolvedType (Reference member)))
-                            [] -> error $ "Member '" ++ member ++ "' not found in class '" ++ objectType ++ "'"
-                            _ -> error $ "Ambiguous reference to '" ++ member ++ "' in class '" ++ objectType ++ "'"
-                    Nothing -> error $ "Object '" ++ obj ++ "' does not correspond to a known class"
-            _ -> error "Name resolution requires object reference and member name"
-
-typeCheckExpression (UnaryOperation op expr) symtab classes =
-  let expr' = typeCheckExpression expr symtab classes
-      type' = getTypeFromExpr expr'
-   in case op of
-        Not ->
-          if type' == "boolean"
-            then
-              TypedExpression "boolean" (UnaryOperation op expr')
-            else
-              error "Logical NOT operation requires an operand of type boolean"
-        Minus ->
-          if type' == "int"
-            then
-              TypedExpression "int" (UnaryOperation op expr')
-            else
-              error "Unary minus operation requires an operand of type int"
-
-typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
-  let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
-   in TypedExpression (getTypeFromStmtExpr stmtExpr') (StatementExpressionExpression stmtExpr')
-
--- ********************************** Type Checking: StatementExpressions **********************************
--- TODO: Implement type checking for StatementExpressions
-typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression
-typeCheckStatementExpression (Assignment id expr) symtab classes =
-  let expr' = typeCheckExpression expr symtab classes
-      type' = getTypeFromExpr expr'
-      type'' = lookupType id symtab
-   in if type' == type''
-        then
-          TypedStatementExpression type' (Assignment id expr')
-        else
-          error "Assignment type mismatch"
-
-typeCheckStatementExpression (ConstructorCall className args) symtab classes =
-  let args' = map (\arg -> typeCheckExpression arg symtab classes) args
-   in TypedStatementExpression className (ConstructorCall className args')
-
-typeCheckStatementExpression (MethodCall methodName args) symtab classes =
-  let args' = map (\arg -> typeCheckExpression arg symtab classes) args
-   in TypedStatementExpression "Object" (MethodCall methodName args')
-
--- ********************************** Type Checking: Statements **********************************
-
-typeCheckStatement :: Statement -> [(Identifier, DataType)] -> [Class] -> Statement
-typeCheckStatement (If cond thenStmt elseStmt) symtab classes =
-  let cond' = typeCheckExpression cond symtab classes
-      thenStmt' = typeCheckStatement thenStmt symtab classes
-      elseStmt' = case elseStmt of
-        Just stmt -> Just (typeCheckStatement stmt symtab classes)
-        Nothing   -> Nothing
-   in if getTypeFromExpr cond' == "boolean"
-        then
-          TypedStatement (getTypeFromStmt thenStmt') (If cond' thenStmt' elseStmt')
-        else
-          error "If condition must be of type boolean"
-
-typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)) symtab classes =
-    -- Check for redefinition in the current scope
-    if any ((== identifier) . snd) symtab
-    then error $ "Variable '" ++ identifier ++ "' is redefined in the same scope"
-    else
-        -- If there's an initializer expression, type check it
-        let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr
-            exprType = fmap getTypeFromExpr checkedExpr
-        in case exprType of
-            Just t | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
-            _ -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
-
-typeCheckStatement (While cond stmt) symtab classes =
-  let cond' = typeCheckExpression cond symtab classes
-      stmt' =  typeCheckStatement stmt symtab classes
-  in if getTypeFromExpr cond' == "boolean"
-       then
-         TypedStatement (getTypeFromStmt stmt') (While cond' stmt')
-       else
-         error "While condition must be of type boolean"
-
-typeCheckStatement (Block statements) symtab classes =
-    let
-        processStatements (accSts, currentSymtab, types) stmt =
-            let
-                checkedStmt = typeCheckStatement stmt currentSymtab classes
-                stmtType = getTypeFromStmt checkedStmt
-            in case stmt of
-                LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) ->
-                    let
-                        checkedExpr = fmap (\expr -> typeCheckExpression expr currentSymtab classes) maybeExpr
-                        newSymtab = (identifier, dataType) : currentSymtab
-                    in (accSts ++ [checkedStmt], newSymtab, types)
-
-                If {} -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
-                While _ _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
-                Return _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
-                _ -> (accSts ++ [checkedStmt], currentSymtab, types)
-
-        -- Initial accumulator: empty statements list, initial symbol table, empty types list
-        (checkedStatements, finalSymtab, collectedTypes) = foldl processStatements ([], symtab, []) statements
-
-        -- Determine the block's type: unify all collected types, default to "Void" if none
-        blockType = if null collectedTypes then "void" else foldl1 unifyReturnTypes collectedTypes
-
-    in TypedStatement blockType (Block checkedStatements)
-
-typeCheckStatement (Return expr) symtab classes =
-  let expr' = case expr of
-        Just e  -> Just (typeCheckExpression e symtab classes)
-        Nothing -> Nothing
-   in case expr' of
-        Just e' -> TypedStatement (getTypeFromExpr e') (Return (Just e'))
-        Nothing -> TypedStatement "Void" (Return Nothing)
-
--- ********************************** Type Checking: Helpers **********************************
-
-getTypeFromExpr :: Expression -> DataType
-getTypeFromExpr (TypedExpression t _) = t
-getTypeFromExpr _ = error "Untyped expression found where typed was expected"
-
-getTypeFromStmt :: Statement -> DataType
-getTypeFromStmt (TypedStatement t _) = t
-getTypeFromStmt _ = error "Untyped statement found where typed was expected"
-
-getTypeFromStmtExpr :: StatementExpression -> DataType
-getTypeFromStmtExpr (TypedStatementExpression t _) = t
-getTypeFromStmtExpr _ = error "Untyped statement expression found where typed was expected"
-
-unifyReturnTypes :: DataType -> DataType -> DataType
-unifyReturnTypes dt1 dt2
-    | dt1 == dt2 = dt1
-    | otherwise  = "Object"
-
-lookupType :: Identifier -> [(Identifier, DataType)] -> DataType
-lookupType id symtab =
-  case lookup id symtab of
-    Just t  -> t
-    Nothing -> error ("Identifier " ++ id ++ " not found in symbol table")

src/Example.hs

@@ -3,6 +3,7 @@ module Example where
 import Ast
 import Control.Exception (catch, evaluate, SomeException, displayException)
 import Control.Exception.Base
+import Typecheck
 
 -- Example classes and their methods and fields
 sampleClasses :: [Class]

src/Main.hs

@@ -1,9 +1,8 @@
 module Main where
 
-import Parser.Lexer
 import Example
+import Typecheck
 
 main = do
-    --print $ alexScanTokens "/**/"
     Example.runTypeCheck
     

src/Typecheck.hs

@@ -0,0 +1,290 @@
+module Typecheck where
+import Data.List (find)
+import Ast
+
+typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
+typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
+
+typeCheckClass :: Class -> [Class] -> Class
+typeCheckClass (Class className methods fields) classes =
+    let
+        -- Create a symbol table from class fields
+        classFields = [(id, dt) | VariableDeclaration dt id _ <- fields]
+        checkedMethods = map (\method -> typeCheckMethodDeclaration method classFields classes) methods
+    in Class className checkedMethods fields
+
+typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration
+typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFields classes =
+    let
+        -- Combine class fields with method parameters to form the initial symbol table for the method
+        methodParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params]
+        -- Ensure method parameters shadow class fields if names collide
+        initialSymtab = classFields ++ methodParams
+        -- Type check the body of the method using the combined symbol table
+        checkedBody = typeCheckStatement body initialSymtab classes
+        bodyType = getTypeFromStmt checkedBody
+        -- Check if the type of the body matches the declared return type
+    in if bodyType == retType || (bodyType == "void" && retType == "void")
+       then MethodDeclaration retType name params checkedBody
+       else error $ "Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType
+
+-- ********************************** Type Checking: Expressions **********************************
+
+typeCheckExpression :: Expression -> [(Identifier, DataType)] -> [Class] -> Expression
+typeCheckExpression (IntegerLiteral i) _ _ = TypedExpression "int" (IntegerLiteral i)
+typeCheckExpression (CharacterLiteral c) _ _ = TypedExpression "char" (CharacterLiteral c)
+typeCheckExpression (BooleanLiteral b) _ _ = TypedExpression "boolean" (BooleanLiteral b)
+typeCheckExpression NullLiteral _ _ = TypedExpression "null" NullLiteral
+typeCheckExpression (Reference id) symtab classes =
+  let type' = lookupType id symtab
+   in TypedExpression type' (Reference id)
+typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
+  let expr1' = typeCheckExpression expr1 symtab classes
+      expr2' = typeCheckExpression expr2 symtab classes
+      type1 = getTypeFromExpr expr1'
+      type2 = getTypeFromExpr expr2'
+   in case op of
+        Addition ->
+          if type1 == "int" && type2 == "int"
+            then
+              TypedExpression "int" (BinaryOperation op expr1' expr2')
+            else
+              error "Addition operation requires two operands of type int"
+        Subtraction ->
+          if type1 == "int" && type2 == "int"
+            then
+              TypedExpression "int" (BinaryOperation op expr1' expr2')
+            else
+              error "Subtraction operation requires two operands of type int"
+        Multiplication ->
+          if type1 == "int" && type2 == "int"
+            then
+              TypedExpression "int" (BinaryOperation op expr1' expr2')
+            else
+              error "Multiplication operation requires two operands of type int"
+        Division ->
+          if type1 == "int" && type2 == "int"
+            then
+              TypedExpression "int" (BinaryOperation op expr1' expr2')
+            else
+              error "Division operation requires two operands of type int"
+        BitwiseAnd ->
+          if type1 == "int" && type2 == "int"
+            then
+              TypedExpression "int" (BinaryOperation op expr1' expr2')
+            else
+              error "Bitwise AND operation requires two operands of type int"
+        BitwiseOr ->
+          if type1 == "int" && type2 == "int"
+            then
+              TypedExpression "int" (BinaryOperation op expr1' expr2')
+            else
+              error "Bitwise OR operation requires two operands of type int"
+        BitwiseXor ->
+          if type1 == "int" && type2 == "int"
+            then
+              TypedExpression "int" (BinaryOperation op expr1' expr2')
+            else
+              error "Bitwise XOR operation requires two operands of type int"
+        CompareLessThan ->
+          if type1 == "int" && type2 == "int"
+            then
+              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
+            else
+              error "Less than operation requires two operands of type int"
+        CompareLessOrEqual ->
+          if type1 == "int" && type2 == "int"
+            then
+              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
+            else
+              error "Less than or equal operation requires two operands of type int"
+        CompareGreaterThan ->
+          if type1 == "int" && type2 == "int"
+            then
+              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
+            else
+              error "Greater than operation requires two operands of type int"
+        CompareGreaterOrEqual ->
+          if type1 == "int" && type2 == "int"
+            then
+              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
+            else
+              error "Greater than or equal operation requires two operands of type int"
+        CompareEqual ->
+          if type1 == type2
+            then
+              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
+            else
+              error "Equality operation requires two operands of the same type"
+        CompareNotEqual ->
+          if type1 == type2
+            then
+              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
+            else
+              error "Inequality operation requires two operands of the same type"
+        And ->
+          if type1 == "boolean" && type2 == "boolean"
+            then
+              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
+            else
+              error "Logical AND operation requires two operands of type boolean"
+        Or ->
+          if type1 == "boolean" && type2 == "boolean"
+            then
+              TypedExpression "boolean" (BinaryOperation op expr1' expr2')
+            else
+              error "Logical OR operation requires two operands of type boolean"
+        NameResolution ->
+          case (expr1', expr2) of
+            (TypedExpression t1 (Reference obj), Reference member) ->
+                -- Lookup the class type of obj from the symbol table
+                let objectType = lookupType obj symtab
+                    classDetails = find (\(Class className _ _) -> className == objectType) classes
+                in case classDetails of
+                    Just (Class _ methods fields) ->
+                        -- Check both fields and methods to find a match for member
+                        let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == member]
+                            methodTypes = [dt | MethodDeclaration dt id _ _ <- methods, id == member]
+                        in case fieldTypes ++ methodTypes of
+                            [resolvedType] -> TypedExpression resolvedType (BinaryOperation op expr1' (TypedExpression resolvedType (Reference member)))
+                            [] -> error $ "Member '" ++ member ++ "' not found in class '" ++ objectType ++ "'"
+                            _ -> error $ "Ambiguous reference to '" ++ member ++ "' in class '" ++ objectType ++ "'"
+                    Nothing -> error $ "Object '" ++ obj ++ "' does not correspond to a known class"
+            _ -> error "Name resolution requires object reference and member name"
+
+typeCheckExpression (UnaryOperation op expr) symtab classes =
+  let expr' = typeCheckExpression expr symtab classes
+      type' = getTypeFromExpr expr'
+   in case op of
+        Not ->
+          if type' == "boolean"
+            then
+              TypedExpression "boolean" (UnaryOperation op expr')
+            else
+              error "Logical NOT operation requires an operand of type boolean"
+        Minus ->
+          if type' == "int"
+            then
+              TypedExpression "int" (UnaryOperation op expr')
+            else
+              error "Unary minus operation requires an operand of type int"
+
+typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
+  let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
+   in TypedExpression (getTypeFromStmtExpr stmtExpr') (StatementExpressionExpression stmtExpr')
+
+-- ********************************** Type Checking: StatementExpressions **********************************
+-- TODO: Implement type checking for StatementExpressions
+typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression
+typeCheckStatementExpression (Assignment id expr) symtab classes =
+  let expr' = typeCheckExpression expr symtab classes
+      type' = getTypeFromExpr expr'
+      type'' = lookupType id symtab
+   in if type' == type''
+        then
+          TypedStatementExpression type' (Assignment id expr')
+        else
+          error "Assignment type mismatch"
+
+typeCheckStatementExpression (ConstructorCall className args) symtab classes =
+  let args' = map (\arg -> typeCheckExpression arg symtab classes) args
+   in TypedStatementExpression className (ConstructorCall className args')
+
+typeCheckStatementExpression (MethodCall methodName args) symtab classes =
+  let args' = map (\arg -> typeCheckExpression arg symtab classes) args
+   in TypedStatementExpression "Object" (MethodCall methodName args')
+
+-- ********************************** Type Checking: Statements **********************************
+
+typeCheckStatement :: Statement -> [(Identifier, DataType)] -> [Class] -> Statement
+typeCheckStatement (If cond thenStmt elseStmt) symtab classes =
+  let cond' = typeCheckExpression cond symtab classes
+      thenStmt' = typeCheckStatement thenStmt symtab classes
+      elseStmt' = case elseStmt of
+        Just stmt -> Just (typeCheckStatement stmt symtab classes)
+        Nothing   -> Nothing
+   in if getTypeFromExpr cond' == "boolean"
+        then
+          TypedStatement (getTypeFromStmt thenStmt') (If cond' thenStmt' elseStmt')
+        else
+          error "If condition must be of type boolean"
+
+typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)) symtab classes =
+    -- Check for redefinition in the current scope
+    if any ((== identifier) . snd) symtab
+    then error $ "Variable '" ++ identifier ++ "' is redefined in the same scope"
+    else
+        -- If there's an initializer expression, type check it
+        let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr
+            exprType = fmap getTypeFromExpr checkedExpr
+        in case exprType of
+            Just t | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
+            _ -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
+
+typeCheckStatement (While cond stmt) symtab classes =
+  let cond' = typeCheckExpression cond symtab classes
+      stmt' =  typeCheckStatement stmt symtab classes
+  in if getTypeFromExpr cond' == "boolean"
+       then
+         TypedStatement (getTypeFromStmt stmt') (While cond' stmt')
+       else
+         error "While condition must be of type boolean"
+
+typeCheckStatement (Block statements) symtab classes =
+    let
+        processStatements (accSts, currentSymtab, types) stmt =
+            let
+                checkedStmt = typeCheckStatement stmt currentSymtab classes
+                stmtType = getTypeFromStmt checkedStmt
+            in case stmt of
+                LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) ->
+                    let
+                        checkedExpr = fmap (\expr -> typeCheckExpression expr currentSymtab classes) maybeExpr
+                        newSymtab = (identifier, dataType) : currentSymtab
+                    in (accSts ++ [checkedStmt], newSymtab, types)
+
+                If {} -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
+                While _ _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
+                Return _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
+                _ -> (accSts ++ [checkedStmt], currentSymtab, types)
+
+        -- Initial accumulator: empty statements list, initial symbol table, empty types list
+        (checkedStatements, finalSymtab, collectedTypes) = foldl processStatements ([], symtab, []) statements
+
+        -- Determine the block's type: unify all collected types, default to "Void" if none
+        blockType = if null collectedTypes then "void" else foldl1 unifyReturnTypes collectedTypes
+
+    in TypedStatement blockType (Block checkedStatements)
+
+typeCheckStatement (Return expr) symtab classes =
+  let expr' = case expr of
+        Just e  -> Just (typeCheckExpression e symtab classes)
+        Nothing -> Nothing
+   in case expr' of
+        Just e' -> TypedStatement (getTypeFromExpr e') (Return (Just e'))
+        Nothing -> TypedStatement "Void" (Return Nothing)
+
+-- ********************************** Type Checking: Helpers **********************************
+
+getTypeFromExpr :: Expression -> DataType
+getTypeFromExpr (TypedExpression t _) = t
+getTypeFromExpr _ = error "Untyped expression found where typed was expected"
+
+getTypeFromStmt :: Statement -> DataType
+getTypeFromStmt (TypedStatement t _) = t
+getTypeFromStmt _ = error "Untyped statement found where typed was expected"
+
+getTypeFromStmtExpr :: StatementExpression -> DataType
+getTypeFromStmtExpr (TypedStatementExpression t _) = t
+getTypeFromStmtExpr _ = error "Untyped statement expression found where typed was expected"
+
+unifyReturnTypes :: DataType -> DataType -> DataType
+unifyReturnTypes dt1 dt2
+    | dt1 == dt2 = dt1
+    | otherwise  = "Object"
+
+lookupType :: Identifier -> [(Identifier, DataType)] -> DataType
+lookupType id symtab =
+  case lookup id symtab of
+    Just t  -> t
+    Nothing -> error ("Identifier " ++ id ++ " not found in symbol table")