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 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 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 under the terms of the GNU General Public License as published by the
@ -22,8 +22,9 @@ module Metadata where
{-! global : Haskell2Xml !-} {-! global : Haskell2Xml !-}
import Data.Generics import Data.Generics
import Numeric
import Text.Printf import Text.Printf
import Text.Read import Text.Regex
data Meta = Meta { data Meta = Meta {
metaFile :: Maybe String, metaFile :: Maybe String,
@ -50,22 +51,23 @@ packMeta :: Meta -> String -> String
packMeta m s packMeta m s
= case metaFile m of = case metaFile m of
Nothing -> s Nothing -> s
Just fn -> printf "~%d\0%d\0%s\0%s" Just fn -> printf "//pos:%d:%d:%s//%s"
(metaLine m) (metaColumn m) fn 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. -- | Extract a Meta (encoded by packMeta) from a String.
unpackMeta :: String -> (Maybe Meta, 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 where
(ls, _:s') = break (== '\0') s metaRE = mkRegex "^(.*)//pos:([0-9]*):([0-9]*):(.*)//(.*)$"
(cs, _:s'') = break (== '\0') s' getInt s = case readDec s of [(v, "")] -> v
(fn, _:rest) = break (== '\0') s''
m = emptyMeta {
metaFile = Just fn,
metaLine = read ls,
metaColumn = read cs
}
unpackMeta s = (Nothing, s)
-- | Find the first Meta value in some part of the AST. -- | Find the first Meta value in some part of the AST.
findMeta :: (Data t, Typeable t) => t -> Meta findMeta :: (Data t, Typeable t) => t -> Meta

View File

@ -1,6 +1,6 @@
{- {-
Tock: a compiler for parallel languages 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 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 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 runTockParser toks prod cs
= do case runParser prod ([], cs) "" toks of = do case runParser prod ([], cs) "" toks of
Left err -> Left err ->
let m = sourcePosToMeta $ errorPos err -- If a position was encoded into the message, use that;
in dieReport (Just m, "Parse error: " ++ show err) -- 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 Right r -> return r
-- | Parse an occam program. -- | Parse an occam program.