    {-# 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)

    -- | 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 <- U.replicateM (k+1) 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 <- U.replicateM (ceiling (timeLimit / elapsed)) $ timeClock iters
          return (U.map (/ fromIntegral iters) times, U.length times)
        thd3 (_, _, c) = c