[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: Optimize *> and >> for Seq (22ef7de)

[git at git.haskell.org]

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/22ef7de71a5de7f9447f3fdcf16fa8f786cb84c0

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

commit 22ef7de71a5de7f9447f3fdcf16fa8f786cb84c0
Author: David Feuer <David.Feuer at gmail.com>
Date:   Wed Nov 19 15:14:01 2014 -0500

    Optimize *> and >> for Seq
    
    Based on a discussion with Ross Paterson, use a multiplication-
    by-doubling algorithm to improve asymptotic time and space
    performance.


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

22ef7de71a5de7f9447f3fdcf16fa8f786cb84c0
 Data/Sequence.hs | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 1c4e143..2cfa9c7 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -228,11 +228,13 @@ instance Monad Seq where
     return = singleton
     xs >>= f = foldl' add empty xs
       where add ys x = ys >< f x
+    (>>) = (*>)
 
 instance Applicative Seq where
     pure = singleton
     fs <*> xs = foldl' add empty fs
       where add ys f = ys >< fmap f xs
+    xs *> ys = replicateSeq (length xs) ys
 
 instance MonadPlus Seq where
     mzero = empty
@@ -655,6 +657,19 @@ replicateM n x
   | n >= 0      = unwrapMonad (replicateA n (WrapMonad x))
   | otherwise   = error "replicateM takes a nonnegative integer argument"
 
+-- | @'replicateSeq' n xs@ concatenates @n@ copies of @xs at .
+replicateSeq :: Int -> Seq a -> Seq a
+replicateSeq n xs
+  | n < 0     = error "replicateSeq takes a nonnegative integer argument"
+  | n == 0    = empty
+  | otherwise = go n xs
+  where
+    -- Invariant: k >= 1
+    go 1 xs = xs
+    go k xs | even k    = kxs
+            | otherwise = xs >< kxs
+            where kxs = go (k `quot` 2) $! (xs >< xs)
+
 -- | /O(1)/. Add an element to the left end of a sequence.
 -- Mnemonic: a triangle with the single element at the pointy end.
 (<|)            :: a -> Seq a -> Seq a