git.iko.soy/reflex
on develop help sign in
Merge fixes to benchmark code to ensure the newer versions work
cbd54eaSamuel May
bench/Main.hs+9−7
compare with develop
unifiedsplit
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE TupleSections #-}
3{-# LANGUAGE TupleSections #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE ScopedTypeVariables #-}
@@ -7,6 +8,7 @@ module Main where
7import Data.Functor.Misc
8import Data.Functor.Misc
8import Control.Monad.Primitive
9import Control.Monad.Primitive
9import Control.Monad.IO.Class
10import Control.Monad.IO.Class
11+import Control.Monad.Identity
10import Data.Dependent.Sum
12import Data.Dependent.Sum
11import Control.Concurrent.STM
13import Control.Concurrent.STM
12import Control.Applicative
14import Control.Applicative
@@ -21,8 +23,6 @@ import System.Mem
21import System.IO
23import System.IO
22import Criterion.Main
24import Criterion.Main
23
25
24−import qualified Data.Traversable as T
25−
26import qualified Data.Dependent.Map as DM
26import qualified Data.Dependent.Map as DM
27
27
28
28
@@ -30,8 +30,10 @@ main :: IO ()
30main = defaultMain
30main = defaultMain
31 [ bgroup "micro" micros ]
31 [ bgroup "micro" micros ]
32
32
33+#if !(MIN_VERSION_deepseq(1,4,2))
33instance NFData (IORef a) where
34instance NFData (IORef a) where
34 rnf x = seq x ()
35 rnf x = seq x ()
36+#endif
35
37
36instance NFData (TVar a) where
38instance NFData (TVar a) where
37 rnf x = seq x ()
39 rnf x = seq x ()
@@ -73,7 +75,7 @@ micros =
73 (newEventWithTriggerRef >>= subscribePair)
75 (newEventWithTriggerRef >>= subscribePair)
74 (\(subd, trigger) -> do
76 (\(subd, trigger) -> do
75 Just key <- liftIO $ readIORef trigger
77 Just key <- liftIO $ readIORef trigger
76− fireEvents [key :=> (42 :: Int)])
78+ fireEvents [key :=> Identity (42 :: Int)])
77 , withSetupWHNF "fireEventsAndRead(head/merge1)"
79 , withSetupWHNF "fireEventsAndRead(head/merge1)"
78 (setupMerge 1 >>= subscribePair)
80 (setupMerge 1 >>= subscribePair)
79 (\(subd, t:riggers) -> fireAndRead t (42 :: Int) subd)
81 (\(subd, t:riggers) -> fireAndRead t (42 :: Int) subd)
@@ -87,17 +89,17 @@ micros =
87 (setupMerge 100 >>= subscribePair)
89 (setupMerge 100 >>= subscribePair)
88 (\(subd, t:riggers) -> do
90 (\(subd, t:riggers) -> do
89 Just key <- liftIO $ readIORef t
91 Just key <- liftIO $ readIORef t
90− fireEvents [key :=> (42 :: Int)])
92+ fireEvents [key :=> Identity (42 :: Int)])
91 , withSetupWHNF "hold" newEventWithTriggerRef $ \(ev,trigger) -> hold (42 :: Int) ev
93 , withSetupWHNF "hold" newEventWithTriggerRef $ \(ev,trigger) -> hold (42 :: Int) ev
92 , withSetupWHNF "sample" (newEventWithTriggerRef >>= hold (42 :: Int) . fst) sample
94 , withSetupWHNF "sample" (newEventWithTriggerRef >>= hold (42 :: Int) . fst) sample
93 ]
95 ]
94
96
95setupMerge :: Int
97setupMerge :: Int
96− -> SpiderHost (Event Spider (DM.DMap (Const2 Int a)),
98+ -> SpiderHost (Event Spider (DM.DMap (Const2 Int a) Identity),
97 [IORef (Maybe (EventTrigger Spider a))])
99 [IORef (Maybe (EventTrigger Spider a))])
98setupMerge num = do
100setupMerge num = do
99 (evs, triggers) <- unzip <$> replicateM 100 newEventWithTriggerRef
101 (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]
101 pure (merge m, triggers)
103 pure (merge m, triggers)
102
104
103subscribePair :: (Event Spider a, b) -> SpiderHost (EventHandle Spider a, b)
105subscribePair :: (Event Spider a, b) -> SpiderHost (EventHandle Spider a, b)
@@ -107,4 +109,4 @@ fireAndRead :: IORef (Maybe (EventTrigger Spider a)) -> a -> EventHandle Spider
107 -> SpiderHost (Maybe b)
109 -> SpiderHost (Maybe b)
108fireAndRead trigger val subd = do
110fireAndRead trigger val subd = do
109 Just key <- liftIO $ readIORef trigger
111 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
24
24
25import Control.Applicative
25import Control.Applicative
26import Control.Monad
26import Control.Monad
27+import Control.Monad.Identity
27import Control.Monad.State.Strict
28import Control.Monad.State.Strict
28
29
29import Data.Dependent.Sum (DSum (..))
30import Data.Dependent.Sum (DSum (..))
@@ -71,8 +72,8 @@ instance (ReflexHost t, MonadRef (HostFrame t), Ref (HostFrame t) ~ Ref IO) => T
71 makeFiring ref (t, a) = (fromIntegral t, [Firing ref a])
72 makeFiring ref (t, a) = (fromIntegral t, [Firing ref a])
72
73
73
74
74−firingTrigger :: (MonadReflexHost t m, MonadIORef m) => Firing t -> m (Maybe (DSum (EventTrigger t)))
75+firingTrigger :: (MonadReflexHost t m, MonadIORef m) => Firing t -> m (Maybe (DSum (EventTrigger t) Identity))
75−firingTrigger (Firing ref a) = fmap (:=> a) <$> readRef ref
76+firingTrigger (Firing ref a) = fmap (:=> Identity a) <$> readRef ref
76
77
77runPlan :: (MonadReflexHost t m, MonadIORef m) => Plan t a -> m (a, Schedule t)
78runPlan :: (MonadReflexHost t m, MonadIORef m) => Plan t a -> m (a, Schedule t)
78runPlan (Plan p) = runHostFrame $ runStateT p mempty
79runPlan (Plan p) = runHostFrame $ runStateT p mempty