More sensible error types

3 files changed, 21 insertions, 17 deletions

diff --git a/src/Compiler.hs b/src/Compiler.hs
index 413a041..c2dff73 100644
--- a/src/Compiler.hs
+++ b/src/Compiler.hs
@@ -114,24 +114,24 @@ compile x = do
         Right (Just (A.FuncType params rtyp)) -> do
           r <- typecheckCall args params
           case r of
-            Just err -> addError $ TypeError err pos
+            Just err -> addError $ Error TypeError err pos
             Nothing -> return $ Right rtyp
-        Right _ -> addError $ Error "non callable value in function call" pos
+        Right _ -> addError $ Error GenericError "non callable value in function call" pos
         _ -> return $ Right Nothing
     (A.Return value pos) -> do
       (ev, errs) <- get
       case getSyml ev "$fn$" of
-        Nothing -> addError $ UnexpectedReturn "return without function call" pos
+        Nothing -> addError $ Error UnexpectedReturn "return without function call" pos
         Just (_, A.FuncType _ rtyp, _) -> do
           r <- typecheckReturn value rtyp
           case r of
-            Just err -> addError $ TypeError err pos
+            Just err -> addError $ Error TypeError err pos
             Nothing -> return $ Right rtyp
     (A.Var ident pos) -> do
       (ev, errs) <- get
       case getSym ev ident of
         Just (_, t, _) -> return $ Right $ Just t
-        Nothing -> addError $ Error ("undefined variable \"" ++ ident ++ "\"") pos
+        Nothing -> addError $ Error GenericError ("undefined variable \"" ++ ident ++ "\"") pos
 
 compileAll :: [A.Expr] -> State CompState CompResult
 compileAll (x : xs) = do
diff --git a/src/Env.hs b/src/Env.hs
index 380addc..d4c4fa3 100644
--- a/src/Env.hs
+++ b/src/Env.hs
@@ -57,6 +57,6 @@ addEnv env = Env Map.empty $ Just env
 addSymUniq :: Env -> Sym -> Either Error Env
 addSymUniq ev (id, typ, pos) = case getSyml ev id of
   Nothing -> Right $ addSym ev sym
-  Just (_, _, p) -> Left $ Error ("\"" ++ id ++ "\" already defined in " ++ show p) pos
+  Just (_, _, p) -> Left $ Error AlreadyDefined ("symbol \"" ++ id ++ "\" already defined in " ++ show p) pos
   where
     sym = (id, typ, pos)
diff --git a/src/Error.hs b/src/Error.hs
index 1363120..14b4875 100644
--- a/src/Error.hs
+++ b/src/Error.hs
@@ -4,19 +4,20 @@ import Data.List (sort)
 import Text.Parsec (SourcePos, errorPos)
 import Text.Parsec.Error (ParseError, errorMessages, showErrorMessages)
 
-data Error
-  = TypeError String SourcePos
-  | UnexpectedReturn String SourcePos
-  | Error String SourcePos
+data ErrorType = GenericError | TypeError | UnexpectedReturn | AlreadyDefined
+
+instance Enum ErrorType where
+  fromEnum GenericError = 0
+  fromEnum TypeError = 1
+  fromEnum UnexpectedReturn = 2
+  fromEnum AlreadyDefined = 3
+  toEnum _ = error "toEnum is undefined for Error"
+
+data Error = Error ErrorType String SourcePos
   deriving (Eq)
 
 instance Show Error where
-  show (Error message pos) =
-    show pos ++ " error: " ++ message
-  -- XXX: can we do this differently?
-  show (TypeError message pos) =
-    show pos ++ " error: " ++ message
-  show (UnexpectedReturn message pos) =
+  show (Error _ message pos) =
     show pos ++ " error: " ++ message
 
 showParserError :: ParseError -> String
@@ -25,7 +26,10 @@ showParserError error =
     ++ showErrorMessages "or" "unknown parser error" "   expecting" "  unexpected" "end of input" (errorMessages error)
 
 instance Ord Error where
-  compare (Error _ pos1) (Error _ pos2) = compare pos1 pos2
+  compare (Error _ _ pos1) (Error _ _ pos2) = compare pos1 pos2
+
+instance Eq ErrorType where
+  e1 == e2 = fromEnum e1 == fromEnum e2
 
 showErrorList :: [Error] -> String
 showErrorList errs = unlines $ map show (sort errs)