Start with positional errors (see #5)

1 files changed, 38 insertions, 53 deletions

diff --git a/Sil/Check.icl b/Sil/Check.icl
index f9147bf..c9ccecb 100644
--- a/Sil/Check.icl
+++ b/Sil/Check.icl
@@ -15,31 +15,12 @@ import Data.Maybe
 import Data.Tuple
 from Text import <+
 
+import Sil.Error
 import Sil.Syntax
 import Sil.Types
+import Sil.Util.Parser
 
-instance toString CheckError
-where
-	toString NoMainFunction
-		= "Error: no main function."
-	toString (MainFunctionInvalidType t)
-		= "Error: function 'main' should not have arguments has type " <+ t <+ "."
-	toString (DuplicateFunctionName n)
-		= "Error: multiply defined: '" <+ n <+ "'."
-	toString (DuplicateLocalName f arg)
-		= "Error: multiply defined: '" <+ arg <+ "' in '" <+ f <+ "'."
-	toString (ReturnExpressionFromVoid f)
-		= "Type error: an expression was returned from void function '" <+ 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."
-	toString (BasicGlobal g)
-		= "Error: global variable '" <+ g <+ "' cannot have a basic type."
-
-instance <<< CheckError where <<< f e = f <<< toString e <<< "\r\n"
-
-checkProgram :: *(Maybe *File) Program -> *([CheckError], *Maybe *File)
+checkProgram :: *(Maybe *File) Program -> *([Error], *Maybe *File)
 checkProgram err prog
 	= checkErrors
 	[ checkFunctionNames
@@ -48,24 +29,25 @@ checkProgram err prog
 	] prog
 	$ appFst flatten $ mapSt (flip checkFunction) prog.p_funs err
 where
-	checkMainFunction :: Program -> [CheckError]
-	checkMainFunction p = case [f \\ f <- p.p_funs | f.f_name == "main"] of
-		[] -> [NoMainFunction]
+	checkMainFunction :: Program -> [Error]
+	checkMainFunction p = case [f \\ f <- p.p_funs | f.pos_val.f_name == "main"] of
+		[] -> [Ck_NoMainFunction]
 		_  -> []
 
-	checkFunctionNames :: Program -> [CheckError]
+	checkFunctionNames :: Program -> [Error]
 	checkFunctionNames p =
-		[ DuplicateFunctionName $ hd fs
-		\\ fs <- tails [f.f_name \\ f <- p.p_funs]
-		| not (isEmpty fs) && isMember (hd fs) (tl fs)]
+		[ Ck_DuplicateFunctionName (errpos $ hd fs) (fromPositioned $ hd fs).f_name
+		\\ fs <- tails [f \\ f <- p.p_funs]
+		| let names = [f.pos_val.f_name \\ f <- fs]
+		  in  not (isEmpty names) && isMember (hd names) (tl names)]
 
-	checkGlobals :: Program -> [CheckError]
+	checkGlobals :: Program -> [Error]
 	checkGlobals p =
-		[ BasicGlobal g.init_name
+		[ Ck_BasicGlobal (errpos g) (fromPositioned g).init_name
 		\\ g <- p.p_globals
-		| (typeSize g.init_type).bsize <> 0]
+		| (typeSize (fromPositioned g).init_type).bsize <> 0]
 
-checkFunction :: *(Maybe *File) Function -> *([CheckError], *Maybe *File)
+checkFunction :: *(Maybe *File) (Positioned Function) -> *([Error], *Maybe *File)
 checkFunction err f = checkErrors
 	[ checkLocals
 	, checkReturnAndVoid
@@ -73,17 +55,17 @@ checkFunction err f = checkErrors
 	] f
 	$ noErrors err
 where
-	checkReturnAndVoid :: Function -> [CheckError]
-	checkReturnAndVoid f = case f.f_type of
+	checkReturnAndVoid :: (Positioned Function) -> [Error]
+	checkReturnAndVoid p=:{pos_val=f} = case f.f_type of
 		TVoid -> case [st \\ st=:(Return (Just _)) <- allStatements f] of
 			[] -> []
-			_  -> [ReturnExpressionFromVoid f.f_name]
-		_     -> if (sureToReturn f.f_code) [] [NoReturnFromNonVoid f.f_name]
+			_  -> [Ck_ReturnExpressionFromVoid (errpos p) f.f_name]
+		_     -> if (sureToReturn f.f_code) [] [Ck_NoReturnFromNonVoid (errpos p) f.f_name]
 	where
 		sureToReturn :: CodeBlock -> Bool
 		sureToReturn cb = case cb.cb_content of
 			[]  -> False
-			sts -> case last sts of
+			sts -> case fromPositioned $ last sts of
 				Return _       -> True
 				While _ cb`    -> sureToReturn cb`
 				If bs (Just e) -> all sureToReturn [e:map snd bs]
@@ -91,24 +73,27 @@ where
 				MachineStm _   -> True // Let's assume the user is not stupid
 				_              -> False
 
-	checkMainFunctionType :: Function -> [CheckError]
-	checkMainFunctionType f=:{f_name="main",f_args=[]} = []
-	checkMainFunctionType f=:{f_name="main"} = [MainFunctionInvalidType $ fromOk $ fromJust $ type zero f]
-	checkMainFunctionType _ = []
+	checkMainFunctionType :: (Positioned Function) -> [Error]
+	checkMainFunctionType {pos_val={f_name="main",f_args=[]}}
+		= []
+	checkMainFunctionType p=:{pos_val=f=:{f_name="main"}}
+		= [Ck_MainFunctionInvalidType (errpos p) $ fromOk $ fromJust $ type zero f]
+	checkMainFunctionType _
+		= []
 
-	checkLocals :: Function -> [CheckError]
-	checkLocals f =
+	checkLocals :: (Positioned Function) -> [Error]
+	checkLocals p=:{pos_val=f} =
 		checkDupName [a.arg_name \\ a <- f.f_args] f.f_code ++
 		concatMap checkVoid (allLocals f)
 	where
-		checkDupName :: [Name] CodeBlock -> [CheckError]
+		checkDupName :: [Name] CodeBlock -> [Error]
 		checkDupName defined cb =
-			[DuplicateLocalName f.f_name l \\ l <- defined | isMember l locals] ++
+			[Ck_DuplicateLocalName (errpos p) f.f_name l \\ l <- defined | isMember l locals] ++
 			concatMap (checkDupName (locals ++ defined)) (underlyingCBs cb)
-		where locals = [i.init_name \\ i <- cb.cb_init]
+		where locals = [(fromPositioned i).init_name \\ i <- cb.cb_init]
 
 		underlyingCBs :: CodeBlock -> [CodeBlock]
-		underlyingCBs cb = concatMap findCBs cb.cb_content
+		underlyingCBs cb = concatMap (findCBs o fromPositioned) cb.cb_content
 		where
 			findCBs (Declaration _ _) = []
 			findCBs (Application _)   = []
@@ -118,17 +103,17 @@ where
 			findCBs (While _ cb)      = [cb]
 			findCBs (MachineStm _)    = []
 
-		checkVoid :: (Type, Name) -> [CheckError]
-		checkVoid (TVoid, n) = [LocalVoid f.f_name n]
+		checkVoid :: (Type, Name) -> [Error]
+		checkVoid (TVoid, n) = [Ck_LocalVoid f.f_name n]
 		checkVoid _          = []
 
-checkErrors :: [(a -> [CheckError])] a *([CheckError], Maybe *File) -> *([CheckError], *Maybe *File)
+checkErrors :: [(a -> [Error])] a *([Error], Maybe *File) -> *([Error], *Maybe *File)
 checkErrors cks x st = seqSt error (concatMap (flip ($) x) cks) st
 
-error :: CheckError *([CheckError], *Maybe *File) -> *([CheckError], *Maybe *File)
+error :: Error *([Error], *Maybe *File) -> *([Error], *Maybe *File)
 error e (es, err) = ([e:es], err <?< e)
 
-noErrors :: *(Maybe *File) -> *([CheckError], *Maybe *File)
+noErrors :: *(Maybe *File) -> *([Error], *Maybe *File)
 noErrors f = ([], f)
 
 (<?<) infixl :: !*(Maybe *File) !a -> *Maybe *File | <<< a