diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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 diff --git a/src/Weigh.hs b/src/Weigh.hs --- a/src/Weigh.hs +++ b/src/Weigh.hs @@ -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 diff --git a/src/Weigh/GHCStats.hs b/src/Weigh/GHCStats.hs --- a/src/Weigh/GHCStats.hs +++ b/src/Weigh/GHCStats.hs @@ -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 diff --git a/weigh.cabal b/weigh.cabal --- a/weigh.cabal +++ b/weigh.cabal @@ -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