blob: 5fafa4f7a582c44dbde8fdfd6e4db0e3c94b18fc (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Utilities for the @closure_size@ tests
module ClosureSizeUtils (assertSize, assertSizeUnlifted) where
import Control.Monad
import GHC.Exts
import GHC.Exts.Heap.Closures
import GHC.Stack
import Type.Reflection
profHeaderSize :: Int
#if PROFILING
profHeaderSize = 2
#else
profHeaderSize = 0
#endif
assertSize
:: forall a. (HasCallStack, Typeable a)
=> a -- ^ closure
-> Int -- ^ expected size in words
-> IO ()
assertSize x =
assertSizeBox (asBox x) (typeRep @a)
assertSizeUnlifted
:: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a)
=> a -- ^ closure
-> Int -- ^ expected size in words
-> IO ()
assertSizeUnlifted x =
assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a)
assertSizeBox
:: forall a. (HasCallStack)
=> Box -- ^ closure
-> TypeRep a
-> Int -- ^ expected size in words
-> IO ()
assertSizeBox x ty expected = do
let !size = closureSize x
when (size /= expected') $ do
putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected'
putStrLn $ prettyCallStack callStack
where expected' = expected + profHeaderSize
{-# NOINLINE assertSize #-}
|
