-- | @futhark autotune@
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, isPrefixOf, 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.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 System.Process
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,
    AutotuneOptions -> [String]
optExtraOptions :: [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 = [(String, Int)]

regexGroups :: Regex -> String -> Maybe [String]
regexGroups :: Regex -> String -> Maybe [String]
regexGroups Regex
regex String
s = do
  (String
_, String
_, String
_, [String]
groups) <-
    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])
  forall a. a -> Maybe a
Just [String]
groups

comparisons :: String -> [(String, Int)]
comparisons :: String -> [(String, Int)]
comparisons = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b}. Read b => String -> Maybe (String, b)
isComparison forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
  where
    regex :: Regex
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' <- forall a. Read a => String -> Maybe a
readMaybe String
val
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
thresh, b
val')

type RunDataset = Server -> Int -> Path -> IO (Either String ([(String, Int)], Int))

type DatasetName = String

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

setTuningParam :: Server -> String -> Int -> IO ()
setTuningParam :: Server -> String -> Int -> IO ()
setTuningParam Server
server String
name Int
val =
  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 a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Server -> Text -> Text -> IO (Either CmdFailure [Text])
cmdSetTuningParam Server
server (String -> Text
T.pack String
name) (forall a. Show a => a -> Text
showText Int
val)

setTuningParams :: Server -> Path -> IO ()
setTuningParams :: Server -> [(String, 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 -> String -> Int -> IO ()
setTuningParam Server
server)

restoreTuningParams :: AutotuneOptions -> Server -> Path -> IO ()
restoreTuningParams :: AutotuneOptions -> Server -> [(String, 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}. (String, b) -> IO ()
opt
  where
    opt :: (String, b) -> IO ()
opt (String
name, b
_) = Server -> String -> Int -> IO ()
setTuningParam Server
server String
name (AutotuneOptions -> Int
optDefaultThreshold AutotuneOptions
opts)

prepare :: AutotuneOptions -> FutharkExe -> FilePath -> IO [(DatasetName, RunDataset, T.Text)]
prepare :: AutotuneOptions
-> FutharkExe -> String -> IO [(String, 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 (String, 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 -> String
runDescription TestRun
trun,
                    \Server
server -> Server
-> Text
-> TestRun
-> Maybe Success
-> Int
-> [(String, Int)]
-> IO (Either String ([(String, 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 :: [(String, RunDataset)]
cases =
          forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> TestRun -> Maybe (String, 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 [(String, RunDataset)]
cases forall a b. (a -> b) -> a -> b
$ \(String
dataset, RunDataset
do_run) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
dataset, RunDataset
do_run, InputOutputs -> Text
iosEntryPoint InputOutputs
ios)
  where
    run :: Server
-> Text
-> TestRun
-> Maybe Success
-> Int
-> [(String, Int)]
-> IO (Either String ([(String, Int)], Int))
run Server
server Text
entry_point TestRun
trun Maybe Success
expected Int
timeout [(String, Int)]
path = do
      let bestRuntime :: ([RunResult], T.Text) -> ([(String, Int)], Int)
          bestRuntime :: ([RunResult], Text) -> ([(String, Int)], Int)
bestRuntime ([RunResult]
runres, Text
errout) =
            ( String -> [(String, Int)]
comparisons (Text -> String
T.unpack 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 [(String, Int)]
path)

      -- Setting the tuning parameters is a stateful action, so we
      -- must be careful to restore the defaults below.  This is
      -- because we rely on parameters not in 'path' to have their
      -- default value.
      Server -> [(String, Int)] -> IO ()
setTuningParams Server
server [(String, 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) -> ([(String, 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 -> [(String, Int)] -> IO ()
restoreTuningParams AutotuneOptions
opts Server
server [(String, Int)]
path

--- Benchmarking a program

data DatasetResult = DatasetResult [(String, 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)

--- Finding initial comparisons.

--- Extracting threshold hierarchy.

type ThresholdForest = Forest (String, Bool)

thresholdMin, thresholdMax :: Int
thresholdMin :: Int
thresholdMin = Int
1
thresholdMax :: Int
thresholdMax = Int
2000000000

-- | Depth-first list of thresholds to tune in order, and a
-- corresponding assignment of ancestor thresholds to ensure that they
-- are used.
tuningPaths :: ThresholdForest -> [(String, Path)]
tuningPaths :: ThresholdForest -> [(String, [(String, 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

thresholdForest :: FilePath -> IO ThresholdForest
thresholdForest :: String -> IO ThresholdForest
thresholdForest String
prog = do
  [(String, [(String, Bool)])]
thresholds <-
    String -> [(String, [(String, Bool)])]
getThresholds
      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-params"] String
""
  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 [(String, [(String, 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) [(String, [(String, Bool)])]
thresholds
  where
    getThresholds :: String -> [(String, [(String, Bool)])]
getThresholds = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe (String, [(String, Bool)])
findThreshold forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    regex :: Regex
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
_, String
grp2] <- Regex -> String -> Maybe [String]
regexGroups Regex
regex String
l
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( String
grp1,
          forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
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
              ( \String
x ->
                  if String
"!" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x
                    then (forall a. Int -> [a] -> [a]
drop Int
1 String
x, Bool
False)
                    else (String
x, Bool
True)
              )
            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 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)

-- | The performance difference in percentage that triggers a non-monotonicity
-- warning. This is to account for slight variantions in run-time.
epsilon :: Double
epsilon :: Double
epsilon = Double
1.02

--- Doing the atual tuning

tuneThreshold ::
  AutotuneOptions ->
  Server ->
  [(DatasetName, RunDataset, T.Text)] ->
  (Path, M.Map DatasetName Int) ->
  (String, Path) ->
  IO (Path, M.Map DatasetName Int)
tuneThreshold :: AutotuneOptions
-> Server
-> [(String, RunDataset, Text)]
-> ([(String, Int)], Map String Int)
-> (String, [(String, Int)])
-> IO ([(String, Int)], Map String Int)
tuneThreshold AutotuneOptions
opts Server
server [(String, RunDataset, Text)]
datasets ([(String, Int)]
already_tuned, Map String Int
best_runtimes0) (String
v, [(String, Int)]
_v_path) = do
  (Maybe (Int, Int)
tune_result, Map String 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 String Int)
-> (String, RunDataset, Text)
-> IO (Maybe (Int, Int), Map String Int)
tuneDataset (forall a. Maybe a
Nothing, Map String Int
best_runtimes0) [(String, RunDataset, Text)]
datasets
  case Maybe (Int, Int)
tune_result of
    Maybe (Int, Int)
Nothing ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
v, Int
thresholdMin) forall a. a -> [a] -> [a]
: [(String, Int)]
already_tuned, Map String Int
best_runtimes)
    Just (Int
_, Int
threshold) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
v, Int
threshold) forall a. a -> [a] -> [a]
: [(String, Int)]
already_tuned, Map String 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 String Int)
-> (String, RunDataset, Text)
-> IO (Maybe (Int, Int), Map String Int)
tuneDataset (Maybe (Int, Int)
thresholds, Map String Int
best_runtimes) (String
dataset_name, RunDataset
run, Text
entry_point) =
      if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (Text -> String
T.unpack Text
entry_point forall a. [a] -> [a] -> [a]
++ String
".") String
v
        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
$
            String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
              [String] -> String
unwords [String
v, String
"is irrelevant for", Text -> String
T.unpack Text
entry_point]
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Int, Int)
thresholds, Map String Int
best_runtimes)
        else do
          String -> IO ()
putStrLn 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 ([(String, Int)], Int)
sample_run <-
            RunDataset
run
              Server
server
              (AutotuneOptions -> Int
optTimeout AutotuneOptions
opts)
              ((String
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]
: [(String, Int)]
already_tuned)

          case Either String ([(String, Int)], Int)
sample_run of
            Left String
err -> do
              -- If the sampling run fails, we treat it as zero information.
              -- One of our ancestor thresholds will have be set such that
              -- this path is never taken.
              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 String Int
best_runtimes)
            Right ([(String, 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) -> (String, Int) -> Bool
candidateEPar (Int
tMin, Int
tMax)) forall a b. (a -> b) -> a -> b
$
                          forall a. Ord a => [a] -> Set a
S.fromList [(String, Int)]
cmps

                  runner :: Int -> Int -> IO (Maybe Int)
                  runner :: Int -> Int -> IO (Maybe Int)
runner Int
timeout' Int
threshold = do
                    Either String ([(String, Int)], Int)
res <- RunDataset
run Server
server Int
timeout' ((String
v, Int
threshold) forall a. a -> [a] -> [a]
: [(String, Int)]
already_tuned)
                    case Either String ([(String, Int)], Int)
res of
                      Right ([(String, 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 ([(String, 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 String Int
best_runtimes' <-
                case String
dataset_name forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map String 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
                        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
                          [String] -> String
unwords
                            [ String
"WARNING! Possible non-monotonicity detected. Previous best run-time for dataset",
                              String
dataset_name,
                              String
" was",
                              forall a. Show a => a -> String
show Int
rt,
                              String
"but after tuning threshold",
                              String
v,
                              String
"it is",
                              forall a. Show a => a -> String
show Int
best_t
                            ]
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure Map String 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 String
dataset_name Int
best_t Map String Int
best_runtimes
              forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just (Int
newMin, Int
newMax), Map String 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
    -- We wish to let datasets run for the untuned time + 20% + 1 second.
    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) -> (String, Int) -> Bool
    candidateEPar :: (Int, Int) -> (String, Int) -> Bool
candidateEPar (Int
tMin, Int
tMax) (String
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
&& String
threshold forall a. Eq a => a -> a -> Bool
== String
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 -- recurse into lower half
                  (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 -- recurse into upper half
                  (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) ->
              -- recurse into lower half
              (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') ->
              -- recurse into upper half
              (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

--- CLI

tune :: AutotuneOptions -> FilePath -> IO Path
tune :: AutotuneOptions -> String -> IO [(String, 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
"..."
  [(String, RunDataset, Text)]
datasets <- AutotuneOptions
-> FutharkExe -> String -> IO [(String, RunDataset, Text)]
prepare AutotuneOptions
opts FutharkExe
futhark String
prog

  ThresholdForest
forest <- String -> IO ThresholdForest
thresholdForest String
prog
  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
$
          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

  let progbin :: String
progbin = String
"." String -> String -> String
</> String -> String
dropExtension 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)

  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 ->
    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
-> [(String, RunDataset, Text)]
-> ([(String, Int)], Map String Int)
-> (String, [(String, Int)])
-> IO ([(String, Int)], Map String Int)
tuneThreshold AutotuneOptions
opts Server
server [(String, RunDataset, Text)]
datasets) ([], forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$
      ThresholdForest -> [(String, [(String, Int)])]
tuningPaths ThresholdForest
forest

runAutotuner :: AutotuneOptions -> FilePath -> IO ()
runAutotuner :: AutotuneOptions -> String -> IO ()
runAutotuner AutotuneOptions
opts String
prog = do
  [(String, Int)]
best <- AutotuneOptions -> String -> IO [(String, Int)]
tune AutotuneOptions
opts String
prog

  let tuning :: String
tuning = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ do
        (String
s, Int
n) <- forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst [(String, Int)]
best
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
s forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show 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 -> String -> IO ()
writeFile (String
prog String -> String -> String
<.> String
suffix) String
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

  String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Result of autotuning:\n" forall a. [a] -> [a] -> [a]
++ String
tuning

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
$ forall a. HasCallStack => String -> a
error 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 -> forall a b. b -> Either a b
Right 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').",
    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
$ forall a. HasCallStack => String -> a
error 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."
  ]

-- | Run @futhark autotune@
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