{-# OPTIONS_GHC -O2 -fno-full-laziness -fno-prof-auto #-}

module ParkBench.Internal.Benchable.Internal
  ( function,
    action,
  )
where

import Control.Exception (evaluate)
import Data.Word (Word64)
import GHC.Types (SPEC (SPEC))
import Prelude

function :: (a -> b) -> a -> Word64 -> IO ()
function :: forall a b. (a -> b) -> a -> Word64 -> IO ()
function a -> b
f a
x =
  SPEC -> Word64 -> IO ()
go SPEC
SPEC
  where
    -- SPEC: make benchmarks independent of -fspec-constr-count
    go :: SPEC -> Word64 -> IO ()
    go :: SPEC -> Word64 -> IO ()
go !SPEC
_ = \case
      Word64
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Word64
n -> do
        -- `f x` won't be let-floated out with -fno-full-laziness
        -- use evaluate rather than seq so both branches depend on the state token
        --   https://gitlab.haskell.org/ghc/ghc/-/issues/21948
        b
_ <- forall a. a -> IO a
evaluate (a -> b
f a
x)
        SPEC -> Word64 -> IO ()
go SPEC
SPEC (Word64
n forall a. Num a => a -> a -> a
- Word64
1)
-- prevent `function f x` from inlining to prevent `f x` from getting let-floated
{-# NOINLINE function #-}

action :: IO a -> Word64 -> IO ()
action :: forall a. IO a -> Word64 -> IO ()
action IO a
io =
  Word64 -> IO ()
go
  where
    go :: Word64 -> IO ()
    go :: Word64 -> IO ()
go = \case
      Word64
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Word64
n -> do
        a
result <- IO a
io
        a
result seq :: forall a b. a -> b -> b
`seq` Word64 -> IO ()
go (Word64
n forall a. Num a => a -> a -> a
- Word64
1)
{-# NOINLINE action #-}