@@ -211,6 +211,12 @@ nextNodeIdRef = unsafePerformIO $ newIORef 1
212newNodeId :: IO Int
212newNodeId :: IO Int
213newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)
213newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)
215+{-# NOINLINE unsafeNodeId #-}
216+unsafeNodeId :: a -> Int
217+unsafeNodeId a = unsafePerformIO $ do
216--------------------------------------------------------------------------------
222--------------------------------------------------------------------------------
@@ -314,10 +320,9 @@ cacheEvent e =
317− unsafePerformIO $ do
318− mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
323+ let mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
319− <- newIORef emptyFastWeak
324+ !mSubscribedRef = unsafeNewIORef e emptyFastWeak
320− pure $ \sub -> {-# SCC "cacheEvent" #-} do
325+ in \sub -> {-# SCC "cacheEvent" #-} do
321#ifdef DEBUG_TRACE_EVENTS
326#ifdef DEBUG_TRACE_EVENTS
322 unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite
327 unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite
@@ -1206,12 +1211,18 @@ buildDynamic readV0 v' = do
1206 return d
1211 return d
1208unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
1213unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
1209−unsafeBuildDynamic readV0 v' =
1214+unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ UnsafeDyn x
1210− Dyn $ unsafePerformIO $ newIORef $ UnsafeDyn (readV0, v')
1215+ where x = (readV0, v')
1212-- ResultM can read behaviors and events
1217-- ResultM can read behaviors and events
1213type ResultM = EventM
1218type ResultM = EventM
1220+{-# NOINLINE unsafeNewIORef #-}
1221+unsafeNewIORef :: a -> b -> IORef b
1222+unsafeNewIORef a b = unsafePerformIO $ do
1215instance HasSpiderTimeline x => Functor (Event x) where
1226instance HasSpiderTimeline x => Functor (Event x) where
1216 fmap f = push $ return . Just . f
1227 fmap f = push $ return . Just . f
@@ -1224,35 +1235,26 @@ push f e = cacheEvent (pushCheap f e)
1225{-# INLINABLE pull #-}
1236{-# INLINABLE pull #-}
1226pull :: BehaviorM x a -> Behavior x a
1237pull :: BehaviorM x a -> Behavior x a
1227−pull a = unsafePerformIO $ do
1238+pull a = behaviorPull $ Pull
1228− ref <- newIORef Nothing
1239+ { pullCompute = a
1240+ , pullValue = unsafeNewIORef a Nothing
1229#ifdef DEBUG_NODEIDS
1241#ifdef DEBUG_NODEIDS
1230− nid <- newNodeId
1242+ , pullNodeId = unsafeNodeId a
1232− pure $ behaviorPull $ Pull
1235−#ifdef DEBUG_NODEIDS
1240{-# INLINABLE switch #-}
1246{-# INLINABLE switch #-}
1241switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a
1247switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a
1242−switch a = unsafePerformIO $ do
1243− ref <- newIORef Nothing
1244− pure $ eventSwitch $ Switch
1248+switch a = eventSwitch $ Switch
1245− { switchParent = a
1249+ { switchParent = a
1246− , switchSubscribed = ref
1250+ , switchSubscribed = unsafeNewIORef a Nothing
1249coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a
1253coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a
1250−coincidence a = unsafePerformIO $ do
1251− ref <- newIORef Nothing
1252− pure $ eventCoincidence $ Coincidence
1254+coincidence a = eventCoincidence $ Coincidence
1253− { coincidenceParent = a
1255+ { coincidenceParent = a
1254− , coincidenceSubscribed = ref
1256+ , coincidenceSubscribed = unsafeNewIORef a Nothing
1257-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
1259-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
1258run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
1260run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
@@ -1456,9 +1458,6 @@ getRootSubscribed k r sub = do
1456 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
1458 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
1457 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
1459 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
1458 writeIORef uninitRef $! uninit
1460 writeIORef uninitRef $! uninit
1459−#ifdef DEBUG_NODEIDS
1462 let !subscribed = RootSubscribed
1461 let !subscribed = RootSubscribed
1463 { rootSubscribedKey = k
1462 { rootSubscribedKey = k
1464 , rootSubscribedCachedSubscribed = cached
1463 , rootSubscribedCachedSubscribed = cached
@@ -1467,7 +1466,7 @@ getRootSubscribed k r sub = do
1467 , rootSubscribedUninit = uninit
1466 , rootSubscribedUninit = uninit
1468 , rootSubscribedWeakSelf = weakSelf
1467 , rootSubscribedWeakSelf = weakSelf
1469#ifdef DEBUG_NODEIDS
1468#ifdef DEBUG_NODEIDS
1470− , rootSubscribedNodeId = nid
1469+ , rootSubscribedNodeId = unsafeNodeId (k, r, subs)
1473 -- If we die at the same moment that all our children die, they will
1472 -- If we die at the same moment that all our children die, they will
@@ -1516,10 +1515,16 @@ newFanInt = do
1516 , _fanInt_occRef = occRef
1515 , _fanInt_occRef = occRef
1518+{-# NOINLINE unsafeNewFanInt #-}
1519+unsafeNewFanInt :: b -> FanInt x a
1520+unsafeNewFanInt b = unsafePerformIO $ do
1519fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
1524fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
1520−fanInt p = unsafePerformIO $ do
1525+fanInt p =
1521− self <- newFanInt
1526+ let self = unsafeNewFanInt p
1522− pure $ EventSelectorInt $ \k -> Event $ \sub -> do
1527+ in EventSelectorInt $ \k -> Event $ \sub -> do
1523 isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)
1528 isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)
1524 when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input
1529 when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input
1525 (subscription, parentOcc) <- subscribeAndRead p $ Subscriber
1530 (subscription, parentOcc) <- subscribeAndRead p $ Subscriber
@@ -1573,16 +1578,13 @@ getFanSubscribed k f sub = do
1573 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
1578 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
1574 occRef <- liftIO $ newIORef parentOcc
1579 occRef <- liftIO $ newIORef parentOcc
1575 when (isJust parentOcc) $ scheduleClear occRef
1580 when (isJust parentOcc) $ scheduleClear occRef
1576−#ifdef DEBUG_NODEIDS
1577− nid <- liftIO newNodeId
1579 let subscribed = FanSubscribed
1581 let subscribed = FanSubscribed
1580 { fanSubscribedCachedSubscribed = fanSubscribed f
1582 { fanSubscribedCachedSubscribed = fanSubscribed f
1581 , fanSubscribedOccurrence = occRef
1583 , fanSubscribedOccurrence = occRef
1582 , fanSubscribedParent = subscription
1584 , fanSubscribedParent = subscription
1583 , fanSubscribedSubscribers = subscribersRef
1585 , fanSubscribedSubscribers = subscribersRef
1584#ifdef DEBUG_NODEIDS
1586#ifdef DEBUG_NODEIDS
1585− , fanSubscribedNodeId = nid
1587+ , fanSubscribedNodeId = unsafeNodeId f
1588 let !self = (k, subscribed)
1590 let !self = (k, subscribed)
@@ -1642,9 +1644,6 @@ getSwitchSubscribed s sub = do
1642 when (isJust parentOcc) $ scheduleClear occRef
1644 when (isJust parentOcc) $ scheduleClear occRef
1643 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"
1645 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"
1644 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed
1646 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed
1645−#ifdef DEBUG_NODEIDS
1646− nid <- liftIO newNodeId
1648 let !subscribed = SwitchSubscribed
1647 let !subscribed = SwitchSubscribed
1649 { switchSubscribedCachedSubscribed = switchSubscribed s
1648 { switchSubscribedCachedSubscribed = switchSubscribed s
1650 , switchSubscribedOccurrence = occRef
1649 , switchSubscribedOccurrence = occRef
@@ -1657,7 +1656,7 @@ getSwitchSubscribed s sub = do
1657 , switchSubscribedCurrentParent = subscriptionRef
1656 , switchSubscribedCurrentParent = subscriptionRef
1658 , switchSubscribedWeakSelf = weakSelf
1657 , switchSubscribedWeakSelf = weakSelf
1659#ifdef DEBUG_NODEIDS
1658#ifdef DEBUG_NODEIDS
1660− , switchSubscribedNodeId = nid
1659+ , switchSubscribedNodeId = unsafeNodeId s
1663 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
1662 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
@@ -1702,9 +1701,6 @@ getCoincidenceSubscribed c sub = do
1702 scheduleClear innerSubdRef
1701 scheduleClear innerSubdRef
1703 weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"
1702 weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"
1704 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed
1703 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed
1705−#ifdef DEBUG_NODEIDS
1706− nid <- liftIO newNodeId
1708 let subscribed = CoincidenceSubscribed
1704 let subscribed = CoincidenceSubscribed
1709 { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c
1705 { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c
1710 , coincidenceSubscribedOccurrence = occRef
1706 , coincidenceSubscribedOccurrence = occRef
@@ -1715,7 +1711,7 @@ getCoincidenceSubscribed c sub = do
1715 , coincidenceSubscribedInnerParent = innerSubdRef
1711 , coincidenceSubscribedInnerParent = innerSubdRef
1716 , coincidenceSubscribedWeakSelf = weakSelf
1712 , coincidenceSubscribedWeakSelf = weakSelf
1717#ifdef DEBUG_NODEIDS
1713#ifdef DEBUG_NODEIDS
1718− , coincidenceSubscribedNodeId = nid
1714+ , coincidenceSubscribedNodeId = unsafeNodeId c
1721 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
1717 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
@@ -2089,13 +2085,12 @@ newtype EventSelector x k = EventSelector { select :: forall a. k a -> Event x a
2089newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) }
2085newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) }
2091fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v
2087fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v
2092−fanG e = unsafePerformIO $ do
2088+fanG e =
2093− ref <- newIORef Nothing
2094 let f = Fan
2089 let f = Fan
2095 { fanParent = e
2090 { fanParent = e
2096− , fanSubscribed = ref
2091+ , fanSubscribed = unsafeNewIORef e Nothing
2098− pure $ EventSelectorG $ \k -> eventFan k f
2093+ in EventSelectorG $ \k -> eventFan k f
2100runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
2095runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
2101runHoldInits holdInitRef dynInitRef mergeInitRef = do
2096runHoldInits holdInitRef dynInitRef mergeInitRef = do