@@ -99,30 +99,17 @@ withStackOneLine expr = unsafePerformIO $ do
9999
100100#endif
101101
102−debugPropagate :: Bool
103−
104−debugInvalidateHeight :: Bool
105−
106−debugInvalidate :: Bool
107−
108102#ifdef DEBUG
109−
110103#define DEBUG_NODEIDS
111104
112−debugPropagate = True
113−
114−debugInvalidateHeight = False
115−
116−debugInvalidate = True
117−
118105class HasNodeId a where
119106 getNodeId :: a -> Int
120107
121−instance HasNodeId (Hold x p a) where
108+instance HasNodeId (Hold x p) where
122109 getNodeId = holdNodeId
123110
124−instance HasNodeId (PushSubscribed x a b) where
125− getNodeId = pushSubscribedNodeId
111+-- instance HasNodeId (PushSubscribed x a b) where
112+-- getNodeId = pushSubscribedNodeId
126113
127114instance HasNodeId (SwitchSubscribed x a) where
128115 getNodeId = switchSubscribedNodeId
@@ -143,41 +130,9 @@ instance HasNodeId (Pull x a) where
143130showNodeId :: HasNodeId a => a -> String
144131showNodeId = ("#"<>) . show . getNodeId
145132
146−showSubscriberType :: Subscriber x a -> String
147−showSubscriberType = \case
148− SubscriberPush _ _ -> "SubscriberPush"
149− SubscriberMerge _ _ -> "SubscriberMerge"
150− SubscriberFan _ -> "SubscriberFan"
151− SubscriberMergeChange _ -> "SubscriberMergeChange"
152− SubscriberHold _ -> "SubscriberHold"
153− SubscriberHoldIdentity _ -> "SubscriberHoldIdentity"
154− SubscriberSwitch _ -> "SubscriberSwitch"
155− SubscriberCoincidenceOuter _ -> "SubscriberCoincidenceOuter"
156− SubscriberCoincidenceInner _ -> "SubscriberCoincidenceInner"
157− SubscriberHandle -> "SubscriberHandle"
158−
159−showEventType :: Event x a -> String
160−showEventType = \case
161− EventRoot _ _ -> "EventRoot"
162− EventNever -> "EventNever"
163− EventPush _ -> "EventPush"
164− EventMerge _ -> "EventMerge"
165− EventFan _ _ -> "EventFan"
166− EventSwitch _ -> "EventSwitch"
167− EventCoincidence _ -> "EventCoincidence"
168− EventHold _ -> "EventHold"
169− EventDyn _ -> "EventDyn"
170− EventHoldIdentity _ -> "EventHoldIdentity"
171− EventDynIdentity _ -> "EventDynIdentity"
172133
173134#else
174135
175−debugPropagate = False
176−
177−debugInvalidateHeight = False
178−
179−debugInvalidate = False
180−
181136-- This must be inline, or error messages will cause memory leaks due to retaining the node in question
182137{-# INLINE showNodeId #-}
183138showNodeId :: a -> String
@@ -363,7 +318,7 @@ wrap tag getSpecificSubscribed sub = do
363318 let es = tag subd
364319 return (EventSubscription (WeakBag.remove sln >> touch sln) es, occ)
365320
366−eventRoot :: GCompare k => k a -> Root x k -> Event x a
321+eventRoot :: (GCompare k, HasSpiderTimeline x) => k a -> Root x k -> Event x a
367322eventRoot !k !r = Event $ wrap eventSubscribedRoot $ liftIO . getRootSubscribed k r
368323
369324eventNever :: Event x a
@@ -422,10 +377,10 @@ newSubscriberHold h = return $ Subscriber
422377 }
423378
424379newSubscriberFan :: forall x k. (HasSpiderTimeline x, GCompare k) => FanSubscribed x k -> IO (Subscriber x (DMap k Identity))
425−newSubscriberFan subscribed = return $ Subscriber
380+newSubscriberFan subscribed = debugSubscriber ("SubscriberFan " <> showNodeId subscribed) $ Subscriber
426381 { subscriberPropagate = \a -> {-# SCC "traverseFan" #-} do
427382 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
428− tracePropagate (Proxy :: Proxy x) $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
383+ -- tracePropagate (Proxy :: Proxy x) $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
429384 liftIO $ writeIORef (fanSubscribedOccurrence subscribed) $ Just a
430385 scheduleClear $ fanSubscribedOccurrence subscribed
431386 let f _ (Pair (Identity v) subsubs) = do
@@ -434,46 +389,37 @@ newSubscriberFan subscribed = return $ Subscriber
434389 _ <- DMap.traverseWithKey f $ DMap.intersectionWithKey (\_ -> Pair) a subs --TODO: Would be nice to have DMap.traverse_
435390 return ()
436391 , subscriberInvalidateHeight = \old -> do
437− when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
438392 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
439393 forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse (_fanSubscribedChildren_list v) $ invalidateSubscriberHeight old
440− when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
394+
441395 , subscriberRecalculateHeight = \new -> do
442− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
443396 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
444397 forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse (_fanSubscribedChildren_list v) $ recalculateSubscriberHeight new
445− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
446398 }
447399
448400newSubscriberSwitch :: forall x a. HasSpiderTimeline x => SwitchSubscribed x a -> IO (Subscriber x a)
449−newSubscriberSwitch subscribed = return $ Subscriber
401+newSubscriberSwitch subscribed = debugSubscriber ("SubscriberCoincidenceOuter" <> showNodeId subscribed) $ Subscriber
450402 { subscriberPropagate = \a -> {-# SCC "traverseSwitch" #-} do
451− tracePropagate (Proxy :: Proxy x) $ "SubscriberSwitch" <> showNodeId subscribed
452403 liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $ Just a
453404 scheduleClear $ switchSubscribedOccurrence subscribed
454405 propagate a $ switchSubscribedSubscribers subscribed
455406 , subscriberInvalidateHeight = \_ -> do
456− when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed
457407 oldHeight <- readIORef $ switchSubscribedHeight subscribed
458408 when (oldHeight /= invalidHeight) $ do
459409 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
460410 WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
461− when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"
462− , subscriberRecalculateHeight = \new -> do
463− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed
464− updateSwitchHeight new subscribed
465− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"
466− }
411+ , subscriberRecalculateHeight = (`updateSwitchHeight` subscribed)
412+ }
467413
468414newSubscriberCoincidenceOuter :: forall x b. HasSpiderTimeline x => CoincidenceSubscribed x b -> IO (Subscriber x (Event x b))
469−newSubscriberCoincidenceOuter subscribed = return $ Subscriber
415+newSubscriberCoincidenceOuter subscribed = debugSubscriber ("SubscriberCoincidenceOuter" <> showNodeId subscribed) $ Subscriber
470416 { subscriberPropagate = \a -> {-# SCC "traverseCoincidenceOuter" #-} do
471− tracePropagate (Proxy :: Proxy x) $ "SubscriberCoincidenceOuter" <> showNodeId subscribed
472417 outerHeight <- liftIO $ readIORef $ coincidenceSubscribedHeight subscribed
473418 tracePropagate (Proxy :: Proxy x) $ " outerHeight = " <> show outerHeight
474419 (occ, innerHeight, innerSubd) <- subscribeCoincidenceInner a outerHeight subscribed
475420 tracePropagate (Proxy :: Proxy x) $ " isJust occ = " <> show (isJust occ)
476421 tracePropagate (Proxy :: Proxy x) $ " innerHeight = " <> show innerHeight
422+
477423 liftIO $ writeIORef (coincidenceSubscribedInnerParent subscribed) $ Just innerSubd
478424 scheduleClear $ coincidenceSubscribedInnerParent subscribed
479425 case occ of
@@ -486,20 +432,13 @@ newSubscriberCoincidenceOuter subscribed = return $ Subscriber
486432 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ
487433 scheduleClear $ coincidenceSubscribedOccurrence subscribed
488434 propagate o $ coincidenceSubscribedSubscribers subscribed
489− , subscriberInvalidateHeight = \_ -> do
490− when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed
491− invalidateCoincidenceHeight subscribed
492− when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed <> " done"
493− , subscriberRecalculateHeight = \_ -> do
494− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed
495− recalculateCoincidenceHeight subscribed
496− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed <> " done"
435+ , subscriberInvalidateHeight = \_ -> invalidateCoincidenceHeight subscribed
436+ , subscriberRecalculateHeight = \_ -> recalculateCoincidenceHeight subscribed
497437 }
498438
499439newSubscriberCoincidenceInner :: forall x a. HasSpiderTimeline x => CoincidenceSubscribed x a -> IO (Subscriber x a)
500−newSubscriberCoincidenceInner subscribed = return $ Subscriber
440+newSubscriberCoincidenceInner subscribed = debugSubscriber ("SubscriberCoincidenceInner" <> showNodeId subscribed) $ Subscriber
501441 { subscriberPropagate = \a -> {-# SCC "traverseCoincidenceInner" #-} do
502− tracePropagate (Proxy :: Proxy x) $ "SubscriberCoincidenceInner" <> showNodeId subscribed
503442 occ <- liftIO $ readIORef $ coincidenceSubscribedOccurrence subscribed
504443 case occ of
505444 Just _ -> return () -- SubscriberCoincidenceOuter must have already propagated this event
@@ -507,14 +446,8 @@ newSubscriberCoincidenceInner subscribed = return $ Subscriber
507446 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $ Just a
508447 scheduleClear $ coincidenceSubscribedOccurrence subscribed
509448 propagate a $ coincidenceSubscribedSubscribers subscribed
510− , subscriberInvalidateHeight = \_ -> do
511− when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed
512− invalidateCoincidenceHeight subscribed
513− when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed <> " done"
514− , subscriberRecalculateHeight = \_ -> do
515− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed
516− recalculateCoincidenceHeight subscribed
517− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed <> " done"
449+ , subscriberInvalidateHeight = \_ -> invalidateCoincidenceHeight subscribed
450+ , subscriberRecalculateHeight = \_ -> recalculateCoincidenceHeight subscribed
518451 }
519452
520453invalidateSubscriberHeight :: Height -> Subscriber x a -> IO ()
@@ -524,15 +457,15 @@ recalculateSubscriberHeight :: Height -> Subscriber x a -> IO ()
524457recalculateSubscriberHeight = flip subscriberRecalculateHeight
525458
526459-- | Propagate everything at the current height
527−propagate :: a -> WeakBag (Subscriber x a) -> EventM x ()
528−propagate a subscribers = withIncreasedDepth $ do
460+propagate :: forall a x. HasSpiderTimeline x => a -> WeakBag (Subscriber x a) -> EventM x ()
461+propagate a subscribers = withIncreasedDepth (Proxy::Proxy x) $ do
529462 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
530463 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work
531464 WeakBag.traverse subscribers $ \s -> subscriberPropagate s a
532465
533466-- | Propagate everything at the current height
534−propagateFast :: a -> FastWeakBag (Subscriber x a) -> EventM x ()
535−propagateFast a subscribers = withIncreasedDepth $ do
467+propagateFast :: forall a x. HasSpiderTimeline x => a -> FastWeakBag (Subscriber x a) -> EventM x ()
468+propagateFast a subscribers = withIncreasedDepth (Proxy::Proxy x) $ do
536469 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
537470 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work
538471 FastWeakBag.traverse subscribers $ \s -> subscriberPropagate s a
@@ -1004,7 +937,7 @@ data SomeMergeUpdate x = SomeMergeUpdate
1004937newtype SomeMergeInit x = SomeMergeInit { unSomeMergeInit :: EventM x () }
1005938
1006939-- EventM can do everything BehaviorM can, plus create holds
1007−newtype EventM x a = EventM { unEventM :: IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException) -- The environment should be Nothing if we are not in a frame, and Just if we are - in which case it is a list of assignments to be done after the frame is over
940+newtype EventM x a = EventM { unEventM :: IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException)
1008941
1009942newtype MergeSubscribedParent x a = MergeSubscribedParent { unMergeSubscribedParent :: EventSubscription x }
1010943
@@ -1279,45 +1212,87 @@ mkWeakPtrWithDebug x debugNote = do
12791212
12801213type WeakList a = [Weak a]
12811214
1282−{-# INLINE withIncreasedDepth #-}
1215+type CanTrace x m = (HasSpiderTimeline x, MonadIO m)
1216+
1217+
1218+
1219+
12831220#ifdef DEBUG
1284−withIncreasedDepth :: CanTrace x m => m a -> m a
1285−withIncreasedDepth a = do
1286− spiderTimeline <- askSpiderTimelineEnv
1287− liftIO $ modifyIORef' (_spiderTimeline_depth spiderTimeline) succ
1221+
1222+debugSubscriber :: forall x a. HasSpiderTimeline x => String -> Subscriber x a -> IO (Subscriber x a)
1223+debugSubscriber description subscribed = return $ Subscriber
1224+ {
1225+ subscriberPropagate = \m -> do
1226+ tracePropagate (Proxy :: Proxy x) ("subscriberPropagate: " <> description)
1227+ subscriberPropagate subscribed m
1228+ , subscriberInvalidateHeight = \old -> do
1229+ putStrLn $ "invalidateSubscriberHeight: " <> description
1230+ subscriberInvalidateHeight subscribed old
1231+ putStrLn $ "invalidateSubscriberHeight: " <> description <> ", done"
1232+ , subscriberRecalculateHeight = \new -> do
1233+ putStrLn $ "subscriberRecalculateHeight: " <> description
1234+ subscriberRecalculateHeight subscribed new
1235+ putStrLn $ "subscriberRecalculateHeight: " <> description <> ", done"
1236+ }
1237+
1238+
1239+{-# INLINE withIncreasedDepth #-}
1240+withIncreasedDepth :: forall proxy x m a. CanTrace x m => proxy x -> m a -> m a
1241+withIncreasedDepth _ a = do
1242+ liftIO $ modifyIORef' (_spiderTimeline_depth (spiderTimeline :: SpiderTimelineEnv x)) succ
12881243 result <- a
1289− liftIO $ modifyIORef' (_spiderTimeline_depth spiderTimeline) pred
1244+ liftIO $ modifyIORef' (_spiderTimeline_depth (spiderTimeline :: SpiderTimelineEnv x)) pred
12901245 return result
1291−#else
1292−withIncreasedDepth :: m a -> m a
1293−withIncreasedDepth = id
1294−#endif
1295−
1296−type CanTrace x m = (HasSpiderTimeline x, MonadIO m)
12971246
12981247{-# INLINE tracePropagate #-}
12991248tracePropagate :: (CanTrace x m) => proxy x -> String -> m ()
1300−tracePropagate p = traceWhen p debugPropagate
1249+tracePropagate p = trace p
13011250
13021251{-# INLINE traceInvalidate #-}
13031252traceInvalidate :: String -> IO ()
1304−traceInvalidate = when debugInvalidate . liftIO . putStrLn
1253+traceInvalidate = liftIO . putStrLn
13051254
1306−{-# INLINE traceWhen #-}
1307−traceWhen :: (CanTrace x m) => proxy x -> Bool -> String -> m ()
1308−traceWhen p b message = traceMWhen p b $ return message
1255+{-# INLINE trace #-}
1256+trace :: (CanTrace x m) => proxy x -> String -> m ()
1257+trace p message = traceM p $ return message
13091258
1310−{-# INLINE traceMWhen #-}
1311−traceMWhen :: (CanTrace x m) => proxy x -> Bool -> m String -> m ()
1312−traceMWhen _ b getMessage = when b $ do
1259+{-# INLINE traceM #-}
1260+traceM :: forall x proxy m. (CanTrace x m) => proxy x -> m String -> m ()
1261+traceM _ getMessage = do
13131262 message <- getMessage
1314−#ifdef DEBUG
1315− spiderTimeline <- askSpiderTimelineEnv
1316− d <- liftIO $ readIORef $ _spiderTimeline_depth spiderTimeline
1263+ d <- liftIO $ readIORef $ _spiderTimeline_depth (spiderTimeline :: SpiderTimelineEnv x)
1264+ liftIO $ putStrLn $ replicate d ' ' <> message
1265+
13171266#else
1318− let d = 0
1267+
1268+{-# INLINE withIncreasedDepth #-}
1269+withIncreasedDepth :: forall x m proxy a. HasSpiderTimeline x => proxy x -> m a -> m a
1270+withIncreasedDepth _ = id
1271+
1272+{-# INLINE tracePropagate #-}
1273+tracePropagate :: (CanTrace x m) => proxy x -> String -> m ()
1274+tracePropagate _ _ = return ()
1275+
1276+{-# INLINE traceInvalidate #-}
1277+traceInvalidate :: String -> IO ()
1278+traceInvalidate _ = return ()
1279+
1280+{-# INLINE debugSubscriber #-}
1281+debugSubscriber :: HasSpiderTimeline x => String -> Subscriber x a -> IO (Subscriber x a)
1282+debugSubscriber _ = return
1283+
1284+{-# INLINE trace #-}
1285+trace :: (CanTrace x m) => proxy x -> String -> m ()
1286+trace _ _ = return ()
1287+
1288+{-# INLINE traceM #-}
1289+traceM :: (CanTrace x m) => proxy x -> m String -> m ()
1290+traceM _ _ = return ()
1291+
13191292#endif
1320− liftIO $ putStrLn $ replicate d ' ' <> message
1293+
1294+
1295+
13211296
13221297whoCreatedIORef :: IORef a -> IO [String]
13231298whoCreatedIORef (IORef a) = whoCreated $! a
@@ -1339,14 +1314,16 @@ listsToForest l = fmap (\(a, l') -> Node a $ listsToForest $ toList l') $ groupB
13391314{-# INLINE propagateSubscriberHold #-}
13401315propagateSubscriberHold :: forall x p. (HasSpiderTimeline x, Patch p) => Hold x p -> p -> EventM x ()
13411316propagateSubscriberHold h a = do
1342− {-# SCC "trace" #-} traceMWhen (Proxy :: Proxy x) debugPropagate $ liftIO $ do
1317+ traceM (Proxy :: Proxy x) $ liftIO $ do
13431318 invalidators <- liftIO $ readIORef $ holdInvalidators h
13441319 return $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)
1320+
13451321 v <- {-# SCC "read" #-} liftIO $ readIORef $ holdValue h
13461322 case {-# SCC "apply" #-} apply a v of
13471323 Nothing -> return ()
13481324 Just v' -> do
1349− {-# SCC "trace2" #-} withIncreasedDepth $ tracePropagate (Proxy :: Proxy x) $ "propagateSubscriberHold: assigning Hold" <> showNodeId h
1325+ withIncreasedDepth (Proxy :: Proxy x) $
1326+ tracePropagate (Proxy :: Proxy x) ("propagateSubscriberHold: assigning Hold" <> showNodeId h)
13501327 vRef <- {-# SCC "vRef" #-} liftIO $ evaluate $ holdValue h
13511328 iRef <- {-# SCC "iRef" #-} liftIO $ evaluate $ holdInvalidators h
13521329 defer $ {-# SCC "assignment" #-} SomeAssignment vRef iRef v'
@@ -1400,7 +1377,7 @@ getDynHold d = do
14001377zeroRef :: IORef Height
14011378zeroRef = unsafePerformIO $ newIORef zeroHeight
14021379
1403−getRootSubscribed :: GCompare k => k a -> Root x k -> Subscriber x a -> IO (WeakBagTicket, RootSubscribed x a, Maybe a)
1380+getRootSubscribed :: forall k x a. (GCompare k, HasSpiderTimeline x) => k a -> Root x k -> Subscriber x a -> IO (WeakBagTicket, RootSubscribed x a, Maybe a)
14041381getRootSubscribed k r sub = do
14051382 mSubscribed <- readIORef $ rootSubscribed r
14061383 let getOcc = fmap (coerce . DMap.lookup k) $ readIORef $ rootOccurrence r
@@ -1414,7 +1391,9 @@ getRootSubscribed k r sub = do
14141391 let !cached = rootSubscribed r
14151392 uninitRef <- newIORef $ error "getRootsubscribed: uninitRef not initialized"
14161393 (subs, sln) <- WeakBag.singleton sub weakSelf cleanupRootSubscribed
1417− when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
1394+
1395+ tracePropagate (Proxy::Proxy x) $ "getRootSubscribed: calling rootInit"
1396+
14181397 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
14191398 writeIORef uninitRef $! uninit
14201399 let !subscribed = RootSubscribed
@@ -1820,7 +1799,7 @@ revalidateMergeHeight m = do
18201799 LT -> return ()
18211800 EQ -> do
18221801 let height = succHeight $ heightBagMax heights
1823− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: height: " <> show height
1802+ traceInvalidate $ "recalculateSubscriberHeight: height: " <> show height
18241803 writeIORef (_merge_heightRef m) $! height
18251804 subscriberRecalculateHeight (_merge_sub m) height
18261805 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show (DMap.size parents) <> ") for Merge"
@@ -1953,7 +1932,7 @@ mergeIntCheap d = Event $ \sub -> do
19531932 LT -> return ()
19541933 EQ -> do
19551934 let height = succHeight $ heightBagMax heights
1956− when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: height: " <> show height
1935+ traceInvalidate $ "recalculateSubscriberHeight: height: " <> show height
19571936 writeIORef heightRef $! height
19581937 subscriberRecalculateHeight sub height
19591938 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show numParents <> ") for Merge"
@@ -2105,19 +2084,19 @@ runFrame a = SpiderHost $ do
21052084 coincidenceInfos <- readIORef $ eventEnvResetCoincidences env
21062085 forM_ toAssign $ \(SomeAssignment vRef iRef v) -> {-# SCC "assignment" #-} do
21072086 writeIORef vRef v
2108− when debugInvalidate $ putStrLn $ "Invalidating Hold"
2087+ traceInvalidate $ "Invalidating Hold"
21092088 writeIORef iRef =<< evaluate =<< invalidate toReconnectRef =<< readIORef iRef
21102089 mergeUpdates <- readIORef $ eventEnvMergeUpdates env
21112090 writeIORef (eventEnvMergeUpdates env) []
2112− when debugPropagate $ putStrLn "Updating merges"
2091+ tracePropagate (Proxy::Proxy x) $ "Updating merges"
21132092 mergeSubscriptionsToKill <- runEventM $ concat <$> mapM _someMergeUpdate_update mergeUpdates
2114− when debugPropagate $ putStrLn "Updating merges done"
2093+ tracePropagate (Proxy::Proxy x) $ "Updating merges done"
21152094 toReconnect <- readIORef toReconnectRef
21162095 clearEventEnv env
21172096 switchSubscriptionsToKill <- forM toReconnect $ \(SomeSwitchSubscribed subscribed) -> {-# SCC "switchSubscribed" #-} do
21182097 oldSubscription <- readIORef $ switchSubscribedCurrentParent subscribed
21192098 wi <- readIORef $ switchSubscribedOwnWeakInvalidator subscribed
2120− when debugInvalidate $ putStrLn $ "Finalizing invalidator for Switch" <> showNodeId subscribed
2099+ traceInvalidate $ "Finalizing invalidator for Switch" <> showNodeId subscribed
21212100 finalize wi
21222101 i <- evaluate $ switchSubscribedOwnInvalidator subscribed
21232102 wi' <- mkWeakPtrWithDebug i "wi'"
@@ -2421,13 +2400,13 @@ instance HasSpiderTimeline x => Reflex.Host.Class.MonadReadEvent (SpiderTimeline
24212400 touch h
24222401 return result
24232402
2424−instance Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHost x) where
2403+instance HasSpiderTimeline x => Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHost x) where
24252404 newEventWithTrigger = SpiderHost . fmap SpiderEvent . newEventWithTriggerIO
24262405 newFanEventWithTrigger f = SpiderHost $ do
24272406 es <- newFanEventWithTriggerIO f
24282407 return $ Reflex.Class.EventSelector $ SpiderEvent . Reflex.Spider.Internal.select es
24292408
2430−instance Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHostFrame x) where
2409+instance HasSpiderTimeline x => Reflex.Host.Class.MonadReflexCreateTrigger (SpiderTimeline x) (SpiderHostFrame x) where
24312410 newEventWithTrigger = SpiderHostFrame . EventM . liftIO . fmap SpiderEvent . newEventWithTriggerIO
24322411 newFanEventWithTrigger f = SpiderHostFrame $ EventM $ liftIO $ do
24332412 es <- newFanEventWithTriggerIO f
@@ -2599,12 +2578,12 @@ instance NotReady (SpiderTimeline x) (SpiderHostFrame x) where
25992578 notReadyUntil _ = pure ()
26002579 notReady = pure ()
26012580
2602−newEventWithTriggerIO :: (RootTrigger x a -> IO (IO ())) -> IO (Event x a)
2581+newEventWithTriggerIO :: forall x a. HasSpiderTimeline x => (RootTrigger x a -> IO (IO ())) -> IO (Event x a)
26032582newEventWithTriggerIO f = do
26042583 es <- newFanEventWithTriggerIO $ \Refl -> f
26052584 return $ select es Refl
26062585
2607−newFanEventWithTriggerIO :: GCompare k => (forall a. k a -> RootTrigger x a -> IO (IO ())) -> IO (EventSelector x k)
2586+newFanEventWithTriggerIO :: (HasSpiderTimeline x, GCompare k) => (forall a. k a -> RootTrigger x a -> IO (IO ())) -> IO (EventSelector x k)
26082587newFanEventWithTriggerIO f = do
26092588 occRef <- newIORef DMap.empty
26102589 subscribedRef <- newIORef DMap.empty