blob: 63e70c1b522966b94a55dedf33624d21f83e6692 (
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
{-# LANGUAGE RecursiveDo, LambdaCase, BangPatterns #-}
import Control.Monad.Fix
import Data.IORef
import System.Mem.Weak
import System.Mem
import Control.Monad
import Data.Foldable
data Pull = Pull
{ weakSelf :: Weak Pull
, compute :: Weak Pull -> IO Int
, invalidators :: IORef [Weak Pull]
, cached :: IORef (Maybe Int)
}
makePull :: (Weak Pull -> IO Int) -> IO Pull
makePull f = do
rec
-- This seems to be the culprit, changing the order makes the weakRef get gc'ed
-- In this configuration it crashes
!foo <- Pull weak f <$> newIORef [] <*> newIORef Nothing
weak <- mkWeakPtr foo Nothing
return foo
invalidate :: Pull -> IO ()
invalidate p = do
writeIORef (cached p) Nothing
invs <- readIORef (invalidators p)
writeIORef (invalidators p) []
traverse_ (deRefWeak >=> traverse_ invalidate) invs
pull :: Weak Pull -> Pull -> IO Int
pull weak p = do
modifyIORef (invalidators p) (weak :)
pull' p
pull' :: Pull -> IO Int
pull' p = do
readIORef (cached p) >>= \case
Nothing -> do
r <- compute p (weakSelf p)
writeIORef (cached p) (Just r)
return r
Just r -> return r
add :: Pull -> Int -> IO (Pull)
add p n = makePull (\w -> (+n) <$> pull w p)
main = do
h <- newIORef 0
source <- makePull (const $ readIORef h)
p <- foldM add source (take 1000 (repeat 1)) -- 100 is not enough for crash
forM_ [1..10] $ \i -> do
writeIORef h i
invalidate source -- Crashes here on second iteration
--performGC
-- This avoids the crash
print =<< pull' p
|
