packages feed

SBench (empty) → 0.1

raw patch · 19 files changed

+1492/−0 lines, 19 filesdep +basedep +criteriondep +deepseqsetup-changed

Dependencies added: base, criterion, deepseq, directory, filepath, gnuplot, haskell98, hp2any-core, parsec, txt-sushi

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Daniel Seidel++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Daniel Seidel nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ SBench.cabal view
@@ -0,0 +1,75 @@+Name:                SBench++Version:             0.1++Synopsis:            A benchmark suite for runtime and heap measurements over +                     a series of inputs.++Description: The package provides a framework for heap and runtime measurements+             for single Haskell functions. For heap measurements simple programs+             are created, compiled with profiling options and run. You can do+             either a heap profile or a graph for the maximal heap consumption+             of a function over different inputsizes. For runtime measurements+             the criterion library is used.++             Measurement data can be stored in a special file format providing+             besides the data some meta information about the measurement.+	     Furthermore measured data can be plotted easily using gnuplot.+             In particular, it is possible to compare measurements for different+             functions (e.g. different version of a semantically equivalent+             function) in one diagram. By using gnuplot for drawing, the+             appearance of a diagram is very flexible and can be adjusted+             directly to, for example, the style of your paper.++License:             BSD3++License-file:        LICENSE++Author:              Daniel Seidel++Maintainer:          ds@informatik.uni-bonn.de++Category:            Testing++Stability:           Experimental++Build-type:          Simple++Extra-source-files:  LICENSE+                     example/Fib.hs+                     example/NFib.hs+                     example/Test.hs++Cabal-version:       >=1.2++Library+  Exposed-modules:+    Test.SBench.STerm+    Test.SBench.Options+    Test.SBench.File.FileOps+    Test.SBench.File.Types+    Test.SBench.Plot.Gnuplot+    Test.SBench.Time.Series.Test+    Test.SBench.Space.OptionSet+    Test.SBench.Space.Single.ExploreProfile+    Test.SBench.Space.Single.Test+    Test.SBench.Space.Series.Test++  Build-depends:+    base >= 4 && <5, +    criterion >= 0.5 && <0.6,+    gnuplot >= 0.4.0.1 && <0.5,+    hp2any-core, +    deepseq,+    txt-sushi >= 0.5 && <0.6,+    parsec >= 3 && <= 4, +    directory >= 1 && <2, +    filepath,+    haskell98+  +  Other-modules:       +    Test.SBench.File.Parser+    Test.SBench.Space.Single.MakeExecutable+    Test.SBench.Space.Single.RunExecutable++  Hs-source-dirs: src/
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/Fib.hs view
@@ -0,0 +1,26 @@+module Fib where+-- | To find more version how to calculate the Fibonacci sequence, have a look+--   at <http://www.haskell.org/haskellwiki/The_Fibonacci_sequence>++import Data.List++-- | The algorithms to test++fib1 :: Int -> Int+fib1 n = {-# SCC "fib1" #-} +  let fibs = (0 : 1 : zipWith (+) (fibs) (tail fibs)) in fibs !! n++fib2 :: Int -> Int +fib2 n = {-# SCC "fib2" #-}+    snd . foldl fib' (1, 0) . map (toEnum . fromIntegral) $ unfoldl divs n+    where+        unfoldl f x = case f x of+                Nothing     -> []+                Just (u, v) -> unfoldl f v ++ [u]+ +        divs 0 = Nothing+        divs k = Just (uncurry (flip (,)) (k `divMod` 2))+ +        fib' (f, g) p+            | p         = (f*(f+2*g), f^2 + g^2)+            | otherwise = (f^2+g^2,   g*(2*f-g))
+ example/NFib.hs view
@@ -0,0 +1,17 @@+module NFib where++import Fib+import Test.SBench.STerm ( Algorithm, toAlgorithm, DataGen, toDataGen )++-- | convert the algorithm to an 'STerm' via 'toAlgorithm' with the actual term,+--   the module it is in, the name of the term and the cost center annotation as+--   arguments.+-- | Notice that putting these functions into the 'Fib' module will force you to+--   install 'SBench' with profiling options. Therefore, here an extra module is+--   preferable.+nFib1 :: Algorithm (Int -> Int)+nFib1 = toAlgorithm fib1 "Fib" "fib1" "fib1"++nFib2 :: Algorithm (Int -> Int)+nFib2 = toAlgorithm fib2 "Fib" "fib2" "fib2"+
+ example/Test.hs view
@@ -0,0 +1,81 @@+module Main where++import System ( getArgs )++import NFib ( nFib1, nFib2 )++import Test.SBench.STerm ( makeIntSeeds, toDataGen, toData, toNamedData )+import Test.SBench.Time.Series.Test ( nfRuntimeSeries )+import Test.SBench.Space.Single.Test ( getMemLine )+import Test.SBench.Space.Series.Test ( maxMemSeries )+import Test.SBench.Plot.Gnuplot ( series2scaledPlot, series2plot, sbench2scaledPlot, toDiagram, toDiagramWith )++import qualified Graphics.Gnuplot.Frame.OptionSet as Opt+import qualified Graphics.Gnuplot.Terminal.PostScript as PS+import qualified Graphics.Gnuplot.Terminal.PNG as PNG++doRuntimeTests bOpts rOpts = +    let seeds = makeIntSeeds 1 10000 10 in+    do dat_fib1 <- nfRuntimeSeries +                     (Just (bOpts, rOpts, "runtime_fib1", "fib1"))+                     nFib1 +                     (toDataGen id "" "id") +                     seeds+       dat_fib2 <- nfRuntimeSeries +                     (Just (bOpts, rOpts, "runtime_fib2", "fib2"))+                     nFib2+                     (toDataGen id "" "id")+                     seeds+       let plt_fib1  = series2scaledPlot ((/(1000 :: Double)) . fromIntegral) (*1000000) "fib1" dat_fib1+           plt_fib2  = series2scaledPlot ((/(1000 :: Double)) . fromIntegral) (*1000000) "fib2" dat_fib2+           frameOpts = [ Opt.title  "runtime comparism for Fibunacci number generators"+                       , Opt.xLabel "number of the Fibunacci number requested (*1000)"+                       , Opt.yLabel "runtime (microseconds)"+                       ]+       toDiagram "comp_runtime_fib" [PS.color] frameOpts [plt_fib1, plt_fib2]+++-- | Create a heap profile for a function.+--   fib2 runs to fast to generate a profile, i.e., there is no sample measured,+--   so here only fib1 is measured.+doMemProfile = +    let inp = toNamedData 3000000 "(3000000::Int)" in+    do  dat_fib1 <- getMemLine True ("memline_fib1", "fib1") nFib1 inp+        let plt_fib1  = series2scaledPlot id ((/(1024*1024::Double)) . fromIntegral) "fib1" dat_fib1+            frameOpts = [ Opt.title  $ "heap consumption when calculating the " +                                       ++ show inp ++ "th Fibonacci number"+                        , Opt.xLabel "runtime (seconds)"+                        , Opt.yLabel "heap consumption (MBytes)"+                        ]+        toDiagram "comp_memline_fib" [PS.color] frameOpts [plt_fib1]++doMaxMemSeries =+    let seeds = makeIntSeeds 1 10000 10 in+    do  dat_fib1 <- maxMemSeries True ("memline_fib1", "fib1") nFib1 (toDataGen id "" "id") seeds+        dat_fib2 <- maxMemSeries True ("memline_fib2", "fib2") nFib2 (toDataGen id "" "id") seeds+        let plt_fib1  = series2scaledPlot ((/(1000 :: Double)) . fromIntegral) ((/(1024::Double)) . fromIntegral) "fib1" dat_fib1+            plt_fib2  = series2scaledPlot ((/(1000 :: Double)) . fromIntegral) ((/(1024::Double)) . fromIntegral) "fib2" dat_fib2+            frameOpts = [ Opt.title  $ "comparism of maximal heap consumption for Fibonacci number generators"+                        , Opt.xLabel "number of the Fibunacci number requested (*1000)"+                        , Opt.yLabel "heap consumption (kBytes)"+                        ]+        toDiagram "comp_maxmem_fib" [PS.color] frameOpts [plt_fib1, plt_fib2]++redoRuntimePlotAsPNG = do+    plt_fib1 <- sbench2scaledPlot (/1000) (*1000000) "runtime_fib1"+    plt_fib2 <- sbench2scaledPlot (/1000) (*1000000) "runtime_fib2"+    let frameOpts = [ Opt.title  "runtime comparism for Fibunacci number generators"+                    , Opt.xLabel "number of the Fibunacci number requested (*1000)"+                    , Opt.yLabel "runtime (microseconds)"+                    ]+    toDiagramWith (PNG.cons "comp_runtime_fib.png") frameOpts [plt_fib1, plt_fib2]++main = do+    let bOpts = "unknown"+        rOpts = "unknown"+    print bOpts+    print rOpts+    doRuntimeTests bOpts rOpts+    doMemProfile+    doMaxMemSeries+    redoRuntimePlotAsPNG
+ src/Test/SBench/File/FileOps.hs view
@@ -0,0 +1,160 @@+module Test.SBench.File.FileOps ( +    criterion2series+  , series2sbench+  , series2sbench'+  , sbench2series+  ) where++import Database.TxtSushi.FlatFile (csvFormat, parseTable)+import System.IO ( FilePath, openFile, hClose, hGetContents, hPutStr, IOMode (..) )+import System.Directory ( doesFileExist )+import System.FilePath ( addExtension, dropExtension, takeExtension )+import Data.List ( findIndex )+import Test.SBench.File.Types ( MetaInfo(..), Range(..) )+import Test.SBench.File.Parser ( getWholeFile )+import Test.SBench.STerm ( Algorithm, DataGen, Data, STerm (..) )+import Test.SBench.Options ( EvalMod, Title )++import Data.List ( foldl' )++-- | File format version.+version = "0.1"++type CriterionFile = FilePath+type SBenchFile    = FilePath+++-- * Get data from Criterion files++-- | Extract the mean runtimes from a criterion data file.+readMeans :: CriterionFile -> IO [String]+readMeans fin =+  do+    exists <- doesFileExist fin+    if exists+      then+        do+          filecont <- myReadFile fin+          let (header : body) = parseTable csvFormat filecont+              meanIndex = findIndex ( == "Mean") header+          case meanIndex of+            Nothing -> error $ "Criterion-File " ++ " is in a wrong format."+            Just i  -> return $ map (!! i) body+      else error $ "File " ++ fin ++ " does not exist."++-- | Read the mean runtimes of a criterion data file and tuple them with seeds+--   to a seed-runtime series.+criterion2series :: Num a => [a] -> CriterionFile -> IO [(a, Double)]+criterion2series seeds file = do+    means <- readMeans file+    return $ zip seeds (map read means)+++-- * Store and read data series from SBench data files++-- | Store a series of measurements over /different inputs/ in a .sbench file.+--   The SBench file format take some extra information about the measurement.+series2sbench :: (Real a, Real b) => +                    (String, String)    -- ^ (build options, runtime options) used for the measurement.+                 -> Maybe EvalMod       -- ^ Evaluation mode for the input (e.g. as given to criterion for time measurements)+                 -> Algorithm (c -> d)  -- ^ The function tested.+                 -> DataGen (e -> c)    -- ^ The data generator used.+                 -> Title               -- ^ Name the measurement should get when the graph is plotted.+                 -> SBenchFile          -- ^ File the data should be stored in.+                 -> [(a, b)]            -- ^ Data.+                 -> IO SBenchFile       -- ^ The generated data file.+series2sbench (bOpts, eOpts) evMod alg gen title file ser = do+      let mi = prepareMetaInfo+          fout = (addExtension (dropExtension file) "sbench")+      print $ "creating sbench data file " ++ fout ++ "..."+      generateFile mi ser fout+      return fout+    where+      generateFile :: (Real a, Real b) => MetaInfo a b -> [(a, b)] -> FilePath -> IO ()+      generateFile mi ser fout =+        myWriteFile fout $ show mi ++ toGNUStyle ser+      prepareMetaInfo =+        MetaInfo +           { header = ["This file was automatically generated by SBench"]+           , sbenchVersion = version+           , graphRanges = getRanges $ ser+           , miGraphTitle = title+           , miAlgName = stName alg+           , miGenName = Left $ stName gen+           , evalMod = evMod+           , buildOptions = bOpts+           , exeOptions = eOpts+           }+      getRanges [] = (AutoRange, AutoRange)+      getRanges ((x,y):ps) = foldl' adjustRanges (ManRange (x,x), ManRange (y,y)) ps +      adjustRanges (r1, r2) (v1, v2) = (adjustRange r1 v1, adjustRange r2 v2)+      adjustRange (ManRange (d1, d2)) d = ManRange (min d1 d, max d2 d)++-- | Store a series of measurements with /a single input/ in a .sbench file.+--   The SBench file format take some extra information about the measurement.+series2sbench' :: (Real a, Real b) => +                     (String, String)    -- ^ (build options, runtime options) used for the measurement.+                  -> Maybe EvalMod       -- ^ Evaluation mode for the input (e.g. as given to criterion for time measurements)+                  -> Algorithm (c -> d)  -- ^ The function tested.+                  -> Data c              -- ^ The data used.+                  -> Title               -- ^ Name the measurement should get when the graph is plotted.+                  -> SBenchFile          -- ^ File the data should be stored in.+                  -> [(a, b)]            -- ^ Data.+                  -> IO SBenchFile       -- ^ The generated data file.+series2sbench' (bOpts, eOpts) evMod alg inp title file ser = do+      let mi = prepareMetaInfo+          fout = (addExtension (dropExtension file) "sbench")+      print $ "creating sbench data file " ++ fout ++ "..."+      generateFile mi ser fout+      return fout+    where+      generateFile :: (Real a, Real b) => MetaInfo a b -> [(a, b)] -> FilePath -> IO ()+      generateFile mi ser fout =+        myWriteFile fout $ show mi ++ toGNUStyle ser+      prepareMetaInfo =+        MetaInfo +           { header = ["This file was automatically generated by SBench"]+           , sbenchVersion = version+           , graphRanges = getRanges $ ser+           , miGraphTitle = title+           , miAlgName = stName alg+           , miGenName = Right $ stName inp+           , evalMod = evMod+           , buildOptions = bOpts+           , exeOptions = eOpts+           }+      getRanges [] = (AutoRange, AutoRange)+      getRanges ((x,y):ps) = foldl' adjustRanges (ManRange (x,x), ManRange (y,y)) ps +      adjustRanges (r1, r2) (v1, v2) = (adjustRange r1 v1, adjustRange r2 v2)+      adjustRange (ManRange (d1, d2)) d = ManRange (min d1 d, max d2 d)+++-- | Read a measurment series from a .sbench data file.+--   Additionally to the measurement series a data structure with meta informations is returned.+sbench2series :: FilePath -> IO (MetaInfo Double Double, [(Double, Double)])+sbench2series file = +    let f = if takeExtension file == "sbench"+              then file +              else addExtension file "sbench"+    in getWholeFile f+++-- * Auxiliar functions++toGNUStyle :: (Show a, Show b) => [(a, b)] -> String+toGNUStyle = foldr (++) "" . map (\(g, r) -> show g ++ "\t" ++ show r ++ "\n")++myWriteFile :: FilePath -> String -> IO ()+myWriteFile f s = do+    hfile <- openFile f WriteMode+    hPutStr hfile s+    hClose hfile+++-- strict read version+myReadFile :: FilePath -> IO String+myReadFile f = do+    hfile <- openFile f ReadMode+    s <- hGetContents hfile+    seq (length s) $ hClose hfile+    return s
+ src/Test/SBench/File/Parser.hs view
@@ -0,0 +1,246 @@+-- | Parser for SBench data files.+module Test.SBench.File.Parser +  ( getMetaInfo+  , getWholeFile+  ) where++import Text.Parsec.String ( Parser(..), parseFromFile)+import Text.Parsec.Error ( ParseError )+import Text.Parsec.Combinator ( manyTill, many1, sepBy, count )+import Text.Parsec.Prim ( many, (<?>), (<|>), try )+import Text.Parsec.Char ( anyChar, spaces, string, newline, digit, char  )+import System.FilePath ( FilePath )+import Test.SBench.File.Types ( MetaInfo(..), Range(..) )+import Test.SBench.Options ( EvalMod (..) )+++getMetaInfo :: FilePath -> IO (MetaInfo Double Double)+getMetaInfo file = do+    emi <- parseFromFile metaInfoParser file+    case emi of+      Left err -> error $ show err+      Right mi -> return mi++getWholeFile :: FilePath -> IO (MetaInfo Double Double, [(Double,Double)])+getWholeFile file = do+    emi <- parseFromFile wholeFileParser file+    case emi of+      Left err -> error $ show err+      Right mi -> return mi++wholeFileParser :: Parser (MetaInfo Double Double, [(Double,Double)])+wholeFileParser = do+    mi  <- metaInfoParser+    dat <- dataParser+    return (mi, dat)++metaInfoParser :: Parser (MetaInfo Double Double)+metaInfoParser = do+   hs    <- many $ try headerLineParser+   v     <- versionParser+   pt    <- graphTitleParser+   alg   <- algNameParser+   gen   <- genNameParser+   evMod <- evalModParser+   prs   <- graphRangesParser+   bopts <- buildOptsParser+   eopts <- exeOptsParser+   return MetaInfo {+        header = hs+      , sbenchVersion = v+      , miGraphTitle = pt+      , miAlgName = alg+      , miGenName = gen+      , evalMod = evMod+      , graphRanges = prs+      , buildOptions = bopts+      , exeOptions = eopts+      }++headerLineParser :: Parser String+headerLineParser = do+    commentLine <?> "HeaderLineParser: Expected Line to start with '#'.\n"+    spaces+    string "header: "+    manyTill anyChar newline++versionParser :: Parser String+versionParser = do+    commentLine <?> "versionParser: Expected Line to start with '#'.\n"+    spaces+    string "SBench version:" <?> "expected SBench version number"+    spaces+    andNewLine (vnumParser <?> "Invalid SBench version number.")+  where+    vnumParser :: Parser String+    vnumParser = do main <- many1 digit+                    subs <- many subnum+                    return $ foldl (++) main subs+    subnum = do char '.' +                ds <- many1 digit                +                return $ '.' : ds++testNameParser :: Parser String+testNameParser = do+    commentLine <?> "testNameParser: Expected Line to start with '#'.\n"+    spaces+    string "test name:" <?> "expected test name"+    spaces+    andNewLine wordParser++genDimParser :: Parser Int+genDimParser = do+    commentLine <?> "genDimParser: Expected Line to start with '#'.\n"+    spaces+    string "number of generators:"+    spaces+    snum <- andNewLine $ many1 digit+    return ((read snum) :: Int)++graphTitleParser :: Parser String+graphTitleParser = do+    commentLine <?> "graphTitleParser: Expected Line to start with '#'.\n"+    spaces+    string "graph title:" <?> "expected graph title"+    spaces+    andNewLine wordParser++algNameParser :: Parser String+algNameParser = do+    commentLine <?> "algNameParser: Expected Line to start with '#'.\n"+    spaces+    string "tested algorithm: " <?> "expected name of tested algorithm"+    spaces+    andNewLine wordParser++genNameParser :: Parser (Either String String)+genNameParser = do+    commentLine <?> "genNameParser: Expected Line to start with '#'.\n"+    spaces+    string "input"+    (try inputParser) <|> inputGenParser+  where inputParser = do string ": "+                         spaces+                         n <- andNewLine wordParser+                         return (Right n)+        inputGenParser = do string " generator: " <?> "expected name of the input generator or input"+                            spaces+                            n <- andNewLine wordParser+                            return (Left n)++evalModParser :: Parser (Maybe EvalMod)+evalModParser = do+    commentLine <?> "evalModParser: Expected Line to start with '#'.\n"+    spaces+    string "evaluation mode: " <?> "expected evaluation mode"+    spaces+    andNewLine (evMod <|> return Nothing)+  where+    evMod = ((string "nf" >> return (Just NF)) <|> (string "whnf" >> return (Just WHNF)))++buildOptsParser :: Parser String+buildOptsParser = do+    commentLine <?> "buildOptsParser: Expected Line to start with '#'.\n"+    spaces+    string "build options: " <?> "expected build options"+    spaces+    andNewLine wordParser++exeOptsParser :: Parser String+exeOptsParser = do+    commentLine <?> "exeOptsParser: Expected Line to start with '#'.\n"+    spaces+    string "execution options: " <?> "expected execution options"+    spaces+    andNewLine wordParser++graphRangesParser :: Parser (Range Double, Range Double)+graphRangesParser = do+    commentLine <?> "graphRangesParser: Expected Line to start with '#'.\n"+    spaces+    string "graph ranges:" <?> "expected graph ranges"+    spaces+    let p = try autoParser <|> manParser +    andNewLine $ pairParser p p+  where+    autoParser :: Parser (Range Double)+    autoParser = do string "Auto"+                    return AutoRange+    manParser :: Parser (Range Double)+    manParser = do+        r <- pairParser doubleParser doubleParser+        return $ ManRange r++pairParser :: Parser a -> Parser b -> Parser (a, b)+pairParser p1 p2 = do+    rmAllWhiteParser '('+    c1 <- p1+    rmAllWhiteParser ','+    c2 <- p2+    rmLeadingWhiteParser ')'+    return (c1, c2)++doubleParser :: Parser Double+doubleParser = do+    i <- many digit+    f <- (char '.' >> many digit) <|> return "0"+    e <- do  char 'e' +             s <- string "+" <|> string "-" <|> return "+"+             e <- many1 digit+             return $ "e" ++ s ++ e+         <|> return ""+    return $ (read (i ++ "." ++ f  ++ e) :: Double)++intParser :: Parser Int+intParser = do+    i <- many1 digit <?> "expected an integer"+    return (read i :: Int)++axisLabelParser :: Parser [String]+axisLabelParser = do+    commentLine <?> "axisLabelParser: Expected Line to start with '#'.\n"+    spaces+    string "axis labels:" <?> "expected axis labels"+    spaces+    andNewLine $ listParser wordParser++rmAllWhiteParser :: Char -> Parser ()+rmAllWhiteParser c = spaces >> char c >> spaces++rmLeadingWhiteParser :: Char -> Parser ()+rmLeadingWhiteParser c = spaces >> char c >> return ()++++listParser :: Parser a -> Parser [a]+listParser p = do+    rmAllWhiteParser '['+    ret <- sepBy p (rmAllWhiteParser ',')+    rmLeadingWhiteParser ']'+    return ret++wordParser :: Parser String+wordParser = char '"' >> manyTill anyChar (char '"')++andNewLine :: Parser a -> Parser a+andNewLine p = do+    ret <- p+    manyTill anyChar newline+    return ret++commentLine :: Parser ()+commentLine = many1 (char '#') >> return ()+        +dataParser :: Parser [(Double, Double)]+dataParser = many $ oneDataLineParser++oneDataLineParser :: Parser (Double, Double)+oneDataLineParser = do+    gens <- spaces >> doubleParser+    rt   <- andNewLine $ spaces >> doubleParser+    return (gens, rt)+    +      +    +    +
+ src/Test/SBench/File/Types.hs view
@@ -0,0 +1,50 @@+module Test.SBench.File.Types ( MetaInfo(..), Range(..) ) where++import Test.SBench.Options ( EvalMod )++-- | Metainformation stored in the header of all .sbench files.+--   Part of the 'MetaInfo' entries are usually calculated automatically.+data (Real a, Real b) => MetaInfo a b = MetaInfo+  { header           :: [String]+  , sbenchVersion    :: String+  , miGraphTitle     :: String+  , miAlgName        :: String+  , miGenName        :: Either String String   -- | 'Left' means an input generator,+                                               --   'Right' a single input+  , evalMod          :: Maybe EvalMod+  , graphRanges      :: (Range a, Range b)+  , buildOptions     :: String+  , exeOptions       :: String+  }++instance (Real a, Real b) => Show (MetaInfo a b) where+    show = showMetaInfo++showMetaInfo mi = foldr (\x y -> x ++ "\n" ++ y) "" lines+  where+    lines  = map ("#" ++) lines'+    lines' =    map ("header: " ++) (header mi)+             ++ ["SBench version: " ++ sbenchVersion mi]+             ++ ["graph title: " ++ toWord (miGraphTitle mi)]+             ++ ["tested algorithm: " ++ toWord (miAlgName mi)]+             ++ inputOrInputGen (miGenName mi)+             ++ ["evaluation mode: " ++ showEvalMod (evalMod mi)]+             ++ ["graph ranges: " ++ showGraphRanges (graphRanges mi)]+             ++ ["build options: " ++ toWord (buildOptions mi)]+             ++ ["execution options: " ++ toWord (exeOptions mi)]+    showGraphRanges             = showPairWith showGraphRange showGraphRange+    showAxisLabels              = showListWith toWord+    showListWith  p xs          = "[" ++ showListWith' p xs ++ "]"+    showListWith' p []          = ""+    showListWith' p [x]         = p x+    showListWith' p (x:xs)      = p x ++ ", " ++ showListWith' p xs+    showPairWith s1 s2 (x, y)   = "(" ++ s1 x ++ ", " ++ s2 y ++ ")"+    showGraphRange AutoRange    = "Auto"+    showGraphRange (ManRange p) = show p+    toWord s                    = "\"" ++ s ++ "\""+    showEvalMod (Just evm)      = show evm+    showEvalMod Nothing         = "unknown"+    inputOrInputGen (Left gen)  = ["input generator: " ++ toWord gen]+    inputOrInputGen (Right inp) = ["input: " ++ toWord inp]  ++data (Real a) => Range a = AutoRange | ManRange (a, a)
+ src/Test/SBench/Options.hs view
@@ -0,0 +1,94 @@+module Test.SBench.Options+  ( ProfParam (..)   -- | re-export from "Profiling.Heap.Process"+  , Breakdown (..)   -- | re-export from "Profiling.Heap.Process"+  , Restriction (..) -- | re-export from "Profiling.Heap.Process"+  , Imports+  , CompilerOptions (..)+  , ProgramArguments (..)+  , MemoryOptions (..)+  , ProfilingOptions (..)+  , Repetitions (..)+  , ThreadNum (..)+  , MemUnit (..)+  , MemSize (..)+  , TestOpts (..)+  , RuntimeOptions (..)+  , EvalMod(..)+  , NormalInput+  , opts2string+  , Title+  ) where++import Profiling.Heap.Process ( ProfParam (..)+                              , Breakdown (..)+                              , Restriction (..)+                              )++import Data.List ( foldl' )++data TestOpts = TOpts+  { cOpts :: CompilerOptions+  , rOpts :: RuntimeOptions+  , reps  :: Maybe Repetitions+  , nfInp :: NormalInput+  }++type CompilerOptions = [String]++data RuntimeOptions = ROpts+  { threadNum :: Maybe ThreadNum+  , profOpts  :: ProfilingOptions+  , memOpts   :: MemoryOptions+  , progArgs  :: ProgramArguments+  }++instance Show RuntimeOptions where+   show rtopts = +     let showProgArgs  = opts2string $ progArgs rtopts+         showMemOpts   = opts2string $ map show $ memOpts rtopts+         showThreadNum = case threadNum rtopts of+                           Nothing -> ""+                           Just i  -> "-N" ++ show i+         showProfOpts  = opts2string $ map show $ profOpts rtopts +     in opts2string [showProgArgs, showMemOpts, showThreadNum, showProfOpts]++type ThreadNum        = Int+type ProfilingOptions = [ProfParam]+type MemoryOptions    = [MemSize]++data MemSize =   Heap  Int MemUnit +               | Stack Int MemUnit++instance Show MemSize where+    show (Heap  a m) = "-H" ++ show a ++ show m+    show (Stack a m) = "-K" ++ show a ++ show m++data MemUnit = G | M | K | B++instance Show MemUnit where+    show G = "G"+    show M = "M"+    show K = "K"+    show B = "B"++type ProgramArguments = [String]++type Repetitions = Int+type NormalInput = Bool++data EvalMod = NF | WHNF++instance Show EvalMod where+  show NF   = "nf"+  show WHNF = "whnf"++type Imports = [String]+++opts2string :: [String] -> String+opts2string = maybeTail . foldl' (\x y -> x ++ " " ++ y) ""+  where+    maybeTail []     = []+    maybeTail (x:xs) = xs++type Title = String
+ src/Test/SBench/Plot/Gnuplot.hs view
@@ -0,0 +1,171 @@+-- | Interface functions to the "gnuplot" package for generating plots.+module Test.SBench.Plot.Gnuplot ( +    series2plot+  , series2scaledPlot+  , series2plotWith+  , series2scaledPlotWith+  , series2plotWithLinestyle+  , series2scaledPlotWithLinestyle+  , sbench2plot+  , sbench2scaledPlot+  , sbench2plotWithLinestyle+  , sbench2scaledPlotWithLinestyle+  , sbench2plotWith+  , sbench2scaledPlotWith+  , toDiagram+  , toDiagramWith+  ) where++import qualified Graphics.Gnuplot.Plot.TwoDimensional as Plot2D+import qualified Graphics.Gnuplot.Graph.TwoDimensional as Graph2D+import qualified Graphics.Gnuplot.Frame.OptionSet as Opts+import qualified Graphics.Gnuplot.LineSpecification as LineSpec+import qualified Graphics.Gnuplot.Advanced as GPlot ( plot )+import qualified Graphics.Gnuplot.Frame as Frame+import qualified Graphics.Gnuplot.Terminal.PostScript as PostScript+import qualified Graphics.Gnuplot.Value.Tuple as TVal+import qualified Graphics.Gnuplot.Value.Atom as AVal+import qualified Graphics.Gnuplot.Graph as Graph+import Data.Monoid ( mappend, mempty )+import System.FilePath ( (<.>) )+import System ( system )+import Test.SBench.Options ( Title )+import Test.SBench.File.FileOps ( sbench2series )+import Test.SBench.File.Types ( MetaInfo(..) )++-- * Plot from a data series++series2plot :: (TVal.C a, AVal.C a, TVal.C b, AVal.C b) => +                 Title         -- ^ Title of the graph.+              -> [(a, b)]      -- ^ Data to plot.+              -> Plot2D.T a b  -- ^ The plot.+series2plot = series2scaledPlot id id++series2scaledPlot :: (TVal.C c, AVal.C c, TVal.C d, AVal.C d) => +                     (a -> c)            -- ^ scale x-axis+                  -> (b -> d)            -- ^ scale y-axis+                  -> Title               -- ^ Title of the graph.+                  -> [(a, b)]            -- ^ Data to plot.+                  -> Plot2D.T c d        -- ^ The plot.+series2scaledPlot xscaler yscaler t s = +    let s' = scaleSeries xscaler yscaler s in +    Graph2D.lineSpec (LineSpec.title t $ LineSpec.deflt) `fmap` Plot2D.list Graph2D.lines s'++series2plotWithLinestyle :: (TVal.C a, AVal.C a, TVal.C b, AVal.C b) => +                     Int             -- ^ Linestyle. See 'gnuplot' manual.+                  -> Title           -- ^ Title of the graph.+                  -> [(a, b)]        -- ^ Data to plot+                  -> Plot2D.T a b    -- ^ the plot.+series2plotWithLinestyle linestyle = series2scaledPlotWithLinestyle linestyle id id++series2scaledPlotWithLinestyle :: (TVal.C c, AVal.C c, TVal.C d, AVal.C d) => +                     Int                 -- ^ Linestyle. See 'gnuplot' manual.+                  -> (a -> c)            -- ^ scale x-axis+                  -> (b -> d)            -- ^ scale y-axis+                  -> Title               -- ^ Title of the graph.+                  -> [(a, b)]            -- ^ Data to plot+                  -> Plot2D.T c d        -- ^ the plot.+series2scaledPlotWithLinestyle linestyle xscaler yscaler title = +    series2scaledPlotWith [LineSpec.title title, LineSpec.lineStyle linestyle] xscaler yscaler++series2plotWith :: (TVal.C a, AVal.C a, TVal.C b, AVal.C b) => +                     [LineSpec.T -> LineSpec.T] -- ^ Line specification, see "Graphics.Gnuplot.LineSpecification".+                  -> [(a, b)]                   -- ^ Data to plot+                  -> Plot2D.T a b               -- ^ the plot.+series2plotWith opts = series2scaledPlotWith opts id id++series2scaledPlotWith :: (TVal.C c, AVal.C c, TVal.C d, AVal.C d) => +                     [LineSpec.T -> LineSpec.T] -- ^ Line specification, see "Graphics.Gnuplot.LineSpecification".+                  -> (a -> c)                   -- ^ scale x-axis+                  -> (b -> d)                   -- ^ scale y-axis+                  -> [(a, b)]                   -- ^ Data to plot+                  -> Plot2D.T c d               -- ^ the plot.+series2scaledPlotWith opts xscaler yscaler s = +    let s' = scaleSeries xscaler yscaler s in+    Graph2D.lineSpec (makeGraphOpts opts) `fmap` Plot2D.list Graph2D.lines s'+++-- * Plot from a .sbench data file++sbench2plot :: FilePath -> IO (Plot2D.T Double Double)+sbench2plot = sbench2scaledPlot id id++sbench2scaledPlot ::    (Double -> Double)             -- ^ scale x-axis+                     -> (Double -> Double)             -- ^ scale y-axis+                     -> FilePath                       -- ^ data file+                     -> IO (Plot2D.T Double Double)    -- ^ produced plot+sbench2scaledPlot xscaler yscaler file = do+    (mi, s) <- sbench2series file+    return $ series2scaledPlot xscaler yscaler (miGraphTitle mi) s++sbench2plotWithLinestyle :: Int                          -- ^ Linestyle. See 'gnuplot' manual. +                         -> FilePath                     -- ^ data file+                         -> IO (Plot2D.T Double Double)  -- ^ produced plot+sbench2plotWithLinestyle linestyle = sbench2scaledPlotWithLinestyle linestyle id id++sbench2scaledPlotWithLinestyle :: Int                          -- ^ Linestyle. See 'gnuplot' manual. +                               -> (Double -> Double)           -- ^ scale x-axis+                               -> (Double -> Double)           -- ^ scale y-axis+                               -> FilePath                     -- ^ data file+                               -> IO (Plot2D.T Double Double)  -- ^ produced plot+sbench2scaledPlotWithLinestyle linestyle xscaler yscaler file = do+    (mi, s) <- sbench2series file+    return $ series2scaledPlotWith [LineSpec.title (miGraphTitle mi), LineSpec.lineStyle linestyle] xscaler yscaler s++sbench2plotWith :: [LineSpec.T -> LineSpec.T]   -- ^ Line specifications. See "Graphics.Gnuplot.LineSpecification"+                -> FilePath                     -- ^ data file+                -> IO (Plot2D.T Double Double)  -- ^ produced plot+sbench2plotWith lineOpts = sbench2scaledPlotWith lineOpts id id++sbench2scaledPlotWith :: [LineSpec.T -> LineSpec.T]   -- ^ Line specifications. See "Graphics.Gnuplot.LineSpecification"+                      -> (Double -> Double)           -- ^ scale x-axis+                      -> (Double -> Double)           -- ^ scale y-axis+                      -> FilePath                     -- ^ data file+                      -> IO (Plot2D.T Double Double)  -- ^ produced plot+sbench2scaledPlotWith lineOpts xscaler yscaler file = do+    (mi, s) <- sbench2series file+    return $ series2scaledPlotWith lineOpts xscaler yscaler s++-- * Combine plots to a diagram++-- | Produces a diagram with several plots inside.+--+--   The parameters are as follows+--   [@terminal@] Choose the output terminal. See "Graphics.Gnuplot.Terminal"+--   [@opts@]     Frame options, e.g. title. See "Graphics.Gnuplot.Frame.OptionSet"+--   [@plots@]    List of plots to be shown in the diagram.+toDiagramWith terminal opts plots = +    GPlot.plot terminal gr + where+   gr = Frame.cons (makeFrameOpts opts) $ combinePlots plots++-- | Compared to 'toDiagramWith', the output terminal is fixed to +--   "Graphics.Gnuplot.Terminal.PostScript" and the resulting+--   .eps file is transformed to a .pdf via a call to 'epstopdf'.+--+--   The parameters are as follows+--   [@name@]  Choose the output terminal. See "Graphics.Gnuplot.Terminal"+--   [@topts@] Frame options, e.g. title. See "Graphics.Gnuplot.Frame.OptionSet"+--   [@opts@]  List of plots to be shown in the diagram.+--   [@plots@]    List of plots to be shown in the diagram.+toDiagram name topts opts plots = +    let file = name <.> "eps" +        plt = (Frame.cons (makeFrameOpts opts) (combinePlots plots))+    in+    GPlot.plot (foldr ($) (PostScript.cons file) topts) plt +             >> system ("epstopdf " ++ file) +                    >> return (name <.> "pdf")++-- * Auxiliar functions++--scaleSeries :: (a -> b) -> (c -> d) -> [(a, c)] -> [(b, d)]+scaleSeries xscaler yscaler = map (\(x,y) -> (xscaler x, yscaler y))++makeGraphOpts :: [LineSpec.T -> LineSpec.T] -> LineSpec.T+makeGraphOpts = foldr ($) LineSpec.deflt++makeFrameOpts :: Graph.C graph => [Opts.T graph -> Opts.T graph] -> Opts.T graph+makeFrameOpts = foldr ($) Opts.deflt++combinePlots :: (TVal.C a, AVal.C a, TVal.C b, AVal.C b) => [Plot2D.T a b] -> Plot2D.T a b +combinePlots = foldr mappend mempty
+ src/Test/SBench/STerm.hs view
@@ -0,0 +1,84 @@+-- | The provided data type 'STerm' is intended to store a term equipped with+--   its own name and maybe some extra information about its cost center+--   annotation and modules that need to be loaded when evaluating the term.+--+--   The additional information, provided as strings, is necessary for space +--   measurements where small programs are constructed from the strings and run+--   for heap profiling.++module Test.SBench.STerm+  ( CostCenter+  , DataGen+  , Algorithm+  , Data+  , Seed +  , Test+  , STerm (..)+  , toData+  , toNamedData+  , toDataGen+  , toAlgorithm+  , (<$>)+  , getImports+  , makeSeeds+  , makeIntSeeds+  ) where++import Data.List ( nub )++type CostCenter = String+type ModuleName = String+type TermName   = String++data STerm a = T { stTerm    :: a             -- ^ The actual term.+                 , stName    :: TermName      -- ^ The term as 'String'+                 , stModules :: [ModuleName]  -- ^ The modules used when evaluation the term+                 , stCC      :: [CostCenter]  -- ^ cost centers to measure when performing +                                              --   heap profiling.+                 }++instance Show (STerm a) where+   show t = stName t++-- Aliases for 'STerm', all suggesting different use.+type Algorithm a = STerm a+type DataGen   a = STerm a+type Data      a = STerm a+type Seed      a = STerm a+type Test a b = Data a -> FilePath -> IO b+++-- Auxiliar generator functions for 'STerm's.+toAlgorithm :: (a -> b) -> ModuleName -> TermName -> CostCenter -> Algorithm (a -> b)+toAlgorithm alg mn tn cc = T alg (mn ++ "." ++ tn) [mn] [cc]++toDataGen :: (a -> b) -> ModuleName -> TermName -> Data (a -> b)+toDataGen f "" tn = T f tn [] []+toDataGen f mn tn = T f (mn ++ "." ++ tn) [mn] []++toData :: (Show a) => a -> STerm a+toData a = T a (show a) [] []++toNamedData :: (Show a) => a -> TermName -> STerm a+toNamedData a n = T a n [] []++makeSeeds :: (Integral a) +          => a -- ^ minimal value+          -> a -- ^ maximal value+          -> a -- ^ number of seeds+          -> [Seed a]+makeSeeds min max steps = map toData [min, (min + ((max - min) `div` steps)) .. max]++-- | Auxiliar version of 'makeSeeds' to prevent defaulting to 'Integer'.+makeIntSeeds :: Int -> Int -> Int -> [Seed Int]+makeIntSeeds = makeSeeds+++-- | Function application for 'STerm'.+(<$>) :: STerm (a -> b) -> STerm a -> STerm b+(<$>) (T f sf ms1 cc1) (T a sa ms2 cc2) =+    T (f a) (sf ++ " " ++ sa) (nub (ms1 ++ ms2)) (nub (cc1 ++ cc2))++getImports :: STerm a -> String+getImports = unlines . map ("import qualified " ++) . stModules+
+ src/Test/SBench/Space/OptionSet.hs view
@@ -0,0 +1,73 @@+module Test.SBench.Space.OptionSet where++import Test.SBench.Options+import Test.SBench.STerm ( Algorithm, STerm(..) )++-- | * Compiler options++-- | Options always added when compiling for space profiling.+generalCOpts :: CompilerOptions+generalCOpts =+    [ "--make"+    , "-prof"+    ]++-- | default compiler options additional to 'generalCOpts'.+defltCOpts :: CompilerOptions+defltCOpts = +    [ "-auto-all" +    , "-caf-all"+    , "-O2"+    ]+++-- * Build options++-- | By default repetitions are calculated automatically+defltRep :: Maybe Repetitions+defltRep = Nothing++-- | Default profiling options.+defltProfOpts :: ProfilingOptions+defltProfOpts = +    [ PPBreakdown  BCostCentreStack  -- RTS heap prof settings+    , PPInterval 0.02+    , PPNameLength 60+    ]++-- | Default test options, i.e. default options for compiling and running+--   a program for space profiling.+defltTestOpts :: TestOpts+defltTestOpts = TOpts+  { cOpts = defltCOpts+  , rOpts = ROpts+    { threadNum = Nothing+    , profOpts  = defltProfOpts+    , memOpts   = []+    , progArgs  = []+    }+  , reps  = Nothing+  , nfInp = False+  }++addCC :: Algorithm a -> TestOpts -> TestOpts+addCC alg opts = +    opts { +      rOpts = (rOpts opts) { +        profOpts = PPRestriction RCCStackAny (stCC alg) : (profOpts (rOpts opts))+        }+      }++setRepetitions ::  Repetitions -> TestOpts -> TestOpts+setRepetitions rep opts = opts { reps = Just rep }++autoRepeat :: TestOpts -> TestOpts+autoRepeat opts = opts { reps = Nothing }++setMemSizes :: [MemSize] -> TestOpts -> TestOpts+setMemSizes ms opts =+    opts {rOpts = (rOpts opts) {memOpts = ms } }++setNfInput :: Bool -> TestOpts -> TestOpts+setNfInput b opts = opts { nfInp = b }+
+ src/Test/SBench/Space/Series/Test.hs view
@@ -0,0 +1,52 @@+module Test.SBench.Space.Series.Test ( +    makeSeries+  , maxMemSeries+  , maxMemSeriesWith+  ) where ++import Test.SBench.Options ( NormalInput, TestOpts(..) )+import Test.SBench.STerm ( Algorithm, DataGen, Seed, Data, STerm(..), (<$>) )+import Test.SBench.Space.OptionSet ( setNfInput, addCC, defltTestOpts )+import Test.SBench.Space.Single.Test ( getMaxMemWith )+import Test.SBench.Options ( opts2string, Title )+import Test.SBench.File.FileOps ( series2sbench )++import System.FilePath ( FilePath )+import Control.Monad ( liftM )++makeSeries :: (Real c, Real d) =>+                 (TestOpts -> Algorithm (a -> b) -> Data a -> FilePath -> IO d) -- ^ Function for a single test.+              -> TestOpts           +              -> (FilePath, Title)   -- ^ File where the result data should be stored and title for the+                                     --   measurement graph (stored as meta information in the .sbench file)+              -> Algorithm (a -> b)  -- ^ Function to be tested+              -> DataGen (c -> a)    -- ^ Input data generator. It is fed with the input seeds.+              -> [Seed c]            -- ^ Input seeds, given to the input data generator to produce an input.+              -> IO [(c, d)]         -- ^ List of input seed-measurement pairs.+makeSeries fun topts (outf, title) alg gen seeds = +    let b = opts2string $ cOpts topts+        r = show $ rOpts topts+    in do+    s <- liftM (zip (map stTerm seeds)) (mapM go seeds)+    series2sbench (b, r) Nothing alg gen title outf s >> return s+  where+    tst  = fun topts alg+    go i = tst (gen <$> i) (outf ++ stName i)++-- | The function measures the maximal heap consumption of a given function over a series of different inputs+--   that are produced via an input generator given different seeds.+maxMemSeries :: Real c => +                   NormalInput            -- ^ Shall input data first be normalized? (Boolean value)+                   -> (FilePath, Title)   -- ^ Output data file (will get extension .sbench) and title for the+                                          --   graph of the data stored as meta information.+                   -> Algorithm (a -> b)  -- ^ Function to benchmark+                   -> DataGen (c -> a)    -- ^  Input data generator. It is fed with the input seeds.+                   -> [Seed c]            -- ^ Input seeds, given to the input data generator to produce an input.+                   -> IO [(c, Integer)]   -- ^ List of input seed-maximal heap consumption pairs.+maxMemSeries nfinp ft alg = maxMemSeriesWith (setNfInput nfinp $ addCC alg $ defltTestOpts) ft alg++-- | The function acts similar to 'maxMemSeries', but instead of only 'NormalInput', 'TestOpts' can be set manually+--   via the first parameter.+maxMemSeriesWith :: Real c => TestOpts -> (FilePath, Title) -> Algorithm (a -> b) -> DataGen (c -> a) -> [Seed c] -> IO [(c, Integer)]+maxMemSeriesWith topts ft alg gen seeds =+    makeSeries getMaxMemWith topts ft alg gen seeds
+ src/Test/SBench/Space/Single/ExploreProfile.hs view
@@ -0,0 +1,29 @@+module Test.SBench.Space.Single.ExploreProfile +  ( getMaxMem+  , getMemLine+  )+where++import Profiling.Heap.Read ( readProfile )+import Profiling.Heap.Types ( Profile(..), ProfileQuery(..), ProfileSample)++getMaxMem :: FilePath -> IO Integer+getMaxMem fp = do+    prof <- myReadProfile fp+    return $ (fromIntegral (maxCost prof) :: Integer)++getMemLine :: FilePath -> IO [(Double, Integer)]+getMemLine fp = do+    prof <- myReadProfile fp+    let s = samples prof+    return $ map (\(t, xs) -> (t, getCost xs)) s++myReadProfile :: FilePath -> IO Profile+myReadProfile fp = do+    mprof <- readProfile fp+    case mprof of+      Nothing   -> error $ "could not read " ++ fp+      Just prof -> return $ prof++getCost :: ProfileSample -> Integer+getCost = sum . map (fromIntegral . snd)
+ src/Test/SBench/Space/Single/MakeExecutable.hs view
@@ -0,0 +1,99 @@+module Test.SBench.Space.Single.MakeExecutable+    ( make+    , makeWith+    ) +  where++import System.FilePath ( FilePath, addExtension )+import System ( system )+import System.IO ( writeFile )+import Data.Maybe ( fromMaybe )+import Control.Monad ( liftM2 )++import Test.SBench.Options ( +    opts2string+  , Repetitions+  , CompilerOptions+  , TestOpts (..)+  , Imports+  , NormalInput+  )++import Test.SBench.STerm ( Algorithm, Data, Seed, STerm(..), getImports )+import Test.SBench.Space.OptionSet ( generalCOpts )++import Criterion.Measurement ( time )++make :: TestOpts -> Algorithm (a -> b) -> Data a -> FilePath -> IO FilePath+make topts = makeWith (nfInp topts) (reps topts) (cOpts topts)++makeWith :: NormalInput -> Maybe Repetitions -> CompilerOptions -> Algorithm (a -> b) -> Data a -> +    FilePath -> IO FilePath+makeWith nfinp rep copts f a out =+  let source    = addExtension out "hs"+      strcopts  = opts2string $ generalCOpts ++ copts+      autoGen   = calcRepetitions nfinp copts f a+  in do+        print $ "The repetitions: " ++ show rep+        print $ "Input normalized: " ++ show nfinp+        rep' <- case rep of { Nothing -> autoGen; Just r -> return r }+        writeFile (addExtension out "hs") (makeContent nfinp rep' f a)+        print $ "running: ghc " ++ strcopts ++ " -o " ++ out ++ " " ++ source+        system $ "ghc " ++ strcopts ++ " -o " ++ out ++ " " ++ source+        return out++-- | Find a reasonable number of repetitions of the function to measure, such that +--   the overall runtime is long enough to get enough heap samples.+--   The function is far from perfect and may need a rewrite.+calcRepetitions :: NormalInput -> CompilerOptions -> Algorithm (a -> b) -> Data a -> IO Int+calcRepetitions nfinp = calcRepetitions' nfinp 10++calcRepetitions' :: NormalInput -> Int -> CompilerOptions -> Algorithm (a -> b) -> Data a -> IO Int+calcRepetitions' nfinp rep copts f a =+  do+     writeFile "rep_check.hs" (makeContent nfinp rep f a)+     print $ "Calculating reasonable number of repetitions trying with " ++ show rep ++ " ..."+     system $ "ghc " ++ opts2string ("--make" : copts) ++ " -o rep_check rep_check.hs"+     print $ "start executing rep_check ..."+     system "chmod +x rep_check"+     (t, _) <- time $ system "./rep_check"+     print $ "... finish executing rep_check"+     print $ "Time was " ++ show t ++ " seconds."+     if t > 0.001+       then +          do+            let reps' = truncate $ 1 * fromIntegral rep / t + 1+                reps  = max reps' 100+            print $ "Testing with " ++ show reps ++ " repetitions (expecting at least 1s runtime without profiling, but quarantee at least 100 runs)"+            return reps+       else calcRepetitions' nfinp (10 * rep) copts f a        +++-- * auxiliar functions to build the program file+makeContent :: NormalInput -> Int -> Algorithm (a -> b) -> Data a -> String+makeContent nfinp rep f a =+    header + ++ imports + ++ "\n" + ++ makeMain nfinp rep f a+  where+    imports = (imports2string defltImport) ++ getImports f ++ getImports a+    makeMain nfinp rep f a = +         "main = \n"+      ++ "    let dat  = " ++ stName a ++ "\n"+      ++ "        dat' = if " ++ show nfinp ++ " then deepseq dat dat else dat \n"+      ++ "        res  = map " +         ++ stName f ++ " as \n"+      ++ "        as = take " ++ show rep ++ " (repeat dat') in \n"+      ++ "    deepseq res (print \"Done.\")"++++header :: String+header = "module Main where \n"+++defltImport = [ "Control.DeepSeq ( deepseq )" ]++imports2string :: Imports -> String+imports2string xs = unlines $ map ("import " ++) xs
+ src/Test/SBench/Space/Single/RunExecutable.hs view
@@ -0,0 +1,44 @@+module Test.SBench.Space.Single.RunExecutable+    ( run+    , runWith+    )+  where++import System.FilePath ( FilePath, addExtension, isRelative )+import System ( system )++import Test.SBench.Options ( +    TestOpts (..)+  , opts2string+  , ProfParam (..)+  , Breakdown (..)+  , Restriction (..)+  , ProfilingOptions+  , MemoryOptions+  , RuntimeOptions (..)+  , ThreadNum+  , ProgramArguments+  )++run :: TestOpts -> FilePath -> IO FilePath+run topts = runWith +              (get progArgs) +              (get threadNum)+              (get memOpts)+              (get profOpts)+  where get opts = opts $ rOpts topts ++runWith :: ProgramArguments -> Maybe ThreadNum -> MemoryOptions -> +       ProfilingOptions -> FilePath -> IO FilePath+runWith pargs threads mopts popts exe = do+    let call = opts2string+                [ (if isRelative exe then "./" else "") ++ exe+                , opts2string pargs+                , "+RTS"+                , case threads of { Nothing -> ""; Just t -> "-N" ++ show t}+                , opts2string (map show mopts)+                , opts2string (map show popts)+                ]+    print $ "call the following program:\n" ++ call ++ "\n"+    system call+    return $ addExtension exe "hp"
+ src/Test/SBench/Space/Single/Test.hs view
@@ -0,0 +1,63 @@+module Test.SBench.Space.Single.Test+    ( getProfile+    , getMaxMem+    , getMaxMemWith+    , getMemLine+    , getMemLineWith+    )+  where++import System.FilePath ( FilePath )++import Test.SBench.Space.Single.MakeExecutable ( make )+import Test.SBench.Space.Single.RunExecutable ( run )+import qualified Test.SBench.Space.Single.ExploreProfile as Explore ( getMaxMem, getMemLine )+import Test.SBench.Options ( TestOpts(..), NormalInput, MemSize(..), MemUnit(..), Title, opts2string, EvalMod(..) )+import Test.SBench.STerm ( Algorithm(..), Data )+import Test.SBench.Space.OptionSet ( setRepetitions, addCC, defltTestOpts, setNfInput, setMemSizes )+import Test.SBench.File.FileOps ( series2sbench' )+++-- | Create only the heap profile.+getProfile :: TestOpts -> Algorithm (a -> b) -> Data a +    -> FilePath -> IO FilePath+getProfile topts alg arg file = make topts alg arg file >>= run topts+++-- | Get the maximal heap occupied by the algorithm.+--   Since the algorithms comes with a cost center annotation this is used to+--   explore what heap consumption should be measured (here: all heap directly+--   or indirectly used by the given algorithm).+getMaxMem ::    NormalInput         -- ^ Shall input be normalized first? (Boolean value)+             -> Algorithm (a -> b)  -- ^ The algorithm to test+             -> Data a              -- ^ The test input+             -> FilePath            -- ^ File the program generated for measurements is stored to.+                                    --   More precise: the files, i.e. source code, executable,+                                    --   heap profile, intermediate files during build+             -> IO Integer          -- ^ Maximal heap used.+getMaxMem nfinp alg = +  getMaxMemWith (setNfInput nfinp $ setMemSizes [Stack 500 M] $ setRepetitions 1 $ addCC alg $ defltTestOpts) alg++-- | As 'getMaxMem', but 'TestOpts' can be set by the user.+getMaxMemWith :: TestOpts -> Algorithm (a -> b) -> Data a -> FilePath -> IO Integer+getMaxMemWith topts alg arg file = getProfile topts alg arg file >>= Explore.getMaxMem+++-- | The function generates a heap profile, returns the heapconsumption over time as series and+--   also stores the series as an .sbench file.+getMemLine :: NormalInput              -- ^ Shall input be normalized first? (Boolean value)+           -> (FilePath, Title)        -- ^ Name of the generated .sbench file and all +                                       --   intermediate files (e.g. .hs, .hp)+           -> Algorithm (a -> b)       -- ^ The algorithm to test+           -> Data a                   -- ^ The test input+           -> IO [(Double, Integer)]+getMemLine nfinp store alg = +  getMemLineWith (setNfInput nfinp $ setMemSizes [Stack 500 M] $ setRepetitions 1 $ addCC alg $ defltTestOpts) store alg++-- As 'getMemLine', but 'TestOpts' can be set by the user.+getMemLineWith :: TestOpts -> (FilePath, Title) -> Algorithm (a -> b) -> Data a -> IO [(Double, Integer)]+getMemLineWith topts (file, title) alg arg = do+    s <- getProfile topts alg arg file >>= Explore.getMemLine+    series2sbench' (opts2string (cOpts topts), show (rOpts topts)) (Just (if (nfInp topts) then NF else WHNF)) alg arg title file s +    return s+
+ src/Test/SBench/Time/Series/Test.hs view
@@ -0,0 +1,96 @@+-- | Functions for runtime tests are provided. They are basically a wrapper to +--   a call to the criterion function "Criterion.Main.defaultMainWith".+--   The measurement data (usually stored in temp.csv) is than postprocessed+--   by extracting only the mean runtime for each run and tupling it with the+--   respective input seed.+--   Results are then returned as list of tuples and optionally stored in a+--   .sbench file (see "Test.File.FileOps").++module Test.SBench.Time.Series.Test ( +    runtimeSeries+  , runtimeSeriesWith+  , nfRuntimeSeries+  , whnfRuntimeSeries +  , scaleRt+  ) where++import Criterion.Main ( defaultMainWith, bgroup, bench, nf, whnf )+import Criterion.Config ( Config(..), defaultConfig )+import Data.Monoid ( Last(..) ) +import System.FilePath ( (<.>), dropExtension )+import qualified Control.DeepSeq ( NFData, deepseq )++import Test.SBench.STerm ( Algorithm, DataGen, Seed, STerm (..), (<$>) )+import Test.SBench.Options ( EvalMod (..), Title )+import Test.SBench.File.FileOps ( criterion2series, series2sbench )++type BuildOptions = String+type ExeOptions = String++scaleRt :: Double -> [(Int, Double)] -> [(Int, Double)]+scaleRt f = map (\(x,y) -> (x,f*y))++defltCriterionFile = "temp" <.> "csv"++-- | Most general function to perform runtime measurements for a series of inputs.+runtimeSeriesWith :: (Control.DeepSeq.NFData b, Real c) => +                        Config  -- ^ see "Criterion.Config.Config"+                     -> EvalMod -- ^ Evaluation level of the input before starting the measurement.+                                --   Either weak head normal form ('WHNF') or normal form ('NF')+                     -> Maybe (BuildOptions, ExeOptions, FilePath, Title) +                                -- ^ Choose, whether you want to create a .sbench file and if give +                                --   meta information about build options, execution options as well+                                --   as the file name for the .sbench file and the title for the+                                --   measurements that should be stored as meta information.+                     -> Algorithm (a -> b) -- ^ The function that is to be tested.+                     -> DataGen (c -> a)   -- ^ The input data generator+                     -> [Seed c]           -- ^ Seeds to the input data generator. For each seed+                                           --   a measurement is performed. A list of seeds might+                                           --   be generated via "Test.SBench.Auxiliar.Datagen.makeGens"+                     -> IO [(c, Double)]   -- ^ series of the measurements as seed-runtime pairs.+runtimeSeriesWith cfg evalMod sbfile alg gen seeds = do+    print "enter criterion benchmarking .."+    t <- defaultMainWith cfg (return ()) benches+    print $ "finished criterion benchmarking with " ++ show t+    s <- criterion2series (map stTerm seeds) file+    case sbfile of+      Nothing -> return s+      Just (b,e,f,t)  -> series2sbench (b, e) (Just evalMod) alg gen t f s +                         >> return s+  where+    file = case cfgSummaryFile cfg of+               Last (Just f) -> f+               _             -> defltCriterionFile+    benches = [ bgroup (dropExtension file) $ map (toBench gen) seeds ]+    toBench gen seed  = let inp = gen <$> seed in bench (stName inp) $ efun (stTerm alg) (stTerm inp)+    efun    = case evalMod of+                NF   -> nf+                WHNF -> whnf++-- | As 'runtimeSeriesWith', but "Criterion.Config.Config" is set to a default.+runtimeSeries :: (Control.DeepSeq.NFData b, Real c) => +                    EvalMod+                 -> Maybe (BuildOptions, ExeOptions, FilePath, Title) +                 -> Algorithm (a -> b) +                 -> DataGen (c -> a) +                 -> [Seed c] +                 -> IO [(c, Double)]+runtimeSeries = runtimeSeriesWith defaultConfig {cfgSummaryFile = Last $ Just $ defltCriterionFile }+++nfRuntimeSeries :: (Control.DeepSeq.NFData b, Real c) => +                      Maybe (BuildOptions, ExeOptions, FilePath, Title) +                   -> Algorithm (a -> b) +                   -> DataGen (c -> a) +                   -> [Seed c] +                   -> IO [(c, Double)]+nfRuntimeSeries = runtimeSeries NF ++whnfRuntimeSeries :: (Control.DeepSeq.NFData b, Real c) => +                        Maybe (BuildOptions, ExeOptions, FilePath, Title)+                     -> Algorithm (a -> b)+                     -> DataGen (c -> a)+                     -> [Seed c]+                     -> IO [(c, Double)]+whnfRuntimeSeries = runtimeSeries WHNF +