13237c3 · reflex · git.iko.soy

git.iko.soy/reflex

on develop help sign in

Revert "Generalize merge"

13237c3Matthew Bauer7 years ago

src/Reflex/Class.hs+3−31

compare with develop

unifiedsplit

@@ -16,7 +16,6 @@

16{-# LANGUAGE TypeFamilies #-}

17{-# LANGUAGE TypeOperators #-}

18{-# LANGUAGE UndecidableInstances #-}

19−{-# LANGUAGE Trustworthy #-}

20#ifdef USE_REFLEX_OPTIMIZER

19#ifdef USE_REFLEX_OPTIMIZER

21{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

20{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

22#endif

21#endif

@@ -46,9 +45,6 @@ module Reflex.Class

46 , pushAlways

45 , pushAlways

47 -- ** Combining 'Event's

46 -- ** Combining 'Event's

48 , leftmost

47 , leftmost

49− , merge

50− , mergeIncremental

51− , mergeIncrementalWithMove

52 , mergeMap

48 , mergeMap

53 , mergeIntMap

49 , mergeIntMap

54 , mergeMapIncremental

50 , mergeMapIncremental

@@ -269,9 +265,7 @@ class ( MonadHold t (PushM t)

269 -- | Merge a collection of events; the resulting 'Event' will only occur if at

265 -- | Merge a collection of events; the resulting 'Event' will only occur if at

270 -- least one input event is occurring, and will contain all of the input keys

266 -- least one input event is occurring, and will contain all of the input keys

271 -- that are occurring simultaneously

267 -- that are occurring simultaneously

272− mergeG :: GCompare k => (forall a. q a -> Event t (v a))

273− -> DMap k q -> Event t (DMap k v)

274− --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty

268+ merge :: GCompare k => DMap k (Event t) -> Event t (DMap k Identity) --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty

275 -- | Efficiently fan-out an event to many destinations. You should save the

269 -- | Efficiently fan-out an event to many destinations. You should save the

276 -- result in a @let@-binding, and then repeatedly 'select' on the result to

270 -- result in a @let@-binding, and then repeatedly 'select' on the result to

277 -- create child events

271 -- create child events

@@ -293,14 +287,9 @@ class ( MonadHold t (PushM t)

293 -- that value.

287 -- that value.

294 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p

288 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p

295 -- | Create a merge whose parents can change over time

289 -- | Create a merge whose parents can change over time

296− mergeIncrementalG :: GCompare k

297− => (forall a. q a -> Event t (v a))

298− -> Incremental t (PatchDMap k q)

290+ mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)

299− -> Event t (DMap k v)

300 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental

291 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental

301− mergeIncrementalWithMoveG :: GCompare k

302− => (forall a. q a -> Event t (v a))

303− -> Incremental t (PatchDMapWithMove k q) -> Event t (DMap k v)

292+ mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)

304 -- | Extract the 'Behavior' component of an 'Incremental'

293 -- | Extract the 'Behavior' component of an 'Incremental'

305 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)

294 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)

306 -- | Extract the 'Event' component of an 'Incremental'

295 -- | Extract the 'Event' component of an 'Incremental'

@@ -1576,23 +1565,6 @@ fmapCheap f = pushCheap $ return . Just . f

1576tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b

1565tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b

1577tagCheap b = pushAlwaysCheap $ \_ -> sample b

1566tagCheap b = pushAlwaysCheap $ \_ -> sample b

1578

1567

1579−-- | Merge a collection of events; the resulting 'Event' will only occur if at

1580−-- least one input event is occurring, and will contain all of the input keys

1581−-- that are occurring simultaneously

1582−merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)

1583−merge = mergeG coerceEvent

1584−{-# INLINE merge #-}

1585−

1586−-- | Create a merge whose parents can change over time

1587−mergeIncremental :: (Reflex t, GCompare k)

1588− => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)

1589−mergeIncremental = mergeIncrementalG coerceEvent

1590−

1591−-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental

1592−mergeIncrementalWithMove :: (Reflex t, GCompare k)

1593− => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)

1594−mergeIncrementalWithMove = mergeIncrementalWithMoveG coerceEvent

1595−

1596-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.

1568-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.

1597{-# INLINE mergeWithCheap #-}

1569{-# INLINE mergeWithCheap #-}

1598mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a

1570mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a

src/Reflex/Profiled.hs+5−9

@@ -8,8 +8,6 @@

8{-# LANGUAGE StandaloneDeriving #-}

9{-# LANGUAGE TypeFamilies #-}

10{-# LANGUAGE UndecidableInstances #-}

11−{-# LANGUAGE PolyKinds #-}

12−{-# LANGUAGE RankNTypes #-}

13-- |

11-- |

14-- Module:

12-- Module:

15-- Reflex.Profiled

13-- Reflex.Profiled

@@ -18,6 +16,7 @@

18-- profiling/cost-center information.

16-- profiling/cost-center information.

19module Reflex.Profiled where

17module Reflex.Profiled where

19+import Control.Lens hiding (children)

21import Control.Monad

20import Control.Monad

22import Control.Monad.Exception

21import Control.Monad.Exception

23import Control.Monad.Fix

22import Control.Monad.Fix

@@ -34,7 +33,6 @@ import Data.Map (Map)

34import qualified Data.Map.Strict as Map

33import qualified Data.Map.Strict as Map

35import Data.Monoid ((<>))

34import Data.Monoid ((<>))

36import Data.Ord

35import Data.Ord

37−import Data.Profunctor.Unsafe ((#.))

38import qualified Data.Semigroup as S

36import qualified Data.Semigroup as S

39import Data.Type.Coercion

37import Data.Type.Coercion

40import Foreign.Ptr

38import Foreign.Ptr

@@ -135,10 +133,8 @@ instance Reflex t => Reflex (ProfiledTimeline t) where

135 push f (Event_Profiled e) = coerce $ push (coerce f) $ profileEvent e -- Profile before rather than after; this way fanout won't count against us

133 push f (Event_Profiled e) = coerce $ push (coerce f) $ profileEvent e -- Profile before rather than after; this way fanout won't count against us

136 pushCheap f (Event_Profiled e) = coerce $ pushCheap (coerce f) $ profileEvent e

134 pushCheap f (Event_Profiled e) = coerce $ pushCheap (coerce f) $ profileEvent e

137 pull = Behavior_Profiled . pull . coerce

135 pull = Behavior_Profiled . pull . coerce

138− mergeG :: forall (k :: z -> *) q v. GCompare k

139− => (forall a. q a -> Event (ProfiledTimeline t) (v a))

140− -> DMap k q -> Event (ProfiledTimeline t) (DMap k v)

136+ merge :: forall k. GCompare k => DMap k (Event (ProfiledTimeline t)) -> Event (ProfiledTimeline t) (DMap k Identity)

141− mergeG nt = Event_Profiled #. mergeG (coerce nt)

137+ merge = Event_Profiled . merge . (unsafeCoerce :: DMap k (Event (ProfiledTimeline t)) -> DMap k (Event t))

142 fan (Event_Profiled e) = EventSelector $ coerce $ select (fan $ profileEvent e)

138 fan (Event_Profiled e) = EventSelector $ coerce $ select (fan $ profileEvent e)

143 switch (Behavior_Profiled b) = coerce $ profileEvent $ switch (coerceBehavior b)

139 switch (Behavior_Profiled b) = coerce $ profileEvent $ switch (coerceBehavior b)

144 coincidence (Event_Profiled e) = coerce $ profileEvent $ coincidence (coerceEvent e)

140 coincidence (Event_Profiled e) = coerce $ profileEvent $ coincidence (coerceEvent e)

@@ -146,8 +142,8 @@ instance Reflex t => Reflex (ProfiledTimeline t) where

146 updated (Dynamic_Profiled d) = coerce $ profileEvent $ updated d

142 updated (Dynamic_Profiled d) = coerce $ profileEvent $ updated d

147 unsafeBuildDynamic (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildDynamic a0 a'

143 unsafeBuildDynamic (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildDynamic a0 a'

148 unsafeBuildIncremental (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildIncremental a0 a'

144 unsafeBuildIncremental (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildIncremental a0 a'

149− mergeIncrementalG nt = (Event_Profiled . coerce) #. mergeIncrementalG nt

145+ mergeIncremental = Event_Profiled . mergeIncremental . (unsafeCoerce :: Incremental (ProfiledTimeline t) (PatchDMap k (Event (ProfiledTimeline t))) -> Incremental t (PatchDMap k (Event t)))

150− mergeIncrementalWithMoveG nt = (Event_Profiled . coerce) #. mergeIncrementalWithMoveG nt

146+ mergeIncrementalWithMove = Event_Profiled . mergeIncrementalWithMove . (unsafeCoerce :: Incremental (ProfiledTimeline t) (PatchDMapWithMove k (Event (ProfiledTimeline t))) -> Incremental t (PatchDMapWithMove k (Event t)))

151 currentIncremental (Incremental_Profiled i) = coerce $ currentIncremental i

147 currentIncremental (Incremental_Profiled i) = coerce $ currentIncremental i

152 updatedIncremental (Incremental_Profiled i) = coerce $ profileEvent $ updatedIncremental i

148 updatedIncremental (Incremental_Profiled i) = coerce $ profileEvent $ updatedIncremental i

153 incrementalToDynamic (Incremental_Profiled i) = coerce $ incrementalToDynamic i

149 incrementalToDynamic (Incremental_Profiled i) = coerce $ incrementalToDynamic i

src/Reflex/Pure.hs+10−16

@@ -5,8 +5,6 @@

5{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE TypeFamilies #-}

8−{-# LANGUAGE RankNTypes #-}

9−{-# LANGUAGE PolyKinds #-}

10#ifdef USE_REFLEX_OPTIMIZER

8#ifdef USE_REFLEX_OPTIMIZER

11{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

9{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

12#endif

10#endif

@@ -41,11 +39,10 @@ import Data.MemoTrie

41import Data.Monoid

39import Data.Monoid

42import Data.Type.Coercion

40import Data.Type.Coercion

43import Reflex.Class

41import Reflex.Class

44−import Data.Kind (Type)

46-- | A completely pure-functional 'Reflex' timeline, identifying moments in time

43-- | A completely pure-functional 'Reflex' timeline, identifying moments in time

47-- with the type @/t/@.

44-- with the type @/t/@.

48−data Pure (t :: Type)

45+data Pure t

50-- | The 'Enum' instance of @/t/@ must be dense: for all @/x :: t/@, there must not exist

47-- | The 'Enum' instance of @/t/@ must be dense: for all @/x :: t/@, there must not exist

51-- any @/y :: t/@ such that @/'pred' x < y < x/@. The 'HasTrie' instance will be used

48-- any @/y :: t/@ such that @/'pred' x < y < x/@. The 'HasTrie' instance will be used

@@ -78,12 +75,11 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where

78 -- [UNUSED_CONSTRAINT]: The following type signature for merge will produce a

75 -- [UNUSED_CONSTRAINT]: The following type signature for merge will produce a

79 -- warning because the GCompare instance is not used; however, removing the

76 -- warning because the GCompare instance is not used; however, removing the

80 -- GCompare instance produces a different warning, due to that constraint

77 -- GCompare instance produces a different warning, due to that constraint

81− -- being present in the original class definition.

78+ -- being present in the original class definition

83− --mergeG :: GCompare k => (forall a. q a -> Event (Pure t) (v a))

80+ --merge :: GCompare k => DMap k (Event (Pure t)) -> Event (Pure t) (DMap k Identity)

84− -- -> DMap k q -> Event (Pure t) (DMap k v)

85− mergeG nt events = Event $ memo $ \t ->

81+ merge events = Event $ memo $ \t ->

86− let currentOccurrences = DMap.mapMaybeWithKey (\_ q -> case nt q of Event a -> a t) events

82+ let currentOccurrences = DMap.mapMaybeWithKey (\_ (Event a) -> Identity <$> a t) events

87 in if DMap.null currentOccurrences

83 in if DMap.null currentOccurrences

88 then Nothing

84 then Nothing

89 else Just currentOccurrences

85 else Just currentOccurrences

@@ -112,8 +108,8 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where

112 --a) -> Incremental (Pure t) p a

108 --a) -> Incremental (Pure t) p a

113 unsafeBuildIncremental readV0 p = Incremental $ \t -> (readV0 t, unEvent p t)

109 unsafeBuildIncremental readV0 p = Incremental $ \t -> (readV0 t, unEvent p t)

114

110

115− mergeIncrementalG = mergeIncrementalImpl

111+ mergeIncremental = mergeIncrementalImpl

116− mergeIncrementalWithMoveG = mergeIncrementalImpl

112+ mergeIncrementalWithMove = mergeIncrementalImpl

117

113

118 currentIncremental i = Behavior $ \t -> fst $ unIncremental i t

114 currentIncremental i = Behavior $ \t -> fst $ unIncremental i t

119

115

@@ -133,11 +129,9 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where

133

129

134 mergeIntIncremental = mergeIntIncrementalImpl

130 mergeIntIncremental = mergeIntIncrementalImpl

135

131

136−mergeIncrementalImpl :: (PatchTarget p ~ DMap k q, GCompare k)

132+mergeIncrementalImpl :: (PatchTarget p ~ DMap k (Event (Pure t)), GCompare k) => Incremental (Pure t) p -> Event (Pure t) (DMap k Identity)

137− => (forall a. q a -> Event (Pure t) (v a))

138− -> Incremental (Pure t) p -> Event (Pure t) (DMap k v)

139−mergeIncrementalImpl nt i = Event $ \t ->

133+mergeIncrementalImpl i = Event $ \t ->

140− let results = DMap.mapMaybeWithKey (\_ q -> case nt q of Event e -> e t) $ fst $ unIncremental i t

134+ let results = DMap.mapMaybeWithKey (\_ (Event e) -> Identity <$> e t) $ fst $ unIncremental i t

141 in if DMap.null results

135 in if DMap.null results

142 then Nothing

136 then Nothing

143 else Just results

137 else Just results

src/Reflex/Spider/Internal.hs+53−78

@@ -16,12 +16,9 @@

16{-# LANGUAGE TypeFamilies #-}

17{-# LANGUAGE TypeOperators #-}

18{-# LANGUAGE UndecidableInstances #-}

19−{-# LANGUAGE PolyKinds #-}

20−{-# LANGUAGE InstanceSigs #-}

21#ifdef USE_REFLEX_OPTIMIZER

19#ifdef USE_REFLEX_OPTIMIZER

22{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

20{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

23#endif

21#endif

24−{-# OPTIONS_GHC -Wunused-binds #-}

25-- | This module is the implementation of the 'Spider' 'Reflex' engine. It uses

22-- | This module is the implementation of the 'Spider' 'Reflex' engine. It uses

26-- a graph traversal algorithm to propagate 'Event's and 'Behavior's.

23-- a graph traversal algorithm to propagate 'Event's and 'Behavior's.

27module Reflex.Spider.Internal (module Reflex.Spider.Internal) where

24module Reflex.Spider.Internal (module Reflex.Spider.Internal) where

@@ -51,7 +48,6 @@ import Data.GADT.Compare

51import Data.IntMap.Strict (IntMap)

48import Data.IntMap.Strict (IntMap)

52import qualified Data.IntMap.Strict as IntMap

49import qualified Data.IntMap.Strict as IntMap

53import Data.IORef

50import Data.IORef

54−import Data.Kind (Type)

55import Data.Maybe hiding (mapMaybe)

51import Data.Maybe hiding (mapMaybe)

56import Data.Monoid ((<>))

52import Data.Monoid ((<>))

57import Data.Proxy

53import Data.Proxy

@@ -88,7 +84,6 @@ import qualified Data.FastWeakBag as FastWeakBag

88import Data.Reflection

84import Data.Reflection

89import Data.Some (Some(Some))

85import Data.Some (Some(Some))

90import Data.Type.Coercion

86import Data.Type.Coercion

91−import Data.Profunctor.Unsafe ((#.), (.#))

92import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)

87import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)

93import qualified Data.WeakBag as WeakBag

88import qualified Data.WeakBag as WeakBag

94import qualified Reflex.Class

89import qualified Reflex.Class

@@ -1148,8 +1143,7 @@ instance HasSpiderTimeline x => Align (Event x) where

1148#if MIN_VERSION_these(0, 8, 0)

1143#if MIN_VERSION_these(0, 8, 0)

1149instance HasSpiderTimeline x => Semialign (Event x) where

1144instance HasSpiderTimeline x => Semialign (Event x) where

1150#endif

1145#endif

1151− align ea eb = mapMaybe dmapToThese $ mergeG coerce $ dynamicConst $

1152− DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]

1146+ align ea eb = mapMaybe dmapToThese $ merge $ dynamicConst $ DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]

1153

1147

1154#ifdef MIN_VERSION_semialign

1148#ifdef MIN_VERSION_semialign

1155#if MIN_VERSION_semialign(1,1,0)

1149#if MIN_VERSION_semialign(1,1,0)

@@ -1162,7 +1156,7 @@ data DynType x p = UnsafeDyn !(BehaviorM x (PatchTarget p), Event x p)

1162 | BuildDyn !(EventM x (PatchTarget p), Event x p)

1156 | BuildDyn !(EventM x (PatchTarget p), Event x p)

1163 | HoldDyn !(Hold x p)

1157 | HoldDyn !(Hold x p)

1164

1158

1165−newtype Dyn (x :: Type) p = Dyn { unDyn :: IORef (DynType x p) }

1159+newtype Dyn x p = Dyn { unDyn :: IORef (DynType x p) }

1166

1160

1167newMapDyn :: HasSpiderTimeline x => (a -> b) -> Dynamic x (Identity a) -> Dynamic x (Identity b)

1161newMapDyn :: HasSpiderTimeline x => (a -> b) -> Dynamic x (Identity a) -> Dynamic x (Identity b)

1168newMapDyn f d = dynamicDynIdentity $ unsafeBuildDynamic (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)

1162newMapDyn f d = dynamicDynIdentity $ unsafeBuildDynamic (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)

@@ -1708,34 +1702,26 @@ cleanupCoincidenceSubscribed subscribed = do

1708subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO WeakBagTicket

1702subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO WeakBagTicket

1709subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceSubscribedSubscribers subscribed) (coincidenceSubscribedWeakSelf subscribed) cleanupCoincidenceSubscribed

1703subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceSubscribedSubscribers subscribed) (coincidenceSubscribedWeakSelf subscribed) cleanupCoincidenceSubscribed

1710

1704

1711−{-# INLINE mergeG #-}

1705+{-# INLINE merge #-}

1712−mergeG :: forall k q x v. (HasSpiderTimeline x, GCompare k)

1706+merge :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)

1713− => (forall a. q a -> Event x (v a))

1714− -> Dynamic x (PatchDMap k q) -> Event x (DMap k v)

1715−mergeG nt d = cacheEvent (mergeCheap nt d)

1707+merge d = cacheEvent (mergeCheap d)

1716

1708

1717{-# INLINE mergeWithMove #-}

1709{-# INLINE mergeWithMove #-}

1718−mergeWithMove :: forall k v q x. (HasSpiderTimeline x, GCompare k)

1710+mergeWithMove :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMapWithMove k (Event x)) -> Event x (DMap k Identity)

1719− => (forall a. q a -> Event x (v a))

1720− -> Dynamic x (PatchDMapWithMove k q) -> Event x (DMap k v)

1721−mergeWithMove nt d = cacheEvent (mergeCheapWithMove nt d)

1711+mergeWithMove d = cacheEvent (mergeCheapWithMove d)

1722

1712

1723{-# INLINE [1] mergeCheap #-}

1713{-# INLINE [1] mergeCheap #-}

1724−mergeCheap

1725− :: forall k x q v. (HasSpiderTimeline x, GCompare k)

1714+mergeCheap :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)

1726− => (forall a. q a -> Event x (v a))

1727− -> Dynamic x (PatchDMap k q)

1728− -> Event x (DMap k v)

1729−mergeCheap nt = mergeGCheap' getInitialSubscribers updateMe destroy

1715+mergeCheap = mergeCheap' getInitialSubscribers updateMe destroy

1730 where

1716 where

1731− updateMe :: MergeUpdateFunc k v x (PatchDMap k q) (MergeSubscribedParent x)

1717+ updateMe :: MergeUpdateFunc k x (PatchDMap k (Event x)) (MergeSubscribedParent x)

1732 updateMe subscriber heightBagRef oldParents (PatchDMap p) = do

1718 updateMe subscriber heightBagRef oldParents (PatchDMap p) = do

1733 let f (subscriptionsToKill, ps) (k :=> ComposeMaybe me) = do

1719 let f (subscriptionsToKill, ps) (k :=> ComposeMaybe me) = do

1734 (mOldSubd, newPs) <- case me of

1720 (mOldSubd, newPs) <- case me of

1735 Nothing -> return $ DMap.updateLookupWithKey (\_ _ -> Nothing) k ps

1721 Nothing -> return $ DMap.updateLookupWithKey (\_ _ -> Nothing) k ps

1736 Just e -> do

1722 Just e -> do

1737 let s = subscriber $ return k

1723 let s = subscriber $ return k

1738− subscription@(EventSubscription _ subd) <- subscribe (nt e) s

1724+ subscription@(EventSubscription _ subd) <- subscribe e s

1739 newParentHeight <- liftIO $ getEventSubscribedHeight subd

1725 newParentHeight <- liftIO $ getEventSubscribedHeight subd

1740 let newParent = MergeSubscribedParent subscription

1726 let newParent = MergeSubscribedParent subscription

1741 liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight

1727 liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight

@@ -1745,33 +1731,28 @@ mergeCheap nt = mergeGCheap' getInitialSubscribers updateMe destroy

1745 liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight

1731 liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight

1746 return (maybeToList (unMergeSubscribedParent <$> mOldSubd) ++ subscriptionsToKill, newPs)

1732 return (maybeToList (unMergeSubscribedParent <$> mOldSubd) ++ subscriptionsToKill, newPs)

1747 foldM f ([], oldParents) $ DMap.toList p

1733 foldM f ([], oldParents) $ DMap.toList p

1748−

1749− getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParent x)

1734+ getInitialSubscribers :: MergeInitFunc k x (MergeSubscribedParent x)

1750 getInitialSubscribers initialParents subscriber = do

1735 getInitialSubscribers initialParents subscriber = do

1751 subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do

1736 subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do

1752 let s = subscriber $ return k

1737 let s = subscriber $ return k

1753− (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead (nt e) s

1738+ (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s

1754 height <- liftIO $ getEventSubscribedHeight parentSubd

1739 height <- liftIO $ getEventSubscribedHeight parentSubd

1755− return (fmap (k :=>) parentOcc, height, k :=> MergeSubscribedParent subscription)

1740+ return (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParent subscription)

1756 return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers

1741 return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers

1757 , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here

1742 , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here

1758 , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers

1743 , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers

1759 )

1744 )

1760−

1761 destroy :: MergeDestroyFunc k (MergeSubscribedParent x)

1745 destroy :: MergeDestroyFunc k (MergeSubscribedParent x)

1762 destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParent sub) -> unsubscribe sub

1746 destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParent sub) -> unsubscribe sub

1763

1747

1764{-# INLINE [1] mergeCheapWithMove #-}

1748{-# INLINE [1] mergeCheapWithMove #-}

1765−mergeCheapWithMove :: forall k x v q. (HasSpiderTimeline x, GCompare k)

1749+mergeCheapWithMove :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMapWithMove k (Event x)) -> Event x (DMap k Identity)

1766− => (forall a. q a -> Event x (v a))

1767− -> Dynamic x (PatchDMapWithMove k q)

1768− -> Event x (DMap k v)

1769−mergeCheapWithMove nt = mergeGCheap' getInitialSubscribers updateMe destroy

1750+mergeCheapWithMove = mergeCheap' getInitialSubscribers updateMe destroy

1770 where

1751 where

1771− updateMe :: MergeUpdateFunc k v x (PatchDMapWithMove k q) (MergeSubscribedParentWithMove x k)

1752+ updateMe :: MergeUpdateFunc k x (PatchDMapWithMove k (Event x)) (MergeSubscribedParentWithMove x k)

1772 updateMe subscriber heightBagRef oldParents p = do

1753 updateMe subscriber heightBagRef oldParents p = do

1773 -- Prepare new parents for insertion

1754 -- Prepare new parents for insertion

1774− let subscribeParent :: forall a. k a -> Event x (v a) -> EventM x (MergeSubscribedParentWithMove x k a)

1755+ let subscribeParent :: forall a. k a -> Event x a -> EventM x (MergeSubscribedParentWithMove x k a)

1775 subscribeParent k e = do

1756 subscribeParent k e = do

1776 keyRef <- liftIO $ newIORef k

1757 keyRef <- liftIO $ newIORef k

1777 let s = subscriber $ liftIO $ readIORef keyRef

1758 let s = subscriber $ liftIO $ readIORef keyRef

@@ -1780,9 +1761,9 @@ mergeCheapWithMove nt = mergeGCheap' getInitialSubscribers updateMe destroy

1780 newParentHeight <- getEventSubscribedHeight subd

1761 newParentHeight <- getEventSubscribedHeight subd

1781 modifyIORef' heightBagRef $ heightBagAdd newParentHeight

1762 modifyIORef' heightBagRef $ heightBagAdd newParentHeight

1782 return $ MergeSubscribedParentWithMove subscription keyRef

1763 return $ MergeSubscribedParentWithMove subscription keyRef

1783− p' <- PatchDMapWithMove.traversePatchDMapWithMoveWithKey (\k q -> subscribeParent k (nt q)) p

1764+ p' <- PatchDMapWithMove.traversePatchDMapWithMoveWithKey subscribeParent p

1784 -- Collect old parents for deletion and update the keys of moved parents

1765 -- Collect old parents for deletion and update the keys of moved parents

1785− let moveOrDelete :: forall a. k a -> PatchDMapWithMove.NodeInfo k q a -> MergeSubscribedParentWithMove x k a -> Constant (EventM x (Maybe (EventSubscription x))) a

1766+ let moveOrDelete :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Event x) a -> MergeSubscribedParentWithMove x k a -> Constant (EventM x (Maybe (EventSubscription x))) a

1786 moveOrDelete _ ni parent = Constant $ case getComposeMaybe $ PatchDMapWithMove._nodeInfo_to ni of

1767 moveOrDelete _ ni parent = Constant $ case getComposeMaybe $ PatchDMapWithMove._nodeInfo_to ni of

1787 Nothing -> do

1768 Nothing -> do

1788 oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ _mergeSubscribedParentWithMove_subscription parent

1769 oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ _mergeSubscribedParentWithMove_subscription parent

@@ -1793,47 +1774,46 @@ mergeCheapWithMove nt = mergeGCheap' getInitialSubscribers updateMe destroy

1793 return Nothing

1774 return Nothing

1794 toDelete <- fmap catMaybes $ mapM (\(_ :=> v) -> getConstant v) $ DMap.toList $ DMap.intersectionWithKey moveOrDelete (unPatchDMapWithMove p) oldParents

1775 toDelete <- fmap catMaybes $ mapM (\(_ :=> v) -> getConstant v) $ DMap.toList $ DMap.intersectionWithKey moveOrDelete (unPatchDMapWithMove p) oldParents

1795 return (toDelete, applyAlways p' oldParents)

1776 return (toDelete, applyAlways p' oldParents)

1796− getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParentWithMove x k)

1777+ getInitialSubscribers :: MergeInitFunc k x (MergeSubscribedParentWithMove x k)

1797 getInitialSubscribers initialParents subscriber = do

1778 getInitialSubscribers initialParents subscriber = do

1798 subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do

1779 subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do

1799 keyRef <- liftIO $ newIORef k

1780 keyRef <- liftIO $ newIORef k

1800 let s = subscriber $ liftIO $ readIORef keyRef

1781 let s = subscriber $ liftIO $ readIORef keyRef

1801− (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead (nt e) s

1782+ (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s

1802 height <- liftIO $ getEventSubscribedHeight parentSubd

1783 height <- liftIO $ getEventSubscribedHeight parentSubd

1803− return (fmap (k :=>) parentOcc, height, k :=> MergeSubscribedParentWithMove subscription keyRef)

1784+ return (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParentWithMove subscription keyRef)

1804 return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers

1785 return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers

1805 , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here

1786 , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here

1806 , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers

1787 , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers

1807 )

1788 )

1808−

1809 destroy :: MergeDestroyFunc k (MergeSubscribedParentWithMove x k)

1789 destroy :: MergeDestroyFunc k (MergeSubscribedParentWithMove x k)

1810 destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParentWithMove sub _) -> unsubscribe sub

1790 destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParentWithMove sub _) -> unsubscribe sub

1811

1791

1812−type MergeUpdateFunc k v x p s

1792+type MergeUpdateFunc k x p s

1813− = (forall a. EventM x (k a) -> Subscriber x (v a))

1793+ = (forall a. EventM x (k a) -> Subscriber x a)

1814 -> IORef HeightBag

1794 -> IORef HeightBag

1815 -> DMap k s

1795 -> DMap k s

1816 -> p

1796 -> p

1817 -> EventM x ([EventSubscription x], DMap k s)

1797 -> EventM x ([EventSubscription x], DMap k s)

1818

1798

1819−type MergeInitFunc k v q x s

1799+type MergeInitFunc k x s

1820− = DMap k q

1800+ = DMap k (Event x)

1821− -> (forall a. EventM x (k a) -> Subscriber x (v a))

1801+ -> (forall a. EventM x (k a) -> Subscriber x a)

1822− -> EventM x (DMap k v, [Height], DMap k s)

1802+ -> EventM x (DMap k Identity, [Height], DMap k s)

1823

1803

1824type MergeDestroyFunc k s

1804type MergeDestroyFunc k s

1825 = DMap k s

1805 = DMap k s

1826 -> IO ()

1806 -> IO ()

1827

1807

1828−data Merge x k v s = Merge

1808+data Merge x k s = Merge

1829 { _merge_parentsRef :: {-# UNPACK #-} !(IORef (DMap k s))

1809 { _merge_parentsRef :: {-# UNPACK #-} !(IORef (DMap k s))

1830 , _merge_heightBagRef :: {-# UNPACK #-} !(IORef HeightBag)

1810 , _merge_heightBagRef :: {-# UNPACK #-} !(IORef HeightBag)

1831 , _merge_heightRef :: {-# UNPACK #-} !(IORef Height)

1811 , _merge_heightRef :: {-# UNPACK #-} !(IORef Height)

1832− , _merge_sub :: {-# UNPACK #-} !(Subscriber x (DMap k v))

1812+ , _merge_sub :: {-# UNPACK #-} !(Subscriber x (DMap k Identity))

1833− , _merge_accumRef :: {-# UNPACK #-} !(IORef (DMap k v))

1813+ , _merge_accumRef :: {-# UNPACK #-} !(IORef (DMap k Identity))

1834 }

1814 }

1835

1815

1836−invalidateMergeHeight :: Merge x k v s -> IO ()

1816+invalidateMergeHeight :: Merge x k s -> IO ()

1837invalidateMergeHeight m = invalidateMergeHeight' (_merge_heightRef m) (_merge_sub m)

1817invalidateMergeHeight m = invalidateMergeHeight' (_merge_heightRef m) (_merge_sub m)

1838

1818

1839invalidateMergeHeight' :: IORef Height -> Subscriber x a -> IO ()

1819invalidateMergeHeight' :: IORef Height -> Subscriber x a -> IO ()

@@ -1843,7 +1823,8 @@ invalidateMergeHeight' heightRef sub = do

1843 writeIORef heightRef $! invalidHeight

1823 writeIORef heightRef $! invalidHeight

1844 subscriberInvalidateHeight sub oldHeight

1824 subscriberInvalidateHeight sub oldHeight

1845

1825

1826+

1846−revalidateMergeHeight :: Merge x k v s -> IO ()

1827+revalidateMergeHeight :: Merge x k s -> IO ()

1847revalidateMergeHeight m = do

1828revalidateMergeHeight m = do

1848 currentHeight <- readIORef $ _merge_heightRef m

1829 currentHeight <- readIORef $ _merge_heightRef m

1849 when (currentHeight == invalidHeight) $ do -- revalidateMergeHeight may be called multiple times; perhaps the's a way to finesse it to avoid this check

1830 when (currentHeight == invalidHeight) $ do -- revalidateMergeHeight may be called multiple times; perhaps the's a way to finesse it to avoid this check

@@ -1859,19 +1840,19 @@ revalidateMergeHeight m = do

1859 subscriberRecalculateHeight (_merge_sub m) height

1840 subscriberRecalculateHeight (_merge_sub m) height

1860 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show (DMap.size parents) <> ") for Merge"

1841 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show (DMap.size parents) <> ") for Merge"

1861

1842

1862−scheduleMergeSelf :: HasSpiderTimeline x => Merge x k v s -> Height -> EventM x ()

1843+scheduleMergeSelf :: HasSpiderTimeline x => Merge x k s -> Height -> EventM x ()

1863scheduleMergeSelf m height = scheduleMerge' height (_merge_heightRef m) $ do

1844scheduleMergeSelf m height = scheduleMerge' height (_merge_heightRef m) $ do

1864 vals <- liftIO $ readIORef $ _merge_accumRef m

1845 vals <- liftIO $ readIORef $ _merge_accumRef m

1865 liftIO $ writeIORef (_merge_accumRef m) $! DMap.empty -- Once we're done with this, we can clear it immediately, because if there's a cacheEvent in front of us, it'll handle subsequent subscribers, and if not, we won't get subsequent subscribers

1846 liftIO $ writeIORef (_merge_accumRef m) $! DMap.empty -- Once we're done with this, we can clear it immediately, because if there's a cacheEvent in front of us, it'll handle subsequent subscribers, and if not, we won't get subsequent subscribers

1866 --TODO: Assert that m is not empty

1847 --TODO: Assert that m is not empty

1867 subscriberPropagate (_merge_sub m) vals

1848 subscriberPropagate (_merge_sub m) vals

1868

1849

1869−mergeSubscriber :: forall x k v s a. (HasSpiderTimeline x, GCompare k) => Merge x k v s -> EventM x (k a) -> Subscriber x (v a)

1850+mergeSubscriber :: forall x k s a. (HasSpiderTimeline x, GCompare k) => Merge x k s -> EventM x (k a) -> Subscriber x a

1870mergeSubscriber m getKey = Subscriber

1851mergeSubscriber m getKey = Subscriber

1871 { subscriberPropagate = \a -> do

1852 { subscriberPropagate = \a -> do

1872 oldM <- liftIO $ readIORef $ _merge_accumRef m

1853 oldM <- liftIO $ readIORef $ _merge_accumRef m

1873 k <- getKey

1854 k <- getKey

1874− let newM = DMap.insertWith (error $ "Same key fired multiple times for Merge") k a oldM

1855+ let newM = DMap.insertWith (error $ "Same key fired multiple times for Merge") k (Identity a) oldM

1875 tracePropagate (Proxy :: Proxy x) $ " DMap.size oldM = " <> show (DMap.size oldM) <> "; DMap.size newM = " <> show (DMap.size newM)

1856 tracePropagate (Proxy :: Proxy x) $ " DMap.size oldM = " <> show (DMap.size oldM) <> "; DMap.size newM = " <> show (DMap.size newM)

1876 liftIO $ writeIORef (_merge_accumRef m) $! newM

1857 liftIO $ writeIORef (_merge_accumRef m) $! newM

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

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

@@ -1902,7 +1883,7 @@ mergeSubscriber m getKey = Subscriber

1902 }

1883 }

1903

1884

1904--TODO: Be able to run as much of this as possible promptly

1885--TODO: Be able to run as much of this as possible promptly

1905−updateMerge :: (HasSpiderTimeline x, GCompare k) => Merge x k v s -> MergeUpdateFunc k v x p s -> p -> SomeMergeUpdate x

1886+updateMerge :: (HasSpiderTimeline x, GCompare k) => Merge x k s -> MergeUpdateFunc k x p s -> p -> SomeMergeUpdate x

1906updateMerge m updateFunc p = SomeMergeUpdate updateMe (invalidateMergeHeight m) (revalidateMergeHeight m)

1887updateMerge m updateFunc p = SomeMergeUpdate updateMe (invalidateMergeHeight m) (revalidateMergeHeight m)

1907 where updateMe = do

1888 where updateMe = do

1908 oldParents <- liftIO $ readIORef $ _merge_parentsRef m

1889 oldParents <- liftIO $ readIORef $ _merge_parentsRef m

@@ -1910,10 +1891,9 @@ updateMerge m updateFunc p = SomeMergeUpdate updateMe (invalidateMergeHeight m)

1910 liftIO $ writeIORef (_merge_parentsRef m) $! newParents

1891 liftIO $ writeIORef (_merge_parentsRef m) $! newParents

1911 return subscriptionsToKill

1892 return subscriptionsToKill

1912

1893

1913−{-# INLINE mergeGCheap' #-}

1894+{-# INLINE mergeCheap' #-}

1914−mergeGCheap' :: forall k v x p s q. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k q)

1915− => MergeInitFunc k v q x s -> MergeUpdateFunc k v x p s -> MergeDestroyFunc k s -> Dynamic x p -> Event x (DMap k v)

1895+mergeCheap' :: forall k x p s. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k (Event x)) => MergeInitFunc k x s -> MergeUpdateFunc k x p s -> MergeDestroyFunc k s -> Dynamic x p -> Event x (DMap k Identity)

1916−mergeGCheap' getInitialSubscribers updateFunc destroy d = Event $ \sub -> do

1896+mergeCheap' getInitialSubscribers updateFunc destroy d = Event $ \sub -> do

1917 initialParents <- readBehaviorUntracked $ dynamicCurrent d

1897 initialParents <- readBehaviorUntracked $ dynamicCurrent d

1918 accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"

1898 accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"

1919 heightRef <- liftIO $ newIORef $ error "merge: heightRef not yet initialized"

1899 heightRef <- liftIO $ newIORef $ error "merge: heightRef not yet initialized"

@@ -2496,7 +2476,7 @@ unsafeNewSpiderTimelineEnv = do

2496newSpiderTimeline :: IO (Some SpiderTimelineEnv)

2476newSpiderTimeline :: IO (Some SpiderTimelineEnv)

2497newSpiderTimeline = withSpiderTimeline (pure . Some)

2477newSpiderTimeline = withSpiderTimeline (pure . Some)

2498

2478

2499−data LocalSpiderTimeline (x :: Type) s

2479+data LocalSpiderTimeline x s

2500

2480

2501instance Reifies s (SpiderTimelineEnv x) =>

2481instance Reifies s (SpiderTimelineEnv x) =>

2502 HasSpiderTimeline (LocalSpiderTimeline x s) where

2482 HasSpiderTimeline (LocalSpiderTimeline x s) where

@@ -2514,11 +2494,11 @@ withSpiderTimeline k = do

2514 env <- unsafeNewSpiderTimelineEnv

2494 env <- unsafeNewSpiderTimelineEnv

2515 reify env $ \s -> k $ localSpiderTimeline s env

2495 reify env $ \s -> k $ localSpiderTimeline s env

2516

2496

2517−newtype SpiderPullM (x :: Type) a = SpiderPullM (BehaviorM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2497+newtype SpiderPullM x a = SpiderPullM (BehaviorM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2518

2498

2519type ComputeM = EventM

2499type ComputeM = EventM

2520

2500

2521−newtype SpiderPushM (x :: Type) a = SpiderPushM (ComputeM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2501+newtype SpiderPushM x a = SpiderPushM (ComputeM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2522

2502

2523instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2503instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2524 {-# SPECIALIZE instance R.Reflex (SpiderTimeline Global) #-}

2504 {-# SPECIALIZE instance R.Reflex (SpiderTimeline Global) #-}

@@ -2538,13 +2518,8 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2538 pushCheap f = SpiderEvent . pushCheap (coerce f) . unSpiderEvent

2518 pushCheap f = SpiderEvent . pushCheap (coerce f) . unSpiderEvent

2539 {-# INLINABLE pull #-}

2519 {-# INLINABLE pull #-}

2540 pull = SpiderBehavior . pull . coerce

2520 pull = SpiderBehavior . pull . coerce

2541− {-# INLINABLE mergeG #-}

2521+ {-# INLINABLE merge #-}

2542− mergeG

2522+ merge = SpiderEvent . merge . dynamicConst . (coerce :: DMap k (R.Event (SpiderTimeline x)) -> DMap k (Event x))

2543− :: forall (k :: k2 -> *) q (v :: k2 -> *). GCompare k

2544− => (forall a. q a -> R.Event (SpiderTimeline x) (v a))

2545− -> DMap k q

2546− -> R.Event (SpiderTimeline x) (DMap k v)

2547− mergeG nt = SpiderEvent . mergeG (unSpiderEvent #. nt) . dynamicConst

2548 {-# INLINABLE fan #-}

2523 {-# INLINABLE fan #-}

2549 fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))

2524 fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))

2550 {-# INLINABLE switch #-}

2525 {-# INLINABLE switch #-}

@@ -2559,10 +2534,10 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2559 unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'

2534 unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'

2560 {-# INLINABLE unsafeBuildIncremental #-}

2535 {-# INLINABLE unsafeBuildIncremental #-}

2561 unsafeBuildIncremental readV0 dv = SpiderIncremental $ dynamicDyn $ unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv

2536 unsafeBuildIncremental readV0 dv = SpiderIncremental $ dynamicDyn $ unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv

2562− {-# INLINABLE mergeIncrementalG #-}

2537+ {-# INLINABLE mergeIncremental #-}

2563− mergeIncrementalG nt = SpiderEvent #. mergeG (coerce #. nt) .# unSpiderIncremental

2538+ mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic x (PatchDMap k (R.Event (SpiderTimeline x))) -> Dynamic x (PatchDMap k (Event x))) . unSpiderIncremental

2564− {-# INLINABLE mergeIncrementalWithMoveG #-}

2539+ {-# INLINABLE mergeIncrementalWithMove #-}

2565− mergeIncrementalWithMoveG nt = SpiderEvent #. mergeWithMove (coerce #. nt) .# unSpiderIncremental

2540+ mergeIncrementalWithMove = SpiderEvent . mergeWithMove . (unsafeCoerce :: Dynamic x (PatchDMapWithMove k (R.Event (SpiderTimeline x))) -> Dynamic x (PatchDMapWithMove k (Event x))) . unSpiderIncremental

2566 {-# INLINABLE currentIncremental #-}

2541 {-# INLINABLE currentIncremental #-}

2567 currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental

2542 currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental

2568 {-# INLINABLE updatedIncremental #-}

2543 {-# INLINABLE updatedIncremental #-}

@@ -2600,7 +2575,7 @@ instance MonadAtomicRef (EventM x) where

2600 atomicModifyRef r f = liftIO $ atomicModifyRef r f

2575 atomicModifyRef r f = liftIO $ atomicModifyRef r f

2601

2576

2602-- | The monad for actions that manipulate a Spider timeline identified by @x@

2577-- | The monad for actions that manipulate a Spider timeline identified by @x@

2603−newtype SpiderHost (x :: Type) a = SpiderHost { unSpiderHost :: IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2578+newtype SpiderHost x a = SpiderHost { unSpiderHost :: IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2604

2579

2605instance Monad (SpiderHost x) where

2580instance Monad (SpiderHost x) where

2606 {-# INLINABLE (>>=) #-}

2581 {-# INLINABLE (>>=) #-}

@@ -2622,7 +2597,7 @@ runSpiderHost (SpiderHost a) = a

2622runSpiderHostForTimeline :: SpiderHost x a -> SpiderTimelineEnv x -> IO a

2597runSpiderHostForTimeline :: SpiderHost x a -> SpiderTimelineEnv x -> IO a

2623runSpiderHostForTimeline (SpiderHost a) _ = a

2598runSpiderHostForTimeline (SpiderHost a) _ = a

2624

2599

2625−newtype SpiderHostFrame (x :: Type) a = SpiderHostFrame { runSpiderHostFrame :: EventM x a }

2600+newtype SpiderHostFrame x a = SpiderHostFrame { runSpiderHostFrame :: EventM x a }

2626 deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2601 deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2627

2602

2628instance Monad (SpiderHostFrame x) where

2603instance Monad (SpiderHostFrame x) where

test/GC.hs+1−2

@@ -27,7 +27,6 @@ import qualified Reflex.Spider.Internal as S

28import System.Exit

29import System.Mem

30−import Data.Coerce

32main :: IO ()

31main :: IO ()

33main = do

32main = do

@@ -47,7 +46,7 @@ hostPerf ref = S.runSpiderHost $ do

47 eventToPerform <- Host.runHostFrame $ do

46 eventToPerform <- Host.runHostFrame $ do

48 (reqMap :: S.Event S.Global (DMap (Const2 Int (DMap Tell (S.SpiderHostFrame S.Global))) Identity))

47 (reqMap :: S.Event S.Global (DMap (Const2 Int (DMap Tell (S.SpiderHostFrame S.Global))) Identity))

49 <- S.SpiderHostFrame

48 <- S.SpiderHostFrame

50− $ fmap ( S.mergeG coerce

49+ $ fmap ( S.merge

51 . S.dynamicHold)

50 . S.dynamicHold)

52 $ S.hold DMap.empty

51 $ S.hold DMap.empty

53 -- Construct a new heap object for the subscriber, invalidating any weak references to the subscriber if they are not retained

52 -- Construct a new heap object for the subscriber, invalidating any weak references to the subscriber if they are not retained