File: unsafe.hs

package info (click to toggle)
haskell-lens 4.18.1-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 2,016 kB
  • sloc: haskell: 16,792; sh: 15; makefile: 14; ansic: 8
file content (65 lines) | stat: -rw-r--r-- 1,617 bytes parent folder | download | duplicates (3)
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 }