perf 0.11.0.0 → 0.12.0.0

raw patch · 9 files changed

+1054/−306 lines, 9 filesdep ~containersdep ~deepseqdep ~rdtscPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers, deepseq, rdtsc

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• LICENSE +2/−2
• app/bench.hs +12/−0
• app/explore.hs +37/−56
• perf.cabal +147/−126
• readme.org +688/−0
• src/Perf.hs +3/−3
• src/Perf/Algos.hs +2/−2
• src/Perf/Report.hs +157/−117

@@ -1,3 +1,9 @@+0.12.0.0+===+* added reportMain and support for executable development.+* refactored app/perf-explore+* created app/perf-bench and aded as a `cabal bench` thing.+ 0.11.0.0 === * added Perf.Count

@@ -1,4 +1,4 @@-Copyright Author name here (c) 2018+Copyright (c) 2018, Tony Day  All rights reserved. @@ -13,7 +13,7 @@       disclaimer in the documentation and/or other materials provided       with the distribution. -    * Neither the name of Author name here nor the names of other+    * Neither the name of Tony Day nor the names of other       contributors may be used to endorse or promote products derived       from this software without specific prior written permission. 

@@ -0,0 +1,12 @@+-- | Sum example, measured using default settings.+module Main where++import Data.List qualified as List+import Perf+import Prelude++main :: IO ()+main = do+  let l = 1000+  let a = ExampleSum+  reportMain (List.intercalate "-" [show a, show l]) $ testExample (examplePattern a l)

@@ -19,16 +19,11 @@  data RunType = RunExample | RunExamples | RunNub | RunExampleIO | RunSums | RunLengths | RunGauge | RunNoOps | RunTicks deriving (Eq, Show) -data Options = Options-  { optionN :: Int,-    optionLength :: Int,-    optionStatDType :: StatDType,-    optionRunType :: RunType,-    optionMeasureType :: MeasureType,-    optionExample :: Example,-    optionGolden :: Golden,-    optionReportConfig :: ReportConfig,-    optionRawStats :: Bool+data ExploreOptions = ExploreOptions+  { exploreReportOptions :: ReportOptions,+    exploreRun :: RunType,+    exploreLength :: Int,+    exploreExample :: Example   }   deriving (Eq, Show) @@ -45,24 +40,19 @@     <|> flag' RunGauge (long "gauge" <> help "gauge runs on exmaple for comparison")     <|> pure RunExample -options :: Parser Options-options =-  Options-    <$> option auto (value 1000 <> long "runs" <> short 'n' <> help "number of runs to perform")-    <*> option auto (value 1000 <> long "length" <> short 'l' <> help "length of list")-    <*> parseStatD+exploreOptions :: Parser ExploreOptions+exploreOptions =+  ExploreOptions+    <$> parseReportOptions     <*> parseRun-    <*> parseMeasure+    <*> option auto (value 1000 <> long "length" <> short 'l' <> help "length of list")     <*> parseExample-    <*> parseGolden "golden"-    <*> parseReportConfig defaultReportConfig-    <*> switch (long "raw" <> short 'w' <> help "write raw statistics to file") -opts :: ParserInfo Options-opts =+exploreOpts :: ParserInfo ExploreOptions+exploreOpts =   info-    (options <**> helper)-    (fullDesc <> progDesc "perf benchmarking" <> header "basic perf callibration")+    (exploreOptions <**> helper)+    (fullDesc <> progDesc "perf exploration" <> header "examples of perf usage")  -- | * exampleIO exampleIO :: (Semigroup t) => PerfT IO t ()@@ -123,56 +113,47 @@  main :: IO () main = do-  o <- execParser opts-  let !n = optionN o-  let !l = optionLength o-  let s = optionStatDType o-  let a = optionExample o-  let r = optionRunType o-  let mt = optionMeasureType o-  let gold = goldenFromOptions [show r, show n, show l, show mt] (optionGolden o)-  let w = optionRawStats o-  let raw =-        "other/"-          <> intercalate "-" [show r, show n, show l, show mt]-          <> ".map"-  let cfg = optionReportConfig o+  o <- execParser exploreOpts+  let repOptions = exploreReportOptions o+  let n = reportN repOptions+  let s = reportStatDType repOptions+  let mt = reportMeasureType repOptions+  let !l = exploreLength o+  let a = exploreExample o+  let r = exploreRun o    case r of     RunNub -> do-      m <- execPerfT (measureDs mt n) $ void $ ffap "nub" nub [1 .. l]-      when w (writeFile raw (show m))-      report cfg gold (measureLabels mt) (statify s m)+      reportMainWith repOptions (show r) (ffap "nub" nub [1 .. l])     RunExample -> do-      m <- execPerfT (measureDs mt n) $ testExample (examplePattern a l)-      when w (writeFile raw (show m))-      report cfg gold (measureLabels mt) (statify s m)+      reportMainWith repOptions (intercalate "-" [show r, show a, show l]) $+        testExample (examplePattern a l)     RunExamples -> do-      m <- statExamples n l (measureDs mt)-      when w (writeFile raw (show m))-      report cfg gold (measureLabels mt) (statify s m)+      reportMainWith+        repOptions+        (intercalate "-" [show r, show l])+        (statExamples l)     RunExampleIO -> do       m1 <- execPerfT (measureDs mt 1) exampleIO       (_, (m', m2)) <- outer "outer-total" (measureDs mt 1) (measureDs mt 1) exampleIO       let ms = mconcat [Map.mapKeys (\x -> ["normal", x]) m1, Map.mapKeys (\x -> ["outer", x]) (m2 <> m')]       putStrLn ""-      when w (writeFile raw (show ms))-      report cfg gold (measureLabels mt) (fmap (statD s) <$> ms)+      let o' = replaceDefaultFilePath (intercalate "-" [show r, show mt, show s]) repOptions+      report o' (fmap (statD s) <$> ms)     RunSums -> do       m <- statSums n l (measureDs mt)-      when w (writeFile raw (show m))-      report cfg gold (measureLabels mt) (statify s m)+      let o' = replaceDefaultFilePath (intercalate "-" [show r, show mt, show n, show l, show s]) repOptions+      report o' (statify s m)     RunLengths -> do       m <- statLengths n l (measureDs mt)-      when w (writeFile raw (show m))-      report cfg gold (measureLabels mt) (statify s m)+      let o' = replaceDefaultFilePath (intercalate "-" [show r, show mt, show n, show l, show s]) repOptions+      report o' (statify s m)     RunNoOps -> do       m <- perfNoOps (measureDs mt n)-      when w (writeFile raw (show m))-      report cfg gold (measureLabels mt) (allStats 4 (Map.mapKeys (: []) m))+      let o' = replaceDefaultFilePath (intercalate "-" [show r, show mt, show n]) repOptions+      report o' (allStats 4 (Map.mapKeys (: []) m))     RunTicks -> do       m <- statTicksSums n l s-      when w (writeFile raw (show m))       reportOrg2D (fmap (expt (Just 3)) m)     RunGauge -> do       mapM_ testGaugeExample ((`examplePattern` l) <$> allExamples)

@@ -1,138 +1,159 @@-cabal-version:      3.0-name:               perf-version:            0.11.0.0-synopsis:           Low-level run time measurement.+cabal-version: 3.0+name: perf+version: 0.12.0.0+license: BSD-3-Clause+license-file: LICENSE+copyright: Tony Day (c) 2018+category: performance+author: Tony Day, Marco Zocca+maintainer: tonyday567@gmail.com+homepage: https://github.com/tonyday567/perf#readme+bug-reports: https://github.com/tonyday567/perf/issues+synopsis: Low-level run time measurement. description:-  A set of tools to measure performance of Haskell programs.-  See the Perf module for an example and full API documentation.+    A set of tools to measure performance of Haskell programs.+    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, Marco Zocca-maintainer:         tonyday567@gmail.com-copyright:          Tony Day-license:            BSD-3-Clause-license-file:       LICENSE-build-type:         Simple-tested-with:        GHC == 8.10.7 || ==9.2.8 || ==9.4.5 || ==9.6.2-extra-doc-files: ChangeLog.md+build-type: Simple+tested-with: GHC == 8.10.7 || ==9.2.8 || ==9.4.5 || ==9.6.2+extra-doc-files:+  ChangeLog.md+  readme.org  source-repository head-  type: git-  location: https://github.com/tonyday567/perf+    type: git+    location: https://github.com/tonyday567/perf -common ghc2021-stanza-  if impl(ghc >=9.2)-    default-language:-      GHC2021-  if impl(ghc <9.2)-    default-language:-      Haskell2010-    default-extensions:-      BangPatterns-      BinaryLiterals-      ConstrainedClassMethods-      ConstraintKinds-      DeriveDataTypeable-      DeriveFoldable-      DeriveFunctor-      DeriveGeneric-      DeriveLift-      DeriveTraversable-      DoAndIfThenElse-      EmptyCase-      EmptyDataDecls-      EmptyDataDeriving-      ExistentialQuantification-      ExplicitForAll-      FlexibleContexts-      FlexibleInstances-      ForeignFunctionInterface-      GADTSyntax-      GeneralisedNewtypeDeriving-      HexFloatLiterals-      ImplicitPrelude-      InstanceSigs-      KindSignatures-      MonomorphismRestriction-      MultiParamTypeClasses-      NamedFieldPuns-      NamedWildCards-      NumericUnderscores-      PatternGuards-      PolyKinds-      PostfixOperators-      RankNTypes-      RelaxedPolyRec-      ScopedTypeVariables-      StandaloneDeriving-      StarIsType-      TraditionalRecordSyntax-      TupleSections-      TypeApplications-      TypeOperators-      TypeSynonymInstances-  if impl(ghc <9.2) && impl(ghc >=8.10)-    default-extensions:-      ImportQualifiedPost-      StandaloneKindSignatures+common ghc-options-exe-stanza+    ghc-options:+        -fforce-recomp+        -funbox-strict-fields+        -rtsopts+        -threaded+        -with-rtsopts=-N  common ghc-options-stanza-  ghc-options:-    -Wall-    -Wcompat-    -Wincomplete-record-updates-    -Wincomplete-uni-patterns-    -Wredundant-constraints-    -Widentities-    -Wpartial-fields+    ghc-options:+        -Wall+        -Wcompat+        -Widentities+        -Wincomplete-record-updates+        -Wincomplete-uni-patterns+        -Wpartial-fields+        -Wredundant-constraints -library-  import: ghc2021-stanza-  import: ghc-options-stanza-  exposed-modules:-    Perf-    Perf.Algos-    Perf.BigO-    Perf.Count-    Perf.Measure-    Perf.Report-    Perf.Space-    Perf.Stats-    Perf.Time-    Perf.Types+common ghc2021-stanza+    if impl ( ghc >= 9.2 )+        default-language: GHC2021 -  hs-source-dirs:     src-  build-depends:-    base >=4.7 && <5,-    containers ^>=0.6,-    deepseq >=1.4.4 && <1.5,-    formatn >=0.2.1 && < 0.4,-    mtl >=2.2.2 && <2.4,-    numhask-space >=0.10 && < 0.12,-    optparse-applicative >=0.17 && <0.19,-    rdtsc ^>=1.3,-    recursion-schemes ^>=5.2.2,-    text >=1.2 && <2.1,-    time >=1.9 && <1.13,-    vector >=0.12.3 && <0.14,+    if impl ( ghc < 9.2 )+        default-language: Haskell2010+        default-extensions:+            BangPatterns+            BinaryLiterals+            ConstrainedClassMethods+            ConstraintKinds+            DeriveDataTypeable+            DeriveFoldable+            DeriveFunctor+            DeriveGeneric+            DeriveLift+            DeriveTraversable+            DoAndIfThenElse+            EmptyCase+            EmptyDataDecls+            EmptyDataDeriving+            ExistentialQuantification+            ExplicitForAll+            FlexibleContexts+            FlexibleInstances+            ForeignFunctionInterface+            GADTSyntax+            GeneralisedNewtypeDeriving+            HexFloatLiterals+            ImplicitPrelude+            InstanceSigs+            KindSignatures+            MonomorphismRestriction+            MultiParamTypeClasses+            NamedFieldPuns+            NamedWildCards+            NumericUnderscores+            PatternGuards+            PolyKinds+            PostfixOperators+            RankNTypes+            RelaxedPolyRec+            ScopedTypeVariables+            StandaloneDeriving+            StarIsType+            TraditionalRecordSyntax+            TupleSections+            TypeApplications+            TypeOperators+            TypeSynonymInstances -  ghc-options:        -O2+    if impl ( ghc < 9.2 ) && impl ( ghc >= 8.10 )+        default-extensions:+            ImportQualifiedPost+            StandaloneKindSignatures +library+    import: ghc-options-stanza+    import: ghc2021-stanza+    hs-source-dirs: src+    build-depends:+        , base                 >=4.7 && <5+        , containers           >=0.6 && <0.7+        , deepseq              >=1.4.4 && <1.6+        , formatn              >=0.2.1 && <0.4+        , mtl                  >=2.2.2 && <2.4+        , numhask-space        >=0.10 && <0.12+        , optparse-applicative >=0.17 && <0.19+        , rdtsc                >=1.3 && <1.4+        , recursion-schemes    ^>=5.2.2+        , text                 >=1.2 && <2.1+        , time                 >=1.9 && <1.13+        , vector               >=0.12.3 && <0.14+    exposed-modules:+        Perf+        Perf.Algos+        Perf.BigO+        Perf.Count+        Perf.Measure+        Perf.Report+        Perf.Space+        Perf.Stats+        Perf.Time+        Perf.Types+    ghc-options: -O2+ executable perf-explore-  import: ghc2021-stanza-  import: ghc-options-stanza-  main-is:          explore.hs-  hs-source-dirs:   app-  build-depends:-    base >=4.7 && <5,-    containers ^>=0.6,-    deepseq >=1.4.4 && <1.5,-    formatn >=0.2.1 && <0.4,-    gauge ^>=0.2.5,-    mtl >=2.2.2 && <2.4,-    optparse-applicative >=0.17 && <0.19,-    perf,-    text >=1.2 && <2.1,-  ghc-options:      -O2+    import: ghc-options-exe-stanza+    import: ghc-options-stanza+    import: ghc2021-stanza+    main-is: explore.hs+    hs-source-dirs: app+    build-depends:+        , base                 >=4.7 && <5+        , containers           >=0.6 && <0.7+        , deepseq              >=1.4.4 && <1.6+        , formatn              >=0.2.1 && <0.4+        , gauge                ^>=0.2.5+        , mtl                  >=2.2.2 && <2.4+        , optparse-applicative >=0.17 && <0.19+        , perf+        , text                 >=1.2 && <2.1+    ghc-options: -O2++benchmark perf-bench+    import: ghc-options-exe-stanza+    import: ghc-options-stanza+    import: ghc2021-stanza+    main-is: bench.hs+    hs-source-dirs: app+    build-depends:+        , base                 >=4.7 && <5+        , perf+    ghc-options: -O2+    type: exitcode-stdio-1.0

@@ -0,0 +1,688 @@+#+TITLE: perf+#+PROPERTY: header-args :exports both+#+PROPERTY: header-args :eval no-export++[[https://hackage.haskell.org/package/perf][file:https://img.shields.io/hackage/v/perf.svg]] [[https://github.com/tonyday567/perf/actions?query=workflow%3Ahaskell-ci][file:https://github.com/tonyday567/perf/workflows/haskell-ci/badge.svg]]++* Introduction++~perf~ provides some ideas, code and a library for low-level performance measurement for Haskell hacking. The library:++- provides a monad transformer, ~PerfT~, as a light-weight wrapper for use on existing code. ~PerfT~ modifications can be included in code bases, as opposed to performance being separated code and  process, with any effects able to be erased at compile time with ~evalPerfT~.++- focuses on using the [[https://en.wikipedia.org/wiki/Time_Stamp_Counter][rdtsc]] instruction set that comes with the x86 chip to measure accurate time performance as number of clock cycles.++- abstracts the concept of what is being measured, so that concepts such as counters, debug checks, time and space performance can be treated equivalently.++* Setup++Note that running this readme.org is very slow compared with an external process which accesses the compiled version of the library.++#+begin_src haskell :results output+:r+:set prompt "> "+:set -Wno-type-defaults+:set -Wno-unused-do-bind+:set -Wno-name-shadowing+:set -XOverloadedStrings+:set -XOverloadedLabels+import Perf+import Data.FormatN+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import qualified Data.Map.Strict as Map+import Control.Monad+import Data.Bifunctor+putStrLn "ok"+#+end_src++#+RESULTS:+#+begin_example+Preprocessing library for perf-0.12.0.0..+Building library for perf-0.12.0.0..+[ 7 of 10] Compiling Perf.Report      ( src/Perf/Report.hs, /Users/tonyday/haskell/perf/dist-newstyle/build/x86_64-osx/ghc-9.6.2/perf-0.12.0.0/build/Perf/Report.o, /Users/tonyday/haskell/perf/dist-newstyle/build/x86_64-osx/ghc-9.6.2/perf-0.12.0.0/build/Perf/Report.dyn_o ) [Source file changed]+[10 of 10] Compiling Perf             ( src/Perf.hs, /Users/tonyday/haskell/perf/dist-newstyle/build/x86_64-osx/ghc-9.6.2/perf-0.12.0.0/build/Perf.o, /Users/tonyday/haskell/perf/dist-newstyle/build/x86_64-osx/ghc-9.6.2/perf-0.12.0.0/build/Perf.dyn_o ) [Source file changed]+Preprocessing benchmark 'perf-bench' for perf-0.12.0.0..+GHCi, version 9.6.2: https://www.haskell.org/ghc/  :? for help+Loaded GHCi configuration from /Users/tonyday/haskell/perf/.ghci+[1 of 2] Compiling Main             ( app/bench.hs, interpreted )+Ok, one module loaded.+> [1 of 2] Compiling Main             ( app/bench.hs, interpreted )+Ok, one module loaded.+>+>+ok+#+end_example++* Time+** What is a tick?++The fundamental operation of Perf.Time is tick, which sandwiches a (strict) function application between two readings of the rdstc chip.++#+begin_src haskell :results output :exports both+:t tick+#+end_src++#+RESULTS:+: tick :: (a -> b) -> a -> IO (Cycles, b)++tick returns in the IO monad, because reading a cycle counter is an IO effect. The trivial but fundamental point is that performance measurement effects the computation being measured.++Unlike benchmarking-style libraries, such as criterion, the result of the computation is passed through along with the cycle count. In this way, the `Perf` monad can be inserted into the midst of a computation in an attempt to measure performance in-situ as opposed to sitting off in a separate and perhaps unrepresentative process.++** tick_++tick_ measures the number of cycles between two clock reads.++#+begin_src haskell :results output :exports both+:t tick_+#+end_src++#+RESULTS:+: tick_ :: IO Cycles++#+begin_src haskell :results output :exports both+fmap word <$> replicateM 10 tick_+#+end_src++#+RESULTS:+: [1722,788,630,606,608,620,596,638,596,598]++** multiple ticks++#+begin_src haskell :results output :exports both+fmap (fmap (word . fst)) . replicateM 10 $ tick (const ()) ()+#+end_src++#+RESULTS:+: [6180,3282,2736,2712,2676,2670,2660,2634,2926,2656]++Here, ~const () ()~ was evaluated and took 6.1k cycles for the first effect, reducing down to 2.6k after 10 effects. What it did in that time we will never know, really, at least from usage of ~perf~. 2.2k cycles is, on my 2.5GHz machine equal to 2200 / 2.5e9 = 8.8e-7 of a second or 880 nanoseconds.++** tickIO++~tickIO~ measures the evaluation of an IO value.++#+begin_src haskell :results output :exports both+:t tickIO+#+end_src++#+RESULTS:+: tickIO :: IO a -> IO (Cycles, a)++#+begin_src haskell :results output :exports both+fmap (fmap (word . fst)) . replicateM 10 $ tickIO (pure ())+#+end_src++#+RESULTS:+: [5508,1632,1378,1210,1576,1214,1160,1174,1176,1176]++** sum example++#+begin_src haskell :exports both+fmap (expt (Just 2) . fromIntegral) . fst <$> ticks 10 sum ([1..10000] :: [Double])+#+end_src++#+RESULTS:+| 2.0e6 | 1.3e6 | 1.2e6 | 6.1e6 | 1.5e6 | 1.7e6 | 3.0e6 | 6.4e5 | 6.2e5 | 1.7e6 |+++#+begin_src haskell :results output :exports both+ts <- ticks 10000 sum ([1..1000] :: [Double])+print $ average (fmap fromIntegral $ fst ts)+#+end_src++#+RESULTS:+:+: 54619.4812++* PerfT++~PerfT~ allows for multiple measurement points and is polymorphic in what is being measured. It returns a Map of results held in State.++Compare a lower-level usage of ticks, measuring the average of summing to one thousand over one thousand trials:++#+begin_src haskell :results output :exports both+first (average . fmap fromIntegral) <$> ticks 1000 sum [1..1000]+#+end_src++#+RESULTS:+: (73752.368,500500)++... with PerfT usage++#+begin_src haskell :results output :exports both+second (fmap (average . fmap fromIntegral)) <$> runPerfT (times 1000) (sum |$| [1..1000])+#+end_src++#+RESULTS:+: (500500,fromList [("",62706.844)])++Comparing performance of sum versus a list fusion approach:++#+begin_src haskell :results output :exports both+fmap (average . fmap fromIntegral) <$> (execPerfT (times 1000) $ do; (fap "sum" sum [1..1000]); (fap "fusion" (\x -> sum [1..x]) 1000))+#+end_src++#+RESULTS:+: fromList [("fusion",114013.79),("sum",63906.848)]++An IO example++#+begin_src haskell+exampleIO' :: IO ()+exampleIO' = do+  txt <- Text.readFile "src/Perf.hs"+  let n = Text.length txt+  Text.putStrLn $ "length of file is: " <> Text.pack (show n)+#+end_src++#+begin_src haskell :results output :exports both+exampleIO = execPerfT time (do+  txt <- fam "file_read" (Text.readFile "src/Perf.hs")+  n <- fap "length" Text.length txt+  fam "print_result" (Text.putStrLn $ "length of file is: " <> Text.pack (show n)))+#+end_src++#+begin_src sh :results output :exports both+perf-explore --exampleIO --record --check+#+end_src++#+RESULTS:+#+begin_example+length of file is: 1751+length of file is: 1751++label1              label2              label3              old_result          new_result          status++normal              file-read           time                4.28e5              4.19e5+normal              length              time                5.61e3              5.64e3+normal              print-result        time                5.47e4              5.38e4+outer               file-read           time                9.37e4              9.46e4+outer               length              time                5.38e3              5.40e3+outer               outer-total         time                1.11e5              1.12e5+outer               print-result        time                5.46e3              5.55e3+#+end_example++* perf-explore++~perf-explore~ contains some exploratory routines used to develop =perf=++#+begin_src sh :results output :exports both+perf-explore --help+#+end_src++#+RESULTS:+#+begin_example+examples of perf usage++Usage: perf-explore [-n|--runs ARG]+                    [--best | --median | --average | --averagesecs]+                    [--time | --space | --spacetime | --allocation | --count]+                    [-g|--golden ARG] [--nocheck] [-r|--record]+                    [--header | --noheader] [--error ARG] [--warning ARG]+                    [--improved ARG]+                    [--sums | --lengths | --nub | --examples | --example |+                      --exampleIO | --noops | --ticks | --gauge]+                    [-l|--length ARG]+                    [--sumFuse | --sum | --lengthF | --constFuse | --mapInc |+                      --noOp]++  perf exploration++Available options:+  -n,--runs ARG            number of runs to perform+  --best                   report upper decile+  --median                 report median+  --average                report average+  --averagesecs            report average in seconds+  --time                   measure time performance+  --space                  measure space performance+  --spacetime              measure both space and time performance+  --allocation             measure bytes allocated+  --count                  measure count+  -g,--golden ARG          golden file name+  --nocheck                do not check versus the golden file+  -r,--record              record the result to the golden file+  --header                 include headers+  --noheader               dont include headers+  --error ARG              error level+  --warning ARG            warning level+  --improved ARG           improved level+  --sums                   run on sum algorithms+  --lengths                run on length algorithms+  --nub                    nub test+  --examples               run on example algorithms+  --example                run on the example algorithm+  --exampleIO              exampleIO test+  --noops                  noops test+  --ticks                  tick test+  --gauge                  gauge runs on exmaple for comparison+  -l,--length ARG          length of list+  --sumFuse                fused sum pipeline+  --sum                    sum+  --lengthF                foldr id length+  --constFuse              fused const pipeline+  --mapInc                 fmap (+1)+  --noOp                   const ()+  -h,--help                Show this help text+#+end_example++#+begin_src haskell :results output :exports both+fmap averageI <$> execPerfT (times 10000) (sum |$| [1..1000])+#+end_src++#+RESULTS:+: fromList [("",54874.5718)]++The equivalent to the above code is:++#+begin_src sh :results output :exports both+perf-explore -n 10000 -l 1000 --sum+#+end_src++#+RESULTS:+: label1              label2              results+:+: sum                 time                1.46e4++** noops++This no-op experiment is useful to understand the pure time performance of the machinery around measurement. It can be (re)run with:++#+begin_src sh :results output :exports both+perf-explore --noops+#+end_src++#+RESULTS:+#+begin_example+label1              label2              label3              results++const               1st                 time                4.46e2+const               2nd                 time                2.20e1+const               3rd                 time                2.20e1+const               4th                 time                2.20e1+const               average             time                2.22e1+const               best                time                2.10e1+const               median              time                2.19e1+pure                1st                 time                1.46e2+pure                2nd                 time                3.40e1+pure                3rd                 time                2.40e1+pure                4th                 time                2.40e1+pure                average             time                2.41e1+pure                best                time                1.86e1+pure                median              time                2.42e1+#+end_example++** measurement context++Exploration of how the code surrounding measurement effects performance.++#+begin_src sh :results drawer :exports both+perf-explore -n 1000 -l 1000 --ticks+#+end_src++#+RESULTS:+:results:+|               | stepTime |   tick | tickForce | tickForceArgs | tickLazy | tickWHNF |  times |+| sumAux        |   1.49e4 | 1.46e4 |    1.46e4 |        1.98e4 |   1.99e1 |   1.45e4 | 1.44e4 |+| sumCata       |   1.45e4 | 1.44e4 |    1.46e4 |        1.46e4 |   1.99e1 |   1.44e4 | 1.44e4 |+| sumCo         |   1.64e4 | 2.06e4 |    1.46e4 |        1.45e4 |   2.31e1 |   1.85e4 | 2.10e4 |+| sumCoCase     |   1.30e4 | 2.18e4 |    1.01e4 |        1.39e4 |   1.99e1 |   1.02e4 | 1.08e4 |+| sumCoGo       |   1.92e4 | 1.68e4 |    1.45e4 |        1.71e4 |   1.98e1 |   1.45e4 | 1.54e4 |+| sumF          |   1.33e4 | 1.34e4 |    1.34e4 |        1.34e4 |   1.97e1 |   1.34e4 | 1.34e4 |+| sumFlip       |   1.34e4 | 1.33e4 |    1.66e4 |        1.55e4 |   1.98e1 |   1.33e4 | 1.34e4 |+| sumFlipLazy   |   1.33e4 | 1.37e4 |    1.88e4 |        1.40e4 |   1.97e1 |   1.34e4 | 1.35e4 |+| sumFoldr      |   1.45e4 | 1.59e4 |    1.58e4 |        1.48e4 |   2.12e1 |   1.52e4 | 1.44e4 |+| sumFuse       |   2.01e3 | 1.80e3 |    1.81e3 |        1.54e3 |   1.97e1 |   2.04e3 | 1.65e3 |+| sumFuseFoldl' |   2.14e3 | 1.80e3 |    1.92e3 |        1.71e3 |   1.97e1 |   1.98e3 | 1.66e3 |+| sumFuseFoldr  |   8.58e3 | 5.43e3 |    5.13e3 |        5.84e3 |   1.97e1 |   5.26e3 | 7.13e3 |+| sumFusePoly   |   1.92e3 | 1.93e3 |    1.96e3 |        1.58e3 |   2.00e1 |   1.60e3 | 1.94e3 |+| sumLambda     |   1.34e4 | 1.34e4 |    1.35e4 |        1.33e4 |   2.05e1 |   1.34e4 | 1.34e4 |+| sumMono       |   1.35e4 | 1.34e4 |    1.34e4 |        1.34e4 |   1.98e1 |   1.33e4 | 1.38e4 |+| sumPoly       |   2.90e4 | 1.34e4 |    5.43e4 |        2.90e4 |   2.01e1 |   1.34e4 | 2.90e4 |+| sumSum        |   1.33e4 | 1.34e4 |    1.33e4 |        1.34e4 |   1.96e1 |   1.34e4 | 1.34e4 |+| sumTail       |   1.47e4 | 1.59e4 |    1.34e4 |        1.81e4 |   2.02e1 |   1.34e4 | 1.33e4 |+| sumTailLazy   |   1.35e4 | 1.39e4 |    1.37e4 |        1.34e4 |   2.18e1 |   1.38e4 | 1.36e4 |+:end:+++#+begin_src sh :results drawer :exports both+perf-explore -n 100000 -l 1000 --ticks+#+end_src++#+RESULTS:+:results:+|               | stepTime |   tick | tickForce | tickForceArgs | tickLazy | tickWHNF |  times |+| sumAux        |   1.83e4 | 1.83e4 |    1.81e4 |        1.81e4 |   1.75e1 |   1.81e4 | 1.86e4 |+| sumCata       |   2.16e4 | 2.16e4 |    2.08e4 |        2.09e4 |   1.75e1 |   2.11e4 | 2.09e4 |+| sumCo         |   1.83e4 | 1.82e4 |    1.82e4 |        1.88e4 |   1.74e1 |   1.81e4 | 1.81e4 |+| sumCoCase     |   1.59e4 | 1.87e4 |    1.54e4 |        1.57e4 |   1.76e1 |   1.83e4 | 1.54e4 |+| sumCoGo       |   2.06e4 | 2.07e4 |    2.07e4 |        2.11e4 |   1.74e1 |   2.07e4 | 2.12e4 |+| sumF          |   8.87e3 | 9.05e3 |    8.61e3 |        8.73e3 |   1.73e1 |   8.66e3 | 8.84e3 |+| sumFlip       |   8.57e3 | 8.66e3 |    8.49e3 |        8.65e3 |   1.74e1 |   8.70e3 | 8.80e3 |+| sumFlipLazy   |   5.60e3 | 8.68e3 |    8.74e3 |        5.91e3 |   1.75e1 |   8.91e3 | 5.53e3 |+| sumFoldr      |   2.14e4 | 2.10e4 |    2.08e4 |        2.08e4 |   1.75e1 |   2.09e4 | 2.12e4 |+| sumFuse       |   2.23e3 | 2.13e3 |    2.11e3 |        2.02e3 |   1.69e1 |   1.98e3 | 2.15e3 |+| sumFuseFoldl' |   2.14e3 | 2.03e3 |    2.20e3 |        1.97e3 |   1.76e1 |   2.22e3 | 2.14e3 |+| sumFuseFoldr  |   1.22e4 | 1.28e4 |    1.23e4 |        1.28e4 |   1.69e1 |   1.26e4 | 1.23e4 |+| sumFusePoly   |   1.67e3 | 1.47e3 |    1.46e3 |        1.47e3 |   1.71e1 |   1.42e3 | 1.65e3 |+| sumLambda     |   9.04e3 | 8.75e3 |    8.70e3 |        8.80e3 |   1.77e1 |   8.70e3 | 9.09e3 |+| sumMono       |   5.97e3 | 5.96e3 |    5.82e3 |        6.26e3 |   1.85e1 |   5.69e3 | 5.91e3 |+| sumPoly       |   8.74e3 | 8.85e3 |    8.70e3 |        8.73e3 |   1.76e1 |   8.64e3 | 8.76e3 |+| sumSum        |   5.90e3 | 6.36e3 |    5.78e3 |        5.78e3 |   1.81e1 |   6.05e3 | 5.88e3 |+| sumTail       |   1.21e4 | 6.48e3 |    5.85e3 |        1.19e4 |   1.76e1 |   5.86e3 | 1.22e4 |+| sumTailLazy   |   6.05e3 | 8.40e3 |    6.02e3 |        5.74e3 |   1.75e1 |   5.91e3 | 5.94e3 |+:end:++*** short list+#+begin_src sh :results drawer :exports both+perf-explore -n 10000 -l 10 --best --ticks+#+end_src++#+RESULTS:+:results:+|               | stepTime |   tick | tickForce | tickForceArgs | tickLazy | tickWHNF |  times |+| sumAux        |   8.94e1 | 9.30e1 |    9.15e1 |        8.97e1 |   1.54e1 |   9.14e1 | 8.96e1 |+| sumCata       |   9.74e1 | 9.79e1 |    9.78e1 |        9.81e1 |   1.55e1 |   9.77e1 | 9.62e1 |+| sumCo         |   9.11e1 | 1.16e2 |    9.15e1 |        9.13e1 |   1.51e1 |   9.11e1 | 8.92e1 |+| sumCoCase     |   9.05e1 | 9.21e1 |    9.18e1 |        9.18e1 |   1.53e1 |   8.99e1 | 8.90e1 |+| sumCoGo       |   9.76e1 | 9.90e1 |    9.76e1 |        9.84e1 |   1.54e1 |   9.76e1 | 9.70e1 |+| sumF          |   7.54e1 | 7.94e1 |    7.75e1 |        7.78e1 |   1.53e1 |   7.73e1 | 7.56e1 |+| sumFlip       |   7.72e1 | 8.07e1 |    7.75e1 |        7.75e1 |   1.51e1 |   7.78e1 | 7.55e1 |+| sumFlipLazy   |   7.74e1 | 7.93e1 |    7.72e1 |        7.78e1 |   1.55e1 |   7.62e1 | 7.55e1 |+| sumFoldr      |   9.75e1 | 9.88e1 |    9.70e1 |        9.77e1 |   1.52e1 |   9.78e1 | 9.71e1 |+| sumFuse       |   3.59e1 | 3.53e1 |    3.52e1 |        3.22e1 |   1.49e1 |   3.33e1 | 3.22e1 |+| sumFuseFoldl' |   3.52e1 | 3.50e1 |    3.52e1 |        3.30e1 |   1.50e1 |   3.33e1 | 3.27e1 |+| sumFuseFoldr  |   5.00e1 | 4.99e1 |    5.06e1 |        4.91e1 |   1.50e1 |   4.91e1 | 4.94e1 |+| sumFusePoly   |   4.42e1 | 4.39e1 |    4.36e1 |        4.19e1 |   1.51e1 |   4.15e1 | 4.31e1 |+| sumLambda     |   7.93e1 | 8.10e1 |    7.94e1 |        7.93e1 |   1.54e1 |   7.92e1 | 7.73e1 |+| sumMono       |   6.33e1 | 6.56e1 |    6.36e1 |        6.36e1 |   1.53e1 |   6.35e1 | 6.31e1 |+| sumPoly       |   7.93e1 | 8.01e1 |    7.92e1 |        7.93e1 |   1.53e1 |   7.93e1 | 7.73e1 |+| sumSum        |   7.93e1 | 7.98e1 |    7.95e1 |        7.95e1 |   1.52e1 |   7.93e1 | 7.73e1 |+| sumTail       |   6.75e1 | 6.99e1 |    6.80e1 |        6.78e1 |   1.56e1 |   6.70e1 | 6.72e1 |+| sumTailLazy   |   6.80e1 | 7.18e1 |    6.80e1 |        6.89e1 |   1.52e1 |   6.85e1 | 6.72e1 |+:end:++*** long list+#+begin_src sh :results drawer :exports both+perf-explore -n 100 -l 100000 --best --ticks+#+end_src++#+RESULTS:+:results:+|               | stepTime |   tick | tickForce | tickForceArgs | tickLazy | tickWHNF |  times |+| sumAux        |   2.26e6 | 2.28e6 |    2.28e6 |        2.25e6 |   1.68e1 |   2.31e6 | 2.26e6 |+| sumCata       |   2.84e6 | 2.82e6 |    2.81e6 |        3.21e6 |   1.56e1 |   2.82e6 | 2.81e6 |+| sumCo         |   2.26e6 | 2.27e6 |    5.02e6 |        2.27e6 |   1.66e1 |   2.28e6 | 2.28e6 |+| sumCoCase     |   2.28e6 | 2.30e6 |    2.32e6 |        2.28e6 |   1.48e1 |   2.97e6 | 2.30e6 |+| sumCoGo       |   2.84e6 | 2.80e6 |    2.84e6 |        2.85e6 |   1.51e1 |   2.81e6 | 2.81e6 |+| sumF          |   7.76e5 | 7.78e5 |    7.80e5 |        7.81e5 |   1.51e1 |   9.76e5 | 7.05e5 |+| sumFlip       |   7.48e5 | 9.04e5 |    7.46e5 |        7.43e5 |   1.68e1 |   7.48e5 | 7.44e5 |+| sumFlipLazy   |   1.21e6 | 1.22e6 |    1.19e6 |        1.19e6 |   1.61e1 |   1.20e6 | 1.20e6 |+| sumFoldr      |   3.63e6 | 2.87e6 |    3.25e6 |        2.81e6 |   1.45e1 |   5.89e6 | 2.81e6 |+| sumFuse       |   1.92e5 | 1.92e5 |    1.92e5 |        1.92e5 |   1.47e1 |   1.92e5 | 1.92e5 |+| sumFuseFoldl' |   1.92e5 | 1.92e5 |    1.92e5 |        1.92e5 |   1.52e1 |   1.92e5 | 1.92e5 |+| sumFuseFoldr  |   1.68e6 | 1.64e6 |    1.65e6 |        1.65e6 |   1.50e1 |   1.65e6 | 1.65e6 |+| sumFusePoly   |   1.32e5 | 1.28e5 |    1.28e5 |        1.28e5 |   1.48e1 |   1.32e5 | 1.28e5 |+| sumLambda     |   7.90e5 | 8.01e5 |    7.93e5 |        7.92e5 |   1.57e1 |   7.93e5 | 7.92e5 |+| sumMono       |   7.86e5 | 8.04e5 |    7.87e5 |        7.83e5 |   1.48e1 |   7.99e5 | 7.88e5 |+| sumPoly       |   7.99e5 | 8.18e5 |    8.06e5 |        8.00e5 |   1.64e1 |   8.10e5 | 8.00e5 |+| sumSum        |   7.82e5 | 7.92e5 |    7.85e5 |        7.82e5 |   1.66e1 |   7.88e5 | 7.87e5 |+| sumTail       |   7.43e5 | 7.84e5 |    8.23e5 |        8.18e5 |   1.61e1 |   7.89e5 | 7.38e5 |+| sumTailLazy   |   1.35e6 | 1.37e6 |    1.34e6 |        1.33e6 |   1.58e1 |   1.35e6 | 1.34e6 |+:end:++** sums++#+begin_src sh :output drawer :exports both+perf-explore -n 1000 -l 1000 --sums+#+end_src++#+RESULTS:+| label1        | label2 | results |+|               |        |         |+| sumAux        | time   | 16200.0 |+| sumCata       | time   | 15600.0 |+| sumCo         | time   | 19100.0 |+| sumCoCase     | time   | 16300.0 |+| sumCoGo       | time   | 15700.0 |+| sumF          | time   | 10500.0 |+| sumFlip       | time   | 10500.0 |+| sumFlipLazy   | time   |  6130.0 |+| sumFoldr      | time   | 16900.0 |+| sumFuse       | time   |  1950.0 |+| sumFuseFoldl' | time   |  1950.0 |+| sumFuseFoldr  | time   | 14600.0 |+| sumFusePoly   | time   |  1400.0 |+| sumLambda     | time   |  9780.0 |+| sumMono       | time   | 11200.0 |+| sumPoly       | time   | 11500.0 |+| sumSum        | time   | 11100.0 |+| sumTail       | time   | 11000.0 |+| sumTailLazy   | time   | 11100.0 |++** lengths++#+begin_src sh :exports both+perf-explore -n 1000 -l 1000 --lengths+#+end_src++#+RESULTS:+| label1           | label2 | results |+|                  |        |         |+| lengthAux        | time   | 11000.0 |+| lengthCo         | time   | 11100.0 |+| lengthCoCase     | time   | 10500.0 |+| lengthF          | time   |  9540.0 |+| lengthFMono      | time   |  9190.0 |+| lengthFlip       | time   |  9770.0 |+| lengthFlipLazy   | time   |  4830.0 |+| lengthFoldr      | time   | 10100.0 |+| lengthFoldrConst | time   | 11100.0 |+| lengthTail       | time   |  9830.0 |+| lengthTailLazy   | time   |  9540.0 |++** Gauge comparison++#+begin_src sh :results output :exports both+perf-explore -n 1000 -l 1000 --average --gauge+#+end_src++#+RESULTS:+#+begin_example+sumFuse+benchmarking function ... 
function                                 time                 849.4 ns++benchmarking function ... 
function                                 time                 848.6 ns++sum+benchmarking function ... 
function                                 time                 3.786 μs++benchmarking function ... 
function                                 time                 3.791 μs++lengthF+benchmarking function ... 
function                                 time                 1.863 μs++benchmarking function ... 
function                                 time                 1.872 μs++constFuse+benchmarking function ... 
function                                 time                 571.0 ns++benchmarking function ... 
function                                 time                 1.080 μs++mapInc+benchmarking function ... 
function                                 time                 9.203 ns++benchmarking function ... 
function                                 time                 15.99 μs++noop+benchmarking function ... 
function                                 time                 5.770 ns++benchmarking function ... 
function                                 time                 4.740 ns++#+end_example++** Space++Data is collected from GHCStats++- allocated_bytes+- gcs+- gcdetails_live_bytes+- max_live_bytes+- max_mem_in_use_bytes++#+begin_src sh :results ouput :exports both+perf-explore -n 10 -l 100000 --space +RTS -T -RTS+#+end_src++#+RESULTS:+| label1 | label2       |  results |+|        |              |          |+| sum    | MaxMem       | 839000.0 |+| sum    | allocated    | 416000.0 |+| sum    | gcLiveBytes  | 220000.0 |+| sum    | gcollects    |      0.1 |+| sum    | maxLiveBytes |      0.0 |++* Perf.BigO++Perf.BigO represents functionality to determine the complexity order for a computation.++We could do a regression and minimise the error term, but we know that the largest run contains the most information; we would need to weight the simulations according to some heuristic.++Instead, we:++- estimate the order factor for each possible Order, from N3 to N0, setting the highest n run constant factor to zero,+- pick the order based on lowest absolute error result summed across all the runs,++#+begin_src haskell :results output :exports both+import qualified Prelude as P+import Data.List (nub)+estOrder (\x -> sum $ nub [1..x]) 10 [1,10,100,1000]+#+end_src++#+RESULTS:+: BigOrder {bigOrder = N2, bigFactor = 13.545801, bigConstant = 0.0}++* References++[[https://github.com/haskell-perf/checklist][The Haskell performance checklist]]++[[https://github.com/ndmitchell/spaceleak][ndmitchell/spaceleak: Notes on space leaks]]++** Core++[[https://ghc.gitlab.haskell.org/ghc/doc/users_guide/debugging.html#options-debugging][5.13. Debugging the compiler]]++#+begin_src sh+ghc app/speed.hs -ddump-simpl -ddump-to-file -fforce-recomp -dlint -O+#+end_src++[[https://wiki.haskell.org/Performance/GHC#Looking_at_the_Core][haskell wiki: Looking at the Core]]++[[https://godbolt.org/][godbolt]]++[[https://gitlab.haskell.org/ghc/ghc/-/issues/15185][ghc issue 15185: Enum instance for IntX / WordX are inefficient]]++[[https://fixpt.de/blog/2017-12-04-strictness-analysis-part-1.html][fixpt - All About Strictness Analysis (part 1)]]++** Profiling+*** setup+[[https://ghc.gitlab.haskell.org/ghc/doc/users_guide/profiling.html#prof-heap][8. Profiling]]++A typical configuration step for profiling:++#+begin_src sh :results output+cabal configure --enable-library-profiling --enable-executable-profiling -fprof-auto -fprof -write-ghc-environment-files=always+#+end_src++A cabal.project.local with profiling enabled:++#+begin_quote+write-ghc-environment-files: always+ignore-project: False+flags: +prof +prof-auto+library-profiling: True+executable-profiling: True+#+end_quote++Examples from markup-parse R&D:++Executable compilation:++#+begin_src sh :results output+ghc -prof -fprof-auto -rtsopts app/speed0.hs -threaded -fforce-recomp+#+end_src++Executable run:++#+begin_src sh :results output+app/speed0 +RTS -s -p -hc -l -RTS+#+end_src++*** Space usage output (-s)++#+begin_example+885,263,472 bytes allocated in the heap+       8,507,448 bytes copied during GC+         163,200 bytes maximum residency (4 sample(s))+          27,752 bytes maximum slop+               6 MiB total memory in use (0 MiB lost due to fragmentation)++                                     Tot time (elapsed)  Avg pause  Max pause+  Gen  0       207 colls,     0 par    0.009s   0.010s     0.0001s    0.0002s+  Gen  1         4 colls,     0 par    0.001s   0.001s     0.0004s    0.0005s++  TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1)++  SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)++  INIT    time    0.006s  (  0.006s elapsed)+  MUT     time    0.367s  (  0.360s elapsed)+  GC      time    0.010s  (  0.011s elapsed)+  RP      time    0.000s  (  0.000s elapsed)+  PROF    time    0.000s  (  0.000s elapsed)+  EXIT    time    0.001s  (  0.001s elapsed)+  Total   time    0.384s  (  0.380s elapsed)+#+end_example++*** Cost center profile (-p)++Dumped to speed0.prof++#+begin_example+COST CENTRE MODULE                SRC                                            %time %alloc++token       MarkupParse           src/MarkupParse.hs:(259,1)-(260,20)             50.2   50.4+wrappedQ'   MarkupParse.FlatParse src/MarkupParse/FlatParse.hs:(215,1)-(217,78)   20.8   23.1+ws_         MarkupParse.FlatParse src/MarkupParse/FlatParse.hs:(135,1)-(146,4)    14.3    5.5+eq          MarkupParse.FlatParse src/MarkupParse/FlatParse.hs:243:1-30           10.6   11.1+gather      MarkupParse           src/MarkupParse.hs:(420,1)-(428,100)             2.4    3.7+runParser   FlatParse.Basic       src/FlatParse/Basic.hs:(217,1)-(225,24)          1.0    6.0+#+end_example++*** heap analysis (-hc -l)++#+begin_src sh :results output+eventlog2html speed0.eventlog+#+end_src++Produces speed0.eventlog.html which contains heap charts.++** Cache speed++The average cycles per + operation can get down to about 0.7 cycles, and there are about 4 cache registers per cycle, so a sum pipeline uses 2.8 register instructions per +.++| Cache             | Cycles         |+|-------------------|----------------|+| register          | 4 per cycle    |+| L1 Cache access   | 3-4 cycles     |+| L2 Cache access   | 11-12 cycles   |+| L3 unified access | 30 - 40        |+| DRAM hit          | 195 cycles     |+| L1 miss           | 40 cycles      |+| L2 miss           | >600 cycles     |++

@@ -1,6 +1,6 @@ -- | == Introduction ----- /perf/ provides tools for measuring the runtime performance of Haskell functions. It includes:+-- @perf@ provides tools for measuring the runtime performance of Haskell functions. It includes: -- -- - time measurement via reading the RDTSC register (TSC stands for "time stamp counter"), which is present on all x86 CPUs since the Pentium architecture. For more details, see  https://en.wikipedia.org/wiki/Time_Stamp_Counter --@@ -10,7 +10,7 @@ -- -- - functionality to determine performance order, in 'Perf.BigO' ----- Usage examples can be found in app/perf-explore.hs and the project's readme.org.+-- - reporting functionality in 'Perf.Report'. @perf@ can be run via 'cabal bench'; see the project's cabal file for an example. module Perf   ( -- * re-exports     module Perf.Types,@@ -26,7 +26,7 @@     module Perf.Algos,     -- | Order of complexity computations     module Perf.BigO,-    -- | Reporting, including 'Golden' file functionality.+    -- | Reporting     module Perf.Report,     -- | Statistical support     module Perf.Stats,

@@ -152,8 +152,8 @@ testExample (PatternNoOp label f a) = void $ fap label f a  -- | run an example measurement.-statExamples :: (MonadIO m) => Int -> Int -> (Int -> Measure m [a]) -> m (Map.Map Text [a])-statExamples n l m = execPerfT (m n) $ mapM_ testExample ((`examplePattern` l) <$> allExamples)+statExamples :: (Semigroup a, MonadIO m) => Int -> PerfT m a ()+statExamples l = mapM_ testExample ((`examplePattern` l) <$> allExamples)  -- | Unification of sum function applications data SumPattern a

@@ -2,31 +2,32 @@  -- | Reporting on performance, potentially checking versus a canned results. module Perf.Report-  ( Format (..),-    parseFormat,+  ( Name,     Header (..),     parseHeader,     CompareLevels (..),     defaultCompareLevels,     parseCompareLevels,-    ReportConfig (..),-    defaultReportConfig,-    parseReportConfig,+    ReportOptions (..),+    defaultReportOptions,+    parseReportOptions,+    infoReportOptions,+    report,+    reportMain,+    reportMainWith,     writeResult,     readResult,     CompareResult (..),     compareNote,-    outercalate,-    reportGolden,     reportOrg2D,     Golden (..),     defaultGolden,-    goldenFromOptions,     parseGolden,-    report,+    replaceDefaultFilePath,   ) where +import Control.Exception import Control.Monad import Data.Bool import Data.Foldable@@ -40,28 +41,96 @@ import Data.Text.IO qualified as Text import GHC.Generics import Options.Applicative+import Perf.Measure+import Perf.Stats+import Perf.Types+import System.Exit import Text.Printf hiding (parseFormat)---- | Type of format for report-data Format = OrgMode | ConsoleMode deriving (Eq, Show, Generic)+import Text.Read --- | Command-line parser for 'Format'-parseFormat :: Format -> Parser Format-parseFormat f =-  flag' OrgMode (long "orgmode" <> help "report using orgmode table format")-    <|> flag' ConsoleMode (long "console" <> help "report using plain table format")-    <|> pure f+-- | Benchmark name+type Name = String  -- | Whether to include header information. data Header = Header | NoHeader deriving (Eq, Show, Generic)  -- | Command-line parser for 'Header'-parseHeader :: Header -> Parser Header-parseHeader h =+parseHeader :: Parser Header+parseHeader =   flag' Header (long "header" <> help "include headers")     <|> flag' NoHeader (long "noheader" <> help "dont include headers")-    <|> pure h+    <|> pure Header +-- | Options for production of a performance report.+data ReportOptions = ReportOptions+  { -- | Number of times to run a benchmark.+    reportN :: Int,+    reportStatDType :: StatDType,+    reportMeasureType :: MeasureType,+    reportGolden :: Golden,+    reportHeader :: Header,+    reportCompare :: CompareLevels+  }+  deriving (Eq, Show, Generic)++-- | Default options+--+-- >>> defaultReportOptions+-- ReportOptions {reportN = 1000, reportStatDType = StatAverage, reportMeasureType = MeasureTime, reportGolden = Golden {golden = "other/bench.perf", check = True, record = False}, reportHeader = Header, reportCompare = CompareLevels {errorLevel = 0.2, warningLevel = 5.0e-2, improvedLevel = 5.0e-2}}+defaultReportOptions :: ReportOptions+defaultReportOptions =+  ReportOptions+    1000+    StatAverage+    MeasureTime+    defaultGolden+    Header+    defaultCompareLevels++-- | Command-line parser for 'ReportOptions'+parseReportOptions :: Parser ReportOptions+parseReportOptions =+  ReportOptions+    <$> option auto (value 1000 <> long "runs" <> short 'n' <> help "number of runs to perform")+    <*> parseStatD+    <*> parseMeasure+    <*> parseGolden+    <*> parseHeader+    <*> parseCompareLevels defaultCompareLevels++-- | Default command-line parser.+infoReportOptions :: ParserInfo ReportOptions+infoReportOptions =+  info+    (parseReportOptions <**> helper)+    (fullDesc <> progDesc "perf benchmarking" <> header "reporting options")++-- | Run and report a benchmark to the console. For example,+--+-- @reportMain "foo" (fap "sum" sum [1..1000])@ would:+--+-- - run a benchmark for summing the numbers 1 to a thousand.+--+-- - look for saved performance data in other/foo-1000-MeasureTime-StatAverage.perf+--+-- - report on performance in isolation or versus the canned data file if it exists.+--+-- - exit with failure if the performace had degraded.+reportMain :: Name -> PerfT IO [[Double]] a -> IO ()+reportMain name t = do+  o <- execParser infoReportOptions+  reportMainWith o name t++-- | Run and report a benchmark to the console with the supplied options.+reportMainWith :: ReportOptions -> Name -> PerfT IO [[Double]] a -> IO ()+reportMainWith o name t = do+  let !n = reportN o+  let s = reportStatDType o+  let mt = reportMeasureType o+  let o' = replaceDefaultFilePath (intercalate "-" [name, show n, show mt, show s]) o+  m <- execPerfT (measureDs mt n) t+  report o' (statify s m)+ -- | Levels of geometric difference in compared performance that triggers reporting. data CompareLevels = CompareLevels {errorLevel :: Double, warningLevel :: Double, improvedLevel :: Double} deriving (Eq, Show) @@ -79,41 +148,22 @@     <*> option auto (value (warningLevel c) <> long "warning" <> help "warning level")     <*> option auto (value (improvedLevel c) <> long "improved" <> help "improved level") --- | Report configuration options-data ReportConfig = ReportConfig-  { format :: Format,-    includeHeader :: Header,-    levels :: CompareLevels-  }-  deriving (Eq, Show, Generic)---- |--- >>> defaultReportConfig--- ReportConfig {format = ConsoleMode, includeHeader = Header, levels = CompareLevels {errorLevel = 0.2, warningLevel = 5.0e-2, improvedLevel = 5.0e-2}}-defaultReportConfig :: ReportConfig-defaultReportConfig = ReportConfig ConsoleMode Header defaultCompareLevels---- | Parse 'ReportConfig' command line options.-parseReportConfig :: ReportConfig -> Parser ReportConfig-parseReportConfig c =-  ReportConfig-    <$> parseFormat (format c)-    <*> parseHeader (includeHeader c)-    <*> parseCompareLevels (levels c)- -- | Write results to file writeResult :: FilePath -> Map.Map [Text] Double -> IO () writeResult f m = writeFile f (show m) --- | Read results from file-readResult :: FilePath -> IO (Map.Map [Text] Double)+-- | Read results from a file.+readResult :: FilePath -> IO (Either String (Map.Map [Text] Double)) readResult f = do-  a <- readFile f-  pure (read a)+  a :: Either SomeException String <- try (readFile f)+  pure $ either (Left . show) readEither a  -- | Comparison data between two results. data CompareResult = CompareResult {oldResult :: Maybe Double, newResult :: Maybe Double, noteResult :: Text} deriving (Show, Eq) +hasDegraded :: Map.Map a CompareResult -> Bool+hasDegraded m = any ((== "degraded") . noteResult) $ fmap snd (Map.toList m)+ -- | Compare two results and produce some notes given level triggers. compareNote :: (Ord a) => CompareLevels -> Map.Map a Double -> Map.Map a Double -> Map.Map a CompareResult compareNote cfg x y =@@ -134,43 +184,18 @@       | y' / x' < (1 - improvedLevel cfg) = "improvement"       | otherwise = "" --- | Like intercalate, but on the outside as well.-outercalate :: Text -> [Text] -> Text-outercalate c ts = c <> Text.intercalate c ts <> c---- | Report to a console, comparing the measurement versus a canned file.-reportGolden :: ReportConfig -> FilePath -> Map.Map [Text] Double -> IO ()-reportGolden cfg f m = do-  mOrig <- readResult f-  let n = compareNote (levels cfg) mOrig m-  reportToConsole $ formatCompare (format cfg) (includeHeader cfg) n---- | Org-mode style header.-formatOrgHeader :: Map.Map [Text] a -> [Text] -> [Text]-formatOrgHeader m ts =-  [ outercalate "|" ((("label" <>) . Text.pack . show <$> [1 .. labelCols]) <> ts),-    outercalate "|" (replicate (labelCols + 1) "---")-  ]-  where-    labelCols = maximum $ length <$> Map.keys m- -- | Console-style header information.-formatConsoleHeader :: Map.Map [Text] a -> [Text] -> [Text]-formatConsoleHeader m ts =-  [mconcat $ Text.pack . printf "%-20s" <$> ((("label" <>) . Text.pack . show <$> [1 .. labelCols]) <> ts), mempty]+formatHeader :: Map.Map [Text] a -> [Text] -> [Text]+formatHeader m ts =+  [mconcat $ Text.pack . printf "%-16s" <$> ((("label" <>) . Text.pack . show <$> [1 .. labelCols]) <> ts), mempty]   where     labelCols = maximum $ length <$> Map.keys m  -- | Format a comparison.-formatCompare :: Format -> Header -> Map.Map [Text] CompareResult -> [Text]-formatCompare f h m =-  case f of-    OrgMode ->-      bool [] (formatOrgHeader m ["old_result", "new_result", "status"]) (h == Header)-        <> Map.elems (Map.mapWithKey (\k a -> outercalate "|" (k <> compareReport a)) m)-    ConsoleMode ->-      bool [] (formatConsoleHeader m ["old_result", "new_result", "status"]) (h == Header)-        <> Map.elems (Map.mapWithKey (\k a -> Text.pack . mconcat $ printf "%-20s" <$> (k <> compareReport a)) m)+formatCompare :: Header -> Map.Map [Text] CompareResult -> [Text]+formatCompare h m =+  bool [] (formatHeader m ["old result", "new result", "change"]) (h == Header)+    <> Map.elems (Map.mapWithKey (\k a -> Text.pack . mconcat $ printf "%-16s" <$> (k <> compareReport a)) m)   where     compareReport (CompareResult x y n) =       [ maybe mempty (expt (Just 3)) x,@@ -178,17 +203,11 @@         n       ] --- | Format a result in org-mode style-formatOrg :: Header -> Map.Map [Text] Text -> [Text]-formatOrg h m =-  bool [] (formatOrgHeader m ["results"]) (h == Header)-    <> Map.elems (Map.mapWithKey (\k a -> outercalate "|" (k <> [a])) m)---- | Format a result in console-style-formatConsole :: Header -> Map.Map [Text] Text -> [Text]-formatConsole h m =-  bool [] (formatConsoleHeader m ["results"]) (h == Header)-    <> Map.elems (Map.mapWithKey (\k a -> Text.pack . mconcat $ printf "%-20s" <$> (k <> [a])) m)+-- | Format a result as lines of text.+formatText :: Header -> Map.Map [Text] Text -> [Text]+formatText h m =+  bool [] (formatHeader m ["results"]) (h == Header)+    <> Map.elems (Map.mapWithKey (\k a -> Text.pack . mconcat $ printf "%-16s" <$> (k <> [a])) m)  -- | Format a result as a table. reportOrg2D :: Map.Map [Text] Text -> IO ()@@ -214,39 +233,60 @@ -- | Golden file options. data Golden = Golden {golden :: FilePath, check :: Bool, record :: Bool} deriving (Generic, Eq, Show) --- | Default filepath is "other/golden.perf"+-- | Default filepath is "other/bench.perf" defaultGolden :: Golden-defaultGolden = Golden "other/golden.perf" False False+defaultGolden = Golden "other/bench.perf" True False --- | Make a filepath from supplied options-goldenFromOptions :: [String] -> Golden -> Golden-goldenFromOptions xs g = bool g g {golden = fp} (golden g == golden defaultGolden)-  where-    fp = "other/" <> intercalate "-" xs <> ".perf"+-- | Replace the golden file name stem if it's the default.+replaceGoldenDefault :: FilePath -> Golden -> Golden+replaceGoldenDefault s g = bool g g {golden = s} (golden g == golden defaultGolden) +defaultGoldenPath :: FilePath -> FilePath+defaultGoldenPath fp = "other/" <> fp <> ".perf"++-- | Replace the Golden file path with the suggested stem, but only if the user did not specify a specific file path at the command line.+replaceDefaultFilePath :: FilePath -> ReportOptions -> ReportOptions+replaceDefaultFilePath fp o =+  o {reportGolden = replaceGoldenDefault (defaultGoldenPath fp) (reportGolden o)}+ -- | Parse command-line golden file options.-parseGolden :: String -> Parser Golden-parseGolden def =+parseGolden :: Parser Golden+parseGolden =   Golden-    <$> option str (Options.Applicative.value ("other/" <> def <> ".perf") <> long "golden" <> short 'g' <> help "golden file name")-    <*> switch (long "check" <> short 'c' <> help "check versus a golden file")-    <*> switch (long "record" <> short 'r' <> help "record the result to a golden file")+    <$> option str (Options.Applicative.value (golden defaultGolden) <> long "golden" <> short 'g' <> help "golden file name")+    -- True is the default for 'check'.+    <*> flag True False (long "nocheck" <> help "do not check versus the golden file")+    <*> switch (long "record" <> short 'r' <> help "record the result to the golden file") +reportConsoleNoCompare :: Header -> Map.Map [Text] Double -> IO ()+reportConsoleNoCompare h m =+  reportToConsole (formatText h (expt (Just 3) <$> m))++reportConsoleCompare :: Header -> Map.Map [Text] CompareResult -> IO ()+reportConsoleCompare h m =+  reportToConsole (formatCompare h m)+ -- | Report results-report :: ReportConfig -> Golden -> [Text] -> Map.Map [Text] [Double] -> IO ()-report cfg g labels m = do-  bool-    (reportToConsole (formatIn (format cfg) (includeHeader cfg) (expt (Just 3) <$> m')))-    (reportGolden cfg (golden g) m')-    (check g)+--+-- If a goldenFile is checked, and performance has degraded, the function will exit with 'ExitFailure' so that 'cabal bench' and other types of processes can signal performance issues.+report :: ReportOptions -> Map.Map [Text] [Double] -> IO ()+report o m = do   when-    (record g)-    (writeResult (golden g) m')+    (record (reportGolden o))+    (writeResult (golden (reportGolden o)) m')+  case check (reportGolden o) of+    False -> reportConsoleNoCompare (reportHeader o) m'+    True -> do+      mOrig <- readResult (golden (reportGolden o))+      case mOrig of+        Left _ -> do+          reportConsoleNoCompare (reportHeader o) m'+          unless+            (record (reportGolden o))+            (putStrLn "No golden file found. To create one, run with '-r'")+        Right orig -> do+          let n = compareNote (reportCompare o) orig m'+          _ <- reportConsoleCompare (reportHeader o) n+          when (hasDegraded n) (exitWith $ ExitFailure 1)   where-    m' = Map.fromList $ mconcat $ (\(ks, xss) -> zipWith (\x l -> (ks <> [l], x)) xss labels) <$> Map.toList m---- | Format a result given 'Format' and 'Header' preferences.-formatIn :: Format -> Header -> Map.Map [Text] Text -> [Text]-formatIn f h = case f of-  OrgMode -> formatOrg h-  ConsoleMode -> formatConsole h+    m' = Map.fromList $ mconcat $ (\(ks, xss) -> zipWith (\x l -> (ks <> [l], x)) xss (measureLabels (reportMeasureType o))) <$> Map.toList m