X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Fhpc%2FHpcUtils.hs;h=5655f837f3e081556cd2fcbe2ac18dc53abaeefa;hp=b679a37741d4bde91abf4959479bb00f6ed9946b;hb=b00e3a6c0a82a8af3238d677f798d812cd7fd49f;hpb=a966047ca5c407f336a633d716d3d7b5ed29d231

diff --git a/utils/hpc/HpcUtils.hs b/utils/hpc/HpcUtils.hs
index b679a37..5655f83 100644
--- a/utils/hpc/HpcUtils.hs
+++ b/utils/hpc/HpcUtils.hs
@@ -1,20 +1,31 @@
 module HpcUtils where
 
 import Trace.Hpc.Util
-import qualified HpcMap as Map
+import qualified Data.Map as Map
 
 -- turns \n into ' '
 -- | grab's the text behind a HpcPos; 
 grabHpcPos :: Map.Map Int String -> HpcPos -> String
-grabHpcPos hsMap span = 
+grabHpcPos hsMap srcspan = 
          case lns of
            [ln] -> (take ((c2 - c1) + 1) $ drop (c1 - 1) ln)
            _ -> let lns1 = drop (c1 -1) (head lns) : tail lns
                     lns2 = init lns1 ++ [take (c2 + 1) (last lns1) ]
                  in foldl1 (\ xs ys -> xs ++ "\n" ++ ys) lns2
-  where (l1,c1,l2,c2) = fromHpcPos span
+  where (l1,c1,l2,c2) = fromHpcPos srcspan
         lns = map (\ n -> case Map.lookup n hsMap of
                            Just ln -> ln
                            Nothing -> error $ "bad line number : " ++ show n
                   ) [l1..l2]
 
+
+readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String
+readFileFromPath _ filename@('/':_) _ = readFile filename
+readFileFromPath err filename path0 = readTheFile path0
+  where
+        readTheFile [] = err $ "could not find " ++ show filename
+                                 ++ " in path " ++ show path0
+        readTheFile (dir:dirs) =
+                catchIO (do str <- readFile (dir ++ "/" ++ filename)
+                            return str)
+                        (\ _ -> readTheFile dirs)