[commit: packages/containers] changelog-foldtree,cleaned_bugfix394,develop-0.6,develop-0.6-questionable,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-184-generic,revert-408-bugfix_394,zip-devel: Specialize splitTraverse; strictify pair splitting (7e6d75f)
git at git.haskell.org
git at git.haskell.org
Mon Apr 17 21:35:32 UTC 2017
Repository : ssh://git@git.haskell.org/containers
On branches: changelog-foldtree,cleaned_bugfix394,develop-0.6,develop-0.6-questionable,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-184-generic,revert-408-bugfix_394,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
More information about the ghc-commits
mailing list