@@ -198,12 +198,6 @@ nextNodeIdRef = unsafePerformIO $ newIORef 1
199newNodeId :: IO Int
199newNodeId :: IO Int
200newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)
200newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)
202−{-# NOINLINE unsafeNodeId #-}
203−unsafeNodeId :: a -> Int
204−unsafeNodeId a = unsafePerformIO $ do
209--------------------------------------------------------------------------------
203--------------------------------------------------------------------------------
@@ -307,9 +301,10 @@ cacheEvent e =
304+ unsafePerformIO $ do
310− let mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
305+ mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
311− !mSubscribedRef = unsafeNewIORef e emptyFastWeak
306+ <- newIORef emptyFastWeak
312− in \sub -> {-# SCC "cacheEvent" #-} do
307+ pure $ \sub -> {-# SCC "cacheEvent" #-} do
313#ifdef DEBUG_TRACE_EVENTS
308#ifdef DEBUG_TRACE_EVENTS
314 unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite
309 unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite
@@ -1177,18 +1172,12 @@ buildDynamic readV0 v' = do
1177 return d
1172 return d
1179unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
1174unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
1180−unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ UnsafeDyn x
1175+unsafeBuildDynamic readV0 v' =
1181− where x = (readV0, v')
1176+ Dyn $ unsafePerformIO $ newIORef $ UnsafeDyn (readV0, v')
1183-- ResultM can read behaviors and events
1178-- ResultM can read behaviors and events
1184type ResultM = EventM
1179type ResultM = EventM
1186−{-# NOINLINE unsafeNewIORef #-}
1187−unsafeNewIORef :: a -> b -> IORef b
1188−unsafeNewIORef a b = unsafePerformIO $ do
1192instance HasSpiderTimeline x => Functor (Event x) where
1181instance HasSpiderTimeline x => Functor (Event x) where
1193 fmap f = push $ return . Just . f
1182 fmap f = push $ return . Just . f
@@ -1201,26 +1190,35 @@ push f e = cacheEvent (pushCheap f e)
1202{-# INLINABLE pull #-}
1191{-# INLINABLE pull #-}
1203pull :: BehaviorM x a -> Behavior x a
1192pull :: BehaviorM x a -> Behavior x a
1204−pull a = behaviorPull $ Pull
1193+pull a = unsafePerformIO $ do
1205− { pullCompute = a
1194+ ref <- newIORef Nothing
1206− , pullValue = unsafeNewIORef a Nothing
1207#ifdef DEBUG_NODEIDS
1195#ifdef DEBUG_NODEIDS
1208− , pullNodeId = unsafeNodeId a
1196+ nid <- newNodeId
1198+ pure $ behaviorPull $ Pull
1201+#ifdef DEBUG_NODEIDS
1212{-# INLINABLE switch #-}
1206{-# INLINABLE switch #-}
1213switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a
1207switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a
1208+switch a = unsafePerformIO $ do
1209+ ref <- newIORef Nothing
1214−switch a = eventSwitch $ Switch
1210+ pure $ eventSwitch $ Switch
1215− { switchParent = a
1211+ { switchParent = a
1216− , switchSubscribed = unsafeNewIORef a Nothing
1212+ , switchSubscribed = ref
1219coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a
1215coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a
1216+coincidence a = unsafePerformIO $ do
1217+ ref <- newIORef Nothing
1220−coincidence a = eventCoincidence $ Coincidence
1218+ pure $ eventCoincidence $ Coincidence
1221− { coincidenceParent = a
1219+ { coincidenceParent = a
1222− , coincidenceSubscribed = unsafeNewIORef a Nothing
1220+ , coincidenceSubscribed = ref
1225-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
1223-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
1226run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
1224run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
@@ -1424,6 +1422,9 @@ getRootSubscribed k r sub = do
1424 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
1422 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
1425 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
1423 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
1426 writeIORef uninitRef $! uninit
1424 writeIORef uninitRef $! uninit
1425+#ifdef DEBUG_NODEIDS
1427 let !subscribed = RootSubscribed
1428 let !subscribed = RootSubscribed
1428 { rootSubscribedKey = k
1429 { rootSubscribedKey = k
1429 , rootSubscribedCachedSubscribed = cached
1430 , rootSubscribedCachedSubscribed = cached
@@ -1432,7 +1433,7 @@ getRootSubscribed k r sub = do
1432 , rootSubscribedUninit = uninit
1433 , rootSubscribedUninit = uninit
1433 , rootSubscribedWeakSelf = weakSelf
1434 , rootSubscribedWeakSelf = weakSelf
1434#ifdef DEBUG_NODEIDS
1435#ifdef DEBUG_NODEIDS
1435− , rootSubscribedNodeId = unsafeNodeId (k, r, subs)
1436+ , rootSubscribedNodeId = nid
1438 -- If we die at the same moment that all our children die, they will
1439 -- If we die at the same moment that all our children die, they will
@@ -1481,16 +1482,10 @@ newFanInt = do
1481 , _fanInt_occRef = occRef
1482 , _fanInt_occRef = occRef
1484−{-# NOINLINE unsafeNewFanInt #-}
1485−unsafeNewFanInt :: b -> FanInt x a
1486−unsafeNewFanInt b = unsafePerformIO $ do
1490fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
1485fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
1491−fanInt p =
1486+fanInt p = unsafePerformIO $ do
1492− let self = unsafeNewFanInt p
1487+ self <- newFanInt
1493− in EventSelectorInt $ \k -> Event $ \sub -> do
1488+ pure $ EventSelectorInt $ \k -> Event $ \sub -> do
1494 isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)
1489 isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)
1495 when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input
1490 when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input
1496 (subscription, parentOcc) <- subscribeAndRead p $ Subscriber
1491 (subscription, parentOcc) <- subscribeAndRead p $ Subscriber
@@ -1544,13 +1539,16 @@ getFanSubscribed k f sub = do
1544 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
1539 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
1545 occRef <- liftIO $ newIORef parentOcc
1540 occRef <- liftIO $ newIORef parentOcc
1546 when (isJust parentOcc) $ scheduleClear occRef
1541 when (isJust parentOcc) $ scheduleClear occRef
1542+#ifdef DEBUG_NODEIDS
1543+ nid <- liftIO newNodeId
1547 let subscribed = FanSubscribed
1545 let subscribed = FanSubscribed
1548 { fanSubscribedCachedSubscribed = fanSubscribed f
1546 { fanSubscribedCachedSubscribed = fanSubscribed f
1549 , fanSubscribedOccurrence = occRef
1547 , fanSubscribedOccurrence = occRef
1550 , fanSubscribedParent = subscription
1548 , fanSubscribedParent = subscription
1551 , fanSubscribedSubscribers = subscribersRef
1549 , fanSubscribedSubscribers = subscribersRef
1552#ifdef DEBUG_NODEIDS
1550#ifdef DEBUG_NODEIDS
1553− , fanSubscribedNodeId = unsafeNodeId f
1551+ , fanSubscribedNodeId = nid
1556 let !self = (k, subscribed)
1554 let !self = (k, subscribed)
@@ -1610,6 +1608,9 @@ getSwitchSubscribed s sub = do
1610 when (isJust parentOcc) $ scheduleClear occRef
1608 when (isJust parentOcc) $ scheduleClear occRef
1611 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"
1609 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"
1612 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed
1610 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed
1611+#ifdef DEBUG_NODEIDS
1612+ nid <- liftIO newNodeId
1613 let !subscribed = SwitchSubscribed
1614 let !subscribed = SwitchSubscribed
1614 { switchSubscribedCachedSubscribed = switchSubscribed s
1615 { switchSubscribedCachedSubscribed = switchSubscribed s
1615 , switchSubscribedOccurrence = occRef
1616 , switchSubscribedOccurrence = occRef
@@ -1622,7 +1623,7 @@ getSwitchSubscribed s sub = do
1622 , switchSubscribedCurrentParent = subscriptionRef
1623 , switchSubscribedCurrentParent = subscriptionRef
1623 , switchSubscribedWeakSelf = weakSelf
1624 , switchSubscribedWeakSelf = weakSelf
1624#ifdef DEBUG_NODEIDS
1625#ifdef DEBUG_NODEIDS
1625− , switchSubscribedNodeId = unsafeNodeId s
1626+ , switchSubscribedNodeId = nid
1628 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
1629 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
@@ -1667,6 +1668,9 @@ getCoincidenceSubscribed c sub = do
1667 scheduleClear innerSubdRef
1668 scheduleClear innerSubdRef
1668 weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"
1669 weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"
1669 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed
1670 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed
1671+#ifdef DEBUG_NODEIDS
1672+ nid <- liftIO newNodeId
1670 let subscribed = CoincidenceSubscribed
1674 let subscribed = CoincidenceSubscribed
1671 { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c
1675 { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c
1672 , coincidenceSubscribedOccurrence = occRef
1676 , coincidenceSubscribedOccurrence = occRef
@@ -1677,7 +1681,7 @@ getCoincidenceSubscribed c sub = do
1677 , coincidenceSubscribedInnerParent = innerSubdRef
1681 , coincidenceSubscribedInnerParent = innerSubdRef
1678 , coincidenceSubscribedWeakSelf = weakSelf
1682 , coincidenceSubscribedWeakSelf = weakSelf
1679#ifdef DEBUG_NODEIDS
1683#ifdef DEBUG_NODEIDS
1680− , coincidenceSubscribedNodeId = unsafeNodeId c
1684+ , coincidenceSubscribedNodeId = nid
1683 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
1687 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
@@ -2051,12 +2055,13 @@ newtype EventSelector x k = EventSelector { select :: forall a. k a -> Event x a
2051newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) }
2055newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) }
2053fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v
2057fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v
2054−fanG e =
2058+fanG e = unsafePerformIO $ do
2059+ ref <- newIORef Nothing
2055 let f = Fan
2060 let f = Fan
2056 { fanParent = e
2061 { fanParent = e
2057− , fanSubscribed = unsafeNewIORef e Nothing
2062+ , fanSubscribed = ref
2059− in EventSelectorG $ \k -> eventFan k f
2064+ pure $ EventSelectorG $ \k -> eventFan k f
2061runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
2066runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
2062runHoldInits holdInitRef dynInitRef mergeInitRef = do
2067runHoldInits holdInitRef dynInitRef mergeInitRef = do