@@ -20,7 +20,6 @@
2020{-# LANGUAGE DeriveFunctor #-}
2121{-# LANGUAGE StandaloneDeriving #-}
2222{-# LANGUAGE InstanceSigs #-}
23−
2423#ifdef USE_REFLEX_OPTIMIZER
2524{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
2625#endif
@@ -211,6 +210,12 @@ nextNodeIdRef = unsafePerformIO $ newIORef 1
211210
212211newNodeId :: IO Int
213212newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)
213+
214+{-# NOINLINE unsafeNodeId #-}
215+unsafeNodeId :: a -> Int
216+unsafeNodeId a = unsafePerformIO $ do
217+ touch a
218+ newNodeId
214219#endif
215220
216221--------------------------------------------------------------------------------
@@ -314,10 +319,9 @@ cacheEvent e =
314319#else
315320 Event $
316321#endif
317− unsafePerformIO $ do
318− mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
319− <- newIORef emptyFastWeak
320− pure $ \sub -> {-# SCC "cacheEvent" #-} do
322+ let mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
323+ !mSubscribedRef = unsafeNewIORef e emptyFastWeak
324+ in \sub -> {-# SCC "cacheEvent" #-} do
321325#ifdef DEBUG_TRACE_EVENTS
322326 unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite
323327#endif
@@ -383,7 +387,7 @@ eventRoot !k !r = Event $ wrap eventSubscribedRoot $ liftIO . getRootSubscribed
383387eventNever :: Event x a
384388eventNever = Event $ \_ -> return (EventSubscription (return ()) eventSubscribedNever, Nothing)
385389
386−eventFan :: (GCompare k, HasSpiderTimeline x) => k a -> Fan x k v -> Event x (v a)
390+eventFan :: (GCompare k, HasSpiderTimeline x) => k a -> Fan x k -> Event x a
387391eventFan !k !f = Event $ wrap eventSubscribedFan $ getFanSubscribed k f
388392
389393eventSwitch :: HasSpiderTimeline x => Switch x a -> Event x a
@@ -435,14 +439,14 @@ newSubscriberHold h = return $ Subscriber
435439 , subscriberRecalculateHeight = \_ -> return ()
436440 }
437441
438−newSubscriberFan :: forall x k v. (HasSpiderTimeline x, GCompare k) => FanSubscribed x k v -> IO (Subscriber x (DMap k v))
442+newSubscriberFan :: forall x k. (HasSpiderTimeline x, GCompare k) => FanSubscribed x k -> IO (Subscriber x (DMap k Identity))
439443newSubscriberFan subscribed = return $ Subscriber
440444 { subscriberPropagate = \a -> {-# SCC "traverseFan" #-} do
441445 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
442446 tracePropagate (Proxy :: Proxy x) $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
443447 liftIO $ writeIORef (fanSubscribedOccurrence subscribed) $ Just a
444448 scheduleClear $ fanSubscribedOccurrence subscribed
445− let f _ (Pair v subsubs) = do
449+ let f _ (Pair (Identity v) subsubs) = do
446450 propagate v $ _fanSubscribedChildren_list subsubs
447451 return $ Constant ()
448452 _ <- DMap.traverseWithKey f $ DMap.intersectionWithKey (\_ -> Pair) a subs --TODO: Would be nice to have DMap.traverse_
@@ -595,7 +599,7 @@ eventSubscribedNever = EventSubscribed
595599#endif
596600 }
597601
598−eventSubscribedFan :: FanSubscribed x k v -> EventSubscribed x
602+eventSubscribedFan :: FanSubscribed x k -> EventSubscribed x
599603eventSubscribedFan !subscribed = EventSubscribed
600604 { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed
601605 , eventSubscribedRetained = toAny subscribed
@@ -1013,7 +1017,7 @@ data RootSubscribed x a = forall k. GCompare k => RootSubscribed
10131017#endif
10141018 }
10151019
1016−data Root x k
1020+data Root x (k :: * -> *)
10171021 = Root { rootOccurrence :: !(IORef (DMap k Identity)) -- The currently-firing occurrence of this event
10181022 , rootSubscribed :: !(IORef (DMap k (RootSubscribed x)))
10191023 , rootInit :: !(forall a. k a -> RootTrigger x a -> IO (IO ()))
@@ -1083,25 +1087,25 @@ heightBagVerify b@(HeightBag s c) = if
10831087heightBagVerify = id
10841088#endif
10851089
1086−data FanSubscribedChildren x k v a = FanSubscribedChildren
1087− { _fanSubscribedChildren_list :: !(WeakBag (Subscriber x (v a)))
1088− , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k v)
1089− , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed x k v)))
1090+data FanSubscribedChildren (x :: *) k a = FanSubscribedChildren
1091+ { _fanSubscribedChildren_list :: !(WeakBag (Subscriber x a))
1092+ , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k)
1093+ , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed x k)))
10901094 }
10911095
1092−data FanSubscribed x k v
1093− = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k v)))
1094− , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k v)))
1095− , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k v))) -- This DMap should never be empty
1096+data FanSubscribed (x :: *) k
1097+ = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k)))
1098+ , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k Identity)))
1099+ , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k))) -- This DMap should never be empty
10961100 , fanSubscribedParent :: !(EventSubscription x)
10971101#ifdef DEBUG_NODEIDS
10981102 , fanSubscribedNodeId :: Int
10991103#endif
11001104 }
11011105
1102−data Fan x k v
1103− = Fan { fanParent :: !(Event x (DMap k v))
1104− , fanSubscribed :: !(IORef (Maybe (FanSubscribed x k v)))
1106+data Fan x k
1107+ = Fan { fanParent :: !(Event x (DMap k Identity))
1108+ , fanSubscribed :: !(IORef (Maybe (FanSubscribed x k)))
11051109 }
11061110
11071111data SwitchSubscribed x a
@@ -1206,12 +1210,18 @@ buildDynamic readV0 v' = do
12061210 return d
12071211
12081212unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
1209−unsafeBuildDynamic readV0 v' =
1210− Dyn $ unsafePerformIO $ newIORef $ UnsafeDyn (readV0, v')
1213+unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ UnsafeDyn x
1214+ where x = (readV0, v')
12111215
12121216-- ResultM can read behaviors and events
12131217type ResultM = EventM
12141218
1219+{-# NOINLINE unsafeNewIORef #-}
1220+unsafeNewIORef :: a -> b -> IORef b
1221+unsafeNewIORef a b = unsafePerformIO $ do
1222+ touch a
1223+ newIORef b
1224+
12151225instance HasSpiderTimeline x => Functor (Event x) where
12161226 fmap f = push $ return . Just . f
12171227
@@ -1224,35 +1234,26 @@ push f e = cacheEvent (pushCheap f e)
12241234
12251235{-# INLINABLE pull #-}
12261236pull :: BehaviorM x a -> Behavior x a
1227−pull a = unsafePerformIO $ do
1228− ref <- newIORef Nothing
1229−#ifdef DEBUG_NODEIDS
1230− nid <- newNodeId
1231−#endif
1232− pure $ behaviorPull $ Pull
1233− { pullCompute = a
1234− , pullValue = ref
1237+pull a = behaviorPull $ Pull
1238+ { pullCompute = a
1239+ , pullValue = unsafeNewIORef a Nothing
12351240#ifdef DEBUG_NODEIDS
1236− , pullNodeId = nid
1241+ , pullNodeId = unsafeNodeId a
12371242#endif
1238− }
1243+ }
12391244
12401245{-# INLINABLE switch #-}
12411246switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a
1242−switch a = unsafePerformIO $ do
1243− ref <- newIORef Nothing
1244− pure $ eventSwitch $ Switch
1245− { switchParent = a
1246− , switchSubscribed = ref
1247− }
1247+switch a = eventSwitch $ Switch
1248+ { switchParent = a
1249+ , switchSubscribed = unsafeNewIORef a Nothing
1250+ }
12481251
12491252coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a
1250−coincidence a = unsafePerformIO $ do
1251− ref <- newIORef Nothing
1252− pure $ eventCoincidence $ Coincidence
1253− { coincidenceParent = a
1254− , coincidenceSubscribed = ref
1255− }
1253+coincidence a = eventCoincidence $ Coincidence
1254+ { coincidenceParent = a
1255+ , coincidenceSubscribed = unsafeNewIORef a Nothing
1256+ }
12561257
12571258-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
12581259run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
@@ -1456,9 +1457,6 @@ getRootSubscribed k r sub = do
14561457 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
14571458 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
14581459 writeIORef uninitRef $! uninit
1459−#ifdef DEBUG_NODEIDS
1460− nid <- newNodeId
1461−#endif
14621460 let !subscribed = RootSubscribed
14631461 { rootSubscribedKey = k
14641462 , rootSubscribedCachedSubscribed = cached
@@ -1467,7 +1465,7 @@ getRootSubscribed k r sub = do
14671465 , rootSubscribedUninit = uninit
14681466 , rootSubscribedWeakSelf = weakSelf
14691467#ifdef DEBUG_NODEIDS
1470− , rootSubscribedNodeId = nid
1468+ , rootSubscribedNodeId = unsafeNodeId (k, r, subs)
14711469#endif
14721470 }
14731471 -- If we die at the same moment that all our children die, they will
@@ -1516,10 +1514,16 @@ newFanInt = do
15161514 , _fanInt_occRef = occRef
15171515 }
15181516
1517+{-# NOINLINE unsafeNewFanInt #-}
1518+unsafeNewFanInt :: b -> FanInt x a
1519+unsafeNewFanInt b = unsafePerformIO $ do
1520+ touch b
1521+ newFanInt
1522+
15191523fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
1520−fanInt p = unsafePerformIO $ do
1521− self <- newFanInt
1522− pure $ EventSelectorInt $ \k -> Event $ \sub -> do
1524+fanInt p =
1525+ let self = unsafeNewFanInt p
1526+ in EventSelectorInt $ \k -> Event $ \sub -> do
15231527 isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)
15241528 when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input
15251529 (subscription, parentOcc) <- subscribeAndRead p $ Subscriber
@@ -1555,7 +1559,7 @@ fanInt p = unsafePerformIO $ do
15551559 return (EventSubscription (FastWeakBag.remove t) $! EventSubscribed heightRef $! toAny (_fanInt_subscriptionRef self, t), IntMap.lookup k currentOcc)
15561560
15571561{-# INLINABLE getFanSubscribed #-}
1558−getFanSubscribed :: (HasSpiderTimeline x, GCompare k) => k a -> Fan x k v -> Subscriber x (v a) -> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
1562+getFanSubscribed :: (HasSpiderTimeline x, GCompare k) => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket, FanSubscribed x k, Maybe a)
15591563getFanSubscribed k f sub = do
15601564 mSubscribed <- liftIO $ readIORef $ fanSubscribed f
15611565 case mSubscribed of
@@ -1573,16 +1577,13 @@ getFanSubscribed k f sub = do
15731577 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
15741578 occRef <- liftIO $ newIORef parentOcc
15751579 when (isJust parentOcc) $ scheduleClear occRef
1576−#ifdef DEBUG_NODEIDS
1577− nid <- liftIO newNodeId
1578−#endif
15791580 let subscribed = FanSubscribed
15801581 { fanSubscribedCachedSubscribed = fanSubscribed f
15811582 , fanSubscribedOccurrence = occRef
15821583 , fanSubscribedParent = subscription
15831584 , fanSubscribedSubscribers = subscribersRef
15841585#ifdef DEBUG_NODEIDS
1585− , fanSubscribedNodeId = nid
1586+ , fanSubscribedNodeId = unsafeNodeId f
15861587#endif
15871588 }
15881589 let !self = (k, subscribed)
@@ -1592,7 +1593,7 @@ getFanSubscribed k f sub = do
15921593 liftIO $ writeIORef (fanSubscribed f) $ Just subscribed
15931594 return (slnForSub, subscribed, coerce $ DMap.lookup k =<< parentOcc)
15941595
1595−cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k v) -> IO ()
1596+cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k) -> IO ()
15961597cleanupFanSubscribed (k, subscribed) = do
15971598 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
15981599 let reducedSubscribers = DMap.delete k subscribers
@@ -1604,7 +1605,7 @@ cleanupFanSubscribed (k, subscribed) = do
16041605 else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers
16051606
16061607{-# INLINE subscribeFanSubscribed #-}
1607−subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k v -> Subscriber x (v a) -> IO WeakBagTicket
1608+subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k -> Subscriber x a -> IO WeakBagTicket
16081609subscribeFanSubscribed k subscribed sub = do
16091610 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
16101611 case DMap.lookup k subscribers of
@@ -1642,9 +1643,6 @@ getSwitchSubscribed s sub = do
16421643 when (isJust parentOcc) $ scheduleClear occRef
16431644 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"
16441645 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed
1645−#ifdef DEBUG_NODEIDS
1646− nid <- liftIO newNodeId
1647−#endif
16481646 let !subscribed = SwitchSubscribed
16491647 { switchSubscribedCachedSubscribed = switchSubscribed s
16501648 , switchSubscribedOccurrence = occRef
@@ -1657,7 +1655,7 @@ getSwitchSubscribed s sub = do
16571655 , switchSubscribedCurrentParent = subscriptionRef
16581656 , switchSubscribedWeakSelf = weakSelf
16591657#ifdef DEBUG_NODEIDS
1660− , switchSubscribedNodeId = nid
1658+ , switchSubscribedNodeId = unsafeNodeId s
16611659#endif
16621660 }
16631661 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
@@ -1702,9 +1700,6 @@ getCoincidenceSubscribed c sub = do
17021700 scheduleClear innerSubdRef
17031701 weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"
17041702 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed
1705−#ifdef DEBUG_NODEIDS
1706− nid <- liftIO newNodeId
1707−#endif
17081703 let subscribed = CoincidenceSubscribed
17091704 { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c
17101705 , coincidenceSubscribedOccurrence = occRef
@@ -1715,7 +1710,7 @@ getCoincidenceSubscribed c sub = do
17151710 , coincidenceSubscribedInnerParent = innerSubdRef
17161711 , coincidenceSubscribedWeakSelf = weakSelf
17171712#ifdef DEBUG_NODEIDS
1718− , coincidenceSubscribedNodeId = nid
1713+ , coincidenceSubscribedNodeId = unsafeNodeId c
17191714#endif
17201715 }
17211716 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
@@ -2086,16 +2081,14 @@ mergeIntCheap d = Event $ \sub -> do
20862081 )
20872082
20882083newtype EventSelector x k = EventSelector { select :: forall a. k a -> Event x a }
2089−newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) }
20902084
2091−fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v
2092−fanG e = unsafePerformIO $ do
2093− ref <- newIORef Nothing
2085+fan :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k Identity) -> EventSelector x k
2086+fan e =
20942087 let f = Fan
20952088 { fanParent = e
2096− , fanSubscribed = ref
2089+ , fanSubscribed = unsafeNewIORef e Nothing
20972090 }
2098− pure $ EventSelectorG $ \k -> eventFan k f
2091+ in EventSelector $ \k -> eventFan k f
20992092
21002093runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
21012094runHoldInits holdInitRef dynInitRef mergeInitRef = do
@@ -2564,8 +2557,6 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
25642557 pushCheap f = SpiderEvent . pushCheap (coerce f) . unSpiderEvent
25652558 {-# INLINABLE pull #-}
25662559 pull = SpiderBehavior . pull . coerce
2567− {-# INLINABLE fanG #-}
2568− fanG e = R.EventSelectorG $ SpiderEvent . selectG (fanG (unSpiderEvent e))
25692560 {-# INLINABLE mergeG #-}
25702561 mergeG
25712562 :: forall (k :: k2 -> *) q (v :: k2 -> *). GCompare k
@@ -2573,6 +2564,8 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
25732564 -> DMap k q
25742565 -> R.Event (SpiderTimeline x) (DMap k v)
25752566 mergeG nt = SpiderEvent . mergeG (unSpiderEvent #. nt) . dynamicConst
2567+ {-# INLINABLE fan #-}
2568+ fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))
25762569 {-# INLINABLE switch #-}
25772570 switch = SpiderEvent . switch . (coerce :: Behavior x (R.Event (SpiderTimeline x) a) -> Behavior x (Event x a)) . unSpiderBehavior
25782571 {-# INLINABLE coincidence #-}