From 62c9c126ed3eedf981cc087938fd98f7afb17506 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Thu, 20 Jul 2017 20:40:38 +0000
Subject: Check the type of the main function (should be Void)

---
 Sil/Check.dcl   |  6 ++++--
 Sil/Check.icl   | 27 +++++++++++++++++++++------
 Sil/Compile.icl |  2 +-
 Sil/Types.dcl   |  4 +++-
 Sil/Types.icl   |  3 +++
 5 files changed, 32 insertions(+), 10 deletions(-)

(limited to 'Sil')

diff --git a/Sil/Check.dcl b/Sil/Check.dcl
index e71448f..a34eb99 100644
--- a/Sil/Check.dcl
+++ b/Sil/Check.dcl
@@ -5,13 +5,15 @@ from StdOverloaded import class toString
 from Data.Maybe import :: Maybe
 
 from Sil.Syntax import :: Program, :: Name
+from Sil.Types import :: Type
 
 :: CheckError
 	= NoMainFunction
+	| MainFunctionInvalidType Type
 	| DuplicateFunctionName Name
 	| DuplicateLocalName Name Name
-	| ReturnExpressionFromVoidError Name
-	| NoReturnFromNonVoidError Name
+	| ReturnExpressionFromVoid Name
+	| NoReturnFromNonVoid Name
 	| LocalVoid Name Name
 
 instance toString CheckError
diff --git a/Sil/Check.icl b/Sil/Check.icl
index 61f5ac7..9b24f50 100644
--- a/Sil/Check.icl
+++ b/Sil/Check.icl
@@ -8,6 +8,7 @@ import StdOverloaded
 import StdString
 import StdTuple
 
+import Data.Error
 from Data.Func import $, mapSt, seqSt
 import Data.List
 import Data.Maybe
@@ -21,13 +22,15 @@ instance toString CheckError
 where
 	toString NoMainFunction
 		= "Error: no main function."
+	toString (MainFunctionInvalidType t)
+		= "Error: function 'main' should have type Void but has type " <+ t <+ "."
 	toString (DuplicateFunctionName n)
 		= "Error: multiply defined: '" <+ n <+ "'."
 	toString (DuplicateLocalName f arg)
 		= "Error: multiply defined: '" <+ arg <+ "' in '" <+ f <+ "'."
-	toString (ReturnExpressionFromVoidError f)
+	toString (ReturnExpressionFromVoid f)
 		= "Type error: an expression was returned from void function '" <+ f <+ "'."
-	toString (NoReturnFromNonVoidError f)
+	toString (NoReturnFromNonVoid f)
 		= "Type error: no return from non-void function '" <+ f <+ "'."
 	toString (LocalVoid f l)
 		= "Type error: local variable '" <+ l <+ "' in '" <+ f <+ "' cannot have type Void."
@@ -36,7 +39,10 @@ instance <<< CheckError where <<< f e = f <<< toString e <<< "\r\n"
 
 checkProgram :: *(Maybe *File) Program -> *([CheckError], *Maybe *File)
 checkProgram err prog
-	= checkErrors [checkFunctionNames, checkMainFunction] prog
+	= checkErrors
+	[ checkFunctionNames
+	, checkMainFunction
+	] prog
 	$ appFst flatten $ mapSt (flip checkFunction) prog.p_funs err
 where
 	checkMainFunction :: Program -> [CheckError]
@@ -51,14 +57,18 @@ where
 		| not (isEmpty fs) && isMember (hd fs) (tl fs)]
 
 checkFunction :: *(Maybe *File) Function -> *([CheckError], *Maybe *File)
-checkFunction err f = checkErrors [checkLocals, checkReturnAndVoid] f $ noErrors err
+checkFunction err f = checkErrors
+	[ checkLocals
+	, checkReturnAndVoid
+	, checkMainFunctionType
+	] f $ noErrors err
 where
 	checkReturnAndVoid :: Function -> [CheckError]
 	checkReturnAndVoid f = case f.f_type of
 		TVoid -> case [st \\ st=:(Return (Just _)) <- allStatements f] of
 			[] -> []
-			_  -> [ReturnExpressionFromVoidError f.f_name]
-		_     -> if (sureToReturn f.f_code) [] [NoReturnFromNonVoidError f.f_name]
+			_  -> [ReturnExpressionFromVoid f.f_name]
+		_     -> if (sureToReturn f.f_code) [] [NoReturnFromNonVoid f.f_name]
 	where
 		sureToReturn :: CodeBlock -> Bool
 		sureToReturn cb = case cb.cb_content of
@@ -70,6 +80,11 @@ where
 				If bs Nothing  -> all (sureToReturn o snd) bs
 				_              -> False
 
+	checkMainFunctionType :: Function -> [CheckError]
+	checkMainFunctionType f=:{f_name="main",f_type=TVoid,f_args=[]} = []
+	checkMainFunctionType f=:{f_name="main"} = [MainFunctionInvalidType $ fromOk $ fromJust $ type zero f]
+	checkMainFunctionType _ = []
+
 	checkLocals :: Function -> [CheckError]
 	checkLocals f =
 		checkDupName [a.arg_name \\ a <- f.f_args] f.f_code ++
diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index af82f3e..50cc86b 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -181,7 +181,7 @@ where
 		typeresolver :: Name -> Maybe (MaybeError TypeError Type)
 		typeresolver n = case [f \\ f <- p.p_funs | f.f_name == n] of
 			[]    -> Nothing
-			[f:_] -> type (const Nothing) f
+			[f:_] -> type zero f
 
 instance gen Function
 where
diff --git a/Sil/Types.dcl b/Sil/Types.dcl
index 1659436..5fd159e 100644
--- a/Sil/Types.dcl
+++ b/Sil/Types.dcl
@@ -1,6 +1,6 @@
 definition module Sil.Types
 
-from StdOverloaded import class ==, class toString
+from StdOverloaded import class ==, class toString, class zero
 
 from Data.Error import :: MaybeError
 from Data.Maybe import :: Maybe
@@ -28,6 +28,8 @@ typeSize :: Type -> Int
 
 :: TypeResolver :== Name -> Maybe (MaybeError TypeError Type)
 
+instance zero TypeResolver
+
 class type a :: TypeResolver a -> Maybe (MaybeError TypeError Type)
 instance type Function
 instance type Expression
diff --git a/Sil/Types.icl b/Sil/Types.icl
index 5f17956..40fc0cb 100644
--- a/Sil/Types.icl
+++ b/Sil/Types.icl
@@ -1,5 +1,6 @@
 implementation module Sil.Types
 
+from StdFunc import const
 import StdList
 import StdOverloaded
 import StdString
@@ -34,6 +35,8 @@ typeSize TVoid = 0
 typeSize TBool = 1
 typeSize TInt  = 1
 
+instance zero TypeResolver where zero = const Nothing
+
 instance type Function
 where
 	type res f = Just $ Ok $ foldr (-->) f.f_type [a.arg_type \\ a <- f.f_args]
-- 
cgit v1.2.3