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
|
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
import Control.Monad
import GHC.Conc
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import Foreign.C.Types
import GHC.IO
import GHC.Exts
foreign import ccall unsafe "&puts" puts :: FunPtr (Ptr CChar -> IO ())
main :: IO ()
main = do
ptr@(Ptr p) <- malloc
poke (ptr :: Ptr CChar) 0
setNumCapabilities 2
let !(FunPtr puts#) = puts
replicateM_ 10000 $ IO $ \s -> let
!(# s1, w #) = mkWeakNoFinalizer# () () s
!(# s2, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s1
!(# s3, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s2
!(# s4, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s3
!(# s5, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s4
!(# s6, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s5
!(# s7, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s6
!(# s8, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s7
!(# s9, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s8
!(# s10, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s9
!(# s11, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s10
!(# s12, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s11
!(# s13, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s12
!(# s14, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s13
!(# s15, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s14
!(# s16, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s15
!(# s17, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s16
!(# s18, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s17
!(# s19, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s18
!(# s20, _ #) = addCFinalizerToWeak# puts# p 0# nullAddr# w s19
in (# s20, () #)
|
