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
|