83d0786 · reflex · git.iko.soy

164 , holdNodeId = unsafeNodeId (v0, e)

165#endif

166 }

167− !s = SubscriberHold h

167+ s <- newSubscriberHold h

168 writeIORef subscriberRef $ unsafeCoerce s

169 modifyIORef' holdInitRef (SomeHoldInit e h :)

170 return $ BehaviorHold h

277data FanSubscribed k

278 = FanSubscribed { fanSubscribedSubscribers :: !(IORef (DMap (FanSubscriberKey k)))

279 , fanSubscribedParent :: !(EventSubscribed (DMap k))

280− , fanSubscribedSelf :: !(Subscriber (DMap k))

280+ , fanSubscribedSelf :: {-# NOUNPACK #-} (Subscriber (DMap k))

281#ifdef DEBUG_NODEIDS

282 , fanSubscribedNodeId :: Int

283#endif

292 = SwitchSubscribed { switchSubscribedOccurrence :: !(IORef (Maybe a))

293 , switchSubscribedHeight :: !(IORef Int)

294 , switchSubscribedSubscribers :: !(IORef [WeakSubscriber a])

295− , switchSubscribedSelf :: !(Subscriber a)

295+ , switchSubscribedSelf :: {-# NOUNPACK #-} (Subscriber a)

296 , switchSubscribedSelfWeak :: !(IORef (Weak (Subscriber a)))

297− , switchSubscribedOwnInvalidator :: !Invalidator

297+ , switchSubscribedOwnInvalidator :: {-# NOUNPACK #-} Invalidator

298 , switchSubscribedOwnWeakInvalidator :: !(IORef (Weak Invalidator))

299 , switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed])

300 , switchSubscribedParent :: !(Behavior (Event a))

313 = CoincidenceSubscribed { coincidenceSubscribedOccurrence :: !(IORef (Maybe a))

314 , coincidenceSubscribedSubscribers :: !(IORef [WeakSubscriber a])

315 , coincidenceSubscribedHeight :: !(IORef Int)

316− , coincidenceSubscribedOuter :: !(Subscriber (Event a))

316+ , coincidenceSubscribedOuter :: {-# NOUNPACK #-} (Subscriber (Event a))

317 , coincidenceSubscribedOuterParent :: !(EventSubscribed (Event a))

318 , coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed a)))

319#ifdef DEBUG_NODEIDS

382 EventCoincidence _ -> "EventCoincidence"

383

384data EventSubscribed a

385− = EventSubscribedRoot !(RootSubscribed a)

385+ = EventSubscribedRoot {-# NOUNPACK #-} (RootSubscribed a)

386 | EventSubscribedNever

387 | forall b. EventSubscribedPush !(PushSubscribed b a)

388 | forall k. (GCompare k, a ~ DMap k) => EventSubscribedMerge !(MergeSubscribed k)

390 | EventSubscribedSwitch !(SwitchSubscribed a)

391 | EventSubscribedCoincidence !(CoincidenceSubscribed a)

392

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+

393--type role Behavior representational

446--type role Behavior representational

394data Behavior a

447data Behavior a

395 = BehaviorHold !(Hold a)

448 = BehaviorHold !(Hold a)

605

658

606subscribeCoincidenceInner :: Event a -> Int -> CoincidenceSubscribed a -> EventM (Maybe a, Int, EventSubscribed a)

659subscribeCoincidenceInner :: Event a -> Int -> CoincidenceSubscribed a -> EventM (Maybe a, Int, EventSubscribed a)

607subscribeCoincidenceInner o outerHeight subscribedUnsafe = do

660subscribeCoincidenceInner o outerHeight subscribedUnsafe = do

608− let !subInner = SubscriberCoincidenceInner subscribedUnsafe

661+ subInner <- liftIO $ newSubscriberCoincidenceInner subscribedUnsafe

609 wsubInner <- liftIO $ mkWeakPtrWithDebug subInner "SubscriberCoincidenceInner"

662 wsubInner <- liftIO $ mkWeakPtrWithDebug subInner "SubscriberCoincidenceInner"

610 innerSubd <- {-# SCC "innerSubd" #-} (subscribe o $ WeakSubscriberSimple wsubInner)

663 innerSubd <- {-# SCC "innerSubd" #-} (subscribe o $ WeakSubscriberSimple wsubInner)

611 innerOcc <- liftIO $ getEventSubscribedOcc innerSubd

664 innerOcc <- liftIO $ getEventSubscribedOcc innerSubd

644 liftIO $ touch $ pullSubscribedOwnInvalidator subscribed

697 liftIO $ touch $ pullSubscribedOwnInvalidator subscribed

645 return $ pullSubscribedValue subscribed

698 return $ pullSubscribedValue subscribed

646 Nothing -> do

699 Nothing -> do

647− let !i = InvalidatorPull p

700+ i <- liftIO $ newInvalidatorPull p

648 wi <- liftIO $ mkWeakPtrWithDebug i "InvalidatorPull"

701 wi <- liftIO $ mkWeakPtrWithDebug i "InvalidatorPull"

649 parentsRef <- liftIO $ newIORef []

702 parentsRef <- liftIO $ newIORef []

650 a <- liftIO $ runReaderT (unBehaviorM $ pullCompute p) $ Just (wi, parentsRef)

703 a <- liftIO $ runReaderT (unBehaviorM $ pullCompute p) $ Just (wi, parentsRef)

772 Just subscribed -> return subscribed

825 Just subscribed -> return subscribed

773 Nothing -> liftIO $ do

826 Nothing -> liftIO $ do

774 subscribersRef <- newIORef []

827 subscribersRef <- newIORef []

775− let !subscribed = RootSubscribed

828+ subscribed <- newRootSubscribed (rootOccurrence r) subscribersRef

776− { rootSubscribedOccurrence = rootOccurrence r

777− , rootSubscribedSubscribers = subscribersRef

778− }

779 -- 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

829 -- 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

780 uninit <- rootInit r $ RootTrigger (subscribersRef, rootOccurrence r)

830 uninit <- rootInit r $ RootTrigger (subscribersRef, rootOccurrence r)

781 addFinalizer subscribed $ do

831 addFinalizer subscribed $ do

792 Just subscribed -> return subscribed

842 Just subscribed -> return subscribed

793 Nothing -> do -- Not yet subscribed

843 Nothing -> do -- Not yet subscribed

794 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ liftM fromJust $ readIORef $ pushSubscribed p

844 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ liftM fromJust $ readIORef $ pushSubscribed p

795− let !s = SubscriberPush (pushCompute p) subscribedUnsafe

845+ s <- liftIO $ newSubscriberPush (pushCompute p) subscribedUnsafe

796 ws <- liftIO $ mkWeakPtrWithDebug s "SubscriberPush"

846 ws <- liftIO $ mkWeakPtrWithDebug s "SubscriberPush"

797 subd <- subscribe (pushParent p) $ WeakSubscriberSimple ws

847 subd <- subscribe (pushParent p) $ WeakSubscriberSimple ws

798 parentOcc <- liftIO $ getEventSubscribedOcc subd

848 parentOcc <- liftIO $ getEventSubscribedOcc subd

821 Nothing -> if DMap.null $ mergeParents m then emptyMergeSubscribed else do

871 Nothing -> if DMap.null $ mergeParents m then emptyMergeSubscribed else do

822 subscribedRef <- liftIO $ newIORef $ error "getMergeSubscribed: subscribedRef not yet initialized"

872 subscribedRef <- liftIO $ newIORef $ error "getMergeSubscribed: subscribedRef not yet initialized"

823 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef

873 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef

824− let !s = Box subscribedUnsafe

874+ s <- liftIO $ newBox subscribedUnsafe

825 ws <- liftIO $ mkWeakPtrWithDebug s "SubscriberMerge"

875 ws <- liftIO $ mkWeakPtrWithDebug s "SubscriberMerge"

826 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

876 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

827 parentSubd <- {-# SCC "getMergeSubscribed.a.parentSubd" #-} subscribe e $ WeakSubscriberMerge k ws

877 parentSubd <- {-# SCC "getMergeSubscribed.a.parentSubd" #-} subscribe e $ WeakSubscriberMerge k ws

881 Just subscribed -> return subscribed

931 Just subscribed -> return subscribed

882 Nothing -> do

932 Nothing -> do

883 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ liftM fromJust $ readIORef $ fanSubscribed f

933 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ liftM fromJust $ readIORef $ fanSubscribed f

884− let !sub = SubscriberFan subscribedUnsafe

934+ sub <- liftIO $ newSubscriberFan subscribedUnsafe

885 wsub <- liftIO $ mkWeakPtrWithDebug sub "SubscriberFan"

935 wsub <- liftIO $ mkWeakPtrWithDebug sub "SubscriberFan"

886 subd <- subscribe (fanParent f) $ WeakSubscriberSimple wsub

936 subd <- subscribe (fanParent f) $ WeakSubscriberSimple wsub

887 subscribersRef <- liftIO $ newIORef DMap.empty

937 subscribersRef <- liftIO $ newIORef DMap.empty

904 Nothing -> do

954 Nothing -> do

905 subscribedRef <- liftIO $ newIORef $ error "getSwitchSubscribed: subscribed has not yet been created"

955 subscribedRef <- liftIO $ newIORef $ error "getSwitchSubscribed: subscribed has not yet been created"

906 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef

956 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef

907− let !i = InvalidatorSwitch subscribedUnsafe

957+ i <- liftIO $ newInvalidatorSwitch subscribedUnsafe

908− !sub = SubscriberSwitch subscribedUnsafe

958+ sub <- liftIO $ newSubscriberSwitch subscribedUnsafe

909 wi <- liftIO $ mkWeakPtrWithDebug i "InvalidatorSwitch"

959 wi <- liftIO $ mkWeakPtrWithDebug i "InvalidatorSwitch"

910 wiRef <- liftIO $ newIORef wi

960 wiRef <- liftIO $ newIORef wi

911 wsub <- liftIO $ mkWeakPtrWithDebug sub "SubscriberSwitch"

961 wsub <- liftIO $ mkWeakPtrWithDebug sub "SubscriberSwitch"

946 Nothing -> do

996 Nothing -> do

947 subscribedRef <- liftIO $ newIORef $ error "getCoincidenceSubscribed: subscribed has not yet been created"

997 subscribedRef <- liftIO $ newIORef $ error "getCoincidenceSubscribed: subscribed has not yet been created"

948 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef

998 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef

949− let !subOuter = SubscriberCoincidenceOuter subscribedUnsafe

999+ subOuter <- liftIO $ newSubscriberCoincidenceOuter subscribedUnsafe

950 wsubOuter <- liftIO $ mkWeakPtrWithDebug subOuter "subOuter"

1000 wsubOuter <- liftIO $ mkWeakPtrWithDebug subOuter "subOuter"

951 outerSubd <- subscribe (coincidenceParent c) $ WeakSubscriberSimple wsubOuter

1001 outerSubd <- subscribe (coincidenceParent c) $ WeakSubscriberSimple wsubOuter

952 outerOcc <- liftIO $ getEventSubscribedOcc outerSubd

1002 outerOcc <- liftIO $ getEventSubscribedOcc outerSubd