/
Environment.hs
63 lines (58 loc) · 2.15 KB
/
Environment.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
{-# LANGUAGE DeriveDataTypeable, TypeOperators #-}
-- |
-- Module : Criterion.Environment
-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
-- Stability : experimental
-- Portability : GHC
--
-- Code for measuring and characterising the execution environment.
module Criterion.Environment
(
Environment(..)
, measureEnvironment
) where
import Control.Monad (replicateM_)
import Control.Monad.Trans (liftIO)
import Criterion.Analysis (analyseMean)
import Criterion.IO (note)
import Criterion.Measurement (getTime, runForAtLeast, time_)
import Criterion.Monad (Criterion)
import qualified Data.Vector.Unboxed as U
import Data.Typeable (Typeable)
import Statistics.Function (create)
-- | Measured aspects of the execution environment.
data Environment = Environment {
envClockResolution :: {-# UNPACK #-} !Double
-- ^ Clock resolution (in seconds).
, envClockCost :: {-# UNPACK #-} !Double
-- ^ The cost of a single clock call (in seconds).
} deriving (Eq, Read, Show, Typeable)
-- | Measure the execution environment.
measureEnvironment :: Criterion Environment
measureEnvironment = do
note "warming up\n"
(_, seed, _) <- liftIO $ runForAtLeast 0.1 10000 resolution
note "estimating clock resolution...\n"
clockRes <- thd3 `fmap` liftIO (runForAtLeast 0.5 seed resolution) >>=
uncurry analyseMean
note "estimating cost of a clock call...\n"
clockCost <- cost (min (100000 * clockRes) 1) >>= uncurry analyseMean
return $ Environment {
envClockResolution = clockRes
, envClockCost = clockCost
}
where
resolution k = do
times <- create (k+1) (const getTime)
return (U.tail . U.filter (>=0) . U.zipWith (-) (U.tail times) $ times,
U.length times)
cost timeLimit = liftIO $ do
let timeClock k = time_ (replicateM_ k getTime)
timeClock 1
(_, iters, elapsed) <- runForAtLeast 0.01 10000 timeClock
times <- create (ceiling (timeLimit / elapsed)) $ \_ -> timeClock iters
return (U.map (/ fromIntegral iters) times, U.length times)
thd3 (_, _, c) = c