ae03249 · reflex · git.iko.soy

git.iko.soy/reflex

Some more simplifications

commitae03249b94cab767381589b18b6bfafa52ab9692 authorRyan Trinkle <ryan.trinkle@gmail.com> dateSun 11 Jun 2017, 18:53 (9 years ago) parentad1991d

3 files changed+77−51

compare with develop

unifiedsplit

src/Data/FastWeakBag.hs+7−25 src/Reflex/FastWeak.hs+50−8 src/Reflex/Spider/Internal.hs+20−18

src/Data/FastWeakBag.hs+7−25

@@ -12,7 +12,7 @@ module Data.FastWeakBag

1212 ( FastWeakBag

1313 , FastWeakBagTicket

1414 , empty

15− , singleton

15+ , isEmpty

1616 , insert

1717 , traverse

1818 , remove

@@ -28,7 +28,6 @@ import Data.Foldable (forM_, mapM_)

2828import Data.IntMap.Strict (IntMap)

2929import qualified Data.IntMap.Strict as IntMap

3030import Data.IORef

31−import Reflex.FastWeak

3231import System.Mem.Weak

3332

3433import Prelude hiding (mapM_, traverse)

@@ -54,25 +53,12 @@ data FastWeakBagTicket = forall a. FastWeakBagTicket

5453{-# INLINE insert #-}

5554insert :: a -- ^ The item

5655 -> FastWeakBag a -- ^ The 'FastWeakBag' to insert into

57− -> FastWeak b -- ^ An arbitrary value to be used in the following

58− -- callback

59− -> (b -> IO ()) -- ^ A callback to be invoked when the item is removed

60− -- (whether automatically by the item being garbage

61− -- collected or manually via 'remove')

6256 -> IO FastWeakBagTicket -- ^ Returns a 'FastWeakBagTicket' that ensures the item

6357 -- is retained and allows the item to be removed.

64−insert a (FastWeakBag nextId children) wb finalizer = {-# SCC "insert" #-} do

58+insert a (FastWeakBag nextId children) = {-# SCC "insert" #-} do

6559 a' <- evaluate a

6660 myId <- atomicModifyIORef' nextId $ \n -> (succ n, n)

67− let cleanup = do

68− mb <- getFastWeakValue wb

69− forM_ mb $ \b -> do

70− csWithoutMe <- atomicModifyIORef children $ \cs ->

71− let !csWithoutMe = IntMap.delete myId cs

72− in (csWithoutMe, csWithoutMe)

73− when (IntMap.null csWithoutMe) $ finalizer b

74− return ()

75− return ()

61+ let cleanup = atomicModifyIORef' children $ \cs -> (IntMap.delete myId cs, ())

7662 wa <- mkWeakPtr a' $ Just cleanup

7763 atomicModifyIORef' children $ \cs -> (IntMap.insert myId wa cs, ())

7864 return $ FastWeakBagTicket

@@ -92,14 +78,10 @@ empty = {-# SCC "empty" #-} do

9278 }

9379 return bag

9480

95−-- | Create a 'FastWeakBag' with one item; equivalent to creating the 'FastWeakBag' with

96−-- 'empty', then using 'insert'.

97−{-# INLINE singleton #-}

98−singleton :: a -> FastWeak b -> (b -> IO ()) -> IO (FastWeakBag a, FastWeakBagTicket)

99−singleton a wb finalizer = {-# SCC "singleton" #-} do

100− bag <- empty

101− ticket <- insert a bag wb finalizer

102− return (bag, ticket)

81+-- | Check whether a 'FastWeakBag' is empty.

82+{-# INLINE isEmpty #-}

83+isEmpty :: FastWeakBag a -> IO Bool

84+isEmpty bag = {-# SCC "isEmpty" #-} IntMap.null <$> readIORef (_weakBag_children bag)

10385

10486{-# INLINE traverse #-}

10587-- | Visit every node in the given list. If new nodes are appended during the

src/Reflex/FastWeak.hs+50−8

@@ -1,4 +1,6 @@

11{-# LANGUAGE CPP #-}

2+{-# LANGUAGE LambdaCase #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

24#ifdef ghcjs_HOST_OS

35{-# LANGUAGE ForeignFunctionInterface #-}

46{-# LANGUAGE JavaScriptFFI #-}

@@ -7,16 +9,21 @@ module Reflex.FastWeak

79 ( FastWeakTicket

810 , FastWeak

911 , mkFastWeakTicket

10− , fastWeakTicketValue

12+ , getFastWeakTicketValue

1113 , getFastWeakTicketWeak

1214 , getFastWeakValue

15+ , getFastWeakTicket

16+ , emptyFastWeak

1317 ) where

1418

19+import GHC.Exts (Any)

20+import Unsafe.Coerce

21+

1522#ifdef ghcjs_HOST_OS

1623import GHCJS.Types

17−import Unsafe.Coerce

1824#else

1925import Control.Exception (evaluate)

26+import System.IO.Unsafe

2027import System.Mem.Weak

2128#endif

2229

@@ -37,14 +44,16 @@ data FastWeakTicket a = FastWeakTicket

3744type FastWeak a = Weak a

3845#endif

3946

40−-- Do we have a concern about accidentally retaining the ticket here?

41−fastWeakTicketValue :: FastWeakTicket a -> a

47+-- This needs to be in IO so we know that we've relinquished the ticket

48+getFastWeakTicketValue :: FastWeakTicket a -> IO a

4249#ifdef ghcjs_HOST_OS

43−fastWeakTicketValue t = unVal (unsafeCoerce (js_ticketVal t))

50+getFastWeakTicketValue t = do

51+ v <- js_ticketVal t

52+ return $ unVal (unsafeCoerce v)

4453

45−foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a -> JSVal

54+foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a -> IO JSVal

4655#else

47−fastWeakTicketValue = _fastWeakTicket_val

56+getFastWeakTicketValue = return . _fastWeakTicket_val

4857#endif

4958

5059getFastWeakValue :: FastWeak a -> IO (Maybe a)

@@ -53,7 +62,7 @@ getFastWeakValue w = do

5362 r <- js_weakVal w

5463 case js_isNull r of

5564 True -> return Nothing

56− False -> return (unsafeCoerce r)

65+ False -> return $ Just $ unVal (unsafeCoerce r)

5766

5867foreign import javascript unsafe "$1 === null" js_isNull :: JSVal -> Bool

5968

@@ -62,6 +71,25 @@ foreign import javascript unsafe "$r = ($1.ticket === null) ? null : $1.ticket.v

6271getFastWeakValue = deRefWeak

6372#endif

6473

74+getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))

75+#ifdef ghcjs_HOST_OS

76+getFastWeakTicket w = do

77+ r <- js_weakTicket w

78+ case js_isNull r of

79+ True -> return Nothing

80+ False -> return $ Just $ FastWeakTicket r

81+

82+foreign import javascript unsafe "$r = $1.ticket;" js_weakTicket :: FastWeak a -> IO JSVal

83+#else

84+getFastWeakTicket w = do

85+ deRefWeak w >>= \case

86+ Nothing -> return Nothing

87+ Just v -> return $ Just $ FastWeakTicket

88+ { _fastWeakTicket_val = v

89+ , _fastWeakTicket_weak = w

90+ }

91+#endif

92+

6593-- I think it's fine if this is lazy - it'll retain the 'a', but so would the output; we just need to make sure it's forced before we start relying on the associated FastWeak to actually be weak

6694mkFastWeakTicket :: a -> IO (FastWeakTicket a)

6795#ifdef ghcjs_HOST_OS

@@ -85,3 +113,17 @@ foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak :: FastWe

85113getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)

86114getFastWeakTicketWeak = return . _fastWeakTicket_weak

87115#endif

116+

117+-- | A weak reference that is always empty

118+emptyFastWeak :: FastWeak a

119+emptyFastWeak = unsafeCoerce w

120+ where w :: FastWeak Any

121+#ifdef ghcjs_HOST_OS

122+ w = js_emptyWeak

123+foreign import javascript unsafe "$r = new h$FastWeak(null);" js_emptyWeak :: FastWeak Any

124+#else

125+ w = unsafePerformIO $ do

126+ w' <- mkWeakPtr undefined Nothing

127+ finalize w'

128+ return w'

129+#endif

src/Reflex/Spider/Internal.hs+20−18

@@ -255,7 +255,6 @@ pushCheap f e = Event $ \sub -> do

255255data CacheSubscribed x a

256256 = CacheSubscribed { _cacheSubscribed_subscribers :: {-# UNPACK #-} !(FastWeakBag (Subscriber x a))

257257 , _cacheSubscribed_parent :: {-# UNPACK #-} !(EventSubscription x)

258− , _cacheSubscribed_cached :: {-# UNPACK #-} !(IORef (Maybe (FastWeakTicket (CacheSubscribed x a))))

259258 , _cacheSubscribed_occurrence :: {-# UNPACK #-} !(IORef (Maybe a))

260259 }

261260

@@ -273,13 +272,13 @@ cacheEvent e =

273272#else

274273 Event $

275274#endif

276− let mSubscribedRef :: IORef (Maybe (FastWeakTicket (CacheSubscribed x a)))

277− !mSubscribedRef = unsafeNewIORef e Nothing

275+ let mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))

276+ !mSubscribedRef = unsafeNewIORef e emptyFastWeak

278277 in \sub -> {-# SCC "cacheEvent" #-} do

279278#ifdef DEBUG_TRACE_EVENTS

280279 unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite

281280#endif

282− subscribedTicket <- liftIO (readIORef mSubscribedRef) >>= \case

281+ subscribedTicket <- liftIO (readIORef mSubscribedRef >>= getFastWeakTicket) >>= \case

283282 Just subscribedTicket -> return subscribedTicket

284283 Nothing -> do

285284 subscribers <- liftIO FastWeakBag.empty

@@ -300,27 +299,30 @@ cacheEvent e =

300299 let !subscribed = CacheSubscribed

301300 { _cacheSubscribed_subscribers = subscribers

302301 , _cacheSubscribed_parent = parentSub

303− , _cacheSubscribed_cached = mSubscribedRef

304302 , _cacheSubscribed_occurrence = occRef

305303 }

306304 subscribedTicket <- liftIO $ mkFastWeakTicket subscribed

307− liftIO $ writeIORef mSubscribedRef $ Just subscribedTicket

305+ liftIO $ writeIORef mSubscribedRef =<< getFastWeakTicketWeak subscribedTicket

308306 return subscribedTicket

309307 liftIO $ do

310− let subscribed = fastWeakTicketValue subscribedTicket

311− subscribedWeak <- getFastWeakTicketWeak subscribedTicket

312− ticket <- FastWeakBag.insert sub (_cacheSubscribed_subscribers subscribed) subscribedWeak cleanupCacheSubscribed

308+ subscribed <- getFastWeakTicketValue subscribedTicket

309+ ticket <- FastWeakBag.insert sub $ _cacheSubscribed_subscribers subscribed

313310 occ <- readIORef $ _cacheSubscribed_occurrence subscribed

314− let es = EventSubscribed

315− { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ _cacheSubscribed_parent subscribed

316− , eventSubscribedRetained = toAny subscribed

311+ let es = EventSubscription

312+ { _eventSubscription_unsubscribe = do

313+ FastWeakBag.remove ticket

314+ isEmpty <- FastWeakBag.isEmpty $ _cacheSubscribed_subscribers subscribed

315+ when isEmpty $ do

316+ writeIORef mSubscribedRef emptyFastWeak

317+ unsubscribe $ _cacheSubscribed_parent subscribed

318+ touch ticket

319+ touch subscribedTicket

320+ , _eventSubscription_subscribed = EventSubscribed

321+ { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ _cacheSubscribed_parent subscribed

322+ , eventSubscribedRetained = toAny subscribedTicket

323+ }

317324 }

318− return (EventSubscription (FastWeakBag.remove ticket >> touch ticket) es, occ)

319−

320−cleanupCacheSubscribed :: CacheSubscribed x a -> IO ()

321−cleanupCacheSubscribed self = do

322− unsubscribe $ _cacheSubscribed_parent self

323− writeIORef (_cacheSubscribed_cached self) Nothing

325+ return (es, occ)

324326

325327subscribe :: Event x a -> Subscriber x a -> EventM x (EventSubscription x)

326328subscribe e s = fst <$> subscribeAndRead e s