diff options
author | Juan J. Martinez <jjm@usebox.net> | 2022-08-15 12:11:10 +0100 |
---|---|---|
committer | Juan J. Martinez <jjm@usebox.net> | 2022-08-15 12:11:10 +0100 |
commit | 60d8f688a0c66759bdb7645c9dd4c232bc433c9f (patch) | |
tree | c81394d00bf9825eae6c456ac6238e0f72bbe4ce | |
parent | cd4c8a3f1b92f0e6a585bd0b199374b8b99c6238 (diff) | |
download | micro-lang-hs-60d8f688a0c66759bdb7645c9dd4c232bc433c9f.tar.gz micro-lang-hs-60d8f688a0c66759bdb7645c9dd4c232bc433c9f.zip |
Unify error reporting
-rw-r--r-- | src/Compiler.hs | 6 | ||||
-rw-r--r-- | src/Error.hs | 10 | ||||
-rw-r--r-- | src/Main.hs | 4 |
3 files changed, 13 insertions, 7 deletions
diff --git a/src/Compiler.hs b/src/Compiler.hs index 0d90143..49af369 100644 --- a/src/Compiler.hs +++ b/src/Compiler.hs @@ -54,7 +54,7 @@ typecheckCall args params else if all (\(a, b) -> a == b) $ zip t params -- compare types then return $ Nothing -- all good! - else return $ Just ("type mismatch in function call:\n unexpected " ++ A.showList t ++ "\n expecting " ++ A.showList params) + else return $ Just ("type mismatch in function call\n unexpected " ++ A.showList t ++ "\n expecting " ++ A.showList params) Nothing -> -- there was an error in on argument return $ Nothing @@ -67,14 +67,14 @@ showMaybet (Just t) = show t -- returning a string decribing an error or Nothing in case of a type match. typecheckReturn :: Maybe A.Expr -> Maybe A.Type -> State CompState (Maybe String) typecheckReturn Nothing Nothing = return $ Nothing -typecheckReturn Nothing fret = return $ Just $ "invalid return value:\n unexpected ()\n expecting " ++ showMaybet fret +typecheckReturn Nothing fret = return $ Just $ "invalid return value\n unexpected ()\n expecting " ++ showMaybet fret typecheckReturn (Just value) fret = do r <- compile value case r of Right r -> if r == fret then return $ Nothing - else return $ Just $ "invalid return value:\n unexpected " ++ showMaybet r ++ "\n expecting " ++ showMaybet fret + else return $ Just $ "invalid return value\n unexpected " ++ showMaybet r ++ "\n expecting " ++ showMaybet fret Left _ -> return $ Nothing -- error resolving return value compile :: A.Expr -> State CompState CompResult diff --git a/src/Error.hs b/src/Error.hs index 96b02dc..f61cea2 100644 --- a/src/Error.hs +++ b/src/Error.hs @@ -1,13 +1,19 @@ module Error where import Data.List (sort) -import Text.Parsec (SourcePos) +import Text.Parsec (SourcePos, errorPos) +import Text.Parsec.Error (ParseError, errorMessages, showErrorMessages) data Error = Error String SourcePos deriving (Eq) instance Show Error where show (Error message pos) = - "error: " ++ show pos ++ ":\n" ++ message + show pos ++ " error: " ++ message + +showParserError :: ParseError -> String +showParserError error = + show (errorPos error) ++ " error: syntax 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 diff --git a/src/Main.hs b/src/Main.hs index 6df7e6c..47fd883 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -3,7 +3,7 @@ module Main where import Compiler import Control.Monad.State (evalState) import qualified Data.Map as Map -import Error (showErrorList) +import Error (showErrorList, showParserError) import Lexer (scan) import Parser (parse, parseFromFile) import System.Exit (exitFailure) @@ -13,7 +13,7 @@ main :: IO () main = do res <- parseFromFile (scan parse) "input" case res of - Left err -> hPutStrLn stderr ("error: " ++ show err) >> exitFailure + Left err -> hPutStrLn stderr (showParserError err) >> exitFailure Right ast -> do res <- return $ evalState (compileAll ast) startState case res of |