68a75c8 · reflex · git.iko.soy

git.iko.soy/reflex

Improve specialization

commit68a75c8142a24db0fe6fa5e0adae487079912e63 authorRyan Trinkle <ryan.trinkle@gmail.com> dateTue 5 Sep 2017, 14:15 (9 years ago) parent6f255aa

4 files changed+31−22

compare with develop

unifiedsplit

reflex.cabal+1−1 src/Reflex/Class.hs+17−1 src/Reflex/Spider/Internal.hs+7−19 src/Reflex/Spider/SpiderTimeline.include.hs+6−1

reflex.cabal+1−1

@@ -105,7 +105,7 @@ library

105105 Reflex.Spider.Internal,

106106 Reflex.Widget.Basic

107107

108− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

108+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -fspecialise-aggressively -ddump-simpl -ddump-to-file -dsuppress-coercions -dsuppress-idinfo

109109 ghc-prof-options: -fprof-auto

110110

111111 if flag(specialize-to-spidertimeline-global)

src/Reflex/Class.hs+17−1

@@ -638,6 +638,8 @@ instance Reflex t => Bind (Event t) where

638638instance Reflex t => Functor (Event t) where

639639 {-# INLINE fmap #-}

640640 fmap f = fmapMaybe $ Just . f

641+ {-# INLINE (<$) #-}

642+ x <$ e = fmapCheap (const x) e

641643

642644instance Reflex t => FunctorMaybe (Event t) where

643645 {-# INLINE fmapMaybe #-}

@@ -956,12 +958,16 @@ mapAccumMaybeMDyn f z e = do

956958 d' <- holdDyn z $ fmapMaybe fst e'

957959 return (d', fmapMaybe snd e')

958960

961+{-# INLINE accumB #-}

959962accumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Behavior t a)

960963accumB f = accumMaybeB $ \v o -> Just $ f v o

964+{-# INLINE accumMB #-}

961965accumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Behavior t a)

962966accumMB f = accumMaybeMB $ \v o -> Just <$> f v o

967+{-# INLINE accumMaybeB #-}

963968accumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Behavior t a)

964969accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o

970+{-# INLINE accumMaybeMB #-}

965971accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)

966972accumMaybeMB f z e = do

967973 rec let e' = flip push e $ \o -> do

@@ -969,14 +975,17 @@ accumMaybeMB f z e = do

969975 f v o

970976 d' <- hold z e'

971977 return d'

978+{-# INLINE mapAccumB #-}

972979mapAccumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)

973980mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o

981+{-# INLINE mapAccumMB #-}

974982mapAccumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)

975983mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o

984+{-# INLINE mapAccumMaybeB #-}

976985mapAccumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)

977986mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o

978987

979−{-# INLINABLE mapAccumMaybeMB #-}

988+{-# INLINE mapAccumMaybeMB #-}

980989mapAccumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)

981990mapAccumMaybeMB f z e = do

982991 rec let e' = flip push e $ \o -> do

@@ -990,6 +999,7 @@ mapAccumMaybeMB f z e = do

990999

9911000-- | Accumulate occurrences of an 'Event', producing an output occurrence each

9921001-- time. Discard the underlying 'Accumulator'.

1002+{-# INLINE mapAccum_ #-}

9931003mapAccum_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)

9941004mapAccum_ f z e = do

9951005 (_, result) <- mapAccumB f z e

@@ -997,6 +1007,7 @@ mapAccum_ f z e = do

9971007

9981008-- | Accumulate occurrences of an 'Event', possibly producing an output

9991009-- occurrence each time. Discard the underlying 'Accumulator'.

1010+{-# INLINE mapAccumMaybe_ #-}

10001011mapAccumMaybe_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)

10011012mapAccumMaybe_ f z e = do

10021013 (_, result) <- mapAccumMaybeB f z e

@@ -1004,6 +1015,7 @@ mapAccumMaybe_ f z e = do

10041015

10051016-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing

10061017-- an output occurrence each time. Discard the underlying 'Accumulator'.

1018+{-# INLINE mapAccumM_ #-}

10071019mapAccumM_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)

10081020mapAccumM_ f z e = do

10091021 (_, result) <- mapAccumMB f z e

@@ -1012,6 +1024,7 @@ mapAccumM_ f z e = do

10121024-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly

10131025-- producing an output occurrence each time. Discard the underlying

10141026-- 'Accumulator'.

1027+{-# INLINE mapAccumMaybeM_ #-}

10151028mapAccumMaybeM_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)

10161029mapAccumMaybeM_ f z e = do

10171030 (_, result) <- mapAccumMaybeMB f z e

@@ -1040,14 +1053,17 @@ zipListWithEvent f l e = do

10401053 mapAccumMaybe_ f' l e

10411054

10421055-- | Assign a number to each occurence of the given 'Event', starting from 0

1056+{-# INLINE numberOccurrences #-}

10431057numberOccurrences :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Event t (b, a))

10441058numberOccurrences = numberOccurrencesFrom 0

10451059

10461060-- | Assign a number to each occurence of the given 'Event'

1061+{-# INLINE numberOccurrencesFrom #-}

10471062numberOccurrencesFrom :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t (b, a))

10481063numberOccurrencesFrom = mapAccum_ (\n a -> (n + 1, (n, a)))

10491064

10501065-- | Assign a number to each occurence of the given 'Event'; discard the occurrences' values

1066+{-# INLINE numberOccurrencesFrom_ #-}

10511067numberOccurrencesFrom_ :: (Reflex t, MonadHold t m, MonadFix m, Num b) => b -> Event t a -> m (Event t b)

10521068numberOccurrencesFrom_ = mapAccum_ (\n _ -> (n + 1, n))

10531069

src/Reflex/Spider/Internal.hs+7−19

@@ -395,7 +395,7 @@ eventDyn :: (HasSpiderTimeline x, Patch p) => Dyn x p -> Event x p

395395eventDyn !j = Event $ \sub -> getDynHold j >>= \h -> subscribeHoldEvent h sub

396396

397397{-# INLINE subscribeCoincidenceInner #-}

398−subscribeCoincidenceInner :: CanSubscribe x m => Event x a -> Height -> CoincidenceSubscribed x a -> m (Maybe a, Height, EventSubscribed x)

398+subscribeCoincidenceInner :: HasSpiderTimeline x => Event x a -> Height -> CoincidenceSubscribed x a -> EventM x (Maybe a, Height, EventSubscribed x)

399399subscribeCoincidenceInner inner outerHeight subscribedUnsafe = do

400400 subInner <- liftIO $ newSubscriberCoincidenceInner subscribedUnsafe

401401 (subscription@(EventSubscription _ innerSubd), innerOcc) <- subscribeAndRead inner subInner

@@ -645,7 +645,7 @@ walkInvalidHeightParents s0 = do

645645#endif

646646

647647{-# INLINE subscribeHoldEvent #-}

648−subscribeHoldEvent :: CanSubscribe x m => Hold x p -> Subscriber x p -> m (EventSubscription x, Maybe p)

648+subscribeHoldEvent :: HasSpiderTimeline x => Hold x p -> Subscriber x p -> EventM x (EventSubscription x, Maybe p)

649649subscribeHoldEvent = subscribeAndRead . holdEvent

650650

651651--------------------------------------------------------------------------------

@@ -929,7 +929,7 @@ hold v0 e = do

929929 return h

930930

931931{-# INLINE getHoldEventSubscription #-}

932−getHoldEventSubscription :: forall m p x. (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer SomeClear m, Patch p, HasCurrentHeight x m, Defer (SomeMergeInit x) m, Defer (SomeResetCoincidence x) m, HasSpiderTimeline x, m ~ EventM x) => Hold x p -> m (EventSubscription x)

932+getHoldEventSubscription :: forall p x. (HasSpiderTimeline x, Patch p) => Hold x p -> EventM x (EventSubscription x)

933933getHoldEventSubscription h = do

934934 ep <- liftIO $ readIORef $ holdParent h

935935 case ep of

@@ -1409,17 +1409,6 @@ getDynHold d = do

14091409zeroRef :: IORef Height

14101410zeroRef = unsafePerformIO $ newIORef zeroHeight

14111411

1412−type CanSubscribe x m =

1413− ( HasSpiderTimeline x

1414− , HasCurrentHeight x m

1415− , Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m -- The things we need to lazily initialize state

1416− , Defer SomeClear m -- Wiping out event firings

1417− , Defer SomeIntClear m

1418− , Defer (SomeAssignment x) m -- Updating state

1419− , Defer (SomeResetCoincidence x) m

1420− , m ~ EventM x

1421− )

1422−

14231412getRootSubscribed :: GCompare k => k a -> Root x k -> Subscriber x a -> IO (WeakBagTicket, RootSubscribed x a, Maybe a)

14241413getRootSubscribed k r sub = do

14251414 mSubscribed <- readIORef $ rootSubscribed r

@@ -1500,7 +1489,6 @@ unsafeNewFanInt b = unsafePerformIO $ do

15001489 touch b

15011490 newFanInt

15021491

1503−{-# NOINLINE fanInt #-}

15041492fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a

15051493fanInt p =

15061494 let self = unsafeNewFanInt p

@@ -1511,7 +1499,7 @@ fanInt p =

15111499 { subscriberPropagate = \m -> do

15121500 liftIO $ writeIORef (_fanInt_occRef self) m

15131501 scheduleIntClear $ _fanInt_occRef self

1514− FastMutableIntMap.forIntersectionWithImmutable_ (_fanInt_subscribers self) m $ \b v -> do

1502+ FastMutableIntMap.forIntersectionWithImmutable_ (_fanInt_subscribers self) m $ \b v -> do --TODO: Do we need to know that no subscribers are being added as we traverse?

15151503 FastWeakBag.traverse b $ \s -> do

15161504 subscriberPropagate s v

15171505 , subscriberInvalidateHeight = \old -> do

@@ -1540,7 +1528,7 @@ fanInt p =

15401528 return (EventSubscription (FastWeakBag.remove t) $! EventSubscribed heightRef $! toAny (_fanInt_subscriptionRef self, t), IntMap.lookup k currentOcc)

15411529

15421530{-# INLINABLE getFanSubscribed #-}

1543−getFanSubscribed :: (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, HasCurrentHeight x m, Defer (SomeResetCoincidence x) m, HasSpiderTimeline x, m ~ EventM x, GCompare k) => k a -> Fan x k -> Subscriber x a -> m (WeakBagTicket, FanSubscribed x k, Maybe a)

1531+getFanSubscribed :: (HasSpiderTimeline x, GCompare k) => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket, FanSubscribed x k, Maybe a)

15441532getFanSubscribed k f sub = do

15451533 mSubscribed <- liftIO $ readIORef $ fanSubscribed f

15461534 case mSubscribed of

@@ -1599,7 +1587,7 @@ subscribeFanSubscribed k subscribed sub = do

15991587 Just (FanSubscribedChildren list _ weakSelf) -> {-# SCC "hitSubscribeFanSubscribed" #-} WeakBag.insert sub list weakSelf cleanupFanSubscribed

16001588

16011589{-# INLINABLE getSwitchSubscribed #-}

1602−getSwitchSubscribed :: (Defer (SomeHoldInit x) m, Defer (SomeAssignment x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, Defer (SomeResetCoincidence x) m, HasCurrentHeight x m, HasSpiderTimeline x, m ~ EventM x) => Switch x a -> Subscriber x a -> m (WeakBagTicket, SwitchSubscribed x a, Maybe a)

1590+getSwitchSubscribed :: HasSpiderTimeline x => Switch x a -> Subscriber x a -> EventM x (WeakBagTicket, SwitchSubscribed x a, Maybe a)

16031591getSwitchSubscribed s sub = do

16041592 mSubscribed <- liftIO $ readIORef $ switchSubscribed s

16051593 case mSubscribed of

@@ -1655,7 +1643,7 @@ subscribeSwitchSubscribed :: SwitchSubscribed x a -> Subscriber x a -> IO WeakBa

16551643subscribeSwitchSubscribed subscribed sub = WeakBag.insert sub (switchSubscribedSubscribers subscribed) (switchSubscribedWeakSelf subscribed) cleanupSwitchSubscribed

16561644

16571645{-# INLINABLE getCoincidenceSubscribed #-}

1658−getCoincidenceSubscribed :: forall x a m. (Defer (SomeAssignment x) m, Defer (SomeHoldInit x) m, Defer (SomeMergeInit x) m, Defer SomeClear m, HasCurrentHeight x m, Defer (SomeResetCoincidence x) m, HasSpiderTimeline x, m ~ EventM x) => Coincidence x a -> Subscriber x a -> m (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)

1646+getCoincidenceSubscribed :: forall x a. HasSpiderTimeline x => Coincidence x a -> Subscriber x a -> EventM x (WeakBagTicket, CoincidenceSubscribed x a, Maybe a)

16591647getCoincidenceSubscribed c sub = do

16601648 mSubscribed <- liftIO $ readIORef $ coincidenceSubscribed c

16611649 case mSubscribed of

src/Reflex/Spider/SpiderTimeline.include.hs+6−1

@@ -57,6 +57,7 @@ instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x))

5757 {-# INLINE fail #-}

5858 fail _ = error "Dynamic does not support 'fail'"

5959

60+{-# INLINABLE newJoinDyn #-}

6061newJoinDyn :: HasSpiderTimeline x => Reflex.Spider.Internal.Dynamic x (Identity (Reflex.Spider.Internal.Dynamic x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)

6162newJoinDyn d =

6263 let readV0 = readBehaviorTracked . dynamicCurrent =<< readBehaviorTracked (dynamicCurrent d)

@@ -68,12 +69,16 @@ newJoinDyn d =

6869

6970instance HasSpiderTimeline x => Functor (Reflex.Class.Dynamic (SpiderTimeline x)) where

7071 fmap f = SpiderDynamic . newMapDyn f . unSpiderDynamic

72+ x <$ _ = pure x

7173

7274instance HasSpiderTimeline x => Applicative (Reflex.Class.Dynamic (SpiderTimeline x)) where

7375 pure = SpiderDynamic . dynamicConst

76+#if MIN_VERSION_base(4,10,0)

77+ liftA2 f a b = SpiderDynamic $ Reflex.Spider.Internal.zipDynWith f a b

78+#endif

7479 SpiderDynamic a <*> SpiderDynamic b = SpiderDynamic $ Reflex.Spider.Internal.zipDynWith ($) a b

7580 _ *> b = b

76− a <* _ = a

81+ a <* _ = a --TODO: The semantics of *>, <*, and <$ might not be quite right - they drop changes

7782

7883holdSpiderEventM :: HasSpiderTimeline x => a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Behavior (SpiderTimeline x) a)

7984holdSpiderEventM v0 e = fmap (SpiderBehavior . behaviorHoldIdentity) $ Reflex.Spider.Internal.hold v0 $ coerce $ unSpiderEvent e