weigh 0.0.12 → 0.0.18
raw patch · 5 files changed
Files
- CHANGELOG +17/−0
- README.md +5/−1
- src/Weigh.hs +110/−44
- src/Weigh/GHCStats.hs +10/−29
- weigh.cabal +5/−2
CHANGELOG view
@@ -1,3 +1,20 @@+0.0.18:+ * Fix compatibility with `mtl`, whenever different version from the one that is wired with ghc is used.++0.0.17:+ * Changes to make compatible for GHC 9.6++0.0.16:+ * Add MaxOS parameter to indicate memory in use by RTS+ * Add haddock docmentation to the 'Column' type+ * Fix bug in treating words as int, use only Word as reported by GHC.++0.0.14:+ * Use the correct data source for final live bytes total++0.0.13:+ * Forward arguments to the child process+ 0.0.12: * Fix bug in non-unique groupings
README.md view
@@ -1,6 +1,10 @@-# weigh [](https://travis-ci.org/fpco/weigh)+# weigh [](https://github.com/fpco/weigh/actions/workflows/tests.yml) Measures the memory usage of a Haskell value or function++# Limitations++* :warning: Turn off the `-threaded` flag, otherwise it will cause inconsistent results. ## Example use
src/Weigh.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ViewPatterns #-}@@ -46,6 +45,7 @@ ,defaultConfig -- * Simple combinators ,func+ ,func' ,io ,value ,action@@ -64,7 +64,9 @@ -- * Internals ,weighDispatch ,weighFunc+ ,weighFuncResult ,weighAction+ ,weighActionResult ,Grouped(..) ) where@@ -72,13 +74,15 @@ import Control.Applicative import Control.Arrow import Control.DeepSeq-import Control.Monad.State+import Control.Monad (unless)+import Control.Monad.State (State, execState, get, gets, modify)+import Criterion.Measurement import qualified Data.Foldable as Foldable-import qualified Data.Traversable as Traversable-import Data.Int import qualified Data.List as List import Data.List.Split import Data.Maybe+import qualified Data.Traversable as Traversable+import Data.Word import GHC.Generics import Prelude import System.Environment@@ -94,7 +98,17 @@ -- Types -- | Table column.-data Column = Case | Allocated | GCs| Live | Check | Max+data Column+ = Case -- ^ Case name for the column+ | Allocated -- ^ Total bytes allocated+ | GCs -- ^ Total number of GCs+ | Live -- ^ Total amount of live data in the heap+ | Check -- ^ Table column indicating about the test status+ | Max -- ^ Maximum residency memory in use+ | MaxOS -- ^ Maximum memory in use by the RTS. Valid only for+ -- GHC >= 8.2.2. For unsupported GHC, this is reported+ -- as 0.+ | WallTime -- ^ Rough execution time. For general indication, not a benchmark tool. deriving (Show, Eq, Enum) -- | Weigh configuration.@@ -115,10 +129,12 @@ -- | How much a computation weighed in at. data Weight = Weight {weightLabel :: !String- ,weightAllocatedBytes :: !Int64- ,weightGCs :: !Int64- ,weightLiveBytes :: !Int64- ,weightMaxBytes :: !Int64+ ,weightAllocatedBytes :: !Word64+ ,weightGCs :: !Word32+ ,weightLiveBytes :: !Word64+ ,weightMaxBytes :: !Word64+ ,weightMaxOSBytes :: !Word64+ ,weightWallTime :: !Double } deriving (Read,Show) @@ -224,12 +240,21 @@ -> Weigh () func name !f !x = validateFunc name f x (const Nothing) +-- | Weigh a function applied to an argument. Unlike 'func', the argument+-- is evaluated to normal form before the function is applied.+func' :: (NFData a, NFData b)+ => String+ -> (b -> a)+ -> b+ -> Weigh ()+func' name !f (force -> !x) = validateFunc name f x (const Nothing)+ -- | Weigh an action applied to an argument. -- -- Implemented in terms of 'validateAction'. io :: (NFData a) => String -- ^ Name of the case.- -> (b -> IO a) -- ^ Aciton that does some IO to measure.+ -> (b -> IO a) -- ^ Action that does some IO to measure. -> b -- ^ Argument to that function. -> Weigh () io name !f !x = validateAction name f x (const Nothing)@@ -253,7 +278,7 @@ action name !m = io name (const m) () -- | Make a validator that set sthe maximum allocations.-maxAllocs :: Int64 -- ^ The upper bound.+maxAllocs :: Word64 -- ^ The upper bound. -> (Weight -> Maybe String) maxAllocs n = \w ->@@ -317,10 +342,13 @@ Just act -> do case act of Action !run arg _ _ -> do- (bytes, gcs, liveBytes, maxByte) <-+ initializeTime+ start <- getTime+ (bytes, gcs, liveBytes, maxByte, maxOSBytes) <- case run of Right f -> weighFunc f arg Left m -> weighAction m arg+ end <- getTime writeFile fp (show@@ -330,6 +358,8 @@ , weightGCs = gcs , weightLiveBytes = liveBytes , weightMaxBytes = maxByte+ , weightMaxOSBytes = maxOSBytes+ , weightWallTime = end - start })) return Nothing _ -> fmap Just (Traversable.traverse (Traversable.traverse fork) cases)@@ -350,10 +380,11 @@ hClose h setEnv "WEIGH_CASE" $ show $ [actionName act,fp] me <- getExecutablePath+ args <- getArgs (exit, _, err) <- readProcessWithExitCode me- ["+RTS", "-T", "-RTS"]+ (args ++ ["+RTS", "-T", "-RTS"]) "" case exit of ExitFailure {} ->@@ -371,13 +402,23 @@ , "processes via a temporary file." ])) --- | Weigh a pure function. This function is heavily documented inside.+-- | Weigh a pure function. This function is built on top of `weighFuncResult`,+-- which is heavily documented inside weighFunc :: (NFData a) => (b -> a) -- ^ A function whose memory use we want to measure. -> b -- ^ Argument to the function. Doesn't have to be forced.- -> IO (Int64,Int64,Int64,Int64) -- ^ Bytes allocated and garbage collections.-weighFunc run !arg = do+ -> IO (Word64,Word32,Word64,Word64,Word64) -- ^ Bytes allocated and garbage collections.+weighFunc run !arg = snd <$> weighFuncResult run arg++-- | Weigh a pure function and return the result. This function is heavily+-- documented inside.+weighFuncResult+ :: (NFData a)+ => (b -> a) -- ^ A function whose memory use we want to measure.+ -> b -- ^ Argument to the function. Doesn't have to be forced.+ -> IO (a, (Word64,Word32,Word64,Word64,Word64)) -- ^ Result, Bytes allocated, GCs.+weighFuncResult run !arg = do ghcStatsSizeInBytes <- GHCStats.getGhcStatsSizeInBytes performGC -- The above forces getStats data to be generated NOW.@@ -385,44 +426,58 @@ -- We need the above to subtract "program startup" overhead. This -- operation itself adds n bytes for the size of GCStats, but we -- subtract again that later.- let !_ = force (run arg)+ let !result = force (run arg) performGC -- The above forces getStats data to be generated NOW. !actionStats <- GHCStats.getStats let reflectionGCs = 1 -- We performed an additional GC. actionBytes =- (GHCStats.totalBytesAllocated actionStats -- GHCStats.totalBytesAllocated bootupStats) -+ (GHCStats.totalBytesAllocated actionStats `subtracting`+ GHCStats.totalBytesAllocated bootupStats) `subtracting` -- We subtract the size of "bootupStats", which will be -- included after we did the performGC. fromIntegral ghcStatsSizeInBytes actionGCs =- GHCStats.gcCount actionStats - GHCStats.gcCount bootupStats -+ GHCStats.gcCount actionStats `subtracting` GHCStats.gcCount bootupStats `subtracting` reflectionGCs -- If overheadBytes is too large, we conservatively just -- return zero. It's not perfect, but this library is for -- measuring large quantities anyway. actualBytes = max 0 actionBytes liveBytes =- max 0 (GHCStats.liveBytes actionStats - GHCStats.liveBytes bootupStats)+ (GHCStats.liveBytes actionStats `subtracting`+ GHCStats.liveBytes bootupStats) maxBytes =- max- 0- (GHCStats.maxBytesInUse actionStats -- GHCStats.maxBytesInUse bootupStats)- return- ( fromIntegral actualBytes- , fromIntegral actionGCs- , fromIntegral liveBytes- , fromIntegral maxBytes)+ (GHCStats.maxBytesInUse actionStats `subtracting`+ GHCStats.maxBytesInUse bootupStats)+ maxOSBytes =+ (GHCStats.maxOSBytes actionStats `subtracting`+ GHCStats.maxOSBytes bootupStats)+ return (result, (actualBytes, actionGCs, liveBytes, maxBytes, maxOSBytes)) --- | Weigh an IO action. This function is heavily documented inside.+subtracting :: (Ord p, Num p) => p -> p -> p+subtracting x y =+ if x > y+ then x - y+ else 0++-- | Weigh an IO action. This function is based on `weighActionResult`, which is+-- heavily documented inside. weighAction :: (NFData a) => (b -> IO a) -- ^ A function whose memory use we want to measure. -> b -- ^ Argument to the function. Doesn't have to be forced.- -> IO (Int64,Int64,Int64,Int64) -- ^ Bytes allocated and garbage collections.-weighAction run !arg = do+ -> IO (Word64,Word32,Word64,Word64,Word64) -- ^ Bytes allocated and garbage collections.+weighAction run !arg = snd <$> weighActionResult run arg++-- | Weigh an IO action, and return the result. This function is heavily+-- documented inside.+weighActionResult+ :: (NFData a)+ => (b -> IO a) -- ^ A function whose memory use we want to measure.+ -> b -- ^ Argument to the function. Doesn't have to be forced.+ -> IO (a, (Word64,Word32,Word64,Word64,Word64)) -- ^ Result, Bytes allocated and GCs.+weighActionResult run !arg = do ghcStatsSizeInBytes <- GHCStats.getGhcStatsSizeInBytes performGC -- The above forces getStats data to be generated NOW.@@ -430,36 +485,43 @@ -- We need the above to subtract "program startup" overhead. This -- operation itself adds n bytes for the size of GCStats, but we -- subtract again that later.- !_ <- fmap force (run arg)+ !result <- fmap force (run arg) performGC -- The above forces getStats data to be generated NOW. !actionStats <- GHCStats.getStats let reflectionGCs = 1 -- We performed an additional GC. actionBytes =- (GHCStats.totalBytesAllocated actionStats -- GHCStats.totalBytesAllocated bootupStats) -+ (GHCStats.totalBytesAllocated actionStats `subtracting`+ GHCStats.totalBytesAllocated bootupStats) `subtracting` -- We subtract the size of "bootupStats", which will be -- included after we did the performGC. fromIntegral ghcStatsSizeInBytes actionGCs =- GHCStats.gcCount actionStats - GHCStats.gcCount bootupStats -+ GHCStats.gcCount actionStats `subtracting` GHCStats.gcCount bootupStats `subtracting` reflectionGCs -- If overheadBytes is too large, we conservatively just -- return zero. It's not perfect, but this library is for -- measuring large quantities anyway. actualBytes = max 0 actionBytes liveBytes =- max 0 (GHCStats.liveBytes actionStats - GHCStats.liveBytes bootupStats)+ max 0 (GHCStats.liveBytes actionStats `subtracting` GHCStats.liveBytes bootupStats) maxBytes = max 0- (GHCStats.maxBytesInUse actionStats -+ (GHCStats.maxBytesInUse actionStats `subtracting` GHCStats.maxBytesInUse bootupStats)- return- ( fromIntegral actualBytes- , fromIntegral actionGCs- , fromIntegral liveBytes- , fromIntegral maxBytes)+ maxOSBytes =+ max+ 0+ (GHCStats.maxOSBytes actionStats `subtracting`+ GHCStats.maxOSBytes bootupStats)+ return (result,+ ( actualBytes+ , actionGCs+ , liveBytes+ , maxBytes+ , maxOSBytes+ )) -------------------------------------------------------------------------------- -- Formatting functions@@ -512,6 +574,8 @@ , (Live, (False, "Live")) , (Check, (True, "Check")) , (Max, (False, "Max"))+ , (MaxOS, (False, "MaxOS"))+ , (WallTime, (False, "Wall Time")) ] toRow (w, err) = [ (Case, (True, takeLastAfterBk $ weightLabel w))@@ -519,6 +583,8 @@ , (GCs, (False, commas (weightGCs w))) , (Live, (False, commas (weightLiveBytes w))) , (Max, (False, commas (weightMaxBytes w)))+ , (MaxOS, (False, commas (weightMaxOSBytes w)))+ , (WallTime, (False, printf "%.3fs" (weightWallTime w))) , ( Check , ( True , case err of
src/Weigh/GHCStats.hs view
@@ -10,37 +10,16 @@ ,gcCount ,totalBytesAllocated ,liveBytes- ,maxBytesInUse)+ ,maxBytesInUse+ ,maxOSBytes+ ) where -#if __GLASGOW_HASKELL__ < 802-import Data.Int-#else-import Data.Int import Data.Word-#endif import GHC.Stats import System.Mem -#if __GLASGOW_HASKELL__ < 802 -- | Get GHC's statistics.-getStats :: IO GCStats-getStats = getGCStats--gcCount :: GCStats -> Int64-gcCount = numGcs--totalBytesAllocated :: GCStats -> Int64-totalBytesAllocated = bytesAllocated--liveBytes :: GCStats -> Int64-liveBytes = currentBytesUsed--maxBytesInUse :: GCStats -> Int64-maxBytesInUse = maxBytesUsed--#else--- | Get GHC's statistics. getStats :: IO RTSStats getStats = getRTSStats @@ -51,24 +30,26 @@ totalBytesAllocated = allocated_bytes liveBytes :: RTSStats -> Word64-liveBytes = cumulative_live_bytes+liveBytes = gcdetails_live_bytes . gc maxBytesInUse :: RTSStats -> Word64 maxBytesInUse = max_live_bytes-#endif +maxOSBytes :: RTSStats -> Word64+maxOSBytes = max_mem_in_use_bytes+ -- | Get the size of a 'RTSStats' object in bytes.-getGhcStatsSizeInBytes :: IO Int64+getGhcStatsSizeInBytes :: IO Word64 getGhcStatsSizeInBytes = do s1 <- oneGetStats- s2 <- twoGetSTats+ s2 <- twoGetStats return (fromIntegral (totalBytesAllocated s2 - totalBytesAllocated s1)) where oneGetStats = do performGC !s <- getStats return s- twoGetSTats = do+ twoGetStats = do performGC !_ <- getStats !s <- getStats
weigh.cabal view
@@ -1,5 +1,5 @@ name: weigh-version: 0.0.12+version: 0.0.18 synopsis: Measure allocations of a Haskell functions/values description: Please see README.md homepage: https://github.com/fpco/weigh#readme@@ -25,13 +25,16 @@ , mtl , split , temporary+ , criterion-measurement default-language: Haskell2010+ if impl(ghc < 8.2.1)+ buildable: False test-suite weigh-test default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: src/test- ghc-options: -O2+ ghc-options: -O2 -Wall main-is: Main.hs build-depends: base , weigh