aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2022-08-15 12:11:10 +0100
committerJuan J. Martinez <jjm@usebox.net>2022-08-15 12:11:10 +0100
commit60d8f688a0c66759bdb7645c9dd4c232bc433c9f (patch)
treec81394d00bf9825eae6c456ac6238e0f72bbe4ce
parentcd4c8a3f1b92f0e6a585bd0b199374b8b99c6238 (diff)
downloadmicro-lang-hs-60d8f688a0c66759bdb7645c9dd4c232bc433c9f.tar.gz
micro-lang-hs-60d8f688a0c66759bdb7645c9dd4c232bc433c9f.zip
Unify error reporting
-rw-r--r--src/Compiler.hs6
-rw-r--r--src/Error.hs10
-rw-r--r--src/Main.hs4
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