module Futhark.CLI.Autotune (main) where
import Control.Monad
import Data.ByteString.Char8 qualified as SBS
import Data.Function (on)
import Data.List (elemIndex, intersect, minimumBy, sort, sortOn)
import Data.Map qualified as M
import Data.Maybe
import Data.Set qualified as S
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Tree
import Futhark.Bench
import Futhark.Server
import Futhark.Test
import Futhark.Util (maxinum, showText)
import Futhark.Util.Options
import System.Directory
import System.Environment (getExecutablePath)
import System.Exit
import System.FilePath
import Text.Read (readMaybe)
import Text.Regex.TDFA
data AutotuneOptions = AutotuneOptions
{ AutotuneOptions -> String
optBackend :: String,
AutotuneOptions -> Maybe String
optFuthark :: Maybe String,
AutotuneOptions -> Int
optMinRuns :: Int,
AutotuneOptions -> Maybe String
optTuning :: Maybe String,
:: [String],
AutotuneOptions -> Int
optVerbose :: Int,
AutotuneOptions -> Int
optTimeout :: Int,
AutotuneOptions -> Bool
optSkipCompilation :: Bool,
AutotuneOptions -> Int
optDefaultThreshold :: Int,
AutotuneOptions -> Maybe String
optTestSpec :: Maybe FilePath
}
initialAutotuneOptions :: AutotuneOptions
initialAutotuneOptions :: AutotuneOptions
initialAutotuneOptions =
AutotuneOptions
{ optBackend :: String
optBackend = String
"opencl",
optFuthark :: Maybe String
optFuthark = forall a. Maybe a
Nothing,
optMinRuns :: Int
optMinRuns = Int
10,
optTuning :: Maybe String
optTuning = forall a. a -> Maybe a
Just String
"tuning",
optExtraOptions :: [String]
optExtraOptions = [],
optVerbose :: Int
optVerbose = Int
0,
optTimeout :: Int
optTimeout = Int
600,
optSkipCompilation :: Bool
optSkipCompilation = Bool
False,
optDefaultThreshold :: Int
optDefaultThreshold = Int
thresholdMax,
optTestSpec :: Maybe String
optTestSpec = forall a. Maybe a
Nothing
}
compileOptions :: AutotuneOptions -> IO CompileOptions
compileOptions :: AutotuneOptions -> IO CompileOptions
compileOptions AutotuneOptions
opts = do
String
futhark <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getExecutablePath forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AutotuneOptions -> Maybe String
optFuthark AutotuneOptions
opts
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
CompileOptions
{ compFuthark :: String
compFuthark = String
futhark,
compBackend :: String
compBackend = AutotuneOptions -> String
optBackend AutotuneOptions
opts,
compOptions :: [String]
compOptions = forall a. Monoid a => a
mempty
}
runOptions :: Int -> AutotuneOptions -> RunOptions
runOptions :: Int -> AutotuneOptions -> RunOptions
runOptions Int
timeout_s AutotuneOptions
opts =
RunOptions
{ runMinRuns :: Int
runMinRuns = AutotuneOptions -> Int
optMinRuns AutotuneOptions
opts,
runMinTime :: NominalDiffTime
runMinTime = NominalDiffTime
0.5,
runTimeout :: Int
runTimeout = Int
timeout_s,
runVerbose :: Int
runVerbose = AutotuneOptions -> Int
optVerbose AutotuneOptions
opts,
runConvergencePhase :: Bool
runConvergencePhase = Bool
True,
runConvergenceMaxTime :: NominalDiffTime
runConvergenceMaxTime = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
timeout_s,
runResultAction :: (Int, Maybe Double) -> IO ()
runResultAction = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
}
type Path = [(T.Text, Int)]
regexGroups :: Regex -> T.Text -> Maybe [T.Text]
regexGroups :: Regex -> Text -> Maybe [Text]
regexGroups Regex
regex Text
s = do
(Text
_, Text
_, Text
_, [Text]
groups) <-
forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM Regex
regex Text
s :: Maybe (T.Text, T.Text, T.Text, [T.Text])
forall a. a -> Maybe a
Just [Text]
groups
comparisons :: T.Text -> [(T.Text, Int)]
comparisons :: Text -> [(Text, Int)]
comparisons = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b}. Read b => Text -> Maybe (Text, b)
isComparison forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
where
regex :: Regex
regex = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex (String
"Compared ([^ ]+) <= (-?[0-9]+)" :: String)
isComparison :: Text -> Maybe (Text, b)
isComparison Text
l = do
[Text
thresh, Text
val] <- Regex -> Text -> Maybe [Text]
regexGroups Regex
regex Text
l
b
val' <- forall a. Read a => String -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
val
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
thresh, b
val')
type RunDataset = Server -> Int -> Path -> IO (Either String ([(T.Text, Int)], Int))
type DatasetName = T.Text
serverOptions :: AutotuneOptions -> [String]
serverOptions :: AutotuneOptions -> [String]
serverOptions AutotuneOptions
opts =
String
"--default-threshold"
forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (AutotuneOptions -> Int
optDefaultThreshold AutotuneOptions
opts)
forall a. a -> [a] -> [a]
: String
"-L"
forall a. a -> [a] -> [a]
: AutotuneOptions -> [String]
optExtraOptions AutotuneOptions
opts
checkCmd :: Either CmdFailure a -> IO a
checkCmd :: forall a. Either CmdFailure a -> IO a
checkCmd = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmdFailure -> [Text]
failureMsg) forall (f :: * -> *) a. Applicative f => a -> f a
pure
setTuningParam :: Server -> T.Text -> Int -> IO ()
setTuningParam :: Server -> Text -> Int -> IO ()
setTuningParam Server
server Text
name Int
val =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Either CmdFailure a -> IO a
checkCmd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Server -> Text -> Text -> IO (Either CmdFailure [Text])
cmdSetTuningParam Server
server Text
name (forall a. Show a => a -> Text
showText Int
val)
setTuningParams :: Server -> Path -> IO ()
setTuningParams :: Server -> [(Text, Int)] -> IO ()
setTuningParams Server
server = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ Server -> Text -> Int -> IO ()
setTuningParam Server
server)
restoreTuningParams :: AutotuneOptions -> Server -> Path -> IO ()
restoreTuningParams :: AutotuneOptions -> Server -> [(Text, Int)] -> IO ()
restoreTuningParams AutotuneOptions
opts Server
server = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {b}. (Text, b) -> IO ()
opt
where
opt :: (Text, b) -> IO ()
opt (Text
name, b
_) = Server -> Text -> Int -> IO ()
setTuningParam Server
server Text
name (AutotuneOptions -> Int
optDefaultThreshold AutotuneOptions
opts)
prepare :: AutotuneOptions -> FutharkExe -> FilePath -> IO [(DatasetName, RunDataset, T.Text)]
prepare :: AutotuneOptions
-> FutharkExe -> String -> IO [(Text, RunDataset, Text)]
prepare AutotuneOptions
opts FutharkExe
futhark String
prog = do
ProgramTest
spec <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO ProgramTest
testSpecFromProgramOrDie String
prog) String -> IO ProgramTest
testSpecFromFileOrDie forall a b. (a -> b) -> a -> b
$
AutotuneOptions -> Maybe String
optTestSpec AutotuneOptions
opts
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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InputOutputs]
ios -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
[String] -> String
unwords (String
"Entry points:" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOutputs -> Text
iosEntryPoint) [InputOutputs]
ios)
if AutotuneOptions -> Bool
optSkipCompilation AutotuneOptions
opts
then do
Bool
exists <- String -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ String -> String
binaryName String
prog
if Bool
exists
then forall (f :: * -> *) a. Applicative f => a -> f a
pure [InputOutputs]
ios
else do
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String -> String
binaryName String
prog forall a. [a] -> [a] -> [a]
++ String
" does not exist, but --skip-compilation passed."
forall a. IO a
exitFailure
else do
Either (String, Maybe ByteString) ()
res <- forall (m :: * -> *).
MonadIO m =>
Maybe Int
-> CompileOptions
-> String
-> [InputOutputs]
-> m (Either (String, Maybe ByteString) ())
prepareBenchmarkProgram 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
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ByteString -> IO ()
SBS.putStrLn Maybe ByteString
errstr
forall a. IO a
exitFailure
Right () ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure [InputOutputs]
ios
TestAction
_ ->
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unsupported test spec."
let runnableDataset :: Text -> TestRun -> Maybe (Text, RunDataset)
runnableDataset Text
entry_point TestRun
trun =
case TestRun -> ExpectedResult Success
runExpectedResult TestRun
trun of
Succeeds Maybe Success
expected
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TestRun -> [String]
runTags TestRun
trun forall a. Eq a => [a] -> [a] -> [a]
`intersect` [String
"notune", String
"disable"]) ->
forall a. a -> Maybe a
Just
( TestRun -> Text
runDescription TestRun
trun,
\Server
server -> Server
-> Text
-> TestRun
-> Maybe Success
-> Int
-> [(Text, Int)]
-> IO (Either String ([(Text, Int)], Int))
run Server
server Text
entry_point TestRun
trun Maybe Success
expected
)
ExpectedResult Success
_ -> forall a. Maybe a
Nothing
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [InputOutputs]
truns forall a b. (a -> b) -> a -> b
$ \InputOutputs
ios -> do
let cases :: [(Text, RunDataset)]
cases =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> TestRun -> Maybe (Text, RunDataset)
runnableDataset forall a b. (a -> b) -> a -> b
$ InputOutputs -> Text
iosEntryPoint InputOutputs
ios) (InputOutputs -> [TestRun]
iosTestRuns InputOutputs
ios)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, RunDataset)]
cases forall a b. (a -> b) -> a -> b
$ \(Text
dataset, RunDataset
do_run) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
dataset, RunDataset
do_run, InputOutputs -> Text
iosEntryPoint InputOutputs
ios)
where
run :: Server
-> Text
-> TestRun
-> Maybe Success
-> Int
-> [(Text, Int)]
-> IO (Either String ([(Text, Int)], Int))
run Server
server Text
entry_point TestRun
trun Maybe Success
expected Int
timeout [(Text, Int)]
path = do
let bestRuntime :: ([RunResult], T.Text) -> ([(T.Text, Int)], Int)
bestRuntime :: ([RunResult], Text) -> ([(Text, Int)], Int)
bestRuntime ([RunResult]
runres, Text
errout) =
( Text -> [(Text, Int)]
comparisons Text
errout,
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map RunResult -> Int
runMicroseconds [RunResult]
runres
)
ropts :: RunOptions
ropts = Int -> AutotuneOptions -> RunOptions
runOptions Int
timeout AutotuneOptions
opts
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn (String
"Trying path: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [(Text, Int)]
path)
Server -> [(Text, Int)] -> IO ()
setTuningParams Server
server [(Text, Int)]
path
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RunResult], Text) -> ([(Text, Int)], Int)
bestRuntime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Server
-> RunOptions
-> FutharkExe
-> String
-> Text
-> Values
-> Maybe Success
-> String
-> IO (Either Text ([RunResult], Text))
benchmarkDataset
Server
server
RunOptions
ropts
FutharkExe
futhark
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)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* AutotuneOptions -> Server -> [(Text, Int)] -> IO ()
restoreTuningParams AutotuneOptions
opts Server
server [(Text, Int)]
path
data DatasetResult = DatasetResult [(T.Text, Int)] Double
deriving (Int -> DatasetResult -> String -> String
[DatasetResult] -> String -> String
DatasetResult -> String
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 (T.Text, Bool)
thresholdMin, thresholdMax :: Int
thresholdMin :: Int
thresholdMin = Int
1
thresholdMax :: Int
thresholdMax = Int
2000000000
tuningPaths :: ThresholdForest -> [(T.Text, Path)]
tuningPaths :: ThresholdForest -> [(Text, [(Text, Int)])]
tuningPaths = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (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
_) [Tree (a, Bool)]
children) =
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) [Tree (a, Bool)]
children 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) [Tree (a, Bool)]
_) =
[(a, Int)] -> Tree (a, Bool) -> [(a, [(a, Int)])]
treePaths ([(a, Int)]
ancestors 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
allTuningParams :: Server -> IO [(T.Text, T.Text)]
allTuningParams :: Server -> IO [(Text, Text)]
allTuningParams Server
server = do
[Text]
entry_points <- forall a. Either CmdFailure a -> IO a
checkCmd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Server -> IO (Either CmdFailure [Text])
cmdEntryPoints Server
server
[Text]
param_names <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Either CmdFailure a -> IO a
checkCmd forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Server -> Text -> IO (Either CmdFailure [Text])
cmdTuningParams Server
server) [Text]
entry_points
[Text]
param_classes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Either CmdFailure a -> IO a
checkCmd forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Server -> Text -> IO (Either CmdFailure Text)
cmdTuningParamClass Server
server) [Text]
param_names
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
param_names [Text]
param_classes
thresholdForest :: Server -> IO ThresholdForest
thresholdForest :: Server -> IO ThresholdForest
thresholdForest Server
server = do
[(Text, [(Text, Bool)])]
thresholds <- forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, Text) -> Maybe (Text, [(Text, Bool)])
findThreshold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Server -> IO [(Text, Text)]
allTuningParams Server
server
let root :: (a, b) -> ((a, Bool), [a])
root (a
v, b
_) = ((a
v, Bool
False), [])
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall b a. (b -> (a, [b])) -> [b] -> [Tree a]
unfoldForest (forall {a} {a} {b} {b}.
Ord a =>
[(a, [(a, b)])] -> ((a, b), [a]) -> ((a, b), [((a, b), [a])])
unfold [(Text, [(Text, Bool)])]
thresholds) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {a}. (a, b) -> ((a, Bool), [a])
root forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Text, [(Text, Bool)])]
thresholds
where
regex :: Regex
regex = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex (Text
"threshold\\(([^ ]+,)(.*)\\)" :: T.Text)
findThreshold :: (T.Text, T.Text) -> Maybe (T.Text, [(T.Text, Bool)])
findThreshold :: (Text, Text) -> Maybe (Text, [(Text, Bool)])
findThreshold (Text
name, Text
param_class) = do
[Text
_, Text
grp] <- Regex -> Text -> Maybe [Text]
regexGroups Regex
regex Text
param_class
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Text
name,
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map
( \Text
x ->
if Text
"!" Text -> Text -> Bool
`T.isPrefixOf` Text
x
then (Int -> Text -> Text
T.drop Int
1 Text
x, Bool
False)
else (Text
x, Bool
True)
)
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
grp
)
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 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 <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
parent [(a, b)]
v_ancestors
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$
forall a. Ord a => [a] -> [a]
sort (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(a, b)]
v_ancestors)
forall a. Eq a => a -> a -> Bool
== forall a. Ord a => [a] -> [a]
sort (a
parent forall a. a -> [a] -> [a]
: [a]
ancestors)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a
v, b
cmp), [a]
ancestors')
in ((a
parent, b
parent_cmp), forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {b}. (a, [(a, b)]) -> Maybe ((a, b), [a])
isChild [(a, [(a, b)])]
thresholds)
epsilon :: Double
epsilon :: Double
epsilon = Double
1.02
tuneThreshold ::
AutotuneOptions ->
Server ->
[(DatasetName, RunDataset, T.Text)] ->
(Path, M.Map DatasetName Int) ->
(T.Text, Path) ->
IO (Path, M.Map DatasetName Int)
tuneThreshold :: AutotuneOptions
-> Server
-> [(Text, RunDataset, Text)]
-> ([(Text, Int)], Map Text Int)
-> (Text, [(Text, Int)])
-> IO ([(Text, Int)], Map Text Int)
tuneThreshold AutotuneOptions
opts Server
server [(Text, RunDataset, Text)]
datasets ([(Text, Int)]
already_tuned, Map Text Int
best_runtimes0) (Text
v, [(Text, Int)]
_v_path) = do
(Maybe (Int, Int)
tune_result, Map Text Int
best_runtimes) <-
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Maybe (Int, Int), Map Text Int)
-> (Text, RunDataset, Text) -> IO (Maybe (Int, Int), Map Text Int)
tuneDataset (forall a. Maybe a
Nothing, Map Text Int
best_runtimes0) [(Text, RunDataset, Text)]
datasets
case Maybe (Int, Int)
tune_result of
Maybe (Int, Int)
Nothing ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text
v, Int
thresholdMin) forall a. a -> [a] -> [a]
: [(Text, Int)]
already_tuned, Map Text Int
best_runtimes)
Just (Int
_, Int
threshold) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text
v, Int
threshold) forall a. a -> [a] -> [a]
: [(Text, Int)]
already_tuned, Map Text Int
best_runtimes)
where
tuneDataset ::
(Maybe (Int, Int), M.Map DatasetName Int) ->
(DatasetName, RunDataset, T.Text) ->
IO (Maybe (Int, Int), M.Map DatasetName Int)
tuneDataset :: (Maybe (Int, Int), Map Text Int)
-> (Text, RunDataset, Text) -> IO (Maybe (Int, Int), Map Text Int)
tuneDataset (Maybe (Int, Int)
thresholds, Map Text Int
best_runtimes) (Text
dataset_name, RunDataset
run, Text
entry_point) = do
[Text]
relevant <- forall a. Either CmdFailure a -> IO a
checkCmd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Server -> Text -> IO (Either CmdFailure [Text])
cmdTuningParams Server
server Text
entry_point
if Text
v forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
relevant
then do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.unwords [Text
v, Text
"is irrelevant for", Text
entry_point]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Int, Int)
thresholds, Map Text Int
best_runtimes)
else do
Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.unwords
[ Text
"Tuning",
Text
v,
Text
"on entry point",
Text
entry_point,
Text
"and dataset",
Text
dataset_name
]
Either String ([(Text, Int)], Int)
sample_run <-
RunDataset
run
Server
server
(AutotuneOptions -> Int
optTimeout AutotuneOptions
opts)
((Text
v, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
thresholdMax forall a b. (a, b) -> b
snd Maybe (Int, Int)
thresholds) forall a. a -> [a] -> [a]
: [(Text, Int)]
already_tuned)
case Either String ([(Text, Int)], Int)
sample_run of
Left String
err -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
String
"Sampling run failed:\n" forall a. [a] -> [a] -> [a]
++ String
err
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Int, Int)
thresholds, Map Text Int
best_runtimes)
Right ([(Text, Int)]
cmps, Int
t) -> do
let (Int
tMin, Int
tMax) = forall a. a -> Maybe a -> a
fromMaybe (Int
thresholdMin, Int
thresholdMax) Maybe (Int, Int)
thresholds
let ePars :: [Int]
ePars =
forall a. Set a -> [a]
S.toAscList forall a b. (a -> b) -> a -> b
$
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> Set a -> Set a
S.filter ((Int, Int) -> (Text, Int) -> Bool
candidateEPar (Int
tMin, Int
tMax)) forall a b. (a -> b) -> a -> b
$
forall a. Ord a => [a] -> Set a
S.fromList [(Text, Int)]
cmps
runner :: Int -> Int -> IO (Maybe Int)
runner :: Int -> Int -> IO (Maybe Int)
runner Int
timeout' Int
threshold = do
Either String ([(Text, Int)], Int)
res <- RunDataset
run Server
server Int
timeout' ((Text
v, Int
threshold) forall a. a -> [a] -> [a]
: [(Text, Int)]
already_tuned)
case Either String ([(Text, Int)], Int)
res of
Right ([(Text, Int)]
_, Int
runTime) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int
runTime
Either String ([(Text, Int)], Int)
_ ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
[String] -> String
unwords (String
"Got ePars: " forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Int]
ePars)
(Int
best_t, Int
newMax) <- (Int -> Int -> IO (Maybe Int))
-> (Int, Int) -> [Int] -> IO (Int, Int)
binarySearch Int -> Int -> IO (Maybe Int)
runner (Int
t, Int
tMax) [Int]
ePars
let newMinIdx :: Maybe Int
newMinIdx = do
Int
i <- forall a. Enum a => a -> a
pred forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Int
newMax [Int]
ePars
if Int
i forall a. Ord a => a -> a -> Bool
< Int
0 then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid lower index" else forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
let newMin :: Int
newMin = forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
maxinum forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [forall a. a -> Maybe a
Just Int
tMin, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Int]
ePars !!) Maybe Int
newMinIdx]
Map Text Int
best_runtimes' <-
case Text
dataset_name forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Text Int
best_runtimes of
Just Int
rt
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rt forall a. Num a => a -> a -> a
* Double
epsilon forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
best_t -> do
Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.unwords
[ Text
"WARNING! Possible non-monotonicity detected. Previous best run-time for dataset",
Text
dataset_name,
Text
" was",
forall a. Show a => a -> Text
showText Int
rt,
Text
"but after tuning threshold",
Text
v,
Text
"it is",
forall a. Show a => a -> Text
showText Int
best_t
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Int
best_runtimes
Maybe Int
_ ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Ord a => a -> a -> a
min Text
dataset_name Int
best_t Map Text Int
best_runtimes
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just (Int
newMin, Int
newMax), Map Text Int
best_runtimes')
bestPair :: [(Int, Int)] -> (Int, Int)
bestPair :: [(Int, Int)] -> (Int, Int)
bestPair = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
timeout :: Int -> Int
timeout :: Int -> Int
timeout Int
elapsed = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
elapsed forall a. Num a => a -> a -> a
* Double
1.2 :: Double) forall a. Num a => a -> a -> a
+ Int
1
candidateEPar :: (Int, Int) -> (T.Text, Int) -> Bool
candidateEPar :: (Int, Int) -> (Text, Int) -> Bool
candidateEPar (Int
tMin, Int
tMax) (Text
threshold, Int
ePar) =
Int
ePar forall a. Ord a => a -> a -> Bool
> Int
tMin Bool -> Bool -> Bool
&& Int
ePar forall a. Ord a => a -> a -> Bool
< Int
tMax Bool -> Bool -> Bool
&& Text
threshold forall a. Eq a => a -> a -> Bool
== Text
v
binarySearch :: (Int -> Int -> IO (Maybe Int)) -> (Int, Int) -> [Int] -> IO (Int, Int)
binarySearch :: (Int -> Int -> IO (Maybe Int))
-> (Int, Int) -> [Int] -> IO (Int, Int)
binarySearch Int -> Int -> IO (Maybe Int)
runner best :: (Int, Int)
best@(Int
best_t, Int
best_e_par) [Int]
xs =
case forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs forall a. Integral a => a -> a -> a
`div` Int
2) [Int]
xs of
([Int]
lower, Int
middle : Int
middle' : [Int]
upper) -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
[String] -> String
unwords
[ String
"Trying e_par",
forall a. Show a => a -> String
show Int
middle,
String
"and",
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 forall a. Ord a => a -> a -> Bool
< Int
new_t'
then
(Int -> Int -> IO (Maybe Int))
-> (Int, Int) -> [Int] -> IO (Int, 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, 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, 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, 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts forall a. Ord a => a -> a -> Bool
> Int
2) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
[String] -> String
unwords
[ String
"Timing failed for candidates",
forall a. Show a => a -> String
show Int
middle,
String
"and",
forall a. Show a => a -> String
show Int
middle'
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
best_t, Int
best_e_par)
([Int]
_, [Int]
_) -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
[String] -> String
unwords [String
"Trying e_pars", forall a. Show a => a -> String
show [Int]
xs]
[(Int, Int)]
candidates <-
forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)) [Int]
xs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Int -> IO (Maybe Int)
runner forall a b. (a -> b) -> a -> b
$ Int -> Int
timeout Int
best_t) [Int]
xs
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> (Int, Int)
bestPair forall a b. (a -> b) -> a -> b
$ (Int, Int)
best forall a. a -> [a] -> [a]
: [(Int, Int)]
candidates
tune :: AutotuneOptions -> FilePath -> IO Path
tune :: AutotuneOptions -> String -> IO [(Text, Int)]
tune AutotuneOptions
opts String
prog = do
FutharkExe
futhark <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> FutharkExe
FutharkExe forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getExecutablePath forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AutotuneOptions -> Maybe String
optFuthark AutotuneOptions
opts
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Compiling " forall a. [a] -> [a] -> [a]
++ String
prog forall a. [a] -> [a] -> [a]
++ String
"..."
[(Text, RunDataset, Text)]
datasets <- AutotuneOptions
-> FutharkExe -> String -> IO [(Text, RunDataset, Text)]
prepare AutotuneOptions
opts FutharkExe
futhark String
prog
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Running with options: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (AutotuneOptions -> [String]
serverOptions AutotuneOptions
opts)
let progbin :: String
progbin = String
"." String -> String -> String
</> String -> String
dropExtension String
prog
forall a. ServerCfg -> (Server -> IO a) -> IO a
withServer (String -> [String] -> ServerCfg
futharkServerCfg String
progbin (AutotuneOptions -> [String]
serverOptions AutotuneOptions
opts)) forall a b. (a -> b) -> a -> b
$ \Server
server -> do
ThresholdForest
forest <- Server -> IO ThresholdForest
thresholdForest Server
server
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AutotuneOptions -> Int
optVerbose AutotuneOptions
opts forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
(String
"Threshold forest:\n" <>) forall a b. (a -> b) -> a -> b
$
[Tree String] -> String
drawForest (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> String
show) ThresholdForest
forest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (AutotuneOptions
-> Server
-> [(Text, RunDataset, Text)]
-> ([(Text, Int)], Map Text Int)
-> (Text, [(Text, Int)])
-> IO ([(Text, Int)], Map Text Int)
tuneThreshold AutotuneOptions
opts Server
server [(Text, RunDataset, Text)]
datasets) ([], forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$
ThresholdForest -> [(Text, [(Text, Int)])]
tuningPaths ThresholdForest
forest
runAutotuner :: AutotuneOptions -> FilePath -> IO ()
runAutotuner :: AutotuneOptions -> String -> IO ()
runAutotuner AutotuneOptions
opts String
prog = do
[(Text, Int)]
best <- AutotuneOptions -> String -> IO [(Text, Int)]
tune AutotuneOptions
opts String
prog
let tuning :: Text
tuning = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ do
(Text
s, Int
n) <- forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst [(Text, Int)]
best
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text
s forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showText Int
n
case AutotuneOptions -> Maybe String
optTuning AutotuneOptions
opts of
Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just String
suffix -> do
String -> Text -> IO ()
T.writeFile (String
prog String -> String -> String
<.> String
suffix) Text
tuning
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Wrote " forall a. [a] -> [a] -> [a]
++ String
prog String -> String -> String
<.> String
suffix
Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"Result of autotuning:\n" forall a. Semigroup a => a -> a -> a
<> Text
tuning
supportedBackends :: [String]
supportedBackends :: [String]
supportedBackends = [String
"opencl", String
"cuda"]
commandLineOptions :: [FunOptDescr AutotuneOptions]
commandLineOptions :: [FunOptDescr AutotuneOptions]
commandLineOptions =
[ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
String
"r"
[String
"runs"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
n ->
case forall a. Read a => ReadS a
reads String
n of
[(Int
n', String
"")] | Int
n' forall a. Ord a => a -> a -> Bool
>= Int
0 ->
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config {optMinRuns :: Int
optMinRuns = Int
n'}
[(Int, String)]
_ ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> IO ()
optionsError forall a b. (a -> b) -> a -> b
$ String
"'" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"' is not a non-negative integer."
)
String
"RUNS"
)
String
"Run each test case this many times.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"backend"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
backend ->
if String
backend forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
supportedBackends
then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config {optBackend :: String
optBackend = String
backend}
else forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> IO ()
optionsError forall a b. (a -> b) -> a -> b
$ String
"autotuning is only supported for these backends: " forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords [String]
supportedBackends
)
String
"BACKEND"
)
String
"The backend used (defaults to 'opencl').",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"futhark"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\String
prog -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config {optFuthark :: Maybe String
optFuthark = forall a. a -> Maybe a
Just String
prog})
String
"PROGRAM"
)
String
"The binary used for operations (defaults to 'futhark').",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"pass-option"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
opt ->
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config ->
AutotuneOptions
config {optExtraOptions :: [String]
optExtraOptions = String
opt forall a. a -> [a] -> [a]
: AutotuneOptions -> [String]
optExtraOptions AutotuneOptions
config}
)
String
"OPT"
)
String
"Pass this option to programs being run.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"tuning"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\String
s -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config {optTuning :: Maybe String
optTuning = forall a. a -> Maybe a
Just String
s})
String
"EXTENSION"
)
String
"Write tuning files with this extension (default: .tuning).",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"timeout"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
n ->
case forall a. Read a => ReadS a
reads String
n of
[(Int
n', String
"")] ->
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config {optTimeout :: Int
optTimeout = Int
n'}
[(Int, String)]
_ ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> IO ()
optionsError forall a b. (a -> b) -> a -> b
$ String
"'" forall a. [a] -> [a] -> [a]
++ String
n 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.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"skip-compilation"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config {optSkipCompilation :: Bool
optSkipCompilation = Bool
True})
String
"Use already compiled program.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
String
"v"
[String
"verbose"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config {optVerbose :: Int
optVerbose = AutotuneOptions -> Int
optVerbose AutotuneOptions
config forall a. Num a => a -> a -> a
+ Int
1})
String
"Enable logging. Pass multiple times for more.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"spec-file"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \AutotuneOptions
config -> AutotuneOptions
config {optTestSpec :: Maybe String
optTestSpec = forall a. a -> Maybe a
Just String
s}) String
"FILE")
String
"Use test specification from this file."
]
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions AutotuneOptions
initialAutotuneOptions [FunOptDescr AutotuneOptions]
commandLineOptions String
"options... program" forall a b. (a -> b) -> a -> b
$ \[String]
progs AutotuneOptions
config ->
case [String]
progs of
[String
prog] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AutotuneOptions -> String -> IO ()
runAutotuner AutotuneOptions
config String
prog
[String]
_ -> forall a. Maybe a
Nothing