03387bd · reflex · git.iko.soy

git.iko.soy/reflex

on develop help sign in

Fix benchmarks to work on modern GHC.

03387bddavean8 years ago

bench-cbits/checkCapability.c+11−12

compare with develop

unifiedsplit

@@ -42,7 +42,7 @@ typedef struct Task_ {

42 // or just continue immediately. It's a workaround for the fact

43 // that signalling a condition variable doesn't do anything if the

44 // thread is already running, but we want it to be sticky.

45− rtsBool wakeup;

45+ bool wakeup;

46#endif

48 // This points to the Capability that the Task "belongs" to. If

@@ -62,14 +62,14 @@ typedef struct Task_ {

62 // The current top-of-stack InCall

63 struct InCall_ *incall;

65− nat n_spare_incalls;

65+ uint32_t n_spare_incalls;

66 struct InCall_ *spare_incalls;

68− rtsBool worker; // == rtsTrue if this is a worker Task

68+ bool worker; // == rtsTrue if this is a worker Task

69− rtsBool stopped; // this task has stopped or exited Haskell

69+ bool stopped; // this task has stopped or exited Haskell

71 // So that we can detect when a finalizer illegally calls back into Haskell

72− rtsBool running_finalizers;

72+ bool running_finalizers;

74 // Links tasks on the returning_tasks queue of a Capability, and

75 // on spare_workers.

@@ -88,7 +88,7 @@ struct Capability_ {

88 StgFunTable f;

89 StgRegTable r;

91− nat no; // capability number.

91+ uint32_t no; // capability number.

93 // The Task currently holding this Capability. This task has

94 // exclusive access to the contents of this Capability (apart from

@@ -98,12 +98,12 @@ struct Capability_ {

99 // true if this Capability is running Haskell code, used for

100 // catching unsafe call-ins.

101− rtsBool in_haskell;

101+ bool in_haskell;

102

103 // Has there been any activity on this Capability since the last GC?

104− nat idle;

104+ uint32_t idle;

105

106− rtsBool disabled;

106+ bool disabled;

107

108 // The run queue. The Task owning this Capability has exclusive

109 // access to its run queue, so can wake up threads without

@@ -159,7 +159,7 @@ struct Capability_ {

159#if defined(THREADED_RTS)

160 // Worker Tasks waiting in the wings. Singly-linked.

161 Task *spare_workers;

162− nat n_spare_workers; // count of above

162+ uint32_t n_spare_workers; // count of above

163

164 // This lock protects:

165 // running_task

@@ -192,10 +192,9 @@ struct Capability_ {

192

193 // Per-capability STM-related data

194 StgTVarWatchQueue *free_tvar_watch_queues;

195− StgInvariantCheckQueue *free_invariant_check_queues;

196 StgTRecChunk *free_trec_chunks;

195 StgTRecChunk *free_trec_chunks;

197 StgTRecHeader *free_trec_headers;

196 StgTRecHeader *free_trec_headers;

198− nat transaction_tokens;

197+ uint32_t transaction_tokens;

199} // typedef Capability is defined in RtsAPI.h

198} // typedef Capability is defined in RtsAPI.h

200 // We never want a Capability to overlap a cache line with anything

199 // We never want a Capability to overlap a cache line with anything

201 // else, so round it up to a cache line size:

200 // else, so round it up to a cache line size:

bench/Main.hs+7−6

@@ -20,6 +20,7 @@ import qualified Data.Dependent.Map as DMap

20import Data.Dependent.Sum

21import Data.Functor.Misc

22import Data.IORef

23+import Data.Maybe (fromJust)

23import Reflex

24import Reflex

24import Reflex.Host.Class

25import Reflex.Host.Class

@@ -70,7 +71,7 @@ micros =

70 , withSetupWHNF "fireEventsOnly"

71 , withSetupWHNF "fireEventsOnly"

71 (newEventWithTriggerRef >>= subscribePair)

72 (newEventWithTriggerRef >>= subscribePair)

72 (\(_, trigger) -> do

73 (\(_, trigger) -> do

73− Just key <- liftIO $ readIORef trigger

74+ key <- fromJust <$> liftIO (readIORef trigger)

74 fireEvents [key :=> Identity (42 :: Int)])

75 fireEvents [key :=> Identity (42 :: Int)])

75 , withSetupWHNF "fireEventsAndRead(head/merge1)"

76 , withSetupWHNF "fireEventsAndRead(head/merge1)"

76 (setupMerge 1 >>= subscribePair)

77 (setupMerge 1 >>= subscribePair)

@@ -84,14 +85,14 @@ micros =

84 , withSetupWHNF "fireEventsOnly(head/merge100)"

85 , withSetupWHNF "fireEventsOnly(head/merge100)"

85 (setupMerge 100 >>= subscribePair)

86 (setupMerge 100 >>= subscribePair)

86 (\(_, t:_) -> do

87 (\(_, t:_) -> do

87− Just key <- liftIO $ readIORef t

88+ key <- fromJust <$> liftIO (readIORef t)

88 fireEvents [key :=> Identity (42 :: Int)])

89 fireEvents [key :=> Identity (42 :: Int)])

89 , withSetupWHNF "hold" newEventWithTriggerRef $ \(ev, _) -> hold (42 :: Int) ev

90 , withSetupWHNF "hold" newEventWithTriggerRef $ \(ev, _) -> hold (42 :: Int) ev

90 , withSetupWHNF "sample" (newEventWithTriggerRef >>= hold (42 :: Int) . fst) sample

91 , withSetupWHNF "sample" (newEventWithTriggerRef >>= hold (42 :: Int) . fst) sample

91 ]

92 ]

93setupMerge :: Int

94setupMerge :: Int

94− -> SpiderHost Global ( Event (SpiderEnv Global) (DMap (Const2 Int a) Identity)

95+ -> SpiderHost Global ( Event (SpiderTimeline Global) (DMap (Const2 Int a) Identity)

95 , [IORef (Maybe (EventTrigger Spider a))]

96 , [IORef (Maybe (EventTrigger Spider a))]

96 )

97 )

97setupMerge num = do

98setupMerge num = do

@@ -99,11 +100,11 @@ setupMerge num = do

99 let !m = DMap.fromList [Const2 i :=> v | (i,v) <- zip [0..] evs]

100 let !m = DMap.fromList [Const2 i :=> v | (i,v) <- zip [0..] evs]

100 pure (merge m, triggers)

101 pure (merge m, triggers)

101

102

102−subscribePair :: (Event (SpiderEnv Global) a, b) -> SpiderHost Global (EventHandle (SpiderEnv Global) a, b)

103+subscribePair :: (Event (SpiderTimeline Global) a, b) -> SpiderHost Global (EventHandle (SpiderTimeline Global) a, b)

103subscribePair (ev, b) = (,b) <$> subscribeEvent ev

104subscribePair (ev, b) = (,b) <$> subscribeEvent ev

104

105

105−fireAndRead :: IORef (Maybe (EventTrigger (SpiderEnv Global) a)) -> a -> EventHandle (SpiderEnv Global) b

106+fireAndRead :: IORef (Maybe (EventTrigger (SpiderTimeline Global) a)) -> a -> EventHandle (SpiderTimeline Global) b

106 -> SpiderHost Global (Maybe b)

107 -> SpiderHost Global (Maybe b)

107fireAndRead trigger val subd = do

108fireAndRead trigger val subd = do

108− Just key <- liftIO $ readIORef trigger

109+ key <- fromJust <$> liftIO (readIORef trigger)

109 fireEventsAndRead [key :=> Identity val] $ readEvent subd >>= sequence

110 fireEventsAndRead [key :=> Identity val] $ readEvent subd >>= sequence

bench/RunAll.hs+1−1

@@ -136,7 +136,7 @@ benchmarks = implGroup "spider" runSpiderHost cases

136pattern RunTestCaseFlag = "--run-test-case"

137

138spawnBenchmark :: String -> Benchmark

139−spawnBenchmark name = Benchmark name $ Benchmarkable $ \n -> do

139+spawnBenchmark name = bench name . toBenchmarkable $ \n -> do

140 self <- getExecutablePath

141 callProcess self [RunTestCaseFlag, name, show n, "+RTS", "-N1"]

142

reflex.cabal+14−3

@@ -303,20 +303,27 @@ test-suite rootCleanup

303

304benchmark spider-bench

305 type: exitcode-stdio-1.0

306− hs-source-dirs: bench

306+ hs-source-dirs: bench test

307 main-is: Main.hs

308 ghc-options: -Wall -O2 -rtsopts

309 build-depends:

310 base,

311+ containers,

311− criterion == 1.1.*,

312+ criterion >= 1.1 && < 1.6,

312 deepseq >= 1.3 && < 1.5,

313 deepseq >= 1.3 && < 1.5,

313 dependent-map,

314 dependent-map,

314 dependent-sum,

315 dependent-sum,

316+ ref-tf,

315 mtl,

317 mtl,

316 primitive,

318 primitive,

317 reflex,

319 reflex,

320+ split,

318 stm,

321 stm,

319 transformers >= 0.3

322 transformers >= 0.3

323+ other-modules:

324+ Reflex.TestPlan

325+ Reflex.Plan.Reflex

326+ Reflex.Bench.Focused

320

327

321benchmark saulzar-bench

328benchmark saulzar-bench

322 type: exitcode-stdio-1.0

329 type: exitcode-stdio-1.0

@@ -327,7 +334,7 @@ benchmark saulzar-bench

327 build-depends:

334 build-depends:

328 base,

335 base,

329 containers >= 0.5 && < 0.7,

336 containers >= 0.5 && < 0.7,

330− criterion == 1.1.*,

337+ criterion >= 1.1 && < 1.6,

331 deepseq >= 1.3 && < 1.5,

338 deepseq >= 1.3 && < 1.5,

332 dependent-map,

339 dependent-map,

333 dependent-sum,

340 dependent-sum,

@@ -341,6 +348,10 @@ benchmark saulzar-bench

341 stm,

348 stm,

342 time,

349 time,

343 transformers >= 0.3

350 transformers >= 0.3

351+ other-modules:

352+ Reflex.TestPlan

353+ Reflex.Plan.Reflex

354+ Reflex.Bench.Focused

344

355

345source-repository head

356source-repository head

346 type: git

357 type: git