1 {-# OPTIONS -cpp -fglasgow-exts #-}
2 -----------------------------------------------------------------------------
4 -- Module : Data.Sequence
5 -- Copyright : (c) Ross Paterson 2005
7 -- Maintainer : ross@soi.city.ac.uk
8 -- Stability : experimental
9 -- Portability : portable
11 -- General purpose finite sequences.
12 -- Apart from being finite and having strict operations, sequences
13 -- also differ from lists in supporting a wider variety of operations
16 -- An amortized running time is given for each operation, with /n/ referring
17 -- to the length of the sequence and /i/ being the integral index used by
18 -- some operations. These bounds hold even in a persistent (shared) setting.
20 -- The implementation uses 2-3 finger trees annotated with sizes,
21 -- as described in section 4.2 of
23 -- * Ralf Hinze and Ross Paterson,
24 -- \"Finger trees: a simple general-purpose data structure\",
25 -- to appear in /Journal of Functional Programming/.
26 -- <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
28 -- /Note/: Many of these operations have the same names as similar
29 -- operations on lists in the "Prelude". The ambiguity may be resolved
30 -- using either qualification or the @hiding@ clause.
32 -----------------------------------------------------------------------------
34 module Data.Sequence (
38 singleton, -- :: a -> Seq a
39 (<|), -- :: a -> Seq a -> Seq a
40 (|>), -- :: Seq a -> a -> Seq a
41 (><), -- :: Seq a -> Seq a -> Seq a
44 null, -- :: Seq a -> Bool
45 length, -- :: Seq a -> Int
48 viewl, -- :: Seq a -> ViewL a
50 viewr, -- :: Seq a -> ViewR a
52 index, -- :: Seq a -> Int -> a
53 adjust, -- :: (a -> a) -> Int -> Seq a -> Seq a
54 update, -- :: Int -> a -> Seq a -> Seq a
55 take, -- :: Int -> Seq a -> Seq a
56 drop, -- :: Int -> Seq a -> Seq a
57 splitAt, -- :: Int -> Seq a -> (Seq a, Seq a)
59 fromList, -- :: [a] -> Seq a
60 toList, -- :: Seq a -> [a]
62 -- ** Right associative
63 foldr, -- :: (a -> b -> b) -> b -> Seq a -> b
64 foldr1, -- :: (a -> a -> a) -> Seq a -> a
65 foldr', -- :: (a -> b -> b) -> b -> Seq a -> b
66 foldrM, -- :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
67 -- ** Left associative
68 foldl, -- :: (a -> b -> a) -> a -> Seq b -> a
69 foldl1, -- :: (a -> a -> a) -> Seq a -> a
70 foldl', -- :: (a -> b -> a) -> a -> Seq b -> a
71 foldlM, -- :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
73 reverse, -- :: Seq a -> Seq a
79 import Prelude hiding (
80 null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
82 import qualified Prelude (foldr)
83 import qualified Data.List (foldl', intersperse)
84 import Control.Monad (MonadPlus(..))
88 #ifdef __GLASGOW_HASKELL__
89 import GHC.Exts (build)
90 import Text.Read (readPrec, lexP, Lexeme(..), (<++), (+++), reset)
91 import Data.Generics.Basics (Data(..), Fixity(..),
92 constrIndex, mkConstr, mkDataType)
96 import Control.Monad (liftM, liftM2, liftM3, liftM4)
97 import Test.QuickCheck
110 -- | General-purpose finite sequences.
111 newtype Seq a = Seq (FingerTree (Elem a))
113 instance Functor Seq where
114 fmap f (Seq xs) = Seq (fmap (fmap f) xs)
116 instance Monad Seq where
118 xs >>= f = foldl' add empty xs
119 where add ys x = ys >< f x
121 instance MonadPlus Seq where
125 instance FunctorM Seq where
126 fmapM f = foldlM f' empty
130 fmapM_ f = foldlM f' ()
131 where f' _ x = f x >> return ()
133 instance Eq a => Eq (Seq a) where
134 xs == ys = length xs == length ys && toList xs == toList ys
136 instance Ord a => Ord (Seq a) where
137 compare xs ys = compare (toList xs) (toList ys)
140 instance Show a => Show (Seq a) where
141 showsPrec p (Seq x) = showsPrec p x
143 instance Show a => Show (Seq a) where
144 showsPrec _ xs = showChar '<' .
145 flip (Prelude.foldr ($)) (Data.List.intersperse (showChar ',')
146 (map shows (toList xs))) .
150 instance Read a => Read (Seq a) where
151 #ifdef __GLASGOW_HASKELL__
152 readPrec = parens $ (symbol "<>" >> return empty) <++ do
154 readEnd empty <++ readRest empty
155 where readEnd xs = do
166 x <- reset (parens p)
173 readsPrec _ = readParen False $ \ r -> do
176 "<>" -> return (empty,s)
180 ">" -> return (empty,t)
181 _ -> readRest empty s
183 where readRest xs s = do
188 ">" -> return (xs',u)
189 "," -> readRest xs' u
193 #include "Typeable.h"
194 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
196 #if __GLASGOW_HASKELL__
197 instance Data a => Data (Seq a) where
198 gfoldl f z s = case viewl s of
200 x :< xs -> z (<|) `f` x `f` xs
202 gunfold k z c = case constrIndex c of
208 | null xs = emptyConstr
209 | otherwise = consConstr
211 dataTypeOf _ = seqDataType
215 emptyConstr = mkConstr seqDataType "empty" [] Prefix
216 consConstr = mkConstr seqDataType "<|" [] Infix
217 seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
225 | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
230 instance Sized a => Sized (FingerTree a) where
231 {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
232 {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
234 size (Single x) = size x
235 size (Deep v _ _ _) = v
237 instance Functor FingerTree where
239 fmap f (Single x) = Single (f x)
240 fmap f (Deep v pr m sf) =
241 Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
244 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
245 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
246 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
247 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
260 instance Functor Digit where
261 fmap f (One a) = One (f a)
262 fmap f (Two a b) = Two (f a) (f b)
263 fmap f (Three a b c) = Three (f a) (f b) (f c)
264 fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)
266 instance Sized a => Sized (Digit a) where
267 {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
268 {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
269 size xs = foldlDigit (\ i x -> i + size x) 0 xs
271 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
272 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
273 digitToTree :: Sized a => Digit a -> FingerTree a
274 digitToTree (One a) = Single a
275 digitToTree (Two a b) = deep (One a) Empty (One b)
276 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
277 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
282 = Node2 {-# UNPACK #-} !Int a a
283 | Node3 {-# UNPACK #-} !Int a a a
288 instance Functor (Node) where
289 fmap f (Node2 v a b) = Node2 v (f a) (f b)
290 fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
292 instance Sized (Node a) where
293 size (Node2 v _ _) = v
294 size (Node3 v _ _ _) = v
297 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
298 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
299 node2 :: Sized a => a -> a -> Node a
300 node2 a b = Node2 (size a + size b) a b
303 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
304 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
305 node3 :: Sized a => a -> a -> a -> Node a
306 node3 a b c = Node3 (size a + size b + size c) a b c
308 nodeToDigit :: Node a -> Digit a
309 nodeToDigit (Node2 _ a b) = Two a b
310 nodeToDigit (Node3 _ a b c) = Three a b c
314 newtype Elem a = Elem { getElem :: a }
316 instance Sized (Elem a) where
319 instance Functor Elem where
320 fmap f (Elem x) = Elem (f x)
323 instance (Show a) => Show (Elem a) where
324 showsPrec p (Elem x) = showsPrec p x
327 ------------------------------------------------------------------------
329 ------------------------------------------------------------------------
331 -- | /O(1)/. The empty sequence.
335 -- | /O(1)/. A singleton sequence.
336 singleton :: a -> Seq a
337 singleton x = Seq (Single (Elem x))
339 -- | /O(1)/. Add an element to the left end of a sequence.
340 -- Mnemonic: a triangle with the single element at the pointy end.
341 (<|) :: a -> Seq a -> Seq a
342 x <| Seq xs = Seq (Elem x `consTree` xs)
344 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
345 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
346 consTree :: Sized a => a -> FingerTree a -> FingerTree a
347 consTree a Empty = Single a
348 consTree a (Single b) = deep (One a) Empty (One b)
349 consTree a (Deep s (Four b c d e) m sf) = m `seq`
350 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
351 consTree a (Deep s (Three b c d) m sf) =
352 Deep (size a + s) (Four a b c d) m sf
353 consTree a (Deep s (Two b c) m sf) =
354 Deep (size a + s) (Three a b c) m sf
355 consTree a (Deep s (One b) m sf) =
356 Deep (size a + s) (Two a b) m sf
358 -- | /O(1)/. Add an element to the right end of a sequence.
359 -- Mnemonic: a triangle with the single element at the pointy end.
360 (|>) :: Seq a -> a -> Seq a
361 Seq xs |> x = Seq (xs `snocTree` Elem x)
363 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
364 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
365 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
366 snocTree Empty a = Single a
367 snocTree (Single a) b = deep (One a) Empty (One b)
368 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
369 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
370 snocTree (Deep s pr m (Three a b c)) d =
371 Deep (s + size d) pr m (Four a b c d)
372 snocTree (Deep s pr m (Two a b)) c =
373 Deep (s + size c) pr m (Three a b c)
374 snocTree (Deep s pr m (One a)) b =
375 Deep (s + size b) pr m (Two a b)
377 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
378 (><) :: Seq a -> Seq a -> Seq a
379 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
381 -- The appendTree/addDigits gunk below is machine generated
383 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
384 appendTree0 Empty xs =
386 appendTree0 xs Empty =
388 appendTree0 (Single x) xs =
390 appendTree0 xs (Single x) =
392 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
393 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
395 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
396 addDigits0 m1 (One a) (One b) m2 =
397 appendTree1 m1 (node2 a b) m2
398 addDigits0 m1 (One a) (Two b c) m2 =
399 appendTree1 m1 (node3 a b c) m2
400 addDigits0 m1 (One a) (Three b c d) m2 =
401 appendTree2 m1 (node2 a b) (node2 c d) m2
402 addDigits0 m1 (One a) (Four b c d e) m2 =
403 appendTree2 m1 (node3 a b c) (node2 d e) m2
404 addDigits0 m1 (Two a b) (One c) m2 =
405 appendTree1 m1 (node3 a b c) m2
406 addDigits0 m1 (Two a b) (Two c d) m2 =
407 appendTree2 m1 (node2 a b) (node2 c d) m2
408 addDigits0 m1 (Two a b) (Three c d e) m2 =
409 appendTree2 m1 (node3 a b c) (node2 d e) m2
410 addDigits0 m1 (Two a b) (Four c d e f) m2 =
411 appendTree2 m1 (node3 a b c) (node3 d e f) m2
412 addDigits0 m1 (Three a b c) (One d) m2 =
413 appendTree2 m1 (node2 a b) (node2 c d) m2
414 addDigits0 m1 (Three a b c) (Two d e) m2 =
415 appendTree2 m1 (node3 a b c) (node2 d e) m2
416 addDigits0 m1 (Three a b c) (Three d e f) m2 =
417 appendTree2 m1 (node3 a b c) (node3 d e f) m2
418 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
419 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
420 addDigits0 m1 (Four a b c d) (One e) m2 =
421 appendTree2 m1 (node3 a b c) (node2 d e) m2
422 addDigits0 m1 (Four a b c d) (Two e f) m2 =
423 appendTree2 m1 (node3 a b c) (node3 d e f) m2
424 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
425 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
426 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
427 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
429 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
430 appendTree1 Empty a xs =
432 appendTree1 xs a Empty =
434 appendTree1 (Single x) a xs =
435 x `consTree` a `consTree` xs
436 appendTree1 xs a (Single x) =
437 xs `snocTree` a `snocTree` x
438 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
439 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
441 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
442 addDigits1 m1 (One a) b (One c) m2 =
443 appendTree1 m1 (node3 a b c) m2
444 addDigits1 m1 (One a) b (Two c d) m2 =
445 appendTree2 m1 (node2 a b) (node2 c d) m2
446 addDigits1 m1 (One a) b (Three c d e) m2 =
447 appendTree2 m1 (node3 a b c) (node2 d e) m2
448 addDigits1 m1 (One a) b (Four c d e f) m2 =
449 appendTree2 m1 (node3 a b c) (node3 d e f) m2
450 addDigits1 m1 (Two a b) c (One d) m2 =
451 appendTree2 m1 (node2 a b) (node2 c d) m2
452 addDigits1 m1 (Two a b) c (Two d e) m2 =
453 appendTree2 m1 (node3 a b c) (node2 d e) m2
454 addDigits1 m1 (Two a b) c (Three d e f) m2 =
455 appendTree2 m1 (node3 a b c) (node3 d e f) m2
456 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
457 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
458 addDigits1 m1 (Three a b c) d (One e) m2 =
459 appendTree2 m1 (node3 a b c) (node2 d e) m2
460 addDigits1 m1 (Three a b c) d (Two e f) m2 =
461 appendTree2 m1 (node3 a b c) (node3 d e f) m2
462 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
463 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
464 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
465 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
466 addDigits1 m1 (Four a b c d) e (One f) m2 =
467 appendTree2 m1 (node3 a b c) (node3 d e f) m2
468 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
469 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
470 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
471 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
472 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
473 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
475 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
476 appendTree2 Empty a b xs =
477 a `consTree` b `consTree` xs
478 appendTree2 xs a b Empty =
479 xs `snocTree` a `snocTree` b
480 appendTree2 (Single x) a b xs =
481 x `consTree` a `consTree` b `consTree` xs
482 appendTree2 xs a b (Single x) =
483 xs `snocTree` a `snocTree` b `snocTree` x
484 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
485 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
487 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
488 addDigits2 m1 (One a) b c (One d) m2 =
489 appendTree2 m1 (node2 a b) (node2 c d) m2
490 addDigits2 m1 (One a) b c (Two d e) m2 =
491 appendTree2 m1 (node3 a b c) (node2 d e) m2
492 addDigits2 m1 (One a) b c (Three d e f) m2 =
493 appendTree2 m1 (node3 a b c) (node3 d e f) m2
494 addDigits2 m1 (One a) b c (Four d e f g) m2 =
495 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
496 addDigits2 m1 (Two a b) c d (One e) m2 =
497 appendTree2 m1 (node3 a b c) (node2 d e) m2
498 addDigits2 m1 (Two a b) c d (Two e f) m2 =
499 appendTree2 m1 (node3 a b c) (node3 d e f) m2
500 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
501 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
502 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
503 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
504 addDigits2 m1 (Three a b c) d e (One f) m2 =
505 appendTree2 m1 (node3 a b c) (node3 d e f) m2
506 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
507 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
508 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
509 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
510 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
511 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
512 addDigits2 m1 (Four a b c d) e f (One g) m2 =
513 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
514 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
515 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
516 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
517 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
518 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
519 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
521 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
522 appendTree3 Empty a b c xs =
523 a `consTree` b `consTree` c `consTree` xs
524 appendTree3 xs a b c Empty =
525 xs `snocTree` a `snocTree` b `snocTree` c
526 appendTree3 (Single x) a b c xs =
527 x `consTree` a `consTree` b `consTree` c `consTree` xs
528 appendTree3 xs a b c (Single x) =
529 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
530 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
531 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
533 addDigits3 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
534 addDigits3 m1 (One a) b c d (One e) m2 =
535 appendTree2 m1 (node3 a b c) (node2 d e) m2
536 addDigits3 m1 (One a) b c d (Two e f) m2 =
537 appendTree2 m1 (node3 a b c) (node3 d e f) m2
538 addDigits3 m1 (One a) b c d (Three e f g) m2 =
539 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
540 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
541 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
542 addDigits3 m1 (Two a b) c d e (One f) m2 =
543 appendTree2 m1 (node3 a b c) (node3 d e f) m2
544 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
545 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
546 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
547 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
548 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
549 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
550 addDigits3 m1 (Three a b c) d e f (One g) m2 =
551 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
552 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
553 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
554 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
555 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
556 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
557 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
558 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
559 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
560 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
561 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
562 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
563 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
564 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
565 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
567 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
568 appendTree4 Empty a b c d xs =
569 a `consTree` b `consTree` c `consTree` d `consTree` xs
570 appendTree4 xs a b c d Empty =
571 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
572 appendTree4 (Single x) a b c d xs =
573 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
574 appendTree4 xs a b c d (Single x) =
575 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
576 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
577 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
579 addDigits4 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
580 addDigits4 m1 (One a) b c d e (One f) m2 =
581 appendTree2 m1 (node3 a b c) (node3 d e f) m2
582 addDigits4 m1 (One a) b c d e (Two f g) m2 =
583 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
584 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
585 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
586 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
587 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
588 addDigits4 m1 (Two a b) c d e f (One g) m2 =
589 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
590 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
591 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
592 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
593 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
594 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
595 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
596 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
597 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
598 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
599 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
600 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
601 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
602 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
603 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
604 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
605 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
606 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
607 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
608 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
609 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
610 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
611 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
613 ------------------------------------------------------------------------
615 ------------------------------------------------------------------------
617 -- | /O(1)/. Is this the empty sequence?
618 null :: Seq a -> Bool
619 null (Seq Empty) = True
622 -- | /O(1)/. The number of elements in the sequence.
623 length :: Seq a -> Int
624 length (Seq xs) = size xs
628 data Maybe2 a b = Nothing2 | Just2 a b
630 -- | View of the left end of a sequence.
632 = EmptyL -- ^ empty sequence
633 | a :< Seq a -- ^ leftmost element and the rest of the sequence
637 instance Eq a => Eq (ViewL a)
638 instance Show a => Show (ViewL a)
642 instance Functor ViewL where
643 fmap _ EmptyL = EmptyL
644 fmap f (x :< xs) = f x :< fmap f xs
646 -- | /O(1)/. Analyse the left end of a sequence.
647 viewl :: Seq a -> ViewL a
648 viewl (Seq xs) = case viewLTree xs of
650 Just2 (Elem x) xs' -> x :< Seq xs'
652 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
653 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
654 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
655 viewLTree Empty = Nothing2
656 viewLTree (Single a) = Just2 a Empty
657 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
658 Nothing2 -> digitToTree sf
659 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
660 viewLTree (Deep s (Two a b) m sf) =
661 Just2 a (Deep (s - size a) (One b) m sf)
662 viewLTree (Deep s (Three a b c) m sf) =
663 Just2 a (Deep (s - size a) (Two b c) m sf)
664 viewLTree (Deep s (Four a b c d) m sf) =
665 Just2 a (Deep (s - size a) (Three b c d) m sf)
667 -- | View of the right end of a sequence.
669 = EmptyR -- ^ empty sequence
670 | Seq a :> a -- ^ the sequence minus the rightmost element,
671 -- and the rightmost element
675 instance Eq a => Eq (ViewR a)
676 instance Show a => Show (ViewR a)
679 instance Functor ViewR where
680 fmap _ EmptyR = EmptyR
681 fmap f (xs :> x) = fmap f xs :> f x
683 -- | /O(1)/. Analyse the right end of a sequence.
684 viewr :: Seq a -> ViewR a
685 viewr (Seq xs) = case viewRTree xs of
687 Just2 xs' (Elem x) -> Seq xs' :> x
689 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
690 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
691 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
692 viewRTree Empty = Nothing2
693 viewRTree (Single z) = Just2 Empty z
694 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
695 Nothing2 -> digitToTree pr
696 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
697 viewRTree (Deep s pr m (Two y z)) =
698 Just2 (Deep (s - size z) pr m (One y)) z
699 viewRTree (Deep s pr m (Three x y z)) =
700 Just2 (Deep (s - size z) pr m (Two x y)) z
701 viewRTree (Deep s pr m (Four w x y z)) =
702 Just2 (Deep (s - size z) pr m (Three w x y)) z
706 -- | /O(log(min(i,n-i)))/. The element at the specified position
707 index :: Seq a -> Int -> a
709 | 0 <= i && i < size xs = case lookupTree (-i) xs of
710 Place _ (Elem x) -> x
711 | otherwise = error "index out of bounds"
713 data Place a = Place {-# UNPACK #-} !Int a
718 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
719 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
720 lookupTree :: Sized a => Int -> FingerTree a -> Place a
721 lookupTree _ Empty = error "lookupTree of empty tree"
722 lookupTree i (Single x) = Place i x
723 lookupTree i (Deep _ pr m sf)
724 | vpr > 0 = lookupDigit i pr
725 | vm > 0 = case lookupTree vpr m of
726 Place i' xs -> lookupNode i' xs
727 | otherwise = lookupDigit vm sf
728 where vpr = i + size pr
731 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
732 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
733 lookupNode :: Sized a => Int -> Node a -> Place a
734 lookupNode i (Node2 _ a b)
736 | otherwise = Place va b
737 where va = i + size a
738 lookupNode i (Node3 _ a b c)
740 | vab > 0 = Place va b
741 | otherwise = Place vab c
742 where va = i + size a
745 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
746 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
747 lookupDigit :: Sized a => Int -> Digit a -> Place a
748 lookupDigit i (One a) = Place i a
749 lookupDigit i (Two a b)
751 | otherwise = Place va b
752 where va = i + size a
753 lookupDigit i (Three a b c)
755 | vab > 0 = Place va b
756 | otherwise = Place vab c
757 where va = i + size a
759 lookupDigit i (Four a b c d)
761 | vab > 0 = Place va b
762 | vabc > 0 = Place vab c
763 | otherwise = Place vabc d
764 where va = i + size a
768 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
769 update :: Int -> a -> Seq a -> Seq a
770 update i x = adjust (const x) i
772 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
773 adjust :: (a -> a) -> Int -> Seq a -> Seq a
775 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
778 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
779 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
780 adjustTree :: Sized a => (Int -> a -> a) ->
781 Int -> FingerTree a -> FingerTree a
782 adjustTree _ _ Empty = error "adjustTree of empty tree"
783 adjustTree f i (Single x) = Single (f i x)
784 adjustTree f i (Deep s pr m sf)
785 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
786 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
787 | otherwise = Deep s pr m (adjustDigit f vm sf)
788 where vpr = i + size pr
791 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
792 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
793 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
794 adjustNode f i (Node2 s a b)
795 | va > 0 = Node2 s (f i a) b
796 | otherwise = Node2 s a (f va b)
797 where va = i + size a
798 adjustNode f i (Node3 s a b c)
799 | va > 0 = Node3 s (f i a) b c
800 | vab > 0 = Node3 s a (f va b) c
801 | otherwise = Node3 s a b (f vab c)
802 where va = i + size a
805 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
806 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
807 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
808 adjustDigit f i (One a) = One (f i a)
809 adjustDigit f i (Two a b)
810 | va > 0 = Two (f i a) b
811 | otherwise = Two a (f va b)
812 where va = i + size a
813 adjustDigit f i (Three a b c)
814 | va > 0 = Three (f i a) b c
815 | vab > 0 = Three a (f va b) c
816 | otherwise = Three a b (f vab c)
817 where va = i + size a
819 adjustDigit f i (Four a b c d)
820 | va > 0 = Four (f i a) b c d
821 | vab > 0 = Four a (f va b) c d
822 | vabc > 0 = Four a b (f vab c) d
823 | otherwise = Four a b c (f vabc d)
824 where va = i + size a
830 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
831 take :: Int -> Seq a -> Seq a
832 take i = fst . splitAt i
834 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
835 drop :: Int -> Seq a -> Seq a
836 drop i = snd . splitAt i
838 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
839 splitAt :: Int -> Seq a -> (Seq a, Seq a)
840 splitAt i (Seq xs) = (Seq l, Seq r)
841 where (l, r) = split i xs
843 split :: Int -> FingerTree (Elem a) ->
844 (FingerTree (Elem a), FingerTree (Elem a))
845 split i Empty = i `seq` (Empty, Empty)
847 | size xs > i = (l, consTree x r)
848 | otherwise = (xs, Empty)
849 where Split l x r = splitTree (-i) xs
851 data Split t a = Split t a t
856 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
857 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
858 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
859 splitTree _ Empty = error "splitTree of empty tree"
860 splitTree i (Single x) = i `seq` Split Empty x Empty
861 splitTree i (Deep _ pr m sf)
862 | vpr > 0 = case splitDigit i pr of
863 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
864 | vm > 0 = case splitTree vpr m of
865 Split ml xs mr -> case splitNode (vpr + size ml) xs of
866 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
867 | otherwise = case splitDigit vm sf of
868 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
869 where vpr = i + size pr
872 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
873 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
874 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
875 deepL Nothing m sf = case viewLTree m of
876 Nothing2 -> digitToTree sf
877 Just2 a m' -> deep (nodeToDigit a) m' sf
878 deepL (Just pr) m sf = deep pr m sf
880 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
881 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
882 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
883 deepR pr m Nothing = case viewRTree m of
884 Nothing2 -> digitToTree pr
885 Just2 m' a -> deep pr m' (nodeToDigit a)
886 deepR pr m (Just sf) = deep pr m sf
888 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
889 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
890 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
891 splitNode i (Node2 _ a b)
892 | va > 0 = Split Nothing a (Just (One b))
893 | otherwise = Split (Just (One a)) b Nothing
894 where va = i + size a
895 splitNode i (Node3 _ a b c)
896 | va > 0 = Split Nothing a (Just (Two b c))
897 | vab > 0 = Split (Just (One a)) b (Just (One c))
898 | otherwise = Split (Just (Two a b)) c Nothing
899 where va = i + size a
902 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
903 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
904 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
905 splitDigit i (One a) = i `seq` Split Nothing a Nothing
906 splitDigit i (Two a b)
907 | va > 0 = Split Nothing a (Just (One b))
908 | otherwise = Split (Just (One a)) b Nothing
909 where va = i + size a
910 splitDigit i (Three a b c)
911 | va > 0 = Split Nothing a (Just (Two b c))
912 | vab > 0 = Split (Just (One a)) b (Just (One c))
913 | otherwise = Split (Just (Two a b)) c Nothing
914 where va = i + size a
916 splitDigit i (Four a b c d)
917 | va > 0 = Split Nothing a (Just (Three b c d))
918 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
919 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
920 | otherwise = Split (Just (Three a b c)) d Nothing
921 where va = i + size a
925 ------------------------------------------------------------------------
927 ------------------------------------------------------------------------
929 -- | /O(n)/. Create a sequence from a finite list of elements.
930 fromList :: [a] -> Seq a
931 fromList = Data.List.foldl' (|>) empty
933 -- | /O(n)/. List of elements of the sequence.
934 toList :: Seq a -> [a]
935 #ifdef __GLASGOW_HASKELL__
936 {-# INLINE toList #-}
937 toList xs = build (\ c n -> foldr c n xs)
939 toList = foldr (:) []
942 ------------------------------------------------------------------------
944 ------------------------------------------------------------------------
946 -- | /O(n*t)/. Fold over the elements of a sequence,
947 -- associating to the right.
948 foldr :: (a -> b -> b) -> b -> Seq a -> b
949 foldr f z (Seq xs) = foldrTree f' z xs
950 where f' (Elem x) y = f x y
952 foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
953 foldrTree _ z Empty = z
954 foldrTree f z (Single x) = x `f` z
955 foldrTree f z (Deep _ pr m sf) =
956 foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr
958 foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
959 foldrDigit f z (One a) = a `f` z
960 foldrDigit f z (Two a b) = a `f` (b `f` z)
961 foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z))
962 foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
964 foldrNode :: (a -> b -> b) -> b -> Node a -> b
965 foldrNode f z (Node2 _ a b) = a `f` (b `f` z)
966 foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
968 -- | /O(n*t)/. A variant of 'foldr' that has no base case,
969 -- and thus may only be applied to non-empty sequences.
970 foldr1 :: (a -> a -> a) -> Seq a -> a
971 foldr1 f (Seq xs) = getElem (foldr1Tree f' xs)
972 where f' (Elem x) (Elem y) = Elem (f x y)
974 foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
975 foldr1Tree _ Empty = error "foldr1: empty sequence"
976 foldr1Tree _ (Single x) = x
977 foldr1Tree f (Deep _ pr m sf) =
978 foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr
980 foldr1Digit :: (a -> a -> a) -> Digit a -> a
981 foldr1Digit f (One a) = a
982 foldr1Digit f (Two a b) = a `f` b
983 foldr1Digit f (Three a b c) = a `f` (b `f` c)
984 foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d))
986 -- | /O(n*t)/. Fold over the elements of a sequence,
987 -- associating to the left.
988 foldl :: (a -> b -> a) -> a -> Seq b -> a
989 foldl f z (Seq xs) = foldlTree f' z xs
990 where f' x (Elem y) = f x y
992 foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
993 foldlTree _ z Empty = z
994 foldlTree f z (Single x) = z `f` x
995 foldlTree f z (Deep _ pr m sf) =
996 foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
998 foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
999 foldlDigit f z (One a) = z `f` a
1000 foldlDigit f z (Two a b) = (z `f` a) `f` b
1001 foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c
1002 foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
1004 foldlNode :: (a -> b -> a) -> a -> Node b -> a
1005 foldlNode f z (Node2 _ a b) = (z `f` a) `f` b
1006 foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
1008 -- | /O(n*t)/. A variant of 'foldl' that has no base case,
1009 -- and thus may only be applied to non-empty sequences.
1010 foldl1 :: (a -> a -> a) -> Seq a -> a
1011 foldl1 f (Seq xs) = getElem (foldl1Tree f' xs)
1012 where f' (Elem x) (Elem y) = Elem (f x y)
1014 foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
1015 foldl1Tree _ Empty = error "foldl1: empty sequence"
1016 foldl1Tree _ (Single x) = x
1017 foldl1Tree f (Deep _ pr m sf) =
1018 foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf
1020 foldl1Digit :: (a -> a -> a) -> Digit a -> a
1021 foldl1Digit f (One a) = a
1022 foldl1Digit f (Two a b) = a `f` b
1023 foldl1Digit f (Three a b c) = (a `f` b) `f` c
1024 foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d
1026 ------------------------------------------------------------------------
1028 ------------------------------------------------------------------------
1030 -- | /O(n*t)/. Fold over the elements of a sequence,
1031 -- associating to the right, but strictly.
1032 foldr' :: (a -> b -> b) -> b -> Seq a -> b
1033 foldr' f z xs = foldl f' id xs z
1034 where f' k x z = k $! f x z
1036 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1037 -- associating to the right, i.e. from right to left.
1038 foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
1039 foldrM f z xs = foldl f' return xs z
1040 where f' k x z = f x z >>= k
1042 -- | /O(n*t)/. Fold over the elements of a sequence,
1043 -- associating to the left, but strictly.
1044 foldl' :: (a -> b -> a) -> a -> Seq b -> a
1045 foldl' f z xs = foldr f' id xs z
1046 where f' x k z = k $! f z x
1048 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1049 -- associating to the left, i.e. from left to right.
1050 foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
1051 foldlM f z xs = foldr f' return xs z
1052 where f' x k z = f z x >>= k
1054 ------------------------------------------------------------------------
1056 ------------------------------------------------------------------------
1058 -- | /O(n)/. The reverse of a sequence.
1059 reverse :: Seq a -> Seq a
1060 reverse (Seq xs) = Seq (reverseTree id xs)
1062 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1063 reverseTree _ Empty = Empty
1064 reverseTree f (Single x) = Single (f x)
1065 reverseTree f (Deep s pr m sf) =
1066 Deep s (reverseDigit f sf)
1067 (reverseTree (reverseNode f) m)
1070 reverseDigit :: (a -> a) -> Digit a -> Digit a
1071 reverseDigit f (One a) = One (f a)
1072 reverseDigit f (Two a b) = Two (f b) (f a)
1073 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1074 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1076 reverseNode :: (a -> a) -> Node a -> Node a
1077 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1078 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1082 ------------------------------------------------------------------------
1084 ------------------------------------------------------------------------
1086 instance Arbitrary a => Arbitrary (Seq a) where
1087 arbitrary = liftM Seq arbitrary
1088 coarbitrary (Seq x) = coarbitrary x
1090 instance Arbitrary a => Arbitrary (Elem a) where
1091 arbitrary = liftM Elem arbitrary
1092 coarbitrary (Elem x) = coarbitrary x
1094 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1095 arbitrary = sized arb
1096 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1097 arb 0 = return Empty
1098 arb 1 = liftM Single arbitrary
1099 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1101 coarbitrary Empty = variant 0
1102 coarbitrary (Single x) = variant 1 . coarbitrary x
1103 coarbitrary (Deep _ pr m sf) =
1104 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1106 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1108 liftM2 node2 arbitrary arbitrary,
1109 liftM3 node3 arbitrary arbitrary arbitrary]
1111 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1112 coarbitrary (Node3 _ a b c) =
1113 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1115 instance Arbitrary a => Arbitrary (Digit a) where
1117 liftM One arbitrary,
1118 liftM2 Two arbitrary arbitrary,
1119 liftM3 Three arbitrary arbitrary arbitrary,
1120 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1122 coarbitrary (One a) = variant 0 . coarbitrary a
1123 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1124 coarbitrary (Three a b c) =
1125 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1126 coarbitrary (Four a b c d) =
1127 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1129 ------------------------------------------------------------------------
1131 ------------------------------------------------------------------------
1136 instance Valid (Elem a) where
1139 instance Valid (Seq a) where
1140 valid (Seq xs) = valid xs
1142 instance (Sized a, Valid a) => Valid (FingerTree a) where
1144 valid (Single x) = valid x
1145 valid (Deep s pr m sf) =
1146 s == size pr + size m + size sf && valid pr && valid m && valid sf
1148 instance (Sized a, Valid a) => Valid (Node a) where
1149 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1150 valid (Node3 s a b c) =
1151 s == size a + size b + size c && valid a && valid b && valid c
1153 instance Valid a => Valid (Digit a) where
1154 valid (One a) = valid a
1155 valid (Two a b) = valid a && valid b
1156 valid (Three a b c) = valid a && valid b && valid c
1157 valid (Four a b c d) = valid a && valid b && valid c && valid d