RunnerTypes.hs 4.21 KB
Newer Older
1 2 3 4 5 6 7 8
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module RunnerTypes where

-- Standard libraries
import Data.Char
9
import Data.Maybe
10
import System.Process
11
import qualified System.Directory as IO
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
import Data.String (IsString)
import Options.Applicative

-- Shake - build system
import Development.Shake.FilePath hiding (exe)

import qualified Measurements as Ms

import GHC.Read as R
import Text.Read.Lex as L
import Text.ParserCombinators.ReadPrec (pfail)

---------------------------------------------------------------------
-- ARGUMENT PARSING - mostly based on CmdArgs

-- | Testnames are either
-- * A single tests name component (eg "rfib")
-- * A subpath eg. "real/eff"
-- * A fully qualified path e.g. "spectral/simple"
newtype TestName = TestName { unTestName :: String }
    deriving (Show, Eq, Ord, IsString)

-- | The directory which the given test lives in
testDir :: TestName -> FilePath
testDir (TestName dir) = dir

testLabel :: TestName -> Ms.Label
testLabel (TestName dir) = Ms.mkLabel dir

data Nofib
    = Build
        {clean :: Bool
        ,tests :: [TestName]
        ,threads :: Int
        ,compiler :: String
        ,compiler_args :: [String]
48
        ,output :: String -- ^ Where to put the results
49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
        ,cachegrind :: Bool
        ,cachegrind_args :: [String]
        ,perf :: Bool
        ,perf_args :: [String]
        ,speed :: Speed
        ,rts_args :: [String]
        ,times :: Int
        }
    deriving (Show)

data Speed = Fast | Norm | Slow
    deriving (Show)

instance Read Speed where
  readPrec =
    parens
    ( do L.Ident s <- lexP
         case s of
           "Slow" -> return Slow
           "slow" -> return Slow
           "Norm" -> return Norm
           "norm" -> return Norm
           "Fast" -> return Fast
           "fast" -> return Fast
           _       -> pfail
    )

nofibMode :: Parser Nofib
nofibMode =
  Build
    <$> switch (short 'c' <> long "clean" <> help "Clean before building")
    <*> many (argument (TestName <$> str) (metavar "TEST" <> help "Tests to run (omit for all)"))
    <*> option auto (short 'j' <> long "threads" <> metavar "N" <> value 1 <> help "Number of threads, defaults to 1")
    <*> option str (short 'w' <> long "compiler" <> metavar "HC" <> value "ghc" <> help "Compiler to use, defaults to `ghc`")
    <*> many (option str (long "compiler-arg" <> help "Extra arguments to pass to the Compiler when building tests"))
    <*> option str (short 'o' <> long "output" <> metavar "DIR" <> help "Where to put created files under ./_make, defaults to {compiler version}")
    <*> switch (long "cachegrind" <> help "Run the tests under cachegrind")
    <*> many (option str (long "cachegrind-arg" <> help "Extra arguments to pass to cachegrind"))
    <*> switch (long "perf" <> help "Run the tests under `perf stat`")
    <*> (many (option str (long "perf-arg" <> help "Extra arguments to pass to `perf stat`"))
         <|> pure ["-e instructions,cycles,cache-misses,task-clock", "-r5"])
    <*> option auto (long "speed" <> short 's' <> value Norm <> help "Test speed (Fast,Norm,Slow)")
    <*> many (option str (long "rts-arg" <> help "Extra arguments to pass to runtime system when running"))
    <*> option auto (long "times" <> short 't' <> value 1 <> help "Number of times to run each test")


-- | Create a clean set of arguments, with any defaults filled in
nofibArgs :: IO Nofib
nofibArgs = do
    args <- execParser $ info (helper <*> nofibMode) (progDesc "nofib Benchmark Suite")
    print args
    case args of
        build@Build{..} -> do
102 103
            -- Turns "ghc" into /usr/bin/../ghc
            compiler' <- fromMaybe (error "Couldn't find GHC at" ++ compiler) <$> IO.findExecutable compiler
104 105
            compilerVer <- compilerVersion compiler
            output' <- return $ "_make" </> (if null output then compilerVer else output)
106
            return build{ output = output', compiler = compiler' }
107 108 109 110 111 112 113

-- | Find the default compiler string, e.g. ghc-7.4.1
compilerVersion :: FilePath -> IO String
compilerVersion compiler = do
    (_,stdout,_) <- readProcessWithExitCode compiler ["--version"] ""
    let ver = takeWhile (\x -> isDigit x || x == '.') $ dropWhile (not . isDigit) stdout
    return $ if null ver then "unknown" else ver