e6142cd · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Some slight performance improvements.

e6142cdCale Gibbard11 years ago

src/Reflex/Class.hs+1−1

compare with develop

unifiedsplit

@@ -322,7 +322,7 @@ instance (Semigroup a, Reflex t) => Monoid (Event t a) where

322mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a

323mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)

324 . merge

325− . DMap.fromAscList

325+ . DMap.fromDistinctAscList

326 . map (\(k, v) -> (Const2 k) :=> v)

327 $ zip [0 :: Int ..] es

328

src/Reflex/Spider/Internal.hs+6−5

@@ -22,6 +22,7 @@ import qualified Data.IntMap as IntMap

22import Control.Monad.Ref

23import Control.Monad.Exception

24import Data.Monoid ((<>))

25+import Data.Coerce

26import System.IO.Unsafe

27import System.IO.Unsafe

27import Unsafe.Coerce

28import Unsafe.Coerce

@@ -733,7 +734,7 @@ readBehaviorTracked b = case b of

733

734

734readEvent :: Event a -> ResultM (Maybe a)

735readEvent :: Event a -> ResultM (Maybe a)

735readEvent e = case e of

736readEvent e = case e of

736− EventRoot k r -> liftIO . liftM (fmap runIdentity . DMap.lookup k) . readIORef $ rootOccurrence r

737+ EventRoot k r -> liftIO . liftM (coerce . DMap.lookup k) . readIORef $ rootOccurrence r

737 EventNever -> return Nothing

738 EventNever -> return Nothing

738 EventPush p -> do

739 EventPush p -> do

739 subscribed <- getPushSubscribed p

740 subscribed <- getPushSubscribed p

@@ -749,7 +750,7 @@ readEvent e = case e of

749 return result

750 return result

750 EventFan k f -> do

751 EventFan k f -> do

751 parentOcc <- readEvent $ fanParent f

752 parentOcc <- readEvent $ fanParent f

752− return . fmap runIdentity $ DMap.lookup k =<< parentOcc

753+ return . coerce $ DMap.lookup k =<< parentOcc

753 EventSwitch s -> do

754 EventSwitch s -> do

754 subscribed <- getSwitchSubscribed s

755 subscribed <- getSwitchSubscribed s

755 liftIO $ do

756 liftIO $ do

@@ -814,7 +815,7 @@ getEventSubscribedOcc es = case es of

814 EventSubscribedPush subscribed -> readIORef $ pushSubscribedOccurrence subscribed

815 EventSubscribedPush subscribed -> readIORef $ pushSubscribedOccurrence subscribed

815 EventSubscribedFan k subscribed -> do

816 EventSubscribedFan k subscribed -> do

816 parentOcc <- getEventSubscribedOcc $ fanSubscribedParent subscribed

817 parentOcc <- getEventSubscribedOcc $ fanSubscribedParent subscribed

817− let occ = fmap runIdentity $ DMap.lookup k =<< parentOcc

818+ let occ = coerce $ DMap.lookup k =<< parentOcc

818 return occ

819 return occ

819 EventSubscribedMerge subscribed -> readIORef $ mergeSubscribedOccurrence subscribed

820 EventSubscribedMerge subscribed -> readIORef $ mergeSubscribedOccurrence subscribed

820 EventSubscribedSwitch subscribed -> readIORef $ switchSubscribedOccurrence subscribed

821 EventSubscribedSwitch subscribed -> readIORef $ switchSubscribedOccurrence subscribed

@@ -847,7 +848,7 @@ getRootSubscribed k r = do

847 Just subscribed -> return subscribed

848 Just subscribed -> return subscribed

848 Nothing -> liftIO $ do

849 Nothing -> liftIO $ do

849 subscribersRef <- newIORef []

850 subscribersRef <- newIORef []

850− subscribed <- newRootSubscribed (liftM (fmap runIdentity . DMap.lookup k) $ readIORef $ rootOccurrence r) subscribersRef

851+ subscribed <- newRootSubscribed (liftM (coerce . DMap.lookup k) $ readIORef $ rootOccurrence r) subscribersRef

851 -- Strangely, init needs the same stuff as a RootSubscribed has, but it must not be the same as the one that everyone's subscribing to, or it'll leak memory

852 -- Strangely, init needs the same stuff as a RootSubscribed has, but it must not be the same as the one that everyone's subscribing to, or it'll leak memory

852 uninit <- rootInit r k $ RootTrigger (subscribersRef, rootOccurrence r, k)

853 uninit <- rootInit r k $ RootTrigger (subscribersRef, rootOccurrence r, k)

853 addFinalizer subscribed $ do

854 addFinalizer subscribed $ do

@@ -900,7 +901,7 @@ getMergeSubscribed m = {-# SCC "getMergeSubscribed.entire" #-} do

900 parentSubd <- {-# SCC "getMergeSubscribed.a.parentSubd" #-} subscribe e $ WeakSubscriberMerge k ws

901 parentSubd <- {-# SCC "getMergeSubscribed.a.parentSubd" #-} subscribe e $ WeakSubscriberMerge k ws

901 parentOcc <- {-# SCC "getMergeSubscribed.a.parentOcc" #-} liftIO $ getEventSubscribedOcc parentSubd

902 parentOcc <- {-# SCC "getMergeSubscribed.a.parentOcc" #-} liftIO $ getEventSubscribedOcc parentSubd

902 height <- {-# SCC "getMergeSubscribed.a.height" #-} liftIO $ readIORef $ eventSubscribedHeightRef parentSubd

903 height <- {-# SCC "getMergeSubscribed.a.height" #-} liftIO $ readIORef $ eventSubscribedHeightRef parentSubd

903− return $ {-# SCC "getMergeSubscribed.a.returnVal" #-} (unsafeCoerce s :: Any, fmap ((k :=>) . Identity) parentOcc, height, k :=> parentSubd)

904+ return $ {-# SCC "getMergeSubscribed.a.returnVal" #-} (unsafeCoerce s :: Any, fmap (\x -> k :=> Identity x) parentOcc, height, k :=> parentSubd)

904 let dm = DMap.fromDistinctAscList $ catMaybes $ map (\(_, x, _, _) -> x) subscribers

905 let dm = DMap.fromDistinctAscList $ catMaybes $ map (\(_, x, _, _) -> x) subscribers

905 subscriberHeights = map (\(_, _, x, _) -> x) subscribers

906 subscriberHeights = map (\(_, _, x, _) -> x) subscribers

906 myHeight =

907 myHeight =