Skip to content

Commit dde7a53

Browse files
committed
Merge pull request #72 from treeowl/then
Optimize *> and >> for Seq
2 parents bcebc7a + 22ef7de commit dde7a53

File tree

1 file changed

+15
-0
lines changed

1 file changed

+15
-0
lines changed

Data/Sequence.hs

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -233,11 +233,13 @@ instance Monad Seq where
233233
return = singleton
234234
xs >>= f = foldl' add empty xs
235235
where add ys x = ys >< f x
236+
(>>) = (*>)
236237

237238
instance Applicative Seq where
238239
pure = singleton
239240
fs <*> xs = foldl' add empty fs
240241
where add ys f = ys >< fmap f xs
242+
xs *> ys = replicateSeq (length xs) ys
241243

242244
instance MonadPlus Seq where
243245
mzero = empty
@@ -660,6 +662,19 @@ replicateM n x
660662
| n >= 0 = unwrapMonad (replicateA n (WrapMonad x))
661663
| otherwise = error "replicateM takes a nonnegative integer argument"
662664

665+
-- | @'replicateSeq' n xs@ concatenates @n@ copies of @xs@.
666+
replicateSeq :: Int -> Seq a -> Seq a
667+
replicateSeq n xs
668+
| n < 0 = error "replicateSeq takes a nonnegative integer argument"
669+
| n == 0 = empty
670+
| otherwise = go n xs
671+
where
672+
-- Invariant: k >= 1
673+
go 1 xs = xs
674+
go k xs | even k = kxs
675+
| otherwise = xs >< kxs
676+
where kxs = go (k `quot` 2) $! (xs >< xs)
677+
663678
-- | /O(1)/. Add an element to the left end of a sequence.
664679
-- Mnemonic: a triangle with the single element at the pointy end.
665680
(<|) :: a -> Seq a -> Seq a

0 commit comments

Comments
 (0)