@@ -215,7 +215,7 @@ instance HasSpiderEnv x (SpiderHost x) where
215215putCurrentHeight :: Height -> EventM x ()
216216putCurrentHeight h = EventM $ do
217217 heightRef <- asks eventEnvCurrentHeight
218− liftIO $ writeIORef heightRef h
218+ liftIO $ writeIORef heightRef $! h
219219
220220instance Defer SomeClear (EventM x) where
221221 {-# INLINE getDeferralQueue #-}
@@ -288,7 +288,7 @@ getHoldEventSubscription h = do
288288-}
289289 -}
290290 subscription@(EventSubscription _ subd) <- subscribe e =<< liftIO (newSubscriberHold h)
291− liftIO $ writeIORef subscriptionRef subscription
291+ liftIO $ writeIORef subscriptionRef $! subscription
292292 occ <- liftIO $ readEventSubscribed subd
293293 case occ of
294294 Nothing -> return ()
@@ -301,7 +301,7 @@ getHoldEventSubscription h = do
301301 v <- liftIO $ evaluate $ holdValue h
302302 i <- liftIO $ evaluate $ holdInvalidators h
303303 defer $ SomeAssignment v i new
304− liftIO $ writeIORef (holdParent h) $ Right subscription
304+ liftIO $ writeIORef (holdParent h) $! Right subscription
305305 return subscription
306306
307307type BehaviorEnv = (Maybe (Weak Invalidator, IORef [SomeBehaviorSubscribed]), IORef [SomeHoldInit])
@@ -826,7 +826,7 @@ run roots after = do
826826 Just ((currentHeight, cur), future) -> do
827827 tracePropagate $ "Running height " ++ show currentHeight
828828 putCurrentHeight $ Height currentHeight
829− liftIO $ writeIORef delayedRef future
829+ liftIO $ writeIORef delayedRef $! future
830830 forM_ cur $ \d -> case d of
831831 DelayedMerge subscribed -> do
832832 height <- liftIO $ readIORef $ mergeSubscribedHeight subscribed
@@ -835,9 +835,9 @@ run roots after = do
835835 GT -> scheduleMerge height subscribed -- The height has been increased (by a coincidence event; TODO: is this the only way?)
836836 EQ -> do
837837 m <- liftIO $ readIORef $ mergeSubscribedAccum subscribed
838− liftIO $ writeIORef (mergeSubscribedAccum subscribed) DMap.empty
838+ liftIO $ writeIORef (mergeSubscribedAccum subscribed) $! DMap.empty
839839 --TODO: Assert that m is not empty
840− liftIO $ writeIORef (mergeSubscribedOccurrence subscribed) $ Just m
840+ liftIO $ writeIORef (mergeSubscribedOccurrence subscribed) $! Just m
841841 scheduleClear $ mergeSubscribedOccurrence subscribed
842842 propagateAndUpdateSubscribersRef (mergeSubscribedSubscribers subscribed) m
843843 go
@@ -930,10 +930,10 @@ walkInvalidHeightParents s0 = do
930930 subscribers <- flip execStateT mempty $ ($ Some.This s0) $ fix $ \loop (Some.This s) -> do
931931 h <- liftIO $ readIORef $ eventSubscribedHeightRef s
932932 when (h == invalidHeight) $ do
933− when (eventSubscribedHasOwnHeightRef s) $ liftIO $ writeIORef (eventSubscribedHeightRef s) invalidHeightBeingTraversed
933+ when (eventSubscribedHasOwnHeightRef s) $ liftIO $ writeIORef (eventSubscribedHeightRef s) $! invalidHeightBeingTraversed
934934 modify (Some.This s :)
935935 mapM_ loop =<< liftIO (eventSubscribedGetParents s)
936− forM_ subscribers $ \(Some.This s) -> writeIORef (eventSubscribedHeightRef s) invalidHeight
936+ forM_ subscribers $ \(Some.This s) -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight
937937 return subscribers
938938
939939groupByHead :: Eq a => [NonEmpty a] -> [(a, NonEmpty [a])]
@@ -1000,7 +1000,7 @@ propagate a subscribers = withIncreasedDepth $ do
10001000 SubscriberHoldIdentity h -> {-# SCC "traverseHoldIdentity" #-} propagateSubscriberHold h a
10011001 SubscriberSwitch subscribed -> {-# SCC "traverseSwitch" #-} do
10021002 tracePropagate $ "SubscriberSwitch" <> showNodeId subscribed
1003− liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $ Just a
1003+ liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $! Just a
10041004 scheduleClear $ switchSubscribedOccurrence subscribed
10051005 propagate a $ switchSubscribedSubscribers subscribed
10061006 SubscriberCoincidenceOuter subscribed -> {-# SCC "traverseCoincidenceOuter" #-} do
@@ -1010,12 +1010,12 @@ propagate a subscribers = withIncreasedDepth $ do
10101010 (occ, innerHeight, innerSubd) <- subscribeCoincidenceInner a outerHeight subscribed
10111011 tracePropagate $ " isJust occ = " <> show (isJust occ)
10121012 tracePropagate $ " innerHeight = " <> show innerHeight
1013− liftIO $ writeIORef (coincidenceSubscribedInnerParent subscribed) $ Just innerSubd
1013+ liftIO $ writeIORef (coincidenceSubscribedInnerParent subscribed) $! Just innerSubd
10141014 scheduleClear $ coincidenceSubscribedInnerParent subscribed
10151015 case occ of
10161016 Nothing -> do
10171017 when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height
1018− writeIORef (coincidenceSubscribedHeight subscribed) innerHeight
1018+ writeIORef (coincidenceSubscribedHeight subscribed) $! innerHeight
10191019 WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight
10201020 WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight innerHeight
10211021 Just o -> do -- Since it's already firing, no need to adjust height
@@ -1028,7 +1028,7 @@ propagate a subscribers = withIncreasedDepth $ do
10281028 case occ of
10291029 Just _ -> return () -- SubscriberCoincidenceOuter must have already propagated this event
10301030 Nothing -> do
1031− liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $ Just a
1031+ liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $! Just a
10321032 scheduleClear $ coincidenceSubscribedOccurrence subscribed
10331033 propagate a $ coincidenceSubscribedSubscribers subscribed
10341034 SubscriberHandle -> {-# SCC "traverseHandle" #-} tracePropagate "SubscriberHandle"
@@ -1107,7 +1107,7 @@ readBehaviorTracked b = case b of
11071107 , pullSubscribedOwnInvalidator = i
11081108 , pullSubscribedParents = parents
11091109 }
1110− liftIO $ writeIORef (pullValue p) $ Just subscribed
1110+ liftIO $ writeIORef (pullValue p) $! Just subscribed
11111111 askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedPull subscribed) :))
11121112 return a
11131113 BehaviorDyn d -> readHoldTracked =<< getDynHold d
@@ -1131,7 +1131,7 @@ getDynHold d = do
11311131 holdInits <- getDeferralQueue
11321132 v0 <- liftIO $ runBehaviorM readV0 Nothing holdInits
11331133 h <- hold v0 v'
1134− liftIO $ writeIORef (unDyn d) $ Right h
1134+ liftIO $ writeIORef (unDyn d) $! Right h
11351135 return h
11361136
11371137{-
@@ -1328,7 +1328,7 @@ getRootSubscribed k r sub = do
13281328 (subs, sln) <- WeakBag.singleton sub weakSelf cleanupRootSubscribed
13291329 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
13301330 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
1331− writeIORef uninitRef uninit
1331+ writeIORef uninitRef $! uninit
13321332 let subscribed = RootSubscribed
13331333 { rootSubscribedKey = k
13341334 , rootSubscribedCachedSubscribed = cached
@@ -1340,7 +1340,7 @@ getRootSubscribed k r sub = do
13401340 , rootSubscribedNodeId = unsafeNodeId (k, r, subs)
13411341#endif
13421342 }
1343− writeIORef weakSelf =<< mkWeakPtrWithDebug subscribed "RootSubscribed"
1343+ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "RootSubscribed"
13441344 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
13451345 return (sln, subscribed)
13461346
@@ -1386,15 +1386,15 @@ getPushSubscribed p sub = do
13861386 , pushSubscribedNodeId = unsafeNodeId p
13871387#endif
13881388 }
1389− liftIO $ writeIORef weakSelf =<< mkWeakPtrWithDebug subscribed "PushSubscribed"
1390− liftIO $ writeIORef subscribedRef subscribed
1391− liftIO $ writeIORef (pushSubscribed p) $ Just subscribed
1389+ liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "PushSubscribed"
1390+ liftIO $ writeIORef subscribedRef $! subscribed
1391+ liftIO $ writeIORef (pushSubscribed p) $! Just subscribed
13921392 return (sln, subscribed)
13931393
13941394cleanupPushSubscribed :: PushSubscribed a b -> IO ()
13951395cleanupPushSubscribed self = do
13961396 unsubscribe $ pushSubscribedParent self
1397− writeIORef (pushSubscribedCachedSubscribed self) Nothing
1397+ writeIORef (pushSubscribedCachedSubscribed self) $! Nothing
13981398
13991399{-# INLINE subscribePushSubscribed #-}
14001400subscribePushSubscribed :: PushSubscribed a b -> Subscriber b -> IO (SubscriberListTicket b)
@@ -1454,9 +1454,9 @@ getMergeSubscribed m sub = do
14541454#endif
14551455 }
14561456 defer $ SomeMergeInit subscribed $ updated $ mergeParents m
1457− liftIO $ writeIORef subscribedRef subscribed
1458− liftIO $ writeIORef weakSelf =<< mkWeakPtrWithDebug subscribed "MergeSubscribed"
1459− liftIO $ writeIORef (mergeSubscribed m) $ Just subscribed
1457+ liftIO $ writeIORef subscribedRef $! subscribed
1458+ liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "MergeSubscribed"
1459+ liftIO $ writeIORef (mergeSubscribed m) $! Just subscribed
14601460 return (sln, subscribed)
14611461
14621462cleanupMergeSubscribed :: MergeSubscribed k -> IO ()
@@ -1464,7 +1464,7 @@ cleanupMergeSubscribed subscribed = do
14641464 parents <- readIORef $ mergeSubscribedParents subscribed
14651465 forM_ (DMap.toList parents) $ \(_ :=> msp) -> unsubscribe $ mergeSubscribedParentSubscription msp
14661466 -- Not necessary, because this whole MergeSubscribed is dead: writeIORef (mergeSubscribedParents subscribed) DMap.empty
1467− writeIORef (mergeSubscribedCachedSubscribed subscribed) Nothing -- Get rid of the cached subscribed
1467+ writeIORef (mergeSubscribedCachedSubscribed subscribed) $! Nothing -- Get rid of the cached subscribed
14681468
14691469{-# INLINE subscribeMergeSubscribed #-}
14701470subscribeMergeSubscribed :: MergeSubscribed k -> Subscriber (DMap k Identity) -> IO (SubscriberListTicket (DMap k Identity))
@@ -1494,9 +1494,9 @@ getFanSubscribed k f sub = do
14941494 , fanSubscribedNodeId = unsafeNodeId f
14951495#endif
14961496 }
1497− liftIO $ writeIORef weakSelf =<< mkWeakPtrWithDebug (k, subscribed) "FanSubscribed"
1498− liftIO $ writeIORef subscribedRef subscribed
1499− liftIO $ writeIORef (fanSubscribed f) $ Just subscribed
1497+ liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug (k, subscribed) "FanSubscribed"
1498+ liftIO $ writeIORef subscribedRef $! subscribed
1499+ liftIO $ writeIORef (fanSubscribed f) $! Just subscribed
15001500 return (slnForSub, subscribed)
15011501
15021502cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed k) -> IO ()
@@ -1507,8 +1507,8 @@ cleanupFanSubscribed (k, subscribed) = do
15071507 then do
15081508 unsubscribe $ fanSubscribedParent subscribed
15091509 -- Not necessary in this case, because this whole FanSubscribed is dead: writeIORef (fanSubscribedSubscribers subscribed) reducedSubscribers
1510− writeIORef (fanSubscribedCachedSubscribed subscribed) Nothing
1511− else writeIORef (fanSubscribedSubscribers subscribed) reducedSubscribers
1510+ writeIORef (fanSubscribedCachedSubscribed subscribed) $! Nothing
1511+ else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers
15121512
15131513{-# INLINE subscribeFanSubscribed #-}
15141514subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed k -> Subscriber a -> IO (SubscriberListTicket a)
@@ -1563,16 +1563,16 @@ getSwitchSubscribed s sub = do
15631563 , switchSubscribedNodeId = unsafeNodeId s
15641564#endif
15651565 }
1566− liftIO $ writeIORef weakSelf =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
1567− liftIO $ writeIORef subscribedRef subscribed
1568− liftIO $ writeIORef (switchSubscribed s) $ Just subscribed
1566+ liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
1567+ liftIO $ writeIORef subscribedRef $! subscribed
1568+ liftIO $ writeIORef (switchSubscribed s) $! Just subscribed
15691569 return (slnForSub, subscribed)
15701570
15711571cleanupSwitchSubscribed :: SwitchSubscribed a -> IO ()
15721572cleanupSwitchSubscribed subscribed = do
15731573 unsubscribe =<< readIORef (switchSubscribedCurrentParent subscribed)
15741574 finalize =<< readIORef (switchSubscribedOwnWeakInvalidator subscribed) -- We don't need to get invalidated if we're dead
1575− writeIORef (switchSubscribedCachedSubscribed subscribed) Nothing
1575+ writeIORef (switchSubscribedCachedSubscribed subscribed) $! Nothing
15761576
15771577{-# INLINE subscribeSwitchSubscribed #-}
15781578subscribeSwitchSubscribed :: SwitchSubscribed a -> Subscriber a -> IO (SubscriberListTicket a)
@@ -1618,15 +1618,15 @@ getCoincidenceSubscribed c sub = do
16181618 , coincidenceSubscribedNodeId = unsafeNodeId c
16191619#endif
16201620 }
1621− liftIO $ writeIORef weakSelf =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
1622− liftIO $ writeIORef subscribedRef subscribed
1623− liftIO $ writeIORef (coincidenceSubscribed c) $ Just subscribed
1621+ liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
1622+ liftIO $ writeIORef subscribedRef $! subscribed
1623+ liftIO $ writeIORef (coincidenceSubscribed c) $! Just subscribed
16241624 return (slnForSub, subscribed)
16251625
16261626cleanupCoincidenceSubscribed :: CoincidenceSubscribed a -> IO ()
16271627cleanupCoincidenceSubscribed subscribed = do
16281628 unsubscribe $ coincidenceSubscribedOuterParent subscribed
1629− writeIORef (coincidenceSubscribedCachedSubscribed subscribed) Nothing
1629+ writeIORef (coincidenceSubscribedCachedSubscribed subscribed) $! Nothing
16301630
16311631{-# INLINE subscribeCoincidenceSubscribed #-}
16321632subscribeCoincidenceSubscribed :: CoincidenceSubscribed a -> Subscriber a -> IO (SubscriberListTicket a)
@@ -1656,8 +1656,8 @@ runHoldInits holdInitRef mergeInitRef = do
16561656 holdInits <- liftIO $ readIORef holdInitRef
16571657 mergeInits <- liftIO $ readIORef mergeInitRef
16581658 if null holdInits && null mergeInits then return () else do
1659− liftIO $ writeIORef holdInitRef []
1660− liftIO $ writeIORef mergeInitRef []
1659+ liftIO $ writeIORef holdInitRef $! []
1660+ liftIO $ writeIORef mergeInitRef $! []
16611661 mapM_ initHold holdInits
16621662 mapM_ initMerge mergeInits
16631663 runHoldInits holdInitRef mergeInitRef
@@ -1675,7 +1675,7 @@ initMerge (SomeMergeInit subscribed changed) = do
16751675 EventSubscription _ changeSubd <- subscribe changed changeSub
16761676 change <- liftIO $ readEventSubscribed changeSubd
16771677 forM_ change $ \c -> defer $ SomeMergeUpdate c subscribed
1678− liftIO $ writeIORef (mergeSubscribedChange subscribed) (changeSub, changeSubd)
1678+ liftIO $ writeIORef (mergeSubscribedChange subscribed) $! (changeSub, changeSubd)
16791679
16801680-- | Run an event action outside of a frame
16811681runFrame :: EventM x a -> SpiderHost x a --TODO: This function also needs to hold the mutex
@@ -1699,18 +1699,18 @@ runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do
16991699 return result
17001700 result <- runEventM go env
17011701 toClear <- readIORef toClearRef
1702− forM_ toClear $ \(SomeClear ref) -> {-# SCC "clear" #-} writeIORef ref Nothing
1702+ forM_ toClear $ \(SomeClear ref) -> {-# SCC "clear" #-} writeIORef ref $! Nothing
17031703 toClearRoot <- readIORef toClearRootRef
1704− forM_ toClearRoot $ \(SomeRootClear ref) -> {-# SCC "rootClear" #-} writeIORef ref DMap.empty
1704+ forM_ toClearRoot $ \(SomeRootClear ref) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty
17051705 toAssign <- readIORef toAssignRef
17061706 toReconnectRef <- newIORef []
17071707 coincidenceInfos <- readIORef coincidenceInfosRef
17081708 forM_ toAssign $ \(SomeAssignment vRef iRef v) -> {-# SCC "assignment" #-} do
17091709 writeIORef vRef v
17101710 when debugInvalidate $ putStrLn $ "Invalidating Hold"
1711− writeIORef iRef =<< invalidate toReconnectRef =<< readIORef iRef
1711+ writeIORef iRef =<< evaluate =<< invalidate toReconnectRef =<< readIORef iRef
17121712 mergeUpdates <- readIORef mergeUpdateRef
1713− writeIORef mergeUpdateRef []
1713+ writeIORef mergeUpdateRef $! []
17141714 let updateMerge :: SomeMergeUpdate -> IO [SomeEventSubscription]
17151715 updateMerge (SomeMergeUpdate (R.PatchDMap p :: R.PatchDMap (DMap k Event)) m) = do
17161716 oldParents <- readIORef $ mergeSubscribedParents m
@@ -1741,9 +1741,9 @@ runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do
17411741 finalize wi
17421742 i <- evaluate $ switchSubscribedOwnInvalidator subscribed
17431743 wi' <- mkWeakPtrWithDebug i "wi'"
1744− writeIORef (switchSubscribedOwnWeakInvalidator subscribed) wi'
1745− writeIORef (switchSubscribedBehaviorParents subscribed) []
1746− writeIORef holdInitRef [] --TODO: Should we reuse this?
1744+ writeIORef (switchSubscribedOwnWeakInvalidator subscribed) $! wi'
1745+ writeIORef (switchSubscribedBehaviorParents subscribed) $! []
1746+ writeIORef holdInitRef $! [] --TODO: Should we reuse this?
17471747 e <- runBehaviorM (readBehaviorTracked (switchSubscribedParent subscribed)) (Just (wi', switchSubscribedBehaviorParents subscribed)) holdInitRef
17481748 runEventM (runHoldInits holdInitRef mergeInitRef) env --TODO: Is this actually OK? It seems like it should be, since we know that no events are firing at this point, but it still seems inelegant
17491749 --TODO: Make sure we touch the pieces of the SwitchSubscribed at the appropriate times
@@ -1756,11 +1756,11 @@ runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do
17561756 EventNever -> "EventNever"
17571757 _ -> "something else"
17581758 -}
1759− writeIORef (switchSubscribedCurrentParent subscribed) subscription
1759+ writeIORef (switchSubscribedCurrentParent subscribed) $! subscription
17601760 parentHeight <- readIORef $ eventSubscribedHeightRef subd'
17611761 myHeight <- readIORef $ switchSubscribedHeight subscribed
17621762 when (parentHeight /= myHeight) $ do
1763− writeIORef (switchSubscribedHeight subscribed) invalidHeight
1763+ writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
17641764 WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight
17651765 return $ SomeEventSubscription oldSubscription
17661766 forM_ coincidenceInfos $ \(SomeResetCoincidence subscription mcs) -> do
@@ -1820,7 +1820,7 @@ invalidateSubscriberHeight old s = case s of
18201820 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed
18211821 oldHeight <- readIORef $ switchSubscribedHeight subscribed
18221822 when (oldHeight /= invalidHeight) $ do
1823− writeIORef (switchSubscribedHeight subscribed) invalidHeight
1823+ writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
18241824 WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
18251825 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"
18261826 SubscriberCoincidenceOuter subscribed -> do
@@ -1838,14 +1838,14 @@ removeMergeHeight oldParentHeight subscribed = do
18381838 oldHeights <- readIORef $ mergeSubscribedHeightBag subscribed
18391839 let newHeights = heightBagRemove oldParentHeight oldHeights
18401840 putStrLn $ "removeMergeHeight " <> showNodeId subscribed <> ": " <> show oldHeights <> " => " <> show newHeights
1841− writeIORef (mergeSubscribedHeightBag subscribed) newHeights
1841+ writeIORef (mergeSubscribedHeightBag subscribed) $! newHeights
18421842
18431843invalidateMergeHeight :: MergeSubscribed k -> IO ()
18441844invalidateMergeHeight subscribed = do
18451845 oldHeight <- readIORef $ mergeSubscribedHeight subscribed
18461846 -- If the height used to be valid, it must be invalid now; we should never have *more* heights than we have parents
18471847 when (oldHeight /= invalidHeight) $ do
1848− writeIORef (mergeSubscribedHeight subscribed) invalidHeight
1848+ writeIORef (mergeSubscribedHeight subscribed) $! invalidHeight
18491849 WeakBag.traverse (mergeSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
18501850
18511851addMergeHeight :: Height -> MergeSubscribed k -> IO ()
@@ -1853,7 +1853,7 @@ addMergeHeight newParentHeight subscribed = do
18531853 oldHeights <- readIORef $ mergeSubscribedHeightBag subscribed
18541854 let newHeights = heightBagAdd newParentHeight oldHeights
18551855 putStrLn $ "addMergeHeight " <> showNodeId subscribed <> ": " <> show oldHeights <> " => " <> show newHeights
1856− writeIORef (mergeSubscribedHeightBag subscribed) newHeights
1856+ writeIORef (mergeSubscribedHeightBag subscribed) $! newHeights
18571857
18581858revalidateMergeHeight :: MergeSubscribed k -> IO ()
18591859revalidateMergeHeight subscribed = do
@@ -1864,14 +1864,14 @@ revalidateMergeHeight subscribed = do
18641864 when (heightBagSize heights == DMap.size parents) $ do
18651865 let height = succHeight $ heightBagMax heights
18661866 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: height: " <> show height
1867− writeIORef (mergeSubscribedHeight subscribed) height
1867+ writeIORef (mergeSubscribedHeight subscribed) $! height
18681868 WeakBag.traverse (mergeSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height
18691869
18701870invalidateCoincidenceHeight :: CoincidenceSubscribed a -> IO ()
18711871invalidateCoincidenceHeight subscribed = do
18721872 oldHeight <- readIORef $ coincidenceSubscribedHeight subscribed
18731873 when (oldHeight /= invalidHeight) $ do
1874− writeIORef (coincidenceSubscribedHeight subscribed) invalidHeight
1874+ writeIORef (coincidenceSubscribedHeight subscribed) $! invalidHeight
18751875 WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
18761876
18771877recalculateSubscriberHeight :: Height -> Subscriber a -> IO ()
@@ -1912,7 +1912,7 @@ updateSwitchHeight new subscribed = do
19121912 oldHeight <- readIORef $ switchSubscribedHeight subscribed
19131913 when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion
19141914 when (new /= invalidHeight) $ do --TODO: This 'when' should probably be an assertion
1915− writeIORef (switchSubscribedHeight subscribed) new
1915+ writeIORef (switchSubscribedHeight subscribed) $! new
19161916 WeakBag.traverse (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new
19171917
19181918recalculateCoincidenceHeight :: CoincidenceSubscribed a -> IO ()
@@ -1921,7 +1921,7 @@ recalculateCoincidenceHeight subscribed = do
19211921 when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion
19221922 height <- calculateCoincidenceHeight subscribed
19231923 when (height /= invalidHeight) $ do
1924− writeIORef (coincidenceSubscribedHeight subscribed) height
1924+ writeIORef (coincidenceSubscribedHeight subscribed) $! height
19251925 WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height
19261926
19271927getEventSubscribedHeight :: EventSubscribed a -> IO Height
@@ -1953,8 +1953,8 @@ invalidate toReconnectRef wis = do
19531953 traceInvalidate $ "invalidate: Pull" <> showNodeId p
19541954 mVal <- readIORef $ pullValue p
19551955 forM_ mVal $ \val -> do
1956− writeIORef (pullValue p) Nothing
1957− writeIORef (pullSubscribedInvalidators val) =<< invalidate toReconnectRef =<< readIORef (pullSubscribedInvalidators val)
1956+ writeIORef (pullValue p) $! Nothing
1957+ writeIORef (pullSubscribedInvalidators val) =<< evaluate =<< invalidate toReconnectRef =<< readIORef (pullSubscribedInvalidators val)
19581958 InvalidatorSwitch subscribed -> do
19591959 traceInvalidate $ "invalidate: Switch" <> showNodeId subscribed
19601960 modifyIORef' toReconnectRef (SomeSwitchSubscribed subscribed :)