More meaningful error messages

1 files changed, 15 insertions, 12 deletions

diff --git a/src/SPL/Parse.hs b/src/SPL/Parse.hs
index 28230f8..eec7fd1 100644
--- a/src/SPL/Parse.hs
+++ b/src/SPL/Parse.hs
@@ -19,11 +19,14 @@ type Parser t = P.Parsec [Token] () t
 parse :: [Token] -> Either P.ParseError Program
 parse = P.parse spl "Not a valid program" . filter (not . isCommentToken)
 
-check :: (Token -> Maybe a) -> Parser a
-check f = P.tokenPrim show (const . const) f
+check :: String -> (Token -> Maybe a) -> Parser a
+check e f = P.tokenPrim show (\p _ _ -> P.incSourceColumn p 1) f <?> e
+-- TODO: We increment the source column to get meaningful error messages;
+-- the error that is furthest in the parsing process. We need to keep positions
+-- in the list of tokens so that we can update this properly.
 
 token :: Token -> Parser Token
-token t = check (\u -> if t == u then Just t else Nothing)
+token t = check (show t) (\u -> if t == u then Just t else Nothing)
 
 choice :: [Parser a] -> Parser a
 choice = P.choice . map P.try
@@ -44,7 +47,7 @@ toplevel = choice
   ]
 
 comment :: Parser String
-comment = check $ \case
+comment = check "comment" $ \case
   TSingleComment s -> Just s
   TBlockComment s  -> Just s
   _                -> Nothing
@@ -70,16 +73,16 @@ var = do
 fun :: Parser Function
 fun = do
   id <- ident
-  args <- parenthesised (ident `sepBy` token TComma) <?> "arguments"
-  ftype <- optional (token TColonColon *> funType) <?> "optional function type"
+  args <- parenthesised (ident `sepBy` token TComma)
+  ftype <- optional (token TColonColon *> funType)
   token TBraceOpen
-  vars <- many (P.try var) <?> "local variables"
-  stmt <- statements <?> "function body"
+  vars <- many (P.try var)
+  stmt <- statements
   token TBraceClose
   return $ Function id ftype args vars stmt
 
 ident :: Parser Name
-ident = check $ \case
+ident = check "identifier" $ \case
   TIdent id -> Just id
   _         -> Nothing
 
@@ -147,7 +150,7 @@ expr =
       ]
 
     literal :: Parser Expression
-    literal = fmap Literal $ nil <|> (check $ \case
+    literal = fmap Literal $ nil <|> (check "literal" $ \case
       TInt i  -> Just (LInt i)
       TBool b -> Just (LBool b)
       TChar c -> Just (LChar c)
@@ -161,7 +164,7 @@ expr =
     var = Var <$> ident
 
 statements :: Parser Statement
-statements = foldr1 Seq <$> some statement <|> pure Nop
+statements = (foldr1 Seq <$> some statement <|> pure Nop) <?> "statement"
 
 -- NOTE: we here assume that if/while blocks need not be braced, as in the
 -- example function `abs`. The alternative is using `braced statements`.
@@ -184,7 +187,7 @@ statement = choice
   ]
 
 field :: Parser Field
-field = token TDot *> check (\case
+field = token TDot *> check "field" (\case
   TIdent "hd"  -> Just Hd
   TIdent "tl"  -> Just Tl
   TIdent "fst" -> Just Fst