src/Example.hs

@@ -98,6 +98,9 @@ exampleNameResolutionAssignment = Block [
     StatementExpressionStatement (Assignment (BinaryOperation NameResolution (Reference "bob") (Reference "age")) (IntegerLiteral 30))
     ]
 
+exampleCharIntOperation :: Expression
+exampleCharIntOperation = BinaryOperation Addition (CharacterLiteral 'a') (IntegerLiteral 1)
+
 testClasses :: [Class]
 testClasses = [
     Class "Person" [
@@ -216,3 +219,10 @@ runTypeCheck = do
         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
+

src/Typecheck.hs

@@ -52,129 +52,31 @@ typeCheckExpression (Reference id) symtab classes =
                 _ -> error $ "Ambiguous reference to field '" ++ id ++ "' in class '" ++ className ++ "'"
             Nothing -> error $ "Class '" ++ className ++ "' not found for 'this'"
         Nothing -> error $ "Context for 'this' not found in symbol table, unable to resolve '" ++ 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'
+      resultType = resolveResultType type1 type2
    in case op of
-        Addition ->
+        Addition -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType
-          if type1 == "int" && type2 == "int"
+        Subtraction -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType
-            then
+        Multiplication -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType
-              TypedExpression "int" (BinaryOperation op expr1' expr2')
+        Division -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType
-            else
+        Modulo -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType
-              error "Addition operation requires two operands of type int"
+        BitwiseAnd -> checkBitwiseOperation op expr1' expr2' type1 type2
-        Subtraction ->
+        BitwiseOr -> checkBitwiseOperation op expr1' expr2' type1 type2
-          if type1 == "int" && type2 == "int"
+        BitwiseXor -> checkBitwiseOperation op expr1' expr2' type1 type2
-            then
+        CompareLessThan -> checkComparisonOperation op expr1' expr2' type1 type2
-              TypedExpression "int" (BinaryOperation op expr1' expr2')
+        CompareLessOrEqual -> checkComparisonOperation op expr1' expr2' type1 type2
-            else
+        CompareGreaterThan -> checkComparisonOperation op expr1' expr2' type1 type2
-              error "Subtraction operation requires two operands of type int"
+        CompareGreaterOrEqual -> checkComparisonOperation op expr1' expr2' type1 type2
-        Multiplication ->
+        CompareEqual -> checkEqualityOperation op expr1' expr2' type1 type2
-          if type1 == "int" && type2 == "int"
+        CompareNotEqual -> checkEqualityOperation op expr1' expr2' type1 type2
-            then
+        And -> checkLogicalOperation op expr1' expr2' type1 type2
-              TypedExpression "int" (BinaryOperation op expr1' expr2')
+        Or -> checkLogicalOperation op expr1' expr2' type1 type2
-            else
+        NameResolution -> resolveNameResolution expr1' expr2 symtab classes
-              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"
-        Modulo ->
-          if type1 == "int" && type2 == "int"
-            then
-              TypedExpression "int" (BinaryOperation op expr1' expr2')
-            else
-              error "Modulus 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 objType (LocalVariable ident), Reference ident2) ->
-              case find (\(Class className _ _) -> className == objType) classes of
-                Just (Class _ _ fields) ->
-                  let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2]
-                  in case fieldTypes of
-                    [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable  ident2)))
-                    [] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'"
-                    _ -> error $ "Ambiguous reference to field '" ++ ident ++ "' in class '" ++ objType ++ "'"
-                Nothing -> error $ "Class '" ++ objType ++ "' not found"
-            (TypedExpression objType (FieldVariable ident), Reference ident2) ->
-              case find (\(Class className _ _) -> className == objType) classes of
-                Just (Class _ _ fields) ->
-                  let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2]
-                  in case fieldTypes of
-                    [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable  ident2)))
-                    [] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'"
-                    _ -> error $ "Ambiguous reference to field '" ++ ident ++ "' in class '" ++ objType ++ "'"
-                Nothing -> error $ "Class '" ++ objType ++ "' not found"
-            _ -> error "Name resolution requires object reference and field name"
 
 typeCheckExpression (UnaryOperation op expr) symtab classes =
   let expr' = typeCheckExpression expr symtab classes
@@ -190,8 +92,47 @@ typeCheckExpression (UnaryOperation op expr) symtab classes =
           if type' == "int" 
             then
               TypedExpression "int" (UnaryOperation op expr')
+          else if type' == "char" 
+            then
+              TypedExpression "char" (UnaryOperation op expr')
             else
-              error "Unary minus operation requires an operand of type int"
+              error "Unary minus operation requires an operand of type int or char"
+        PostIncrement ->
+          if type' == "int"
+            then
+              TypedExpression "int" (UnaryOperation op expr')
+          else if type' == "char"
+            then
+              TypedExpression "char" (UnaryOperation op expr')
+            else
+              error "Post-increment operation requires an operand of type int or char"
+        PostDecrement ->
+          if type' == "int"
+            then
+              TypedExpression "int" (UnaryOperation op expr')
+          else if type' == "char"
+            then
+              TypedExpression "char" (UnaryOperation op expr')
+            else
+              error "Post-decrement operation requires an operand of type int or char"
+        PreIncrement ->
+          if type' == "int"
+            then
+              TypedExpression "int" (UnaryOperation op expr')
+          else if type' == "char"
+            then
+              TypedExpression "char" (UnaryOperation op expr')
+            else
+              error "Pre-increment operation requires an operand of type int or char"
+        PreDecrement ->
+          if type' == "int"
+            then
+              TypedExpression "int" (UnaryOperation op expr')
+          else if type' == "char"
+            then
+              TypedExpression "char" (UnaryOperation op expr')
+            else
+              error "Pre-decrement operation requires an operand of type int or char"
 
 typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
   let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
@@ -329,7 +270,7 @@ typeCheckStatement (Return expr) symtab classes =
         Nothing -> Nothing
    in case expr' of
         Just e' -> TypedStatement (getTypeFromExpr e') (Return (Just e'))
-        Nothing -> TypedStatement "Void" (Return Nothing)
+        Nothing -> TypedStatement "void" (Return Nothing)
 
 typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes =
   let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
@@ -359,3 +300,56 @@ lookupType id symtab =
   case lookup id symtab of
     Just t  -> Just t
     Nothing -> Nothing
+
+resolveResultType :: DataType -> DataType -> DataType
+resolveResultType "char" "char" = "char"
+resolveResultType "int" "int" = "int"
+resolveResultType "char" "int" = "int"
+resolveResultType "int" "char" = "int"
+resolveResultType t1 t2
+  | t1 == t2 = t1
+  | otherwise = error $ "Incompatible types: " ++ t1 ++ " and " ++ t2
+
+checkArithmeticOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> DataType -> Expression
+checkArithmeticOperation op expr1' expr2' type1 type2 resultType
+  | (type1 == "int" || type1 == "char") && (type2 == "int" || type2 == "char") =
+      TypedExpression resultType (BinaryOperation op expr1' expr2')
+  | otherwise = error $ "Arithmetic operation " ++ show op ++ " requires operands of type int or char"
+
+checkBitwiseOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression
+checkBitwiseOperation op expr1' expr2' type1 type2
+  | type1 == "int" && type2 == "int" =
+      TypedExpression "int" (BinaryOperation op expr1' expr2')
+  | otherwise = error $ "Bitwise operation " ++ show op ++ " requires operands of type int"
+
+checkComparisonOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression
+checkComparisonOperation op expr1' expr2' type1 type2
+  | (type1 == "int" || type1 == "char") && (type2 == "int" || type2 == "char") =
+      TypedExpression "boolean" (BinaryOperation op expr1' expr2')
+  | otherwise = error $ "Comparison operation " ++ show op ++ " requires operands of type int or char"
+
+checkEqualityOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression
+checkEqualityOperation op expr1' expr2' type1 type2
+  | type1 == type2 =
+      TypedExpression "boolean" (BinaryOperation op expr1' expr2')
+  | otherwise = error $ "Equality operation " ++ show op ++ " requires operands of the same type"
+
+checkLogicalOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression
+checkLogicalOperation op expr1' expr2' type1 type2
+  | type1 == "boolean" && type2 == "boolean" =
+      TypedExpression "boolean" (BinaryOperation op expr1' expr2')
+  | otherwise = error $ "Logical operation " ++ show op ++ " requires operands of type boolean"
+
+resolveNameResolution :: Expression -> Expression -> [(Identifier, DataType)] -> [Class] -> Expression
+resolveNameResolution expr1' (Reference ident2) symtab classes =
+  case getTypeFromExpr expr1' of
+    objType ->
+      case find (\(Class className _ _) -> className == objType) classes of
+        Just (Class _ _ fields) ->
+          let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2]
+          in case fieldTypes of
+            [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2)))
+            [] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'"
+            _ -> error $ "Ambiguous reference to field '" ++ ident2 ++ "' in class '" ++ objType ++ "'"
+        Nothing -> error $ "Class '" ++ objType ++ "' not found"
+resolveNameResolution _ _ _ _ = error "Name resolution requires object reference and field name"