on develop help sign in
Merge pull request #304 from kmicklas/some-newtype

Use Some for more existential types (which should be efficient now that it is a newtype)

commit6f61a7cf4c0bc7570c0a25676a2251f74a2d0b0e authorRyan Trinkle <ryan.trinkle@gmail.com> dateTue 30 Apr 2019, 10:49 (7 years ago) parent1b16a5e5c191d7
1 file changed+22−22
src/Reflex/Spider/Internal.hs+22−22
src/Reflex/Spider/Internal.hs+22−22
@@ -659,7 +659,7 @@ behaviorPull !p = Behavior $ do
659659 val <- liftIO $ readIORef $ pullValue p
660660 case val of
661661 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)) :))
663663 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (pullSubscribedInvalidators subscribed) (wi:))
664664 liftIO $ touch $ pullSubscribedOwnInvalidator subscribed
665665 return $ pullSubscribedValue subscribed
@@ -678,7 +678,7 @@ behaviorPull !p = Behavior $ do
678678 , pullSubscribedParents = parents
679679 }
680680 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)) :))
682682 return a
683683
684684behaviorDyn :: Patch p => Dyn x p -> Behavior x (PatchTarget p)
@@ -689,7 +689,7 @@ readHoldTracked :: Hold x p -> BehaviorM x (PatchTarget p)
689689readHoldTracked h = do
690690 result <- liftIO $ readIORef $ holdValue h
691691 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)) :))
693693 liftIO $ touch h -- Otherwise, if this gets inlined enough, the hold's parent reference may get collected
694694 return result
695695
@@ -782,9 +782,9 @@ data EventEnv x
782782 , eventEnvDynInits :: !(IORef [SomeDynInit x])
783783 , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate x])
784784 , eventEnvMergeInits :: !(IORef [SomeMergeInit x]) -- Needed for Subscribe
785− , eventEnvClears :: !(IORef [SomeClear]) -- Needed for Subscribe
786− , eventEnvIntClears :: !(IORef [SomeIntClear])
787− , eventEnvRootClears :: !(IORef [SomeRootClear])
785+ , eventEnvClears :: !(IORef [Some Clear]) -- Needed for Subscribe
786+ , eventEnvIntClears :: !(IORef [Some IntClear])
787+ , eventEnvRootClears :: !(IORef [Some RootClear])
788788 , eventEnvCurrentHeight :: !(IORef Height) -- Needed for Subscribe
789789 , eventEnvResetCoincidences :: !(IORef [SomeResetCoincidence x]) -- Needed for Subscribe
790790 , eventEnvDelayedMerges :: !(IORef (IntMap [EventM x ()]))
@@ -856,29 +856,29 @@ putCurrentHeight h = do
856856 heightRef <- asksEventEnv eventEnvCurrentHeight
857857 liftIO $ writeIORef heightRef $! h
858858
859−instance HasSpiderTimeline x => Defer SomeClear (EventM x) where
859+instance HasSpiderTimeline x => Defer (Some Clear) (EventM x) where
860860 {-# INLINE getDeferralQueue #-}
861861 getDeferralQueue = asksEventEnv eventEnvClears
862862
863863{-# INLINE scheduleClear #-}
864−scheduleClear :: Defer SomeClear m => IORef (Maybe a) -> m ()
865−scheduleClear r = defer $ SomeClear r
864+scheduleClear :: Defer (Some Clear) m => IORef (Maybe a) -> m ()
865+scheduleClear r = defer $ Some.This $ Clear r
866866
867−instance HasSpiderTimeline x => Defer SomeIntClear (EventM x) where
867+instance HasSpiderTimeline x => Defer (Some IntClear) (EventM x) where
868868 {-# INLINE getDeferralQueue #-}
869869 getDeferralQueue = asksEventEnv eventEnvIntClears
870870
871871{-# INLINE scheduleIntClear #-}
872−scheduleIntClear :: Defer SomeIntClear m => IORef (IntMap a) -> m ()
873−scheduleIntClear r = defer $ SomeIntClear r
872+scheduleIntClear :: Defer (Some IntClear) m => IORef (IntMap a) -> m ()
873+scheduleIntClear r = defer $ Some.This $ IntClear r
874874
875−instance HasSpiderTimeline x => Defer SomeRootClear (EventM x) where
875+instance HasSpiderTimeline x => Defer (Some RootClear) (EventM x) where
876876 {-# INLINE getDeferralQueue #-}
877877 getDeferralQueue = asksEventEnv eventEnvRootClears
878878
879879{-# INLINE scheduleRootClear #-}
880−scheduleRootClear :: Defer SomeRootClear m => IORef (DMap k Identity) -> m ()
881−scheduleRootClear r = defer $ SomeRootClear r
880+scheduleRootClear :: Defer (Some RootClear) m => IORef (DMap k Identity) -> m ()
881+scheduleRootClear r = defer $ Some.This $ RootClear r
882882
883883instance HasSpiderTimeline x => Defer (SomeResetCoincidence x) (EventM x) where
884884 {-# INLINE getDeferralQueue #-}
@@ -951,7 +951,7 @@ data BehaviorSubscribed x a
951951 = forall p. BehaviorSubscribedHold (Hold x p)
952952 | BehaviorSubscribedPull (PullSubscribed x a)
953953
954−data SomeBehaviorSubscribed x = forall a. SomeBehaviorSubscribed (BehaviorSubscribed x a)
954+newtype SomeBehaviorSubscribed x = SomeBehaviorSubscribed (Some (BehaviorSubscribed x))
955955
956956--type role PullSubscribed representational
957957data PullSubscribed x a
@@ -1259,11 +1259,11 @@ scheduleMerge' initialHeight heightRef a = scheduleMerge initialHeight $ do
12591259 GT -> scheduleMerge' height heightRef a -- The height has been increased (by a coincidence event; TODO: is this the only way?)
12601260 EQ -> a
12611261
1262−data SomeClear = forall a. SomeClear {-# UNPACK #-} !(IORef (Maybe a))
1262+newtype Clear a = Clear (IORef (Maybe a))
12631263
1264−data SomeIntClear = forall a. SomeIntClear {-# UNPACK #-} !(IORef (IntMap a))
1264+newtype IntClear a = IntClear (IORef (IntMap a))
12651265
1266−data SomeRootClear = forall k. SomeRootClear {-# UNPACK #-} !(IORef (DMap k Identity))
1266+newtype RootClear k = RootClear (IORef (DMap k Identity))
12671267
12681268data SomeAssignment x = forall a. SomeAssignment {-# UNPACK #-} !(IORef a) {-# UNPACK #-} !(IORef [Weak (Invalidator x)]) a
12691269
@@ -2096,11 +2096,11 @@ runFrame a = SpiderHost $ do
20962096 return result
20972097 result <- runEventM go
20982098 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
21002100 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
21022102 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
21042104 toAssign <- readIORef $ eventEnvAssignments env
21052105 toReconnectRef <- newIORef []
21062106 coincidenceInfos <- readIORef $ eventEnvResetCoincidences env