module Language.Futhark.ParserBenchmarks (benchmarks) where

import Criterion (Benchmark, bench, bgroup, whnf)
import Data.Either (fromRight)
import Data.Text qualified as T
import Futhark.Util (showText)
import Language.Futhark.Parser (parseExp)

bigArray :: Int -> T.Text
bigArray :: Int -> Text
bigArray Int
n = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"i32") (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. Show a => a -> Text
showText) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

benchmarks :: Benchmark
benchmarks :: Benchmark
benchmarks =
  String -> [Benchmark] -> Benchmark
bgroup
    String
"Language.Futhark.Parser"
    [ Int -> Benchmark
benchIntArray Int
10000,
      Int -> Benchmark
benchIntArray Int
100000,
      Int -> Benchmark
benchIntArray Int
1000000
    ]
  where
    benchIntArray :: Int -> Benchmark
benchIntArray Int
n =
      String -> Benchmarkable -> Benchmark
bench (String
"[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]i32") (Benchmarkable -> Benchmark) -> Benchmarkable -> Benchmark
forall a b. (a -> b) -> a -> b
$
        (Text -> UncheckedExp) -> Text -> Benchmarkable
forall a b. (a -> b) -> a -> Benchmarkable
whnf (UncheckedExp -> Either SyntaxError UncheckedExp -> UncheckedExp
forall b a. b -> Either a b -> b
fromRight (String -> UncheckedExp
forall a. HasCallStack => String -> a
error String
"parse error") (Either SyntaxError UncheckedExp -> UncheckedExp)
-> (Text -> Either SyntaxError UncheckedExp)
-> Text
-> UncheckedExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Either SyntaxError UncheckedExp
parseExp String
"") (Int -> Text
bigArray Int
n)