heapsize (empty) → 0.1

raw patch · 6 files changed

+270/−0 lines, 6 filesdep +basedep +criteriondep +deepseqsetup-changed

Dependencies added: base, criterion, deepseq, ghc-heap, hashable, heapsize, primitive, unordered-containers

Files

LICENSE +30/−0
Setup.hs +3/−0
benchmarks/Main.hs +55/−0
cbits/heapsize_prim.cmm +15/−0
heapsize.cabal +47/−0
src/HeapSize.hs +120/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2012 Dennis Felsing++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,3 @@+module Main where+import Distribution.Simple+main = defaultMain

+ benchmarks/Main.hs view

@@ -0,0 +1,55 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}++import Criterion.Main+import Criterion.Types+import HeapSize+import GHC.Generics (Generic)+import Data.Primitive.ByteArray+import Data.IORef+import Control.DeepSeq++listBenchmark :: Benchmark+listBenchmark = bgroup "[Int]" $+  map mkBenchmark+    [ 1000+    , 10000+    , 100000+    , 1000000+    ]+  where+    mkBenchmark :: Int -> Benchmark+    mkBenchmark size = env (pure [0 .. size]) $ \lst -> bench (show size) $ nfAppIO recursiveSize lst++byteArrayBenchmark :: Benchmark+byteArrayBenchmark = bgroup "ByteArray#" $+  -- Just to make sure that it's O(1)+  map mkBenchmark [10, 10000]+  where+    mkBenchmark :: Int -> Benchmark+    mkBenchmark size = env+      (newByteArray size)+      (\lst -> bench (show size) $ nfAppIO recursiveSize lst)+++data C = C Int (IORef C)+  deriving (Generic, NFData)++circularBenchmark :: Benchmark+circularBenchmark = env mkT (\c -> bench "Circular" (nfAppIO recursiveSize c))+  where+    mkT :: IO C+    mkT = do+      rec first <- newIORef (C 1 second)+          second <- newIORef (C 2 third)+          third <- newIORef (C 3 first)+      readIORef first+++main :: IO ()+main =+  defaultMainWith+    (defaultConfig {reportFile = Just "ghc-datasize-benchmark.html"})+    [ listBenchmark, byteArrayBenchmark, circularBenchmark ]

+ cbits/heapsize_prim.cmm view

@@ -0,0 +1,15 @@+#include "Cmm.h"++unpackClosurePtrs ( P_ closure )+{+    W_ ptrArray;+    ("ptr" ptrArray) = foreign "C" heap_view_closurePtrs(MyCapability() "ptr", UNTAG(closure) "ptr");+    return (ptrArray);+}++closureSize ( P_ closure )+{+    W_ len;+    (len) = foreign "C" heap_view_closureSize(UNTAG(closure) "ptr");+    return (len);+}

+ heapsize.cabal view

@@ -0,0 +1,47 @@+cabal-version:      3.0+name:               heapsize+version:            0.1+license:            BSD-3-Clause+license-file:       LICENSE+category:           GHC, Debug, Development+build-type:         Simple+author:             Michail Pardalos <mpardalos@gmail.com>+maintainer:         Michail Pardalos <mpardalos@gmail.com>+copyright:          Michail Pardalos 2020+synopsis:           Determine the size of runtime data structures+description:        heapsize is a tool to determine the size data structures.+                    Determining the size of recursive data structures is+                    supported. All sizes are in Bytes.++Library+  Exposed-modules:+    HeapSize+  c-sources:+    cbits/heapsize_prim.cmm+  Default-Language: Haskell2010+  Build-depends:+      base >= 4.12 && < 4.15+    , deepseq >= 1.3 && < 1.5+    , ghc-heap >= 8.6+    , unordered-containers ==0.2.*+    , hashable ==1.3.*+    , primitive+  Hs-source-dirs: src/+  Ghc-options: -Wall++benchmark benchmarks+  build-depends:+      base+    , heapsize+    , criterion+    , primitive+    , deepseq+  default-language: Haskell2010+  ghc-options:      -Wall+  hs-source-dirs:   benchmarks+  main-is:          Main.hs+  type:             exitcode-stdio-1.0++source-repository head+    type:     git+    location: https://github.com/mpardalos/heapsize.git

+ src/HeapSize.hs view

@@ -0,0 +1,120 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GHCForeignImportPrim #-}+{-# LANGUAGE UnliftedFFITypes #-}++{- |+   Module      : HeapSize+   Copyright   : (c) Michail Pardalos+   License     : 3-Clause BSD-style+   Maintainer  : mpardalos@gmail.com++   Based on GHC.Datasize by Dennis Felsing+ -}+module HeapSize (+  recursiveSize,+  recursiveSizeNoGC,+  recursiveSizeNF,+  closureSize+  )+  where++import Control.DeepSeq (NFData, force)++import GHC.Exts hiding (closureSize#)+import GHC.Arr+import GHC.Exts.Heap hiding (size)+import qualified Data.HashSet as H+import Data.IORef+import Data.Hashable++import Control.Monad++import System.Mem++foreign import prim "aToWordzh" aToWord# :: Any -> Word#+foreign import prim "unpackClosurePtrs" unpackClosurePtrs# :: Any -> Array# b+foreign import prim "closureSize" closureSize# :: Any -> Int#++-- | Get the *non-recursive* size of an closure in words+closureSize :: a -> IO Int+closureSize x = return (I# (closureSize# (unsafeCoerce# x)))++getClosures :: a -> IO (Array Int Box)+getClosures x = case unpackClosurePtrs# (unsafeCoerce# x) of+    pointers ->+      let nelems = I# (sizeofArray# pointers)+      in pure (fmap Box $ Array 0 (nelems - 1) nelems pointers)++-- | Calculate the recursive size of GHC objects in Bytes. Note that the actual+--   size in memory is calculated, so shared values are only counted once.+--+--   Call with+--   @+--    recursiveSize $! 2+--   @+--   to force evaluation to WHNF before calculating the size.+--+--   Call with+--   @+--    recursiveSize $!! \"foobar\"+--   @+--   ($!! from Control.DeepSeq) to force full evaluation before calculating the+--   size.+--+--   A garbage collection is performed before the size is calculated, because+--   the garbage collector would make heap walks difficult.+--+--   This function works very quickly on small data structures, but can be slow+--   on large and complex ones. If speed is an issue it's probably possible to+--   get the exact size of a small portion of the data structure and then+--   estimate the total size from that.+recursiveSize :: a -> IO Int+recursiveSize x = performGC >> recursiveSizeNoGC x++-- | Same as `recursiveSize` except without performing garbage collection first.+--   Useful if you want to measure the size of many objects in sequence. You can+--   call `performGC` once at first and then use this function to avoid multiple+--   unnecessary garbage collections.+recursiveSizeNoGC :: a -> IO Int+recursiveSizeNoGC x = do+  state <- newIORef (0, H.empty)+  go state (asBox x)++  fst <$> readIORef state+  where+    go :: IORef (Int, H.HashSet HashableBox) -> Box -> IO ()+    go state b@(Box y) = do+      (_, closuresSeen) <- readIORef state++      when (not $ H.member (HashableBox b) closuresSeen) $ do+        thisSize <- closureSize y+        modifyIORef state $ \(size, _) ->+          (size + thisSize, H.insert (HashableBox b) closuresSeen)++        mapM_ (go state) =<< getClosures y++-- | Calculate the recursive size of GHC objects in Bytes after calling+-- Control.DeepSeq.force on the data structure to force it into Normal Form.+-- Using this function requires that the data structure has an `NFData`+-- typeclass instance.++recursiveSizeNF :: NFData a => a -> IO Int+recursiveSizeNF = recursiveSize . force++newtype HashableBox = HashableBox Box+    deriving newtype Show++-- | Pointer Equality+instance Eq HashableBox where+    (HashableBox (Box a1)) == (HashableBox (Box a2)) =+        W# (aToWord# a1) == W# (aToWord# a2)++-- | Pointer hash+instance Hashable HashableBox where+    hashWithSalt n (HashableBox (Box a)) = hashWithSalt n (W# (aToWord# a))