diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +0.11.0.0 +=== +* added Perf.Count +* GHC 9.6.2 support + 0.10.0 === * GHC 9.2.1 support diff --git a/app/explore.hs b/app/explore.hs --- a/app/explore.hs +++ b/app/explore.hs @@ -1,25 +1,23 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wall #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -- | basic measurement and callibration module Main where import Control.DeepSeq +import Control.Monad import Control.Monad.State.Lazy import Data.FormatN -import Data.List (intercalate) -import qualified Data.Map.Strict as Map +import Data.List (intercalate, nub) +import Data.Map.Strict qualified as Map import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text +import Data.Text qualified as Text +import Data.Text.IO qualified as Text import Gauge import Options.Applicative import Perf import Prelude -data RunType = RunExample | RunExamples | RunExampleIO | RunSums | RunLengths | RunGauge | RunNoOps | RunTicks deriving (Eq, Show) +data RunType = RunExample | RunExamples | RunNub | RunExampleIO | RunSums | RunLengths | RunGauge | RunNoOps | RunTicks deriving (Eq, Show) data Options = Options { optionN :: Int, @@ -38,6 +36,7 @@ parseRun = flag' RunSums (long "sums" <> help "run on sum algorithms") <|> flag' RunLengths (long "lengths" <> help "run on length algorithms") + <|> flag' RunNub (long "nub" <> help "nub test") <|> flag' RunExamples (long "examples" <> help "run on example algorithms") <|> flag' RunExample (long "example" <> help "run on the example algorithm") <|> flag' RunExampleIO (long "exampleIO" <> help "exampleIO test") @@ -131,17 +130,7 @@ let a = optionExample o let r = optionRunType o let mt = optionMeasureType o - let gold' = optionGolden o - let gold = - case golden gold' of - "other/golden.perf" -> - gold' - { golden = - "other/" - <> intercalate "-" [show r, show n, show l, show mt] - <> ".perf" - } - _ -> gold' + let gold = goldenFromOptions [show r, show n, show l, show mt] (optionGolden o) let w = optionRawStats o let raw = "other/" @@ -150,6 +139,10 @@ let cfg = optionReportConfig 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) RunExample -> do m <- execPerfT (measureDs mt n) $ testExample (examplePattern a l) when w (writeFile raw (show m)) diff --git a/perf.cabal b/perf.cabal --- a/perf.cabal +++ b/perf.cabal @@ -1,6 +1,6 @@ -cabal-version: 2.4 +cabal-version: 3.0 name: perf -version: 0.10.3 +version: 0.11.0.0 synopsis: Low-level run time measurement. description: A set of tools to measure performance of Haskell programs. @@ -15,14 +15,69 @@ license: BSD-3-Clause license-file: LICENSE build-type: Simple -tested-with: - GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.2.5 || ==9.4.4 -extra-source-files: ChangeLog.md +tested-with: GHC == 8.10.7 || ==9.2.8 || ==9.4.5 || ==9.6.2 +extra-doc-files: ChangeLog.md source-repository head 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-stanza ghc-options: -Wall @@ -30,13 +85,17 @@ -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + -Widentities + -Wpartial-fields library + import: ghc2021-stanza import: ghc-options-stanza exposed-modules: Perf Perf.Algos Perf.BigO + Perf.Count Perf.Measure Perf.Report Perf.Space @@ -51,20 +110,19 @@ deepseq >=1.4.4 && <1.5, formatn >=0.2.1 && < 0.4, mtl >=2.2.2 && <2.4, - numhask-space ^>=0.10, - optparse-applicative ^>=0.17, + 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, - default-language: Haskell2010 - default-extensions: ghc-options: -O2 executable perf-explore - import: ghc-options-stanza + import: ghc2021-stanza + import: ghc-options-stanza main-is: explore.hs hs-source-dirs: app build-depends: @@ -74,9 +132,7 @@ formatn >=0.2.1 && <0.4, gauge ^>=0.2.5, mtl >=2.2.2 && <2.4, - optparse-applicative ^>=0.17, + optparse-applicative >=0.17 && <0.19, perf, text >=1.2 && <2.1, - - default-language: Haskell2010 ghc-options: -O2 diff --git a/src/Perf.hs b/src/Perf.hs --- a/src/Perf.hs +++ b/src/Perf.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wall #-} - -- | == Introduction -- -- /perf/ provides tools for measuring the runtime performance of Haskell functions. It includes: @@ -15,25 +13,29 @@ -- Usage examples can be found in app/perf-explore.hs and the project's readme.org. module Perf ( -- * re-exports - + module Perf.Types, + -- | Representation of what a Performance 'Measure' is. + module Perf.Measure, + -- | Low-level time performance 'Measure' counting 'Cycles' + module Perf.Time, + -- | Low-level space performance 'Measure's based on GHC's allocation statistics. + module Perf.Space, + -- | Simple loop counter + module Perf.Count, -- | Various (fast loop) algorithms that have been used for testing perf functionality. module Perf.Algos, - -- | Low-level time performance 'Measure's counting 'Cycles' - module Perf.Time, -- | Order of complexity computations module Perf.BigO, - -- | Low-level space performance 'Measure's based on GHC's allocation statistics. - module Perf.Space, -- | Reporting, including 'Golden' file functionality. module Perf.Report, + -- | Statistical support module Perf.Stats, - module Perf.Types, - module Perf.Measure, ) where import Perf.Algos import Perf.BigO +import Perf.Count import Perf.Measure import Perf.Report import Perf.Space diff --git a/src/Perf/Algos.hs b/src/Perf/Algos.hs --- a/src/Perf/Algos.hs +++ b/src/Perf/Algos.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} @@ -87,7 +85,7 @@ import Data.Bifunctor import Data.Foldable import Data.Functor.Foldable -import qualified Data.Map.Strict as Map +import Data.Map.Strict qualified as Map import Data.Text (Text) import Options.Applicative import Perf.Types diff --git a/src/Perf/BigO.hs b/src/Perf/BigO.hs --- a/src/Perf/BigO.hs +++ b/src/Perf/BigO.hs @@ -1,17 +1,16 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wall #-} -- | Order of complexity calculations. -- --- . +-- References -- --- +-- - . -- --- +-- - -- --- +-- - +-- +-- - module Perf.BigO ( O (..), olist, @@ -40,11 +39,11 @@ where import Data.Bool -import qualified Data.List as List -import qualified Data.Map.Strict as Map +import Data.List qualified as List +import Data.Map.Strict qualified as Map import Data.Maybe import Data.Monoid -import qualified Data.Vector as V +import Data.Vector qualified as V import GHC.Generics import Perf.Stats import Perf.Time @@ -275,7 +274,10 @@ -- | BigOrder estimate -- -- > estOrder (\x -> sum [1..x]) 100 [1,10,100,1000,10000] --- BigOrder {bigOrder = N1, bigFactor = 76.27652961460446, bigConstant = 0.0} +-- > BigOrder {bigOrder = N1, bigFactor = 76.27652961460446, bigConstant = 0.0} +-- +-- > estOrder (\x -> sum $ nub [1..x]) 100 [1,10,100,1000] +-- > BigOrder {bigOrder = N2, bigFactor = 13.485763594353541, bigConstant = 0.0} estOrder :: (Int -> b) -> Int -> [Int] -> IO (BigOrder Double) estOrder f sims ns = do xs <- tcurve StatBest sims f ns diff --git a/src/Perf/Count.hs b/src/Perf/Count.hs new file mode 100644 --- /dev/null +++ b/src/Perf/Count.hs @@ -0,0 +1,22 @@ +-- | Simple counter. +module Perf.Count + ( count, + countN, + ) +where + +import Perf.Types +import Prelude + +-- | Register 1 as a performance measure +count :: (Applicative m) => StepMeasure m Int +count = StepMeasure start stop + where + start = pure () + stop _ = pure 1 +{-# INLINEABLE count #-} + +-- | Count the number of times measured. +countN :: Int -> Measure IO Int +countN n = sum <$> toMeasureN n count +{-# INLINEABLE countN #-} diff --git a/src/Perf/Measure.hs b/src/Perf/Measure.hs --- a/src/Perf/Measure.hs +++ b/src/Perf/Measure.hs @@ -6,18 +6,21 @@ parseMeasure, measureDs, measureLabels, + measureFinalStat, ) where import Data.Text (Text) import Options.Applicative +import Perf.Count import Perf.Space +import Perf.Stats import Perf.Time import Perf.Types import Prelude hiding (cycle) -- | Command-line measurement options. -data MeasureType = MeasureTime | MeasureSpace | MeasureSpaceTime | MeasureAllocation deriving (Eq, Show) +data MeasureType = MeasureTime | MeasureSpace | MeasureSpaceTime | MeasureAllocation | MeasureCount deriving (Eq, Show) -- | Parse command-line 'MeasureType' options. parseMeasure :: Parser MeasureType @@ -26,6 +29,7 @@ <|> flag' MeasureSpace (long "space" <> help "measure space performance") <|> flag' MeasureSpaceTime (long "spacetime" <> help "measure both space and time performance") <|> flag' MeasureAllocation (long "allocation" <> help "measure bytes allocated") + <|> flag' MeasureCount (long "count" <> help "measure count") <|> pure MeasureTime -- | unification of the different measurements to being a list of doubles. @@ -36,6 +40,7 @@ MeasureSpace -> toMeasureN n (ssToList <$> space False) MeasureSpaceTime -> toMeasureN n ((\x y -> ssToList x <> [fromIntegral y]) <$> space False <*> stepTime) MeasureAllocation -> fmap ((: []) . fromIntegral) <$> toMeasureN n (allocation False) + MeasureCount -> (: []) . fmap fromIntegral <$> toMeasureN n count -- | unification of the different measurements to being a list of doubles. measureLabels :: MeasureType -> [Text] @@ -45,3 +50,14 @@ MeasureSpace -> spaceLabels MeasureSpaceTime -> spaceLabels <> ["time"] MeasureAllocation -> ["allocation"] + MeasureCount -> ["count"] + +-- | How to fold the list of performance measures. +measureFinalStat :: MeasureType -> [Double] -> Double +measureFinalStat mt = + case mt of + MeasureTime -> average + MeasureSpace -> average + MeasureSpaceTime -> average + MeasureAllocation -> average + MeasureCount -> sum diff --git a/src/Perf/Report.hs b/src/Perf/Report.hs --- a/src/Perf/Report.hs +++ b/src/Perf/Report.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -- | Reporting on performance, potentially checking versus a canned results. @@ -21,6 +20,8 @@ reportGolden, reportOrg2D, Golden (..), + defaultGolden, + goldenFromOptions, parseGolden, report, ) @@ -30,12 +31,13 @@ import Data.Bool import Data.Foldable import Data.FormatN hiding (format) -import qualified Data.List as List +import Data.List (intercalate) +import Data.List qualified as List import Data.Map.Merge.Strict -import qualified Data.Map.Strict as Map +import Data.Map.Strict qualified as Map import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text +import Data.Text qualified as Text +import Data.Text.IO qualified as Text import GHC.Generics import Options.Applicative import Text.Printf hiding (parseFormat) @@ -211,6 +213,16 @@ -- | Golden file options. data Golden = Golden {golden :: FilePath, check :: Bool, record :: Bool} deriving (Generic, Eq, Show) + +-- | Default filepath is "other/golden.perf" +defaultGolden :: Golden +defaultGolden = Golden "other/golden.perf" False 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" -- | Parse command-line golden file options. parseGolden :: String -> Parser Golden diff --git a/src/Perf/Space.hs b/src/Perf/Space.hs --- a/src/Perf/Space.hs +++ b/src/Perf/Space.hs @@ -1,9 +1,4 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# OPTIONS_GHC -Wall #-} -- | Space performance measurement. module Perf.Space @@ -16,7 +11,7 @@ ) where -import Control.Monad.State.Lazy +import Control.Monad import Data.Text (Text) import Data.Word import GHC.Stats diff --git a/src/Perf/Stats.hs b/src/Perf/Stats.hs --- a/src/Perf/Stats.hs +++ b/src/Perf/Stats.hs @@ -1,6 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# OPTIONS_GHC -Wall #-} -- | Statistical choices for multiple performance measurements. module Perf.Stats @@ -22,8 +20,8 @@ where import Control.Monad.State.Lazy -import qualified Data.List as List -import qualified Data.Map.Strict as Map +import Data.List qualified as List +import Data.Map.Strict qualified as Map import Data.Text (Text, pack) import NumHask.Space (quantile) import Options.Applicative diff --git a/src/Perf/Time.hs b/src/Perf/Time.hs --- a/src/Perf/Time.hs +++ b/src/Perf/Time.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wall #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -- | 'tick' uses the rdtsc chipset to measure time performance of a computation. -- diff --git a/src/Perf/Types.hs b/src/Perf/Types.hs --- a/src/Perf/Types.hs +++ b/src/Perf/Types.hs @@ -1,16 +1,9 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TupleSections #-} -{-# OPTIONS_GHC -Wall #-} -- | Abstract types of performance measurement. module Perf.Types - ( Measure (..), + ( -- * Measure + Measure (..), repeated, StepMeasure (..), toMeasure, @@ -43,10 +36,11 @@ where import Control.DeepSeq +import Control.Monad import Control.Monad.State.Lazy import Data.Bifunctor import Data.Functor.Identity -import qualified Data.Map.Strict as Map +import Data.Map.Strict qualified as Map import Data.Text (Text) import Prelude