File: Bench.hs

package info (click to toggle)
haskell-foldable1-classes-compat 0.1-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 108 kB
  • sloc: haskell: 686; makefile: 3
file content (178 lines) | stat: -rw-r--r-- 6,148 bytes parent folder | download
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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
{-# LANGUAGE CPP            #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor  #-}

#if MIN_VERSION_base(4,18,0)
# define HAS_FOLDABLE1_CONTAINERS MIN_VERSION_containers(0,6,7)
#else
# define HAS_FOLDABLE1_CONTAINERS 1
#endif

module Main (main) where

import Prelude hiding (foldl1, head, last, maximum)

import Control.DeepSeq    (NFData (..))
import Criterion.Main
import qualified Data.Foldable as F (Foldable)
import Data.Foldable1
import Data.List.NonEmpty (NonEmpty (..))
import Data.Semigroup     (Min (..))

#if HAS_FOLDABLE1_CONTAINERS
import Data.Tree          (Tree (..))
#endif

input :: NonEmpty Int
input = 1 :| take 10000000 [2 .. ]

#if HAS_FOLDABLE1_CONTAINERS
tree :: Tree Int
tree = go 7 0 where
    go :: Int -> Int -> Tree Int
    go n x
        | n <= 0    = Node x []
        | otherwise = Node x [ go (pred n) (x * 10 + x') | x' <- [0 .. 9] ]
#endif

main :: IO ()
main = defaultMain
    -- NonEmpty left folds
    [ env (return input) $ \ne -> bgroup "NonEmpty-vanilla"
        [ bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) ne
        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) ne
        , bench "foldl1' min"       $ whnf (foldl1' min) ne
        , bench "foldl1 min"        $ whnf (foldl1 min) ne
        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) ne
        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) ne
        ]
    , env (return $ NE1 input) $ \ne -> bgroup "NonEmpty-foldMap1"
        [ bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) ne
        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) ne
        , bench "foldl1' min"       $ whnf (foldl1' min) ne
        , bench "foldl1 min"        $ whnf (foldl1 min) ne
        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) ne
        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) ne
        ]
    , env (return $ NE3 input) $ \ne -> bgroup "NonEmpty-foldrMap1"
        [ bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) ne
        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) ne
        , bench "foldl1' min"       $ whnf (foldl1' min) ne
        , bench "foldl1 min"        $ whnf (foldl1 min) ne
        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) ne
        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) ne
        ]

#if HAS_FOLDABLE1_CONTAINERS
    -- Trees
    , env (return tree) $ \tr -> bgroup "Tree-vanilla"
        [ bench "head" $ whnf head tr
        , bench "last" $ whnf last tr
        , bench "maximum" $ whnf maximum tr
        , bench "maximum'" $ whnf (foldl1' max) tr

        , bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) tr
        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) tr
        , bench "foldl1' min"       $ whnf (foldl1' min) tr
        , bench "foldl1 min"        $ whnf (foldl1 min) tr
        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) tr
        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) tr
        ]
    , env (return $ Tree1 tree) $ \tr -> bgroup "Tree-foldMap1"
        [ bench "head" $ whnf head tr
        , bench "last" $ whnf last tr
        , bench "maximum" $ whnf maximum tr
        , bench "maximum'" $ whnf (foldl1' max) tr

        , bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) tr
        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) tr
        , bench "foldl1' min"       $ whnf (foldl1' min) tr
        , bench "foldl1 min"        $ whnf (foldl1 min) tr
        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) tr
        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) tr
        ]
    , env (return $ Tree3 tree) $ \tr -> bgroup "Tree-foldr1Map"
        [ bench "head" $ whnf head tr
        , bench "last" $ whnf last tr
        , bench "maximum" $ whnf maximum tr
        , bench "maximum'" $ whnf (foldl1' max) tr

        , bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) tr
        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) tr
        , bench "foldl1' min"       $ whnf (foldl1' min) tr
        , bench "foldl1 min"        $ whnf (foldl1 min) tr
        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) tr
        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) tr
        ]
#endif
    ]

-------------------------------------------------------------------------------
-- NonEmpty variants
-------------------------------------------------------------------------------

-- Using foldMap1 only
newtype NE1 a = NE1 (NonEmpty a)
  deriving (Functor, F.Foldable)

instance NFData a => NFData (NE1 a) where
    rnf (NE1 xs) = rnf xs

instance Foldable1 NE1 where
    foldMap1 f (NE1 xs) = foldMap1 f xs

-- Using toNonEmpty
-- newtype NE2 a = NE2 (NonEmpty a)
--   deriving (Functor, F.Foldable)
--
-- instance NFData a => NFData (NE2 a) where
--     rnf (NE2 xs) = rnf xs
--
-- instance Foldable1 NE2 where
--     toNonEmpty (NE2 xs) = toNonEmpty xs

-- Using to foldrMap1
newtype NE3 a = NE3 (NonEmpty a)
  deriving (Functor, F.Foldable)

instance NFData a => NFData (NE3 a) where
    rnf (NE3 xs) = rnf xs

instance Foldable1 NE3 where
    foldrMap1 g f (NE3 xs) = foldrMap1 g f xs

#if HAS_FOLDABLE1_CONTAINERS
-------------------------------------------------------------------------------
-- Tree variants
-------------------------------------------------------------------------------

-- Using foldMap1 only
newtype Tree1 a = Tree1 (Tree a)
  deriving (Functor, F.Foldable)

instance NFData a => NFData (Tree1 a) where
    rnf (Tree1 xs) = rnf xs

instance Foldable1 Tree1 where
    foldMap1 f (Tree1 xs) = foldMap1 f xs

-- Using toNonEmpty
-- newtype Tree2 a = Tree2 (Tree a)
--   deriving (Functor, F.Foldable)
--
-- instance NFData a => NFData (Tree2 a) where
--     rnf (Tree2 xs) = rnf xs
--
-- instance Foldable1 Tree2 where
--     toNonEmpty (Tree2 xs) = toNonEmpty xs

-- Using to foldrMap1
newtype Tree3 a = Tree3 (Tree a)
  deriving (Functor, F.Foldable)

instance NFData a => NFData (Tree3 a) where
    rnf (Tree3 xs) = rnf xs

instance Foldable1 Tree3 where
    foldrMap1 f g (Tree3 xs) = foldrMap1 f g xs
#endif