stm-stats 0.1.0.0 → 0.2.0.0

raw patch · 3 files changed

+38/−22 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Concurrent/STM/Stats.hs +22/−21
• LICENSE +1/−0
• stm-stats.cabal +15/−1

@@ -76,15 +76,21 @@         -- the exception.     , warnFunction :: String -> IO ()         -- ^ Function to call when a warning is to be emitted.+    , warnInSTMFunction :: String -> IO ()+        -- ^ Function to call when a warning is to be emitted during an STM+        -- transaction. This is possibly dangerous, see the documentation to+        -- 'unsafeIOToSTM', but can be useful to detect transactions that keep+        -- retrying forever.     }  -- | The default settings are: -- -- > defaultTrackSTMConf = TrackSTMConf--- >    { tryThreshold =   Just 10--- >    , globalTheshold = Just 3000--- >    , exception =      True--- >    , warnFunction =   hPutStrLn stderr+-- >    { tryThreshold =      Just 10+-- >    , globalTheshold =    Just 3000+-- >    , exception =         True+-- >    , warnFunction =      hPutStrLn stderr+-- >    , warnInSTMFunction = \_ -> return () -- >    } defaultTrackSTMConf :: TrackSTMConf defaultTrackSTMConf = TrackSTMConf @@ -92,6 +98,7 @@     , globalTheshold = Just 3000     , extendException = True     , warnFunction = hPutStrLn stderr+    , warnInSTMFunction = \_ -> return ()     }  -- | A drop-in replacement for 'atomically'. The statistics will list this, and@@ -128,17 +135,13 @@     counter <- newIORef 0     let wrappedTx =             do  unsafeIOToSTM $ do-                    atomicModifyIORef counter incCounter-                    -- This is disabled, because the documentation to-                    -- unsafeIOToSTM says that using handles in unsafeIOToSTM-                    -- can cause deadlocks:-                    ---                    -- when (warnPred i) $-                    --  warnFunction $ msgPrefix ++ " reached try count of " ++ show i+                    i <- atomicModifyIORef counter incCounter+                    when (warnPred i) $+                        warnInSTMFunction $ msgPrefix ++ " reached try count of " ++ show i                 txm     res <- if extendException           then atomically wrappedTx-              `catch` (\(e::BlockedIndefinitelyOnSTM) ->+              `catch` (\(_::BlockedIndefinitelyOnSTM) ->                        throwIO (BlockedIndefinitelyOnNamedSTM name))           else atomically wrappedTx     i <- readIORef counter@@ -153,21 +156,19 @@     incCounter i = let j = i + 1 in (j, j)     warnPred j = case tryThreshold of         Nothing -> False-        Just n  -> j >= 2*n && (j >= 4 * n || j `mod` 2 * n == 0)+        Just n  -> j >= 2*n && (j >= 4 * n || j `mod` (2 * n) == 0)     msgPrefix = "STM transaction " ++ name     incGlobalRetryCount i = do-        k <- atomicModifyIORef globalRetryCountMap $ \m -> +        (k,k') <- atomicModifyIORef globalRetryCountMap $ \m ->                  let (oldVal, m') = M.insertLookupWithKey'                                     (\_ (a1,b1) (a2,b2) -> ((,) $! a1+a2) $! b1+b2)                                     name                                     (1,i)                                     m-                in (m', case oldVal of-                             Nothing -> i-                             Just (_,j) -> j+i)+                in (m', let j = maybe 0 snd oldVal in (j,j+i))         doMB globalTheshold $ \globalRetryThreshold -> -            when (k > 0 && k `mod` globalRetryThreshold == 0) $-                warnFunction $ msgPrefix ++ "reached global retry count of " ++ show k+            when (k `div` globalRetryThreshold /= k' `div` globalRetryThreshold) $+                warnFunction $ msgPrefix ++ " reached global retry count of " ++ show k'  -- | If 'extendException' is set (which is the case with 'trackNamedSTM'), an -- occurrence of 'BlockedIndefinitelyOnSTM' is replaced by@@ -197,8 +198,8 @@     stats <- getSTMStats     time <- show <$> getCurrentTime     hPutStrLn stderr $ "STM transaction statistics (" ++ time ++ "):"-    hPrintf stderr "%-12s %10s %10s %10s\n" "Transaction" "Commits" "Retries" "Ratio"-    sequence_+    sequence_ $+        hPrintf stderr "%-12s %10s %10s %10s\n" "Transaction" "Commits" "Retries" "Ratio" :         [ hPrintf stderr "%-12s %10d %10d %10.2f\n" name commits retries ratio         | (name,(commits,retries)) <- M.toList stats         , commits > 0 -- safeguard

@@ -1,4 +1,5 @@ Copyright (c) 2011 David Leuschner+Copyright (c) 2011 Stefan Wehr Copyright (c) 2011 Joachim Breitner  All rights reserved.

@@ -1,5 +1,5 @@ Name:           stm-stats-Version:        0.1.0.0+Version:        0.2.0.0 Synopsis:       retry statistics for STM transactions Description:    This module provides functions that can replace calls to                 'atomically' and count how often the transaction was retried@@ -11,9 +11,23 @@                 transaction-related exceptions such as                 'BlockedIndefinitelyOnSTM' are replaced by variants that                 indicate which transaction caused the exception.+                .+                /Changelog:/+                .+                [0.2.0.0] (2011-10-10)+                .+                [ ] Added 'warnInSTMFunction' to 'TrackSTMConf'.+                .+                [ ] Bugfix with the global retry count warning.+                .+                [0.1.0.0] (2011-10-09)+                .+                [ ] Initial Release+ License:        BSD3 License-file:   LICENSE Author:         David Leuschner <leuschner@factisresearch.com>,+                Stefan Wehr <wehr@factisresearch.com>,                 Joachim Breitner <mail@joachim-breitner.de> Maintainer:     Joachim Breitner <mail@joachim-breitner.de> Category:       Concurrency