diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,10 @@ -# weigh [![Build Status](https://travis-ci.org/fpco/weigh.svg)](https://travis-ci.org/fpco/weigh) +# weigh [![Tests](https://github.com/fpco/weigh/actions/workflows/tests.yml/badge.svg)](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 diff --git a/src/Weigh.hs b/src/Weigh.hs --- a/src/Weigh.hs +++ b/src/Weigh.hs @@ -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 diff --git a/src/Weigh/GHCStats.hs b/src/Weigh/GHCStats.hs --- a/src/Weigh/GHCStats.hs +++ b/src/Weigh/GHCStats.hs @@ -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 diff --git a/weigh.cabal b/weigh.cabal --- a/weigh.cabal +++ b/weigh.cabal @@ -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