weigh 0.0.5 → 0.0.6
raw patch · 4 files changed
+126/−82 lines, 4 filesdep ~basedep ~mtl
Dependency ranges changed: base, mtl
Files
- CHANGELOG +4/−0
- src/Weigh.hs +62/−39
- src/Weigh/GHCStats.hs +59/−42
- weigh.cabal +1/−1
CHANGELOG view
@@ -1,3 +1,7 @@+0.0.6:+ * Support GHC 8.2+ * Use more reliable calculations+ 0.0.4: * Added more system-independent word size calculation
src/Weigh.hs view
@@ -58,8 +58,7 @@ import Data.List import Data.List.Split import Data.Maybe-import GHC.Int-import GHC.Stats+import Data.Int import Prelude import System.Environment import System.Exit@@ -68,7 +67,7 @@ import System.Mem import System.Process import Text.Printf-import Weigh.GHCStats+import qualified Weigh.GHCStats as GHCStats -------------------------------------------------------------------------------- -- Types@@ -303,32 +302,44 @@ => (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 performGC- -- The above forces getGCStats data to be generated NOW.- !bootupStats <- getGCStats+weighFunc run !arg = do+ ghcStatsSizeInBytes <- GHCStats.getGhcStatsSizeInBytes+ performGC+ -- The above forces getStats data to be generated NOW.+ !bootupStats <- GHCStats.getStats -- 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)- performGC- -- The above forces getGCStats data to be generated NOW.- !actionStats <- getGCStats- let reflectionGCs = 1 -- We performed an additional GC.- actionBytes =- (bytesAllocated actionStats - bytesAllocated bootupStats) -+ let !_ = 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) - -- We subtract the size of "bootupStats", which will be -- included after we did the performGC.- ghcStatsSizeInBytes- actionGCs = numGcs actionStats - numGcs bootupStats - reflectionGCs+ fromIntegral ghcStatsSizeInBytes+ actionGCs =+ GHCStats.gcCount actionStats - GHCStats.gcCount bootupStats -+ 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 (currentBytesUsed actionStats -- currentBytesUsed bootupStats)- maxBytes = max 0 (maxBytesUsed actionStats - maxBytesUsed bootupStats)- return (actualBytes,actionGCs,liveBytes, maxBytes)+ actualBytes = max 0 actionBytes+ liveBytes =+ max 0 (GHCStats.liveBytes actionStats - GHCStats.liveBytes bootupStats)+ maxBytes =+ max+ 0+ (GHCStats.maxBytesInUse actionStats -+ GHCStats.maxBytesInUse bootupStats)+ return+ ( fromIntegral actualBytes+ , fromIntegral actionGCs+ , fromIntegral liveBytes+ , fromIntegral maxBytes) -- | Weigh a pure function. This function is heavily documented inside. weighAction@@ -336,32 +347,44 @@ => (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 performGC- -- The above forces getGCStats data to be generated NOW.- !bootupStats <- getGCStats+weighAction run !arg = do+ ghcStatsSizeInBytes <- GHCStats.getGhcStatsSizeInBytes+ performGC+ -- The above forces getStats data to be generated NOW.+ !bootupStats <- GHCStats.getStats -- 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)- performGC- -- The above forces getGCStats data to be generated NOW.- !actionStats <- getGCStats- let reflectionGCs = 1 -- We performed an additional GC.- actionBytes =- (bytesAllocated actionStats - bytesAllocated bootupStats) -+ !_ <- 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) - -- We subtract the size of "bootupStats", which will be -- included after we did the performGC.- ghcStatsSizeInBytes- actionGCs = numGcs actionStats - numGcs bootupStats - reflectionGCs+ fromIntegral ghcStatsSizeInBytes+ actionGCs =+ GHCStats.gcCount actionStats - GHCStats.gcCount bootupStats -+ 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 (currentBytesUsed actionStats -- currentBytesUsed bootupStats)- maxBytes = max 0 (maxBytesUsed actionStats - maxBytesUsed bootupStats)- return (actualBytes,actionGCs,liveBytes, maxBytes)+ actualBytes = max 0 actionBytes+ liveBytes =+ max 0 (GHCStats.liveBytes actionStats - GHCStats.liveBytes bootupStats)+ maxBytes =+ max+ 0+ (GHCStats.maxBytesInUse actionStats -+ GHCStats.maxBytesInUse bootupStats)+ return+ ( fromIntegral actualBytes+ , fromIntegral actionGCs+ , fromIntegral liveBytes+ , fromIntegral maxBytes) -------------------------------------------------------------------------------- -- Formatting functions
src/Weigh/GHCStats.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-}@@ -5,51 +6,67 @@ -- | Calculate the size of GHC.Stats statically. module Weigh.GHCStats- (ghcStatsSizeInBytes)+ (getGhcStatsSizeInBytes+ ,getStats+ ,gcCount+ ,totalBytesAllocated+ ,liveBytes+ ,maxBytesInUse) where -#include "MachDeps.h"-+import Data.Int+import Data.Word import GHC.Stats-import GHC.Int-import Language.Haskell.TH-import Data.List+import System.Mem --- | Get the size of a 'GHCStats' object in bytes.-ghcStatsSizeInBytes :: Int64-ghcStatsSizeInBytes =- $(do info <- reify ''GHC.Stats.GCStats- case info of-#if __GLASGOW_HASKELL__ >= 800- TyConI (DataD _ _ _ _ [RecC _ fields] _) ->+#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- TyConI (DataD _ _ _ [RecC _ fields] _) ->+-- | Get GHC's statistics.+getStats :: IO RTSStats+getStats = getRTSStats++gcCount :: RTSStats -> Word32+gcCount = gcs++totalBytesAllocated :: RTSStats -> Word64+totalBytesAllocated = allocated_bytes++liveBytes :: RTSStats -> Word64+liveBytes = cumulative_live_bytes++maxBytesInUse :: RTSStats -> Word64+maxBytesInUse = max_live_bytes #endif- do total <-- fmap (foldl' (+) headerSize)- (mapM fieldSize fields)- litE (IntegerL (fromIntegral total))- where headerSize = SIZEOF_HSWORD- fieldSize- :: (name,strict,Type) -> Q Int64- fieldSize (_,_,typ) =- case typ of- ConT typeName ->- case lookup typeName knownTypes of- Nothing ->- fail ("Unknown size for type " ++- show typeName ++- ". Please report this as a bug, the codebase needs updating.")- Just size -> return size- _ ->- fail ("Unexpected type shape: " ++- show typ ++- ". Please report this as a bug, the codebase needs updating.")- knownTypes :: [(Name,Int64)]- knownTypes =- map (,SIZEOF_HSWORD)- [''Int64,''Int32,''Int8,''Int16,''Double]- _ ->- fail ("Unexpected shape of GCStats data type. " ++- "Please report this as a bug, this function " ++- "needs to be updated to the newer GCStats type."))++-- | Get the size of a 'RTSStats' object in bytes.+getGhcStatsSizeInBytes :: IO Int64+getGhcStatsSizeInBytes = do+ s1 <- oneGetStats+ s2 <- twoGetSTats+ pure (fromIntegral (totalBytesAllocated s2 - totalBytesAllocated s1))+ where+ oneGetStats = do+ performGC+ !s <- getStats+ pure s+ twoGetSTats = do+ performGC+ !_ <- getStats+ !s <- getStats+ pure s
weigh.cabal view
@@ -1,5 +1,5 @@ name: weigh-version: 0.0.5+version: 0.0.6 synopsis: Measure allocations of a Haskell functions/values description: Please see README.md homepage: https://github.com/fpco/weigh#readme