data-size (empty) → 0.1.0.3
raw patch · 6 files changed
+555/−0 lines, 6 filesdep +basedep +bytestringdep +containerssetup-changed
Dependencies added: base, bytestring, containers
Files
- Data/Size.hs +14/−0
- Data/Size/Base.hs +242/−0
- Data/Size/Instances.hs +239/−0
- LICENSE +20/−0
- Setup.hs +2/−0
- data-size.cabal +38/−0
+ Data/Size.hs view
@@ -0,0 +1,14 @@+-- ----------------------------------------++module Data.Size+ ( module Data.Size.Base+ , module Data.Size.Instances+ , module Data.Monoid+ )+where++import Data.Monoid+import Data.Size.Base+import Data.Size.Instances++-- ----------------------------------------
+ Data/Size/Base.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE BangPatterns #-}++module Data.Size.Base+ ( module Data.Size.Base+ , module Data.Monoid+ )+where++import qualified Data.List as L+import qualified Data.Map.Strict as M+import Data.Monoid+import Data.Typeable++-- ----------------------------------------++infix 7 .*.++-- --------------------++bytesPerWord :: Int+bytesPerWord = bitsPerWord `div` 8++bitsPerWord :: Int+bitsPerWord = cnt 1 $ iterate (*2) (1::Int)+ where+ cnt i (x : xs)+ | x < 0 = i+ | otherwise = cnt (i+1) xs+ cnt _ _ -- just to turn of pattern match warning+ = undefined++bytesToWords :: Int -> Int+bytesToWords i = (i + bytesPerWord - 1) `div` bytesPerWord++-- --------------------++-- | Counter for # of objects and # of words++data Size+ = Size+ { _objCnt :: ! Int+ , _wordCnt :: ! Int+ }+ deriving (Eq, Show)++-- | Make a counter for one object with n fields+--+-- constructors count 1 word+-- 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++-- get the # of words for the data fields of a value++dataSize :: Size -> Int+dataSize (Size _o w) = (w - 1) `max` 0 -- decrement constructor size++-- | The size value of a singleton+--+-- Singletons are only counted once++singletonSize :: Size+singletonSize = Size 1 0++instance Monoid Size where+ mempty+ = singletonSize -- Size 0 0+ mappend c1@(Size o1 w1) c2@(Size o2 w2)+ | c1 == singletonSize = c2 -- singletons don't accumulate+ | c2 == singletonSize = c1 -- " " "+ | otherwise = Size (o1 + o2) (w1 + w2)+ mconcat+ = L.foldl' mappend mempty++instance Scale Size where+ i .*. c@(Size o w)+ | c == singletonSize = c+ | otherwise = Size (i*o) (i*w)++-- --------------------++newtype SizeTable+ = ST (M.Map String Size)+ deriving (Show)++instance Monoid SizeTable where+ mempty = ST M.empty+ mappend (ST t1) (ST t2)+ = ST $ M.unionWith (<>) t1 t2+ mconcat+ = L.foldl' mappend mempty++instance Scale SizeTable where+ i .*. (ST t)+ | i == 0 = mempty+ | otherwise = ST $ M.map (i .*.) t++-- --------------------++data SizeStatistics+ = SST+ { _nameof :: ! String+ , _accu :: ! Size+ , _parts :: ! SizeTable+ }++instance Show SizeStatistics where+ show = showstats++instance Monoid SizeStatistics where+ mempty = SST "" mempty mempty+ mappend (SST n1 c1 t1) (SST n2 c2 t2)+ = SST n c t+ where+ n = if null n1 then n2 else n1+ c = c1 <> c2+ t = t1 <> t2+ mconcat+ = L.foldl' mappend mempty++instance Scale SizeStatistics where+ i .*. (SST n c t)+ = SST n (i .*. c) (i .*. t)++-- --------------------++class Monoid a => Scale a where+ (.*.) :: Int -> a -> a++-- --------------------++class Typeable a => Sizeable a where+ nameof :: a -> String+ sizeof :: 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++ sizeof _ = mksize 1 -- defaults for primitive types+ statsof x = mkstats x "" 1 -- " " " "++-- --------------------++nameof' :: Typeable a => a -> String+nameof' x+ | m == "GHC.Types" = n+ | otherwise = m ++ "." ++ n+ where+ t = fst . splitTyConApp . typeOf $ x+ m = tyConModule t+ n = tyConName t++-- ------------------------------------------------------------++insertSizeTable :: String -> Size -> SizeTable -> SizeTable+insertSizeTable k v (ST t) = ST $ M.insertWith (<>) k v t++-- ------------------------------------------------------------++setName :: String -> SizeStatistics -> SizeStatistics+setName n st+ = st { _nameof = n }++addSize :: Size -> SizeStatistics -> SizeStatistics+addSize c st+ = st { _accu = c <> _accu st }++addPart :: String -> Size -> SizeStatistics -> SizeStatistics+addPart n c st+ = st { _parts = insertSizeTable n c $ _parts st }++mkstats :: Sizeable a => a -> String -> Int -> SizeStatistics+mkstats x cn w+ = 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++showstats :: SizeStatistics -> String+showstats (SST name cnt (ST parts))+ = unlines $+ header+ ++ "total value:"+ : toLine name cnt+ : ""+ : "components:"+ : (L.map (uncurry toLine) . M.toList $ parts)+ where+ ! widthName = L.maximum . L.map length . ([col1, name] ++) . M.keys+ $ parts+ ! widthObj = 16 `max` length col2+ ! widthWord = 16 `max` length col3+ 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+ ]+ 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 n s+ | n < n' = s+ | otherwise = reverse . take n . reverse . (replicate n ' ' ++) $ s+ where+ n' = length s++ expR n s+ | n < n' = s+ | otherwise = take n $ s ++ replicate n ' '+ where+ n' = length s++-- ------------------------------------------------------------
+ Data/Size/Instances.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS -fno-warn-orphans #-}++module Data.Size.Instances+where++import qualified Data.List as L+import Data.Monoid+import Data.Size.Base++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.IntMap as IM+import qualified Data.IntSet as IS+import qualified Data.Map as M++-- ----------------------------------------++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 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+ <>+ 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+ <>+ 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+ <>+ statsof x1 <> statsof x2 <> statsof x3 <> statsof x4++-- --------------------++instance Sizeable a => Sizeable [a] where+ nameof xs+ = listTypeName (nameof (head xs))+ sizeof+ = mconcat . L.map sizeof+ statsof xs+ | null xs+ = mkstats xs "[]" 0++ | nameof hd `elem` ["Char", "Int", "Double", "Float", "Bool"]+ = mkstats xs "[]" 0+ <>+ len .*. mkstats xs "(:)" 2+ <>+ len .*. statsof hd++ | otherwise+ = mkstats xs "[]" 0+ <>+ len .*. mkstats xs "(:)" 2+ <>+ (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+ | IS.null s+ = mksize 0+ | otherwise+ = len .*. mksize 2+ <>+ (len - 1) .*. mksize 4+ 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++-- hack: Data.IntSet.Base is hidden, so we have to look into the source+-- and compute the size by hand++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++-- --------------------++instance Sizeable v => Sizeable (IM.IntMap v) where+ sizeof m+ | IM.null m+ = mksize 0+ | otherwise+ = len .*. mksize 2+ <>+ (len - 1) .*. mksize 4+ 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++-- --------------------++instance (Sizeable k, Sizeable v) => Sizeable (M.Map k v) where+ sizeof m+ | M.null m+ = mksize 0+ | otherwise+ = len .*. mksize 5+ <>+ M.foldWithKey (\ k v st -> sizeof k <> sizeof v <> st) mempty m+ 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+ where+ len = M.size m++-- --------------------++{-+data BS.ByteString = PS {-# UNPACK #-} !(ForeignPtr Word8) -- payload+ {-# UNPACK #-} !Int -- offset+ {-# UNPACK #-} !Int -- length+-}++instance Sizeable BS.ByteString where+ sizeof+ = mksize . (3 +) . bytesToWords . BS.length++ statsof s+ = mkstats s "" (dataSize . sizeof $ s)++-- --------------------++{-+ data BL.ByteString = Empty+ | Chunk {-# UNPACK #-} ! BS.ByteString ByteString+-}++instance Sizeable BL.ByteString where+ sizeof+ = mconcat . L.map sizeof' . BL.toChunks+ where+ sizeof' c = mksize (3 + 1 + bytesToWords (BS.length c))++ statsof s+ = mkstats s "" (dataSize . sizeof $ s)++-- ------------------------------------------------------------
+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2013 Uwe Schmidt++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ data-size.cabal view
@@ -0,0 +1,38 @@+-- 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.3+synopsis: Profiling of data structures+description: Profiling of data structures+ for counting the # of object allocated for a value+ and estimating the total # of words used for a value.+ Statistics for every type or constructor+ occuring as component or subcomponent are gathered.+license: MIT+license-file: LICENSE+author: Uwe Schmidt+maintainer: uwe@fh-wedel.de+copyright: 2013 Uwe Schmidt+category: Testing+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++library+ exposed-modules: Data.Size+ Data.Size.Base+ other-modules: Data.Size.Instances++ other-extensions: DeriveDataTypeable+ , BangPatterns++ build-depends: base >= 4.6 && < 5+ , bytestring >= 0.10+ , containers >= 0.5++ hs-source-dirs: .++ ghc-options: -Wall -fwarn-tabs++ default-language: Haskell2010