82bb22a · patch · git.iko.soy

git.iko.soy/patch

Add 'DEBUG' CPP macro to Reflex.Spider

82bb22aRyan Trinkle12 years ago

src/Reflex/Spider/Internal.hs+145−30

@@ -1,4 +1,4 @@

1−{-# LANGUAGE ExistentialQuantification, GADTs, ScopedTypeVariables, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, RankNTypes, BangPatterns, UndecidableInstances, EmptyDataDecls, RecursiveDo, RoleAnnotations, LambdaCase #-}

1+{-# LANGUAGE CPP, ExistentialQuantification, GADTs, ScopedTypeVariables, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, RankNTypes, BangPatterns, UndecidableInstances, EmptyDataDecls, RecursiveDo, RoleAnnotations, LambdaCase #-}

2module Reflex.Spider.Internal where

4import Prelude hiding (mapM, mapM_, any, sequence, concat)

@@ -30,6 +30,65 @@ import System.IO.Unsafe

30import Unsafe.Coerce

31import Control.Monad.Primitive

33+debugPropagate :: Bool

34+

35+debugInvalidateHeight :: Bool

36+

37+class HasNodeId a where

38+ getNodeId :: a -> Int

39+

40+showNodeId :: HasNodeId a => a -> String

41+showNodeId = ("#"<>) . show . getNodeId

42+

43+#ifdef DEBUG

44+

45+#define DEBUG_NODEIDS

46+

47+debugPropagate = True

48+

49+debugInvalidateHeight = True

50+

51+instance HasNodeId (Hold a) where

52+ getNodeId = holdNodeId

53+

54+instance HasNodeId (PushSubscribed a b) where

55+ getNodeId = pushSubscribedNodeId

56+

57+instance HasNodeId (SwitchSubscribed a) where

58+ getNodeId = switchSubscribedNodeId

59+

60+instance HasNodeId (MergeSubscribed a) where

61+ getNodeId = mergeSubscribedNodeId

62+

63+instance HasNodeId (FanSubscribed a) where

64+ getNodeId = fanSubscribedNodeId

65+

66+instance HasNodeId (CoincidenceSubscribed a) where

67+ getNodeId = coincidenceSubscribedNodeId

68+

69+#else

70+

71+debugPropagate = False

72+

73+debugInvalidateHeight = False

74+

75+instance HasNodeId a where

76+ getNodeId = const ""

77+

78+#endif

79+

80+#ifdef DEBUG_NODEIDS

81+{-# NOINLINE nextNodeIdRef #-}

82+nextNodeIdRef :: IORef Int

83+nextNodeIdRef = unsafePerformIO $ newIORef 1

84+

85+{-# NOINLINE unsafeNodeId #-}

86+unsafeNodeId :: a -> Int

87+unsafeNodeId a = unsafePerformIO $ do

88+ touch a

89+ atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)

90+#endif

91+

33--TODO: Figure out why certain things are not 'representational', then make them representational so we can use coerce

92--TODO: Figure out why certain things are not 'representational', then make them representational so we can use coerce

34--type role Hold representational

93--type role Hold representational

35data Hold a

94data Hold a

@@ -38,6 +97,9 @@ data Hold a

38 -- We need to use 'Any' for the next two things, because otherwise Hold inherits a nominal role for its 'a' parameter, and we want to be able to use 'coerce'

97 -- We need to use 'Any' for the next two things, because otherwise Hold inherits a nominal role for its 'a' parameter, and we want to be able to use 'coerce'

39 , holdSubscriber :: !(IORef Any) -- Keeps its subscription alive; for some reason, a regular (or strict) reference to the Subscriber itself wasn't working, so had to use an IORef

98 , holdSubscriber :: !(IORef Any) -- Keeps its subscription alive; for some reason, a regular (or strict) reference to the Subscriber itself wasn't working, so had to use an IORef

40 , holdParent :: !(IORef Any) -- Keeps its parent alive (will be undefined until the hold is initialized --TODO: Probably shouldn't be an IORef

99 , holdParent :: !(IORef Any) -- Keeps its parent alive (will be undefined until the hold is initialized --TODO: Probably shouldn't be an IORef

100+#ifdef DEBUG_NODEIDS

101+ , holdNodeId :: Int

102+#endif

41 }

103 }

104

43data EventEnv

105data EventEnv

@@ -97,6 +159,9 @@ hold v0 e = do

97 , holdInvalidators = invsRef

159 , holdInvalidators = invsRef

98 , holdSubscriber = subscriberRef

160 , holdSubscriber = subscriberRef

99 , holdParent = parentRef

161 , holdParent = parentRef

162+#ifdef DEBUG_NODEIDS

163+ , holdNodeId = unsafeNodeId (v0, e)

164+#endif

100 }

165 }

101 !s = SubscriberHold h

166 !s = SubscriberHold h

102 writeIORef subscriberRef $ unsafeCoerce s

167 writeIORef subscriberRef $ unsafeCoerce s

@@ -165,6 +230,9 @@ data PushSubscribed a b

165 , pushSubscribedSubscribers :: !(IORef [WeakSubscriber b])

230 , pushSubscribedSubscribers :: !(IORef [WeakSubscriber b])

166 , pushSubscribedSelf :: !(Subscriber a) -- Hold this in memory to ensure our WeakReferences don't die

231 , pushSubscribedSelf :: !(Subscriber a) -- Hold this in memory to ensure our WeakReferences don't die

167 , pushSubscribedParent :: !(EventSubscribed a)

232 , pushSubscribedParent :: !(EventSubscribed a)

233+#ifdef DEBUG_NODEIDS

234+ , pushSubscribedNodeId :: Int

235+#endif

168 }

236 }

169

237

170data Push a b

238data Push a b

@@ -180,6 +248,9 @@ data MergeSubscribed k

180 , mergeSubscribedSubscribers :: !(IORef [WeakSubscriber (DMap k)])

248 , mergeSubscribedSubscribers :: !(IORef [WeakSubscriber (DMap k)])

181 , mergeSubscribedSelf :: !Any -- Hold all our Subscribers in memory

249 , mergeSubscribedSelf :: !Any -- Hold all our Subscribers in memory

182 , mergeSubscribedParents :: !(DMap (WrapArg EventSubscribed k))

250 , mergeSubscribedParents :: !(DMap (WrapArg EventSubscribed k))

251+#ifdef DEBUG_NODEIDS

252+ , mergeSubscribedNodeId :: Int

253+#endif

183 }

254 }

184

255

185--TODO: DMap sucks; we should really write something better (with a functor for the value as well as the key)

256--TODO: DMap sucks; we should really write something better (with a functor for the value as well as the key)

@@ -206,6 +277,9 @@ data FanSubscribed k

206 = FanSubscribed { fanSubscribedSubscribers :: !(IORef (DMap (FanSubscriberKey k)))

277 = FanSubscribed { fanSubscribedSubscribers :: !(IORef (DMap (FanSubscriberKey k)))

207 , fanSubscribedParent :: !(EventSubscribed (DMap k))

278 , fanSubscribedParent :: !(EventSubscribed (DMap k))

208 , fanSubscribedSelf :: !(Subscriber (DMap k))

279 , fanSubscribedSelf :: !(Subscriber (DMap k))

280+#ifdef DEBUG_NODEIDS

281+ , fanSubscribedNodeId :: Int

282+#endif

209 }

283 }

210

284

211data Fan k

285data Fan k

@@ -224,6 +298,9 @@ data SwitchSubscribed a

224 , switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed])

298 , switchSubscribedBehaviorParents :: !(IORef [SomeBehaviorSubscribed])

225 , switchSubscribedParent :: !(Behavior (Event a))

299 , switchSubscribedParent :: !(Behavior (Event a))

226 , switchSubscribedCurrentParent :: !(IORef (EventSubscribed a))

300 , switchSubscribedCurrentParent :: !(IORef (EventSubscribed a))

301+#ifdef DEBUG_NODEIDS

302+ , switchSubscribedNodeId :: Int

303+#endif

227 }

304 }

228

305

229data Switch a

306data Switch a

@@ -238,6 +315,9 @@ data CoincidenceSubscribed a

238 , coincidenceSubscribedOuter :: !(Subscriber (Event a))

315 , coincidenceSubscribedOuter :: !(Subscriber (Event a))

239 , coincidenceSubscribedOuterParent :: !(EventSubscribed (Event a))

316 , coincidenceSubscribedOuterParent :: !(EventSubscribed (Event a))

240 , coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed a)))

317 , coincidenceSubscribedInnerParent :: !(IORef (Maybe (EventSubscribed a)))

318+#ifdef DEBUG_NODEIDS

319+ , coincidenceSubscribedNodeId :: Int

320+#endif

241 }

321 }

242

322

243data Coincidence a

323data Coincidence a

@@ -379,7 +459,7 @@ propagateAndUpdateSubscribersRef subscribersRef a = do

379run :: [DSum RootTrigger] -> ResultM b -> IO b

459run :: [DSum RootTrigger] -> ResultM b -> IO b

380run roots after = do

460run roots after = do

381 when debugPropagate $ putStrLn "Running an event frame"

461 when debugPropagate $ putStrLn "Running an event frame"

382− runFrame $ do

462+ result <- runFrame $ do

383 forM_ roots $ \(RootTrigger (_, occRef) :=> a) -> do

463 forM_ roots $ \(RootTrigger (_, occRef) :=> a) -> do

384 liftIO $ writeIORef occRef $ Just a

464 liftIO $ writeIORef occRef $ Just a

385 scheduleClear occRef

465 scheduleClear occRef

@@ -411,6 +491,8 @@ run roots after = do

411 go

491 go

412 putCurrentHeight maxBound

492 putCurrentHeight maxBound

413 after

493 after

494+ when debugPropagate $ putStrLn "Done running an event frame"

495+ return result

414

496

415data SomeMaybeIORef = forall a. SomeMaybeIORef (IORef (Maybe a))

497data SomeMaybeIORef = forall a. SomeMaybeIORef (IORef (Maybe a))

416

498

@@ -427,9 +509,6 @@ mkWeakPtrWithDebug x debugNote = mkWeakPtr x $

427 then Just $ putStrLn $ "finalizing: " ++ debugNote

509 then Just $ putStrLn $ "finalizing: " ++ debugNote

428 else Nothing

510 else Nothing

429

511

430−debugPropagate :: Bool

431−debugPropagate = False

432−

433type WeakList a = [Weak a]

512type WeakList a = [Weak a]

434

513

435--TODO: Is it faster to clean up every time, or to occasionally go through and clean up as needed?

514--TODO: Is it faster to clean up every time, or to occasionally go through and clean up as needed?

@@ -450,7 +529,7 @@ propagate :: a -> [WeakSubscriber a] -> EventM [WeakSubscriber a]

450propagate a subscribers = do

529propagate a subscribers = do

451 traverseAndCleanWeakList_ (liftIO . deRefWeakSubscriber) subscribers $ \s -> case s of

530 traverseAndCleanWeakList_ (liftIO . deRefWeakSubscriber) subscribers $ \s -> case s of

452 SubscriberPush compute subscribed -> do

531 SubscriberPush compute subscribed -> do

453− when debugPropagate $ liftIO $ putStrLn "SubscriberPush"

532+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberPush" <> showNodeId subscribed

454 occ <- compute a

533 occ <- compute a

455 case occ of

534 case occ of

456 Nothing -> return () -- No need to write a Nothing back into the Ref

535 Nothing -> return () -- No need to write a Nothing back into the Ref

@@ -459,7 +538,7 @@ propagate a subscribers = do

459 scheduleClear $ pushSubscribedOccurrence subscribed

538 scheduleClear $ pushSubscribedOccurrence subscribed

460 liftIO . writeIORef (pushSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (pushSubscribedSubscribers subscribed))

539 liftIO . writeIORef (pushSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (pushSubscribedSubscribers subscribed))

461 SubscriberMerge k subscribed -> do

540 SubscriberMerge k subscribed -> do

462− when debugPropagate $ liftIO $ putStrLn $ "SubscriberMerge"

541+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberMerge" <> showNodeId subscribed

463 oldM <- liftIO $ readIORef $ mergeSubscribedAccum subscribed

542 oldM <- liftIO $ readIORef $ mergeSubscribedAccum subscribed

464 liftIO $ writeIORef (mergeSubscribedAccum subscribed) $ DMap.insertWith (error "Same key fired multiple times for") k a oldM

543 liftIO $ writeIORef (mergeSubscribedAccum subscribed) $ DMap.insertWith (error "Same key fired multiple times for") k a oldM

465 when (DMap.null oldM) $ do -- Only schedule the firing once

544 when (DMap.null oldM) $ do -- Only schedule the firing once

@@ -470,7 +549,7 @@ propagate a subscribers = do

470 scheduleMerge height subscribed

549 scheduleMerge height subscribed

471 SubscriberFan subscribed -> do

550 SubscriberFan subscribed -> do

472 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed

551 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed

473− when debugPropagate $ liftIO $ putStrLn $ "SubscriberFan: " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"

552+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"

474 --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

553 --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

475 forM_ (DMap.toList a) $ \(k :=> v) -> case DMap.lookup (FanSubscriberKey k) subs of

554 forM_ (DMap.toList a) $ \(k :=> v) -> case DMap.lookup (FanSubscriberKey k) subs of

476 Nothing -> do

555 Nothing -> do

@@ -486,17 +565,17 @@ propagate a subscribers = do

486 liftIO $ writeIORef (fanSubscribedSubscribers subscribed) $ DMap.fromDistinctAscList $ catMaybes subs'

565 liftIO $ writeIORef (fanSubscribedSubscribers subscribed) $ DMap.fromDistinctAscList $ catMaybes subs'

487 SubscriberHold h -> do

566 SubscriberHold h -> do

488 invalidators <- liftIO $ readIORef $ holdInvalidators h

567 invalidators <- liftIO $ readIORef $ holdInvalidators h

489− when debugPropagate $ liftIO $ putStrLn $ "SubscriberHold: " ++ show (length invalidators)

568+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)

490 toAssignRef <- askToAssignRef

569 toAssignRef <- askToAssignRef

491 liftIO $ modifyIORef' toAssignRef (SomeAssignment h a :)

570 liftIO $ modifyIORef' toAssignRef (SomeAssignment h a :)

492 SubscriberSwitch subscribed -> do

571 SubscriberSwitch subscribed -> do

493− when debugPropagate $ liftIO $ putStrLn "SubscriberSwitch"

572+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberSwitch" <> showNodeId subscribed

494 liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $ Just a

573 liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $ Just a

495 scheduleClear $ switchSubscribedOccurrence subscribed

574 scheduleClear $ switchSubscribedOccurrence subscribed

496 subs <- liftIO $ readIORef $ switchSubscribedSubscribers subscribed

575 subs <- liftIO $ readIORef $ switchSubscribedSubscribers subscribed

497 liftIO . writeIORef (switchSubscribedSubscribers subscribed) =<< propagate a subs

576 liftIO . writeIORef (switchSubscribedSubscribers subscribed) =<< propagate a subs

498 SubscriberCoincidenceOuter subscribed -> do

577 SubscriberCoincidenceOuter subscribed -> do

499− when debugPropagate $ liftIO $ putStrLn "SubscriberCoincidenceOuter"

578+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberCoincidenceOuter" <> showNodeId subscribed

500 outerHeight <- liftIO $ readIORef $ coincidenceSubscribedHeight subscribed

579 outerHeight <- liftIO $ readIORef $ coincidenceSubscribedHeight subscribed

501 when debugPropagate $ liftIO $ putStrLn $ " outerHeight = " <> show outerHeight

580 when debugPropagate $ liftIO $ putStrLn $ " outerHeight = " <> show outerHeight

502 (occ, innerHeight, innerSubd) <- subscribeCoincidenceInner a outerHeight subscribed

581 (occ, innerHeight, innerSubd) <- subscribeCoincidenceInner a outerHeight subscribed

@@ -515,7 +594,7 @@ propagate a subscribers = do

515 scheduleClear $ coincidenceSubscribedOccurrence subscribed

594 scheduleClear $ coincidenceSubscribedOccurrence subscribed

516 liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))

595 liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate o =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))

517 SubscriberCoincidenceInner subscribed -> do

596 SubscriberCoincidenceInner subscribed -> do

518− when debugPropagate $ liftIO $ putStrLn "SubscriberCoincidenceInner"

597+ when debugPropagate $ liftIO $ putStrLn $ "SubscriberCoincidenceInner" <> showNodeId subscribed

519 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $ Just a

598 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $ Just a

520 scheduleClear $ coincidenceSubscribedOccurrence subscribed

599 scheduleClear $ coincidenceSubscribedOccurrence subscribed

521 liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate a =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))

600 liftIO . writeIORef (coincidenceSubscribedSubscribers subscribed) =<< propagate a =<< liftIO (readIORef (coincidenceSubscribedSubscribers subscribed))

@@ -705,17 +784,17 @@ getRootSubscribed r = do

705

784

706-- When getPushSubscribed returns, the PushSubscribed returned will have a fully filled-in

785-- When getPushSubscribed returns, the PushSubscribed returned will have a fully filled-in

707getPushSubscribed :: Push a b -> EventM (PushSubscribed a b)

786getPushSubscribed :: Push a b -> EventM (PushSubscribed a b)

708−getPushSubscribed (Push compute parent subscribedRef) = do

787+getPushSubscribed p = do

709− mSubscribed <- liftIO $ readIORef subscribedRef

788+ mSubscribed <- liftIO $ readIORef $ pushSubscribed p

710 case mSubscribed of

789 case mSubscribed of

711 Just subscribed -> return subscribed

790 Just subscribed -> return subscribed

712 Nothing -> do -- Not yet subscribed

791 Nothing -> do -- Not yet subscribed

713− subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ liftM fromJust $ readIORef subscribedRef

792+ subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ liftM fromJust $ readIORef $ pushSubscribed p

714− let !s = SubscriberPush compute subscribedUnsafe

793+ let !s = SubscriberPush (pushCompute p) subscribedUnsafe

715 ws <- liftIO $ mkWeakPtrWithDebug s "SubscriberPush"

794 ws <- liftIO $ mkWeakPtrWithDebug s "SubscriberPush"

716− subd <- subscribe parent $ WeakSubscriberSimple ws

795+ subd <- subscribe (pushParent p) $ WeakSubscriberSimple ws

717 parentOcc <- liftIO $ getEventSubscribedOcc subd

796 parentOcc <- liftIO $ getEventSubscribedOcc subd

718− occ <- liftM join $ mapM compute parentOcc

797+ occ <- liftM join $ mapM (pushCompute p) parentOcc

719 occRef <- liftIO $ newIORef occ

798 occRef <- liftIO $ newIORef occ

720 when (isJust occ) $ scheduleClear occRef

799 when (isJust occ) $ scheduleClear occRef

721 subscribersRef <- liftIO $ newIORef []

800 subscribersRef <- liftIO $ newIORef []

@@ -725,8 +804,11 @@ getPushSubscribed (Push compute parent subscribedRef) = do

725 , pushSubscribedSubscribers = subscribersRef

804 , pushSubscribedSubscribers = subscribersRef

726 , pushSubscribedSelf = unsafeCoerce s

805 , pushSubscribedSelf = unsafeCoerce s

727 , pushSubscribedParent = subd

806 , pushSubscribedParent = subd

807+#ifdef DEBUG_NODEIDS

808+ , pushSubscribedNodeId = unsafeNodeId p

809+#endif

728 }

810 }

729− liftIO $ writeIORef subscribedRef $ Just subscribed

811+ liftIO $ writeIORef (pushSubscribed p) $ Just subscribed

730 return subscribed

812 return subscribed

731

813

732getMergeSubscribed :: forall k. GCompare k => Merge k -> EventM (MergeSubscribed k)

814getMergeSubscribed :: forall k. GCompare k => Merge k -> EventM (MergeSubscribed k)

@@ -768,6 +850,9 @@ getMergeSubscribed m = {-# SCC "getMergeSubscribed.entire" #-} do

768 , mergeSubscribedSubscribers = subsRef

850 , mergeSubscribedSubscribers = subsRef

769 , mergeSubscribedSelf = unsafeCoerce $ map (\(x, _, _, _) -> x) subscribers --TODO: Does lack of strictness make this leak?

851 , mergeSubscribedSelf = unsafeCoerce $ map (\(x, _, _, _) -> x) subscribers --TODO: Does lack of strictness make this leak?

770 , mergeSubscribedParents = DMap.fromDistinctAscList $ map (^._4) subscribers

852 , mergeSubscribedParents = DMap.fromDistinctAscList $ map (^._4) subscribers

853+#ifdef DEBUG_NODEIDS

854+ , mergeSubscribedNodeId = unsafeNodeId m

855+#endif

771 }

856 }

772 liftIO $ writeIORef subscribedRef subscribed

857 liftIO $ writeIORef subscribedRef subscribed

773 return subscribed

858 return subscribed

@@ -782,6 +867,9 @@ getMergeSubscribed m = {-# SCC "getMergeSubscribed.entire" #-} do

782 , mergeSubscribedSubscribers = subsRef --TODO: This will definitely leak

867 , mergeSubscribedSubscribers = subsRef --TODO: This will definitely leak

783 , mergeSubscribedSelf = unsafeCoerce ()

868 , mergeSubscribedSelf = unsafeCoerce ()

784 , mergeSubscribedParents = DMap.empty

869 , mergeSubscribedParents = DMap.empty

870+#ifdef DEBUG_NODEIDS

871+ , mergeSubscribedNodeId = -1

872+#endif

785 }

873 }

786

874

787getFanSubscribed :: GCompare k => Fan k -> EventM (FanSubscribed k)

875getFanSubscribed :: GCompare k => Fan k -> EventM (FanSubscribed k)

@@ -799,6 +887,9 @@ getFanSubscribed f = do

799 { fanSubscribedParent = subd

887 { fanSubscribedParent = subd

800 , fanSubscribedSubscribers = subscribersRef

888 , fanSubscribedSubscribers = subscribersRef

801 , fanSubscribedSelf = sub

889 , fanSubscribedSelf = sub

890+#ifdef DEBUG_NODEIDS

891+ , fanSubscribedNodeId = unsafeNodeId f

892+#endif

802 }

893 }

803 liftIO $ writeIORef (fanSubscribed f) $ Just subscribed

894 liftIO $ writeIORef (fanSubscribed f) $ Just subscribed

804 return subscribed

895 return subscribed

@@ -837,6 +928,9 @@ getSwitchSubscribed s = do

837 , switchSubscribedBehaviorParents = parentsRef

928 , switchSubscribedBehaviorParents = parentsRef

838 , switchSubscribedParent = switchParent s

929 , switchSubscribedParent = switchParent s

839 , switchSubscribedCurrentParent = subdRef

930 , switchSubscribedCurrentParent = subdRef

931+#ifdef DEBUG_NODEIDS

932+ , switchSubscribedNodeId = unsafeNodeId s

933+#endif

840 }

934 }

841 liftIO $ writeIORef subscribedRef subscribed

935 liftIO $ writeIORef subscribedRef subscribed

842 liftIO $ writeIORef (switchSubscribed s) $ Just subscribed

936 liftIO $ writeIORef (switchSubscribed s) $ Just subscribed

@@ -873,6 +967,9 @@ getCoincidenceSubscribed c = do

873 , coincidenceSubscribedOuter = subOuter

967 , coincidenceSubscribedOuter = subOuter

874 , coincidenceSubscribedOuterParent = outerSubd

968 , coincidenceSubscribedOuterParent = outerSubd

875 , coincidenceSubscribedInnerParent = innerSubdRef

969 , coincidenceSubscribedInnerParent = innerSubdRef

970+#ifdef DEBUG_NODEIDS

971+ , coincidenceSubscribedNodeId = unsafeNodeId c

972+#endif

876 }

973 }

877 liftIO $ writeIORef subscribedRef subscribed

974 liftIO $ writeIORef subscribedRef subscribed

878 liftIO $ writeIORef (coincidenceSubscribed c) $ Just subscribed

975 liftIO $ writeIORef (coincidenceSubscribed c) $ Just subscribed

@@ -958,9 +1055,6 @@ runFrame a = do

958 mapM_ recalculateSubscriberHeight =<< readIORef (switchSubscribedSubscribers subscribed)

1055 mapM_ recalculateSubscriberHeight =<< readIORef (switchSubscribedSubscribers subscribed)

959 return result

1056 return result

960

1057

961−debugInvalidateHeight :: Bool

962−debugInvalidateHeight = False

963−

964invalidHeight :: Int

1058invalidHeight :: Int

965invalidHeight = -1000

1059invalidHeight = -1000

966

1060

@@ -971,31 +1065,37 @@ invalidateSubscriberHeight ws = do

971 Nothing -> return () --TODO: cleanup?

1065 Nothing -> return () --TODO: cleanup?

972 Just s -> case s of

1066 Just s -> case s of

973 SubscriberPush _ subscribed -> do

1067 SubscriberPush _ subscribed -> do

974− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberPush"

1068+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberPush" <> showNodeId subscribed

975 mapM_ invalidateSubscriberHeight =<< readIORef (pushSubscribedSubscribers subscribed)

1069 mapM_ invalidateSubscriberHeight =<< readIORef (pushSubscribedSubscribers subscribed)

1070+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberPush" <> showNodeId subscribed <> " done"

976 SubscriberMerge _ subscribed -> do

1071 SubscriberMerge _ subscribed -> do

977− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberMerge"

1072+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberMerge" <> showNodeId subscribed

978 oldHeight <- readIORef $ mergeSubscribedHeight subscribed

1073 oldHeight <- readIORef $ mergeSubscribedHeight subscribed

979 when (oldHeight /= invalidHeight) $ do

1074 when (oldHeight /= invalidHeight) $ do

980 writeIORef (mergeSubscribedHeight subscribed) $ invalidHeight

1075 writeIORef (mergeSubscribedHeight subscribed) $ invalidHeight

981 mapM_ invalidateSubscriberHeight =<< readIORef (mergeSubscribedSubscribers subscribed)

1076 mapM_ invalidateSubscriberHeight =<< readIORef (mergeSubscribedSubscribers subscribed)

1077+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberMerge" <> showNodeId subscribed <> " done"

982 SubscriberFan subscribed -> do

1078 SubscriberFan subscribed -> do

983− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberFan"

1079+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed

984 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

1080 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

985 forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> v) -> mapM_ invalidateSubscriberHeight v) :: DSum (FanSubscriberKey k) -> IO ())

1081 forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> v) -> mapM_ invalidateSubscriberHeight v) :: DSum (FanSubscriberKey k) -> IO ())

1082+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"

986 SubscriberHold _ -> return ()

1083 SubscriberHold _ -> return ()

987 SubscriberSwitch subscribed -> do

1084 SubscriberSwitch subscribed -> do

988− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberSwitch"

1085+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed

989 oldHeight <- readIORef $ switchSubscribedHeight subscribed

1086 oldHeight <- readIORef $ switchSubscribedHeight subscribed

990 when (oldHeight /= invalidHeight) $ do

1087 when (oldHeight /= invalidHeight) $ do

991 writeIORef (switchSubscribedHeight subscribed) $ invalidHeight

1088 writeIORef (switchSubscribedHeight subscribed) $ invalidHeight

992 mapM_ invalidateSubscriberHeight =<< readIORef (switchSubscribedSubscribers subscribed)

1089 mapM_ invalidateSubscriberHeight =<< readIORef (switchSubscribedSubscribers subscribed)

1090+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"

993 SubscriberCoincidenceOuter subscribed -> do

1091 SubscriberCoincidenceOuter subscribed -> do

994− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberCoincidenceOuter"

1092+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed

995 invalidateCoincidenceHeight subscribed

1093 invalidateCoincidenceHeight subscribed

1094+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed <> " done"

996 SubscriberCoincidenceInner subscribed -> do

1095 SubscriberCoincidenceInner subscribed -> do

997− when debugInvalidateHeight $ putStrLn "invalidateSubscriberHeight: SubsciberCoincidenceInner"

1096+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed

998 invalidateCoincidenceHeight subscribed

1097 invalidateCoincidenceHeight subscribed

1098+ when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed <> " done"

999

1099

1000invalidateCoincidenceHeight :: CoincidenceSubscribed a -> IO ()

1100invalidateCoincidenceHeight :: CoincidenceSubscribed a -> IO ()

1001invalidateCoincidenceHeight subscribed = do

1101invalidateCoincidenceHeight subscribed = do

@@ -1013,27 +1113,42 @@ recalculateSubscriberHeight ws = do

1013 Nothing -> return () --TODO: cleanup?

1113 Nothing -> return () --TODO: cleanup?

1014 Just s -> case s of

1114 Just s -> case s of

1015 SubscriberPush _ subscribed -> do

1115 SubscriberPush _ subscribed -> do

1116+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberPush" <> showNodeId subscribed

1016 mapM_ recalculateSubscriberHeight =<< readIORef (pushSubscribedSubscribers subscribed)

1117 mapM_ recalculateSubscriberHeight =<< readIORef (pushSubscribedSubscribers subscribed)

1118+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberPush" <> showNodeId subscribed <> " done"

1017 SubscriberMerge _ subscribed -> do

1119 SubscriberMerge _ subscribed -> do

1120+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberMerge" <> showNodeId subscribed

1018 oldHeight <- readIORef $ mergeSubscribedHeight subscribed

1121 oldHeight <- readIORef $ mergeSubscribedHeight subscribed

1019 when (oldHeight == invalidHeight) $ do

1122 when (oldHeight == invalidHeight) $ do

1020 height <- calculateMergeHeight subscribed

1123 height <- calculateMergeHeight subscribed

1124+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: height: " <> show height

1021 when (height /= invalidHeight) $ do -- If height == invalidHeight, that means some of the prereqs have not yet been recomputed; when they do recompute, they'll catch this node again --TODO: this is O(n*m), where n is the number of children of this noe and m is the number that have been invalidated

1125 when (height /= invalidHeight) $ do -- If height == invalidHeight, that means some of the prereqs have not yet been recomputed; when they do recompute, they'll catch this node again --TODO: this is O(n*m), where n is the number of children of this noe and m is the number that have been invalidated

1022 writeIORef (mergeSubscribedHeight subscribed) height

1126 writeIORef (mergeSubscribedHeight subscribed) height

1023 mapM_ recalculateSubscriberHeight =<< readIORef (mergeSubscribedSubscribers subscribed)

1127 mapM_ recalculateSubscriberHeight =<< readIORef (mergeSubscribedSubscribers subscribed)

1128+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberMerge" <> showNodeId subscribed <> " done"

1024 SubscriberFan subscribed -> do

1129 SubscriberFan subscribed -> do

1130+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed

1025 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

1131 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

1026 forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> v) -> mapM_ recalculateSubscriberHeight v) :: DSum (FanSubscriberKey k) -> IO ())

1132 forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> v) -> mapM_ recalculateSubscriberHeight v) :: DSum (FanSubscriberKey k) -> IO ())

1133+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"

1027 SubscriberHold _ -> return ()

1134 SubscriberHold _ -> return ()

1028 SubscriberSwitch subscribed -> do

1135 SubscriberSwitch subscribed -> do

1136+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed

1029 oldHeight <- readIORef $ switchSubscribedHeight subscribed

1137 oldHeight <- readIORef $ switchSubscribedHeight subscribed

1030 when (oldHeight == invalidHeight) $ do

1138 when (oldHeight == invalidHeight) $ do

1031 height <- calculateSwitchHeight subscribed

1139 height <- calculateSwitchHeight subscribed

1032 when (height /= invalidHeight) $ do

1140 when (height /= invalidHeight) $ do

1033 writeIORef (switchSubscribedHeight subscribed) height

1141 writeIORef (switchSubscribedHeight subscribed) height

1034 mapM_ recalculateSubscriberHeight =<< readIORef (switchSubscribedSubscribers subscribed)

1142 mapM_ recalculateSubscriberHeight =<< readIORef (switchSubscribedSubscribers subscribed)

1143+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"

1144+ SubscriberCoincidenceOuter subscribed -> do

1145+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed

1035− SubscriberCoincidenceOuter subscribed -> void $ recalculateCoincidenceHeight subscribed

1146+ void $ recalculateCoincidenceHeight subscribed

1147+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceOuter" <> showNodeId subscribed <> " done"

1148+ SubscriberCoincidenceInner subscribed -> do

1149+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed

1036− SubscriberCoincidenceInner subscribed -> void $ recalculateCoincidenceHeight subscribed

1150+ void $ recalculateCoincidenceHeight subscribed

1151+ when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberCoincidenceInner" <> showNodeId subscribed <> " done"

1037

1152

1038recalculateCoincidenceHeight :: CoincidenceSubscribed a -> IO ()

1153recalculateCoincidenceHeight :: CoincidenceSubscribed a -> IO ()

1039recalculateCoincidenceHeight subscribed = do

1154recalculateCoincidenceHeight subscribed = do