Reduce arity of foldlOf' and related functions

benchmarks/folds.hs

@@ -31,6 +31,10 @@ main = defaultMainWith config
       [ bench "native"     $ nf (V.toList . V.indexed) v
       , bench "itraversed" $ nf (itoListOf itraversed) v
       ]
+    , bgroup "sum"
+      [ bench "native" $ whnf V.sum v
+      , bench "each"   $ whnf (sumOf each) v
+      ]
     ]
   , bgroup "unboxed-vector"
     [ bgroup "toList"
@@ -41,6 +45,10 @@ main = defaultMainWith config
       [ bench "native"     $ nf (U.toList . U.indexed) u
       , bench "vTraverse" $ nf (itoListOf vectorTraverse) u
       ]
+    , bgroup "sum"
+      [ bench "native" $ whnf U.sum u
+      , bench "each"   $ whnf (sumOf each) u
+      ]
     ]
   , bgroup "sequence"
     [ bgroup "toList"
@@ -72,6 +80,10 @@ main = defaultMainWith config
       [ bench "native"     $ nf (zip [(0::Int)..]) l
       , bench "itraversed" $ nf (itoListOf itraversed) l
       ]
+    , bgroup "sum"
+      [ bench "native" $ whnf sum l
+      , bench "each"   $ whnf (sumOf each) l
+      ]
     ]
   , bgroup "map"
     [ bgroup "toList"

src/Control/Lens/Fold.hs

@@ -1754,8 +1754,9 @@ lookupOf l k = foldrOf l (\(k',v) next -> if k == k' then Just v else next) Noth
 -- 'foldr1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a
 -- @
 foldr1Of :: HasCallStack => Getting (Endo (Maybe a)) s a -> (a -> a -> a) -> s -> a
-foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure")
-                            (foldrOf l mf Nothing xs) where
+-- See: NOTE: [Inlining and arity]
+foldr1Of l f = fromMaybe (error "foldr1Of: empty structure")
+             . foldrOf l mf Nothing where
   mf x my = Just $ case my of
     Nothing -> x
     Just y -> f x y
@@ -1780,7 +1781,8 @@ foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure")
 -- 'foldl1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a
 -- @
 foldl1Of :: HasCallStack => Getting (Dual (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a
-foldl1Of l f xs = fromMaybe (error "foldl1Of: empty structure") (foldlOf l mf Nothing xs) where
+-- See: NOTE: [Inlining and arity]
+foldl1Of l f = fromMaybe (error "foldl1Of: empty structure") . foldlOf l mf Nothing where
   mf mx y = Just $ case mx of
     Nothing -> y
     Just x  -> f x y
@@ -1800,7 +1802,8 @@ foldl1Of l f xs = fromMaybe (error "foldl1Of: empty structure") (foldlOf l mf No
 -- 'foldrOf'' :: 'Traversal'' s a -> (a -> r -> r) -> r -> s -> r
 -- @
 foldrOf' :: Getting (Dual (Endo (Endo r))) s a -> (a -> r -> r) -> r -> s -> r
-foldrOf' l f z0 xs = foldlOf l f' (Endo id) xs `appEndo` z0
+-- See: NOTE: [Inlining and arity]
+foldrOf' l f z0 = \xs -> foldlOf l f' (Endo id) xs `appEndo` z0
   where f' (Endo k) x = Endo $ \ z -> k $! f x z
 {-# INLINE foldrOf' #-}
 
@@ -1818,7 +1821,8 @@ foldrOf' l f z0 xs = foldlOf l f' (Endo id) xs `appEndo` z0
 -- 'foldlOf'' :: 'Traversal'' s a -> (r -> a -> r) -> r -> s -> r
 -- @
 foldlOf' :: Getting (Endo (Endo r)) s a -> (r -> a -> r) -> r -> s -> r
-foldlOf' l f z0 xs = foldrOf l f' (Endo id) xs `appEndo` z0
+-- See: NOTE: [Inlining and arity]
+foldlOf' l f z0 = \xs -> foldrOf l f' (Endo id) xs `appEndo` z0
   where f' x (Endo k) = Endo $ \z -> k $! f z x
 {-# INLINE foldlOf' #-}
 
@@ -1838,7 +1842,8 @@ foldlOf' l f z0 xs = foldrOf l f' (Endo id) xs `appEndo` z0
 -- 'foldr1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a
 -- @
 foldr1Of' :: HasCallStack => Getting (Dual (Endo (Endo (Maybe a)))) s a -> (a -> a -> a) -> s -> a
-foldr1Of' l f xs = fromMaybe (error "foldr1Of': empty structure") (foldrOf' l mf Nothing xs) where
+-- See: NOTE: [Inlining and arity]
+foldr1Of' l f = fromMaybe (error "foldr1Of': empty structure") . foldrOf' l mf Nothing where
   mf x Nothing = Just $! x
   mf x (Just y) = Just $! f x y
 {-# INLINE foldr1Of' #-}
@@ -1859,7 +1864,8 @@ foldr1Of' l f xs = fromMaybe (error "foldr1Of': empty structure") (foldrOf' l mf
 -- 'foldl1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a
 -- @
 foldl1Of' :: HasCallStack => Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a
-foldl1Of' l f xs = fromMaybe (error "foldl1Of': empty structure") (foldlOf' l mf Nothing xs) where
+-- See: NOTE: [Inlining and arity]
+foldl1Of' l f = fromMaybe (error "foldl1Of': empty structure") . foldlOf' l mf Nothing where
   mf Nothing y = Just $! y
   mf (Just x) y = Just $! f x y
 {-# INLINE foldl1Of' #-}
@@ -1881,7 +1887,8 @@ foldl1Of' l f xs = fromMaybe (error "foldl1Of': empty structure") (foldlOf' l mf
 foldrMOf :: Monad m
          => Getting (Dual (Endo (r -> m r))) s a
          -> (a -> r -> m r) -> r -> s -> m r
-foldrMOf l f z0 xs = foldlOf l f' return xs z0
+-- See: NOTE: [Inlining and arity]
+foldrMOf l f z0 = \xs -> foldlOf l f' return xs z0
   where f' k x z = f x z >>= k
 {-# INLINE foldrMOf #-}
 
@@ -1902,10 +1909,26 @@ foldrMOf l f z0 xs = foldlOf l f' return xs z0
 foldlMOf :: Monad m
          => Getting (Endo (r -> m r)) s a
          -> (r -> a -> m r) -> r -> s -> m r
-foldlMOf l f z0 xs = foldrOf l f' return xs z0
+-- See: NOTE: [Inlining and arity]
+foldlMOf l f z0 = \xs -> foldrOf l f' return xs z0
   where f' x k z = f z x >>= k
 {-# INLINE foldlMOf #-}
 
+-- NOTE: [Inlining and arity]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- GHC uses the following inlining heuristic: a function body is inlined if
+-- all its arguments on the LHS are applied. So the following two definitions
+-- are not equivalent from the inliner's PoV:
+--
+-- > foldlOf' l f z0 xs = ...
+-- > foldlOf' l f z0 = \xs -> ...
+--
+-- GHC will be less eager to inline the first one and this results in
+-- worse code. For example, a simple list summation using `sumOf` will be 8x slower
+-- with the first version.
+
+
 -- | Check to see if this 'Fold' or 'Traversal' matches 1 or more entries.
 --
 -- >>> has (element 0) []