fibon (empty) → 0.1.0

raw patch · 35 files changed

+2885/−0 lines, 35 filesdep +Cabaldep +basedep +bytestringbuild-type:Customsetup-changed

Dependencies added: Cabal, base, bytestring, containers, directory, filepath, hslogger, mtl, old-locale, process, statistics, tabular, text, time, vector

Files

• FindBench.hs +174/−0
• FindConfig.hs +38/−0
• LICENSE +30/−0
• README +133/−0
• Setup.hs +34/−0
• fibon.cabal +127/−0
• lib/Fibon/BenchmarkInstance.hs +32/−0
• lib/Fibon/ConfigMonad.hs +107/−0
• lib/Fibon/FlagConfig.hs +10/−0
• lib/Fibon/InputSize.hs +10/−0
• lib/Fibon/Result.hs +41/−0
• lib/Fibon/Timeout.hs +19/−0
• tools/fibon-analyse/Fibon/Analyse/Analysis.hs +225/−0
• tools/fibon-analyse/Fibon/Analyse/AnalysisRoutines.hs +41/−0
• tools/fibon-analyse/Fibon/Analyse/CommandLine.hs +80/−0
• tools/fibon-analyse/Fibon/Analyse/ExtraStats.hs +10/−0
• tools/fibon-analyse/Fibon/Analyse/ExtraStats/GhcStats.hs +34/−0
• tools/fibon-analyse/Fibon/Analyse/Main.hs +37/−0
• tools/fibon-analyse/Fibon/Analyse/Metrics.hs +165/−0
• tools/fibon-analyse/Fibon/Analyse/Output.hs +113/−0
• tools/fibon-analyse/Fibon/Analyse/Parse.hs +43/−0
• tools/fibon-analyse/Fibon/Analyse/Result.hs +34/−0
• tools/fibon-analyse/Fibon/Analyse/Tables.hs +44/−0
• tools/fibon-init/Main.hs +131/−0
• tools/fibon-run/Fibon/Run/Actions.hs +243/−0
• tools/fibon-run/Fibon/Run/BenchmarkBundle.hs +168/−0
• tools/fibon-run/Fibon/Run/BenchmarkRunner.hs +209/−0
• tools/fibon-run/Fibon/Run/CommandLine.hs +157/−0
• tools/fibon-run/Fibon/Run/Config.hs +84/−0
• tools/fibon-run/Fibon/Run/Config/Default.hs +25/−0
• tools/fibon-run/Fibon/Run/Config/Local.hs +14/−0
• tools/fibon-run/Fibon/Run/Log.hs +60/−0
• tools/fibon-run/Fibon/Run/Main.hs +177/−0
• tools/fibon-run/Fibon/Run/Manifest.hs +21/−0
• tools/fibon-run/Fibon/Run/SysTools.hs +15/−0

@@ -0,0 +1,174 @@+module FindBench(findLocalBenchmarks) where+--module Main where++import Control.Exception+import Control.Monad (filterM, when, liftM)+import Data.List+import System.Directory+import System.FilePath+import System.IO++{-+-- for standalone testing+main = do+  findLocalBenchmarks "benchmarks"+-}++benchmarksModule         = ["Fibon", "Benchmarks"]+benchmarksInstanceModule = "Fibon.Instance"++findLocalBenchmarks :: FilePath -> IO ()+findLocalBenchmarks baseDir = do+  let searchPath = join ([pathSeparator]) (baseDir : benchmarksModule)+  putStr $ "Looking for benchmarks in "++searchPath+  groups <- sort `liftM` bmGroups searchPath+  bms    <- bmInstances searchPath groups+  let allBms       = (sort . concat) bms+      qualifiedBms = +        concat $ zipWith (\g bs -> map ((,)g) (sort bs)) groups bms+      outFile      = searchPath ++ ".hs"+  when (null groups) printNoBenchmarksWarning+  putStrLn $ "... found ("++ (show.length$ allBms)++")"+  putStrLn $ "  writing benchmark manifest to "++outFile+  createDirectoryIfMissing True (baseDir </> "Fibon")+  h <- openFile outFile WriteMode+  hPutStrLn h moduleHeader+  hPutStrLn h $ moduleImports (join "." benchmarksModule) qualifiedBms+  hPutStrLn h ""+  hPutStrLn h $ benchDataDecl allBms+  hPutStrLn h ""+  hPutStrLn h $ groupDataDecl groups+  hPutStrLn h ""+  hPutStrLn h $ allBenchmarksDecl allBms+  hPutStrLn h ""+  hPutStrLn h $ benchGroupDecl qualifiedBms+  hPutStrLn h ""+  hPutStrLn h $ benchInstanceDecl qualifiedBms+  hPutStrLn h ""+  hPutStrLn h $ benchPathDecl qualifiedBms+  hClose h++bmGroups :: FilePath -> IO [FilePath]+bmGroups baseDir = do+  dirs <- try (getDirectoryContents baseDir) :: IO (Either IOError [FilePath])+  case dirs of+    Left  _  -> return [] +    Right ds -> removeBadEntries baseDir ds++bmInstances :: FilePath -> [FilePath] -> IO [[String]]+bmInstances baseDir groups = do+  let paths = map (baseDir </>) groups+  bms <- mapM getDirectoryContents paths+  mapM (\(p, bm) -> removeBadEntries p bm) (zip paths bms)++removeDotFiles :: [FilePath] -> [FilePath]+removeDotFiles = filter (\d -> not ("." `isPrefixOf` d))++removeBadEntries :: FilePath -> [FilePath] -> IO [FilePath]+removeBadEntries baseDir dirs = do+  let paths = map (baseDir </>) dirs+  noFiles <- filterM (\d -> doesDirectoryExist (baseDir </> d)) dirs+  let noUnderscores = filter (\d -> not ("_" `isPrefixOf` d)) noFiles+  return (removeDotFiles noUnderscores)++moduleHeader :: String+moduleHeader = join "\n" [+  "module "++modName++" (",+  "    FibonBenchmark(..)",+  "  , FibonGroup(..)",+  "  , allBenchmarks",+  "  , benchGroup",+  "  , benchInstance",+  "  , benchPath",+  ")",+  "where",+  "import Fibon.InputSize",+  "import Fibon.BenchmarkInstance",+  "import System.FilePath"+  ]+  where+  modName = join "." benchmarksModule ++moduleImports :: String -> [(String, String)] -> String+moduleImports baseMod bms = join "\n" imports+  where+  imports           = map importStmt bms+  importStmt (g,bm) = +    "import qualified "+    ++baseMod++"."++g++"."++bm++"."++benchmarksInstanceModule+    ++" as "++(importAs g bm) ++importAs :: String -> String -> String+importAs _grp modu = modu ++ "_bm"++groupName :: String -> String+groupName g = g++benchDataDecl :: [String] -> String+benchDataDecl bms = "data FibonBenchmark = " ++ datas bms ++ derivings+  where derivings = "\n    deriving(Read, Show, Eq, Ord, Enum)"+        datas []  = "NoBenchmarksFound"+        datas bms = "\n   " ++ (join ("\n  | ") bms)++groupDataDecl :: [String] -> String+groupDataDecl grps = "data FibonGroup = " ++ datas grps ++ derivings+  where derivings  = "\n    deriving(Read, Show, Eq, Ord, Enum)"+        datas []   = "NoGroupsFound"+        datas grps = "\n   "++ (join ("\n  | ") (map groupName grps))++allBenchmarksDecl :: [String] -> String+allBenchmarksDecl bms =+  "allBenchmarks :: [FibonBenchmark]\n"+++  "allBenchmarks = [\n      "+++  (join ("\n    , ") bms) +++  "\n  ]"++benchGroupDecl :: [(String, String)] -> String+benchGroupDecl []   = benchGroupTypeDecl ++ "benchGroup = "++ emptyError+benchGroupDecl qBms = benchGroupTypeDecl ++ (join ("\n") $ map defn qBms)+  where+  defn (g,bm) = "benchGroup " ++ bm ++ " = " ++ (groupName g)++benchGroupTypeDecl :: String+benchGroupTypeDecl = "benchGroup :: FibonBenchmark -> FibonGroup\n"++benchInstanceDecl :: [(String, String)] -> String+benchInstanceDecl []   = benchInstanceTypeDecl ++ "benchInstance = "++ emptyError+benchInstanceDecl qBms = benchInstanceTypeDecl ++ (join ("\n") $ map defn qBms)+  where+  defn (g,bm) =+    "benchInstance " ++ bm ++ " = " ++ (importAs g bm) ++ ".mkInstance"++benchInstanceTypeDecl :: String+benchInstanceTypeDecl =+  "benchInstance :: FibonBenchmark -> InputSize -> BenchmarkInstance\n"++benchPathDecl :: [(String, String)] -> String+benchPathDecl []   = benchPathTypeDecl ++ "benchPath = " ++ emptyError+benchPathDecl qBms = benchPathTypeDecl ++ (join ("\n") $ map defn qBms)+  where+  defn (g,bm) = "benchPath " ++ bm ++ " = " ++ s g ++ " </> " ++ s bm+  s x = "\"" ++ x ++"\""++benchPathTypeDecl :: String+benchPathTypeDecl = "benchPath :: FibonBenchmark -> FilePath\n"++join :: String -> [String] -> String+join s ss = concat (intersperse s ss)++emptyError :: String+emptyError = "error \"No benchmarks found. Need to re-run cabal config step\""++printNoBenchmarksWarning :: IO ()+printNoBenchmarksWarning = do+  putStrLn "\n"+  putStrLn banner+  putStrLn $cap("! No benchmarks found.")+  putStrLn $cap("! You will not be able to run collect results with fibon-run")+  putStrLn banner+  putStrLn ""+  where+  banner = line++"WARNING"++line+  line   = take 30 (repeat '-')+  cap s  = s ++ take ((length banner) - (length s) - 1) (repeat ' ') ++ "!"+

@@ -0,0 +1,38 @@+module FindConfig(findLocalConfigs, localConfigsFileName) where+import Data.List+import System.Directory+import System.FilePath+import System.IO++findLocalConfigs :: FilePath -> IO ()+findLocalConfigs cDir = do+  fs <- getDirectoryContents cDir+  putStr "\nLooking for local configuration modules... "+  let modNames = map dropExtension $ filter (".hs" `isSuffixOf`) fs+  let imports  = map importStmt $ modNames+  let modules  = map importAs   $ modNames+  putStrLn $ "found ("++ (show.length$ modNames)++")"+  writeToFile (localConfigsFileName cDir) (imports ++ [modulesList modules])+  where+  importStmt m = "import qualified "++m++" as " ++importAs m+  writeToFile fName contents = do+    h <- openFile fName WriteMode+    putStrLn $ "  writing config manifest to " ++ fName+    --putStrLn $ unlines contents+    hPutStr h (unlines contents)+    hClose h++modulesList :: [String] -> String+modulesList mods = typ ++ lst +  where+  typ = "localConfigs :: [RunConfig]\n"+  lst = "localConfigs = [" ++ (join ", " cfgs) ++ "]"+  cfgs = map (++".config") mods+  join s = concat . intersperse s++importAs :: String -> String+importAs modName = modName++"_Config"++localConfigsFileName :: FilePath -> FilePath+localConfigsFileName baseDir = baseDir </> "LocalConfigs.txt"+

@@ -0,0 +1,30 @@+Copyright David M Peixotto 2010++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 David M Peixotto 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.

@@ -0,0 +1,133 @@+Fibon in a Flash+===================================================================+    $ git clone git://github.com/dmpots/fibon.git+    $ cd fibon+    $ git submodule update --init benchmarks+    $ cabal configure && cabal build+    $ ./dist/build/fibon-run/fibon-run++Introduction+===================================================================+Fibon is a set of tools for running and analysing benchmarks in+Haskell. Most importantly, it includes a set of default benchmarks+taken from the [Hackage][1] open source repository.++Benchmarks+------------------+Fibon makes it easy to use either the fibon benchmarks or your own+set of benchmarks. Benchmarks are stored in the+`benchmarks/Fibon/Benchmarks` directory. This directory is setup as+a [git submodule][2] which means you can easily grab the standard+suite or use a suite kept under your own source control.++Benchmark Groups+------------------+Benchamarks named and organized into groups based on the filesystem+organization. For example, a benchmark in the directory+`benchmarks/Fibon/Benchmarks/Hackage/Agum` will have the name `Agum`+an be in the benchmark group `Hackage`.++Executables+------------------+The fibon package builds three tools+  1. `fibon-run` - runs the benchmarks+  2. `fibon-analyze` - analyzes the results of a run+  2. `fibon-init` - utilty used when adding new benchmarks++Size and Tune+------------------+Fibon benchmarks can be run with two different input sizes: `Test` and+`Ref`. The `Test` size is useful to make sure that a benchmark can+run successsfully, but will not give meaningful timings.++Fibon benchmarks can be run under two different tune settings (e.g.+compiler optimization settings). The `Base` and `Peak` settings can+be configured anyway you want to make the desired comparison.++Directory Structure+--------------------+Source directories+    ./benchmarks -- benchmark code+    ./config     -- config files+    ./lib        -- common files used by several executables+    ./tools      -- source code for executables++Working directories+    ./log        -- logging output from benchmark runs+    ./run        -- working directory for benchmark runs++Getting the Benchmarks+===================================================================+The benchmarks are kept in a separate repository as a [git+submodule][2]. You can get the fibon benchmarks by updating the+submodule from within your fibon working directory++    $ git submodule update --init benchmarks++This will checkout the benchmarks from the fibon-benchmarks+repository and place them in your working copy.++Running Benchmarks+===================================================================+The available benchmarks and configurations are discovered when the+fibon package is configured. Benchmarks are searched for in the+`benchmarks/Fibon/Benchmarks` directory and configuration files are+searched for in the `config` directory. If a configuration file or+benchmark is added, you will need to re-run `cabal configure` to+make them available to the fibon-run tool.++Configuration+---------------+Fibon comes with a default configuration. The default configuration+will run all benchmarks with the `Base` setting of `-O0` and a+`Peak` setting of `-O2` on the `Ref` size. A configuration file can+be used to specify more complicated configurations.++You can get some example configuration by doing+    $ git submodule update --init config++This will checkout a repository of config files. Note that currently+these files contain some user and machine-specific configurations,+but should be a useful starting point.++You can also selectively run benchmarks, groups, sizes, and tune+settings as described below.++Running+---------------+Benchamarks are run with the `fibon-run` tool. Running `fibon-run`+with no arguments will use the default config file. An alternate+config file can be specified with the `-c` flag. Also, you can give+a list of benchmarks or groups to run on the command line. Use+`--help` to see a full list of options.++Running the benchmarks will produce some logging to standard out and+create four output files in the `log` directory.++  1. `*.LOG` - the full log of the run+  1. `*.SUMMARY` - the mean runtimes of each benchmark+  1. `*.RESULTS` - the full results (passed to `fibon-analyse`)++Analyzing Benchmark Results+===================================================================+Benchmarks can be analyzed by the `fibon-analyse` tool.++    $ fibon-analyse log/000.default.RESULTS++Adding New Benchmarks+===================================================================+TODO++Benchmark Notes+===================================================================+Ghc610+  ChameneosRedux+    Does not work with -O0. Gets "thread blocked indefinitely"+    exception++  Mandelbrot+    The Test size gives different result, but the Ref size is ok.+    Think it is just some kind of floating point wibbles.++[1]: http://hackage.haskell.org+[2]: http://www.kernel.org/pub/software/scm/git/docs/user-manual.html#submodules

@@ -0,0 +1,34 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+import Distribution.PackageDescription+import Control.Monad+import System.Directory+import FindBench+import FindConfig++main = defaultMainWithHooks simpleUserHooks {+          preConf   = createConfDir+        , postConf  = writeLocalConf+        , postClean = deleteLocalConf}++createConfDir _ _ = do+  e <- doesDirectoryExist configDir+  unless e (createDirectory configDir)+  return emptyHookedBuildInfo++writeLocalConf _ _ _ _ = do+  findLocalConfigs    configDir+  findLocalBenchmarks benchmarkDir++deleteLocalConf _ _ _ _ = do+  deleteIfExists (localConfigsFileName configDir)++deleteIfExists :: FilePath -> IO ()+deleteIfExists f = do+  e <- doesFileExist f+  when e (removeFile f)+++configDir, benchmarkDir :: FilePath+configDir       = "config"+benchmarkDir    = "benchmarks"

@@ -0,0 +1,127 @@+-- The name of the package.+Name:                fibon+Version:             0.1.0+Synopsis:            A reworking of the classic nofib benchmark suite+Description:         +  Fibon is a set of tools for running and analyzing benchmark programs.+  The fibon package contains the tools for benchmarking, but not the+  benchmarks themselves. The package will build, but will not have any+  benchmarks to run. A set of benchmarks can be found at++  http://github.com/dmpots/fibon-benchmarks++  Installing the cabal package will get you the following tools++    * fibon - runs the benchmarks+    * fibon-analyse - analyses the results of a benchmark run+    * fibon-init - generate a benchmark description from a cabal file++  See http://github.com/dmpots/fibon/wiki for more details+License:             BSD3+License-file:        LICENSE+Author:              David M Peixotto+Maintainer:          dmp@rice.edu+Stability:           Experimental+Category:            Benchmarking+Homepage:            http://github.com/dmpots/fibon/wiki+Bug-reports:         http://github.com/dmpots/fibon/issues+Build-type:          Custom+Cabal-version:       >=1.8++Extra-source-files: README+                    FindBench.hs+                    FindConfig.hs+                    lib/Fibon/BenchmarkInstance.hs+                    lib/Fibon/ConfigMonad.hs+                    lib/Fibon/FlagConfig.hs+                    lib/Fibon/InputSize.hs+                    lib/Fibon/Result.hs+                    lib/Fibon/Timeout.hs+                    tools/fibon-analyse/Fibon/Analyse/AnalysisRoutines.hs+                    tools/fibon-analyse/Fibon/Analyse/Analysis.hs+                    tools/fibon-analyse/Fibon/Analyse/CommandLine.hs+                    tools/fibon-analyse/Fibon/Analyse/ExtraStats/GhcStats.hs+                    tools/fibon-analyse/Fibon/Analyse/ExtraStats.hs+                    tools/fibon-analyse/Fibon/Analyse/Main.hs+                    tools/fibon-analyse/Fibon/Analyse/Metrics.hs+                    tools/fibon-analyse/Fibon/Analyse/Output.hs+                    tools/fibon-analyse/Fibon/Analyse/Parse.hs+                    tools/fibon-analyse/Fibon/Analyse/Result.hs+                    tools/fibon-analyse/Fibon/Analyse/Tables.hs+                    tools/fibon-init/Main.hs+                    tools/fibon-run/Fibon/Run/Actions.hs+                    tools/fibon-run/Fibon/Run/BenchmarkBundle.hs+                    tools/fibon-run/Fibon/Run/BenchmarkRunner.hs+                    tools/fibon-run/Fibon/Run/CommandLine.hs+                    tools/fibon-run/Fibon/Run/Config/Default.hs+                    tools/fibon-run/Fibon/Run/Config/Local.hs+                    tools/fibon-run/Fibon/Run/Config.hs+                    tools/fibon-run/Fibon/Run/Log.hs+                    tools/fibon-run/Fibon/Run/Main.hs+                    tools/fibon-run/Fibon/Run/Manifest.hs+                    tools/fibon-run/Fibon/Run/SysTools.hs++source-repository head+  type:     git+  location: git://github.com/dmpots/fibon.git++source-repository this+  type:     git+  location: git://github.com/dmpots/fibon.git+  tag:      v0.1.0++Flag analyse+  description: Build the fibon-analyse program+  default: True++Executable fibon-run+  main-is:          Fibon/Run/Main.hs+  ghc-options: -Wall -threaded+  include-dirs: config+  hs-source-dirs: tools/fibon-run+                  lib+                  benchmarks+                  config+  build-depends:  base >= 4 && < 5+                , containers+                , mtl         == 1.1.*+                , directory   == 1.0.*+                , filepath    == 1.1.*+                , hslogger    == 1.0.*+                , process     == 1.0.*+                , time        == 1.1.*+                , old-locale  == 1.0.*+                , statistics  == 0.6.*+                , vector      == 0.6.*+--  other-modules:  Fibon.Benchmarks++Executable fibon-init+  main-is:        Main.hs+  ghc-options:    -Wall+  hs-source-dirs: tools/fibon-init+  build-depends:  base >= 4 && < 5+                , filepath    == 1.1.*+                , directory   == 1.0.*+                , Cabal == 1.8.*++Executable fibon-analyse+  if (flag(analyse))+    buildable: True+  else+    buildable: False+  main-is:        Fibon/Analyse/Main.hs+  ghc-options:    -Wall+  hs-source-dirs: tools/fibon-analyse, lib+  if (flag(analyse))+    build-depends:    base >= 4 && < 5+                    , containers+                    , mtl        == 1.1.*+                    , filepath   == 1.1.*+                    , bytestring == 0.9.*+                    , text       == 0.8.*+                    , tabular    == 0.2.*+                    , vector     == 0.6.*+                    , statistics == 0.6.*+  extensions: CPP++

@@ -0,0 +1,32 @@+module Fibon.BenchmarkInstance(+    BenchmarkInstance(..)+  , OutputDestination(..)+  , ValidationOption(..)+  , OutputDescription+  , Fibon.FlagConfig.FlagConfig(..)+  , Fibon.InputSize.InputSize(..)+)+where+import Fibon.FlagConfig+import Fibon.InputSize++data OutputDestination = +    OutputFile String+  | Stdout+  | Stderr+  deriving(Eq, Show, Ord)++data ValidationOption =+    Diff   {expectedOutput :: FilePath}+  | Exists+  deriving(Eq, Show, Ord)+  +type OutputDescription = (OutputDestination, ValidationOption)++data BenchmarkInstance = BenchmarkInstance {+      flagConfig     :: FlagConfig+    , stdinInput     :: Maybe FilePath+    , output         :: [OutputDescription]+    , exeName        :: String+  } deriving (Show)+

@@ -0,0 +1,107 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Fibon.ConfigMonad (+    FlagParameter(..)+  , FlagConfig(..)+  , Configuration+  , ConfigState(..)+  , ConfigMonad+  , done+  , append+  , replace+  , setTimeout+  , runWithInitialFlags+  , collectExtraStatsFrom+  , noExtraStats+  , useGhcDir+  , useGhcInPlaceDir+)+where++import Control.Monad.State+import qualified Data.Map as Map+import Fibon.FlagConfig+import Fibon.Timeout+import System.FilePath++data FlagParameter =+    ConfigureFlags+  | BuildFlags+  | RunFlags+  deriving (Show, Eq, Ord, Enum)++newtype GenConfigMonad a = CM {+    configState :: (State (ConfigState ConfigMap) a)+  }+  deriving (Monad)++data ConfigState a = ConfigState {+    flags          :: a+  , limit          :: Timeout+  , extraStatsFile :: Maybe FilePath+  }+type ConfigMap   = Map.Map FlagParameter [String]+type ConfigMonad = GenConfigMonad ()+type Configuration = ConfigState FlagConfig++done :: ConfigMonad+done = CM (return ())++replace :: FlagParameter -> String -> ConfigMonad+replace p f = do+  CM $ modify $ (\c -> c {flags = Map.insert p [f] (flags c)})++append :: FlagParameter -> String -> ConfigMonad+append p f = do+  CM $ modify $ (\c -> c {flags = Map.insertWith (flip (++)) p as (flags c)})+  where as = words f++setTimeout :: Timeout -> ConfigMonad+setTimeout t = do+  CM $ modify $ (\c -> c {limit = t})++collectExtraStatsFrom :: FilePath -> ConfigMonad+collectExtraStatsFrom f = do+  CM $ modify $ (\c -> c {extraStatsFile = Just f})++noExtraStats :: ConfigMonad+noExtraStats = do+  CM $ modify $ (\c -> c {extraStatsFile = Nothing})++useGhcDir :: FilePath -> ConfigMonad+useGhcDir dir = do+  append ConfigureFlags $ "--with-ghc="++(dir </> "ghc")+  append ConfigureFlags $ "--with-ghc-pkg="++(dir </> "ghc-pkg")++useGhcInPlaceDir :: FilePath -> ConfigMonad+useGhcInPlaceDir dir = do+  append ConfigureFlags $ "--with-ghc="++(dir </> "ghc-stage2")+  append ConfigureFlags $ "--with-ghc-pkg="++(dir </> "ghc-pkg")++runWithInitialFlags :: FlagConfig -> ConfigMonad -> Configuration+runWithInitialFlags fc cm = toConfig finalState+  where+  startState = ConfigState {+      flags          = fromFlagConfig fc+    , limit          = Infinity+    , extraStatsFile = Nothing+    }+  finalState = execState (configState cm) startState++toConfig :: (ConfigState ConfigMap) -> Configuration+toConfig state = state {+    flags =+      FlagConfig {+          configureFlags = Map.findWithDefault [] ConfigureFlags configMap+        , buildFlags     = Map.findWithDefault [] BuildFlags configMap+        , runFlags       = Map.findWithDefault [] RunFlags configMap+      }+  }+  where+    configMap = flags state++fromFlagConfig :: FlagConfig -> ConfigMap+fromFlagConfig fc =+    Map.insert ConfigureFlags (configureFlags fc) $+    Map.insert BuildFlags     (buildFlags     fc) $+    Map.insert RunFlags       (runFlags       fc) $+    Map.empty

@@ -0,0 +1,10 @@+module Fibon.FlagConfig (+  FlagConfig(..)+)+where++data FlagConfig = FlagConfig {+      configureFlags :: [String]+    , buildFlags     :: [String]+    , runFlags       :: [String]+  } deriving (Show, Eq, Ord)

@@ -0,0 +1,10 @@+module Fibon.InputSize(+  InputSize(..)+)+where++data InputSize =+    Test+  | Ref+  deriving(Eq, Read, Show, Ord, Enum)+

@@ -0,0 +1,41 @@+module Fibon.Result (+    FibonResult(..)+  , RunData(..)+  , BuildData(..)+  , RunSummary(..)+  , RunDetail(..)+  , ExtraStats+)+where++data FibonResult = FibonResult {+      benchName   :: String+    , buildData   :: BuildData+    , runData     :: RunData+  } deriving(Read, Show)++data BuildData = BuildData {+      buildTime :: Double  -- ^ Time to build the program+    , buildSize :: String  -- ^ Size of the program+  }+  deriving(Read, Show)++data RunData = RunData {+    summary :: RunSummary+  , details :: [RunDetail]+  } deriving(Read, Show)++data RunSummary = RunSummary {+      meanTime     :: Double+    , stdDevTime   :: Double+    , statsSummary :: ExtraStats+  }+  deriving (Read, Show)++data RunDetail = RunDetail {runTime :: Double, runStats :: ExtraStats}+  deriving (Read, Show)++--type ExtraStats = [(String, String)]+type ExtraStats = String++

@@ -0,0 +1,19 @@+module Fibon.Timeout(+    Timeout(..)+  , timeoutToMicroSeconds+)+where++data Timeout =+    Infinity+  | Limit {hours :: Int, mins :: Int, secs :: Int}++timeoutToMicroSeconds :: Timeout -> Maybe Int+timeoutToMicroSeconds Infinity      = Nothing+timeoutToMicroSeconds (Limit h m s) = Just $+  (hoursToMicroSeconds h) + (minsToMicroSeconds m) + (secsToMicroSeconds s)+  where+    hoursToMicroSeconds = (* (36 * 10 ^ (8::Int)))+    minsToMicroSeconds  = (* (6  * 10 ^ (7::Int)))+    secsToMicroSeconds  = (* (1  * 10 ^ (6::Int)))+  

@@ -0,0 +1,225 @@+module Fibon.Analyse.Analysis (+    Analysis(..)+  , runAnalysis+  , computeRows+  , Normalize(..)+  , NormMethod+)+where+import Data.List+import Data.Maybe+import qualified Data.Map        as M+import Control.Monad.Error+import Fibon.Result+import Fibon.Analyse.AnalysisRoutines+import Fibon.Analyse.Parse+import Fibon.Analyse.Result+import Fibon.Analyse.Metrics+import Fibon.Analyse.Tables+import Statistics.Sample+import qualified Data.Vector.Unboxed as V++runAnalysis :: Analysis a -> FilePath -> IO (Maybe [ResultColumn a])+runAnalysis analysis file = do+  fibonResults <- parseFibonResults file+  case fibonResults of+    Nothing -> return Nothing+    Just rs -> do x <- createResultColumns analysis rs+                  return (Just x)++createResultColumns :: Analysis a+                    -> M.Map ResultLabel [FibonResult] +                    -> IO [ResultColumn a]+createResultColumns analysis fibonResults =+  mapM (analyseResults analysis) (M.toList fibonResults)+  ++analyseResults :: Analysis a+               -> (ResultLabel, [FibonResult])+               -> IO (ResultColumn a)+analyseResults analysis (resultName, fibonResults) = do+  ars <- mapM (analyseResult analysis) fibonResults+  return $ ResultColumn resultName (resMap ars)+  where+    resMap ars       = foldr create M.empty (zip ars fibonResults)+    create (ar,fr) m = M.insert (benchNameOnly fr) ar m+    benchNameOnly fr = takeWhile (/= '-') (benchName fr)+  +analyseResult :: +                 Analysis a+              -> FibonResult +              -> IO (AnalyseResult a)        -- ^ final result+analyseResult analysis fibonR = do+  fibonS <- (fibonAnalysis analysis) fibonR+  extraS <- case mbExtras of +              Nothing -> return   Nothing+              Just [] -> return   Nothing+              Just es -> return . Just =<< (extraAnalysis analysis) es +  return (AnalyseResult fibonS extraS)+  where+    mbExtras = sequence $ map (extraP.runStats) (details.runData $ fibonR)+    extraP   = extraParser analysis+++-- | Functions for normalizing and computing summaries of results+--+--+type RowData = (RowName, [PerfData])+type RowName    = String+type TableError = String+type PerfMonad  = Either TableError+type NormMethod a = ResultColumn a -> Normalize a++data Normalize a =+    NormPercent (ResultColumn a)+  | NormRatio   (ResultColumn a)+  | NormNone    (ResultColumn a) -- ^ For uniform normalization use++computeRows :: [(Normalize a, ResultColumn a)]+            -> [BenchName]+            -> TableSpec a+            -> Either TableError ([RowData], [RowData])+computeRows resultColumns benchs colSpecs = do+  rows <- mapM (computeOneRow resultColumns colSpecs) benchs+  let colData = transpose $ map snd rows+      doSumm  how = mapM (summarize how) colData+  minRow   <- doSumm Min+  meanRow  <- doSumm GeoMean+  arithRow <- doSumm ArithMean+  maxRow   <- doSumm Max+  let sumRows = [+          ("min", minRow)+        , ("geomean", meanRow)+        , ("arithmean", arithRow)+        , ("max", maxRow)+        ]+  return (rows, sumRows)++computeOneRow :: [(Normalize a, ResultColumn a)]+              -> [ColSpec a]+              -> BenchName+              -> PerfMonad RowData+computeOneRow resultColumns colSpecs bench = do+  row <- mapM (\spec ->+      mapM (computeOneColumn bench spec) resultColumns+    ) colSpecs+  return (bench, concat row)++computeOneColumn :: BenchName+                 -> ColSpec a+                 -> (Normalize a, ResultColumn a)+                 -> PerfMonad PerfData+computeOneColumn bench (ColSpec _ metric) (normType, resultColumn) =+  maybe (return NoResult) doNormalize (getRawPerf resultColumn)+  where+    doNormalize peak =+      case normType of+        NormPercent base -> normToBase base normalizePercent+        NormRatio   base -> normToBase base normalizeRatio+        NormNone      _  -> return (mkRaw peak)+      where+        mkRaw  = Basic . Raw+        mkNorm = Basic . Norm+        normToBase base normFun = maybe (return NoResult)+                                        (\b -> mkNorm `liftM` normFun b peak)+                                        (getRawPerf base)+    getRawPerf rc = perf $ fmap metric ((M.lookup bench . results) rc)++type NormFun a =(a -> Double) -> a -> a -> NormPerf+normalizePercent :: RawPerf -> RawPerf -> PerfMonad NormPerf+normalizePercent = normalize normP++normalizeRatio :: RawPerf -> RawPerf -> PerfMonad NormPerf+normalizeRatio = normalize normR++normalize :: NormFun RawPerf+          -> RawPerf+          -> RawPerf+          -> PerfMonad NormPerf+normalize n base@(RawTime _) peak@(RawTime _) =+  return(n rawPerfToDouble base peak)+normalize n base@(RawSize _) peak@(RawSize _) =+  return(n rawPerfToDouble base peak)+normalize _ _ _ = throwError "Can not normalize a size by time"++normP :: NormFun a+normP = norm Percent (\base peak -> (peak / base) * 100)++normR :: NormFun a+normR = norm Ratio (\base peak -> (base / peak))++-- TODO: use the intervals to compute the resulting interval+norm :: (Estimate Double -> NormPerf)  -- ^ NormPerf constructor+     -> (Double -> Double -> Double)   -- ^ Normalizing function+     -> (a -> Double)                  -- ^ Conversion to double+     -> a -> a                         -- ^ Values to normalize+     -> NormPerf+norm c f toDouble base peak =+  c (mkPointEstimate mkStddev (f (toDouble base) (toDouble peak)))+  where mkStddev = fromIntegral :: Int -> Double++summarize :: Summary -> [PerfData] -> PerfMonad PerfData+summarize how perfData =+  case (normData, rawData) of+    ([], []) -> return NoResult+    (nd, []) -> summarizeNorm how nd+    ([], rd) -> summarizeRaw  how rd+    _        -> throwError "Mixed raw and norm results in column"+  where+    normData = getData (\p -> case p of Basic (Norm n) -> Just n ; _ -> Nothing)+    rawData  = getData (\p -> case p of Basic (Raw  r) -> Just r ; _ -> Nothing)+    getData  f = (catMaybes . map f) perfData++summarizeRaw :: Summary -> [RawPerf] -> PerfMonad PerfData+summarizeRaw how rawPerfs =+  case (isTime rawPerfs, isSize rawPerfs) of+    (True, _) -> summarizeRaw' how ExecTime          RawTime rawPerfs+    (_, True) -> summarizeRaw' how (MemSize . round) RawSize rawPerfs+    _         -> throwError "Can only summarize column with time or size"+  where+    isTime = all (\r -> case r of RawTime _ -> True; RawSize _ -> False)+    isSize = all (\r -> case r of RawSize _ -> True; RawTime _ -> False)++summarizeRaw' :: Summary                 -- ^ what kind of summary+             -> (Double -> a)            -- ^ rounding function+             -> (Estimate a -> RawPerf)  -- ^ RawPerf constructor+             -> [RawPerf]                -- ^ Performance numbers to summary+             -> PerfMonad PerfData+summarizeRaw' how roundFun makeRaw rawPerfs =+  return $ Summary how (Raw (makeRaw (fmap roundFun (computeSummary how vec))))+  where+    vec = V.fromList (map rawPerfToDouble rawPerfs)++summarizeNorm :: Summary -> [NormPerf] -> PerfMonad PerfData+summarizeNorm how normPerfs =+  case (isPercent normPerfs, isRatio normPerfs) of+    (True, _) -> summarizeNorm' how Percent normPerfs+    (_, True) -> summarizeNorm' how Ratio   normPerfs+    _         -> throwError "Can only summarize column with percent or ratio"+    where+      isPercent = all (\r -> case r of Percent _ -> True;  Ratio _ -> False)+      isRatio   = all (\r -> case r of Percent _ -> False; Ratio _ -> True)++summarizeNorm' :: Summary+              -> (Estimate Double -> NormPerf)+              -> [NormPerf]+              -> PerfMonad PerfData+summarizeNorm' how makeNorm normPerfs =+  return $ Summary how (Norm (makeNorm (computeSummary how vec)))+  where+    vec = V.fromList (map normPerfToDouble normPerfs)++computeSummary :: Summary -> Sample -> Estimate Double+computeSummary summaryType vec =+  Estimate {+      ePoint  = sumF summaryType vec+    , eStddev = stdDev vec -- TODO: this is wrong stddev for geoMean+    , eSize   = V.length vec+    , eCI     = Nothing+  }+  where+  sumF ArithMean = mean+  sumF GeoMean   = geometricMean+  sumF Max       = V.maximum+  sumF Min       = V.minimum+

@@ -0,0 +1,41 @@+module Fibon.Analyse.AnalysisRoutines(+    noAnalysis+  , ghcStatsAnalysis+  , Analysis(..)+)+where++import Fibon.Result+import Fibon.Analyse.Result+import Fibon.Analyse.Metrics+import Fibon.Analyse.ExtraStats++data Analysis a = Analysis {+      fibonAnalysis :: (FibonResult -> IO FibonStats)-- ^ RunData analyser+    , extraParser   :: (String  -> Maybe a)          -- ^ extraStats parser+    , extraAnalysis :: ([a]     -> IO    a)          -- ^ extraStats analyser+  }++noAnalysis :: Analysis a+noAnalysis  = Analysis {+      fibonAnalysis  = return . getStats+    , extraParser    = const Nothing+    , extraAnalysis  = return . head+  }+  where +    getStats fr = FibonStats {+          compileTime = Single $ ExecTime ((buildTime . buildData) fr)+        , binarySize  = Single $ MemSize 0 +        , wallTime    = Single $ ExecTime ((meanTime . summary . runData) fr)+      }++ghcStatsAnalysis :: Analysis GhcStats+ghcStatsAnalysis = noAnalysis {+      extraParser = parseGhcStats+  }++--makeAnalysis :: Analysis a -> (String -> Maybe b) -> Analysis b++++

@@ -0,0 +1,80 @@+module Fibon.Analyse.CommandLine (+    Opt(..)+  , NormalizeBy(..)+  , parseCommandLine+)+where+import Fibon.Analyse.Output(OutputFormat(..))+import System.Console.GetOpt++data Opt = Opt {+    optHelpMsg      :: Maybe String+  , optOutputFormat :: OutputFormat+  , optNormalizeBy  :: NormalizeBy+  }++type UsageError  = String+type MbOpt       = Either UsageError Opt+data NormalizeBy = ByPercent | ByRatio | ByNone++defaultOpts :: Opt+defaultOpts = Opt {+    optHelpMsg      = Nothing+  , optOutputFormat = AsciiArt+  , optNormalizeBy  = ByPercent+  }++parseCommandLine :: [String] -> Either UsageError (Opt, [FilePath])+parseCommandLine args =+  case getOpt Permute options args of+    (opts, files, []) -> either Left (\o -> Right (o, files)) (parseOpts opts)+    (_, _, errs)   -> Left (concat errs ++ usage)++parseOpts :: [OptionParser] -> MbOpt+parseOpts = foldl (flip id) (Right defaultOpts)++type OptionParser = MbOpt -> MbOpt+options :: [OptDescr OptionParser]+options = [+    Option ['h'] ["help"]+      (NoArg $ flip process (\o -> Right $ o {optHelpMsg = Just usage}))+      "print a help message"+    ,+    Option ['t'] ["table"]+      (ReqArg (\a mbOpt -> process mbOpt (\o ->+        case a of+          "ascii" -> setFormat AsciiArt o+          "latex" -> setFormat Latex o+          "csv"   -> setFormat Csv o+          _       -> Left $ "Invalid table format: "++a)) "OutputFormat")+      "table format [ascii, latex, raw]"+    ,+    Option ['r'] ["raw"]+      (ReqArg (\a mbOpt -> process mbOpt (\o ->+        let noNorm = o {optNormalizeBy = ByNone} in+        case a of+          "\\t"     -> setFormat (SimpleText "\t") noNorm+          _         -> setFormat (SimpleText a)    noNorm))+        "sep")+      "raw data with seperator"+    ,+    Option ['n'] ["normalize"]+      (ReqArg (\a mbOpt -> process mbOpt (\o ->+        case a of+          "percent" -> setNorm ByPercent o+          "ratio"   -> setNorm ByRatio   o+          "none"    -> setNorm ByNone    o+          _         -> Left $ "Invalid normalization: "++a)) "NormBy")+      "normalize results by [percent, speedup, none]"+  ]+  where+    setFormat fmt o = Right $ o {optOutputFormat = fmt}+    setNorm  norm o = Right $ o {optNormalizeBy  = norm}++process :: MbOpt -> (Opt -> MbOpt) -> MbOpt+process = flip (either Left)++usage :: String+usage = usageInfo header options+  where header = "Usage: fibon-analyse [OPTION...] [RESULTFILE...]"+

@@ -0,0 +1,10 @@+module Fibon.Analyse.ExtraStats(+    GhcStats.GhcStats(..)+  , parseGhcStats+)+where+import Fibon.Analyse.ExtraStats.GhcStats as GhcStats++parseGhcStats :: String -> Maybe GhcStats+parseGhcStats = GhcStats.parseMachineReadableStats+

@@ -0,0 +1,34 @@+module Fibon.Analyse.ExtraStats.GhcStats(+    GhcStats(..)+  , parseMachineReadableStats+)+where++import Fibon.Analyse.Metrics++data GhcStats = GhcStats {+      bytesAllocated          :: Measurement MemSize+    , numGCs                  :: Measurement MemSize+    , averageBytesUsed        :: Measurement MemSize+    , maxBytesUsed            :: Measurement MemSize+    , numByteUsageSamples     :: Measurement MemSize+    , peakMegabytesAllocated  :: Measurement MemSize+    , initCPUSeconds          :: Measurement ExecTime+    , initWallSeconds         :: Measurement ExecTime+    , mutatorCPUSeconds       :: Measurement ExecTime+    , mutatorWallSeconds      :: Measurement ExecTime+    , gcCPUSeconds            :: Measurement ExecTime+    , gcWallSeconds           :: Measurement ExecTime++    -- derived metrics+    , ghcCpuTime                 :: Measurement ExecTime+    , ghcWallTime                :: Measurement ExecTime+  }+  deriving (Read, Show)++++parseMachineReadableStats :: String -> Maybe GhcStats+parseMachineReadableStats _ = Nothing++

@@ -0,0 +1,37 @@+module Main (main) where+import Fibon.Analyse.AnalysisRoutines+import Fibon.Analyse.Analysis+import Fibon.Analyse.CommandLine+import Fibon.Analyse.Output+import Fibon.Analyse.Result+import Fibon.Analyse.Tables+import System.Environment+import System.Exit++main :: IO ()+main = do+  (opts, files) <- getCommandLine+  mbResults <- mapM (\f -> runAnalysis noAnalysis f) files+  case concat `fmap` sequence mbResults of+    Nothing -> putStrLn "Error Parsing Results"+    Just rs -> do+      let fmt  = optOutputFormat opts+      let norm = getNormFun opts+      putStrLn $ renderSummaryTable rs norm fmt basicTable+      putStrLn $ renderTables       rs norm fmt basicTable+++getCommandLine :: IO (Opt, [FilePath])+getCommandLine = do+  args    <- getArgs+  case parseCommandLine args of+    Left err -> putStrLn err >> exitFailure+    Right (Opt {optHelpMsg = Just msg}, _) -> putStrLn msg >> exitSuccess+    Right opts      -> return opts++getNormFun :: Opt -> (ResultColumn a -> Normalize a)+getNormFun o =+  case optNormalizeBy o of+    ByPercent -> NormPercent+    ByRatio   -> NormRatio+    ByNone    -> NormNone

@@ -0,0 +1,165 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving#-}+module Fibon.Analyse.Metrics (+    MemSize(..)+  , ExecTime(..)+  , Estimate(..)+  , ConfidenceInterval(..)+  , Measurement(..)+  , Metric(..)+  , PerfData(..)+  , pprPerfData+  , RawPerf(..)+  , NormPerf(..)+  , BasicPerf(..)+  , Summary(..)+  , mkPointEstimate+  , rawPerfToDouble+  , normPerfToDouble+)+where++import Data.Word+import Text.Printf++newtype MemSize    = MemSize  {fromMemSize  :: Word64}+  deriving(Eq, Num, Read, Show)+newtype ExecTime   = ExecTime {fromExecTime :: Double}+  deriving(Eq, Num, Read, Show)++data Estimate a = Estimate {+      ePoint  :: !a+    , eStddev :: !a+    , eSize   :: !Int+    , eCI     :: Maybe (ConfidenceInterval a)+  }+  deriving (Read, Show)++data ConfidenceInterval a = ConfidenceInterval {+      eLowerBound       :: !a+    , eUpperBound       :: !a+    , eConfidenceLevel  :: !Double+}+  deriving (Read, Show)++instance Functor Estimate where+  fmap f e = e {+      ePoint  = f (ePoint e)+    , eStddev = f (eStddev e)+    , eCI     = maybe Nothing (Just . fmap f) (eCI e)+  }++instance Functor ConfidenceInterval where+  fmap f c = c {+      eLowerBound = f (eLowerBound c)+    , eUpperBound = f (eUpperBound c)+  }++data Measurement a = +    Single   a+  | Interval (Estimate a)+  deriving (Read, Show)++mkPointEstimate :: (Num b) => (b -> a) -> a -> Estimate a+mkPointEstimate mkA a = Estimate {+      ePoint  = a+    , eStddev = mkA 0+    , eSize   = 1+    , eCI     = Nothing+  }++class Metric a where+  perf :: a -> Maybe RawPerf++instance Metric (Measurement ExecTime) where+  perf (Single m)   = Just (RawTime (mkPointEstimate ExecTime m))+  perf (Interval e) = Just (RawTime  e)++instance Metric (Measurement MemSize) where+  perf (Single m)   = Just (RawSize (mkPointEstimate MemSize m))+  perf (Interval e) = Just (RawSize e)++instance Metric a => Metric (Maybe a) where+  --perf = fmap perf+  perf Nothing  = Nothing+  perf (Just x) = perf x++data PerfData =+    NoResult+  | Basic BasicPerf+  | Summary Summary BasicPerf+  deriving(Read, Show)++data BasicPerf =+    Raw RawPerf+  | Norm NormPerf+  deriving(Read, Show)++data RawPerf =+    RawTime (Estimate ExecTime)+  | RawSize (Estimate MemSize)+  deriving(Read, Show)++data NormPerf =+    Percent (Estimate Double) -- ^ (ref  / base) * 100+  | Ratio   (Estimate Double) -- ^ (base / ref)+  deriving(Read, Show)++data Summary =+    Min+  | GeoMean+  | ArithMean+  | Max+  deriving(Read, Show)++pprPerfData :: Bool -> PerfData -> String+pprPerfData _ NoResult    = "--"+pprPerfData u (Basic b) = pprBasicPerf u b+pprPerfData u (Summary _ s) = pprBasicPerf u s++pprBasicPerf :: Bool -> BasicPerf -> String+pprBasicPerf u (Raw  r)    = pprRawPerf  u r+pprBasicPerf u (Norm n)    = pprNormPerf u n++pprNormPerf :: Bool -> NormPerf -> String+pprNormPerf u (Percent d) =+  printf "%0.2f%s" ((ePoint d)  - 100) (pprUnit u "%")+pprNormPerf _ (Ratio d) =+  printf "%0.2f"    (ePoint d)++pprRawPerf :: Bool -> RawPerf -> String+pprRawPerf u (RawTime t)    =+  printf "%0.2f%s"  ((fromExecTime . ePoint) t) (pprUnit u "s")+pprRawPerf u (RawSize s)    =+  printf "%0d%s"+    (round (fromIntegral ((fromMemSize . ePoint) s) / 1000 :: Double)::Word64)+    (pprUnit u "k")+{-+pprRawPerf u (RawTimeInterval e) = printf "%0.2f%s"+                              ((fromExecTime . ePoint) e)+                              (pprPlusMinus e fromExecTime)+                              (pprUnit u "s")+pprRawPerf u (RawSizeInterval e) = printf "%d%s%s"+                              ((fromMemSize . ePoint) e)+                              (pprPlusMinus e fromMemSize)+                              (pprUnit u "k")++pprPlusMinus :: Real b => Estimate a -> (a -> b) -> String+pprPlusMinus e f = printf "%c%0.2d" (chr 0xB1) ((realToFrac spread)::Double)+  where spread = abs ((f . ePoint) e) - ((f . eLowerBound) e)+pprSummaryPerf :: Bool -> SummaryPerf -> String+pprSummaryPerf u (GeoMean n)   = pprBasicPerf u n+pprSummaryPerf u (ArithMean r) = pprBasicPerf u r+-}++pprUnit :: Bool -> String -> String+pprUnit True s = s+pprUnit _    _ = ""++rawPerfToDouble :: RawPerf -> Double+rawPerfToDouble (RawTime t) = (fromExecTime . ePoint) t+rawPerfToDouble (RawSize s) = (fromIntegral . fromMemSize . ePoint) s++normPerfToDouble :: NormPerf -> Double+normPerfToDouble (Percent p) = ePoint p+normPerfToDouble (Ratio   r) = ePoint r+

@@ -0,0 +1,113 @@+module Fibon.Analyse.Output (+    OutputFormat(..)+  , renderTables+  , renderSummaryTable+)+where++import qualified Data.Map as M+import Fibon.Analyse.Analysis+import Fibon.Analyse.Metrics+import Fibon.Analyse.Result+import Fibon.Analyse.Tables+import Text.Tabular+import Text.Printf+import qualified Text.Tabular.AsciiArt as Ascii+import qualified Text.Tabular.Csv      as Csv+import qualified Text.Tabular.Latex    as Latex+import qualified Text.Tabular.SimpleText as Simple++data OutputFormat = +    AsciiArt +  | SimpleText {separator :: String}+  | Latex+  | Csv++-- | Render a series of tables based on the 'TableSpec'+--   A table is rendered for each column in the 'TableSpec'. The data for the+--   columns are taken from the list of 'ResultColumn' passed to the function.+renderTables :: [ResultColumn a] -> NormMethod a -> OutputFormat -> [ColSpec a] -> String+renderTables [] _ _fmt _spec = ""+renderTables rs@(baseline:compares) normMethod fmt tableSpec =+  unlines $ map render tableSpec+  where+    render colSpec =+      renderTable (cName colSpec) colNames columns fmt [colSpec]+    columns     = baselineCol : compareCols+    baselineCol = (NormNone baseline, baseline)+    compareCols = [(normMethod baseline, c) | c <- compares]+    colNames = map resultLabel rs+++-- | Render a summary table comparing the "base" to a "peak" result.+--   The table is rendered with a column of "peak" data for each column listed+--   in the 'TableSpec'.+renderSummaryTable::[ResultColumn a] -> NormMethod a -> OutputFormat -> TableSpec a -> String+renderSummaryTable [base, peak] normMethod fmt tableSpec =+  renderTable "Fibon Summary" colNames columns fmt tableSpec+  where+    columns = [(normMethod base, peak)]+    colNames = map cName tableSpec+renderSummaryTable _ _ _ _ = ""++-- | Renders a table. The number of columns is+--   length (tableData) * length (TableSpec).+renderTable :: String                          -- ^ Table name+            -> [String]                        -- ^ Column names+            -> [(Normalize a, ResultColumn a)] -- ^ Table data+            -> OutputFormat                    -- ^ Output format+            -> TableSpec a                     -- ^ Table description+            -> String+renderTable _  _ [] _ _ = ""+renderTable tableName columnNames rs@(aResult:_) fmt tableSpec =+  render table+  where+    render t =+      tableName ++ errMsg ++ "\n" +++      renderAs fmt (printf fmtString) id (renderPerfData fmt) tab+      where tab = (Table rowHeader colHeader t)+    (errMsg, dataRowLabels, summaryRowLabels, table) =+      case computeRows rs benchNames tableSpec of+        Left err   -> (err, [],[],[[]])+        Right rows -> unzipRows rows+    unzipRows (dataRows, summRows) =+      let (dl,dr) = unzip dataRows+          (sl,sr) = unzip summRows+      in+      (noErrorMsg, dl,sl, dr ++ sr)+    rowLabels = dataRowLabels ++ summaryRowLabels+    rowHeader = Group SingleLine [+                  (Group NoLine dataRowNames),(Group NoLine summaryRowNames)+                ]+    colHeader = Group NoLine colNames+    dataRowNames = map Header dataRowLabels+    summaryRowNames = map Header summaryRowLabels+    colNames = map Header columnNames+    benchNames = M.keys (results . snd $ aResult)+    fmtString = "%"++(show . maximum $ map length rowLabels)++"s"+    noErrorMsg = ""+++renderPerfData :: OutputFormat -> (PerfData -> String)+renderPerfData = pprPerfData . includeUnits++type RenderFun rh ch td =  (rh -> String) -- ^ Row header renderer+                        -> (ch -> String) -- ^ Col header renderer+                        -> (td -> String) -- ^ Data renderer+                        -> Table rh ch td -- ^ Table data+                        -> String         -- ^ Rendered table+renderAs :: OutputFormat -> RenderFun rh ch td+renderAs AsciiArt         = Ascii.render+renderAs Latex            = Latex.render+renderAs Csv              = Csv.render+renderAs (SimpleText sep) = Simple.render sep+++-- | Don't print units for outputs which are intended to be inputs to+--   other analysis programs (like R or Excel)+includeUnits :: OutputFormat -> Bool+includeUnits (SimpleText _) = False+includeUnits Csv            = False+includeUnits Latex          = False+includeUnits _              = True+

@@ -0,0 +1,43 @@+module Fibon.Analyse.Parse(+    GhcStats(..)+  , parseFibonResults+)+where++import qualified Data.Map        as M+import qualified Data.Text       as T+import qualified Data.Text.IO    as T+import Fibon.Result+import Fibon.Analyse.ExtraStats+import Fibon.Analyse.Result+import System.FilePath+++parseFibonResults :: FilePath  -- ^ input file+                  -> IO (Maybe (M.Map ResultLabel [FibonResult])) -- ^ Result+parseFibonResults file = do+  input <- T.readFile file+  case runParser input of+    Nothing -> return Nothing+    Just [] -> return Nothing+    Just rs -> return (Just $ M.mapKeys addFileSource (groupResults rs))+  where+    baseName        = takeBaseName file+    addFileSource s = baseName ++ s++    runParser :: T.Text -> Maybe [FibonResult]+    runParser text = sequence (map parseLine (T.lines text))++    parseLine :: T.Text -> Maybe FibonResult+    parseLine line = +      case reads (T.unpack line) of+        [(r, _)] -> Just r+        _        -> Nothing++groupResults :: [FibonResult] -> M.Map ResultLabel [FibonResult]+groupResults = foldr grouper M.empty+  where+  grouper   r = M.insertWith (++)  (benchType r) [r]+  benchType r = dropWhile (/= '-') (benchName r)++

@@ -0,0 +1,34 @@+module Fibon.Analyse.Result(+    FibonStats(..)+  , AnalyseResult(..)+  , BenchName+  , ResultLabel+  , ResultColumn(..)+)+where++import qualified Data.Map        as M+import Fibon.Analyse.Metrics++type BenchName     = String+type ResultLabel   = String++data ResultColumn a = ResultColumn {+      resultLabel :: ResultLabel+    , results     :: M.Map BenchName (AnalyseResult a)+  }+  deriving (Read, Show)++data AnalyseResult a = AnalyseResult {+      fibonStats  :: FibonStats+    , extraStats  :: Maybe a+  }+  deriving (Read, Show)++data FibonStats = FibonStats {+      compileTime :: Measurement ExecTime+    , binarySize  :: Measurement MemSize+    , wallTime    :: Measurement ExecTime+  }+  deriving (Read, Show)+  

@@ -0,0 +1,44 @@+{-# LANGUAGE ExistentialQuantification #-}+module Fibon.Analyse.Tables (+    basicTable+  , ghcStatsSummaryTable+  , ColSpec(..)+  , TableSpec+)+where++import Fibon.Analyse.ExtraStats+import Fibon.Analyse.Metrics+import Fibon.Analyse.Result++basicTable :: TableSpec a+basicTable = [+      ColSpec "RunTime"     (onFibonStats wallTime)+    , ColSpec "Size"        (onFibonStats binarySize)+    , ColSpec "CompileTime" (onFibonStats compileTime)+  ]++ghcStatsSummaryTable :: TableSpec GhcStats+ghcStatsSummaryTable = [+      ColSpec "Size"       (onFibonStats binarySize)+    , ColSpec "Allocs"     (onExtraStats bytesAllocated)+    , ColSpec "Runtime"    (onExtraStats ghcCpuTime)+    , ColSpec "Elapsed"    (onExtraStats ghcWallTime)+    , ColSpec "TotalMem"   (onExtraStats maxBytesUsed)+  ]++-- Idea borrowed graciously from nofib-analyse+data ColSpec a =+  forall b . Metric b =>+      ColSpec {+        cName   :: String             -- ^ Short name (for column heading)+      , cMetric ::  (AnalyseResult a -> Maybe b) -- ^ How to get the result+      }++type TableSpec a = [ColSpec a]++onExtraStats :: (a -> b) -> AnalyseResult a -> Maybe b+onExtraStats f = fmap f . extraStats++onFibonStats :: (FibonStats -> b) -> AnalyseResult a -> Maybe b+onFibonStats f = Just . f . fibonStats

@@ -0,0 +1,131 @@+-- Utility for adding the Fibon directory for a new benchmark+module Main (main) where++import Control.Monad+import Data.Char as Char+import Data.List++import Distribution.Package+import Distribution.PackageDescription+import Distribution.PackageDescription.Configuration+import Distribution.PackageDescription.Parse+import Distribution.Verbosity++import System.Directory+import System.Exit+import System.FilePath+import System.IO++main :: IO ()+main = do+  cf  <- findCabalFile+  pkg <- parsePackage cf+  createDirectoryStructure+  writeInstanceFile pkg++findCabalFile :: IO String+findCabalFile = do+  cwd   <- getCurrentDirectory+  files <- getDirectoryContents cwd+  let cabalfiles = filter (".cabal" `isSuffixOf`) files+  case cabalfiles of+    [f] -> return f+    []  -> do+      putStrLn "Error: no cabal files found in current directory"+      exitFailure+    _   -> do+      putStrLn "Error: multiple cabal files found in current directory"+      exitFailure++parsePackage :: FilePath -> IO PackageDescription+parsePackage cabalFile = do+  gps <- (readPackageDescription silent) cabalFile+  return $ flattenPackageDescription gps++getName :: PackageDescription -> String+getName pkg = upCase $ toS $ (packageName . package) pkg+  where +  toS (PackageName p) = p++upCase :: String -> String+upCase []     = []+upCase (x:xs) = Char.toUpper x : xs++createDirectoryStructure :: IO ()+createDirectoryStructure = do+  safeCreateDir   "Fibon"+  safeCreateDir $ "Fibon" </> "data"+  safeCreateDir $ "Fibon" </> "data" </> "test"+  safeCreateDir $ "Fibon" </> "data" </> "test" </> "input"+  safeCreateDir $ "Fibon" </> "data" </> "test" </> "output"+  safeCreateDir $ "Fibon" </> "data" </> "ref"+  safeCreateDir $ "Fibon" </> "data" </> "ref"  </> "input"+  safeCreateDir $ "Fibon" </> "data" </> "ref"  </> "output"++safeCreateDir :: FilePath -> IO ()+safeCreateDir path = do+  exists <- doesDirectoryExist path+  unless exists (createDirectory path)++writeInstanceFile :: PackageDescription -> IO ()+writeInstanceFile pkg = do+  exists <- doesFileExist outFile+  when exists (putStrLn "Error: Instance.hs already exists" >> exitFailure)+  cwd   <- getCurrentDirectory+  let bName = getName pkg+      gName = getGrpName cwd+      eName = getExeName pkg+  h <- openFile outFile WriteMode+  hPutStrLn h (template gName bName eName)+  hClose h+  putStrLn $ "Wrote instance file to "++outFile+  where+  outFile = "Fibon" </> "Instance.hs"+++getGrpName :: FilePath -> String+getGrpName path =+  case dirs of+  (_:_:_) ->  upCase $ (head . drop 1 . reverse) dirs+  _       ->  "Unknown"+  where dirs = splitDirectories path++getExeName :: PackageDescription -> String+getExeName pkg = +  case executables pkg of+    (e:_) -> exeName e+    _      -> "Unknown"+++template :: String -> String -> String -> String+template grpName bmName exName = unlines [+  "{-# OPTIONS_GHC -fno-warn-missing-signatures #-}",+  "module "++modName++"(",+  "  mkInstance",+  ")",+  "where",+  "import Fibon.BenchmarkInstance",+  "",+  "sharedConfig = BenchmarkInstance {",+  "    flagConfig = FlagConfig {",+  "        configureFlags = []",+  "      , buildFlags     = []",+  "      , runFlags       = []",+  "      }",+  "    , stdinInput     = Nothing",+  "    , output         = [(Stdout, Diff "++(show expectedOut)++")]",+  "    , exeName        = "++(show exName),+  "  }",+  "flgCfg = flagConfig sharedConfig",+  "",+  "mkInstance Test = sharedConfig {",+  "        flagConfig = flgCfg",+  "    }",+  "mkInstance Ref  = sharedConfig {",+  "        flagConfig = flgCfg",+  "    }"+  ]+  where+  modName = "Fibon.Benchmarks."++grpName++"."++bmName++".Fibon.Instance"+  expectedOut = exName ++ ".stdout.expected"+

@@ -0,0 +1,243 @@+module Fibon.Run.Actions (+      runBundle+    , buildBundle+    , sanityCheckBundle+    , FibonError+    , Action(..)+    , ActionRunner+)+where++import Data.List+import Data.Maybe+import Data.Time.Clock.POSIX+import Fibon.BenchmarkInstance+import Fibon.Result+import Fibon.Run.BenchmarkBundle+import Fibon.Run.BenchmarkRunner as Runner+import qualified Fibon.Run.Log as Log+import qualified Fibon.Run.SysTools as SysTools+import Control.Monad.Error+import Control.Monad.Reader+import System.Directory+import System.Exit+import System.FilePath+import System.Process++type FibonRunMonad = ErrorT FibonError (ReaderT BenchmarkBundle IO)++data Action =+    Sanity+  | Build+  | Run+  deriving (Read, Show, Eq, Ord, Enum)++type ActionRunner a = (BenchmarkBundle -> IO (Either FibonError a))++data ActionResult =+    SanityComplete+  | BuildComplete BuildData+  | RunComplete   RunData+  deriving(Show)++data FibonError =+    BuildError   String+  | SanityError  String+  | RunError     String+  | OtherError   String -- ^ For general IO exceptions+  deriving (Show)+instance Error FibonError where+  strMsg = OtherError++sanityCheckBundle :: BenchmarkBundle -> IO (Either FibonError ())+sanityCheckBundle bb = runFibonMonad bb $ do+  SanityComplete <- runAction Sanity+  return ()++buildBundle :: BenchmarkBundle -> IO (Either FibonError BuildData)+buildBundle bb = runFibonMonad bb $ do+  SanityComplete   <- runAction Sanity+  BuildComplete br <- runAction Build+  return br++runBundle :: BenchmarkBundle -> IO (Either FibonError FibonResult)+runBundle bb = runFibonMonad bb $ do+  SanityComplete   <- runAction Sanity+  BuildComplete br <- runAction Build+  RunComplete   rr <- runAction Run+  return $ FibonResult (bundleName bb) br rr++runFibonMonad :: BenchmarkBundle+              -> ErrorT FibonError (ReaderT BenchmarkBundle IO) a+              -> IO (Either FibonError a)+runFibonMonad bb a = runReaderT (runErrorT a) bb++runAction :: Action -> FibonRunMonad ActionResult+runAction Sanity = do+  io $ Log.notice "  Checking..."+  sanityCheck+  return SanityComplete+runAction Build = do+  io $ Log.notice "  Building..."+  prepConfigure+  runConfigure+  r <- runBuild+  return $ BuildComplete r+runAction Run = do+  io $ Log.notice "  Running..."+  prepRun+  r <- runRun+  return $ RunComplete r++sanityCheck :: FibonRunMonad ()+sanityCheck = do+  bb <- ask+  let bmPath = pathToBench bb+  io $ Log.info ("Checking for directory:\n"++bmPath)+  bdExists <- io $ doesDirectoryExist bmPath+  unless bdExists (throwError $ pathDoesNotExist bmPath)+  io $ Log.info ("Checking for cabal file in:\n"++bmPath)+  dirContents <- io $ getDirectoryContents bmPath+  let cabalFile = find (".cabal" `isSuffixOf`) dirContents+  case cabalFile of+    Just f  -> do io $ Log.info ("Found cabal file: "++f)+                  checkForExpectedOutFiles+    Nothing -> throwError cabalFileDoesNotExist+  where+  pathDoesNotExist bmP  = SanityError("Directory:\n"++bmP++" does not exist")+  cabalFileDoesNotExist = SanityError "Can not find cabal file"++checkForExpectedOutFiles :: FibonRunMonad ()+checkForExpectedOutFiles = do+  bb <- ask+  io $ Log.info "Checking for diff files"+  let expectedOut = (output . benchDetails) bb+      fs = diffFiles expectedOut+  missingFiles <- io $ filterM (missing bb) fs+  case missingFiles of+    [] -> return ()+    ms -> throwError $ SanityError("Missing expected output files: "++show ms)+  where+  missing bb f = do+    Log.info $ "Checking for expected output file: " ++ f+    e1 <- doesFileExist $ (pathToAllOutputFiles bb)  </> f+    e2 <- doesFileExist $ (pathToSizeOutputFiles bb) </> f+    return (not e1 && not e2)+  diffFiles =+    catMaybes . map (\o -> case o of (_, Diff f) -> Just f ; _ -> Nothing)++prepConfigure :: FibonRunMonad ()+prepConfigure = do+  bb <- ask+  let ud = (workDir bb) </> (unique bb)+  udExists <- io $ doesDirectoryExist ud+  unless udExists (io $ createDirectory ud)++runConfigure :: FibonRunMonad ()+runConfigure = do+  _ <- runCabalCommand "configure" configureFlags+  return ()++runBuild :: FibonRunMonad BuildData+runBuild = do+  time <- runCabalCommand "build" buildFlags+  size <- runSizeCommand+  return $ BuildData {buildTime = time, buildSize = size}++prepRun :: FibonRunMonad ()+prepRun = do+  mapM_ copyFiles [+      pathToSizeInputFiles+    , pathToAllInputFiles+    , pathToSizeOutputFiles+    , pathToAllOutputFiles+    ]++runRun :: FibonRunMonad RunData+runRun =  do+  bb <- ask+  res <- io $ Runner.run bb+  io $ Log.info (show res)+  case res of+    Success s d -> return     $ RunData  {summary = s, details = d}+    Failure msg -> throwError $ RunError (summarize msg)+  where+  summarize = concat . intersperse "\n" . map  simplify+  simplify (MissingOutput f) = "Missing output file: "++f+  simplify (DiffError     _ )= "Output differs from expected."+  simplify (Timeout         )= "Timeout"++copyFiles :: (BenchmarkBundle -> FilePath)+          -> FibonRunMonad ()+copyFiles pathSelector = do+  bb <- ask+  let srcPath = pathSelector bb+      dstPath = pathToExeBuildDir bb+      cp f    = do+        io $ copyFile (srcPath </> baseName) (dstPath </> baseName)+        where baseName = snd (splitFileName f)+  dExists <- io $ doesDirectoryExist srcPath+  if not dExists+    then do return ()+    else do+      io $ Log.info ("Copying files\n  from: "++srcPath++"\n  to: "++dstPath)+      files <- io $ getDirectoryContents srcPath+      let realFiles = filter (\f -> f /= "." && f /= "..") files+      io $ Log.info ("Copying files: "++(show realFiles))+      mapM_ cp realFiles+      return ()++runCabalCommand :: String+                -> (FlagConfig -> [String])+                -> FibonRunMonad Double+runCabalCommand cmd flagsSelector = do+  bb <- ask+  let fullArgs = ourArgs ++ userArgs+      userArgs = (flagsSelector . fullFlags) bb+      ourArgs  = [cmd, "--builddir="++(pathToCabalWorkDir bb)]+  (_, time) <- timeInDir (pathToBench bb) $ exec SysTools.cabal fullArgs+  return time++runSizeCommand :: FibonRunMonad String+runSizeCommand = do+  bb <- ask+  exec (SysTools.size) [(pathToExe bb)]+++timeInDir :: FilePath -> FibonRunMonad a -> FibonRunMonad (a, Double)+timeInDir fp action = do+  dir <- io $ getCurrentDirectory+  io $ setCurrentDirectory fp+  start <- io $ getTime+  r <- action+  end <- io $ getTime+  io $ setCurrentDirectory dir+  let !delta = end - start+  return (r, delta)++io :: IO a -> FibonRunMonad a+io = liftIO++exec :: FilePath -> [String] -> FibonRunMonad String+exec cmd args = do+  (exit, out, err) <- io $ readProcessWithExitCode cmd args []+  io $ Log.info ("COMMAND: "++fullCommand)+  io $ Log.info ("STDOUT: \n"++out)+  io $ Log.info ("STDERR: \n"++err)+  case exit of+    ExitSuccess   -> return out+    ExitFailure _ -> throwError $ BuildError msg+  where+  msg         = "Failed running command: " ++ fullCommand +  fullCommand = cmd ++ stringify args+++joinWith :: a -> [[a]] -> [a]+joinWith a = concatMap (a:)++stringify :: [String] -> String+stringify = joinWith ' '++getTime :: IO Double+getTime = (fromRational . toRational) `fmap` getPOSIXTime+

@@ -0,0 +1,168 @@+module Fibon.Run.BenchmarkBundle (+    BenchmarkBundle(..)+  , mkBundle+  , bundleName+  , pathToBench+  , pathToCabalWorkDir+  , pathToExeBuildDir+  , pathToExe+  , pathToSizeInputFiles+  , pathToSizeOutputFiles+  , pathToAllInputFiles+  , pathToAllOutputFiles+  , pathToSizeDataFiles+  , pathToStdoutFile+  , pathToStderrFile+  , pathToExeRunDir+  , pathToStdinFile+  , prettyRunCommand+  , bundleProcessSpec+)+where++import Data.Char+import Data.List+import Fibon.Benchmarks+import Fibon.BenchmarkInstance+import Fibon.Timeout+import Fibon.Run.Config+import System.FilePath+import System.IO+import System.Process+import System.Info+++data BenchmarkBundle = BenchmarkBundle {+      benchmark     :: FibonBenchmark+    , workDir       :: FilePath+    , benchDir      :: FilePath+    , unique        :: String+    , iters         :: Int+    , tuneSetting   :: TuneSetting+    , inputSize     :: InputSize+    , fullFlags     :: FlagConfig+    , benchDetails  :: BenchmarkInstance+    , timeout       :: Maybe Int+    , extraStats    :: Maybe FilePath+  } deriving (Show)++mkBundle :: RunConfig+         -> FibonBenchmark+         -> FilePath -- ^ working directory+         -> FilePath -- ^ benchmarks directory+         -> String   -- ^ unique id+         -> InputSize+         -> TuneSetting+         -> BenchmarkBundle+mkBundle rc bm wd bmsDir uniq size tune =+  BenchmarkBundle {+      benchmark     = bm+    , workDir       = wd+    , benchDir      = bmsDir+    , unique        = uniq+    , iters         = (iterations rc)+    , tuneSetting   = tune+    , inputSize     = size+    , fullFlags     = flags configuration+    , benchDetails  = benchInstance bm size+    , timeout       = timeoutToMicroSeconds (limit configuration)+    , extraStats    = (extraStatsFile configuration)+  }+  where+    configuration = mkConfig rc bm size tune++bundleName :: BenchmarkBundle -> String+bundleName bb = concat $ intersperse "-"+  [(show $ benchmark bb), (show $ inputSize bb), (show $ tuneSetting bb)]++pathToBench :: BenchmarkBundle -> FilePath+pathToBench bb = (benchDir bb) </> ((benchPath . benchmark) bb)++pathToCabalWorkDir :: BenchmarkBundle -> FilePath+pathToCabalWorkDir bb = (workDir bb) </> (unique bb) </> (bundleName bb)++pathToExeBuildDir :: BenchmarkBundle -> FilePath+pathToExeBuildDir bb = +  (pathToCabalWorkDir bb) </> "build" </> (exeName.benchDetails $ bb)++pathToExeRunDir :: BenchmarkBundle -> FilePath+pathToExeRunDir = pathToExeBuildDir++pathToExe :: BenchmarkBundle -> FilePath+pathToExe bb = (pathToExeBuildDir bb) </> (exeName.benchDetails $ bb)++ext+  where ext = if System.Info.os == "mingw32" then ".exe" else ""++pathToSizeInputFiles :: BenchmarkBundle -> FilePath+pathToSizeInputFiles = pathToSizeDataFiles "input"++pathToSizeOutputFiles :: BenchmarkBundle -> FilePath+pathToSizeOutputFiles = pathToSizeDataFiles "output"++pathToAllInputFiles :: BenchmarkBundle -> FilePath+pathToAllInputFiles = pathToAllDataFiles "input"++pathToAllOutputFiles :: BenchmarkBundle -> FilePath+pathToAllOutputFiles = pathToAllDataFiles "output"++pathToSizeDataFiles :: FilePath -> BenchmarkBundle -> FilePath+pathToSizeDataFiles subDir bb = pathToDataFiles size subDir bb+  where+  size = (map toLower $ show $ inputSize bb)++pathToAllDataFiles :: FilePath -> BenchmarkBundle -> FilePath+pathToAllDataFiles = pathToDataFiles "all"++pathToDataFiles :: FilePath -> FilePath -> BenchmarkBundle -> FilePath+pathToDataFiles size subDir bb =+  (pathToBench bb) </> "Fibon" </> "data" </> size </> subDir++pathToStdoutFile :: BenchmarkBundle -> FilePath+pathToStdoutFile = pathToStdioFile "stdout"++pathToStderrFile :: BenchmarkBundle -> FilePath+pathToStderrFile = pathToStdioFile "stderr"++pathToStdioFile :: String -> BenchmarkBundle -> FilePath+pathToStdioFile name bb =+  (pathToExeRunDir bb) </> (exeName.benchDetails $ bb) ++"."++name++".actual"++pathToStdinFile :: BenchmarkBundle -> FilePath -> FilePath+pathToStdinFile bb inFile = (pathToExeRunDir bb) </> inFile++benchExeAndArgs :: BenchmarkBundle -> (String, [String])+benchExeAndArgs bb = (exe, fullArgs)+  where+  exe      = pathToExe bb+  fullArgs = (runFlags . fullFlags) bb++prettyRunCommand :: BenchmarkBundle -> String+prettyRunCommand bb = cmd+  where+  cmd        = exe  ++ (concatMap (' ':) fullArgs)+  fullArgs   = args ++ stdioArgs+  (exe,args) = benchExeAndArgs bb+  stdioArgs  = [stdIn, stdOut, stdErr]+  stdIn      = case (stdinInput.benchDetails $ bb) of+                    Nothing -> ""+                    Just f  -> " < " ++ pathToStdinFile bb f+  stdOut     = "  > " ++ (pathToStdoutFile bb)+  stdErr     = " 2> " ++ (pathToStderrFile bb)++bundleProcessSpec :: BenchmarkBundle -> IO CreateProcess+bundleProcessSpec bb = do+  stdIn <-+    case  (stdinInput.benchDetails $ bb) of+      Nothing -> do return CreatePipe+      Just f  -> do h <- openFile (pathToStdinFile bb f) ReadMode+                    return (UseHandle h)+  out <- openFile (pathToStdoutFile bb) WriteMode+  err <- openFile (pathToStderrFile bb) WriteMode+  return $ (proc exe args) {+        cwd     = Just (pathToExeRunDir bb)+      , std_in  = stdIn+      , std_out = UseHandle out+      , std_err = UseHandle err+  }+  where+  (exe, args) = benchExeAndArgs bb+

@@ -0,0 +1,209 @@+module Fibon.Run.BenchmarkRunner (+    RunResult(..)+  , RunFailure(..)+  , Fibon.Run.BenchmarkRunner.run+)+where++import Control.Concurrent+import Control.Monad+import Control.Exception+import Data.Time.Clock+import Data.Maybe+import qualified Data.Vector.Unboxed as Vector+import Fibon.BenchmarkInstance+import Fibon.Result+import Fibon.Run.BenchmarkBundle+import Fibon.Run.Log as Log+import qualified Fibon.Run.SysTools as SysTools+import Statistics.Sample+import System.Directory+import System.Exit+import System.FilePath+import System.IO+import System.Process+import Text.Printf++data RunResult =+    Success {runSummary :: RunSummary, runDetails :: [RunDetail]}+  | Failure [RunFailure]+  deriving (Read, Show)++data RunFailure =+    MissingOutput FilePath+  | DiffError     String+  | Timeout+  deriving (Read, Show)++run :: BenchmarkBundle -> IO RunResult+run bb = do+  let bmk = (bundleName bb)+      pwd = (pathToExeBuildDir bb)+      cmd = (prettyRunCommand bb)+  Log.info $ "Running Benchmark "+  Log.info $ "   BMK: " ++ bmk+  Log.info $ "   PWD: " ++ pwd+  Log.info $ "   CMD: " ++ cmd+  Log.info $ printf "\n@%s|%s|%s" bmk pwd cmd+  runDirect bb++{-+-- Move this to analysis time+analyze :: Sample -> ExtraStats -> Int -> Double -> IO RunSummary+analyze times ghcStats numResamples ci = do+  let ests = [mean, stdDev]+  res   <- withSystemRandom $ \gen ->+            resample gen ests numResamples times :: IO [Resample]+  let [em,es] = bootstrapBCA ci times ests res+  let runData = RunSummary {+                timeSummary =+                  TimeMeasurement {+                      meanTime     = estPoint em+                    , meanTimeLB   = estLowerBound em+                    , meanTimeUB   = estUpperBound em+                    , meanStddev   = estPoint es+                    , meanStddevUB = estLowerBound es+                    , meanStddevLB = estUpperBound es+                    , confidence   = ci+                  }+              , statsSummary = ghcStats+  }+  return runData+-}++checkResult :: BenchmarkBundle -> IO (Maybe [RunFailure])+checkResult bb = do+  rs <- mapM (checkOutput bb) (output . benchDetails $ bb)+  let errs = filter isJust rs+  case errs of+    [] -> return $ Nothing+    es -> return $ Just (catMaybes es)++checkOutput :: BenchmarkBundle -> OutputDescription -> IO (Maybe RunFailure)+checkOutput bb (o, Exists) = do+  let f = (destinationToRealFile bb o)+  e <- doesFileExist f+  if e then return   Nothing+       else return $ Just $ MissingOutput ("File "++f++" does not exist")+checkOutput bb (o, Diff diffFile) = do+  e1 <- checkOutput bb (o, Exists)+  e2 <- checkOutput bb (d, Exists)+  e3 <- runDiff f1 f2+  return $ msum [e1, e2, e3]+  where+  d  = OutputFile diffFile+  f1 = (destinationToRealFile bb o)+  f2 = (destinationToRealFile bb d)++runDiff :: FilePath -> FilePath -> IO (Maybe RunFailure)+runDiff f1 f2 = do+  Log.info $ "Diffing files: "++f1++" "++f2+  (r, o, _) <- readProcessWithExitCode (SysTools.diff) [f1, f2] ""+  if r == ExitSuccess then Log.info "No diff error" >>+                           return   Nothing+                      else Log.info "Diff error" >>+                           (return $ Just $ DiffError o)++destinationToRealFile :: BenchmarkBundle -> OutputDestination -> FilePath+destinationToRealFile bb (OutputFile f) = (pathToExeRunDir bb)  </> f+destinationToRealFile bb  Stdout        = (pathToStdoutFile bb)+destinationToRealFile bb  Stderr        = (pathToStderrFile bb)++readExtraStats :: BenchmarkBundle -> IO ExtraStats+readExtraStats bb = do+  let mbStatsFile   = extraStats bb+      statsFile     = fromJust mbStatsFile+      logReadE :: IOException -> IO ExtraStats+      logReadE e =+        Log.warn ("Error reading stats file: "++statsFile++"\n  "++show e)+        >> return []+      --logParseE =+      --  Log.warn ("Error parsing stats file: "++statsFile) >> return []+  case mbStatsFile of+    Nothing -> return []+    Just f  -> do+      handle logReadE $+        bracket (openFile ((pathToExeRunDir bb) </> f) ReadMode)+                (hClose)+                (\h -> hGetContents h >>= \s -> length s `seq` return s)+                    --stats <- hGetContents h+                    -- drop header line in machine readable stats+                    --let body = (unlines . drop 1 . lines) stats+                    --case reads body of+                    --    [(p, _)] -> return p+                    --    _        -> logParseE)++type RunStepResult = IO (Either [RunFailure] RunDetail)++runDirect :: BenchmarkBundle -> IO RunResult+runDirect bb = do+  mbDetails <- go count []+  case mbDetails of+    Left e   -> return $ Failure e+    Right ds -> return $ Success (summarize ds) ds+  where+  go 0 ds = return $ Right (reverse ds)+  go n ds = do+    res <- runB bb+    case res of+      Right d -> go (n-1) (d:ds)+      Left e  -> return $ Left e+  runB    = maybe runBenchmarkWithoutTimeout runBenchmarkWithTimeout limit+  limit   = timeout bb+  count   = (iters bb)++summarize :: [RunDetail] -> RunSummary+summarize ds = RunSummary {+      meanTime     = mean times+    , stdDevTime   = stdDev times+    , statsSummary = stats+  }+  where+    times = (Vector.fromList $ map runTime ds)+    stats = concatMap runStats ds++type TimeoutLength = Int+runBenchmarkWithTimeout :: TimeoutLength -> BenchmarkBundle -> RunStepResult+runBenchmarkWithTimeout us bb = do+  resMVar <- newEmptyMVar+  pidMVar <- newEmptyMVar+  tid1 <- forkIO $ (putMVar resMVar . Just) =<< timeBenchmarkExe bb (Just pidMVar)+  _    <- forkIO $ threadDelay us >> putMVar resMVar Nothing+  res <- takeMVar resMVar+  case res of+    Nothing -> do+      Log.info $ "benchmark timed out after "++(show us)++" us"+      -- try to kill the subprocess+      pid <- tryTakeMVar pidMVar+      maybe pass terminateProcess pid+      -- kill the haskell thread+      killThread tid1+      return $ Left [Timeout]+    Just runDetail -> do+       maybe (Right runDetail) Left `liftM` checkResult bb++runBenchmarkWithoutTimeout :: BenchmarkBundle -> RunStepResult+runBenchmarkWithoutTimeout bb = do+  runDetail <- timeBenchmarkExe bb Nothing+  maybe (Right runDetail) Left `liftM` checkResult bb+      +timeBenchmarkExe :: BenchmarkBundle            -- benchmark to run+                 -> Maybe (MVar ProcessHandle) -- in case we need to kill it+                 -> IO RunDetail+timeBenchmarkExe bb pidMVar = do+  p     <- bundleProcessSpec bb+  start <- getCurrentTime+  (_, _, _, pid) <- createProcess p+  maybe pass (flip putMVar pid) pidMVar+  _  <- waitForProcess pid+  end   <- getCurrentTime+  mapM_ closeStdIO [std_in  p, std_out p, std_err p]+  stats <- readExtraStats bb+  return $ RunDetail (realToFrac (diffUTCTime end start)) stats++closeStdIO :: StdStream -> IO ()+closeStdIO (UseHandle h) = hClose h+closeStdIO _             = return ()++pass :: IO ()+pass = return()

@@ -0,0 +1,157 @@+module Fibon.Run.CommandLine (+    Opt(..)+  , UsageError+  , parseCommandLine+)+where++import Data.Maybe+import Data.List+import Fibon.Run.Actions+import Fibon.Run.Config+import Fibon.Run.Manifest+import System.Console.GetOpt++type UsageError = String+data Opt = Opt {+      optConfig      :: ConfigId+    , optHelpMsg     :: Maybe String+    , optBenchmarks  :: Maybe [BenchmarkRunSelection]+    , optTuneSetting :: Maybe TuneSetting+    , optSizeSetting :: Maybe InputSize+    , optIterations  :: Maybe Int+    , optAction      :: Action+  }++defaultOpts :: Opt+defaultOpts = Opt {+      optConfig      = "default"+    , optBenchmarks  = Nothing+    , optHelpMsg     = Nothing+    , optTuneSetting = Nothing+    , optSizeSetting = Nothing+    , optIterations  = Nothing+    , optAction      = Run+  }+++parseCommandLine :: [String] -> Either UsageError Opt+parseCommandLine args =+  case getOpt Permute options args of+    (o, bms, []) ->+      let (oErrs, opts) = parseOpts o+          (bErrs, bs)   = parseBenchs bms+      in+        case (oErrs, bErrs) of+          (Just oe, Just be) -> Left  $ oe ++ be+          (Just oe, Nothing) -> Left  $ oe+          (Nothing, Just be) -> Left  $ be+          (Nothing, Nothing) -> Right $ opts {optBenchmarks = bs}+    (_,_,errs) -> Left (concat errs ++ usage)+++parseOpts :: [OptionParser] -> (Maybe UsageError, Opt)+parseOpts = foldl (flip id) (Nothing, defaultOpts)++parseBenchs :: [String] -> (Maybe UsageError, Maybe [BenchmarkRunSelection])+parseBenchs bms = (errors, benchs)+  where+    bmParses = map mbParse bms :: [Maybe FibonBenchmark]+    grParses = map mbParse bms :: [Maybe FibonGroup]+    parses   = zipWith oneOrTheOther bmParses grParses+    errors   = foldl collectErrors Nothing (zip bms parses)+    benchs   = case catMaybes parses of [] -> Nothing; bs -> Just bs++    oneOrTheOther (Just b) _  = Just $ RunSingle b+    oneOrTheOther  _ (Just g) = Just $ RunGroup  g+    oneOrTheOther  _  _       = Nothing++    collectErrors errs (bm, parse) =+      mbAddError errs parse ("Unknown benchmark: "++bm)+++type OptionParser = ((Maybe UsageError, Opt) -> (Maybe UsageError, Opt))+options :: [OptDescr OptionParser]+options = [+    Option ['h'] ["help"]+      (NoArg (\(e, opt) -> (e, opt {optHelpMsg = Just usage})))+      "print a help message"+    ,+    Option ['c'] ["config"]+      (ReqArg (\c (e, opt) -> (e, opt {optConfig = c})) "ConfigId")+      "default config settings"+    ,+    Option ['t'] ["tune"]+      (ReqArg (\t (e, opt) ->+        let tune = mbParse    t+            errs = mbAddError e tune ("Unknown tune setting: "++t)+        in+        (errs, opt {optTuneSetting = tune})) "TuneSetting"+      )+      "override tune setting"+    ,+    Option ['s'] ["size"]+      (ReqArg (\s (e, opt) ->+        let size = mbParse    s+            errs = mbAddError e size ("Unknown size setting: "++s)+        in+        (errs, opt {optSizeSetting = size})) "InputSize"+      )+      "override size setting"+    ,+    Option ['i'] ["iters"]+      (ReqArg (\i (e, opt) ->+        let iter = mbParse    i+            errs = mbAddError e iter ("Invalid iter setting: "++i)+        in+        (errs, opt {optIterations = iter})) "Int"+      )+      "override number of iterations"+    ,+    Option ['m'] ["manifest"]+      (NoArg (\(e, opt) -> (e, opt {optHelpMsg = Just manifest})))+      "print manifest of configs and benchmarks"+    ,+    Option ['a'] ["action"]+      (ReqArg (\a (e, opt) ->+        let act  = mbParse    a+            errs = mbAddError e act ("Invalid action setting: "++a)+        in+        (errs, opt {optAction = fromMaybe (optAction opt) act})) "Action"+      )+      "override default action"+  ]++usage :: String+usage = usageInfo header options+  where header = "Usage: fibon-run [OPTION...] [BENCHMARKS...]"++mbAddError :: Maybe UsageError -> Maybe a -> UsageError -> Maybe UsageError+mbAddError e p msg =+  case p of+    Just _success -> e+    Nothing -> case e of+               Just errs -> Just (errs ++ "\n" ++ msg)+               Nothing   -> Just msg++mbParse :: (Read a) => String -> Maybe a+mbParse s =+  case reads s of+    [(a, "")] -> Just a+    _         -> Nothing++manifest :: String+manifest =+  "Configurations(" ++ nConfigs ++ ")\n  " ++ configs ++ "\n" +++  "Benchmarks("     ++ nBenchs  ++ ")\n  " ++ bms     ++ "\n" +++  "Groups("         ++ nGroups  ++ ")\n  " ++ grps+  where+    nConfigs = formatN configManifest+    nBenchs  = formatN benchmarkManifest+    nGroups  = formatN groupManifest+    configs  = format configId configManifest+    bms      = format show     benchmarkManifest+    grps     = format show     groupManifest+    format f = concat . intersperse "\n  " . map f+    formatN  = show . length+

@@ -0,0 +1,84 @@+module Fibon.Run.Config (+    Fibon.ConfigMonad.append+  , Fibon.ConfigMonad.setTimeout+  , Fibon.ConfigMonad.done+  , Fibon.ConfigMonad.collectExtraStatsFrom+  , Fibon.ConfigMonad.noExtraStats+  , Fibon.ConfigMonad.useGhcDir+  , Fibon.ConfigMonad.useGhcInPlaceDir+  , Fibon.Timeout.Timeout(..)+  , Fibon.ConfigMonad.FlagParameter(..)+  , Fibon.ConfigMonad.Configuration+  , Fibon.ConfigMonad.ConfigState(..)+  , Fibon.Benchmarks.FibonGroup(..)+  , Fibon.Benchmarks.FibonBenchmark(..)+  , Fibon.Benchmarks.allBenchmarks+  , Fibon.InputSize.InputSize(..)+  , RunConfig(..)+  , TuneSetting(..)+  , TuneSelection(..)+  , BenchmarkRunSelection(..)+  , BenchmarkConfigSelection(..)+  , ConfigBuilder+  , ConfigId+  , mkConfig+)+where+import Fibon.Benchmarks+import Fibon.BenchmarkInstance+import Fibon.InputSize+import Fibon.ConfigMonad+import Fibon.Timeout++data RunConfig = RunConfig {+      configId      :: ConfigId+    , sizeList      :: [InputSize]+    , tuneList      :: [TuneSetting]+    , runList       :: [BenchmarkRunSelection]+    , iterations    :: Int+    , configBuilder :: ConfigBuilder+  }++type ConfigId = String+type ConfigBuilder = TuneSelection -> BenchmarkConfigSelection -> ConfigMonad++data TuneSetting = +    Base +  | Peak +  deriving(Eq, Read, Show, Ord, Enum)++data TuneSelection =+    ConfigTune TuneSetting+  | ConfigTuneDefault+  deriving(Show, Eq, Ord)++data BenchmarkRunSelection =+    RunGroup  FibonGroup+  | RunSingle FibonBenchmark+  deriving(Show, Eq, Ord)++data BenchmarkConfigSelection =+    ConfigBenchGroup  FibonGroup+  | ConfigBench       FibonBenchmark+  | ConfigBenchDefault+  deriving(Show, Eq, Ord)++mkConfig :: RunConfig+                -> FibonBenchmark+                -> InputSize+                -> TuneSetting+                -> Configuration+mkConfig rc bm size tune = runWithInitialFlags benchFlags configM+  where+  configM = mapM_ (uncurry builder) [+        (ConfigTuneDefault, ConfigBenchDefault)+      , (ConfigTune tune  , ConfigBenchDefault)+      , (ConfigTuneDefault, ConfigBenchGroup group)+      , (ConfigTune tune  , ConfigBenchGroup group)+      , (ConfigTuneDefault, ConfigBench bm)+      , (ConfigTune tune  , ConfigBench bm)+    ]+  builder    = configBuilder rc+  group      = benchGroup bm+  benchFlags = flagConfig $ benchInstance bm size+

@@ -0,0 +1,25 @@+module Fibon.Run.Config.Default (+  config+)+where+import Fibon.Run.Config++config :: RunConfig+config = RunConfig {+    configId = "default"+  , runList  = map RunSingle allBenchmarks+  , sizeList = [Ref]+  , tuneList = [Base, Peak]+  , iterations = 10+  , configBuilder = build+  }++build :: ConfigBuilder+build (ConfigTune Base) ConfigBenchDefault = do+  append  ConfigureFlags "--disable-optimization"++build (ConfigTune Peak) ConfigBenchDefault = do+  append  ConfigureFlags "--enable-optimization=2"++build _ _ = do+  done

@@ -0,0 +1,14 @@+{-# LANGUAGE CPP #-}+module Fibon.Run.Config.Local(+  configs+)+where++import Fibon.Run.Config++-- This includes the conifg module imports and defines the localConfigs list+#include "LocalConfigs.txt"++configs :: [RunConfig]+configs = localConfigs+

@@ -0,0 +1,60 @@+module Fibon.Run.Log (+    debug+  , info+  , notice+  , warn+  , Fibon.Run.Log.error+  , setupLogger+  , result+  , summary+)+where++import Control.Monad+import System.Directory+import System.IO+import System.Log.Logger+import System.Log.Handler.Simple+import Text.Printf+import System.FilePath+++fibonLog :: String+fibonLog = "Fibon"++resultLog :: String+resultLog = "Fibon.Result"++summaryLog :: String+summaryLog = "Fibon.Summary"++setupLogger :: FilePath -> FilePath -> String -> IO (FilePath, FilePath, FilePath)+setupLogger logDir outDir runId = do+  let logFileName = printf "%s.LOG" runId+      logPath     = logDir </> logFileName+      resultPath  = outDir </> (printf "%s.RESULTS" runId)+      summaryPath = outDir </> (printf "%s.SUMMARY" runId)+  ldExists <- doesDirectoryExist logDir+  unless ldExists (createDirectory logDir)+  h  <- openFile logPath WriteMode+  ch <- streamHandler        stdout NOTICE+  fh <- verboseStreamHandler h      DEBUG+  rh <- fileHandler resultPath      DEBUG+  sh <- fileHandler summaryPath     DEBUG+  updateGlobalLogger rootLoggerName (setLevel DEBUG . setHandlers [ch,fh])+  updateGlobalLogger resultLog      (setLevel DEBUG . setHandlers [rh])+  updateGlobalLogger summaryLog     (setLevel DEBUG . setHandlers [sh])+  return (logPath, resultPath, summaryPath)++debug, info, notice, warn, error :: String -> IO ()+debug  = debugM fibonLog+info   = infoM fibonLog+notice = noticeM fibonLog+warn   = warningM fibonLog+error  = errorM fibonLog++result :: String -> IO ()+result  = infoM resultLog++summary :: String -> IO ()+summary = infoM summaryLog

@@ -0,0 +1,177 @@+module Main (+  main+)+where +import Control.Monad+import Control.Exception+import Data.Char+import Data.List+import Data.Time.Clock+import Data.Time.Format+import Data.Time.LocalTime+import Fibon.Benchmarks+import Fibon.Result+import Fibon.Run.Actions+import Fibon.Run.CommandLine+import Fibon.Run.Config+import Fibon.Run.Manifest+import Fibon.Run.BenchmarkBundle+import qualified Fibon.Run.Log as Log+import System.Directory+import System.Exit+import System.Environment+import System.FilePath+import System.Locale+import Text.Printf+++main :: IO ()+main = do+  opts <- parseArgsOrDie+  currentDir <- getCurrentDirectory+  initConfig  <- selectConfig (optConfig opts)+  let runConfig  = mergeConfigOpts initConfig opts+      workingDir = currentDir </> "run"+      benchRoot  = currentDir </> "benchmarks/Fibon/Benchmarks"+      logPath    = currentDir </> "log"+      action     = optAction opts+  uniq       <- chooseUniqueName workingDir (configId runConfig)+  (logFile, outFile, summaryFile) <- Log.setupLogger logPath logPath uniq+  startTime <- timeStamp+  Log.notice ("Starting Run at   " ++ startTime)+  Log.notice ("Logging output  to " ++ logFile)+  Log.notice ("Logging result  to " ++ outFile)+  Log.notice ("Logging summary to " ++ summaryFile)+  mapM_ (runAndReport action) (makeBundles runConfig workingDir benchRoot uniq)+  endTime <- timeStamp+  Log.notice ("Finished Run at   " ++ endTime)+  Log.notice ("Logged output  to " ++ logFile)+  Log.notice ("Logged result  to " ++ outFile)+  Log.notice ("Logged summary to " ++ summaryFile)++parseArgsOrDie :: IO Opt+parseArgsOrDie = do+  args <- getArgs+  case parseCommandLine args of+    Left  msg  -> putStrLn msg >> exitFailure+    Right opts -> do+      case optHelpMsg opts of+        Just msg -> putStrLn msg >> exitSuccess+        Nothing  -> return opts++runAndReport :: Action -> BenchmarkBundle -> IO ()+runAndReport action bundle = do+  Log.notice $ "Benchmark: "++ (bundleName bundle)++ " action="++(show action)+  case action of+    Sanity -> run sanityCheckBundle  (const $ return ())+    Build  -> run buildBundle        (\(BuildData time _size) -> do+                Log.info (printf "Build completed in %0.2f seconds" time)+              )+    Run    -> run runBundle          (\fr@(FibonResult n _bd rd) -> do+                -- Log.notice (show rr)+                Log.result(show fr)+                Log.summary(printf "%s %.4f" n ((meanTime . summary) rd))+              )+  return ()+  where+  run :: Show a => ActionRunner a -> (a -> IO ()) -> IO ()+  run = runAndLogErrors bundle++runAndLogErrors :: Show a+                => BenchmarkBundle+                -> ActionRunner a+                -> (a -> IO ())+                -> IO ()+runAndLogErrors bundle act cont = do+  result <- try (act bundle)+  -- result could fail from an IOError, or from a failure in the RunMonad+  case result of+    Left  ioe -> logError (show (ioe :: IOError))+    Right res ->+      case res of+        Left  e -> logError (show e) >> return ()+        Right r -> cont r+   where+   name = bundleName bundle+   logError s = do Log.warn $ "Error running: "  ++ name+                   Log.warn $ "        =====> "  ++ s++selectConfig :: ConfigId -> IO RunConfig+selectConfig configName =+  case find ((== configName) . configId) configManifest of+    Just c  -> do return c+    Nothing -> do+      Log.error $ "Unknown config: "       ++ configName+      Log.error $ "Available configs:\n  " ++ configNames+      exitFailure+  where configNames = concat (intersperse "\n  " $ map configId configManifest)++makeBundles :: RunConfig+            -> FilePath  -- ^ Working directory+            -> FilePath  -- ^ Benchmark base path+            -> String    -- ^ Unique Id+            -> [BenchmarkBundle]+makeBundles rc workingDir benchRoot uniq = map bundle bms+  where+  bundle (bm, size, tune) =+    mkBundle rc bm workingDir benchRoot uniq size tune+  bms = sort+        [(bm, size, tune) |+                      size <- (sizeList rc),+                      bm   <- expandBenchList $ runList rc,+                      tune <- (tuneList rc)]++expandBenchList :: [BenchmarkRunSelection] -> [FibonBenchmark]+expandBenchList = concatMap expand+  where+  expand (RunSingle b) = [b]+  expand (RunGroup  g) = filter (\b -> benchGroup b == g) allBenchmarks++chooseUniqueName :: FilePath -> String -> IO String+chooseUniqueName workingDir configName = do+  wdExists <- doesDirectoryExist workingDir+  unless wdExists (createDirectory workingDir)+  dirs  <- getDirectoryContents workingDir+  let numbered = filter (\x -> length x > 0) $ map (takeWhile isDigit) dirs+  case numbered of+    [] -> return $ format (0 :: Int)+    _  -> return $ (format . (+1) . read . last . sort) numbered+  where+  format :: Int -> String+  format d = printf "%03d.%s" d configName++timeStamp :: IO String+timeStamp = do+  tz <- getCurrentTimeZone+  t  <- getCurrentTime+  return $ formatTime defaultTimeLocale "%F %T" (utcToLocalTime tz t)++mergeConfigOpts :: RunConfig -> Opt -> RunConfig+mergeConfigOpts rc opt = rc {+      tuneList   = maybe (tuneList rc) (:[]) (optTuneSetting opt)+    , sizeList   = maybe (sizeList rc) (:[]) (optSizeSetting opt)+    , runList    = maybe (runList  rc)   id  (optBenchmarks  opt)+    , iterations = maybe (iterations rc) id  (optIterations  opt)+  }++{-+dumpConfig :: RunConfig -> IO ()+dumpConfig rc = do+  --putStrLn $ show $ map (uncurry benchInstance) $ sort bms+  putStrLn $ show bms+  mapM_ (dumpInstance rc) bms+  where+  bms = sort+        [(bm, size, tune) |+                      size <- (sizeList rc),+                      bm   <- expandBenchList $ runList rc,+                      tune <- (tuneList rc)]++dumpInstance :: RunConfig -> (FibonBenchmark, InputSize, TuneSetting)->IO ()+dumpInstance rc inst@(bm, size, tune) = do+  putStrLn (take 68 $ repeat '-')+  putStrLn (show inst)+  putStrLn (take 68 $ repeat '-')+  putStrLn (show $ mkFlagConfig rc bm size tune)++-}

@@ -0,0 +1,21 @@+module Fibon.Run.Manifest (+    configManifest+  , groupManifest+  , benchmarkManifest+)+where++import Data.List+import Fibon.Benchmarks+import Fibon.Run.Config+import Fibon.Run.Config.Default as Default+import Fibon.Run.Config.Local as Local++configManifest :: [RunConfig]+configManifest = Default.config : Local.configs++groupManifest :: [FibonGroup]+groupManifest = (nub . sort . map benchGroup)  benchmarkManifest++benchmarkManifest :: [FibonBenchmark]+benchmarkManifest = allBenchmarks

@@ -0,0 +1,15 @@+module Fibon.Run.SysTools (+    size+  , cabal+  , diff+)+where++size :: String+size = "size"++cabal :: String+cabal = "cabal"++diff :: String+diff = "diff"