git.iko.soy/patch
on develop help sign in
Use Some for more existential types (which should be efficient now that it is a newtype)
5c191d7Ken Micklas
src/Reflex/Spider/Internal.hs+22−22
compare with develop
unifiedsplit
@@ -659,7 +659,7 @@ behaviorPull !p = Behavior $ do
659 val <- liftIO $ readIORef $ pullValue p
659 val <- liftIO $ readIORef $ pullValue p
660 case val of
660 case val of
661 Just subscribed -> do
661 Just subscribed -> do
662− askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedPull subscribed) :))
662+ askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some.This (BehaviorSubscribedPull subscribed)) :))
663 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (pullSubscribedInvalidators subscribed) (wi:))
663 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (pullSubscribedInvalidators subscribed) (wi:))
664 liftIO $ touch $ pullSubscribedOwnInvalidator subscribed
664 liftIO $ touch $ pullSubscribedOwnInvalidator subscribed
665 return $ pullSubscribedValue subscribed
665 return $ pullSubscribedValue subscribed
@@ -678,7 +678,7 @@ behaviorPull !p = Behavior $ do
678 , pullSubscribedParents = parents
678 , pullSubscribedParents = parents
679 }
679 }
680 liftIO $ writeIORef (pullValue p) $ Just subscribed
680 liftIO $ writeIORef (pullValue p) $ Just subscribed
681− askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedPull subscribed) :))
681+ askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some.This (BehaviorSubscribedPull subscribed)) :))
682 return a
682 return a
683
683
684behaviorDyn :: Patch p => Dyn x p -> Behavior x (PatchTarget p)
684behaviorDyn :: Patch p => Dyn x p -> Behavior x (PatchTarget p)
@@ -689,7 +689,7 @@ readHoldTracked :: Hold x p -> BehaviorM x (PatchTarget p)
689readHoldTracked h = do
689readHoldTracked h = do
690 result <- liftIO $ readIORef $ holdValue h
690 result <- liftIO $ readIORef $ holdValue h
691 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (holdInvalidators h) (wi:))
691 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (holdInvalidators h) (wi:))
692− askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedHold h) :))
692+ askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some.This (BehaviorSubscribedHold h)) :))
693 liftIO $ touch h -- Otherwise, if this gets inlined enough, the hold's parent reference may get collected
693 liftIO $ touch h -- Otherwise, if this gets inlined enough, the hold's parent reference may get collected
694 return result
694 return result
695
695
@@ -782,9 +782,9 @@ data EventEnv x
782 , eventEnvDynInits :: !(IORef [SomeDynInit x])
782 , eventEnvDynInits :: !(IORef [SomeDynInit x])
783 , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate x])
783 , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate x])
784 , eventEnvMergeInits :: !(IORef [SomeMergeInit x]) -- Needed for Subscribe
784 , eventEnvMergeInits :: !(IORef [SomeMergeInit x]) -- Needed for Subscribe
785− , eventEnvClears :: !(IORef [SomeClear]) -- Needed for Subscribe
785+ , eventEnvClears :: !(IORef [Some Clear]) -- Needed for Subscribe
786− , eventEnvIntClears :: !(IORef [SomeIntClear])
786+ , eventEnvIntClears :: !(IORef [Some IntClear])
787− , eventEnvRootClears :: !(IORef [SomeRootClear])
787+ , eventEnvRootClears :: !(IORef [Some RootClear])
788 , eventEnvCurrentHeight :: !(IORef Height) -- Needed for Subscribe
788 , eventEnvCurrentHeight :: !(IORef Height) -- Needed for Subscribe
789 , eventEnvResetCoincidences :: !(IORef [SomeResetCoincidence x]) -- Needed for Subscribe
789 , eventEnvResetCoincidences :: !(IORef [SomeResetCoincidence x]) -- Needed for Subscribe
790 , eventEnvDelayedMerges :: !(IORef (IntMap [EventM x ()]))
790 , eventEnvDelayedMerges :: !(IORef (IntMap [EventM x ()]))
@@ -856,29 +856,29 @@ putCurrentHeight h = do
856 heightRef <- asksEventEnv eventEnvCurrentHeight
856 heightRef <- asksEventEnv eventEnvCurrentHeight
857 liftIO $ writeIORef heightRef $! h
857 liftIO $ writeIORef heightRef $! h
858
858
859−instance HasSpiderTimeline x => Defer SomeClear (EventM x) where
859+instance HasSpiderTimeline x => Defer (Some Clear) (EventM x) where
860 {-# INLINE getDeferralQueue #-}
860 {-# INLINE getDeferralQueue #-}
861 getDeferralQueue = asksEventEnv eventEnvClears
861 getDeferralQueue = asksEventEnv eventEnvClears
862
862
863{-# INLINE scheduleClear #-}
863{-# INLINE scheduleClear #-}
864−scheduleClear :: Defer SomeClear m => IORef (Maybe a) -> m ()
864+scheduleClear :: Defer (Some Clear) m => IORef (Maybe a) -> m ()
865−scheduleClear r = defer $ SomeClear r
865+scheduleClear r = defer $ Some.This $ Clear r
866
866
867−instance HasSpiderTimeline x => Defer SomeIntClear (EventM x) where
867+instance HasSpiderTimeline x => Defer (Some IntClear) (EventM x) where
868 {-# INLINE getDeferralQueue #-}
868 {-# INLINE getDeferralQueue #-}
869 getDeferralQueue = asksEventEnv eventEnvIntClears
869 getDeferralQueue = asksEventEnv eventEnvIntClears
870
870
871{-# INLINE scheduleIntClear #-}
871{-# INLINE scheduleIntClear #-}
872−scheduleIntClear :: Defer SomeIntClear m => IORef (IntMap a) -> m ()
872+scheduleIntClear :: Defer (Some IntClear) m => IORef (IntMap a) -> m ()
873−scheduleIntClear r = defer $ SomeIntClear r
873+scheduleIntClear r = defer $ Some.This $ IntClear r
874
874
875−instance HasSpiderTimeline x => Defer SomeRootClear (EventM x) where
875+instance HasSpiderTimeline x => Defer (Some RootClear) (EventM x) where
876 {-# INLINE getDeferralQueue #-}
876 {-# INLINE getDeferralQueue #-}
877 getDeferralQueue = asksEventEnv eventEnvRootClears
877 getDeferralQueue = asksEventEnv eventEnvRootClears
878
878
879{-# INLINE scheduleRootClear #-}
879{-# INLINE scheduleRootClear #-}
880−scheduleRootClear :: Defer SomeRootClear m => IORef (DMap k Identity) -> m ()
880+scheduleRootClear :: Defer (Some RootClear) m => IORef (DMap k Identity) -> m ()
881−scheduleRootClear r = defer $ SomeRootClear r
881+scheduleRootClear r = defer $ Some.This $ RootClear r
882
882
883instance HasSpiderTimeline x => Defer (SomeResetCoincidence x) (EventM x) where
883instance HasSpiderTimeline x => Defer (SomeResetCoincidence x) (EventM x) where
884 {-# INLINE getDeferralQueue #-}
884 {-# INLINE getDeferralQueue #-}
@@ -951,7 +951,7 @@ data BehaviorSubscribed x a
951 = forall p. BehaviorSubscribedHold (Hold x p)
951 = forall p. BehaviorSubscribedHold (Hold x p)
952 | BehaviorSubscribedPull (PullSubscribed x a)
952 | BehaviorSubscribedPull (PullSubscribed x a)
953
953
954−data SomeBehaviorSubscribed x = forall a. SomeBehaviorSubscribed (BehaviorSubscribed x a)
954+newtype SomeBehaviorSubscribed x = SomeBehaviorSubscribed (Some (BehaviorSubscribed x))
955
955
956--type role PullSubscribed representational
956--type role PullSubscribed representational
957data PullSubscribed x a
957data PullSubscribed x a
@@ -1259,11 +1259,11 @@ scheduleMerge' initialHeight heightRef a = scheduleMerge initialHeight $ do
1259 GT -> scheduleMerge' height heightRef a -- The height has been increased (by a coincidence event; TODO: is this the only way?)
1259 GT -> scheduleMerge' height heightRef a -- The height has been increased (by a coincidence event; TODO: is this the only way?)
1260 EQ -> a
1260 EQ -> a
1261
1261
1262−data SomeClear = forall a. SomeClear {-# UNPACK #-} !(IORef (Maybe a))
1262+newtype Clear a = Clear (IORef (Maybe a))
1263
1263
1264−data SomeIntClear = forall a. SomeIntClear {-# UNPACK #-} !(IORef (IntMap a))
1264+newtype IntClear a = IntClear (IORef (IntMap a))
1265
1265
1266−data SomeRootClear = forall k. SomeRootClear {-# UNPACK #-} !(IORef (DMap k Identity))
1266+newtype RootClear k = RootClear (IORef (DMap k Identity))
1267
1267
1268data SomeAssignment x = forall a. SomeAssignment {-# UNPACK #-} !(IORef a) {-# UNPACK #-} !(IORef [Weak (Invalidator x)]) a
1268data SomeAssignment x = forall a. SomeAssignment {-# UNPACK #-} !(IORef a) {-# UNPACK #-} !(IORef [Weak (Invalidator x)]) a
1269
1269
@@ -2096,11 +2096,11 @@ runFrame a = SpiderHost $ do
2096 return result
2096 return result
2097 result <- runEventM go
2097 result <- runEventM go
2098 toClear <- readIORef $ eventEnvClears env
2098 toClear <- readIORef $ eventEnvClears env
2099− forM_ toClear $ \(SomeClear ref) -> {-# SCC "clear" #-} writeIORef ref Nothing
2099+ forM_ toClear $ \(Some.This (Clear ref)) -> {-# SCC "clear" #-} writeIORef ref Nothing
2100 toClearInt <- readIORef $ eventEnvIntClears env
2100 toClearInt <- readIORef $ eventEnvIntClears env
2101− forM_ toClearInt $ \(SomeIntClear ref) -> {-# SCC "intClear" #-} writeIORef ref $! IntMap.empty
2101+ forM_ toClearInt $ \(Some.This (IntClear ref)) -> {-# SCC "intClear" #-} writeIORef ref $! IntMap.empty
2102 toClearRoot <- readIORef $ eventEnvRootClears env
2102 toClearRoot <- readIORef $ eventEnvRootClears env
2103− forM_ toClearRoot $ \(SomeRootClear ref) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty
2103+ forM_ toClearRoot $ \(Some.This (RootClear ref)) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty
2104 toAssign <- readIORef $ eventEnvAssignments env
2104 toAssign <- readIORef $ eventEnvAssignments env
2105 toReconnectRef <- newIORef []
2105 toReconnectRef <- newIORef []
2106 coincidenceInfos <- readIORef $ eventEnvResetCoincidences env
2106 coincidenceInfos <- readIORef $ eventEnvResetCoincidences env