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
|
||||
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
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in New Issue
Block a user