@@ -230,12 +230,6 @@ eventHold !h = Event $ subscribeHoldEvent h
230230eventDyn :: (a ~ p b, R.Patch p) => Dyn x p b -> Event x a
231231eventDyn !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent h sub
232232
233−eventHoldIdentity :: (a ~ Identity b) => Hold x Identity b -> Event x a
234−eventHoldIdentity !h = Event $ subscribeHoldEvent h
235−
236−eventDynIdentity :: (a ~ Identity b) => Dyn x Identity b -> Event x a
237−eventDynIdentity !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent h sub
238−
239233{-# INLINE subscribeCoincidenceInner #-}
240234subscribeCoincidenceInner :: CanSubscribe x m => Event x a -> Height -> CoincidenceSubscribed x a -> m (Maybe a, Height, EventSubscribed x a)
241235subscribeCoincidenceInner inner outerHeight subscribedUnsafe = do
@@ -630,9 +624,6 @@ behaviorPull !p = Behavior $ do
630624behaviorDyn :: R.Patch p => Dyn x p a -> Behavior x a
631625behaviorDyn !d = Behavior $ readHoldTracked =<< getDynHold d
632626
633−behaviorDynIdentity :: Dyn x Identity a -> Behavior x a
634−behaviorDynIdentity = behaviorDyn
635−
636627{-# INLINE readHoldTracked #-}
637628readHoldTracked :: Hold x p a -> BehaviorM x a
638629readHoldTracked h = do
@@ -648,6 +639,39 @@ readBehaviorUntracked b = do
648639 holdInits <- getDeferralQueue
649640 liftIO $ runBehaviorM (readBehaviorTracked b) Nothing holdInits --TODO: Specialize readBehaviorTracked to the Nothing and Just cases
650641
642+--------------------------------------------------------------------------------
643+-- Dynamic
644+--------------------------------------------------------------------------------
645+
646+data Dynamic x p a = Dynamic
647+ { dynamicCurrent :: !(Behavior x a)
648+ , dynamicUpdated :: !(Event x (p a))
649+ }
650+
651+dynamicHold :: Hold x p a -> Dynamic x p a
652+dynamicHold !h = Dynamic
653+ { dynamicCurrent = behaviorHold h
654+ , dynamicUpdated = eventHold h
655+ }
656+
657+dynamicHoldIdentity :: Hold x Identity a -> Dynamic x Identity a
658+dynamicHoldIdentity = dynamicHold
659+
660+dynamicConst :: a -> Dynamic x p a
661+dynamicConst !a = Dynamic
662+ { dynamicCurrent = behaviorConst a
663+ , dynamicUpdated = eventNever
664+ }
665+
666+dynamicDyn :: R.Patch p => Dyn x p a -> Dynamic x p a
667+dynamicDyn !d = Dynamic
668+ { dynamicCurrent = behaviorDyn d
669+ , dynamicUpdated = eventDyn d
670+ }
671+
672+dynamicDynIdentity :: Dyn x Identity a -> Dynamic x Identity a
673+dynamicDynIdentity = dynamicDyn
674+
651675--------------------------------------------------------------------------------
652676-- Combinators
653677--------------------------------------------------------------------------------
@@ -1049,89 +1073,63 @@ newInvalidatorSwitch subd = return $! InvalidatorSwitch subd
10491073newInvalidatorPull :: Pull x a -> IO (Invalidator x)
10501074newInvalidatorPull p = return $! InvalidatorPull p
10511075
1052−data Dynamic x p a
1053− = DynamicHold !(Hold x p a)
1054− | p ~ Identity => DynamicHoldIdentity !(Hold x Identity a)
1055− | DynamicConst !a
1056− | DynamicDyn !(Dyn x p a)
1057− | p ~ Identity => DynamicDynIdentity !(Dyn x Identity a)
1058−
1059−{-# INLINE current #-}
1060−current :: R.Patch p => Dynamic x p a -> Behavior x a
1061−current = \case
1062− DynamicHold h -> behaviorHold h
1063− DynamicHoldIdentity h -> behaviorHoldIdentity h
1064− DynamicConst a -> behaviorConst a
1065− DynamicDyn d -> behaviorDyn d
1066− DynamicDynIdentity d -> behaviorDynIdentity d
1067−
1068−--TODO: If you only need updated, not current, can we avoid actually constructing the Hold?
1069−{-# INLINE updated #-}
1070−updated :: R.Patch p => Dynamic x p a -> Event x (p a)
1071−updated = \case
1072− DynamicHold h -> eventHold h
1073− DynamicHoldIdentity h -> eventHoldIdentity h
1074− DynamicConst _ -> eventNever
1075− DynamicDyn d -> eventDyn d
1076− DynamicDynIdentity d -> eventDynIdentity d
1076+instance R.FunctorMaybe (Event x) where
1077+ fmapMaybe f = push $ return . f
1078+
1079+instance Align (Event x) where
1080+ nil = eventNever
1081+ align ea eb = R.fmapMaybe R.dmapToThese $ merge $ dynamicConst $ DMap.fromList [R.LeftTag :=> ea, R.RightTag :=> eb]
1082+
1083+newtype Dyn x p a = Dyn { unDyn :: IORef (Either (BehaviorM x a, Event x (p a)) (Hold x p a)) }
10771084
10781085newMapDyn :: (a -> b) -> Dynamic x Identity a -> Dynamic x Identity b
1079−newMapDyn f d = DynamicDynIdentity $ unsafeDyn (fmap f $ readBehaviorTracked $ current d) (Identity . f . runIdentity <$> updated d)
1086+newMapDyn f d = dynamicDynIdentity $ unsafeDyn (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)
10801087
10811088instance Functor (Dynamic x Identity) where
10821089 fmap = newMapDyn
10831090
10841091instance Applicative (Dynamic x Identity) where
1085− pure = DynamicConst
1092+ pure = dynamicConst
10861093 (<*>) = zipDynWith ($)
10871094 _ *> b = b
10881095 a <* _ = a
10891096
1090−instance R.FunctorMaybe (Event x) where
1091− fmapMaybe f = push $ return . f
1092−
1093−instance Align (Event x) where
1094− nil = eventNever
1095− align ea eb = R.fmapMaybe R.dmapToThese $ merge $ DynamicConst $ DMap.fromList [R.LeftTag :=> ea, R.RightTag :=> eb]
1096−
10971097--TODO: Avoid the duplication between this and R.zipDynWith
10981098zipDynWith :: (a -> b -> c) -> Dynamic x Identity a -> Dynamic x Identity b -> Dynamic x Identity c
10991099zipDynWith f da db =
1100− let eab = align (updated da) (updated db)
1100+ let eab = align (dynamicUpdated da) (dynamicUpdated db)
11011101 ec = flip push eab $ \o -> do
11021102 (a, b) <- case o of
11031103 This (Identity a) -> do
1104− b <- readBehaviorUntracked $ current db
1104+ b <- readBehaviorUntracked $ dynamicCurrent db
11051105 return (a, b)
11061106 That (Identity b) -> do
1107− a <- readBehaviorUntracked $ current da
1107+ a <- readBehaviorUntracked $ dynamicCurrent da
11081108 return (a, b)
11091109 These (Identity a) (Identity b) -> return (a, b)
11101110 return $ Just $ Identity $ f a b
1111− in DynamicDynIdentity $ unsafeDyn (f <$> readBehaviorUntracked (current da) <*> readBehaviorUntracked (current db)) ec
1111+ in dynamicDynIdentity $ unsafeDyn (f <$> readBehaviorUntracked (dynamicCurrent da) <*> readBehaviorUntracked (dynamicCurrent db)) ec
11121112
11131113instance Monad (Dynamic x Identity) where
11141114 {-# INLINE return #-}
11151115 return = pure
11161116 {-# INLINE (>>=) #-}
1117− x >>= f = DynamicDynIdentity $ newJoinDyn $ newMapDyn f x
1117+ x >>= f = dynamicDynIdentity $ newJoinDyn $ newMapDyn f x
11181118 {-# INLINE (>>) #-}
11191119 _ >> y = y
11201120 {-# INLINE fail #-}
11211121 fail _ = error "Dynamic does not support 'fail'"
11221122
1123−newtype Dyn x p a = Dyn { unDyn :: IORef (Either (BehaviorM x a, Event x (p a)) (Hold x p a)) }
1124−
11251123unsafeDyn :: BehaviorM x a -> Event x (p a) -> Dyn x p a
11261124unsafeDyn readV0 v' = Dyn $ unsafeNewIORef x $ Left x
11271125 where x = (readV0, v')
11281126
11291127newJoinDyn :: Dynamic x Identity (Dynamic x Identity a) -> Dyn x Identity a
11301128newJoinDyn d =
1131− let readV0 = readBehaviorTracked . current =<< readBehaviorTracked (current d)
1132− eOuter = push (fmap (Just . Identity) . readBehaviorUntracked . current . runIdentity) $ updated d
1133− eInner = switch $ updated <$> current d
1134− eBoth = coincidence $ updated . runIdentity <$> updated d
1129+ let readV0 = readBehaviorTracked . dynamicCurrent =<< readBehaviorTracked (dynamicCurrent d)
1130+ eOuter = push (fmap (Just . Identity) . readBehaviorUntracked . dynamicCurrent . runIdentity) $ dynamicUpdated d
1131+ eInner = switch $ dynamicUpdated <$> dynamicCurrent d
1132+ eBoth = coincidence $ dynamicUpdated . runIdentity <$> dynamicUpdated d
11351133 v' = unSpiderEvent $ R.leftmost $ map SpiderEvent [eBoth, eOuter, eInner]
11361134 in unsafeDyn readV0 v'
11371135
@@ -1473,7 +1471,7 @@ getMergeSubscribed m sub = do
14731471 Nothing -> {-# SCC "missMerge" #-} do
14741472 subscribedRef <- liftIO $ newIORef $ error "getMergeSubscribed: subscribedRef not yet initialized"
14751473 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
1476− initialParents <- readBehaviorUntracked $ current $ mergeParents m
1474+ initialParents <- readBehaviorUntracked $ dynamicCurrent $ mergeParents m
14771475 subscribers :: [(Maybe (DSum k Identity), Height, DSum k (MergeSubscribedParent x k))] <- forM (DMap.toList initialParents) $ \(k :=> e) -> do
14781476 s <- liftIO $ newSubscriberMerge k subscribedUnsafe
14791477 (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s
@@ -1514,7 +1512,7 @@ getMergeSubscribed m sub = do
15141512 , mergeSubscribedNodeId = unsafeNodeId m
15151513#endif
15161514 }
1517− defer $ SomeMergeInit subscribed $ updated $ mergeParents m
1515+ defer $ SomeMergeInit subscribed $ dynamicUpdated $ mergeParents m
15181516 liftIO $ writeIORef subscribedRef $! subscribed
15191517 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "MergeSubscribed"
15201518 liftIO $ writeIORef (mergeSubscribed m) $ Just subscribed
@@ -2032,7 +2030,7 @@ instance R.Reflex (SpiderEnv x) where
20322030 {-# INLINABLE pull #-}
20332031 pull = SpiderBehavior . pull . coerce
20342032 {-# INLINABLE merge #-}
2035− merge = SpiderEvent . merge . DynamicConst . (coerce :: DMap k (R.Event (SpiderEnv x)) -> DMap k (Event x))
2033+ merge = SpiderEvent . merge . dynamicConst . (coerce :: DMap k (R.Event (SpiderEnv x)) -> DMap k (Event x))
20362034 {-# INLINABLE fan #-}
20372035 fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))
20382036 {-# INLINABLE switch #-}
@@ -2040,22 +2038,22 @@ instance R.Reflex (SpiderEnv x) where
20402038 {-# INLINABLE coincidence #-}
20412039 coincidence = SpiderEvent . coincidence . (coerce :: Event x (R.Event (SpiderEnv x) a) -> Event x (Event x a)) . unSpiderEvent
20422040 {-# INLINABLE current #-}
2043− current = SpiderBehavior . current . unSpiderDynamic
2041+ current = SpiderBehavior . dynamicCurrent . unSpiderDynamic
20442042 {-# INLINABLE updated #-}
2045− updated = SpiderEvent . fmap runIdentity . updated . unSpiderDynamic
2043+ updated = SpiderEvent . fmap runIdentity . dynamicUpdated . unSpiderDynamic
20462044 {-# INLINABLE unsafeBuildDynamic #-}
2047− unsafeBuildDynamic readV0 v' = SpiderDynamic $ DynamicDynIdentity $ unsafeDyn (coerce readV0) $ coerce $ unSpiderEvent v'
2045+ unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (coerce readV0) $ coerce $ unSpiderEvent v'
20482046 {-# INLINABLE unsafeBuildIncremental #-}
2049− unsafeBuildIncremental readV0 dv = SpiderIncremental $ DynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv
2047+ unsafeBuildIncremental readV0 dv = SpiderIncremental $ dynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv
20502048 {-# INLINABLE mergeIncremental #-}
20512049 mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic x R.PatchDMap (DMap k (R.Event (SpiderEnv x))) -> Dynamic x R.PatchDMap (DMap k (Event x))) . unSpiderIncremental
20522050 {-# INLINABLE currentIncremental #-}
2053− currentIncremental = SpiderBehavior . current . unSpiderIncremental
2051+ currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
20542052 {-# INLINABLE updatedIncremental #-}
2055− updatedIncremental = SpiderEvent . updated . unSpiderIncremental
2053+ updatedIncremental = SpiderEvent . dynamicUpdated . unSpiderIncremental
20562054 {-# INLINABLE incrementalToDynamic #-}
2057− incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ DynamicDynIdentity $ unsafeDyn (readBehaviorUntracked $ current i) $ flip push (updated i) $ \p -> do
2058− c <- readBehaviorUntracked $ current i
2055+ incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ dynamicDynIdentity $ unsafeDyn (readBehaviorUntracked $ dynamicCurrent i) $ flip push (dynamicUpdated i) $ \p -> do
2056+ c <- readBehaviorUntracked $ dynamicCurrent i
20592057 return $ Identity <$> R.apply p c --TODO: Avoid the redundant 'apply'
20602058
20612059instance R.MonadSample (SpiderEnv x) (EventM x) where
@@ -2074,10 +2072,10 @@ holdSpiderEventM :: a -> R.Event (SpiderEnv x) a -> EventM x (R.Behavior (Spider
20742072holdSpiderEventM v0 e = fmap (SpiderBehavior . behaviorHoldIdentity) $ hold v0 $ coerce $ unSpiderEvent e
20752073
20762074holdDynSpiderEventM :: a -> R.Event (SpiderEnv x) a -> EventM x (R.Dynamic (SpiderEnv x) a)
2077−holdDynSpiderEventM v0 e = fmap (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ coerce $ unSpiderEvent e
2075+holdDynSpiderEventM v0 e = fmap (SpiderDynamic . dynamicHoldIdentity) $ hold v0 $ coerce $ unSpiderEvent e
20782076
20792077holdIncrementalSpiderEventM :: R.Patch p => a -> R.Event (SpiderEnv x) (p a) -> EventM x (R.Incremental (SpiderEnv x) p a)
2080−holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . DynamicHold) $ hold v0 $ unSpiderEvent e
2078+holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . dynamicHold) $ hold v0 $ unSpiderEvent e
20812079
20822080instance R.MonadHold (SpiderEnv x) (SpiderHost x) where
20832081 {-# INLINABLE hold #-}
@@ -2103,9 +2101,9 @@ instance R.MonadHold (SpiderEnv x) (SpiderPushM x) where
21032101 {-# INLINABLE hold #-}
21042102 hold v0 e = R.current <$> R.holdDyn v0 e
21052103 {-# INLINABLE holdDyn #-}
2106− holdDyn v0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ coerce e
2104+ holdDyn v0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . dynamicHoldIdentity) $ hold v0 $ coerce e
21072105 {-# INLINABLE holdIncremental #-}
2108− holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . DynamicHold <$> hold v0 e
2106+ holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . dynamicHold <$> hold v0 e
21092107
21102108data RootTrigger x a = forall k. GCompare k => RootTrigger (WeakBag (Subscriber x a), IORef (DMap k Identity), k a)
21112109
@@ -2193,9 +2191,9 @@ instance R.MonadHold (SpiderEnv x) (SpiderHostFrame x) where
21932191 {-# INLINABLE hold #-}
21942192 hold v0 e = SpiderHostFrame $ fmap (SpiderBehavior . behaviorHoldIdentity) $ hold v0 $ coerce $ unSpiderEvent e
21952193 {-# INLINABLE holdDyn #-}
2196− holdDyn v0 e = SpiderHostFrame $ fmap (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ coerce $ unSpiderEvent e
2194+ holdDyn v0 e = SpiderHostFrame $ fmap (SpiderDynamic . dynamicHoldIdentity) $ hold v0 $ coerce $ unSpiderEvent e
21972195 {-# INLINABLE holdIncremental #-}
2198− holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . DynamicHold) $ hold v0 $ unSpiderEvent e
2196+ holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . dynamicHold) $ hold v0 $ unSpiderEvent e
21992197
22002198newEventWithTriggerIO :: (RootTrigger x a -> IO (IO ())) -> IO (Event x a)
22012199newEventWithTriggerIO f = do