diff --git a/Trace/Hpc/Mix.hs b/Trace/Hpc/Mix.hs
index b36c2ac6d3ac81d274af0bc8be28644c29a4fe6a..efcc5595c76544e5786b3aa96308ade8e12a97e2 100644
--- a/Trace/Hpc/Mix.hs
+++ b/Trace/Hpc/Mix.hs
@@ -28,7 +28,7 @@ import Data.Char
 -- been introduced in that module, accessed by tick-number position
 -- in the list
 
-import Trace.Hpc.Util (HpcPos, insideHpcPos, Hash, HpcHash(..))
+import Trace.Hpc.Util (HpcPos, insideHpcPos, Hash, HpcHash(..), catchIO)
 import Trace.Hpc.Tix
 
 -- | 'Mix' is the information about a modules static properties, like
@@ -98,7 +98,7 @@ readMix dirNames mod' = do
                                      Left  _   -> True
                                      Right tix -> h == tixModuleHash tix
                                   ) -> return $ Just r
-                           _ -> return $ Nothing) `catch` (\ _ -> return $ Nothing)
+                           _ -> return $ Nothing) `catchIO` (\ _ -> return $ Nothing)
                    | dirName <- dirNames
                    ]
    case catMaybes res of
diff --git a/Trace/Hpc/Tix.hs b/Trace/Hpc/Tix.hs
index 4e495887747ea5a94f9f83a751c1494da0471123..5752c96e743752b4bd3d5b906a2ae258093e6416 100644
--- a/Trace/Hpc/Tix.hs
+++ b/Trace/Hpc/Tix.hs
@@ -9,7 +9,7 @@ module Trace.Hpc.Tix(Tix(..), TixModule(..),
 		     readTix, writeTix, getTixFileName) where
 
 import Data.List (isSuffixOf)
-import Trace.Hpc.Util(Hash)
+import Trace.Hpc.Util (Hash, catchIO)
 
 -- 'Tix ' is the storage format for our dynamic imformation about what
 -- boxes are ticked.
@@ -34,11 +34,11 @@ tixModuleTixs (TixModule  _ _ _ tixs) = tixs
 
 -- read a Tix File.
 readTix :: String
-	-> IO (Maybe Tix)
-readTix tix_filename = 
-  catch (do contents <- readFile $ tix_filename
-	    return $ Just $ read contents)
-	(\ _ -> return $ Nothing)
+        -> IO (Maybe Tix)
+readTix tix_filename =
+  catchIO (do contents <- readFile $ tix_filename
+              return $ Just $ read contents)
+          (\ _ -> return $ Nothing)
 
 -- write a Tix File.
 writeTix :: String 
diff --git a/Trace/Hpc/Util.hs b/Trace/Hpc/Util.hs
index 47a9ca0d488f0acd7fc5023695f76c4b90e621f8..371a9ef7468be7b5bf38a3ec6c3370bc117cf331 100644
--- a/Trace/Hpc/Util.hs
+++ b/Trace/Hpc/Util.hs
@@ -11,8 +11,10 @@ module Trace.Hpc.Util
        , insideHpcPos
        , HpcHash(..)
        , Hash
+       , catchIO
        ) where
 
+import qualified Control.Exception as Exception
 import Data.List(foldl')
 import Data.Char (ord)
 import Data.Bits (xor)
@@ -103,3 +105,7 @@ instance HpcHash HpcPos where
 
 hxor :: Hash -> Hash -> Hash
 hxor (Hash x) (Hash y) = Hash $ x `xor` y
+
+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
+catchIO = Exception.catch
+