399906d · patch · git.iko.soy

reflex.cabal+7

compare with develop

unifiedsplit

@@ -183,6 +183,13 @@ test-suite GC-Semantics

183 , reflex

184 , ref-tf

185

186+test-suite rootCleanup

187+ type: exitcode-stdio-1.0

188+ main-is: rootCleanup.hs

189+ hs-source-dirs: test

190+ build-depends: base

191+ , reflex

192+

186benchmark spider-bench

193benchmark spider-bench

187 type: exitcode-stdio-1.0

194 type: exitcode-stdio-1.0

188 hs-source-dirs: bench

195 hs-source-dirs: bench

src/Data/WeakBag.hs+3

@@ -16,6 +16,9 @@ module Data.WeakBag

16 , insert

17 , traverse

18 , remove

19+ -- * Internal functions

20+ -- These will not always be available.

21+ , _weakBag_children --TODO: Don't export this

19 ) where

22 ) where

20

23

21import Control.Exception

24import Control.Exception

src/Reflex/Spider/Internal.hs+12−2

@@ -73,7 +73,7 @@ import Data.Monoid (mempty)

73import Data.Tree (Forest, Tree (..), drawForest)

74#endif

75

76−import Data.WeakBag (WeakBag, WeakBagTicket)

76+import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)

77import qualified Data.WeakBag as WeakBag

78#ifndef SPECIALIZE_TO_SPIDERTIMELINE_GLOBAL

79import Data.Reflection

@@ -1365,7 +1365,17 @@ getRootSubscribed k r sub = do

1365 , rootSubscribedNodeId = unsafeNodeId (k, r, subs)

1366#endif

1367 }

1368+ -- If we die at the same moment that all our children die, they will

1369+ -- try to clean us up but will fail because their Weak reference to us

1370+ -- will also be dead. So, if we are dying, check if there are any

1371+ -- children; since children don't bother cleaning themselves up if

1372+ -- their parents are already dead, I don't think there's a race

1373+ -- condition here. However, if there are any children, then we can

1374+ -- infer that we need to clean ourselves up, so we do.

1375+ finalCleanup = do

1376+ cs <- readIORef $ _weakBag_children subs

1377+ when (not $ IntMap.null cs) (cleanupRootSubscribed subscribed)

1368− writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "RootSubscribed"

1378+ writeIORef weakSelf =<< evaluate =<< mkWeakPtr subscribed (Just finalCleanup)

1369 modifyIORef' (rootSubscribed r) $ DMap.insertWith (error $ "getRootSubscribed: duplicate key inserted into Root") k subscribed --TODO: I think we can just write back mSubscribed rather than re-reading it

1379 modifyIORef' (rootSubscribed r) $ DMap.insertWith (error $ "getRootSubscribed: duplicate key inserted into Root") k subscribed --TODO: I think we can just write back mSubscribed rather than re-reading it

1370 occ <- getOcc

1380 occ <- getOcc

1371 return (sln, subscribed, occ)

1381 return (sln, subscribed, occ)

test/hlint.hs+1

@@ -13,6 +13,7 @@ main = do

13 , "--ignore=Use const"

14 , "--ignore=Use >=>"

15 , "--ignore=Use ."

16+ , "--ignore=Use unless"

16 , "--cpp-define=USE_TEMPLATE_HASKELL"

17 , "--cpp-define=USE_TEMPLATE_HASKELL"

17 ]

18 ]

18 if null ideas then exitSuccess else exitFailure

19 if null ideas then exitSuccess else exitFailure

test/rootCleanup.hsnew file+25

@@ -0,0 +1,25 @@

1+import Control.Monad

2+import Control.Concurrent

3+import Reflex

4+import Reflex.Host.Class

5+import System.Mem

6+import Data.IORef

7+import System.Exit

8+

9+main :: IO ()

10+main = do

11+ numSubscriptions <- newIORef 0

12+ replicateM_ 1000 $ do

13+ runSpiderHost $ do

14+ e <- newEventWithTrigger $ \_ -> do

15+ modifyIORef' numSubscriptions succ

16+ return $ modifyIORef' numSubscriptions pred

17+ _ <- hold () e

18+ return ()

19+ replicateM_ 100 $ do

20+ performMajorGC

21+ threadDelay 1

22+ n <- readIORef numSubscriptions

23+ if n == 0

24+ then putStrLn "Succeeded"

25+ else putStrLn "Failed" >> exitFailure