MicroBenchmark for HLS

Main.hs

#!/usr/bin/env cabal
{- cabal:
build-depends:
  base       >= 4.7 && < 5,
  criterion  >= 1.6 && < 2,
  containers >= 0.6 && < 1,
  vector     >= 0.12 && < 1
-}
-- Run with: cabal run bench.hs
-- (no project setup needed — cabal script handles everything)

module Main (main) where

import Criterion.Main
import qualified Data.Set as Set
import qualified Data.Vector as Vector

-- | Configurable base extensions and boot suffix.
baseExts :: [String]
baseExts = [".hs", ".lhs"]

bootSuffix :: String
bootSuffix = "-boot"

-- | The canonical 4-element collection, derived from the config above.
extensions :: [String]
extensions = baseExts ++ map (++ bootSuffix) baseExts
-- => [".hs", ".lhs", ".hs-boot", ".lhs-boot"]

-- --------------------------------------------------------------------------
-- Representations built once and shared across benchmark runs.
-- --------------------------------------------------------------------------

extList :: [String]
extList = extensions

extSet :: Set.Set String
extSet = Set.fromList extensions

extVec :: Vector.Vector String
extVec = Vector.fromList extensions

-- --------------------------------------------------------------------------
-- Membership predicates
-- --------------------------------------------------------------------------

memberList :: String -> Bool
memberList x = x `elem` extList

memberSet :: String -> Bool
memberSet x = x `Set.member` extSet

memberVec :: String -> Bool
memberVec x = x `Vector.elem` extVec

-- --------------------------------------------------------------------------
-- Probe values: mix of hits and misses so neither branch is dead code.
-- --------------------------------------------------------------------------

probes :: [String]
probes =
  [ ".hs"        -- hit  (first)
  , ".lhs"       -- hit  (second)
  , ".hs-boot"   -- hit  (third)
  , ".lhs-boot"  -- hit  (fourth / last)
  , ".c"         -- miss
  , ".js"        -- miss
  , ".py"        -- miss
  ]

-- | Force all membership checks so the optimiser cannot drop them.
checkAll :: (String -> Bool) -> Bool
checkAll f = all f (take 4 probes) && not (any f (drop 4 probes))
--                  ^^^^^^^^^^^^ 4 hits          ^^^^^^^^^^^^^^^ 3 misses

-- --------------------------------------------------------------------------
-- Main
-- --------------------------------------------------------------------------

main :: IO ()
main = defaultMain
  [ bgroup "membership / 4-element collection"
      [ bgroup "list"
          [ bench "hit  first  (.hs)"      $ whnf memberList ".hs"
          , bench "hit  last   (.lhs-boot)"$ whnf memberList ".lhs-boot"
          , bench "miss        (.py)"      $ whnf memberList ".py"
          , bench "all probes"             $ whnf checkAll   memberList
          ]
      , bgroup "Set"
          [ bench "hit  first  (.hs)"      $ whnf memberSet  ".hs"
          , bench "hit  last   (.lhs-boot)"$ whnf memberSet  ".lhs-boot"
          , bench "miss        (.py)"      $ whnf memberSet  ".py"
          , bench "all probes"             $ whnf checkAll   memberSet
          ]
      , bgroup "Vector"
          [ bench "hit  first  (.hs)"      $ whnf memberVec  ".hs"
          , bench "hit  last   (.lhs-boot)"$ whnf memberVec  ".lhs-boot"
          , bench "miss        (.py)"      $ whnf memberVec  ".py"
          , bench "all probes"             $ whnf checkAll   memberVec
          ]
      ]
  ]