{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Futhark.CLI.Autotune (main) where
import Control.Monad
import qualified Data.ByteString.Char8 as SBS
import Data.Function (on)
import Data.Tree
import Data.List (intersect, isPrefixOf, sort, sortOn, elemIndex, minimumBy)
import Data.Maybe
import Text.Read (readMaybe)
import Text.Regex.TDFA
import qualified Data.Text as T
import qualified Data.Set as S
import System.Environment (getExecutablePath)
import System.Exit
import System.Process
import System.FilePath
import System.Console.GetOpt
import Futhark.Bench
import Futhark.Test
import Futhark.Util (maxinum)
import Futhark.Util.Options
data AutotuneOptions = AutotuneOptions
{ AutotuneOptions -> String
optBackend :: String
, AutotuneOptions -> Maybe String
optFuthark :: Maybe String
, AutotuneOptions -> Int
optRuns :: Int
, AutotuneOptions -> Maybe String
optTuning :: Maybe String
, :: [String]
, AutotuneOptions -> Int
optVerbose :: Int
, AutotuneOptions -> Int
optTimeout :: Int
, AutotuneOptions -> Int
optDefaultThreshold :: Int
}
initialAutotuneOptions :: AutotuneOptions
initialAutotuneOptions :: AutotuneOptions
initialAutotuneOptions =
String
-> Maybe String
-> Int
-> Maybe String
-> [String]
-> Int
-> Int
-> Int
-> AutotuneOptions
AutotuneOptions String
"opencl" Maybe String
forall a. Maybe a
Nothing Int
10 (String -> Maybe String
forall a. a -> Maybe a
Just String
"tuning") [] Int
0 Int
60 Int
thresholdMax
compileOptions :: AutotuneOptions -> IO CompileOptions
compileOptions :: AutotuneOptions -> IO CompileOptions
compileOptions AutotuneOptions
opts = do
String
futhark <- IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getExecutablePath String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO String) -> Maybe String -> IO String
forall a b. (a -> b) -> a -> b
$ AutotuneOptions -> Maybe String
optFuthark AutotuneOptions
opts
CompileOptions -> IO CompileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileOptions -> IO CompileOptions)
-> CompileOptions -> IO CompileOptions
forall a b. (a -> b) -> a -> b
$ CompileOptions :: String -> String -> [String] -> CompileOptions
CompileOptions { compFuthark :: String
compFuthark = String
futhark
, compBackend :: String
compBackend = AutotuneOptions -> String
optBackend AutotuneOptions
opts
, compOptions :: [String]
compOptions = [String]
forall a. Monoid a => a
mempty
}
runOptions :: Path -> Int -> AutotuneOptions -> RunOptions
runOptions :: Path -> Int -> AutotuneOptions -> RunOptions
runOptions Path
path Int
timeout_s AutotuneOptions
opts =
RunOptions :: String
-> Int
-> [String]
-> Int
-> Int
-> Maybe (Int -> IO ())
-> RunOptions
RunOptions { runRunner :: String
runRunner = String
""
, runRuns :: Int
runRuns = AutotuneOptions -> Int
optRuns AutotuneOptions
opts
, runExtraOptions :: [String]
runExtraOptions = String
"--default-threshold" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
Int -> String
forall a. Show a => a -> String
show (AutotuneOptions -> Int
optDefaultThreshold AutotuneOptions
opts) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
String
"-L" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
((String, Int) -> String) -> Path -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> String
forall a. Show a => (String, a) -> String
opt Path
path [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
AutotuneOptions -> [String]
optExtraOptions AutotuneOptions
opts
, runTimeout :: Int
runTimeout = Int
timeout_s
, runVerbose :: Int
runVerbose = AutotuneOptions -> Int
optVerbose AutotuneOptions
opts
, runResultAction :: Maybe (Int -> IO ())
runResultAction = Maybe (Int -> IO ())
forall a. Maybe a
Nothing
}
where opt :: (String, a) -> String
opt (String
name, a
val) = String
"--size=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
val
type Path = [(String, Int)]
regexGroups :: Regex -> String -> Maybe [String]
regexGroups :: Regex -> String -> Maybe [String]
regexGroups Regex
regex String
s = do
(String
_, String
_, String
_, [String]
groups) <-
Regex -> String -> Maybe (String, String, String, [String])
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
regex String
s :: Maybe (String, String, String, [String])
[String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
groups
comparisons :: String -> [(String,Int)]
comparisons :: String -> Path
comparisons = (String -> Maybe (String, Int)) -> [String] -> Path
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe (String, Int)
forall b. Read b => String -> Maybe (String, b)
isComparison ([String] -> Path) -> (String -> [String]) -> String -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
where regex :: Regex
regex = String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex (String
"Compared ([^ ]+) <= (-?[0-9]+)" :: String)
isComparison :: String -> Maybe (String, b)
isComparison String
l = do [String
thresh, String
val] <- Regex -> String -> Maybe [String]
regexGroups Regex
regex String
l
b
val' <- String -> Maybe b
forall a. Read a => String -> Maybe a
readMaybe String
val
(String, b) -> Maybe (String, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
thresh, b
val')
type RunDataset = Int -> Path -> IO (Either String ([(String, Int)], Int))
type DatasetName = String
prepare :: AutotuneOptions -> FilePath -> IO [(DatasetName, RunDataset, T.Text)]
prepare :: AutotuneOptions -> String -> IO [(String, RunDataset, Text)]
prepare AutotuneOptions
opts String
prog = do
ProgramTest
spec <- String -> IO ProgramTest
testSpecFromFileOrDie String
prog
CompileOptions
copts <- AutotuneOptions -> IO CompileOptions
compileOptions AutotuneOptions
opts
[InputOutputs]
truns <-
case ProgramTest -> TestAction
testAction ProgramTest
spec of
RunCases [InputOutputs]
ios [StructureTest]
_ [WarningTest]
_ | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [InputOutputs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InputOutputs]
ios -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
[String] -> String
unwords (String
"Entry points:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (InputOutputs -> String) -> [InputOutputs] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack (Text -> String)
-> (InputOutputs -> Text) -> InputOutputs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOutputs -> Text
iosEntryPoint) [InputOutputs]
ios)
Either (String, Maybe ByteString) ()
res <- Maybe Int
-> CompileOptions
-> String
-> [InputOutputs]
-> IO (Either (String, Maybe ByteString) ())
forall (m :: * -> *).
MonadIO m =>
Maybe Int
-> CompileOptions
-> String
-> [InputOutputs]
-> m (Either (String, Maybe ByteString) ())
prepareBenchmarkProgram Maybe Int
forall a. Maybe a
Nothing CompileOptions
copts String
prog [InputOutputs]
ios
case Either (String, Maybe ByteString) ()
res of
Left (String
err, Maybe ByteString
errstr) -> do
String -> IO ()
putStrLn String
err
IO () -> (ByteString -> IO ()) -> Maybe ByteString -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ByteString -> IO ()
SBS.putStrLn Maybe ByteString
errstr
IO [InputOutputs]
forall a. IO a
exitFailure
Right () ->
[InputOutputs] -> IO [InputOutputs]
forall (m :: * -> *) a. Monad m => a -> m a
return [InputOutputs]
ios
TestAction
_ ->
String -> IO [InputOutputs]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unsupported test spec."
let runnableDataset :: Text -> TestRun -> Maybe (String, RunDataset)
runnableDataset Text
entry_point TestRun
trun =
case TestRun -> ExpectedResult Success
runExpectedResult TestRun
trun of
Succeeds Maybe Success
expected
| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TestRun -> [String]
runTags TestRun
trun [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [String
"notune", String
"disable"]) ->
(String, RunDataset) -> Maybe (String, RunDataset)
forall a. a -> Maybe a
Just (TestRun -> String
runDescription TestRun
trun, Text -> TestRun -> Maybe Success -> RunDataset
run Text
entry_point TestRun
trun Maybe Success
expected)
ExpectedResult Success
_ -> Maybe (String, RunDataset)
forall a. Maybe a
Nothing
([[(String, RunDataset, Text)]] -> [(String, RunDataset, Text)])
-> IO [[(String, RunDataset, Text)]]
-> IO [(String, RunDataset, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(String, RunDataset, Text)]] -> [(String, RunDataset, Text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[(String, RunDataset, Text)]]
-> IO [(String, RunDataset, Text)])
-> IO [[(String, RunDataset, Text)]]
-> IO [(String, RunDataset, Text)]
forall a b. (a -> b) -> a -> b
$ [InputOutputs]
-> (InputOutputs -> IO [(String, RunDataset, Text)])
-> IO [[(String, RunDataset, Text)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [InputOutputs]
truns ((InputOutputs -> IO [(String, RunDataset, Text)])
-> IO [[(String, RunDataset, Text)]])
-> (InputOutputs -> IO [(String, RunDataset, Text)])
-> IO [[(String, RunDataset, Text)]]
forall a b. (a -> b) -> a -> b
$ \InputOutputs
ios ->
[(String, RunDataset)]
-> ((String, RunDataset) -> IO (String, RunDataset, Text))
-> IO [(String, RunDataset, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ((TestRun -> Maybe (String, RunDataset))
-> [TestRun] -> [(String, RunDataset)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> TestRun -> Maybe (String, RunDataset)
runnableDataset (Text -> TestRun -> Maybe (String, RunDataset))
-> Text -> TestRun -> Maybe (String, RunDataset)
forall a b. (a -> b) -> a -> b
$ InputOutputs -> Text
iosEntryPoint InputOutputs
ios)
(InputOutputs -> [TestRun]
iosTestRuns InputOutputs
ios)) (((String, RunDataset) -> IO (String, RunDataset, Text))
-> IO [(String, RunDataset, Text)])
-> ((String, RunDataset) -> IO (String, RunDataset, Text))
-> IO [(String, RunDataset, Text)]
forall a b. (a -> b) -> a -> b
$
\(String
dataset, RunDataset
do_run) ->
(String, RunDataset, Text) -> IO (String, RunDataset, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
dataset, RunDataset
do_run, InputOutputs -> Text
iosEntryPoint InputOutputs
ios)
where run :: Text -> TestRun -> Maybe Success -> RunDataset
run Text
entry_point TestRun
trun Maybe Success
expected Int
timeout Path
path = do
let bestRuntime :: ([RunResult], T.Text) -> ([(String, Int)], Int)
bestRuntime :: ([RunResult], Text) -> (Path, Int)
bestRuntime ([RunResult]
runres, Text
errout) =
(String -> Path
comparisons (Text -> String
T.unpack Text
errout),
[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (RunResult -> Int) -> [RunResult] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map RunResult -> Int
runMicroseconds [RunResult]
runres)
ropts :: RunOptions
ropts = Path -> Int -> AutotuneOptions -> RunOptions
runOptions Path
path Int
timeout AutotuneOptions
opts
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Running with options: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (RunOptions -> [String]
runExtraOptions RunOptions
ropts)
(Text -> Either String (Path, Int))
-> (([RunResult], Text) -> Either String (Path, Int))
-> Either Text ([RunResult], Text)
-> Either String (Path, Int)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String (Path, Int)
forall a b. a -> Either a b
Left (String -> Either String (Path, Int))
-> (Text -> String) -> Text -> Either String (Path, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ((Path, Int) -> Either String (Path, Int)
forall a b. b -> Either a b
Right ((Path, Int) -> Either String (Path, Int))
-> (([RunResult], Text) -> (Path, Int))
-> ([RunResult], Text)
-> Either String (Path, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RunResult], Text) -> (Path, Int)
bestRuntime) (Either Text ([RunResult], Text) -> Either String (Path, Int))
-> IO (Either Text ([RunResult], Text))
-> IO (Either String (Path, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
RunOptions
-> String
-> Text
-> Values
-> Maybe Success
-> String
-> IO (Either Text ([RunResult], Text))
benchmarkDataset RunOptions
ropts String
prog Text
entry_point
(TestRun -> Values
runInput TestRun
trun) Maybe Success
expected
(String -> Text -> TestRun -> String
testRunReferenceOutput String
prog Text
entry_point TestRun
trun)
data DatasetResult = DatasetResult [(String, Int)] Double
deriving Int -> DatasetResult -> String -> String
[DatasetResult] -> String -> String
DatasetResult -> String
(Int -> DatasetResult -> String -> String)
-> (DatasetResult -> String)
-> ([DatasetResult] -> String -> String)
-> Show DatasetResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DatasetResult] -> String -> String
$cshowList :: [DatasetResult] -> String -> String
show :: DatasetResult -> String
$cshow :: DatasetResult -> String
showsPrec :: Int -> DatasetResult -> String -> String
$cshowsPrec :: Int -> DatasetResult -> String -> String
Show
type ThresholdForest = Forest (String, Bool)
thresholdMin, thresholdMax :: Int
thresholdMin :: Int
thresholdMin = Int
1
thresholdMax :: Int
thresholdMax = Int
2000000000
tuningPaths :: ThresholdForest -> [(String, Path)]
tuningPaths :: ThresholdForest -> [(String, Path)]
tuningPaths = (Tree (String, Bool) -> [(String, Path)])
-> ThresholdForest -> [(String, Path)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Path -> Tree (String, Bool) -> [(String, Path)]
forall a. [(a, Int)] -> Tree (a, Bool) -> [(a, [(a, Int)])]
treePaths [])
where treePaths :: [(a, Int)] -> Tree (a, Bool) -> [(a, [(a, Int)])]
treePaths [(a, Int)]
ancestors (Node (a
v, Bool
_) Forest (a, Bool)
children) =
(Tree (a, Bool) -> [(a, [(a, Int)])])
-> Forest (a, Bool) -> [(a, [(a, Int)])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(a, Int)] -> a -> Tree (a, Bool) -> [(a, [(a, Int)])]
onChild [(a, Int)]
ancestors a
v) Forest (a, Bool)
children [(a, [(a, Int)])] -> [(a, [(a, Int)])] -> [(a, [(a, Int)])]
forall a. [a] -> [a] -> [a]
++ [(a
v, [(a, Int)]
ancestors)]
onChild :: [(a, Int)] -> a -> Tree (a, Bool) -> [(a, [(a, Int)])]
onChild [(a, Int)]
ancestors a
v child :: Tree (a, Bool)
child@(Node (a
_, Bool
cmp) Forest (a, Bool)
_) =
[(a, Int)] -> Tree (a, Bool) -> [(a, [(a, Int)])]
treePaths ([(a, Int)]
ancestors[(a, Int)] -> [(a, Int)] -> [(a, Int)]
forall a. [a] -> [a] -> [a]
++[(a
v, Bool -> Int
t Bool
cmp)]) Tree (a, Bool)
child
t :: Bool -> Int
t Bool
False = Int
thresholdMax
t Bool
True = Int
thresholdMin
thresholdForest :: FilePath -> IO ThresholdForest
thresholdForest :: String -> IO ThresholdForest
thresholdForest String
prog = do
[(String, [(String, Bool)])]
thresholds <- String -> [(String, [(String, Bool)])]
getThresholds (String -> [(String, [(String, Bool)])])
-> IO String -> IO [(String, [(String, Bool)])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
String -> [String] -> String -> IO String
readProcess (String
"." String -> String -> String
</> String -> String
dropExtension String
prog) [String
"--print-sizes"] String
""
let root :: (a, b) -> ((a, Bool), [a])
root (a
v, b
_) = ((a
v, Bool
False), [])
ThresholdForest -> IO ThresholdForest
forall (m :: * -> *) a. Monad m => a -> m a
return (ThresholdForest -> IO ThresholdForest)
-> ThresholdForest -> IO ThresholdForest
forall a b. (a -> b) -> a -> b
$ (((String, Bool), [String])
-> ((String, Bool), [((String, Bool), [String])]))
-> [((String, Bool), [String])] -> ThresholdForest
forall b a. (b -> (a, [b])) -> [b] -> Forest a
unfoldForest ([(String, [(String, Bool)])]
-> ((String, Bool), [String])
-> ((String, Bool), [((String, Bool), [String])])
forall a a b b.
Ord a =>
[(a, [(a, b)])] -> ((a, b), [a]) -> ((a, b), [((a, b), [a])])
unfold [(String, [(String, Bool)])]
thresholds) ([((String, Bool), [String])] -> ThresholdForest)
-> [((String, Bool), [String])] -> ThresholdForest
forall a b. (a -> b) -> a -> b
$
((String, [(String, Bool)]) -> ((String, Bool), [String]))
-> [(String, [(String, Bool)])] -> [((String, Bool), [String])]
forall a b. (a -> b) -> [a] -> [b]
map (String, [(String, Bool)]) -> ((String, Bool), [String])
forall a b a. (a, b) -> ((a, Bool), [a])
root ([(String, [(String, Bool)])] -> [((String, Bool), [String])])
-> [(String, [(String, Bool)])] -> [((String, Bool), [String])]
forall a b. (a -> b) -> a -> b
$ ((String, [(String, Bool)]) -> Bool)
-> [(String, [(String, Bool)])] -> [(String, [(String, Bool)])]
forall a. (a -> Bool) -> [a] -> [a]
filter ([(String, Bool)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(String, Bool)] -> Bool)
-> ((String, [(String, Bool)]) -> [(String, Bool)])
-> (String, [(String, Bool)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [(String, Bool)]) -> [(String, Bool)]
forall a b. (a, b) -> b
snd) [(String, [(String, Bool)])]
thresholds
where getThresholds :: String -> [(String, [(String, Bool)])]
getThresholds = (String -> Maybe (String, [(String, Bool)]))
-> [String] -> [(String, [(String, Bool)])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe (String, [(String, Bool)])
findThreshold ([String] -> [(String, [(String, Bool)])])
-> (String -> [String]) -> String -> [(String, [(String, Bool)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
regex :: Regex
regex = String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex (String
"(.*)\\ \\(threshold\\ \\((.*)\\)\\)" :: String)
findThreshold :: String -> Maybe (String, [(String, Bool)])
findThreshold :: String -> Maybe (String, [(String, Bool)])
findThreshold String
l = do [String
grp1, String
grp2] <- Regex -> String -> Maybe [String]
regexGroups Regex
regex String
l
(String, [(String, Bool)]) -> Maybe (String, [(String, Bool)])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
grp1,
((String, Bool) -> Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, Bool) -> Bool) -> (String, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool)
-> ((String, Bool) -> String) -> (String, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Bool) -> String
forall a b. (a, b) -> a
fst) ([(String, Bool)] -> [(String, Bool)])
-> [(String, Bool)] -> [(String, Bool)]
forall a b. (a -> b) -> a -> b
$
(String -> (String, Bool)) -> [String] -> [(String, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> if String
"!" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x
then (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
x, Bool
False)
else (String
x, Bool
True)) ([String] -> [(String, Bool)]) -> [String] -> [(String, Bool)]
forall a b. (a -> b) -> a -> b
$
String -> [String]
words String
grp2)
unfold :: [(a, [(a, b)])] -> ((a, b), [a]) -> ((a, b), [((a, b), [a])])
unfold [(a, [(a, b)])]
thresholds ((a
parent, b
parent_cmp), [a]
ancestors) =
let ancestors' :: [a]
ancestors' = a
parent a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ancestors
isChild :: (a, [(a, b)]) -> Maybe ((a, b), [a])
isChild (a
v, [(a, b)]
v_ancestors) = do
b
cmp <- a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
parent [(a, b)]
v_ancestors
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$
[a] -> [a]
forall a. Ord a => [a] -> [a]
sort (((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
v_ancestors) [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
==
[a] -> [a]
forall a. Ord a => [a] -> [a]
sort (a
parent a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ancestors)
((a, b), [a]) -> Maybe ((a, b), [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
v, b
cmp), [a]
ancestors')
in ((a
parent, b
parent_cmp), ((a, [(a, b)]) -> Maybe ((a, b), [a]))
-> [(a, [(a, b)])] -> [((a, b), [a])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (a, [(a, b)]) -> Maybe ((a, b), [a])
forall a b. (a, [(a, b)]) -> Maybe ((a, b), [a])
isChild [(a, [(a, b)])]
thresholds)
tuneThreshold :: AutotuneOptions
-> [(DatasetName, RunDataset, T.Text)]
-> Path -> (String, Path)
-> IO Path
tuneThreshold :: AutotuneOptions
-> [(String, RunDataset, Text)]
-> Path
-> (String, Path)
-> IO Path
tuneThreshold AutotuneOptions
opts [(String, RunDataset, Text)]
datasets Path
already_tuned (String
v, Path
_v_path) = do
(Int
_, Int
threshold) <-
((Int, Int) -> (String, RunDataset, Text) -> IO (Int, Int))
-> (Int, Int) -> [(String, RunDataset, Text)] -> IO (Int, Int)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Int, Int) -> (String, RunDataset, Text) -> IO (Int, Int)
tuneDataset (Int
thresholdMin, Int
thresholdMax) [(String, RunDataset, Text)]
datasets
Path -> IO Path
forall (m :: * -> *) a. Monad m => a -> m a
return (Path -> IO Path) -> Path -> IO Path
forall a b. (a -> b) -> a -> b
$ (String
v, Int
threshold) (String, Int) -> Path -> Path
forall a. a -> [a] -> [a]
: Path
already_tuned
where
tuneDataset :: (Int, Int) -> (DatasetName, RunDataset, T.Text) -> IO (Int, Int)
tuneDataset :: (Int, Int) -> (String, RunDataset, Text) -> IO (Int, Int)
tuneDataset (Int
tMin, Int
tMax) (String
dataset_name, RunDataset
run, Text
entry_point) =
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (Text -> String
T.unpack Text
entry_point String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".") String
v then do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
v, String
"is irrelevant for", Text -> String
T.unpack Text
entry_point]
(Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
tMin, Int
tMax)
else do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Tuning", String
v, String
"on entry point", Text -> String
T.unpack Text
entry_point,
String
"and dataset", String
dataset_name]
Either String (Path, Int)
sample_run <- RunDataset
run (AutotuneOptions -> Int
optTimeout AutotuneOptions
opts) ((String
v, Int
tMax) (String, Int) -> Path -> Path
forall a. a -> [a] -> [a]
: Path
already_tuned)
case Either String (Path, Int)
sample_run of
Left String
err -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"Sampling run failed:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
(Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
tMin, Int
tMax)
Right (Path
cmps, Int
t) -> do
let ePars :: [Int]
ePars = Set Int -> [Int]
forall a. Set a -> [a]
S.toAscList (Set Int -> [Int]) -> Set Int -> [Int]
forall a b. (a -> b) -> a -> b
$
((String, Int) -> Int) -> Set (String, Int) -> Set Int
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (String, Int) -> Int
forall a b. (a, b) -> b
snd (Set (String, Int) -> Set Int) -> Set (String, Int) -> Set Int
forall a b. (a -> b) -> a -> b
$
((String, Int) -> Bool) -> Set (String, Int) -> Set (String, Int)
forall a. (a -> Bool) -> Set a -> Set a
S.filter ((Int, Int) -> (String, Int) -> Bool
candidateEPar (Int
tMin, Int
tMax)) (Set (String, Int) -> Set (String, Int))
-> Set (String, Int) -> Set (String, Int)
forall a b. (a -> b) -> a -> b
$
Path -> Set (String, Int)
forall a. Ord a => [a] -> Set a
S.fromList Path
cmps
runner :: Int -> Int -> IO (Maybe Int)
runner :: Int -> Int -> IO (Maybe Int)
runner Int
timeout' Int
threshold = do
Either String (Path, Int)
res <- RunDataset
run Int
timeout' ((String
v, Int
threshold) (String, Int) -> Path -> Path
forall a. a -> [a] -> [a]
: Path
already_tuned)
case Either String (Path, Int)
res of
Right (Path
_, Int
runTime) ->
Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
runTime
Either String (Path, Int)
_ ->
Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords (String
"Got ePars: " String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int]
ePars)
Int
newMax <- (Int -> Int -> IO (Maybe Int)) -> (Int, Int) -> [Int] -> IO Int
binarySearch Int -> Int -> IO (Maybe Int)
runner (Int
t, Int
tMax) [Int]
ePars
let newMinIdx :: Maybe Int
newMinIdx = Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Int] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Int
newMax [Int]
ePars
let newMin :: Int
newMin = [Int] -> Int
forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
maxinum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ [Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes [Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tMin, Maybe Int
newMinIdx]
(Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
newMin, Int
newMax)
bestPair :: [(Int, Int)] -> (Int, Int)
bestPair :: [(Int, Int)] -> (Int, Int)
bestPair = ((Int, Int) -> (Int, Int) -> Ordering)
-> [(Int, Int)] -> (Int, Int)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Int, Int) -> Int) -> (Int, Int) -> (Int, Int) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, Int) -> Int
forall a b. (a, b) -> a
fst)
timeout :: Int -> Int
timeout :: Int -> Int
timeout Int
elapsed = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
elapsed Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1.2 :: Double) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
candidateEPar :: (Int, Int) -> (String, Int) -> Bool
candidateEPar :: (Int, Int) -> (String, Int) -> Bool
candidateEPar (Int
tMin, Int
tMax) (String
threshold, Int
ePar) =
Int
ePar Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
tMin Bool -> Bool -> Bool
&& Int
ePar Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
tMax Bool -> Bool -> Bool
&& String
threshold String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v
binarySearch :: (Int -> Int -> IO (Maybe Int)) -> (Int, Int) -> [Int] -> IO Int
binarySearch :: (Int -> Int -> IO (Maybe Int)) -> (Int, Int) -> [Int] -> IO Int
binarySearch Int -> Int -> IO (Maybe Int)
runner best :: (Int, Int)
best@(Int
best_t, Int
best_e_par) [Int]
xs =
case Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [Int]
xs of
([Int]
lower, Int
middle : Int
middle' : [Int]
upper) -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Trying e_par", Int -> String
forall a. Show a => a -> String
show Int
middle,
String
"and", Int -> String
forall a. Show a => a -> String
show Int
middle']
Maybe Int
candidate <- Int -> Int -> IO (Maybe Int)
runner (Int -> Int
timeout Int
best_t) Int
middle
Maybe Int
candidate' <- Int -> Int -> IO (Maybe Int)
runner (Int -> Int
timeout Int
best_t) Int
middle'
case (Maybe Int
candidate, Maybe Int
candidate') of
(Just Int
new_t, Just Int
new_t') ->
if Int
new_t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
new_t' then
(Int -> Int -> IO (Maybe Int)) -> (Int, Int) -> [Int] -> IO Int
binarySearch Int -> Int -> IO (Maybe Int)
runner ([(Int, Int)] -> (Int, Int)
bestPair [(Int
new_t, Int
middle), (Int, Int)
best]) [Int]
lower
else
(Int -> Int -> IO (Maybe Int)) -> (Int, Int) -> [Int] -> IO Int
binarySearch Int -> Int -> IO (Maybe Int)
runner ([(Int, Int)] -> (Int, Int)
bestPair [(Int
new_t', Int
middle'), (Int, Int)
best]) [Int]
upper
(Just Int
new_t, Maybe Int
Nothing) ->
(Int -> Int -> IO (Maybe Int)) -> (Int, Int) -> [Int] -> IO Int
binarySearch Int -> Int -> IO (Maybe Int)
runner ([(Int, Int)] -> (Int, Int)
bestPair [(Int
new_t, Int
middle), (Int, Int)
best]) [Int]
lower
(Maybe Int
Nothing, Just Int
new_t') ->
(Int -> Int -> IO (Maybe Int)) -> (Int, Int) -> [Int] -> IO Int
binarySearch Int -> Int -> IO (Maybe Int)
runner ([(Int, Int)] -> (Int, Int)
bestPair [(Int
new_t', Int
middle'), (Int, Int)
best]) [Int]
upper
(Maybe Int
Nothing, Maybe Int
Nothing) -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Timing failed for candidates",
Int -> String
forall a. Show a => a -> String
show Int
middle, String
"and", Int -> String
forall a. Show a => a -> String
show Int
middle']
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
best_e_par
([Int]
_, [Int]
_) -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Trying e_pars", [Int] -> String
forall a. Show a => a -> String
show [Int]
xs]
[(Int, Int)]
candidates <- [Maybe (Int, Int)] -> [(Int, Int)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Int, Int)] -> [(Int, Int)])
-> ([Maybe Int] -> [Maybe (Int, Int)])
-> [Maybe Int]
-> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Maybe Int -> Maybe (Int, Int))
-> [Int] -> [Maybe Int] -> [Maybe (Int, Int)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Int -> (Int, Int)) -> Maybe Int -> Maybe (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> (Int, Int)) -> Maybe Int -> Maybe (Int, Int))
-> (Int -> Int -> (Int, Int))
-> Int
-> Maybe Int
-> Maybe (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> (Int, Int)) -> Int -> Int -> (Int, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)) [Int]
xs ([Maybe Int] -> [(Int, Int)]) -> IO [Maybe Int] -> IO [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Int -> IO (Maybe Int)) -> [Int] -> IO [Maybe Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Int -> IO (Maybe Int)
runner (Int -> Int -> IO (Maybe Int)) -> Int -> Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int
timeout Int
best_t) [Int]
xs
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> (Int, Int)
bestPair ([(Int, Int)] -> (Int, Int)) -> [(Int, Int)] -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ (Int, Int)
best (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)]
candidates
tune :: AutotuneOptions -> FilePath -> IO Path
tune :: AutotuneOptions -> String -> IO Path
tune AutotuneOptions
opts String
prog = do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Compiling " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."
[(String, RunDataset, Text)]
datasets <- AutotuneOptions -> String -> IO [(String, RunDataset, Text)]
prepare AutotuneOptions
opts String
prog
ThresholdForest
forest <- String -> IO ThresholdForest
thresholdForest String
prog
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (String
"Threshold forest:\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Forest String -> String
drawForest (Forest String -> String) -> Forest String -> String
forall a b. (a -> b) -> a -> b
$ (Tree (String, Bool) -> Tree String)
-> ThresholdForest -> Forest String
forall a b. (a -> b) -> [a] -> [b]
map (((String, Bool) -> String) -> Tree (String, Bool) -> Tree String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Bool) -> String
forall a. Show a => a -> String
show) ThresholdForest
forest
(Path -> (String, Path) -> IO Path)
-> Path -> [(String, Path)] -> IO Path
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (AutotuneOptions
-> [(String, RunDataset, Text)]
-> Path
-> (String, Path)
-> IO Path
tuneThreshold AutotuneOptions
opts [(String, RunDataset, Text)]
datasets) [] ([(String, Path)] -> IO Path) -> [(String, Path)] -> IO Path
forall a b. (a -> b) -> a -> b
$ ThresholdForest -> [(String, Path)]
tuningPaths ThresholdForest
forest
runAutotuner :: AutotuneOptions -> FilePath -> IO ()
runAutotuner :: AutotuneOptions -> String -> IO ()
runAutotuner AutotuneOptions
opts String
prog = do
Path
best <- AutotuneOptions -> String -> IO Path
tune AutotuneOptions
opts String
prog
let tuning :: String
tuning = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ do (String
s, Int
n) <- ((String, Int) -> String) -> Path -> Path
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (String, Int) -> String
forall a b. (a, b) -> a
fst Path
best
String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
case AutotuneOptions -> Maybe String
optTuning AutotuneOptions
opts of
Maybe String
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just String
suffix -> do
String -> String -> IO ()
writeFile (String
prog String -> String -> String
<.> String
suffix) String
tuning
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Wrote " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prog String -> String -> String
<.> String
suffix
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Result of autotuning:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tuning
commandLineOptions :: [FunOptDescr AutotuneOptions]
commandLineOptions :: [FunOptDescr AutotuneOptions]
commandLineOptions = [
String
-> [String]
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> FunOptDescr AutotuneOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"r" [String
"runs"]
((String -> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
n ->
case ReadS Int
forall a. Read a => ReadS a
reads String
n of
[(Int
n', String
"")] | Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 ->
(AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. b -> Either a b
Right ((AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> (AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config ->
AutotuneOptions
config { optRuns :: Int
optRuns = Int
n'
}
[(Int, String)]
_ ->
IO () -> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. a -> Either a b
Left (IO () -> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> IO () -> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is not a non-negative integer.")
String
"RUNS")
String
"Run each test case this many times."
, String
-> [String]
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> FunOptDescr AutotuneOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"backend"]
((String -> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
backend -> (AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. b -> Either a b
Right ((AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> (AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config { optBackend :: String
optBackend = String
backend })
String
"BACKEND")
String
"The compiler used (defaults to 'opencl')."
, String
-> [String]
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> FunOptDescr AutotuneOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"futhark"]
((String -> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
prog -> (AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. b -> Either a b
Right ((AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> (AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config { optFuthark :: Maybe String
optFuthark = String -> Maybe String
forall a. a -> Maybe a
Just String
prog })
String
"PROGRAM")
String
"The binary used for operations (defaults to 'futhark')."
, String
-> [String]
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> FunOptDescr AutotuneOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"pass-option"]
((String -> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
opt ->
(AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. b -> Either a b
Right ((AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> (AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config ->
AutotuneOptions
config { optExtraOptions :: [String]
optExtraOptions = String
opt String -> [String] -> [String]
forall a. a -> [a] -> [a]
: AutotuneOptions -> [String]
optExtraOptions AutotuneOptions
config })
String
"OPT")
String
"Pass this option to programs being run."
, String
-> [String]
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> FunOptDescr AutotuneOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"tuning"]
((String -> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s -> (AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. b -> Either a b
Right ((AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> (AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config { optTuning :: Maybe String
optTuning = String -> Maybe String
forall a. a -> Maybe a
Just String
s })
String
"EXTENSION")
String
"Write tuning files with this extension (default: .tuning)."
, String
-> [String]
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> FunOptDescr AutotuneOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"timeout"]
((String -> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
n ->
case ReadS Int
forall a. Read a => ReadS a
reads String
n of
[(Int
n', String
"")] ->
(AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. b -> Either a b
Right ((AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> (AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config { optTimeout :: Int
optTimeout = Int
n' }
[(Int, String)]
_ ->
IO () -> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. a -> Either a b
Left (IO () -> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> IO () -> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is not a non-negative integer.")
String
"SECONDS")
String
"Initial tuning timeout for each dataset. Later tuning runs are based off of the runtime of the first run."
, String
-> [String]
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> String
-> FunOptDescr AutotuneOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"v" [String
"verbose"]
(Either (IO ()) (AutotuneOptions -> AutotuneOptions)
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (AutotuneOptions -> AutotuneOptions)
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions)))
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
-> ArgDescr (Either (IO ()) (AutotuneOptions -> AutotuneOptions))
forall a b. (a -> b) -> a -> b
$ (AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. b -> Either a b
Right ((AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions))
-> (AutotuneOptions -> AutotuneOptions)
-> Either (IO ()) (AutotuneOptions -> AutotuneOptions)
forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config { optVerbose :: Int
optVerbose = AutotuneOptions -> Int
optVerbose AutotuneOptions
config Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 })
String
"Enable logging. Pass multiple times for more."
]
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = AutotuneOptions
-> [FunOptDescr AutotuneOptions]
-> String
-> ([String] -> AutotuneOptions -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions AutotuneOptions
initialAutotuneOptions [FunOptDescr AutotuneOptions]
commandLineOptions
String
"options... program" (([String] -> AutotuneOptions -> Maybe (IO ()))
-> String -> [String] -> IO ())
-> ([String] -> AutotuneOptions -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$
\[String]
progs AutotuneOptions
config ->
case [String]
progs of [String
prog] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ AutotuneOptions -> String -> IO ()
runAutotuner AutotuneOptions
config String
prog
[String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing