1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
|
{-# LANGUAGE BangPatterns #-}
module Main where
import Control.Lens
import Control.Lens.Internal
import Control.Exception
import Criterion.Main
import Criterion.Types (Config(..))
import Data.Functor.Identity (Identity(..))
import GHC.Exts
overS :: ASetter s t a b -> (a -> b) -> s -> t
overS l f = runIdentity . l (Identity . f)
{-# INLINE overS #-}
mappedS :: ASetter [a] [b] a b
mappedS f = Identity . map (runIdentity . f)
{-# INLINE mappedS #-}
overU :: ASetter s t a b -> (a -> b) -> s -> t
overU = over
{-# INLINE overU #-}
mappedU :: ASetter [a] [b] a b
mappedU = mapped
{-# INLINE mappedU #-}
-- Need to eta-expand for full inlining in the NOINLINE cases?
-- Doesn't seem to make a difference, though.
mapSN :: (a -> b) -> [a] -> [b]
mapSN f l = overS mappedS f l
{-# NOINLINE mapSN #-}
mapSI :: (a -> b) -> [a] -> [b]
mapSI f = overS mappedS f
{-# INLINE mapSI #-}
mapUN :: (a -> b) -> [a] -> [b]
mapUN f l = overU mappedU f l
{-# NOINLINE mapUN #-}
mapUI :: (a -> b) -> [a] -> [b]
mapUI f = overU mappedU f
{-# INLINE mapUI #-}
main :: IO ()
main = do
let n = 1000
l = replicate n "hi"; f = length
--l = replicate n (); f = (\ _ -> ())
--l = replicate n (); f = (\ !_ -> ()) -- strange results
--l = replicate n (); f = lazy (\_ -> ())
defaultMainWith config
[ bench "map safe noinline" $ nf (mapSN f) l
, bench "map safe inline" $ nf (mapSI f) l
, bench "map unsafe noinline" $ nf (mapUN f) l
, bench "map unsafe inline" $ nf (mapUI f) l
]
where
config = defaultConfig { resamples = 1000 }
|