src/Example.hs

@@ -101,24 +101,33 @@ exampleNameResolutionAssignment = Block [
 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)
+
 testClasses :: [Class]
 testClasses = [
     Class "Person" [
-        MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] 
+        MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"]
         (Block [
             Return (Just (Reference "this"))
         ]),
-        MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"] 
+        MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"]
         (Block [
             LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge")))
         ]),
-        MethodDeclaration "int" "getAge" [] 
+        MethodDeclaration "int" "getAge" []
         (Return (Just (Reference "age")))
     ] [
         VariableDeclaration "int" "age" Nothing  -- initially unassigned
     ],
     Class "Main" [
-        MethodDeclaration "int" "main" [] 
+        MethodDeclaration "int" "main" []
         (Block [
             LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 25])))),
             StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
@@ -211,7 +220,7 @@ runTypeCheck = do
         printSuccess "Type checking of Program completed successfully"
         printResult "Typed Program:" typedProgram
         ) handleError
-    
+
     catch (do
         print "====================================================================================="
         typedAssignment <- evaluate (typeCheckStatement exampleNameResolutionAssignment [] sampleClasses)
@@ -226,3 +235,23 @@ runTypeCheck = do
         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

src/Typecheck.hs

@@ -146,11 +146,11 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes =
       ref' = typeCheckExpression ref symtab classes
       type' = getTypeFromExpr expr'
       type'' = getTypeFromExpr ref'
-    in
-      if type'' == type' then
-        TypedStatementExpression type' (Assignment ref' expr')
-      else
-        error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type'
+  in
+    if type'' == type' || (type' == "null" && isObjectType type'') then
+      TypedStatementExpression type'' (Assignment ref' expr')
+    else
+      error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type'
 
 typeCheckStatementExpression (ConstructorCall className args) symtab classes =
   case find (\(Class name _ _) -> name == className) classes of
@@ -226,8 +226,12 @@ typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType ident
         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))
+            Just t
+                | t == "null" && isObjectType dataType -> 
+                    TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
+                | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
+                | otherwise -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
+            Nothing -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
 
 typeCheckStatement (While cond stmt) symtab classes =
   let cond' = typeCheckExpression cond symtab classes
@@ -278,6 +282,9 @@ typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes =
 
 -- ********************************** Type Checking: Helpers **********************************
 
+isObjectType :: DataType -> Bool
+isObjectType dt = dt /= "int" && dt /= "boolean" && dt /= "char"
+
 getTypeFromExpr :: Expression -> DataType
 getTypeFromExpr (TypedExpression t _) = t
 getTypeFromExpr _ = error "Untyped expression found where typed was expected"