perf 0.3.1.1 → 0.4.0.0
raw patch · 9 files changed
+114/−420 lines, 9 filesdep +deepseqdep +transformersdep −formattingdep −numhaskdep −optparse-genericdep ~base
Dependencies added: deepseq, transformers
Dependencies removed: formatting, numhask, optparse-generic, perf, protolude, scientific, tdigest, vector
Dependency ranges changed: base
Files
- CHANGELOG.md +5/−0
- LICENSE +2/−2
- examples/examples.hs +0/−279
- perf.cabal +15/−34
- src/Perf.hs +36/−17
- src/Perf/Cycle.hs +11/−52
- src/Perf/Measure.hs +41/−28
- stack.yaml +1/−4
- test/test.hs +3/−4
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+ 0.1+ + * No Protolude, numhask dependencies+ * No default langugage extensions in package.yaml+ * No tdigest
LICENSE view
@@ -1,4 +1,4 @@-Copyright Tony Day (c) 2016+Copyright Author name here (c) 2018 All rights reserved. @@ -13,7 +13,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Tony Day nor the names of other+ * Neither the name of Author name here nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission.
− examples/examples.hs
@@ -1,279 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleInstances #-}-{-# OPTIONS_GHC -Wall #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}-{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Main where--import qualified Data.Text as Text-import Data.Text.IO (writeFile)-import qualified Data.Vector as V-import qualified Data.Vector.Storable as S-import qualified Data.Vector.Unboxed as U-import Formatting-import Options.Generic-import NumHask.Prelude hiding ((%))-import Perf-import Data.Scientific--data Opts = Opts- { runs :: Maybe Int -- <?> "number of runs"- , sumTo :: Maybe Int -- <?> "sum to this number"- , sumsTo :: Maybe [Int] -- <?> "sum to these numbers"- , flipMaybe :: Maybe Bool- } deriving (Generic, Show)--instance ParseField [Int]--instance ParseRecord Opts--ticksInFile :: (NFData b) => Int -> (a -> b) -> a -> IO ([Cycle], b)-ticksInFile n0 f a = go f a n0 []- where- go f a n ts- | n <= 0 = pure (ts, f a)- | otherwise = do- (t,_) <- tick f a- go f a (n - 1) (t:ts)--fLambda :: Int -> Int-fLambda = \x -> foldl' (+) 0 [1 .. x]--fMono :: Int -> Int-fMono x = foldl' (+) 0 [1 .. x]--fPoly :: (Enum b, Num b, Additive b) => b -> b-fPoly x = foldl' (+) 0 [1 .. x]--prec :: Int -> Format r (Scientific -> r)-prec n = scifmt Exponent (Just n)--int2Sci :: ToInteger a => a -> Scientific-int2Sci n = scientific (fromIntegral n) 0--formatone :: (ToInteger a) => Text -> Int -> a -> Text-formatone t p x =- sformat- ((right 24 ' ' %. stext) %- (left 8 ' ' %. prec p) % " cycles") t (int2Sci x)--runone :: (ToInteger a) => Text -> Int -> IO (a, b) -> IO Text-runone label p t = formatone label p . fst <$> t--main :: IO ()-main = do- o :: Opts <- getRecord "a random bit of text"- let n = fromMaybe 1000 (runs o)- let a = fromMaybe 1000 (sumTo o)- let !a' = fromIntegral a- let !a'' = a'+1- let !a''' = a'+1- let as = [1, 10, 100, 1000 :: Int]- let fm = fromMaybe True (flipMaybe o)-- writeFile "other/run.md" $- code- [ sformat ((right 24 ' ' %. stext)%prec 1) "number of runs:" (int2Sci n)- , sformat ((right 24 ' ' %. stext)%prec 1) "accumulate to:" (int2Sci a)- , sformat ((right 24 ' ' %. stext)%stext) "function:" "foldl' (+) 0"- ]-- let formatRun :: [Cycle] -> Text -> Int -> Text- formatRun cs label p =- sformat- ((right 24 ' ' %. stext) % stext %- (left 7 ' ' %. prec p) % " cycles")- label- (Text.intercalate " " $ sformat (left 7 ' ' %. prec p) .- int2Sci <$>- take 5 cs)- (fromFloatDigits $ percentile 0.4 cs)-- let formatRunHeader =- sformat- ((right 24 ' ' %. stext) %- (left 7 ' ' %. stext) %- (left 8 ' ' %. stext) %- (left 8 ' ' %. stext) %- (left 8 ' ' %. stext) %- (left 8 ' ' %. stext) %- (left 8 ' ' %. stext))- "run"- "first"- "2nd"- "3rd"- "4th"- "5th"- "40th %"-- let run label p t = (\x -> formatRun x label p) . fst <$> t-- _ <- warmup 100-- -- | tick_- onetick <- tick_- ticks' <- replicateM 10 tick_- manyticks <- replicateM 1000000 tick_- let avticks = average manyticks- let qticks = deciles 10 manyticks- let tick999 = percentile 0.999 manyticks- let tick99999 = percentile 0.99999 manyticks- let tick99 = percentile 0.99 manyticks- let tick40 = percentile 0.4 manyticks- writeFile "other/tick_.md" $- code- [ "one tick_: " <> show onetick <> " cycles"- , "next 10: " <> show ticks'- , "average over 1m: " <> sformat (fixed 2) avticks <> " cycles"- , "99.999% perc: " <> sformat commas (floor tick99999 :: Integer)- , "99.9% perc: " <> sformat (fixed 2) tick999- , "99th perc: " <> sformat (fixed 2) tick99- , "40th perc: " <> sformat (fixed 2) tick40- , "[min, 10th, 20th, .. 90th, max]:"- , mconcat (sformat (" " % prec 4) . fromFloatDigits <$> qticks)- ]-- -- tick- (t, resultPrime) <- tick fMono a'- print resultPrime- (t2,_) <- tick fMono a'- writeFile "other/tick.md" $- code- [ "sum to " <> show a- , "first measure: " <> show t <> " cycles"- , "second measure: " <> show t2 <> " cycles"- ]-- -- | various versions of tick- rpure <- run "ticks" 2 $ ticks n fMono a'- rpurePoly <- run "ticks (poly)" 2 $ ticks n fPoly a- rpureLambda <- run "ticks (lambda)" 2 $ ticks n fLambda a'- rio <- run "ticksIO" 2 $ ticksIO n (pure $ fMono a'')- rioPoly <- run "ticksIO (poly)" 2 $ ticksIO n (pure $ fPoly a)- rioLambda <- run "ticksIO (lambda)" 2 $ ticksIO n (pure $ fLambda a')-- writeFile "other/ticks.md" $- code [ "sum to " <> show a <> " n = " <> show n <> " prime run: " <>- sformat (prec 3) (int2Sci t)- , formatRunHeader- , rpure- , rpureLambda- , rpurePoly- , rio- , rioLambda- , rioPoly- ]-- -- | overall ticks cost- let formatGap :: Int -> (Cycle, ([Cycle],b)) -> Text- formatGap a (co, (ci, _)) =- sformat- ("n = " %(left 7 ' ' %. prec 3)%" outside: "%(left 7 ' ' %. prec 3)%" inside: "%(left 7 ' ' %. prec 3)%" gap: "%(left 7 ' ' %. prec 3))- (int2Sci a) (int2Sci co) (int2Sci $ sum ci) (int2Sci $ co - sum ci)- let runGap t a = formatGap a <$> tickIO t- gaps <- sequence $ (\a -> runGap (ticks n fPoly a) a) <$> as- writeFile "other/ticksCost.md" $ code gaps-- -- | ns- css <-- fmap (fmap fst) <$>- sequence ((replicateM n . tick fMono) <$> as)- let r12 =- "(replicateM n . tick fMono) <$> as: " <>- mconcat (sformat (" " %prec 3) <$> (fromFloatDigits . percentile 0.4 <$> css))- (ts, _) <-ns (ticks n fMono) as- let r13 =- "ns (ticks n fMono) as: " <>- mconcat (sformat (" " %prec 3) <$> (fromFloatDigits . percentile 0.4 <$> ts))- writeFile "other/tickns.md" $- code ["sum to's " <> show as, r13, r12]-- -- | vectors- let asl :: [Int]- asl = [1 .. a]- let suml :: [Int] -> Int- suml = foldl' (+) 0- rlist <- run "ticks list" 2 $ ticks n suml asl- let sumv :: V.Vector Int -> Int- sumv = V.foldl (+) 0- let asv :: V.Vector Int =- V.generate a identity- rboxed <- run "ticks boxed" 2 $ ticks n sumv asv- let sums :: S.Vector Int -> Int- sums = S.foldl (+) 0- let ass :: S.Vector Int =- S.generate a identity- rstorable <- run "ticks storable" 2 $ ticks n sums ass- let sumu :: U.Vector Int -> Int- sumu = U.foldl (+) 0- let asu :: U.Vector Int =- U.generate a identity- runboxed <- run "ticks unboxed" 2 $ ticks n sumu asu- writeFile "other/vector.md" $- code ["sum to " <> show a, rlist, rboxed, rstorable, runboxed]--- -- WHNF- let just' x- | fm = Just x- | otherwise = Nothing-- rnf <- runone "tick" 2 $ tick (fmap fMono) (just' a')- rwhnf <- runone "tickWHNF" 2 $ tick (fmap fMono) (just' a')- rnfs <- run "ticks" 2 $ ticks n (fmap fMono) (just' a')- rwhnfs <- run "ticksWHNF" 2 $ ticksWHNF n (fmap fMono) (just' a')-- rnfio <- runone "tickIO" 2 $ tickIO (pure $ fmap fMono (just' a'))- rwhnfio <- runone "tickWHNFIO" 2 $ tickWHNFIO (pure $ fmap fMono (just' a'))- rnfsio <- run "ticksIO" 2 $ ticksIO n (pure $ fmap fMono (just' a'''))- rwhnfsio <- run "ticksWHNFIO" 2 $ ticksWHNFIO n (pure $ fmap fMono (just' a'))-- writeFile "other/whnf.md" $- code ["sum to " <> show a,- rnf, rwhnf, rnfs, rwhnfs, rnfio, rwhnfio, rnfsio, rwhnfsio]--{-- -- perf basics- (result, cs) <- runPerfT $- perf "sum" cycles (pure $ foldl' (+) 0 [0 .. floor a :: Integer])- putStrLn (show (result, cs) :: Text)-- -- PerfT example- -- prior to Perfification- result <- do- txt <- readFile "examples/examples.hs"- let n = Text.length txt- let x = foldl' (+) 0 [1..n]- putStrLn $ "sum of one to number of characters is: " <>- (show x :: Text)- pure (n, x)-- -- post-Perfification- (result', ms) <- runPerfT $ do- txt <- perf "file read" cycles $ readFile "examples/examples.hs"- n <- perf "length" cycles $ pure (Text.length txt)- x <- perf "sum" cycles $ pure (foldl' (+) 0 [1..n])- perf "print to screen" cycles $- putStrLn $ "sum of one to number of characters is: " <>- (show x :: Text)- pure (n, x)-- when (result == result') $ print "PerfT preserving computations"-- let fmt = sformat ((right 40 ' ' %. stext) %prec 3 % " " % stext)- writeFile "other/perf.md" $- "\nperf cycle measurements\n---\n" <>- code ((\(t,c) -> fmt t c "cycles") <$> Map.toList ms)--}---code :: [Text] -> Text-code cs = "\n```\n" <> Text.intercalate "\n" cs <> "\n```\n"
perf.cabal view
@@ -2,16 +2,18 @@ -- -- see: https://github.com/sol/hpack ----- hash: 0de644718bf0dc295e55cc494bae9ef3965fa50a59415333b221fce61c4a1dd0+-- hash: ce01c5e5d57fc57b3bd0e39325c134d3ffb9e7aa21597bbc8458eb894b92991e name: perf-version: 0.3.1.1-synopsis: low-level performance statistics-description: A set of tools to measure time performance. +version: 0.4.0.0+synopsis: Low-level run time measurement.+description: A set of tools to accurately measure time performance of Haskell programs.+ perf aims to be lightweight by having minimal dependencies on standard libraries.+ See the Perf module for an example and full API documentation. category: project homepage: https://github.com/tonyday567/perf#readme bug-reports: https://github.com/tonyday567/perf/issues-author: Tony Day+author: Tony Day, Marco Zocca maintainer: tonyday567@gmail.com copyright: Tony Day license: BSD3@@ -20,6 +22,7 @@ cabal-version: >= 1.10 extra-source-files:+ CHANGELOG.md stack.yaml source-repository head@@ -29,16 +32,16 @@ library hs-source-dirs: src- default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax BangPatterns TypeSynonymInstances+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends:- base >=4.7 && <4.11+ base >=4.7 && <4.12 , containers+ , deepseq , foldl- , numhask >=0.1.2 && <0.2- , protolude , rdtsc- , tdigest+ , text , time+ , transformers exposed-modules: Perf Perf.Measure@@ -47,37 +50,15 @@ Paths_perf default-language: Haskell2010 -executable perf-examples- main-is: examples.hs- hs-source-dirs:- examples- default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax ScopedTypeVariables- ghc-options: -fforce-recomp -rtsopts -O2- build-depends:- base >=4.7 && <4.11- , formatting- , numhask- , optparse-generic- , perf- , protolude- , scientific- , text- , vector- other-modules:- Paths_perf- default-language: Haskell2010- test-suite test type: exitcode-stdio-1.0 main-is: test.hs hs-source-dirs: test- default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends:- base >=4.7 && <5+ base >=4.7 && <4.12 , doctest- , perf- , protolude other-modules: Paths_perf default-language: Haskell2010
src/Perf.hs view
@@ -1,13 +1,20 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -Wall #-} --- | 'PerfT' is a monad transformer designed to collect performance information.--- The transformer can be used to add performance measurent to an existing code base using 'Measure's.+-- | == Introduction+-- +-- 'perf' provides high-resolution measurements of the runtime of Haskell functions. It does so by reading the RDTSC register (TSC stands for "time stamp counter"), which is present on all x86 CPUs since the Pentium architecture. ----- For example, here's some code doing some cheesey stuff:+-- With 'perf' the user may measure both pure and effectful functions, as shown in the Example below. Every piece of code the user may want to profile is passed as an argument to the 'perf' function, along with a text label (that will be displayed in the final summary) and the measurement function (e.g. 'cycles', 'cputime' or 'realtime'). ----- > -- prior to Perfification+--'PerfT' is a monad transformer designed to collect performance information.+-- The transformer can be used to add performance measurent to existing code using 'Measure's.+--+-- == Example :+--+-- Code block to be profiled :+-- -- > result <- do -- > txt <- readFile "examples/examples.hs" -- > let n = Text.length txt@@ -16,7 +23,7 @@ -- > (show x :: Text) -- > pure (n, x) ----- And here's the code after 'Perf'ification, measuring performance of the components.+-- The same code, instrumented with 'perf' : -- -- > (result', ms) <- runPerfT $ do -- > txt <- perf "file read" cycles $ readFile "examples/examples.hs"@@ -34,6 +41,9 @@ -- > print to screen 1.06e5 cycles -- > sum 8.12e3 cycles --+-- == Note on RDTSC+--+-- Measuring program runtime with RDTSC comes with a set of caveats, such as portability issues, internal timer consistency in the case of multiprocessor architectures, and flucturations due to power throttling. For more details, see : https://en.wikipedia.org/wiki/Time_Stamp_Counter module Perf ( PerfT , Perf@@ -44,17 +54,26 @@ , execPerfT , module Perf.Cycle , module Perf.Measure- ) where+ )+ where -import qualified Data.Map as Map-import NumHask.Prelude+import Control.Monad.IO.Class+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State (StateT(..), evalStateT, runStateT, execStateT, get, put )+import Data.Functor.Identity import Perf.Cycle import Perf.Measure+import qualified Data.Map as Map+import qualified Data.Text as T +-- $setup+-- >>> import Perf.Cycle+-- >>> import Data.Foldable (foldl')+ -- | PerfT is polymorphic in the type of measurement being performed. -- The monad stores and produces a Map of labelled measurement values newtype PerfT m b a = PerfT- { runPerf_ :: StateT (Map.Map Text b) m a+ { runPerf_ :: StateT (Map.Map T.Text b) m a } deriving (Functor, Applicative, Monad) -- | The obligatory transformer over Identity@@ -64,19 +83,19 @@ liftIO = PerfT . liftIO -- | Lift a monadic computation to a PerfT m, providing a label and a 'Measure'.-perf :: (MonadIO m, Additive b) => Text -> Measure m b -> m a -> PerfT m b a+perf :: (MonadIO m, Additive b) => T.Text -> Measure m b -> m a -> PerfT m b a perf label m a = PerfT $ do st <- get (m', a') <- lift $ runMeasure m a- put $ Map.insertWith (+) label m' st+ put $ Map.insertWith add label m' st return a' -- | Lift a monadic computation to a PerfT m, and carry out the computation multiple times. perfN ::- (MonadIO m, Semigroup b, Monoid b)+ (MonadIO m, Monoid b) => Int- -> Text+ -> T.Text -> Measure m b -> m a -> PerfT m b a@@ -93,7 +112,7 @@ -- >>> (cs, result) <- runPerfT $ perf "sum" cycles (pure $ foldl' (+) 0 [0..10000]) -- -- > (50005000,fromList [("sum",562028)])-runPerfT :: PerfT m b a -> m (a, Map.Map Text b)+runPerfT :: PerfT m b a -> m (a, Map.Map T.Text b) runPerfT p = flip runStateT Map.empty $ runPerf_ p -- | Consume the PerfT layer and return the original monadic result.@@ -102,7 +121,7 @@ -- >>> result <- evalPerfT $ perf "sum" cycles (pure $ foldl' (+) 0 [0..10000]) -- -- > 50005000-evalPerfT :: (Monad m) => PerfT m b a -> m a+evalPerfT :: Monad m => PerfT m b a -> m a evalPerfT p = flip evalStateT Map.empty $ runPerf_ p -- | Consume a PerfT layer and return the measurement.@@ -110,5 +129,5 @@ -- >>> cs <- execPerfT $ perf "sum" cycles (pure $ foldl' (+) 0 [0..10000]) -- -- > fromList [("sum",562028)]-execPerfT :: (Monad m) => PerfT m b a -> m (Map.Map Text b)+execPerfT :: Monad m => PerfT m b a -> m (Map.Map T.Text b) execPerfT p = flip execStateT Map.empty $ runPerf_ p
src/Perf/Cycle.hs view
@@ -1,7 +1,4 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -28,20 +25,18 @@ , ticksWHNF , ticksWHNFIO , average- , deciles- , percentile- ) where+ )+ where -import qualified Control.Foldl as L-import Data.List as List-import Data.TDigest-import NumHask.Prelude+import Control.DeepSeq (NFData(..), force)+import qualified Control.Foldl as L (fold, sum, premap, genericLength)+import Control.Monad (replicateM)+import GHC.Word (Word64) import System.CPUTime.Rdtsc-import qualified Protolude -- $setup--- >>> :set -XNoImplicitPrelude -- >>> import Perf.Cycle+-- >>> import Data.Foldable (foldl') -- >>> let n = 1000 -- >>> let a = 1000 -- >>> let f x = foldl' (+) 0 [1 .. x]@@ -50,26 +45,6 @@ -- | an unwrapped Word64 type Cycle = Word64 -instance AdditiveMagma Cycle where- plus = (Protolude.+)--instance AdditiveUnital Cycle where- zero = 0--instance AdditiveAssociative Cycle--instance AdditiveCommutative Cycle--instance Additive Cycle--instance AdditiveInvertible Cycle where- negate = Protolude.negate--instance AdditiveGroup Cycle--instance ToInteger Cycle where- toInteger = Protolude.toInteger- -- | tick_ measures the number of cycles it takes to read the rdtsc chip twice: the difference is then how long it took to read the clock the second time. -- -- Below are indicative measurements using tick_:@@ -79,8 +54,6 @@ -- >>> manyticks <- replicateM 1000000 tick_ -- >>> let average = L.fold ((/) <$> L.sum <*> L.genericLength) -- >>> let avticks = average (fromIntegral <$> manyticks)--- >>> let qticks = deciles 10 manyticks--- >>> let tick999 = percentile 0.999 manyticks -- -- > one tick_: 78 cycles -- > next 10: [20,18,20,20,20,20,18,16,20,20]@@ -175,7 +148,7 @@ -- > ticks (lambda) 1.19e3 718 682 684 678 682 cycles -- > ticks (poly) 1.64e3 1.34e3 1.32e3 1.32e3 1.32e3 1.31e3 cycles ---ticks :: (NFData b) => Int -> (a -> b) -> a -> IO ([Cycle], b)+ticks :: NFData b => Int -> (a -> b) -> a -> IO ([Cycle], b) ticks n0 f a = go f a n0 [] where go f' a' n ts@@ -215,7 +188,7 @@ -- > sum to's [1,10,100,1000] -- > tickns n fMono: 17.8 23.5 100 678 ---ns :: (NFData b) => (a -> IO ([Cycle],b)) -> [a] -> IO ([[Cycle]], [b])+ns :: (a -> IO ([Cycle],b)) -> [a] -> IO ([[Cycle]], [b]) ns t as = do cs <- sequence $ t <$> as pure (fst <$> cs, snd <$> cs)@@ -227,22 +200,6 @@ average :: (Foldable f) => f Cycle -> Double average = L.fold (L.premap fromIntegral ((/) <$> L.sum <*> L.genericLength)) --- | compute deciles------ > c5 <- decile 5 <$> ticks n f a----deciles :: (Functor f, Foldable f) => Int -> f Cycle -> [Double]-deciles n xs =- (\x -> fromMaybe 0 $ quantile x (tdigest (fromIntegral <$> xs) :: TDigest 25)) <$>- ((/ fromIntegral n) . fromIntegral <$> [0 .. n]) :: [Double]---- | compute a percentile------ > c <- percentile 0.4 . fst <$> ticks n f a----percentile :: (Functor f, Foldable f) => Double -> f Cycle -> Double-percentile p xs = fromMaybe 0 $ quantile p (tdigest (fromIntegral <$> xs) :: TDigest 25)- -- | WHNF version tickWHNF :: (a -> b) -> a -> IO (Cycle, b) tickWHNF !f !a = tickWHNF' f a@@ -294,3 +251,5 @@ (t,_) <- tickWHNFIONoinline a' go a' (n - 1) (t:ts) {-# NOINLINE ticksWHNFIO #-}++
src/Perf/Measure.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -14,15 +13,44 @@ , realtime , count , cycles- ) where+ , Additive(..)+ )+ where import Data.Time.Clock-import NumHask.Prelude-import Perf.Cycle as C-import qualified Protolude as P+import GHC.Word (Word64)+import Control.Monad (replicateM_)+import Perf.Cycle import System.CPUTime import System.CPUTime.Rdtsc ++-- | Lightweight 'Additive' class. +class Num a => Additive a where+ add :: a -> a -> a+ zero :: a++instance Additive Int where+ add = (+)+ zero = 0++instance Additive Integer where+ add = (+)+ zero = 0++instance Additive Word64 where+ add = (+)+ zero = 0++instance Additive NominalDiffTime where+ add = (+)+ zero = 0+ ++-- $setup+-- >>> import Data.Foldable (foldl')+--+ -- | A Measure consists of a monadic effect prior to measuring, a monadic effect to finalise the measurement, and the value measured -- -- For example, the measure specified below will return 1 every time measurement is requested, thus forming the base of a simple counter for loopy code.@@ -34,13 +62,14 @@ , poststep :: a -> m b } + -- | Measure a single effect. -- -- >>> r <- runMeasure count (pure "joy") -- >>> r -- (1,"joy") ---runMeasure :: (MonadIO m) => Measure m b -> m a -> m (b, a)+runMeasure :: Monad m => Measure m b -> m a -> m (b, a) runMeasure (Measure _ pre post) a = do p <- pre !a' <- a@@ -53,7 +82,7 @@ -- >>> r -- (1,"joys") ---runMeasureN :: (MonadIO m) => Int -> Measure m b -> m a -> m (b, a)+runMeasureN :: Monad m => Int -> Measure m b -> m a -> m (b, a) runMeasureN n (Measure _ pre post) a = do p <- pre replicateM_ (n - 1) a@@ -66,10 +95,8 @@ -- >>> r <- cost count -- >>> r -- 1-cost :: (MonadIO m) => Measure m b -> m b-cost (Measure _ pre post) = do- p <- pre- post p+cost :: Monad m => Measure m b -> m b+cost (Measure _ pre post) = pre >>= post -- | a measure using 'getCPUTime' from System.CPUTime (unit is picoseconds) --@@ -85,23 +112,8 @@ t <- getCPUTime return $ t - a -instance AdditiveMagma NominalDiffTime where- plus = (P.+) -instance AdditiveUnital NominalDiffTime where- zero = 0 -instance AdditiveAssociative NominalDiffTime--instance AdditiveCommutative NominalDiffTime--instance Additive NominalDiffTime--instance AdditiveInvertible NominalDiffTime where- negate = P.negate--instance AdditiveGroup NominalDiffTime- -- | a measure using 'getCurrentTime' (unit is 'NominalDiffTime' which prints as seconds) -- -- >>> r <- runMeasure realtime (pure $ foldl' (+) 0 [0..1000])@@ -117,7 +129,7 @@ t <- getCurrentTime return $ diffUTCTime t a --- | a measure used to count iterations+-- | a 'Measure' used to count iterations -- -- >>> r <- runMeasure count (pure ()) -- >>> r@@ -130,7 +142,7 @@ start = return () stop () = return 1 --- | a Measure using the 'rdtsc' chip set (units are in cycles)+-- | a 'Measure' using the 'rdtsc' CPU register (units are in cycles) -- -- >>> r <- runMeasureN 1000 cycles (pure ()) -- @@ -145,3 +157,4 @@ stop a = do t <- rdtsc return $ t - a+
stack.yaml view
@@ -1,7 +1,4 @@-resolver: nightly-2017-12-27--packages:- - '.'+resolver: nightly-2018-04-05 extra-deps: - rdtsc-1.3.0.1
test/test.hs view
@@ -2,14 +2,13 @@ module Main where -import Protolude import Test.DocTest main :: IO () main = do- putStrLn ("Perf.Cycle DocTest" :: Text)+ putStrLn "Perf.Cycle DocTest" doctest ["src/Perf/Cycle.hs"]- putStrLn ("Perf.Measure DocTest" :: Text)+ putStrLn "Perf.Measure DocTest" doctest ["src/Perf/Measure.hs"]- putStrLn ("Perf DocTest" :: Text)+ putStrLn "Perf DocTest" doctest ["src/Perf.hs"]