@@ -129,9 +129,33 @@ withStackOneLine expr = unsafePerformIO $ do
129129
130130#endif
131131
132+debugPropagate :: Bool
133+
134+debugInvalidateHeight :: Bool
135+
136+debugInvalidate :: Bool
137+
132138#ifdef DEBUG
133139#define DEBUG_NODEIDS
134140
141+#ifdef DEBUG_TRACE_PROPAGATION
142+debugPropagate = True
143+#else
144+debugPropagate = False
145+#endif
146+
147+#ifdef DEBUG_TRACE_HEIGHT
148+debugInvalidateHeight = True
149+#else
150+debugInvalidateHeight = False
151+#endif
152+
153+#ifdef DEBUG_TRACE_INVALIDATION
154+debugInvalidate = True
155+#else
156+debugInvalidate = False
157+#endif
158+
135159class HasNodeId a where
136160 getNodeId :: a -> Int
137161
@@ -169,6 +193,10 @@ showNodeId' = ("#"<>) . show
169193
170194#else
171195
196+debugPropagate = False
197+debugInvalidateHeight = False
198+debugInvalidate = False
199+
172200-- This must be inline, or error messages will cause memory leaks due to retaining the node in question
173201{-# INLINE showNodeId #-}
174202showNodeId :: a -> String
@@ -1351,11 +1379,11 @@ tracePropagate p = when debugPropagate . trace p
13511379
13521380{-# INLINE traceInvalidate #-}
13531381traceInvalidate :: String -> IO ()
1354−traceInvalidate = liftIO . debugStrLn
1382+traceInvalidate = when debugInvalidate . liftIO . debugStrLn
13551383
13561384{-# INLINE traceInvalidateHeight #-}
13571385traceInvalidateHeight :: String -> IO ()
1358−traceInvalidateHeight = liftIO . debugStrLn
1386+traceInvalidateHeight = when debugInvalidateHeight . liftIO . debugStrLn
13591387
13601388{-# INLINE trace #-}
13611389trace :: (CanTrace x m) => proxy x -> String -> m ()
@@ -1454,7 +1482,7 @@ instance Show EventLoopException where
14541482{-# INLINE propagateSubscriberHold #-}
14551483propagateSubscriberHold :: forall x p. (HasSpiderTimeline x, Patch p) => Hold x p -> p -> EventM x ()
14561484propagateSubscriberHold h a = do
1457− traceM (Proxy :: Proxy x) $ liftIO $ do
1485+ {-# SCC "trace" #-} when debugPropagate $ traceM (Proxy :: Proxy x) $ liftIO $ do
14581486 invalidators <- liftIO $ readIORef $ holdInvalidators h
14591487 return $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)
14601488
@@ -1462,7 +1490,7 @@ propagateSubscriberHold h a = do
14621490 case {-# SCC "apply" #-} apply a v of
14631491 Nothing -> return ()
14641492 Just v' -> do
1465− withIncreasedDepth (Proxy :: Proxy x) $
1493+ {-# SCC "trace2" #-} withIncreasedDepth (Proxy :: Proxy x) $
14661494 tracePropagate (Proxy :: Proxy x) ("propagateSubscriberHold: assigning Hold" <> showNodeId h)
14671495 vRef <- {-# SCC "vRef" #-} liftIO $ evaluate $ holdValue h
14681496 iRef <- {-# SCC "iRef" #-} liftIO $ evaluate $ holdInvalidators h
@@ -1994,7 +2022,7 @@ revalidateMergeHeight m = do
19942022 LT -> return ()
19952023 EQ -> do
19962024 let height = succHeight $ heightBagMax heights
1997− traceInvalidate $ "recalculateSubscriberHeight: height: " <> show height
2025+ traceInvalidateHeight $ "recalculateSubscriberHeight: height: " <> show height
19982026 writeIORef (_merge_heightRef m) $! height
19992027 subscriberRecalculateHeight (_merge_sub m) height
20002028 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show (DMap.size parents) <> ") for Merge"
@@ -2158,7 +2186,7 @@ mergeIntCheap d = Event $ \sub -> do
21582186 LT -> return ()
21592187 EQ -> do
21602188 let height = succHeight $ heightBagMax heights
2161− traceInvalidate $ "recalculateSubscriberHeight: height: " <> show height
2189+ traceInvalidateHeight $ "recalculateSubscriberHeight: height: " <> show height
21622190 writeIORef heightRef $! height
21632191 subscriberRecalculateHeight sub height
21642192 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show numParents <> ") for Merge"