<commit_before>{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
-- | Simple tool for benchmarking Futhark programs.  Use the @--json@
-- flag for machine-readable output.
module Main (main) where

import Control.Concurrent
import Control.Monad
import Control.Monad.Except
import qualified Data.ByteString.Char8 as SBS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Either
import Data.Maybe
import Data.Semigroup ((<>))
import Data.List
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as T
import System.Console.GetOpt
import System.FilePath
import System.Directory
import System.IO
import System.IO.Temp
import System.Timeout
import System.Process.ByteString (readProcessWithExitCode)
import System.Exit
import qualified Text.JSON as JSON
import Text.Printf
import Text.Regex.TDFA

import Futhark.Test
import Futhark.Util.Options

data BenchOptions = BenchOptions
                   { optCompiler :: String
                   , optRunner :: String
                   , optRuns :: Int
                   , optExtraOptions :: [String]
                   , optJSON :: Maybe FilePath
                   , optTimeout :: Int
                   , optSkipCompilation :: Bool
                   , optExcludeCase :: [String]
                   , optIgnoreFiles :: [Regex]
                   }

initialBenchOptions :: BenchOptions
initialBenchOptions = BenchOptions "futhark-c" "" 10 [] Nothing (-1) False
                      ["nobench", "disable"] []

-- | The name we use for compiled programs.
binaryName :: FilePath -> FilePath
binaryName = dropExtension

newtype RunResult = RunResult { runMicroseconds :: Int }
data DataResult = DataResult String (Either T.Text ([RunResult], T.Text))
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, progerr))) =
          (desc, JSON.JSObject $ JSON.toJSObject
                 [("runtimes", JSON.showJSON $ map runMicroseconds runtimes),
                  ("stderr", JSON.showJSON progerr)])

fork :: (a -> IO b) -> a -> IO (MVar b)
fork f x =
  do
    cell <- newEmptyMVar
    forkIO (do { result <- f x; putMVar cell result })
    return cell

pmapIO :: (a -> IO b) -> [a] -> IO [b]
pmapIO f elems = go elems []
  where<commit_msg>Silence a warning.<commit_after>{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
-- | Simple tool for benchmarking Futhark programs.  Use the @--json@
-- flag for machine-readable output.
module Main (main) where

import Control.Concurrent
import Control.Monad
import Control.Monad.Except
import qualified Data.ByteString.Char8 as SBS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Either
import Data.Maybe
import Data.Semigroup ((<>))
import Data.List
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as T
import System.Console.GetOpt
import System.FilePath
import System.Directory
import System.IO
import System.IO.Temp
import System.Timeout
import System.Process.ByteString (readProcessWithExitCode)
import System.Exit
import qualified Text.JSON as JSON
import Text.Printf
import Text.Regex.TDFA

import Futhark.Test
import Futhark.Util.Options

data BenchOptions = BenchOptions
                   { optCompiler :: String
                   , optRunner :: String
                   , optRuns :: Int
                   , optExtraOptions :: [String]
                   , optJSON :: Maybe FilePath
                   , optTimeout :: Int
                   , optSkipCompilation :: Bool
                   , optExcludeCase :: [String]
                   , optIgnoreFiles :: [Regex]
                   }

initialBenchOptions :: BenchOptions
initialBenchOptions = BenchOptions "futhark-c" "" 10 [] Nothing (-1) False
                      ["nobench", "disable"] []

-- | The name we use for compiled programs.
binaryName :: FilePath -> FilePath
binaryName = dropExtension

newtype RunResult = RunResult { runMicroseconds :: Int }
data DataResult = DataResult String (Either T.Text ([RunResult], T.Text))
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, progerr))) =
          (desc, JSON.JSObject $ JSON.toJSObject
                 [("runtimes", JSON.showJSON $ map runMicroseconds runtimes),
                  ("stderr", JSON.showJSON progerr)])

fork :: (a -> IO b) -> a -> IO (MVar b)
fork f x = do cell <- newEmptyMVar
              void $ forkIO $ do result <- f x
                                 putMVar cell result
              return cell

pmapIO :: (a -> IO b) -> [a] -> IO [b]
pmapIO f elems = go elems []
  where
{'fraction_non_alphanumeric': 0.09561752988047809, 'fraction_numerical': 0.0016600265604249668, 'mean_word_length': 2.4988385598141694, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 3, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1835877', 'n_tokens_mistral': 1726, 'n_tokens_neox': 1645, 'n_words': 498}