Rework the code for getting errors through the parser.

This used to work by adding a magic prefix to the error message, but it appears
that doesn't work with the GHC 6.6 version of Parsec. It now searches for a
magic substring anywhere in the error message.

It uses // as a delimeter rather than \0 now, since including nulls in Strings
causes problems -- for example, putStr "a\0b" will only print "a".
This commit is contained in:
Adam Sampson 2008-03-04 12:52:25 +00:00
parent 7ec6566495
commit d2c0fd674e
2 changed files with 23 additions and 17 deletions

View File

@ -1,6 +1,6 @@
{-
Tock: a compiler for parallel languages
Copyright (C) 2007 University of Kent
Copyright (C) 2007, 2008 University of Kent
This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
@ -22,8 +22,9 @@ module Metadata where
{-! global : Haskell2Xml !-}
import Data.Generics
import Numeric
import Text.Printf
import Text.Read
import Text.Regex
data Meta = Meta {
metaFile :: Maybe String,
@ -50,22 +51,23 @@ packMeta :: Meta -> String -> String
packMeta m s
= case metaFile m of
Nothing -> s
Just fn -> printf "~%d\0%d\0%s\0%s"
(metaLine m) (metaColumn m) fn s
Just fn -> printf "//pos:%d:%d:%s//%s"
(metaLine m) (metaColumn m) (unslash fn) s
where
-- | Remove doubled slashes from a string, so we can unambiguously encode it.
unslash :: String -> String
unslash s = subRegex (mkRegex "//+") s "/"
-- | Extract a Meta (encoded by packMeta) from a String.
unpackMeta :: String -> (Maybe Meta, String)
unpackMeta ('~':s) = (Just m, rest)
unpackMeta s
= case matchRegex metaRE s of
Just [before, line, col, file, after] ->
(Just $ Meta (Just file) (getInt line) (getInt col), before ++ after)
Nothing -> (Nothing, s)
where
(ls, _:s') = break (== '\0') s
(cs, _:s'') = break (== '\0') s'
(fn, _:rest) = break (== '\0') s''
m = emptyMeta {
metaFile = Just fn,
metaLine = read ls,
metaColumn = read cs
}
unpackMeta s = (Nothing, s)
metaRE = mkRegex "^(.*)//pos:([0-9]*):([0-9]*):(.*)//(.*)$"
getInt s = case readDec s of [(v, "")] -> v
-- | Find the first Meta value in some part of the AST.
findMeta :: (Data t, Typeable t) => t -> Meta

View File

@ -1,6 +1,6 @@
{-
Tock: a compiler for parallel languages
Copyright (C) 2007 University of Kent
Copyright (C) 2007, 2008 University of Kent
This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
@ -2007,8 +2007,12 @@ runTockParser :: [Token] -> OccParser t -> CompState -> PassM t
runTockParser toks prod cs
= do case runParser prod ([], cs) "" toks of
Left err ->
let m = sourcePosToMeta $ errorPos err
in dieReport (Just m, "Parse error: " ++ show err)
-- If a position was encoded into the message, use that;
-- else use the parser position.
let errMeta = sourcePosToMeta $ errorPos err
(msgMeta, msg) = unpackMeta $ show err
m = Just errMeta >> msgMeta
in dieReport (m, "Parse error: " ++ msg)
Right r -> return r
-- | Parse an occam program.