From d2c0fd674ea662b6183e2541f0249632ba616f57 Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Tue, 4 Mar 2008 12:52:25 +0000
Subject: [PATCH] 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".
---
 data/Metadata.hs        | 30 ++++++++++++++++--------------
 frontends/ParseOccam.hs | 10 +++++++---
 2 files changed, 23 insertions(+), 17 deletions(-)

diff --git a/data/Metadata.hs b/data/Metadata.hs
index 15fc2b9..57efb36 100644
--- a/data/Metadata.hs
+++ b/data/Metadata.hs
@@ -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
diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs
index 688ddef..f66b163 100644
--- a/frontends/ParseOccam.hs
+++ b/frontends/ParseOccam.hs
@@ -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.