@@ -47,6 +47,8 @@ import qualified Data.Dependent.Map as DMap
4747import Data.Foldable hiding (concat, elem, sequence_)
4848import Data.Function
4949import Data.Functor.Compose
50+import Data.Functor.Constant
51+import Data.Functor.Product
5052import Data.GADT.Compare
5153import Data.IntMap.Strict (IntMap)
5254import qualified Data.IntMap.Strict as IntMap
@@ -330,14 +332,11 @@ newSubscriberFan subscribed = return $ Subscriber
330332 { subscriberPropagate = \a -> {-# SCC "traverseFan" #-} do
331333 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
332334 tracePropagate $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
333− --TODO: We need a better DMap intersection; here, we are assuming that the number of firing keys is small and the number of subscribers is large
334− forM_ (DMap.toList a) $ \(k :=> Identity v) -> {-# SCC "SubscriberFan" #-} case DMap.lookup k subs of
335− Nothing -> do
336− tracePropagate "No subscriber for key"
337− return ()
338− Just subsubs -> do
339− propagate v $ _fanSubscribedChildren_list subsubs
340− return ()
335+ let f _ (Pair (Identity v) subsubs) = do
336+ propagate v $ _fanSubscribedChildren_list subsubs
337+ return $ Constant ()
338+ _ <- DMap.traverseWithKey f $ DMap.intersectionWithKey (\_ -> Pair) a subs --TODO: Would be nice to have DMap.traverse_
339+ return ()
341340 , subscriberInvalidateHeight = \old -> do
342341 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
343342 subscribers <- readIORef $ fanSubscribedSubscribers subscribed