data-size 0.1.0.4 → 0.1.1.1
raw patch · 3 files changed
+362/−216 lines, 3 files
Files
- Data/Size/Base.hs +201/−75
- Data/Size/Instances.hs +160/−137
- data-size.cabal +1/−4
Data/Size/Base.hs view
@@ -1,24 +1,35 @@ {-# LANGUAGE BangPatterns #-} module Data.Size.Base- ( Size+ ( Bytes+ , Size , SizeTable , SizeStatistics , Sizeable(..) , bitsPerWord , bytesPerWord+ , bytesPerChar , bytesToWords- , mksize+ , wordAlign+ , mkBytes+ , mkSize , dataSize , singletonSize+ , dataOfObj+ , dataOfConstr+ , dataOfPtr+ , dataOfSingleton , (.*.)+ , typeName , setName , addSize , addPart- , mkstats- , showstats+ , mkObject+ , mkStats+ , constrStats+ , showStats , mempty -- re-export of Monoid , mappend@@ -27,10 +38,11 @@ ) where -import qualified Data.List as L-import qualified Data.Map.Strict as M+import qualified Data.List as L+import qualified Data.Map.Strict as M import Data.Monoid import Data.Typeable+import qualified Foreign.Storable as FS -- ---------------------------------------- @@ -41,6 +53,9 @@ bytesPerWord :: Int bytesPerWord = bitsPerWord `div` 8 +bytesPerChar :: Int+bytesPerChar = FS.sizeOf ' '+ bitsPerWord :: Int bitsPerWord = cnt 1 $ iterate (*2) (1::Int) where@@ -55,12 +70,63 @@ -- -------------------- +data Bytes+ = Bytes+ { _bytes :: ! Int+ , _align :: ! Int+ }+ deriving (Eq, Show)++instance Monoid Bytes where+ mempty+ = Bytes 0 1+ (Bytes bs1 al1) `mappend` (Bytes bs2 al2)+ = Bytes (align bs1 al2 + bs2) (al1 `max` al2)++instance Scale Bytes where+ i .*. (Bytes bs al)+ = Bytes (i * bs) al++align :: Int -> Int -> Int+align x a+ = (x + (a - 1)) `div` a * a++mkBytes :: Int -> Int -> Bytes+mkBytes bs' al'+ = Bytes (align bs al) al+ where+ bs = bs' `max` 0+ al = al' `max` 1++wordAlign :: Bytes -> Bytes+wordAlign x+ = x <> Bytes 0 bytesPerWord++dataOfSingleton :: Bytes+dataOfSingleton+ = Bytes 0 bytesPerWord++dataOfConstr :: Bytes+dataOfConstr+ = Bytes bytesPerWord bytesPerWord++dataOfPtr :: Bytes+dataOfPtr+ = Bytes bytesPerWord bytesPerWord++dataOfObj :: Bytes -> Bytes+dataOfObj w@(Bytes bs _al)+ | bs == 0 = w -- singleton+ | otherwise = wordAlign $ dataOfConstr <> w++-- --------------------+ -- | Counter for # of objects and # of words data Size = Size { _objCnt :: ! Int- , _wordCnt :: ! Int+ , _byteCnt :: ! Int } deriving (Eq, Show) @@ -70,14 +136,15 @@ -- If # words for the data is 0, it's a singleton, -- so the # of objects are not accumulated -mksize :: Int -> Size-mksize 0 = singletonSize-mksize n = Size 1 (n + 1) -- one word for constructor+mkSize :: Bytes -> Size+mkSize (Bytes n _)+ | n == 0 = singletonSize+ | otherwise = Size 1 n --- get the # of words for the data fields of a value+-- get the # of bytes for the data fields of a value, without counting the constructor field dataSize :: Size -> Int-dataSize (Size _o w) = (w - 1) `max` 0 -- decrement constructor size+dataSize (Size _o w) = (w - bytesPerWord) `max` 0 -- decrement constructor size -- | The size value of a singleton --@@ -104,7 +171,7 @@ -- -------------------- newtype SizeTable- = ST (M.Map String Size)+ = ST (M.Map (String, String) Size) deriving (Show) instance Monoid SizeTable where@@ -123,13 +190,13 @@ data SizeStatistics = SST- { _nameof :: ! String- , _accu :: ! Size- , _parts :: ! SizeTable+ { _nameof :: String+ , _accu :: Size+ , _parts :: SizeTable }+-- deriving Show -instance Show SizeStatistics where- show = showstats+instance Show SizeStatistics where show = showStats instance Monoid SizeStatistics where mempty = SST "" mempty mempty@@ -153,26 +220,27 @@ -- -------------------- -class Typeable a => Sizeable a where- nameof :: a -> String- sizeof :: a -> Size- statsof :: a -> SizeStatistics+class (Typeable a) => Sizeable a where+ nameOf :: a -> String+ dataOf :: a -> Bytes+ bytesOf :: a -> Bytes+ objectsOf :: a -> Size+ statsOf :: a -> SizeStatistics - nameof x- | m == "GHC.Types" = n- | otherwise = m ++ "." ++ n- where- t = fst . splitTyConApp . typeOf $ x- m = tyConModule t- n = tyConName t+ nameOf = typeName+ bytesOf = dataOfObj . dataOf+ objectsOf = _accu . statsOf+ statsOf = mkStats - sizeof _ = mksize 1 -- defaults for primitive types- statsof x = mkstats x "" 1 -- " " " " +typeName :: Typeable a => a -> String+typeName+ = show . typeOf+ -- ------------------------------------------------------------ -insertSizeTable :: String -> Size -> SizeTable -> SizeTable-insertSizeTable k v (ST t) = ST $ M.insertWith (<>) k v t+insertSizeTable :: (String, String) -> Size -> SizeTable -> SizeTable+insertSizeTable tn v (ST t) = ST $ M.insertWith (<>) tn v t -- ------------------------------------------------------------ @@ -184,69 +252,127 @@ addSize c st = st { _accu = c <> _accu st } -addPart :: String -> Size -> SizeStatistics -> SizeStatistics-addPart n c st- = st { _parts = insertSizeTable n c $ _parts st }+addPart :: String -> String -> Size -> SizeStatistics -> SizeStatistics+addPart tn cn c st+ = st { _parts = insertSizeTable (tn, cn) c $ _parts st } -mkstats :: Sizeable a => a -> String -> Int -> SizeStatistics-mkstats x cn w+mkObject :: Sizeable a => a -> Size+mkObject x+ | n == 0 = singletonSize+ | otherwise = Size 1 n+ where+ (Bytes n _) = bytesOf x++mkStats :: (Sizeable a) => a -> SizeStatistics+mkStats = constrStats ""++constrStats :: (Sizeable a) => String -> a -> SizeStatistics+constrStats cn x = st3 where- n = nameof x- cnt = Size 1 (if w == 0 then 0 else w + 1) -- overhead for tagfield- st1 = addSize cnt $ setName n $ mempty- st2 = addPart n cnt st1- st3 | null cn = st2- | otherwise = addPart (n ++ " " ++ cn) cnt st2+ nm = nameOf x+ cnt = mkObject x+ st1 = addSize cnt $ setName nm $ mempty -- add the stats for the datatype+ st2 = addPart nm "" cnt st1+ st3 | null cn = st2+ | otherwise = addPart nm cn cnt st2 -- add the stats for the constructor -showstats :: SizeStatistics -> String-showstats (SST name cnt (ST parts))+showStats :: SizeStatistics -> String+showStats (SST name (Size oc bc) (ST parts)) = unlines $ header ++ "total value:"- : toLine name cnt+ : toLine' ( (charToString name, "")+ , (showNum oc, showNum . bytesToWords $ bc)+ ) : "" : "components:"- : (L.map (uncurry toLine) . M.toList $ parts)+ : toTable where- ! widthName = L.maximum . L.map length . ([col1, name] ++) . M.keys- $ parts- ! widthObj = 16 `max` length col2- ! widthWord = 16 `max` length col3+ statsTable = L.map toString . M.toList $ parts++ toString :: ((String, String), Size) -> ((String, String), (String, String))+ toString ((tn, cn), Size os bs)+ = ( ( if null cn+ then charToString tn+ else blankName+ , cn+ )+ , ( showNum os+ , showNum . bytesToWords $ bs+ )+ )+ toTable+ = L.map toLine' $ statsTable++ toLine' :: ((String, String), (String, String)) -> String+ toLine' ((tn, cn), (os, bs))+ = unwords [ if null cn+ then expR widthCol1 tn+ else blankName ++ expR widthCol1 cn+ , expL widthCol2 os+ , expL widthCol3 bs+ ]++ blankName = replicate 8 ' '++ widthCol1+ = 16 `max` length col1 `max` (L.maximum . L.map (uncurry width . fst) $ statsTable)+ where+ width tn cn+ = length tn + length cn+ widthCol2+ = 16 `max` length col2 `max` (L.maximum . L.map (length . fst . snd) $ statsTable)++ widthCol3+ = 16 `max`length col3 `max` (L.maximum . L.map (length . snd . snd) $ statsTable)++ charToString+ = subst "[Char]" "String"+ col1 = "type/constructor" col2 = "# object" col3 = "# word" ++ show bitsPerWord header = [l1, l2, l3] where- l1 = unwords [ expR widthName col1- , expL widthObj col2- , expL widthWord col3+ l1 = unwords [ expR widthCol1 col1+ , expL widthCol2 col2+ , expL widthCol3 col3 ] l2 = map (const '=') l1 l3 = "" - toLine n (Size o w)- = unwords [ indentConstr widthName n- , expL widthObj $ show o- , expL widthWord $ show w- ]- indentConstr i n- | length ws == 2 = replicate 8 ' ' ++ expR i (concat . drop 1 $ ws)- | otherwise = expR i n- where- ws = words n+expL :: Int -> String -> String+expL n s+ | n < n' = s+ | otherwise = reverse . take n . reverse . (replicate n ' ' ++) $ s+ where+ n' = length s - expL n s- | n < n' = s- | otherwise = reverse . take n . reverse . (replicate n ' ' ++) $ s- where- n' = length s+expR :: Int -> String -> String+expR n s+ | n < n' = s+ | otherwise = take n $ s ++ replicate n ' '+ where+ n' = length s - expR n s- | n < n' = s- | otherwise = take n $ s ++ replicate n ' '- where- n' = length s+showNum :: Int -> String+showNum+ = reverse . insComma . reverse . show+ where+ insComma (x1 : x2 : x3 : xs4@(_ : _))+ = x1 : x2 : x3 : ',' : insComma xs4+ insComma xs+ = xs++subst :: String -> String -> String -> String+subst _ _ []+ = []+subst xs ys inp+ | L.isPrefixOf xs inp+ = ys ++ subst xs ys (L.drop (length xs) inp)+ | otherwise+ = head inp : subst xs ys (tail inp) -- ------------------------------------------------------------
Data/Size/Instances.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns #-}-{-# OPTIONS -fno-warn-orphans #-}+{-# OPTIONS -fno-warn-orphans #-} module Data.Size.Instances where@@ -13,211 +13,226 @@ import qualified Data.IntSet as IS import qualified Data.Map as M +import qualified Foreign.Storable as FS+ -- ---------------------------------------- -instance Sizeable Bool where-instance Sizeable Int where-instance Sizeable Char where-instance Sizeable Double where- sizeof _ = mksize (64 `div` bitsPerWord)- statsof x = mkstats x "" (64 `div` bitsPerWord)+instance Sizeable Bool where dataOf = dataOfStorable+instance Sizeable Int where dataOf = dataOfStorable+instance Sizeable Char where dataOf = dataOfStorable+instance Sizeable Float where dataOf = dataOfStorable+instance Sizeable Double where dataOf = dataOfStorable +dataOfStorable :: FS.Storable a => a -> Bytes+dataOfStorable x+ = mkBytes (FS.sizeOf x) (FS.alignment x)++dataOfBool :: Bytes+dataOfBool+ = dataOfStorable (undefined :: Bool)++dataOfInt :: Bytes+dataOfInt+ = dataOfStorable (undefined :: Int)++dataOfChar :: Bytes+dataOfChar+ = dataOfStorable (undefined :: Char)++dataOfFloat :: Bytes+dataOfFloat+ = dataOfStorable (undefined :: Float)++dataOfDouble :: Bytes+dataOfDouble+ = dataOfStorable (undefined :: Double)+ -- -------------------- instance (Sizeable t1, Sizeable t2) => Sizeable (t1, t2) where- nameof (x1, x2)- = concat ["("- , nameof x1- , ","- , nameof x2- , ")"- ]- sizeof (x1, x2)- = mksize 2- <>- sizeof x1 <> sizeof x2- statsof xs@(x1, x2)- = mkstats xs "" 2+ dataOf (_x1, _x2)+ = 2 .*. dataOfPtr++ statsOf xs@(x1, x2)+ = mkStats xs <>- statsof x1 <> statsof x2+ statsOf x1 <> statsOf x2 -- -------------------- instance (Sizeable t1, Sizeable t2, Sizeable t3) => Sizeable (t1, t2, t3) where- nameof (x1, x2, x3)- = concat ["("- , nameof x1- , ","- , nameof x2- , ","- , nameof x3- , ")"- ]- sizeof (x1, x2, x3)- = mksize 3- <>- sizeof x1 <> sizeof x2 <> sizeof x3- statsof xs@(x1, x2, x3)- = mkstats xs "" 3+ dataOf (_x1, _x2, _x3)+ = 3 .*. dataOfPtr++ statsOf xs@(x1, x2, x3)+ = mkStats xs <>- statsof x1 <> statsof x2 <> statsof x3+ statsOf x1 <> statsOf x2 <> statsOf x3 -- -------------------- instance (Sizeable t1, Sizeable t2, Sizeable t3, Sizeable t4) => Sizeable (t1, t2, t3, t4) where- nameof (x1, x2, x3, x4)- = concat ["("- , nameof x1- , ","- , nameof x2- , ","- , nameof x3- , ","- , nameof x4- , ")"- ]- sizeof (x1, x2, x3, x4)- = mksize 4- <>- sizeof x1 <> sizeof x2 <> sizeof x3 <> sizeof x4- statsof xs@(x1, x2, x3, x4)- = mkstats xs "" 4+ dataOf (_x1, _x2, _x3, _x4)+ = 4 .*. dataOfPtr++ statsOf xs@(x1, x2, x3, x4)+ = mkStats xs <>- statsof x1 <> statsof x2 <> statsof x3 <> statsof x4+ statsOf x1 <> statsOf x2 <> statsOf x3 <> statsOf x4 -- -------------------- +instance (Sizeable t) => Sizeable (Maybe t) where+ dataOf x+ = case x of+ Just _ -> dataOfPtr+ Nothing -> dataOfSingleton++ statsOf x+ = case x of+ Just x1 -> constrStats "Just" x <> statsOf x1+ Nothing -> constrStats "Nothing" x++-- --------------------++instance (Sizeable t1, Sizeable t2) => Sizeable (Either t1 t2) where+ dataOf x+ = case x of+ Left _ -> dataOfPtr+ Right _ -> dataOfPtr++ statsOf x+ = case x of+ Left x1 -> constrStats "Left" x <> statsOf x1+ Right x1 -> constrStats "Right" x <> statsOf x1++-- --------------------+--+-- in list statistics the constructors ([] and (:) are not counted+-- just the # of lists and the total # of cells used for all the (:) nodes+ instance Sizeable a => Sizeable [a] where- nameof xs- = listTypeName (nameof (head xs))- sizeof- = mconcat . L.map sizeof- statsof xs+ dataOf xs+ = length xs .*. (dataOfConstr <> (2 .*. dataOfPtr))++ bytesOf -- Lists are handled as a single object,+ = dataOf -- all space is already accumulated in dataOf++ statsOf xs | null xs- = mkstats xs "[]" 0+ = mkStats xs - | nameof hd `elem` ["Char", "Int", "Double", "Float", "Bool"]- = mkstats xs "[]" 0- <>- len .*. mkstats xs "(:)" 2+ | nameOf hd `elem` ["Char", "Int", "Double", "Float", "Bool"]+ = mkStats xs <>- len .*. statsof hd+ len .*. statsOf hd | otherwise- = mkstats xs "[]" 0- <>- len .*. mkstats xs "(:)" 2+ = mkStats xs <>- (mconcat . L.map statsof $ xs)+ (mconcat . L.map statsOf $ xs) where hd = head xs len = length xs -listTypeName :: String -> String-listTypeName n- | n == "Char" = "String"- | otherwise = "[" ++ n ++ "]"- -- -------------------- instance Sizeable IS.IntSet where- sizeof s+ dataOf s | IS.null s- = mksize 0+ = dataOfSingleton | otherwise- = len .*. mksize 2+ = len .*. (dataOfObj $ dataOfInt <> dataOfInt) <>- (len - 1) .*. mksize 4+ (len - 1) .*. (dataOfObj $ dataOfInt <> dataOfInt <> dataOfPtr <> dataOfPtr) where len = countTips s - statsof s- | IS.null s- = mkstats s "Nil" 0- | otherwise- = len .*. mkstats s "Tip" 2- <>- (len - 1) .*. mkstats s "Bin" 4- where- len = countTips s+ countTips :: IS.IntSet -> Int+ countTips = cnt 0 . IS.elems+ where+ cnt !i []+ = i+ cnt !i xs@(x : _)+ = cnt (i + 1) $+ dropWhile (\ y -> y `div` bitsPerWord == x `div` bitsPerWord) xs --- hack: Data.IntSet.Base is hidden, so we have to look into the source--- and compute the size by hand+ bytesOf -- IntSet is handled as a single object,+ = dataOf -- all space is already accumulated in dataOf -countTips :: IS.IntSet -> Int-countTips = cnt 0 . IS.elems- where- cnt !i []- = i- cnt !i xs@(x : _)- = cnt (i + 1) $ dropWhile (\ y -> y `div` bitsPerWord == x `div` bitsPerWord) xs+ statsOf+ = mkStats -- -------------------- instance Sizeable v => Sizeable (IM.IntMap v) where- sizeof m+ dataOf m | IM.null m- = mksize 0+ = dataOfSingleton | otherwise- = len .*. mksize 2+ = len .*. (dataOfObj $ dataOfInt <> dataOfPtr) <>- (len - 1) .*. mksize 4+ (len - 1) .*. (dataOfObj $ dataOfInt <> dataOfInt <> dataOfPtr <> dataOfPtr) where len = IM.size m - statsof m- | IM.null m- = mkstats m "Nil" 0- | otherwise- = len .*. mkstats m "Tip" 2- <>- (len - 1) .*. mkstats m "Bin" 4- <>- IM.foldr' ((<>) . statsof) mempty m- where- len = IM.size m+ bytesOf -- IntMap is handled as a single object,+ = dataOf -- all space is already accumulated in dataOf + statsOf m+ = mkStats m+ <>+ IM.foldr' ((<>) . statsOf) mempty m+ -- -------------------- instance (Sizeable k, Sizeable v) => Sizeable (M.Map k v) where- sizeof m+ dataOf m | M.null m- = mksize 0+ = dataOfSingleton | otherwise- = len .*. mksize 5- <>- M.foldWithKey (\ k v st -> sizeof k <> sizeof v <> st) mempty m+ = len .*. (dataOfObj $ dataOfInt <> 4 .*. dataOfPtr) where len = M.size m - statsof m- | M.null m- = mkstats m "Tip" 0- | otherwise- = (len + 1) .*. mkstats m "Tip" 0- <>- len .*. mkstats m "Bin" 5- <>- M.foldWithKey (\ k v st -> statsof k <> statsof v <> st) mempty m+ bytesOf -- Map is handled as a single object,+ = dataOf -- all space is already accumulated in dataOf++ statsOf m+ = mkStats m+ <>+ (mconcat . L.map (uncurry statsOfPair) $ M.toList m) where- len = M.size m+ statsOfPair k v+ = statsOf k <> statsOf v + -- -------------------- {- data BS.ByteString = PS {-# UNPACK #-} !(ForeignPtr Word8) -- payload {-# UNPACK #-} !Int -- offset {-# UNPACK #-} !Int -- length+data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents++data ForeignPtrContents+ = PlainForeignPtr !(IORef (Finalizers, [IO ()]))+ | MallocPtr (MutableByteArray# RealWorld) !(IORef (Finalizers, [IO ()]))+ | PlainPtr (MutableByteArray# RealWorld) -} instance Sizeable BS.ByteString where- sizeof- = mksize . (3 +) . bytesToWords . BS.length+ dataOf bs+ = (dataOfPtr <> 2 .*. dataOfInt) -- size of ByteString data+ <> (dataOfObj $ dataOfPtr <> dataOfPtr) -- size of ForeignPtr object+ <> (wordAlign $ -- size of byte sequence+ BS.length bs .*. dataOfChar+ ) - statsof s- = mkstats s "" (dataSize . sizeof $ s)+ statsOf s+ = mkStats s -- -------------------- @@ -227,12 +242,20 @@ -} instance Sizeable BL.ByteString where- sizeof- = mconcat . L.map sizeof' . BL.toChunks- where- sizeof' c = mksize (3 + 1 + bytesToWords (BS.length c))+ nameOf+ = (++ " (lazy)") . typeName - statsof s- = mkstats s "" (dataSize . sizeof $ s)+ dataOf bs+ = length cs .*. (dataOfObj $ dataOfPtr <> dataOfPtr)+ <>+ (mconcat . L.map bytesOf $ cs)+ where+ cs = BL.toChunks bs++ bytesOf -- ByteString is handled as a single object,+ = dataOf -- all space is already accumulated in dataOf++ statsOf+ = mkStats -- ------------------------------------------------------------
data-size.cabal view
@@ -1,8 +1,5 @@--- Initial data-size.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/- name: data-size-version: 0.1.0.4+version: 0.1.1.1 synopsis: Profiling of data structures description: Profiling of data structures for counting the # of object allocated for a value