git.iko.soy/reflex
on develop help sign in
Merge fixes to benchmark code to ensure the newer versions work
commitcbd54ea42e9c512a4040dc275bca9974fdc1a14f authorSamuel May <ag.eitilt@gmail.com> dateSat 30 Dec 2017, 10:21 (9 years ago) parenta49c43c
2 files changed+12−9
compare with develop
unifiedsplit
bench/Main.hs+9−7 test/Reflex/Plan/Reflex.hs+3−2
bench/Main.hs+9−7
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE BangPatterns #-}
23{-# LANGUAGE TupleSections #-}
34{-# LANGUAGE ScopedTypeVariables #-}
@@ -7,6 +8,7 @@ module Main where
78import Data.Functor.Misc
89import Control.Monad.Primitive
910import Control.Monad.IO.Class
11+import Control.Monad.Identity
1012import Data.Dependent.Sum
1113import Control.Concurrent.STM
1214import Control.Applicative
@@ -21,8 +23,6 @@ import System.Mem
2123import System.IO
2224import Criterion.Main
2325
24−import qualified Data.Traversable as T
25−
2626import qualified Data.Dependent.Map as DM
2727
2828
@@ -30,8 +30,10 @@ main :: IO ()
3030main = defaultMain
3131 [ bgroup "micro" micros ]
3232
33+#if !(MIN_VERSION_deepseq(1,4,2))
3334instance NFData (IORef a) where
3435 rnf x = seq x ()
36+#endif
3537
3638instance NFData (TVar a) where
3739 rnf x = seq x ()
@@ -73,7 +75,7 @@ micros =
7375 (newEventWithTriggerRef >>= subscribePair)
7476 (\(subd, trigger) -> do
7577 Just key <- liftIO $ readIORef trigger
76− fireEvents [key :=> (42 :: Int)])
78+ fireEvents [key :=> Identity (42 :: Int)])
7779 , withSetupWHNF "fireEventsAndRead(head/merge1)"
7880 (setupMerge 1 >>= subscribePair)
7981 (\(subd, t:riggers) -> fireAndRead t (42 :: Int) subd)
@@ -87,17 +89,17 @@ micros =
8789 (setupMerge 100 >>= subscribePair)
8890 (\(subd, t:riggers) -> do
8991 Just key <- liftIO $ readIORef t
90− fireEvents [key :=> (42 :: Int)])
92+ fireEvents [key :=> Identity (42 :: Int)])
9193 , withSetupWHNF "hold" newEventWithTriggerRef $ \(ev,trigger) -> hold (42 :: Int) ev
9294 , withSetupWHNF "sample" (newEventWithTriggerRef >>= hold (42 :: Int) . fst) sample
9395 ]
9496
9597setupMerge :: Int
96− -> SpiderHost (Event Spider (DM.DMap (Const2 Int a)),
98+ -> SpiderHost (Event Spider (DM.DMap (Const2 Int a) Identity),
9799 [IORef (Maybe (EventTrigger Spider a))])
98100setupMerge num = do
99101 (evs, triggers) <- unzip <$> replicateM 100 newEventWithTriggerRef
100− let !m = DM.fromList [WrapArg (Const2 i) :=> v | (i,v) <- zip [0..] evs]
102+ let !m = DM.fromList [(Const2 i) :=> v | (i,v) <- zip [0..] evs]
101103 pure (merge m, triggers)
102104
103105subscribePair :: (Event Spider a, b) -> SpiderHost (EventHandle Spider a, b)
@@ -107,4 +109,4 @@ fireAndRead :: IORef (Maybe (EventTrigger Spider a)) -> a -> EventHandle Spider
107109 -> SpiderHost (Maybe b)
108110fireAndRead trigger val subd = do
109111 Just key <- liftIO $ readIORef trigger
110− fireEventsAndRead [key :=> val] $ readEvent subd >>= T.sequence
112+ fireEventsAndRead [key :=> Identity val] $ readEvent subd >>= sequence
test/Reflex/Plan/Reflex.hs+3−2
@@ -24,6 +24,7 @@ import Reflex.TestPlan
2424
2525import Control.Applicative
2626import Control.Monad
27+import Control.Monad.Identity
2728import Control.Monad.State.Strict
2829
2930import Data.Dependent.Sum (DSum (..))
@@ -71,8 +72,8 @@ instance (ReflexHost t, MonadRef (HostFrame t), Ref (HostFrame t) ~ Ref IO) => T
7172 makeFiring ref (t, a) = (fromIntegral t, [Firing ref a])
7273
7374
74−firingTrigger :: (MonadReflexHost t m, MonadIORef m) => Firing t -> m (Maybe (DSum (EventTrigger t)))
75−firingTrigger (Firing ref a) = fmap (:=> a) <$> readRef ref
75+firingTrigger :: (MonadReflexHost t m, MonadIORef m) => Firing t -> m (Maybe (DSum (EventTrigger t) Identity))
76+firingTrigger (Firing ref a) = fmap (:=> Identity a) <$> readRef ref
7677
7778runPlan :: (MonadReflexHost t m, MonadIORef m) => Plan t a -> m (a, Schedule t)
7879runPlan (Plan p) = runHostFrame $ runStateT p mempty