@@ -164,7 +164,7 @@ hold v0 e = do
164164 , holdNodeId = unsafeNodeId (v0, e)
165165#endif
166166 }
167− !s = SubscriberHold h
167+ s <- newSubscriberHold h
168168 writeIORef subscriberRef $ unsafeCoerce s
169169 modifyIORef' holdInitRef (SomeHoldInit e h :)
170170 return $ BehaviorHold h
@@ -277,7 +277,7 @@ instance GCompare k => GCompare (FanSubscriberKey k) where
277277data FanSubscribed k
278278 = FanSubscribed { fanSubscribedSubscribers :: !(IORef (DMap (FanSubscriberKey k)))
279279 , fanSubscribedParent :: !(EventSubscribed (DMap k))
280− , fanSubscribedSelf :: !(Subscriber (DMap k))
280+ , fanSubscribedSelf :: {-# NOUNPACK #-} (Subscriber (DMap k))
281281#ifdef DEBUG_NODEIDS
282282 , fanSubscribedNodeId :: Int
283283#endif
@@ -292,9 +292,9 @@ data SwitchSubscribed a
292292 = SwitchSubscribed { switchSubscribedOccurrence :: !(IORef (Maybe a))
293293 , switchSubscribedHeight :: !(IORef Int)
294294 , switchSubscribedSubscribers :: !(IORef [WeakSubscriber a])
295− , switchSubscribedSelf :: !(Subscriber a)
295+ , switchSubscribedSelf :: {-# NOUNPACK #-} (Subscriber a)
296296 , switchSubscribedSelfWeak :: !(IORef (Weak (Subscriber a)))
297− , switchSubscribedOwnInvalidator :: !Invalidator
297+ , switchSubscribedOwnInvalidator :: {-# NOUNPACK #-} Invalidator
298298 , switchSubscribedOwnWeakInvalidator :: !(IORef (Weak Invalidator))
299299 , switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed])
300300 , switchSubscribedParent :: !(Behavior (Event a))
@@ -313,7 +313,7 @@ data CoincidenceSubscribed a
313313 = CoincidenceSubscribed { coincidenceSubscribedOccurrence :: !(IORef (Maybe a))
314314 , coincidenceSubscribedSubscribers :: !(IORef [WeakSubscriber a])
315315 , coincidenceSubscribedHeight :: !(IORef Int)
316− , coincidenceSubscribedOuter :: !(Subscriber (Event a))
316+ , coincidenceSubscribedOuter :: {-# NOUNPACK #-} (Subscriber (Event a))
317317 , coincidenceSubscribedOuterParent :: !(EventSubscribed (Event a))
318318 , coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed a)))
319319#ifdef DEBUG_NODEIDS
@@ -382,7 +382,7 @@ showEventType = \case
382382 EventCoincidence _ -> "EventCoincidence"
383383
384384data EventSubscribed a
385− = EventSubscribedRoot !(RootSubscribed a)
385+ = EventSubscribedRoot {-# NOUNPACK #-} (RootSubscribed a)
386386 | EventSubscribedNever
387387 | forall b. EventSubscribedPush !(PushSubscribed b a)
388388 | forall k. (GCompare k, a ~ DMap k) => EventSubscribedMerge !(MergeSubscribed k)
@@ -390,6 +390,59 @@ data EventSubscribed a
390390 | EventSubscribedSwitch !(SwitchSubscribed a)
391391 | EventSubscribedCoincidence !(CoincidenceSubscribed a)
392392
393+-- These function are constructor functions that are marked NOINLINE so they are
394+-- opaque to GHC. If we do not do this, then GHC will sometimes fuse the constructor away
395+-- so any weak references that are attached to the constructors will have their
396+-- finalizer run. Using the opaque constructor, does not see the
397+-- constructor application, so it behaves like an IORef and cannot be fused away.
398+--
399+-- The result is also evaluated to WHNF, since forcing a thunk invalidates
400+-- the weak pointer to it in some cases.
401+
402+{-# NOINLINE newRootSubscribed #-}
403+newRootSubscribed :: IORef (Maybe a) -> IORef [WeakSubscriber a] -> IO (RootSubscribed a)
404+newRootSubscribed occ subs =
405+ return $! RootSubscribed
406+ { rootSubscribedOccurrence = occ
407+ , rootSubscribedSubscribers = subs
408+ }
409+
410+{-# NOINLINE newSubscriberPush #-}
411+newSubscriberPush :: (a -> EventM (Maybe b)) -> PushSubscribed a b -> IO (Subscriber a)
412+newSubscriberPush compute subd = return $! SubscriberPush compute subd
413+
414+{-# NOINLINE newSubscriberHold #-}
415+newSubscriberHold :: Hold a -> IO (Subscriber a)
416+newSubscriberHold h = return $! SubscriberHold h
417+
418+{-# NOINLINE newSubscriberFan #-}
419+newSubscriberFan :: GCompare k => FanSubscribed k -> IO (Subscriber (DMap k))
420+newSubscriberFan subd = return $! SubscriberFan subd
421+
422+{-# NOINLINE newSubscriberSwitch #-}
423+newSubscriberSwitch :: SwitchSubscribed a -> IO (Subscriber a)
424+newSubscriberSwitch subd = return $! SubscriberSwitch subd
425+
426+{-# NOINLINE newSubscriberCoincidenceOuter #-}
427+newSubscriberCoincidenceOuter :: CoincidenceSubscribed b -> IO (Subscriber (Event b))
428+newSubscriberCoincidenceOuter subd = return $! SubscriberCoincidenceOuter subd
429+
430+{-# NOINLINE newSubscriberCoincidenceInner #-}
431+newSubscriberCoincidenceInner :: CoincidenceSubscribed a -> IO (Subscriber a)
432+newSubscriberCoincidenceInner subd = return $! SubscriberCoincidenceInner subd
433+
434+{-# NOINLINE newInvalidatorSwitch #-}
435+newInvalidatorSwitch :: SwitchSubscribed a -> IO Invalidator
436+newInvalidatorSwitch subd = return $! InvalidatorSwitch subd
437+
438+{-# NOINLINE newInvalidatorPull #-}
439+newInvalidatorPull :: Pull a -> IO Invalidator
440+newInvalidatorPull p = return $! InvalidatorPull p
441+
442+{-# NOINLINE newBox #-}
443+newBox :: a -> IO (Box a)
444+newBox a = return $! Box a
445+
393446--type role Behavior representational
394447data Behavior a
395448 = BehaviorHold !(Hold a)
@@ -605,7 +658,7 @@ data SomeCoincidenceInfo = forall a. SomeCoincidenceInfo (Weak (Subscriber a)) (
605658
606659subscribeCoincidenceInner :: Event a -> Int -> CoincidenceSubscribed a -> EventM (Maybe a, Int, EventSubscribed a)
607660subscribeCoincidenceInner o outerHeight subscribedUnsafe = do
608− let !subInner = SubscriberCoincidenceInner subscribedUnsafe
661+ subInner <- liftIO $ newSubscriberCoincidenceInner subscribedUnsafe
609662 wsubInner <- liftIO $ mkWeakPtrWithDebug subInner "SubscriberCoincidenceInner"
610663 innerSubd <- {-# SCC "innerSubd" #-} (subscribe o $ WeakSubscriberSimple wsubInner)
611664 innerOcc <- liftIO $ getEventSubscribedOcc innerSubd
@@ -644,7 +697,7 @@ readBehaviorTracked b = case b of
644697 liftIO $ touch $ pullSubscribedOwnInvalidator subscribed
645698 return $ pullSubscribedValue subscribed
646699 Nothing -> do
647− let !i = InvalidatorPull p
700+ i <- liftIO $ newInvalidatorPull p
648701 wi <- liftIO $ mkWeakPtrWithDebug i "InvalidatorPull"
649702 parentsRef <- liftIO $ newIORef []
650703 a <- liftIO $ runReaderT (unBehaviorM $ pullCompute p) $ Just (wi, parentsRef)
@@ -772,10 +825,7 @@ getRootSubscribed r = do
772825 Just subscribed -> return subscribed
773826 Nothing -> liftIO $ do
774827 subscribersRef <- newIORef []
775− let !subscribed = RootSubscribed
776− { rootSubscribedOccurrence = rootOccurrence r
777− , rootSubscribedSubscribers = subscribersRef
778− }
828+ subscribed <- newRootSubscribed (rootOccurrence r) subscribersRef
779829 -- Strangely, init needs the same stuff as a RootSubscribed has, but it must not be the same as the one that everyone's subscribing to, or it'll leak memory
780830 uninit <- rootInit r $ RootTrigger (subscribersRef, rootOccurrence r)
781831 addFinalizer subscribed $ do
@@ -792,7 +842,7 @@ getPushSubscribed p = do
792842 Just subscribed -> return subscribed
793843 Nothing -> do -- Not yet subscribed
794844 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ liftM fromJust $ readIORef $ pushSubscribed p
795− let !s = SubscriberPush (pushCompute p) subscribedUnsafe
845+ s <- liftIO $ newSubscriberPush (pushCompute p) subscribedUnsafe
796846 ws <- liftIO $ mkWeakPtrWithDebug s "SubscriberPush"
797847 subd <- subscribe (pushParent p) $ WeakSubscriberSimple ws
798848 parentOcc <- liftIO $ getEventSubscribedOcc subd
@@ -821,7 +871,7 @@ getMergeSubscribed m = {-# SCC "getMergeSubscribed.entire" #-} do
821871 Nothing -> if DMap.null $ mergeParents m then emptyMergeSubscribed else do
822872 subscribedRef <- liftIO $ newIORef $ error "getMergeSubscribed: subscribedRef not yet initialized"
823873 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
824− let !s = Box subscribedUnsafe
874+ s <- liftIO $ newBox subscribedUnsafe
825875 ws <- liftIO $ mkWeakPtrWithDebug s "SubscriberMerge"
826876 subscribers :: [(Any, Maybe (DSum k), Int, DSum (WrapArg EventSubscribed k))] <- forM (DMap.toList $ mergeParents m) $ {-# SCC "getMergeSubscribed.a" #-} \(WrapArg k :=> e) -> {-# SCC "getMergeSubscribed.a1" #-} do
827877 parentSubd <- {-# SCC "getMergeSubscribed.a.parentSubd" #-} subscribe e $ WeakSubscriberMerge k ws
@@ -881,7 +931,7 @@ getFanSubscribed f = do
881931 Just subscribed -> return subscribed
882932 Nothing -> do
883933 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ liftM fromJust $ readIORef $ fanSubscribed f
884− let !sub = SubscriberFan subscribedUnsafe
934+ sub <- liftIO $ newSubscriberFan subscribedUnsafe
885935 wsub <- liftIO $ mkWeakPtrWithDebug sub "SubscriberFan"
886936 subd <- subscribe (fanParent f) $ WeakSubscriberSimple wsub
887937 subscribersRef <- liftIO $ newIORef DMap.empty
@@ -904,8 +954,8 @@ getSwitchSubscribed s = do
904954 Nothing -> do
905955 subscribedRef <- liftIO $ newIORef $ error "getSwitchSubscribed: subscribed has not yet been created"
906956 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
907− let !i = InvalidatorSwitch subscribedUnsafe
908− !sub = SubscriberSwitch subscribedUnsafe
957+ i <- liftIO $ newInvalidatorSwitch subscribedUnsafe
958+ sub <- liftIO $ newSubscriberSwitch subscribedUnsafe
909959 wi <- liftIO $ mkWeakPtrWithDebug i "InvalidatorSwitch"
910960 wiRef <- liftIO $ newIORef wi
911961 wsub <- liftIO $ mkWeakPtrWithDebug sub "SubscriberSwitch"
@@ -946,7 +996,7 @@ getCoincidenceSubscribed c = do
946996 Nothing -> do
947997 subscribedRef <- liftIO $ newIORef $ error "getCoincidenceSubscribed: subscribed has not yet been created"
948998 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
949− let !subOuter = SubscriberCoincidenceOuter subscribedUnsafe
999+ subOuter <- liftIO $ newSubscriberCoincidenceOuter subscribedUnsafe
9501000 wsubOuter <- liftIO $ mkWeakPtrWithDebug subOuter "subOuter"
9511001 outerSubd <- subscribe (coincidenceParent c) $ WeakSubscriberSimple wsubOuter
9521002 outerOcc <- liftIO $ getEventSubscribedOcc outerSubd