diff --git a/Trace/Hpc/Reflect.hsc b/Trace/Hpc/Reflect.hsc
index 20601a1a99a83d1aee95cf81abf11829e67cdf54..5fb2db8274682313adf1181f37498a79e784a522 100644
--- a/Trace/Hpc/Reflect.hsc
+++ b/Trace/Hpc/Reflect.hsc
@@ -29,6 +29,7 @@ data ModuleInfo =
 #if __GLASGOW_HASKELL__ >= 907
                                   (Ptr Word64)
                                   (Ptr Word64)
+                                  (Ptr Word64)
 #endif
 
 moduleInfoList :: Ptr () -> IO [ModuleInfo]
@@ -41,14 +42,15 @@ moduleInfoList ptr
         hashNo    <- (#peek HpcModuleInfo, hashNo) ptr
         tixArr    <- (#peek HpcModuleInfo, tixArr) ptr
 #if __GLASGOW_HASKELL__ >= 907
-        trxInfo   <- (#peek HpcModuleInfo, trxInfo) ptr
-        trxArr    <- (#peek HpcModuleInfo, trxArr) ptr
+        trxInfo      <- (#peek HpcModuleInfo, trxInfo) ptr
+        trxArr       <- (#peek HpcModuleInfo, trxArr) ptr
+        rettrxArr    <- (#peek HpcModuleInfo, rettrxArr) ptr
 #endif
         next      <- (#peek HpcModuleInfo, next) ptr
         rest      <- moduleInfoList next
         return $
 #if __GLASGOW_HASKELL__ >= 907
-          ModuleInfo modName tickCount (toHash (hashNo :: Int)) tixArr trxInfo trxArr : rest
+          ModuleInfo modName tickCount (toHash (hashNo :: Int)) tixArr trxInfo trxArr rettrxArr : rest
 #else
           ModuleInfo modName tickCount (toHash (hashNo :: Int)) tixArr : rest
 
@@ -58,7 +60,7 @@ clearTix :: IO ()
 clearTix = do
       sequence_ [ pokeArray ptr $ take (fromIntegral count) $ repeat 0
 #if __GLASGOW_HASKELL__ >= 907
-                | ModuleInfo _mod count _hash ptr _info _trx <- modInfo
+                | ModuleInfo _mod count _hash ptr _info _trx _rtrx <- modInfo
 #else
                 | ModuleInfo _mod count _hash ptr <- modInfo
 #endif
@@ -70,8 +72,9 @@ examineTix :: IO Tix
 examineTix = do
       mods <- sequence [ do tixs <- peekArray (fromIntegral count) ptr
 #if __GLASGOW_HASKELL__ >= 907
-                            info <- peekArray (fromIntegral 2) trxInfo
-                            trx <- peekArray (fromIntegral (info !! 1)) trxArr
+                            info <- peekArray (fromIntegral 3) trxInfo
+                            trx <- peekArray (fromIntegral (info !! 2)) trxArr
+                            rettrx <- peekArray (fromIntegral (info !! 2)) rettrxArr
 #endif
 
                             return $ TixModule mod' hash 
@@ -80,7 +83,8 @@ examineTix = do
 #if __GLASGOW_HASKELL__ >= 907
                                       (map fromIntegral info)
                                       (map fromIntegral trx)
-                       | (ModuleInfo mod' count hash ptr trxInfo trxArr) <- modInfo
+                                      (map fromIntegral rettrx)
+                       | (ModuleInfo mod' count hash ptr trxInfo trxArr rettrxArr) <- modInfo
 #else
                        | (ModuleInfo mod' count hash ptr) <- modInfo
 #endif
@@ -95,8 +99,8 @@ updateTix (Tix modTixes)
   | otherwise = do
       sequence_ [ pokeArray ptr $ map fromIntegral tixs
 #if __GLASGOW_HASKELL__ >= 907
-                | (ModuleInfo mod1 count1 hash1 ptr info1 trx1,
-                   TixModule mod2 hash2 count2 tixs info2 trx2) <- zip modInfo modTixes
+                | (ModuleInfo mod1 count1 hash1 ptr info1 trx1 rtrx1,
+                   TixModule mod2 hash2 count2 tixs info2 trx2 rtrx2) <- zip modInfo modTixes
 #else
                 | (ModuleInfo mod1 count1 hash1 ptr,
                    TixModule mod2 hash2 count2 tixs) <- zip modInfo modTixes
diff --git a/Trace/Hpc/Tix.hs b/Trace/Hpc/Tix.hs
index 79df547906f112ff23af3530d760677c94dca470..b10f59227c9d78006cd429497f479ba7387087c9 100644
--- a/Trace/Hpc/Tix.hs
+++ b/Trace/Hpc/Tix.hs
@@ -8,7 +8,7 @@
 module Trace.Hpc.Tix(Tix(..), TixModule(..),
                      tixModuleName, tixModuleHash, tixModuleTixs,
 #if __GLASGOW_HASKELL__ >= 907
-                     tixModuleTraceInfo, tixModuleTrace,
+                     tixModuleTraceInfo, tixModuleTrace, tixModuleRetTrace,
 #endif
                      readTix, writeTix, getTixFileName) where
 
@@ -36,6 +36,7 @@ data TixModule = TixModule
 #if __GLASGOW_HASKELL__ >= 907
                  [Integer] --  current trace posistion
                  [Integer] -- traces
+                 [Integer] -- rettraces
 #endif
         deriving (Read, Show, Eq)
 
@@ -49,13 +50,14 @@ tixModuleName :: TixModule -> String
 tixModuleHash :: TixModule -> Hash
 tixModuleTixs :: TixModule -> [Integer]
 #if __GLASGOW_HASKELL__ >= 907
-tixModuleName (TixModule nm _ _ _ _ _) = nm
-tixModuleHash (TixModule _ h  _ _ _ _) = h
-tixModuleTixs (TixModule  _ _ _ tixs _ _) = tixs
+tixModuleName (TixModule nm _ _ _ _ _ _) = nm
+tixModuleHash (TixModule _ h  _ _ _ _ _) = h
+tixModuleTixs (TixModule  _ _ _ tixs _ _ _) = tixs
 tixModuleTraceInfo :: TixModule -> [Integer]
 tixModuleTrace :: TixModule -> [Integer]
-tixModuleTraceInfo (TixModule  _ _ _ _ info _) = info
-tixModuleTrace (TixModule  _ _ _ _ _ trace) = trace
+tixModuleTraceInfo (TixModule  _ _ _ _ info _ _) = info
+tixModuleTrace (TixModule  _ _ _ _ _ trace _) = trace
+tixModuleRetTrace (TixModule  _ _ _ _ _ _ ret) = ret
 #else
 tixModuleName (TixModule nm _ _ _ ) = nm
 tixModuleHash (TixModule _ h  _ _ ) = h