[commit: packages/containers] develop-0.6,develop-0.6-questionable,master,zip-devel: Specialize splitTraverse; strictify pair splitting (7e6d75f)

[git at git.haskell.org]

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

On branches: develop-0.6,develop-0.6-questionable,master,zip-devel
Link       : http://git.haskell.org/packages/containers.git/commitdiff/7e6d75f9cfb524ccb3c7dfd149c6f7f74e276285

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

commit 7e6d75f9cfb524ccb3c7dfd149c6f7f74e276285
Author: David Feuer <David.Feuer at gmail.com>
Date:   Wed Dec 3 13:27:41 2014 -0500

    Specialize splitTraverse; strictify pair splitting
    
    Explicitly specialize `splitTraverse` functions to the necessary types.
    This has no immediate performance impact, but makes it clearer what the
    functions are about. Make splitting pairs a bit stricter; we don't need
    that much laziness.


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

7e6d75f9cfb524ccb3c7dfd149c6f7f74e276285
 Data/Sequence.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 10d3a92..9955584 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -1726,14 +1726,18 @@ instance Splittable (Seq a) where
     splitState = splitAt
 
 instance (Splittable a, Splittable b) => Splittable (a, b) where
-    splitState i (a, b) = ((al, bl), (ar, br))
+    splitState i (a, b) = (al `seq` bl `seq` (al, bl), ar `seq` br `seq` (ar, br))
       where
         (al, ar) = splitState i a
         (bl, br) = splitState i b
 
+{-# SPECIALIZE splitTraverseSeq :: (Seq x -> a -> b) -> Seq x -> Seq a -> Seq b #-}
+{-# SPECIALIZE splitTraverseSeq :: ((Seq x, Seq y) -> a -> b) -> (Seq x, Seq y) -> Seq a -> Seq b #-}
 splitTraverseSeq :: (Splittable s) => (s -> a -> b) -> s -> Seq a -> Seq b
 splitTraverseSeq f s (Seq xs) = Seq $ splitTraverseTree (\s' (Elem a) -> Elem (f s' a)) s xs
 
+{-# SPECIALIZE splitTraverseTree :: (Seq x -> Elem y -> b) -> Seq x -> FingerTree (Elem y) -> FingerTree b #-}
+{-# SPECIALIZE splitTraverseTree :: (Seq x -> Node y -> b) -> Seq x -> FingerTree (Node y) -> FingerTree b #-}
 splitTraverseTree :: (Sized a, Splittable s) => (s -> a -> b) -> s -> FingerTree a -> FingerTree b
 splitTraverseTree _f _s Empty = Empty
 splitTraverseTree f s (Single xs) = Single $ f s xs
@@ -1742,6 +1746,8 @@ splitTraverseTree f s (Deep n pr m sf) = Deep n (splitTraverseDigit f prs pr) (s
     (prs, r) = splitState (size pr) s
     (ms, sfs) = splitState (n - size pr - size sf) r
 
+{-# SPECIALIZE splitTraverseDigit :: (Seq x -> Elem y -> b) -> Seq x -> Digit (Elem y) -> Digit b #-}
+{-# SPECIALIZE splitTraverseDigit :: (Seq x -> Node y -> b) -> Seq x -> Digit (Node y) -> Digit b #-}
 splitTraverseDigit :: (Sized a, Splittable s) => (s -> a -> b) -> s -> Digit a -> Digit b
 splitTraverseDigit f s (One a) = One (f s a)
 splitTraverseDigit f s (Two a b) = Two (f first a) (f second b)
@@ -1757,6 +1763,8 @@ splitTraverseDigit f s (Four a b c d) = Four (f first a) (f second b) (f third c
     (middle, fourth) = splitState (size b + size c) s'
     (second, third) = splitState (size b) middle
 
+{-# SPECIALIZE splitTraverseNode :: (Seq x -> Elem y -> b) -> Seq x -> Node (Elem y) -> Node b #-}
+{-# SPECIALIZE splitTraverseNode :: (Seq x -> Node y -> b) -> Seq x -> Node (Node y) -> Node b #-}
 splitTraverseNode :: (Sized a, Splittable s) => (s -> a -> b) -> s -> Node a -> Node b
 splitTraverseNode f s (Node2 ns a b) = Node2 ns (f first a) (f second b)
   where