Skip to content

Commit

Permalink
Fix compilation of benchmarks
Browse files Browse the repository at this point in the history
I removed an outdated zipper benchmark, since Control.Lens.Zipper was
moved to the zippers package. I opened a PR to move it there:
ekmett/zippers#11

Addresses
commercialhaskell/stackage#1372 (comment)
  • Loading branch information
RyanGlScott committed Apr 22, 2016
1 parent dd6cc12 commit c8d496a
Show file tree
Hide file tree
Showing 5 changed files with 27 additions and 82 deletions.
20 changes: 9 additions & 11 deletions benchmarks/alongside.hs
Original file line number Diff line number Diff line change
Expand Up @@ -70,22 +70,20 @@ half l r pfq (s,s') = fmap (\(b,t') -> (peekContext b x,t')) (getCompose (r (\a'
-- alongside' :: Lens s t a b -> Lens s' t' a' b' -> Lens (s,s') (t,t') (a,a') (b,b')
-- {-# INLINE alongside'#-}

compound :: Lens s t a b
-> Lens s' t' a' b'
-> Lens (s,s') (t,t') (a,a') (b,b')
compound :: Lens' s a
-> Lens' s' a'
-> Lens' (s,s') (a,a')
compound l r = lens (\(s, s') -> (view l s, view r s'))
(\(s, s') (t, t') -> (set l t s, set r t' s'))
{-# INLINE compound #-}

compound5 :: Lens s t a b
-> Lens s' t' a' b'
-> Lens s'' t'' a'' b''
-> Lens s''' t''' a''' b'''
-> Lens s'''' t'''' a'''' b''''
-> Lens (s, (s', (s'', (s''', s''''))))
(t, (t', (t'', (t''', t''''))))
compound5 :: Lens' s a
-> Lens' s' a'
-> Lens' s'' a''
-> Lens' s''' a'''
-> Lens' s'''' a''''
-> Lens' (s, (s', (s'', (s''', s''''))))
(a, (a', (a'', (a''', a''''))))
(b, (b', (b'', (b''', b''''))))
compound5 l l' l'' l''' l''''
= lens (\(s, (s', (s'', (s''', s''''))))
-> (view l s, (view l' s', (view l'' s'', (view l''' s''', view l'''' s'''')))) )
Expand Down
8 changes: 8 additions & 0 deletions benchmarks/plated.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,15 @@
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif

#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative
#endif

import Control.Lens
import Control.DeepSeq
import Criterion.Main
Expand Down
12 changes: 7 additions & 5 deletions benchmarks/unsafe.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,16 +6,18 @@ import Control.Lens.Internal
import Control.Exception

import Criterion.Main
import Criterion.Config
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 = runMutator . l (Mutator . f)
overS l f = runIdentity . l (Identity . f)
{-# INLINE overS #-}

mappedS :: ASetter [a] [b] a b
mappedS f = Mutator . map (runMutator . f)
mappedS f = Identity . map (runIdentity . f)
{-# INLINE mappedS #-}

overU :: ASetter s t a b -> (a -> b) -> s -> t
Expand Down Expand Up @@ -53,11 +55,11 @@ main = do
--l = replicate n (); f = (\ _ -> ())
--l = replicate n (); f = (\ !_ -> ()) -- strange results
--l = replicate n (); f = lazy (\_ -> ())
defaultMainWith config (return ())
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 { cfgSamples = ljust 1000 }
config = defaultConfig { resamples = 1000 }
45 changes: 0 additions & 45 deletions benchmarks/zipper.hs

This file was deleted.

24 changes: 3 additions & 21 deletions lens.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -452,8 +452,7 @@ benchmark alongside
hs-source-dirs: benchmarks
build-depends:
base,
comonad,
comonads-fd,
comonad >= 4,
criterion,
deepseq,
lens,
Expand Down Expand Up @@ -497,25 +496,8 @@ benchmark unsafe
hs-source-dirs: benchmarks
build-depends:
base,
comonad,
comonads-fd,
criterion,
deepseq,
generic-deriving,
lens,
transformers

-- Benchmarking zipper usage
benchmark zipper
type: exitcode-stdio-1.0
main-is: zipper.hs
ghc-options: -w -O2 -threaded -fdicts-cheap -funbox-strict-fields
hs-source-dirs: benchmarks
build-depends:
base,
comonad,
comonads-fd,
criterion,
comonad >= 4,
criterion >= 1,
deepseq,
generic-deriving,
lens,
Expand Down

0 comments on commit c8d496a

Please sign in to comment.