From c23b7cd159af38f588ce4214d6ad37ceadf3c1a6 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Thu, 27 Jul 2017 23:32:59 +0200
Subject: Centralise errors (needed for positional errors #5)

---
 Sil/Parse.icl | 21 ++++++++-------------
 1 file changed, 8 insertions(+), 13 deletions(-)

(limited to 'Sil/Parse.icl')

diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index 4fdc479..c9521bf 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -20,6 +20,7 @@ from Text import <+, class Text, instance Text String
 
 import GenEq
 
+import Sil.Error
 import Sil.Syntax
 import Sil.Types
 import Sil.Util.Parser
@@ -58,16 +59,10 @@ where
 	name (TMachineCode _) = "machine code"
 	name t                = toString t
 
-instance toString ParseError
-where
-	toString (Invalid loc sym)       = "Invalid token '" <+ sym <+ "' while parsing a " <+ loc <+ "."
-	toString (Expected s)            = "Expected " <+ s <+ "."
-	toString UnknownError            = "Unknown error."
-
-tokenise :: [Char] -> MaybeError ParseError [Token]
+tokenise :: [Char] -> MaybeError Error [Token]
 tokenise cs = reverse <$> tks cs []
 where
-	tks :: [Char] [Token] -> MaybeError ParseError [Token]
+	tks :: [Char] [Token] -> MaybeError Error [Token]
 	tks [] t = pure t
 	tks ['/':'/':r] t = tks (dropWhile ((<>) '\n') r) t
 	tks ['/':'*':r] t = tks (skipUntilEndOfComment r) t
@@ -105,7 +100,7 @@ where
 	tks cs=:[h:_] t
 	| isSpace h          = tks (dropWhile isSpace cs) t
 	| isDigit h          = tks numrest [TLit $ ILit $ toInt $ toString num:t]
-	| not (isNameChar h) = Error $ Invalid "name" h
+	| not (isNameChar h) = Error $ P_Invalid "name" h
 	| otherwise          = tks namerest [TName $ toString name:t]
 	where
 		(name,namerest) = span isNameChar cs
@@ -116,7 +111,7 @@ where
 
 	isNotNameChar = not o isNameChar
 
-parse :: ([Token] -> MaybeError ParseError Program)
+parse :: ([Token] -> MaybeError Error Program)
 parse = fst o runParser program
 
 program :: Parser Token Program
@@ -239,14 +234,14 @@ where
 		<|> parenthised expression
 
 name :: Parser Token Name
-name = liftM (\(TName s) -> s) $ satisfy isName <?> Expected "name"
+name = liftM (\(TName s) -> s) $ satisfy isName <?> P_Expected "name"
 where
 	isName (TName _) = True
 	isName _         = False
 
 arg :: Parser Token Arg
 arg = (type >>= \type -> name >>= \name -> pure {arg_type=type, arg_name=name})
-	<?> Expected "argument"
+	<?> P_Expected "argument"
 
 type :: Parser Token Type
 type
@@ -254,7 +249,7 @@ type
 	<|> simpletype "Int"  TInt
 	<|> simpletype "Void" TVoid
 	<|> (parenthised (min2seplist TComma type) >>= \ts -> pure $ TTuple (length ts) ts)
-	<?> Expected "type"
+	<?> P_Expected "type"
 where
 	simpletype s t = item (TName s) $> t
 
-- 
cgit v1.2.3