diff --git a/examples/examples.hs b/examples/examples.hs
new file mode 100644
--- /dev/null
+++ b/examples/examples.hs
@@ -0,0 +1,197 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wall #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
+
+import qualified Data.List as List
+import qualified Data.Text as Text
+import Data.Text.IO (writeFile, readFile)
+import qualified Data.Map as Map
+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
+
+data Opts = Opts
+ { runs :: Maybe Int -- "number of runs"
+ , sumTo :: Maybe Double -- "sum to this number"
+ } deriving (Generic, Show)
+
+instance ParseRecord Opts
+
+ticks :: Int -> (a -> b) -> a -> IO ([Cycle], b)
+ticks n f a = do
+ ts <- replicateM' n (tick f a)
+ pure (fst <$> ts, snd $ List.last ts)
+
+qtick :: Int -> (a -> b) -> a -> IO (Double, b)
+qtick n f a = do
+ ts <- replicateM' n (tick f a)
+ pure (percentile 0.4 $ fst <$> ts, snd $ List.last ts)
+
+main :: IO ()
+main = do
+ o :: Opts <- getRecord "a random bit of text"
+ let n = fromMaybe 1000 (runs o)
+ let a = fromMaybe 10000 (sumTo o)
+
+ -- perf
+ -- 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 preserves 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)
+
+ -- | 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) <$> qticks)
+ ]
+
+
+ -- tick
+ _ <- warmup 100
+ let f x = foldl' (+) 0 [1 .. x]
+ (t, _) <- tick f a
+ (ts, _) <- Main.ticks n f a
+ let qt x = (`percentile` x) <$> [0, 0.3, 0.5, 0.9, 0.99, 1]
+ writeFile "other/tick.md" $
+ code
+ [ "sum to " <> show a
+ , "first measure: " <> show t <> " cycles"
+ , "average over next " <> show n <> ": " <> sformat (fixed 2) (average ts) <>
+ " cycles"
+ , "[min, 30th, median, 90th, 99th, max]:"
+ , mconcat (sformat (" " % prec 4) <$> qt ts)
+ ]
+
+ -- | ticks & friends
+ (cs, _) <- Perf.ticks n f a
+ let ft cs t =
+ sformat
+ ((right 40 ' ' %. stext) % prec 3 % " cycles")
+ t
+ (percentile 0.4 cs)
+ let r1 = ft cs "Perf.ticks n f a"
+ (cs, _) <- Main.ticks n f a
+ let r2 = ft cs "Main.ticks n f a"
+ (cs, _) <- Perf.ticksIO n (pure $ f a)
+ let r3 = ft cs "Perf.ticksIO n (pure $ f a)"
+ (c, _) <- Perf.qtick n f a
+ let fq c t = sformat ((right 40 ' ' %. stext) %prec 3 % " cycles") t c
+ let r4 = fq c "Perf.qtick n f a"
+ (c, _) <- Main.qtick n f a
+ let r5 = fq c "Main.qtick n f a"
+ cs <- fmap fst <$> replicateM n (tick f a)
+ let r6 = ft cs "replicateM n (tick f a)"
+ cs <- fmap fst <$> replicateM' n (tick f a)
+ let r7 = ft cs "replicateM' n (tick f a)"
+ cs <- fmap fst <$> replicateM n (tickIO (pure (f a)))
+ let r8 = ft cs "replicateM n (tickIO (pure (f a)))"
+ cs <- fmap fst <$> replicateM n (tick (app (f a)) ())
+ let r9 = ft cs "replicateM n (tick (app (f a)) ())"
+ cs <- fmap fst <$> replicateM n (tick identity (f a))
+ let r10 = ft cs "replicateM n (tick identity (f a))"
+ cs <- fmap fst <$> replicateM n (tick (const (f a)) ())
+ let r11 = ft cs "replicateM n (tick (const (f a)) ())"
+ css <-
+ fmap (fmap fst) <$>
+ sequence ((replicateM n . tick f) <$> [1, 10, 100, 1000, 10000 :: Int])
+ let r12 =
+ "(replicateM n . tick f) <$> [1,10,100,1000,10000]: " <>
+ mconcat (sformat (" " %prec 3) <$> (percentile 0.4 <$> css))
+ (ts, _) <- Perf.tickns n f [1, 10, 100, 1000, 10000 :: Int]
+ let r13 =
+ "Perf.tickns n f [1,10,100,1000,10000]: " <>
+ mconcat (sformat (" " %prec 3) <$> (percentile 0.4 <$> ts))
+ writeFile "other/ticks.md" $
+ code ["sum to " <> show a, r1, r2, r3, r4, r5, r6, r7, r8, r9, r10, r11, r12, r13]
+
+ -- vectors
+
+ let sumv :: V.Vector Double -> Double
+ sumv = V.foldl (+) 0
+
+ let asv :: V.Vector Double =
+ (\x -> V.generate (fromIntegral $ floor x) fromIntegral) a
+
+ (t, _) <- Perf.ticks n sumv asv
+ let rboxed = sformat ("boxed: " %prec 3) (percentile 0.4 t)
+
+ let sums :: S.Vector Double -> Double
+ sums = S.foldl (+) 0
+
+ let ass :: S.Vector Double =
+ (\x -> S.generate (fromIntegral $ floor x) fromIntegral) a
+
+ (t, _) <- Perf.ticks n sums ass
+ let rstorable = sformat ("storable: " %prec 3) (percentile 0.4 t)
+
+ let sumu :: U.Vector Double -> Double
+ sumu = U.foldl (+) 0
+
+ let asu :: U.Vector Double =
+ (\x -> U.generate (fromIntegral $ floor x) fromIntegral) a
+
+ (t, _) <- Perf.ticks n sumu asu
+ let runboxed = sformat ("unboxed: " %prec 3) (percentile 0.4 t)
+
+ writeFile "other/vector.md" $
+ code ["sum to " <> show a, rboxed, rstorable, runboxed]
+
+ (t, _) <- Perf.ticks n f a
+ putStrLn $ sformat ("Perf.Cycle.ticks n f a: " %prec 3) (percentile 0.4 t)
+
+ -- perf basics
+ (result, cs) <- runPerfT $
+ perf "sum" cycles (pure $ foldl' (+) 0 [0..10000 :: Integer])
+ putStrLn (show (result, cs) :: Text)
+
+
+code :: [Text] -> Text
+code cs = "\n```\n" <> Text.intercalate "\n" cs <> "\n```\n"
diff --git a/examples/examples.lhs b/examples/examples.lhs
deleted file mode 100644
--- a/examples/examples.lhs
+++ /dev/null
@@ -1,327 +0,0 @@
-
-
-
-
-[perf](https://tonyday567.github.io/perf/index.html)
-===
-
-[](https://travis-ci.org/tonyday567/perf) [](https://hackage.haskell.org/package/perf) [](http://stackage.org/lts/package/perf) [](http://stackage.org/nightly/package/perf)
-
-[repo](https://github.com/tonyday567/perf)
-
-If you want to make stuff very fast in haskell, you need to dig down below the criterion abstraction-level and start counting cycles using the [rdtsc](https://en.wikipedia.org/wiki/Time_Stamp_Counter) register on x86.
-
-These examples are experiments in measuring cycles (or ticks), a development of intuition about what is going on at the very fast level.
-
-The interface is subject to change as intuition develops and rabbit holes explored.
-
-> {-# OPTIONS_GHC -Wall #-}
-> {-# OPTIONS_GHC -fno-warn-type-defaults #-}
-> {-# LANGUAGE OverloadedStrings #-}
-> {-# LANGUAGE DataKinds #-}
-> import Data.Text (pack, intercalate)
-> import Data.Text.IO (writeFile)
-> import Formatting
-> import Protolude hiding ((%), intercalate)
-> import Data.List ((!!))
-> import Data.TDigest
-> import System.Random.MWC.Probability
-> import Options.Generic
-> import qualified Control.Foldl as L
-> import qualified Data.Vector as V
-> import qualified Data.Vector.Unboxed as U
-> import qualified Data.Vector.Storable as S
-> import Chart
->
-
-The examples below mostly use `Perf.Cycles`. There is also a monad layer in `Perf` which has been used in `other/summing.lhs`.
-
-> import Perf
-
-All the imports that are needed for charts
-
-command line
----
-
-> data Opts = Opts
-> { runs :: Maybe Int -- "number of runs"
-> , sumTo :: [Double] -- "sum to this number"
-> , chartNum :: Maybe Int
-> , truncAt :: Maybe Double
-> }
-> deriving (Generic, Show)
->
-> instance ParseRecord Opts
-
-main
----
-
-> main :: IO ()
-> main = do
-> o :: Opts <- getRecord "a random bit of text"
-> let n = fromMaybe 10000 (runs o)
-> let as = case sumTo o of
-> [] -> [1,10,100,1000,10000]
-> x -> x
-> let trunc = fromMaybe 5 (truncAt o)
-> let numChart = min (length as) $ fromMaybe 3 (chartNum o)
-
-For reference, based on a 2.6G machine one cycle is = 0.38 𝛈s
-
-`tick_` taps the register twice to get a sense of the cost.
-
-> onetick <- tick_
-> ticks' <- replicateM 10 tick_
-> avtick <- replicateM 1000000 tick_
-> let average cs = L.fold ((/) <$> L.sum <*> L.genericLength) cs
-> writeFile "other/onetick.md" $ code
-> [ "one tick_: " <> pack (show onetick) <> " cycles"
-> , "next 10: " <> pack (show ticks')
-> , "average over 1m: " <>
-> pack (show $ average (fromIntegral <$> avtick)) <> " cycles"
-> ]
-
-```include
-other/onetick.md
-```
-
-Before we actually measure something, lets take a closer look at tick_.
-
-A pattern I see on my machine are shifts by multiples of 4, which correspond to roughly the L1 [cache latency](http://stackoverflow.com/questions/1126529/what-is-the-cost-of-an-l1-cache-miss).
-
-It pays to look at the whole distribution, and a compact way of doing that is to calculate quantiles:
-
-> -- warmup 100
-> xs <- replicateM 10000 tick_
-> writeFile "other/tick_.md" $ code $
-> (["[min, 10th, 20th, .. 90th, max]:"] :: [Text]) <>
-> [mconcat (sformat (" " % prec 3) <$> deciles 5 (fromIntegral <$> xs))]
-
-```include
-other/tick_.md
-```
-
-The important cycle count for most work is around the 30th to 50th percentile, where you get a clean measure, hopefully free of GC activity and cache miss-fires.
-
-The quantile print of tick_ sometimes shows a 12 to 14 point jump around the 90th percential, and this is in the zone of an L2 access. Without a warmup, one or more larger values occur at the start, and often are in the zone of an L2 miss. Sometimes there's also a few large hiccoughs at around 2k cycles.
-
-summing
-===
-
-Let's measure something. The simplest something I could think of was summing.
-
-The helper function `reportQuantiles` utilises `spins` which takes n measurements of a function application over a range of values to apply.
-
-> let f :: Double -> Double
-> f x = foldl' (+) 0 [1..x]
-> _ <- warmup 100
-> (cs,_) <- spins n tick f as
-> reportQuantiles cs as "other/spin.md"
->
-
-```include
-other/spin.md
-```
-
-Each row represents summing to a certain point: 1 up to 10000, and each column is a decile: min, 10th .. 90th, max. The values in each cell are the number of cycles divided by the number of runs and the number of sumTo.
-
-The first row (summing to 1) represents the cost of setting up the sum, so we're looking at about (692 - 128) = 560 cycles every run.
-
-Overall, the computation looks like it's running in O(n) where n is the number of runs * nuber of sumTo. Specifically, I would write down the order at about:
-
- 123 * o(n) + 560 * o(1)
-
-The exception is the 70th to 90th zone, where the number of cycles creeps up to 194 for 1k sumTo at the 90th percentile.
-
-Charting the 1k sumTo:
-
-> let xs_0 = fromIntegral <$> take 10000 (cs!!numChart) -- summing to 1000
-> let xs1 = (\x -> min x (trunc*deciles 5 xs_0 !! 5)) <$> xs_0
-> fileSvg "other/spin1k.svg" (750,250) $ pad 1.1 $ histLine xs1
-
-
-
-Switching to a solo experiment gives:
-
-~~~
-stack exec "ghc" -- -O2 -rtsopts examples/summing.lhs
-./examples/summing +RTS -s -RTS --runs 10000 --sumTo 1000 --chart --chartName other/sum1e3.svg --truncAt 4
-~~~
-
-
-
-Executable complexity has changed the profile of the overall computation. Both measurements have the same value, however, up to around the 30th percentile.
-
-
-generic vector
----
-
-Using vector to sum:
-
-> let asv :: [V.Vector Double] = (\x -> V.generate (floor x) fromIntegral) <$> as
-> let sumv :: V.Vector Double -> Double
-> sumv x = V.foldl (+) 0 x
-> (csv,_) <- spins n tick sumv asv
-> reportQuantiles csv as "other/vectorGen.md"
->
-
-```include
-other/vectorGen.md
-```
-
-randomizing data
----
-
-To avoid ghc (and fusion) trickiness, it's often a good idea to use random numbers instead of simple progressions. One day, a compiler will discover `x(x+1)/2` and then we'll be in real trouble.
-
-> mwc <- create
-> !asr <- (fmap V.fromList <$>) <$> sequence $ (\x -> samples x uniform mwc) . floor <$> as
-> void $ warmup 100
-> (csr,_) <- spins n tick sumv asr
-> reportQuantiles csr as "other/vectorr.md"
->
-
-```include
-other/vectorr.md
-```
-
-Charting the 1k sumTo:
-
-> let csr0 = fromIntegral <$> take 10000 (csr!!numChart) -- summing to 1000
-> let csr1 = (\x -> min x (trunc*deciles 5 csr0 !! 5)) <$> csr0
-> fileSvg "other/vector1k.svg" (750,250) $ pad 1.1 $ histLine csr1
-
-
-
-unboxed
----
-
-> !asu <- (fmap U.fromList <$>) <$> sequence $ (\x -> samples x uniform mwc) . floor <$> as
-> let sumu :: U.Vector Double -> Double
-> sumu x = U.foldl (+) 0 x
-> void $ warmup 100
-> (csu,_) <- spins n tick sumu asu
-> reportQuantiles csu as "other/vectoru.md"
->
-
-```include
-other/vectoru.md
-```
-
-Charting the 1k sumTo:
-
-> let csu0 = fromIntegral <$> take 10000 (csu!!numChart) -- summing to 1000
-> let csu1 = (\x -> min x (trunc*deciles 5 csu0 !! 5)) <$> csu0
-> fileSvg "other/vectoru1k.svg" (750,250) $ pad 1.1 $ histLine csu1
-
-
-
-storable
----
-
-> !ass <- (fmap S.fromList <$>) <$> sequence $ (\x -> samples x uniform mwc) . floor <$> as
-> let sums :: S.Vector Double -> Double
-> sums x = S.foldl (+) 0 x
-> void $ warmup 100
-> (css,_) <- spins n tick sums ass
-> reportQuantiles css as "other/vectors.md"
->
-
-```include
-other/vectors.md
-```
-
-Charting the 1k sumTo:
-
-> let css0 = fromIntegral <$> take 10000 (css!!numChart) -- summing to 1000
-> let css1 = (\x -> min x (trunc*deciles 5 css0 !! 5)) <$> css0
-> fileSvg "other/vectors1k.svg" (750,250) $ pad 1.1 $ histLine css1
-
-
-
-tickf, ticka, tickfa
----
-
-These functions attempt to discriminate between cycles used to compute `f a` (ie to apply the function f), and cycles used to force `a`. In experiments so far, this act of observation tends to change the number of cycles.
-
-Separation of the `f` and `a` effects in `f a`
-
-> void $ warmup 100
-> (csr2,_) <- spins n tick sumv asr
-> (csvf,_) <- spins n tickf sumv asr
-> (csva,_) <- spins n ticka sumv asr
-> (csvfa,_) <- spins n tickfa sumv asr
-> reportQuantiles csr2 as "other/vectorr2.md"
-> reportQuantiles csvf as "other/vectorf.md"
-> reportQuantiles csva as "other/vectora.md"
-> reportQuantiles (fmap fst <$> csvfa) as "other/vectorfaf.md"
-> reportQuantiles (fmap snd <$> csvfa) as "other/vectorfaa.md"
->
-
-a full tick
-
-```include
-other/vectorr2.md
-```
-
-just function application
-
-```include
-other/vectorf.md
-```
-
-just forcing `a`:
-
-```include
-other/vectora.md
-```
-
-the f splice of f a
-
-```include
-other/vectorfaf.md
-```
-
-the a slice of fa
-
-```include
-other/vectorfaa.md
-```
-
-> pure ()
->
-
-helpers
----
-
-> showxs :: [Double] -> Double -> Text
-> showxs qs m =
-> sformat (" " % Formatting.expt 2) m <> ": " <>
-> mconcat (sformat (" " % prec 3) <$> ((/m) <$> qs))
->
-> deciles :: (Foldable f) => Int -> f Double -> [Double]
-> deciles n xs =
-> (\x -> fromMaybe 0 $
-> quantile x (tdigest xs :: TDigest 25)) <$>
-> ((/fromIntegral n) . fromIntegral <$> [0..n]) :: [Double]
->
-> reportQuantiles :: [[Cycles]] -> [Double] -> FilePath -> IO ()
-> reportQuantiles css as name =
-> writeFile name $ code $ zipWith showxs (deciles 5 . fmap fromIntegral <$> css) as
->
-> code :: [Text] -> Text
-> code cs = "\n~~~\n" <> intercalate "\n" cs <> "\n~~~\n"
->
-> histLine :: [Double] -> Chart' a
-> histLine xs =
-> lineChart (repeat (LineConfig 0.002 (Color 0 0 1 0.1))) widescreen
-> (zipWith (\x y -> [V2 x 0,V2 x y]) [0..] xs) <>
-> axes
-> ( chartAspect .~ widescreen
-> $ chartRange .~ Just
-> (Rect $ V2
-> (Range (0.0,fromIntegral $ length xs))
-> (Range (0,L.fold (L.Fold max 0 identity) xs)))
-> $ def)
diff --git a/perf.cabal b/perf.cabal
--- a/perf.cabal
+++ b/perf.cabal
@@ -1,10 +1,10 @@
name: perf
-version: 0.1.2
+version: 0.2.0
synopsis:
low-level performance statistics
description:
.
- See for example results and write-up.
+ A set of tools to measure time performance.
.
category:
project
@@ -34,108 +34,71 @@
exposed-modules:
Perf,
Perf.Measure,
- Perf.Cycles
+ Perf.Cycle
build-depends:
- base >= 4.7 && < 5,
- rdtsc,
+ base >= 4.7 && < 4.11,
+ containers,
foldl,
+ numhask >= 0.1.2 && < 0.2,
protolude,
+ rdtsc,
tdigest,
- containers,
time
default-extensions:
+ NegativeLiterals,
NoImplicitPrelude,
+ OverloadedStrings,
UnicodeSyntax,
BangPatterns,
- BinaryLiterals,
- DeriveFoldable,
- DeriveFunctor,
- DeriveGeneric,
- DeriveTraversable,
- DisambiguateRecordFields,
- EmptyCase,
- FlexibleContexts,
- FlexibleInstances,
- FunctionalDependencies,
- GADTSyntax,
- InstanceSigs,
- KindSignatures,
- LambdaCase,
- MonadComprehensions,
- MultiParamTypeClasses,
- MultiWayIf,
- NegativeLiterals,
- OverloadedStrings,
- ParallelListComp,
- PartialTypeSignatures,
- PatternSynonyms,
- RankNTypes,
- RecordWildCards,
- RecursiveDo,
- ScopedTypeVariables,
- TupleSections,
- TypeFamilies,
- TypeOperators
+ TypeSynonymInstances
executable perf-examples
default-language:
Haskell2010
ghc-options:
- -- -funbox-strict-fields
-fforce-recomp
- -- -threaded
-rtsopts
- -- -with-rtsopts=-N
-O2
hs-source-dirs:
examples
main-is:
- examples.lhs
+ examples.hs
build-depends:
- base >= 4.7 && < 5,
- protolude,
- perf,
- optparse-generic,
+ base >= 4.7 && < 4.11,
+ containers,
formatting,
- foldl,
+ numhask,
+ optparse-generic,
+ perf,
+ protolude,
text,
- vector,
- tdigest,
- chart-unit,
- mwc-probability
+ vector
default-extensions:
+ NegativeLiterals,
NoImplicitPrelude,
+ OverloadedStrings,
UnicodeSyntax,
- BangPatterns,
- BinaryLiterals,
- DeriveFoldable,
- DeriveFunctor,
- DeriveGeneric,
- DeriveTraversable,
- DisambiguateRecordFields,
- EmptyCase,
- FlexibleContexts,
- FlexibleInstances,
- FunctionalDependencies,
- GADTSyntax,
- InstanceSigs,
- KindSignatures,
- LambdaCase,
- MonadComprehensions,
- MultiParamTypeClasses,
- MultiWayIf,
+ ScopedTypeVariables
+
+test-suite test
+ default-language:
+ Haskell2010
+ type:
+ exitcode-stdio-1.0
+ hs-source-dirs:
+ test
+ main-is:
+ test.hs
+ build-depends:
+ base >= 4.7 && < 5,
+ doctest,
+ protolude,
+ perf
+ default-extensions:
NegativeLiterals,
+ NoImplicitPrelude,
OverloadedStrings,
- ParallelListComp,
- PartialTypeSignatures,
- PatternSynonyms,
- RankNTypes,
- RecordWildCards,
- RecursiveDo,
- ScopedTypeVariables,
- TupleSections,
- TypeFamilies,
- TypeOperators
+ UnicodeSyntax
source-repository head
type:
diff --git a/src/Perf.hs b/src/Perf.hs
--- a/src/Perf.hs
+++ b/src/Perf.hs
@@ -1,62 +1,114 @@
-{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# 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.
+--
+-- For example, here's some code doing some cheesey stuff:
+--
+-- > -- 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)
+--
+-- And here's the code after 'Perf'ification, measuring performance of the components.
+--
+-- > (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)
+--
+-- Running the code produces a tuple of the original computation results, and a Map of performance measurements that were specified. Indicative results:
+--
+-- > file read 4.92e5 cycles
+-- > length 1.60e6 cycles
+-- > print to screen 1.06e5 cycles
+-- > sum 8.12e3 cycles
+--
module Perf
- (
- -- * The Perf Monad
- PerfT
- , Perf
- , perf
- , perfN
- , runPerfT
- , evalPerfT
- , execPerfT
- , module Perf.Cycles
- , module Perf.Measure
- )
- where
+ ( PerfT
+ , Perf
+ , perf
+ , perfN
+ , runPerfT
+ , evalPerfT
+ , execPerfT
+ , module Perf.Cycle
+ , module Perf.Measure
+ ) where
-import Protolude
-import Perf.Measure
-import Perf.Cycles
import qualified Data.Map as Map
+import NumHask.Prelude
+import Perf.Cycle
+import Perf.Measure
-newtype PerfT m b a =
- PerfT { runPerf_ :: StateT (Map.Map Text b) m a }
- deriving
- ( Functor
- , Applicative
- , Monad
- )
+-- | 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
+ } deriving (Functor, Applicative, Monad)
+-- | The obligatory transformer over Identity
type Perf b a = PerfT Identity b a
instance (MonadIO m) => MonadIO (PerfT m b) where
liftIO = PerfT . liftIO
-perf :: (MonadIO m, Monoid b, Semigroup b) => 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
- return a'
+-- | 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 label m a =
+ PerfT $ do
+ st <- get
+ (m', a') <- lift $ runMeasure m a
+ put $ Map.insertWith (+) label m' st
+ return a'
-perfN :: (MonadIO m, Semigroup b, Monoid b) => Int -> Text -> Measure m b -> m a -> PerfT m b a
-perfN n label m a = PerfT $ do
- st <- get
- (m', a') <- lift $ runMeasureN n m a
- put $ Map.insertWith (<>) 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)
+ => Int
+ -> Text
+ -> Measure m b
+ -> m a
+ -> PerfT m b a
+perfN n label m a =
+ PerfT $ do
+ st <- get
+ (m', a') <- lift $ runMeasureN n m a
+ put $ Map.insertWith (<>) label m' st
+ return a'
+-- | Consume the PerfT layer and return a (result, measurement).
+--
+-- >>> :set -XOverloadedStrings
+-- >>> (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 p =
- flip runStateT Map.empty $ runPerf_ p
+runPerfT p = flip runStateT Map.empty $ runPerf_ p
+-- | Consume the PerfT layer and return the original monadic result.
+-- Fingers crossed, PerfT structure should be completely compiled away.
+--
+-- >>> result <- evalPerfT $ perf "sum" cycles (pure $ foldl' (+) 0 [0..10000])
+--
+-- > 50005000
evalPerfT :: (Monad m) => PerfT m b a -> m a
-evalPerfT p =
- flip evalStateT Map.empty $ runPerf_ p
+evalPerfT p = flip evalStateT Map.empty $ runPerf_ p
+-- | Consume a PerfT layer and return the measurement.
+--
+-- >>> 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 p =
- flip execStateT Map.empty $ runPerf_ p
+execPerfT p = flip execStateT Map.empty $ runPerf_ p
diff --git a/src/Perf/Cycle.hs b/src/Perf/Cycle.hs
new file mode 100644
--- /dev/null
+++ b/src/Perf/Cycle.hs
@@ -0,0 +1,241 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# OPTIONS_GHC -Wall #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- | 'tick' uses the rdtsc chipset to measure time performance of a computation.
+--
+-- The measurement unit - a 'Cycle' - is one oscillation of the chip crystal as measured by the instruction which inspects the TSC register.
+--
+-- For reference, a computer with a frequency of 2 GHz means that one cycle is equivalent to 0.5 nanoseconds.
+--
+module Perf.Cycle
+ ( -- $setup
+ Cycle
+ , tick_
+ , warmup
+ , tick
+ , app
+ , tickIO
+ , ticks
+ , qtick
+ , ticksIO
+ , tickns
+ , force
+ , replicateM'
+ , average
+ , deciles
+ , percentile
+ ) where
+
+import qualified Control.Foldl as L
+import Data.List
+import Data.TDigest
+import NumHask.Prelude hiding (force)
+import System.CPUTime.Rdtsc
+import qualified Protolude
+
+-- $setup
+-- >>> :set -XNoImplicitPrelude
+-- >>> import Perf.Cycle
+-- >>> let n = 1000
+-- >>> let a = 1000
+-- >>> let f x = foldl' (+) 0 [1 .. x]
+--
+
+
+-- | 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_:
+--
+-- >>> onetick <- tick_
+-- >>> ticks' <- replicateM 10 tick_
+-- >>> 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]
+-- > average over 1m: 20.08 cycles
+-- > 99.999% perc: 7,986
+-- > 99.9% perc: 50.97
+-- > 99th perc: 24.99
+-- > 40th perc: 18.37
+-- > [min, 10th, 20th, .. 90th, max]:
+-- > 12.00 16.60 17.39 17.88 18.37 18.86 19.46 20.11 20.75 23.04 5.447e5
+--
+-- The distribution of tick_ measurements is highly skewed, with the maximum being around 50k cycles, which is of the order of a GC. The important point on the distribution is around the 30th to 50th percentile, where you get a clean measure, usually free of GC activity and cache miss-fires
+tick_ :: IO Cycle
+tick_ = do
+ t <- rdtsc
+ t' <- rdtsc
+ pure (t' - t)
+
+-- | Warm up the register, to avoid a high first measurement. Without a warmup, one or more larger values can occur at the start of a measurement spree, and often are in the zone of an L2 miss.
+--
+-- >>> t <- tick_ -- first measure can be very high
+-- >>> _ <- warmup 100
+-- >>> t <- tick_ -- should be around 20 (3k for ghci)
+--
+warmup :: Int -> IO Double
+warmup n = do
+ ts <- replicateM n tick_
+ pure $ average ts
+
+-- | `tick f a` strictly applies a to f, and returns a (Cycle, f a)
+--
+-- >>> _ <- warmup 100
+-- >>> (cs, _) <- tick f a
+--
+-- > one tick: 197012 cycles
+-- > average over 1000: 10222.79 cycles -- 10 cycles per operation
+-- > [min, 30th, median, 90th, 99th, max]:
+-- > 1.002e4 1.011e4 1.013e4 1.044e4 1.051e4 2.623e4
+tick :: (a -> b) -> a -> IO (Cycle, b)
+tick f a = do
+ !t <- rdtsc
+ !a' <- pure (f a)
+ !t' <- rdtsc
+ pure (t' - t, a')
+
+-- | evaluates and measures an `IO a`
+--
+-- >>> (cs, _) <- tickIO (pure (f a))
+--
+tickIO :: IO a -> IO (Cycle, a)
+tickIO a = do
+ t <- rdtsc
+ !a' <- a
+ t' <- rdtsc
+ pure (t' - t, a')
+
+-- | needs more testing
+app :: t -> () -> t
+app e () = e
+{-# NOINLINE app #-}
+
+-- | n measurements of a tick
+--
+-- returns a list of Cycles and the last evaluated f a
+--
+-- GHC is very good as memoization, and any of the functions that measuring a computation multiple times are fraught. When a computation actually gets memoized is an inexact science. Current readings are:
+--
+-- > sum to 1000.0
+-- > Perf.ticks n f a 8.37e3 cycles
+-- > Main.ticks n f a 8.38e3 cycles
+-- > Perf.ticksIO n (pure $ f a) 8.38e3 cycles
+-- > Perf.qtick n f a 8.38e3 cycles
+-- > Main.qtick n f a 8.38e3 cycles
+-- > replicateM n (tick f a) 8.37e3 cycles
+-- > replicateM' n (tick f a) 9.74e3 cycles
+-- > replicateM n (tickIO (pure (f a))) 1.21e4 cycles
+-- > replicateM n (tick (app (f a)) ()) 9.72e3 cycles
+-- > replicateM n (tick identity (f n)) 18.2 cycles
+-- > replicateM n (tick (const (f a)) ()) 9.71e3 cycles
+-- > (replicateM n . tick f) <$> [1,10,100,1000,10000]: 16.3 16.2 16.3 16.2 16.2
+-- > Perf.tickns n f [1,10,100,1000,10000]: 16.2 16.2 16.2 16.2 16.2
+--
+-- >>> let n = 1000
+-- >>> (cs, fa) <- ticks n f a
+--
+ticks :: Int -> (a -> b) -> a -> IO ([Cycle], b)
+ticks n f a = do
+ ts <- replicateM' n (tick f a)
+ pure (fst <$> ts, snd $ last ts)
+{-# INLINE ticks #-}
+
+-- | returns the 40th percentile measurement and the last evaluated f a
+--
+-- >>> (c, fa) <- qtick n f a
+--
+qtick :: Int -> (a -> b) -> a -> IO (Double, b)
+qtick n f a = do
+ ts <- replicateM' n (tick f a)
+ pure (percentile 0.4 $ fst <$> ts, snd $ last ts)
+{-# INLINE qtick #-}
+
+-- | n measuremenst of a tickIO
+--
+-- returns an IO tuple; list of Cycles and the last evaluated f a
+--
+-- >>> (cs, fa) <- ticksIO n (pure $ f a)
+--
+ticksIO :: Int -> IO a -> IO ([Cycle], a)
+ticksIO n a = do
+ cs <- replicateM n (tickIO a)
+ pure (fst <$> cs, last $ snd <$> cs)
+
+-- | n measurements on each of a list of a's to be applied to f.
+--
+-- Currently memoizing it's ass off
+--
+-- > tickns n f [1,10,100,1000]
+--
+tickns :: Int -> (a -> b) -> [a] -> IO ([[Cycle]], [b])
+tickns n f as = do
+ cs <- sequence $ ticks n f <$> as
+ pure (fst <$> cs, snd <$> cs)
+
+-- | extra oomph for those hard to reach evaluations
+force :: (NFData a) => a -> a
+force x = x `deepseq` x
+
+-- | a replicateM with good attributes
+replicateM' :: Monad m => Int -> m a -> m [a]
+replicateM' n op' = go n []
+ where
+ go 0 acc = return $ reverse acc
+ go n' acc = do
+ x <- op'
+ go (n' - 1) (x : acc)
+
+-- | average of a Cycle foldable
+--
+-- > cAv <- average <$> ticks n f a
+--
+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 <- percentoile 0.4 <$> 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)
+
diff --git a/src/Perf/Cycles.hs b/src/Perf/Cycles.hs
deleted file mode 100644
--- a/src/Perf/Cycles.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-
-module Perf.Cycles where
-
-import Protolude
-import System.CPUTime.Rdtsc
-import Data.List
-import qualified Control.Foldl as L
-import Data.TDigest
-
--- | Cycles
-type Cycles = Word64
-
-instance Semigroup Cycles where
- (<>) = (+)
-
-instance Monoid Cycles where
- mempty = 0
- mappend = (+)
-
-
--- | `tick f a` applies a to f, and strictly returns a (number of cycles, application result) tuple
-tick :: (a -> b) -> a -> IO (Cycles, b)
-tick f a = do
- t <- rdtsc
- !a' <- return (f a)
- t' <- rdtsc
- return (t' - t, a')
-
--- | variation that just acts on an `a`
-tick' :: a -> IO (Cycles, a)
-tick' a = do
- t <- rdtsc
- !a' <- return a
- t' <- rdtsc
- return (t' - t, a')
-
--- | variation that takes an `IO a`
-tickM :: IO a -> IO (Cycles, a)
-tickM a = do
- t <- rdtsc
- !a' <- a
- t' <- rdtsc
- return (t' - t, a')
-
--- | variation that just measures the number of cycles to take a tick measurement
-tick_ :: IO Cycles
-tick_ = do
- t <- rdtsc
- t' <- rdtsc
- return (t' - t)
-
--- | `tickf f a` applies a to f, and strictly returns a (number of cycles, application result) tuple, measuring just the f effect
-tickf :: (a -> b) -> a -> IO (Cycles, b)
-tickf f a = do
- !a' <- pure a
- t <- rdtsc
- !a'' <- return (f a')
- t' <- rdtsc
- return (t' - t, a'')
-
--- | monadic version
-tickfM :: (a -> IO b) -> a -> IO (Cycles, b)
-tickfM f a = do
- !a' <- pure a
- t <- rdtsc
- !a'' <- f a'
- t' <- rdtsc
- return (t' - t, a'')
-
--- | `ticka f a` applies a to f, and strictly returns a (number of cycles, application result) tuple, measuring just the a effect
-ticka :: (a -> b) -> a -> IO (Cycles, b)
-ticka f a = do
- t <- rdtsc
- !a' <- pure a
- t' <- rdtsc
- !a'' <- return (f a')
- return (t' - t, a'')
-
--- | `tickfa f a` applies a to f, and strictly returns a (number of cycles, application result) tuple, measuring both the f and the a effects separately.
-tickfa :: (a -> b) -> a -> IO ((Cycles, Cycles), b)
-tickfa f a = do
- t_a <- rdtsc
- !a' <- pure a
- t_a' <- rdtsc
- !a'' <- return (f a')
- t_f <- rdtsc
- return ((t_f - t_a', t_a' - t_a), a'')
-
--- | n measurements of whatever tick engine
-spin :: Int -> ((a -> b) -> a -> IO (c, b)) ->
- (a -> b) -> a -> IO ([c], b)
-spin n tick f a = do
- ticks <- replicateM n (tick f a)
- pure (fst <$> ticks, snd $ last ticks)
-
-spins :: Int -> ((a -> b) -> a -> IO (c, b)) ->
- (a -> b) -> [a] -> IO ([[c]], [b])
-spins n t f as = do
- cs <- sequence $ spin n t f <$> as
- pure (fst <$> cs, snd <$> cs)
-
--- | n measurements of whatever tick engine
-spinM :: Int -> ((a -> IO b) -> a -> IO (c, b)) ->
- (a -> IO b) -> a -> IO ([c], b)
-spinM n tick f a = do
- ticks <- replicateM n (tick f a)
- pure (fst <$> ticks, snd $ last ticks)
-
--- | warm up the register, and the setup
-warmup :: Int -> IO Double
-warmup n = do
- ts <- replicateM n tick_
- pure $ average (fromIntegral <$> ts)
- where
- average cs = L.fold ((/) <$> L.sum <*> L.genericLength) cs
-
--- | helpers
-force :: (NFData a) => a -> a
-force x = x `deepseq` x
-
-replicateM' :: Monad m
- => Int -> m a -> m [a]
-replicateM' n op' = go n []
- where
- go 0 acc = return $ reverse acc
- go n' acc = do
- x <- op'
- go (n' - 1) (x : acc)
diff --git a/src/Perf/Measure.hs b/src/Perf/Measure.hs
--- a/src/Perf/Measure.hs
+++ b/src/Perf/Measure.hs
@@ -1,55 +1,82 @@
-{-# LANGUAGE RankNTypes #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -Wall #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- | Specification of a performance measurement type suitable for the 'PerfT' monad transformer.
module Perf.Measure
- where
-
-import Protolude
+ ( Measure(..)
+ , runMeasure
+ , runMeasureN
+ , cost
+ , cputime
+ , realtime
+ , count
+ , cycles
+ ) where
import Data.Time.Clock
+import NumHask.Prelude
+import Perf.Cycle as C
+import qualified Protolude as P
import System.CPUTime
-import Perf.Cycles as C
import System.CPUTime.Rdtsc
-data Measure m b = forall a. (Monoid b) => Measure
- { measure :: b
- , prestep :: m a
- , poststep :: a -> m b
- }
+-- | 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.
+--
+-- >>> let count = Measure 0 (pure ()) (pure 1)
+data Measure m b = forall a. (Additive b) => Measure
+ { measure :: b
+ , prestep :: m a
+ , 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 (Measure _ pre post) a = do
- p <- pre
- !a' <- a
- m' <- post p
- return (m', a')
+ p <- pre
+ !a' <- a
+ m' <- post p
+ return (m', a')
+-- | Measure once, but run an effect multiple times.
+--
+-- >>> r <- runMeasureN 1000 count (pure "joys")
+-- >>> r
+-- (1,"joys")
+--
runMeasureN :: (MonadIO m) => Int -> Measure m b -> m a -> m (b, a)
runMeasureN n (Measure _ pre post) a = do
- p <- pre
- replicateM_ (n - 1) a
- !a' <- a
- m' <- post p
- return (m', a')
+ p <- pre
+ replicateM_ (n - 1) a
+ !a' <- a
+ m' <- post p
+ return (m', a')
+-- | cost of a measurement in terms of the Measure's own units
+--
+-- >>> r <- cost count
+-- >>> r
+-- 1
cost :: (MonadIO m) => Measure m b -> m b
cost (Measure _ pre post) = do
p <- pre
post p
--- instances
-instance Monoid Integer where
- mempty = 0
- mappend = (+)
-
+-- | a measure using 'getCPUTime' from System.CPUTime (unit is picoseconds)
+--
+-- >>> r <- runMeasure cputime (pure $ foldl' (+) 0 [0..1000])
+--
+-- > (34000000,500500)
+--
cputime :: Measure IO Integer
cputime = Measure 0 start stop
where
@@ -58,31 +85,59 @@
t <- getCPUTime
return $ t - a
-instance Monoid NominalDiffTime where
- mempty = 0
- mappend = (+)
+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])
+--
+-- > (0.000046s,500500)
+--
realtime :: Measure IO NominalDiffTime
realtime = Measure m0 start stop
where
- m0 = fromInteger (0::Integer) :: NominalDiffTime
+ m0 = zero :: NominalDiffTime
start = getCurrentTime
stop a = do
t <- getCurrentTime
return $ diffUTCTime t a
-instance Monoid Int where
- mempty = 0
- mappend = (+)
-
+-- | a measure used to count iterations
+--
+-- >>> r <- runMeasure count (pure ())
+-- >>> r
+-- (1,())
+--
count :: Measure IO Int
count = Measure m0 start stop
where
- m0 = 0::Int
+ m0 = 0 :: Int
start = return ()
stop () = return 1
-cycles :: Measure IO Cycles
+-- | a Measure using the 'rdtsc' chip set (units are in cycles)
+--
+-- >>> r <- runMeasureN 1000 cycles (pure ())
+--
+-- > (120540,()) -- ghci-level
+-- > (18673,()) -- compiled with -O2
+--
+cycles :: Measure IO Cycle
cycles = Measure m0 start stop
where
m0 = 0
@@ -90,5 +145,3 @@
stop a = do
t <- rdtsc
return $ t - a
-
-
diff --git a/test/test.hs b/test/test.hs
new file mode 100644
--- /dev/null
+++ b/test/test.hs
@@ -0,0 +1,15 @@
+{-# OPTIONS_GHC -Wall #-}
+
+module Main where
+
+import Protolude
+import Test.DocTest
+
+main :: IO ()
+main = do
+ putStrLn ("Perf.Cycle DocTest" :: Text)
+ doctest ["src/Perf/Cycle.hs"]
+ putStrLn ("Perf.Measure DocTest" :: Text)
+ doctest ["src/Perf/Measure.hs"]
+ putStrLn ("Perf DocTest" :: Text)
+ doctest ["src/Perf.hs"]