Better errors

1 files changed, 41 insertions, 3 deletions

diff --git a/Sil/Error.icl b/Sil/Error.icl
index 36a614b..fde96ee 100644
--- a/Sil/Error.icl
+++ b/Sil/Error.icl
@@ -1,8 +1,10 @@
 implementation module Sil.Error
 
 import StdFile
+import StdInt
 import StdString
 
+import Data.Maybe
 import Text
 
 import Sil.Syntax
@@ -10,9 +12,12 @@ import Sil.Types
 import Sil.Util.Parser
 
 :: ErrorPosition =
-	{ ep_line :: Int
+	{ ep_line  :: Int
+	, ep_token :: Int
 	}
 
+instance < ErrorPosition where < p1 p2 = p1.ep_token < p2.ep_token
+
 instance toString ErrorPosition
 where
 	toString ep = ep.ep_line <+ ":\t"
@@ -20,7 +25,7 @@ where
 instance toString Error
 where
 	toString (P_Invalid                     w tk)  = "\tInvalid token '" <+ tk <+ "' while parsing a " <+ w <+ "."
-	toString (P_Expected                    s)     = "\tExpected " <+ s <+ "."
+	toString (P_Expected                  p s h)   = p <+ "Expected " <+ s <+ " near '" <+ h <+ "'."
 	toString (T_IllegalApplication          ft et) = "\tCannot apply a " <+ et <+ " to a " <+ ft <+ "."
 	toString (T_IllegalField                f t)   = "\tIllegal field '" <+ f <+ "' on type " <+ t <+ "."
 	toString (T_TooHighTupleArity           i)     = "\tToo high tuple arity " <+ i <+ " (maximum is 32)."
@@ -43,5 +48,38 @@ where
 
 instance <<< Error where <<< f e = f <<< toString e <<< "\r\n"
 
+instance < Error
+where
+	< _                (UnknownError _) = False
+	< (UnknownError _) _                = True
+	< e1               e2               = case (getErrorPosition e1, getErrorPosition e2) of
+		(Just p1, Just p2) -> p1 < p2
+		(_      , Nothing) -> False
+		(Nothing, _      ) -> True
+
+getErrorPosition :: Error -> Maybe ErrorPosition
+getErrorPosition (P_Invalid                     w tk)  = Nothing
+getErrorPosition (P_Expected                  p s h)   = Just p
+getErrorPosition (T_IllegalApplication          ft et) = Nothing
+getErrorPosition (T_IllegalField                f t)   = Nothing
+getErrorPosition (T_TooHighTupleArity           i)     = Nothing
+getErrorPosition  Ck_NoMainFunction                    = Nothing
+getErrorPosition (Ck_MainFunctionInvalidType  p t)     = Just p
+getErrorPosition (Ck_DuplicateFunctionName    p n)     = Just p
+getErrorPosition (Ck_DuplicateLocalName       p f arg) = Just p
+getErrorPosition (Ck_ReturnExpressionFromVoid p f)     = Just p
+getErrorPosition (Ck_NoReturnFromNonVoid      p f)     = Just p
+getErrorPosition (Ck_LocalVoid                  f l)   = Nothing
+getErrorPosition (Ck_BasicGlobal              p g)     = Just p
+getErrorPosition (C_UndefinedName               n)     = Nothing
+getErrorPosition (C_UndefinedField              f)     = Nothing
+getErrorPosition  C_VariableLabel                      = Nothing
+getErrorPosition  C_FunctionOnStack                    = Nothing
+getErrorPosition (C_CouldNotDeduceType          e)     = Nothing
+getErrorPosition (C_TypeMisMatch                t e u) = Nothing
+getErrorPosition (C_BasicInitWithoutValue       n)     = Nothing
+getErrorPosition (UnknownError                  e)     = Nothing
+
 errpos :: a -> ErrorPosition | getPos a
-errpos x = {ep_line=(getPos x).pp_line}
+errpos x = {ep_line=p.pp_line, ep_token=p.pp_token}
+where p = getPos x