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:
parent
7ec6566495
commit
d2c0fd674e
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user