Benchmark for generating Core directly when deriving Generic.

Main.hs

#!/usr/bin/env cabal
{- cabal:
build-depends: base, directory, process
ghc-options: -Wall
-}

-- https://gitlab.haskell.org/ghc/ghc/-/issues/27130

import qualified Control.Exception as Exception
import qualified Control.Monad as Monad
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified System.Directory as Directory
import qualified System.Exit as Exit
import qualified System.IO as IO
import qualified System.Process as Process
import qualified Text.Printf as Printf
import qualified Text.Read as Read

main :: IO ()
main = do
  putStrLn "Size,Optimization Level,Is Direct,Pass,Time (ms),Allocations (mb)"
  Monad.forM_ [0 .. 10] $ \ p -> do
    Monad.forM_ [0 .. 2] $ \ o -> do
      Monad.forM_ [False, True] $ \ b -> do
        withTemporaryFile "M.hs" $ \ f h -> do
          let n = 2 ^ (p :: Word)
          IO.hPutStr h $ generateModule n
          IO.hClose h
          (exitCode, stdout, stderr) <- Process.readProcessWithExitCode "_build/stage1/bin/ghc"
            [ "-dshow-passes"
            , "-fforce-recomp"
            , "-O" <> show (o :: Word)
            , f
            , "-f" <> (if b then "" else "no-") <> "direct-core-generic-deriving"
            ] ""
          Monad.when (exitCode /= Exit.ExitSuccess) . fail $ show (stdout, stderr)
          mapM_ (\ (ps, (ms, mb)) -> Printf.printf "%d,%d,%s,%s,%.1f,%.1f\n" n o (if b then "true" else "false") ps ms mb)
            . Maybe.mapMaybe parseLine
            $ lines stderr

withTemporaryFile :: String -> (FilePath -> IO.Handle -> IO a) -> IO a
withTemporaryFile s = Exception.bracket
  (do
    d <- Directory.getTemporaryDirectory
    IO.openTempFile d s)
  (\ (f, h) -> do
    IO.hClose h
    Directory.removeFile f)
  . uncurry

generateModule :: Word -> String
generateModule n = unlines
  [ "{-# language DeriveGeneric #-}"
  , "module M where"
  , "import GHC.Generics"
  , generateSum n
  , "  deriving Generic"
  ]

generateSum :: Word -> String
generateSum n =
  let p = 'S' : show n
  in "data "
    <> p
    <> "T"
    <> " = "
    <> List.intercalate " | " (fmap (\ i -> p <> "C" <> show i) [ 1 .. n ])

parseLine :: String -> Maybe (String, (Double, Double))
parseLine line = do
  (ps, rest) <- break (== ':') <$> List.stripPrefix "!!! " line
  (ms, mb) <- case words rest of
    [_, _, _, x, "milliseconds,", _, y, "megabytes"] ->
      (,) <$> Read.readMaybe x <*> Read.readMaybe y
    _ -> fail "no parse"
  pure (ps, (ms, mb))

results.csv