[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Speed up zipWith some more (e8f34b5)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/containers

On branches: cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/e8f34b52aafa59feab40395fcacfc4dca50157d5

>---------------------------------------------------------------

commit e8f34b52aafa59feab40395fcacfc4dca50157d5
Author: David Feuer <David.Feuer at gmail.com>
Date:   Tue May 24 00:26:00 2016 -0400

    Speed up zipWith some more
    
    This one's all about making nice to GHC by pulling
    local functions to the top level and marking them
    inline, as well as eta-expanding at a recursive
    call site.
    
    Old (after recent `splitAt` improvements):
    
    benchmarking zip/ix10000/5000
    time                 8.806 μs   (8.768 μs .. 8.857 μs)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 8.787 μs   (8.766 μs .. 8.879 μs)
    std dev              113.3 ns   (30.31 ns .. 244.0 ns)
    
    benchmarking zip/nf100
    time                 13.19 μs   (13.15 μs .. 13.24 μs)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 13.19 μs   (13.15 μs .. 13.28 μs)
    std dev              157.8 ns   (86.36 ns .. 288.1 ns)
    
    benchmarking zip/nf10000
    time                 1.768 ms   (1.764 ms .. 1.774 ms)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 1.778 ms   (1.772 ms .. 1.793 ms)
    std dev              29.50 μs   (16.59 μs .. 56.72 μs)
    
    New:
    
    benchmarking zip/ix10000/5000
    time                 7.684 μs   (7.668 μs .. 7.704 μs)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 7.685 μs   (7.675 μs .. 7.707 μs)
    std dev              46.68 ns   (27.98 ns .. 73.76 ns)
    
    benchmarking zip/nf100
    time                 9.152 μs   (9.139 μs .. 9.170 μs)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 9.166 μs   (9.148 μs .. 9.197 μs)
    std dev              76.90 ns   (42.73 ns .. 140.9 ns)
    
    benchmarking zip/nf10000
    time                 1.294 ms   (1.291 ms .. 1.298 ms)
                         1.000 R²   (1.000 R² .. 1.000 R²)
    mean                 1.295 ms   (1.292 ms .. 1.298 ms)
    std dev              10.51 μs   (7.936 μs .. 14.12 μs)


>---------------------------------------------------------------

e8f34b52aafa59feab40395fcacfc4dca50157d5
 Data/Sequence.hs | 91 +++++++++++++++++++++++++++++++-------------------------
 1 file changed, 51 insertions(+), 40 deletions(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index aa840b5..033d6e0 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -2966,48 +2966,59 @@ reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
 --
 -- > mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b
 -- > mapWithIndex f = splitMap (\n i -> (i, n+i)) f 0
+{-# INLINE splitMap #-}
 splitMap :: (Int -> s -> (s,s)) -> (s -> a -> b) -> s -> Seq a -> Seq b
-splitMap splt' f0 s0 (Seq xs0) = Seq $ splitMapTree splt' (\s' (Elem a) -> Elem (f0 s' a)) s0 xs0
- where
-  {-# SPECIALIZE splitMapTree :: (Int -> s -> (s,s)) -> (s -> Elem y -> b) -> s -> FingerTree (Elem y) -> FingerTree b #-}
-  {-# SPECIALIZE splitMapTree :: (Int -> s -> (s,s)) -> (s -> Node y -> b) -> s -> FingerTree (Node y) -> FingerTree b #-}
-  splitMapTree :: Sized a => (Int -> s -> (s,s)) -> (s -> a -> b) -> s -> FingerTree a -> FingerTree b
-  splitMapTree _    _ _ EmptyT = EmptyT
-  splitMapTree _    f s (Single xs) = Single $ f s xs
-  splitMapTree splt f s (Deep n pr m sf) = Deep n (splitMapDigit splt f prs pr) (splitMapTree splt (splitMapNode splt f) ms m) (splitMapDigit splt f sfs sf)
-    where
-      (prs, r) = splt (size pr) s
-      (ms, sfs) = splt (n - size pr - size sf) r
-
-  {-# SPECIALIZE splitMapDigit :: (Int -> s -> (s,s)) -> (s -> Elem y -> b) -> s -> Digit (Elem y) -> Digit b #-}
-  {-# SPECIALIZE splitMapDigit :: (Int -> s -> (s,s)) -> (s -> Node y -> b) -> s -> Digit (Node y) -> Digit b #-}
-  splitMapDigit :: Sized a => (Int -> s -> (s,s)) -> (s -> a -> b) -> s -> Digit a -> Digit b
-  splitMapDigit _    f s (One a) = One (f s a)
-  splitMapDigit splt f s (Two a b) = Two (f first a) (f second b)
-    where
-      (first, second) = splt (size a) s
-  splitMapDigit splt f s (Three a b c) = Three (f first a) (f second b) (f third c)
-    where
-      (first, r) = splt (size a) s
-      (second, third) = splt (size b) r
-  splitMapDigit splt f s (Four a b c d) = Four (f first a) (f second b) (f third c) (f fourth d)
-    where
-      (first, s') = splt (size a) s
-      (middle, fourth) = splt (size b + size c) s'
-      (second, third) = splt (size b) middle
-
-  {-# SPECIALIZE splitMapNode :: (Int -> s -> (s,s)) -> (s -> Elem y -> b) -> s -> Node (Elem y) -> Node b #-}
-  {-# SPECIALIZE splitMapNode :: (Int -> s -> (s,s)) -> (s -> Node y -> b) -> s -> Node (Node y) -> Node b #-}
-  splitMapNode :: Sized a => (Int -> s -> (s,s)) -> (s -> a -> b) -> s -> Node a -> Node b
-  splitMapNode splt f s (Node2 ns a b) = Node2 ns (f first a) (f second b)
-    where
-      (first, second) = splt (size a) s
-  splitMapNode splt f s (Node3 ns a b c) = Node3 ns (f first a) (f second b) (f third c)
-    where
-      (first, r) = splt (size a) s
-      (second, third) = splt (size b) r
+splitMap splt' f0 s0 (Seq xs0) = Seq $ splitMapTreeE splt' (\s' (Elem a) -> Elem (f0 s' a)) s0 xs0
+
+-- Note: We end up boxing and unboxing Ints here.
+-- If we wanted, we could manually unbox them all.
+-- However, benchmarks indicate the performance gains
+-- are small, and maintaining an entirely separate copy of
+-- all the splitMap helpers specially for GHC seems
+-- an unreasonable maintenance burden.
+{-# INLINE splitMapTreeE #-}
+splitMapTreeE :: (Int -> s -> (s,s)) -> (s -> Elem y -> b) -> s -> FingerTree (Elem y) -> FingerTree b
+splitMapTreeE _    _ _ EmptyT = EmptyT
+splitMapTreeE _    f s (Single xs) = Single $ f s xs
+splitMapTreeE splt f s (Deep n pr m sf) = Deep n (splitMapDigit splt f prs pr) (splitMapTreeN splt (\eta1 eta2 -> splitMapNode splt f eta1 eta2) ms m) (splitMapDigit splt f sfs sf)
+      where
+        (prs, r) = splt (size pr) s
+        (ms, sfs) = splt (n - size pr - size sf) r
+
+splitMapTreeN :: (Int -> s -> (s,s)) -> (s -> Node a -> b) -> s -> FingerTree (Node a) -> FingerTree b
+splitMapTreeN _    _ _ EmptyT = EmptyT
+splitMapTreeN _    f s (Single xs) = Single $ f s xs
+splitMapTreeN splt f s (Deep n pr m sf) = Deep n (splitMapDigit splt f prs pr) (splitMapTreeN splt (\eta1 eta2 -> splitMapNode splt f eta1 eta2) ms m) (splitMapDigit splt f sfs sf)
+      where
+        (prs, r) = splt (size pr) s
+        (ms, sfs) = splt (n - size pr - size sf) r
+
+{-# INLINE splitMapDigit #-}
+splitMapDigit :: Sized a => (Int -> s -> (s,s)) -> (s -> a -> b) -> s -> Digit a -> Digit b
+splitMapDigit _    f s (One a) = One (f s a)
+splitMapDigit splt f s (Two a b) = Two (f first a) (f second b)
+  where
+    (first, second) = splt (size a) s
+splitMapDigit splt f s (Three a b c) = Three (f first a) (f second b) (f third c)
+  where
+    (first, r) = splt (size a) s
+    (second, third) = splt (size b) r
+splitMapDigit splt f s (Four a b c d) = Four (f first a) (f second b) (f third c) (f fourth d)
+  where
+    (first, s') = splt (size a) s
+    (middle, fourth) = splt (size b + size c) s'
+    (second, third) = splt (size b) middle
+
+{-# INLINE splitMapNode #-}
+splitMapNode :: Sized a => (Int -> s -> (s,s)) -> (s -> a -> b) -> s -> Node a -> Node b
+splitMapNode splt f s (Node2 ns a b) = Node2 ns (f first a) (f second b)
+  where
+    (first, second) = splt (size a) s
+splitMapNode splt f s (Node3 ns a b c) = Node3 ns (f first a) (f second b) (f third c)
+  where
+    (first, r) = splt (size a) s
+    (second, third) = splt (size b) r
 
-{-# INLINE splitMap #-}
 
 getSingleton :: Seq a -> a
 getSingleton (Seq (Single (Elem a))) = a