X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhpc%2FHpcUtils.hs;h=5655f837f3e081556cd2fcbe2ac18dc53abaeefa;hb=HEAD;hp=ed8be63675fd79932cd1d31e0cb74fe4a81efc7e;hpb=c8742f253f0c0b38f977530eceaaecac55578b4b;p=ghc-hetmet.git diff --git a/utils/hpc/HpcUtils.hs b/utils/hpc/HpcUtils.hs index ed8be63..5655f83 100644 --- a/utils/hpc/HpcUtils.hs +++ b/utils/hpc/HpcUtils.hs @@ -1,19 +1,18 @@ module HpcUtils where import Trace.Hpc.Util -import qualified HpcMap as Map -import HpcFlags +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 @@ -21,12 +20,12 @@ grabHpcPos hsMap span = readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String -readFileFromPath err filename@('/':_) _ = readFile filename +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) = - catch (do str <- readFile (dir ++ "/" ++ filename) - return str) - (\ _ -> readTheFile dirs) + readTheFile [] = err $ "could not find " ++ show filename + ++ " in path " ++ show path0 + readTheFile (dir:dirs) = + catchIO (do str <- readFile (dir ++ "/" ++ filename) + return str) + (\ _ -> readTheFile dirs)