<commit_before>{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Simple tool for benchmarking Futhark programs.  Supports raw
-- output if you want to do your own analysis, but will normally print
-- the average runtime.

module Main (main) where

import Control.Monad
import Control.Monad.Except hiding (forM_)
import Data.Maybe
import Data.Monoid
import Data.List
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.Console.GetOpt
import System.FilePath
import System.Directory
import System.IO
import System.IO.Temp
import System.Process.Text (readProcessWithExitCode)
import System.Exit
import qualified Text.JSON as JSON
import Text.Printf

import Futhark.Test
import Futhark.Util.Pretty (prettyText)
import Futhark.Util.Options

import Prelude

data BenchOptions = BenchOptions
                   { optCompiler :: String
                   , optRuns :: Int
                   , optRawReporting :: Bool
                   , optExtraOptions :: [String]
                   , optValidate :: Bool
                   , optJSON :: Maybe FilePath
                   }

initialBenchOptions :: BenchOptions
initialBenchOptions = BenchOptions "futhark-c" 10 False [] True Nothing

-- | The name we use for compiled programs.
binaryName :: FilePath -> FilePath
binaryName = (`replaceExtension` "bin")

data RunResult = RunResult { runMicroseconds :: Int }

data DataResult = DataResult String (Either T.Text [RunResult])
data BenchResult = BenchResult FilePath [DataResult]

resultsToJSON :: [BenchResult] -> JSON.JSValue
resultsToJSON = JSON.JSObject . JSON.toJSObject . map benchResultToJSObject
  where benchResultToJSObject
          :: BenchResult
          -> (String, JSON.JSValue)
        benchResultToJSObject (BenchResult prog rs) =
          (prog, JSON.JSObject $ JSON.toJSObject
                 [("datasets", JSON.JSObject $ JSON.toJSObject $
                               map dataResultToJSObject rs)])
        dataResultToJSObject
          :: DataResult
          -> (String, JSON.JSValue)
        dataResultToJSObject (DataResult desc (Left err)) =
          (desc, JSON.showJSON err)
        dataResultToJSObject (DataResult desc (Right runtimes)) =
          (desc, JSON.JSObject $ JSON.toJSObject
                 [("runtimes", JSON.showJSON $ map runMicroseconds runtimes)])

runBenchmarks :: BenchOptions -> [FilePath] -> IO ()
runBenchmarks opts paths = do
  benchmarks <- testSpecsFromPaths paths
  results <- mapM (uncurry $ runBenchmark opts) benchmarks
  case optJSON opts of
    Nothing -> return ()
    Just file -> writeFile file $ JSON.encode $ resultsToJSON results

runBenchmark :: BenchOptions -> FilePath -> ProgramTest -> IO BenchResult
runBenchmark opts program spec = do
  putStrLn $ program ++ ":"
  case testAction spec of
    RunCases cases -> do
      (futcode, _, futerr) <-
        liftIO $ readProcessWithExitCode compiler
        [program, "-o", binaryName program] ""
      case futcode of
        ExitFailure 127 -> fail $ progNotFound compiler
        ExitFailure _   -> fail $ T.unpack futerr
        ExitSuccess     -> return ()

      BenchResult program . catMaybes <$>
        zipWithM (runBenchmarkCase opts program) [0..] cases
    _ ->
      return $ BenchResult program []
  where compiler = optCompiler opts

reportResult :: Bool -> [RunResult] -> IO ()<commit_msg>Do not benchmark programs tagged with nobench.<commit_after>{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Simple tool for benchmarking Futhark programs.  Supports raw
-- output if you want to do your own analysis, but will normally print
-- the average runtime.

module Main (main) where

import Control.Monad
import Control.Monad.Except hiding (forM_)
import Data.Maybe
import Data.Monoid
import Data.List
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.Console.GetOpt
import System.FilePath
import System.Directory
import System.IO
import System.IO.Temp
import System.Process.Text (readProcessWithExitCode)
import System.Exit
import qualified Text.JSON as JSON
import Text.Printf

import Futhark.Test
import Futhark.Util.Pretty (prettyText)
import Futhark.Util.Options

import Prelude

data BenchOptions = BenchOptions
                   { optCompiler :: String
                   , optRuns :: Int
                   , optRawReporting :: Bool
                   , optExtraOptions :: [String]
                   , optValidate :: Bool
                   , optJSON :: Maybe FilePath
                   }

initialBenchOptions :: BenchOptions
initialBenchOptions = BenchOptions "futhark-c" 10 False [] True Nothing

-- | The name we use for compiled programs.
binaryName :: FilePath -> FilePath
binaryName = (`replaceExtension` "bin")

data RunResult = RunResult { runMicroseconds :: Int }

data DataResult = DataResult String (Either T.Text [RunResult])
data BenchResult = BenchResult FilePath [DataResult]

resultsToJSON :: [BenchResult] -> JSON.JSValue
resultsToJSON = JSON.JSObject . JSON.toJSObject . map benchResultToJSObject
  where benchResultToJSObject
          :: BenchResult
          -> (String, JSON.JSValue)
        benchResultToJSObject (BenchResult prog rs) =
          (prog, JSON.JSObject $ JSON.toJSObject
                 [("datasets", JSON.JSObject $ JSON.toJSObject $
                               map dataResultToJSObject rs)])
        dataResultToJSObject
          :: DataResult
          -> (String, JSON.JSValue)
        dataResultToJSObject (DataResult desc (Left err)) =
          (desc, JSON.showJSON err)
        dataResultToJSObject (DataResult desc (Right runtimes)) =
          (desc, JSON.JSObject $ JSON.toJSObject
                 [("runtimes", JSON.showJSON $ map runMicroseconds runtimes)])

runBenchmarks :: BenchOptions -> [FilePath] -> IO ()
runBenchmarks opts paths = do
  benchmarks <- testSpecsFromPaths paths
  results <- mapM (uncurry $ runBenchmark opts) benchmarks
  case optJSON opts of
    Nothing -> return ()
    Just file -> writeFile file $ JSON.encode $ resultsToJSON results

runBenchmark :: BenchOptions -> FilePath -> ProgramTest -> IO BenchResult
runBenchmark opts program spec = do
  putStrLn $ program ++ ":"
  case testAction spec of
    RunCases cases | "nobench" `notElem` testTags spec -> do
      (futcode, _, futerr) <-
        liftIO $ readProcessWithExitCode compiler
        [program, "-o", binaryName program] ""
      case futcode of
        ExitFailure 127 -> fail $ progNotFound compiler
        ExitFailure _   -> fail $ T.unpack futerr
        ExitSuccess     -> return ()

      BenchResult program . catMaybes <$>
        zipWithM (runBenchmarkCase opts program) [0..] cases
    _ ->
      return $ BenchResult program []
  where compiler = optCompiler opts

reportResult :: Bool -> [RunResult] -> IO ()
{'fraction_non_alphanumeric': 0.08667548112237403, 'fraction_numerical': 0.0017628911414720142, 'mean_word_length': 2.805477920626048, 'pattern_counts': {'":': 2, '<': 11, '<?xml version=': 0, '>': 41, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3701866', 'n_tokens_mistral': 1926, 'n_tokens_neox': 1835, 'n_words': 580}