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 Data.List (foldl')
83 import Control.Monad (MonadPlus(..), liftM2)
87 #ifdef __GLASGOW_HASKELL__
88 import GHC.Exts (build)
89 import Text.Read (Lexeme(Ident), lexP, parens, prec,
90 readPrec, readListPrec, readListPrecDefault)
91 import Data.Generics.Basics (Data(..), Fixity(..),
92 constrIndex, mkConstr, mkDataType)
96 import Control.Monad (liftM, 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 p xs = showParen (p > 10) $
145 showString "fromList " . shows (toList xs)
148 instance Read a => Read (Seq a) where
149 #ifdef __GLASGOW_HASKELL__
150 readPrec = parens $ prec 10 $ do
151 Ident "fromList" <- lexP
155 readListPrec = readListPrecDefault
157 readsPrec p = readParen (p > 10) $ \ r -> do
158 ("fromList",s) <- lex r
160 return (fromList xs,t)
163 #include "Typeable.h"
164 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
166 #if __GLASGOW_HASKELL__
167 instance Data a => Data (Seq a) where
168 gfoldl f z s = case viewl s of
170 x :< xs -> z (<|) `f` x `f` xs
172 gunfold k z c = case constrIndex c of
178 | null xs = emptyConstr
179 | otherwise = consConstr
181 dataTypeOf _ = seqDataType
185 emptyConstr = mkConstr seqDataType "empty" [] Prefix
186 consConstr = mkConstr seqDataType "<|" [] Infix
187 seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
195 | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
200 instance Sized a => Sized (FingerTree a) where
201 {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
202 {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
204 size (Single x) = size x
205 size (Deep v _ _ _) = v
207 instance Functor FingerTree where
209 fmap f (Single x) = Single (f x)
210 fmap f (Deep v pr m sf) =
211 Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
214 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
215 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
216 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
217 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
230 instance Functor Digit where
231 fmap f (One a) = One (f a)
232 fmap f (Two a b) = Two (f a) (f b)
233 fmap f (Three a b c) = Three (f a) (f b) (f c)
234 fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)
236 instance Sized a => Sized (Digit a) where
237 {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
238 {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
239 size xs = foldlDigit (\ i x -> i + size x) 0 xs
241 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
242 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
243 digitToTree :: Sized a => Digit a -> FingerTree a
244 digitToTree (One a) = Single a
245 digitToTree (Two a b) = deep (One a) Empty (One b)
246 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
247 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
252 = Node2 {-# UNPACK #-} !Int a a
253 | Node3 {-# UNPACK #-} !Int a a a
258 instance Functor (Node) where
259 fmap f (Node2 v a b) = Node2 v (f a) (f b)
260 fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
262 instance Sized (Node a) where
263 size (Node2 v _ _) = v
264 size (Node3 v _ _ _) = v
267 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
268 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
269 node2 :: Sized a => a -> a -> Node a
270 node2 a b = Node2 (size a + size b) a b
273 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
274 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
275 node3 :: Sized a => a -> a -> a -> Node a
276 node3 a b c = Node3 (size a + size b + size c) a b c
278 nodeToDigit :: Node a -> Digit a
279 nodeToDigit (Node2 _ a b) = Two a b
280 nodeToDigit (Node3 _ a b c) = Three a b c
284 newtype Elem a = Elem { getElem :: a }
286 instance Sized (Elem a) where
289 instance Functor Elem where
290 fmap f (Elem x) = Elem (f x)
293 instance (Show a) => Show (Elem a) where
294 showsPrec p (Elem x) = showsPrec p x
297 ------------------------------------------------------------------------
299 ------------------------------------------------------------------------
301 -- | /O(1)/. The empty sequence.
305 -- | /O(1)/. A singleton sequence.
306 singleton :: a -> Seq a
307 singleton x = Seq (Single (Elem x))
309 -- | /O(1)/. Add an element to the left end of a sequence.
310 -- Mnemonic: a triangle with the single element at the pointy end.
311 (<|) :: a -> Seq a -> Seq a
312 x <| Seq xs = Seq (Elem x `consTree` xs)
314 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
315 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
316 consTree :: Sized a => a -> FingerTree a -> FingerTree a
317 consTree a Empty = Single a
318 consTree a (Single b) = deep (One a) Empty (One b)
319 consTree a (Deep s (Four b c d e) m sf) = m `seq`
320 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
321 consTree a (Deep s (Three b c d) m sf) =
322 Deep (size a + s) (Four a b c d) m sf
323 consTree a (Deep s (Two b c) m sf) =
324 Deep (size a + s) (Three a b c) m sf
325 consTree a (Deep s (One b) m sf) =
326 Deep (size a + s) (Two a b) m sf
328 -- | /O(1)/. Add an element to the right end of a sequence.
329 -- Mnemonic: a triangle with the single element at the pointy end.
330 (|>) :: Seq a -> a -> Seq a
331 Seq xs |> x = Seq (xs `snocTree` Elem x)
333 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
334 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
335 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
336 snocTree Empty a = Single a
337 snocTree (Single a) b = deep (One a) Empty (One b)
338 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
339 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
340 snocTree (Deep s pr m (Three a b c)) d =
341 Deep (s + size d) pr m (Four a b c d)
342 snocTree (Deep s pr m (Two a b)) c =
343 Deep (s + size c) pr m (Three a b c)
344 snocTree (Deep s pr m (One a)) b =
345 Deep (s + size b) pr m (Two a b)
347 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
348 (><) :: Seq a -> Seq a -> Seq a
349 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
351 -- The appendTree/addDigits gunk below is machine generated
353 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
354 appendTree0 Empty xs =
356 appendTree0 xs Empty =
358 appendTree0 (Single x) xs =
360 appendTree0 xs (Single x) =
362 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
363 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
365 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
366 addDigits0 m1 (One a) (One b) m2 =
367 appendTree1 m1 (node2 a b) m2
368 addDigits0 m1 (One a) (Two b c) m2 =
369 appendTree1 m1 (node3 a b c) m2
370 addDigits0 m1 (One a) (Three b c d) m2 =
371 appendTree2 m1 (node2 a b) (node2 c d) m2
372 addDigits0 m1 (One a) (Four b c d e) m2 =
373 appendTree2 m1 (node3 a b c) (node2 d e) m2
374 addDigits0 m1 (Two a b) (One c) m2 =
375 appendTree1 m1 (node3 a b c) m2
376 addDigits0 m1 (Two a b) (Two c d) m2 =
377 appendTree2 m1 (node2 a b) (node2 c d) m2
378 addDigits0 m1 (Two a b) (Three c d e) m2 =
379 appendTree2 m1 (node3 a b c) (node2 d e) m2
380 addDigits0 m1 (Two a b) (Four c d e f) m2 =
381 appendTree2 m1 (node3 a b c) (node3 d e f) m2
382 addDigits0 m1 (Three a b c) (One d) m2 =
383 appendTree2 m1 (node2 a b) (node2 c d) m2
384 addDigits0 m1 (Three a b c) (Two d e) m2 =
385 appendTree2 m1 (node3 a b c) (node2 d e) m2
386 addDigits0 m1 (Three a b c) (Three d e f) m2 =
387 appendTree2 m1 (node3 a b c) (node3 d e f) m2
388 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
389 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
390 addDigits0 m1 (Four a b c d) (One e) m2 =
391 appendTree2 m1 (node3 a b c) (node2 d e) m2
392 addDigits0 m1 (Four a b c d) (Two e f) m2 =
393 appendTree2 m1 (node3 a b c) (node3 d e f) m2
394 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
395 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
396 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
397 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
399 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
400 appendTree1 Empty a xs =
402 appendTree1 xs a Empty =
404 appendTree1 (Single x) a xs =
405 x `consTree` a `consTree` xs
406 appendTree1 xs a (Single x) =
407 xs `snocTree` a `snocTree` x
408 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
409 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
411 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
412 addDigits1 m1 (One a) b (One c) m2 =
413 appendTree1 m1 (node3 a b c) m2
414 addDigits1 m1 (One a) b (Two c d) m2 =
415 appendTree2 m1 (node2 a b) (node2 c d) m2
416 addDigits1 m1 (One a) b (Three c d e) m2 =
417 appendTree2 m1 (node3 a b c) (node2 d e) m2
418 addDigits1 m1 (One a) b (Four c d e f) m2 =
419 appendTree2 m1 (node3 a b c) (node3 d e f) m2
420 addDigits1 m1 (Two a b) c (One d) m2 =
421 appendTree2 m1 (node2 a b) (node2 c d) m2
422 addDigits1 m1 (Two a b) c (Two d e) m2 =
423 appendTree2 m1 (node3 a b c) (node2 d e) m2
424 addDigits1 m1 (Two a b) c (Three d e f) m2 =
425 appendTree2 m1 (node3 a b c) (node3 d e f) m2
426 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
427 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
428 addDigits1 m1 (Three a b c) d (One e) m2 =
429 appendTree2 m1 (node3 a b c) (node2 d e) m2
430 addDigits1 m1 (Three a b c) d (Two e f) m2 =
431 appendTree2 m1 (node3 a b c) (node3 d e f) m2
432 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
433 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
434 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
435 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
436 addDigits1 m1 (Four a b c d) e (One f) m2 =
437 appendTree2 m1 (node3 a b c) (node3 d e f) m2
438 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
439 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
440 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
441 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
442 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
443 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
445 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
446 appendTree2 Empty a b xs =
447 a `consTree` b `consTree` xs
448 appendTree2 xs a b Empty =
449 xs `snocTree` a `snocTree` b
450 appendTree2 (Single x) a b xs =
451 x `consTree` a `consTree` b `consTree` xs
452 appendTree2 xs a b (Single x) =
453 xs `snocTree` a `snocTree` b `snocTree` x
454 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
455 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
457 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
458 addDigits2 m1 (One a) b c (One d) m2 =
459 appendTree2 m1 (node2 a b) (node2 c d) m2
460 addDigits2 m1 (One a) b c (Two d e) m2 =
461 appendTree2 m1 (node3 a b c) (node2 d e) m2
462 addDigits2 m1 (One a) b c (Three d e f) m2 =
463 appendTree2 m1 (node3 a b c) (node3 d e f) m2
464 addDigits2 m1 (One a) b c (Four d e f g) m2 =
465 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
466 addDigits2 m1 (Two a b) c d (One e) m2 =
467 appendTree2 m1 (node3 a b c) (node2 d e) m2
468 addDigits2 m1 (Two a b) c d (Two e f) m2 =
469 appendTree2 m1 (node3 a b c) (node3 d e f) m2
470 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
471 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
472 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
473 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
474 addDigits2 m1 (Three a b c) d e (One f) m2 =
475 appendTree2 m1 (node3 a b c) (node3 d e f) m2
476 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
477 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
478 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
479 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
480 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
481 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
482 addDigits2 m1 (Four a b c d) e f (One g) m2 =
483 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
484 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
485 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
486 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
487 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
488 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
489 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
491 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
492 appendTree3 Empty a b c xs =
493 a `consTree` b `consTree` c `consTree` xs
494 appendTree3 xs a b c Empty =
495 xs `snocTree` a `snocTree` b `snocTree` c
496 appendTree3 (Single x) a b c xs =
497 x `consTree` a `consTree` b `consTree` c `consTree` xs
498 appendTree3 xs a b c (Single x) =
499 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
500 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
501 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
503 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))
504 addDigits3 m1 (One a) b c d (One e) m2 =
505 appendTree2 m1 (node3 a b c) (node2 d e) m2
506 addDigits3 m1 (One a) b c d (Two e f) m2 =
507 appendTree2 m1 (node3 a b c) (node3 d e f) m2
508 addDigits3 m1 (One a) b c d (Three e f g) m2 =
509 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
510 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
511 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
512 addDigits3 m1 (Two a b) c d e (One f) m2 =
513 appendTree2 m1 (node3 a b c) (node3 d e f) m2
514 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
515 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
516 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
517 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
518 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
519 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
520 addDigits3 m1 (Three a b c) d e f (One g) m2 =
521 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
522 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
523 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
524 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
525 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
526 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
527 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
528 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
529 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
530 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
531 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
532 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
533 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
534 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
535 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
537 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
538 appendTree4 Empty a b c d xs =
539 a `consTree` b `consTree` c `consTree` d `consTree` xs
540 appendTree4 xs a b c d Empty =
541 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
542 appendTree4 (Single x) a b c d xs =
543 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
544 appendTree4 xs a b c d (Single x) =
545 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
546 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
547 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
549 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))
550 addDigits4 m1 (One a) b c d e (One f) m2 =
551 appendTree2 m1 (node3 a b c) (node3 d e f) m2
552 addDigits4 m1 (One a) b c d e (Two f g) m2 =
553 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
554 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
555 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
556 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
557 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
558 addDigits4 m1 (Two a b) c d e f (One g) m2 =
559 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
560 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
561 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
562 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
563 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
564 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
565 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
566 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
567 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
568 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
569 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
570 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
571 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
572 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
573 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
574 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
575 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
576 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
577 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
578 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
579 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
580 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
581 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
583 ------------------------------------------------------------------------
585 ------------------------------------------------------------------------
587 -- | /O(1)/. Is this the empty sequence?
588 null :: Seq a -> Bool
589 null (Seq Empty) = True
592 -- | /O(1)/. The number of elements in the sequence.
593 length :: Seq a -> Int
594 length (Seq xs) = size xs
598 data Maybe2 a b = Nothing2 | Just2 a b
600 -- | View of the left end of a sequence.
602 = EmptyL -- ^ empty sequence
603 | a :< Seq a -- ^ leftmost element and the rest of the sequence
605 # if __GLASGOW_HASKELL__
606 deriving (Eq, Ord, Show, Read, Data)
608 deriving (Eq, Ord, Show, Read)
611 instance Eq a => Eq (ViewL a)
612 instance Ord a => Ord (ViewL a)
613 instance Show a => Show (ViewL a)
614 instance Read a => Read (ViewL a)
615 instance Data a => Data (ViewL a)
618 INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL")
620 instance Functor ViewL where
621 fmap _ EmptyL = EmptyL
622 fmap f (x :< xs) = f x :< fmap f xs
624 instance FunctorM ViewL where
625 fmapM _ EmptyL = return EmptyL
626 fmapM f (x :< xs) = liftM2 (:<) (f x) (fmapM f xs)
627 fmapM_ _ EmptyL = return ()
628 fmapM_ f (x :< xs) = f x >> fmapM_ f xs >> return ()
630 -- | /O(1)/. Analyse the left end of a sequence.
631 viewl :: Seq a -> ViewL a
632 viewl (Seq xs) = case viewLTree xs of
634 Just2 (Elem x) xs' -> x :< Seq xs'
636 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
637 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
638 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
639 viewLTree Empty = Nothing2
640 viewLTree (Single a) = Just2 a Empty
641 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
642 Nothing2 -> digitToTree sf
643 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
644 viewLTree (Deep s (Two a b) m sf) =
645 Just2 a (Deep (s - size a) (One b) m sf)
646 viewLTree (Deep s (Three a b c) m sf) =
647 Just2 a (Deep (s - size a) (Two b c) m sf)
648 viewLTree (Deep s (Four a b c d) m sf) =
649 Just2 a (Deep (s - size a) (Three b c d) m sf)
651 -- | View of the right end of a sequence.
653 = EmptyR -- ^ empty sequence
654 | Seq a :> a -- ^ the sequence minus the rightmost element,
655 -- and the rightmost element
657 # if __GLASGOW_HASKELL__
658 deriving (Eq, Ord, Show, Read, Data)
660 deriving (Eq, Ord, Show, Read)
663 instance Eq a => Eq (ViewR a)
664 instance Ord a => Ord (ViewR a)
665 instance Show a => Show (ViewR a)
666 instance Read a => Read (ViewR a)
667 instance Data a => Data (ViewR a)
670 INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR")
672 instance Functor ViewR where
673 fmap _ EmptyR = EmptyR
674 fmap f (xs :> x) = fmap f xs :> f x
676 instance FunctorM ViewR where
677 fmapM _ EmptyR = return EmptyR
678 fmapM f (xs :> x) = liftM2 (:>) (fmapM f xs) (f x)
679 fmapM_ _ EmptyR = return ()
680 fmapM_ f (xs :> x) = fmapM_ f xs >> f x >> return ()
682 -- | /O(1)/. Analyse the right end of a sequence.
683 viewr :: Seq a -> ViewR a
684 viewr (Seq xs) = case viewRTree xs of
686 Just2 xs' (Elem x) -> Seq xs' :> x
688 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
689 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
690 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
691 viewRTree Empty = Nothing2
692 viewRTree (Single z) = Just2 Empty z
693 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
694 Nothing2 -> digitToTree pr
695 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
696 viewRTree (Deep s pr m (Two y z)) =
697 Just2 (Deep (s - size z) pr m (One y)) z
698 viewRTree (Deep s pr m (Three x y z)) =
699 Just2 (Deep (s - size z) pr m (Two x y)) z
700 viewRTree (Deep s pr m (Four w x y z)) =
701 Just2 (Deep (s - size z) pr m (Three w x y)) z
705 -- | /O(log(min(i,n-i)))/. The element at the specified position
706 index :: Seq a -> Int -> a
708 | 0 <= i && i < size xs = case lookupTree (-i) xs of
709 Place _ (Elem x) -> x
710 | otherwise = error "index out of bounds"
712 data Place a = Place {-# UNPACK #-} !Int a
717 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
718 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
719 lookupTree :: Sized a => Int -> FingerTree a -> Place a
720 lookupTree _ Empty = error "lookupTree of empty tree"
721 lookupTree i (Single x) = Place i x
722 lookupTree i (Deep _ pr m sf)
723 | vpr > 0 = lookupDigit i pr
724 | vm > 0 = case lookupTree vpr m of
725 Place i' xs -> lookupNode i' xs
726 | otherwise = lookupDigit vm sf
727 where vpr = i + size pr
730 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
731 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
732 lookupNode :: Sized a => Int -> Node a -> Place a
733 lookupNode i (Node2 _ a b)
735 | otherwise = Place va b
736 where va = i + size a
737 lookupNode i (Node3 _ a b c)
739 | vab > 0 = Place va b
740 | otherwise = Place vab c
741 where va = i + size a
744 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
745 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
746 lookupDigit :: Sized a => Int -> Digit a -> Place a
747 lookupDigit i (One a) = Place i a
748 lookupDigit i (Two a b)
750 | otherwise = Place va b
751 where va = i + size a
752 lookupDigit i (Three a b c)
754 | vab > 0 = Place va b
755 | otherwise = Place vab c
756 where va = i + size a
758 lookupDigit i (Four a b c d)
760 | vab > 0 = Place va b
761 | vabc > 0 = Place vab c
762 | otherwise = Place vabc d
763 where va = i + size a
767 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
768 update :: Int -> a -> Seq a -> Seq a
769 update i x = adjust (const x) i
771 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
772 adjust :: (a -> a) -> Int -> Seq a -> Seq a
774 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
777 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
778 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
779 adjustTree :: Sized a => (Int -> a -> a) ->
780 Int -> FingerTree a -> FingerTree a
781 adjustTree _ _ Empty = error "adjustTree of empty tree"
782 adjustTree f i (Single x) = Single (f i x)
783 adjustTree f i (Deep s pr m sf)
784 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
785 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
786 | otherwise = Deep s pr m (adjustDigit f vm sf)
787 where vpr = i + size pr
790 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
791 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
792 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
793 adjustNode f i (Node2 s a b)
794 | va > 0 = Node2 s (f i a) b
795 | otherwise = Node2 s a (f va b)
796 where va = i + size a
797 adjustNode f i (Node3 s a b c)
798 | va > 0 = Node3 s (f i a) b c
799 | vab > 0 = Node3 s a (f va b) c
800 | otherwise = Node3 s a b (f vab c)
801 where va = i + size a
804 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
805 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
806 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
807 adjustDigit f i (One a) = One (f i a)
808 adjustDigit f i (Two a b)
809 | va > 0 = Two (f i a) b
810 | otherwise = Two a (f va b)
811 where va = i + size a
812 adjustDigit f i (Three a b c)
813 | va > 0 = Three (f i a) b c
814 | vab > 0 = Three a (f va b) c
815 | otherwise = Three a b (f vab c)
816 where va = i + size a
818 adjustDigit f i (Four a b c d)
819 | va > 0 = Four (f i a) b c d
820 | vab > 0 = Four a (f va b) c d
821 | vabc > 0 = Four a b (f vab c) d
822 | otherwise = Four a b c (f vabc d)
823 where va = i + size a
829 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
830 take :: Int -> Seq a -> Seq a
831 take i = fst . splitAt i
833 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
834 drop :: Int -> Seq a -> Seq a
835 drop i = snd . splitAt i
837 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
838 splitAt :: Int -> Seq a -> (Seq a, Seq a)
839 splitAt i (Seq xs) = (Seq l, Seq r)
840 where (l, r) = split i xs
842 split :: Int -> FingerTree (Elem a) ->
843 (FingerTree (Elem a), FingerTree (Elem a))
844 split i Empty = i `seq` (Empty, Empty)
846 | size xs > i = (l, consTree x r)
847 | otherwise = (xs, Empty)
848 where Split l x r = splitTree (-i) xs
850 data Split t a = Split t a t
855 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
856 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
857 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
858 splitTree _ Empty = error "splitTree of empty tree"
859 splitTree i (Single x) = i `seq` Split Empty x Empty
860 splitTree i (Deep _ pr m sf)
861 | vpr > 0 = case splitDigit i pr of
862 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
863 | vm > 0 = case splitTree vpr m of
864 Split ml xs mr -> case splitNode (vpr + size ml) xs of
865 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
866 | otherwise = case splitDigit vm sf of
867 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
868 where vpr = i + size pr
871 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
872 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
873 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
874 deepL Nothing m sf = case viewLTree m of
875 Nothing2 -> digitToTree sf
876 Just2 a m' -> deep (nodeToDigit a) m' sf
877 deepL (Just pr) m sf = deep pr m sf
879 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
880 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
881 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
882 deepR pr m Nothing = case viewRTree m of
883 Nothing2 -> digitToTree pr
884 Just2 m' a -> deep pr m' (nodeToDigit a)
885 deepR pr m (Just sf) = deep pr m sf
887 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
888 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
889 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
890 splitNode i (Node2 _ a b)
891 | va > 0 = Split Nothing a (Just (One b))
892 | otherwise = Split (Just (One a)) b Nothing
893 where va = i + size a
894 splitNode i (Node3 _ a b c)
895 | va > 0 = Split Nothing a (Just (Two b c))
896 | vab > 0 = Split (Just (One a)) b (Just (One c))
897 | otherwise = Split (Just (Two a b)) c Nothing
898 where va = i + size a
901 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
902 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
903 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
904 splitDigit i (One a) = i `seq` Split Nothing a Nothing
905 splitDigit i (Two a b)
906 | va > 0 = Split Nothing a (Just (One b))
907 | otherwise = Split (Just (One a)) b Nothing
908 where va = i + size a
909 splitDigit i (Three a b c)
910 | va > 0 = Split Nothing a (Just (Two b c))
911 | vab > 0 = Split (Just (One a)) b (Just (One c))
912 | otherwise = Split (Just (Two a b)) c Nothing
913 where va = i + size a
915 splitDigit i (Four a b c d)
916 | va > 0 = Split Nothing a (Just (Three b c d))
917 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
918 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
919 | otherwise = Split (Just (Three a b c)) d Nothing
920 where va = i + size a
924 ------------------------------------------------------------------------
926 ------------------------------------------------------------------------
928 -- | /O(n)/. Create a sequence from a finite list of elements.
929 fromList :: [a] -> Seq a
930 fromList = Data.List.foldl' (|>) empty
932 -- | /O(n)/. List of elements of the sequence.
933 toList :: Seq a -> [a]
934 #ifdef __GLASGOW_HASKELL__
935 {-# INLINE toList #-}
936 toList xs = build (\ c n -> foldr c n xs)
938 toList = foldr (:) []
941 ------------------------------------------------------------------------
943 ------------------------------------------------------------------------
945 -- | /O(n*t)/. Fold over the elements of a sequence,
946 -- associating to the right.
947 foldr :: (a -> b -> b) -> b -> Seq a -> b
948 foldr f z (Seq xs) = foldrTree f' z xs
949 where f' (Elem x) y = f x y
951 foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
952 foldrTree _ z Empty = z
953 foldrTree f z (Single x) = x `f` z
954 foldrTree f z (Deep _ pr m sf) =
955 foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr
957 foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
958 foldrDigit f z (One a) = a `f` z
959 foldrDigit f z (Two a b) = a `f` (b `f` z)
960 foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z))
961 foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
963 foldrNode :: (a -> b -> b) -> b -> Node a -> b
964 foldrNode f z (Node2 _ a b) = a `f` (b `f` z)
965 foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
967 -- | /O(n*t)/. A variant of 'foldr' that has no base case,
968 -- and thus may only be applied to non-empty sequences.
969 foldr1 :: (a -> a -> a) -> Seq a -> a
970 foldr1 f (Seq xs) = getElem (foldr1Tree f' xs)
971 where f' (Elem x) (Elem y) = Elem (f x y)
973 foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
974 foldr1Tree _ Empty = error "foldr1: empty sequence"
975 foldr1Tree _ (Single x) = x
976 foldr1Tree f (Deep _ pr m sf) =
977 foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr
979 foldr1Digit :: (a -> a -> a) -> Digit a -> a
980 foldr1Digit f (One a) = a
981 foldr1Digit f (Two a b) = a `f` b
982 foldr1Digit f (Three a b c) = a `f` (b `f` c)
983 foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d))
985 -- | /O(n*t)/. Fold over the elements of a sequence,
986 -- associating to the left.
987 foldl :: (a -> b -> a) -> a -> Seq b -> a
988 foldl f z (Seq xs) = foldlTree f' z xs
989 where f' x (Elem y) = f x y
991 foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
992 foldlTree _ z Empty = z
993 foldlTree f z (Single x) = z `f` x
994 foldlTree f z (Deep _ pr m sf) =
995 foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
997 foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
998 foldlDigit f z (One a) = z `f` a
999 foldlDigit f z (Two a b) = (z `f` a) `f` b
1000 foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c
1001 foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
1003 foldlNode :: (a -> b -> a) -> a -> Node b -> a
1004 foldlNode f z (Node2 _ a b) = (z `f` a) `f` b
1005 foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
1007 -- | /O(n*t)/. A variant of 'foldl' that has no base case,
1008 -- and thus may only be applied to non-empty sequences.
1009 foldl1 :: (a -> a -> a) -> Seq a -> a
1010 foldl1 f (Seq xs) = getElem (foldl1Tree f' xs)
1011 where f' (Elem x) (Elem y) = Elem (f x y)
1013 foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
1014 foldl1Tree _ Empty = error "foldl1: empty sequence"
1015 foldl1Tree _ (Single x) = x
1016 foldl1Tree f (Deep _ pr m sf) =
1017 foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf
1019 foldl1Digit :: (a -> a -> a) -> Digit a -> a
1020 foldl1Digit f (One a) = a
1021 foldl1Digit f (Two a b) = a `f` b
1022 foldl1Digit f (Three a b c) = (a `f` b) `f` c
1023 foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d
1025 ------------------------------------------------------------------------
1027 ------------------------------------------------------------------------
1029 -- | /O(n*t)/. Fold over the elements of a sequence,
1030 -- associating to the right, but strictly.
1031 foldr' :: (a -> b -> b) -> b -> Seq a -> b
1032 foldr' f z xs = foldl f' id xs z
1033 where f' k x z = k $! f x z
1035 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1036 -- associating to the right, i.e. from right to left.
1037 foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
1038 foldrM f z xs = foldl f' return xs z
1039 where f' k x z = f x z >>= k
1041 -- | /O(n*t)/. Fold over the elements of a sequence,
1042 -- associating to the left, but strictly.
1043 foldl' :: (a -> b -> a) -> a -> Seq b -> a
1044 foldl' f z xs = foldr f' id xs z
1045 where f' x k z = k $! f z x
1047 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1048 -- associating to the left, i.e. from left to right.
1049 foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
1050 foldlM f z xs = foldr f' return xs z
1051 where f' x k z = f z x >>= k
1053 ------------------------------------------------------------------------
1055 ------------------------------------------------------------------------
1057 -- | /O(n)/. The reverse of a sequence.
1058 reverse :: Seq a -> Seq a
1059 reverse (Seq xs) = Seq (reverseTree id xs)
1061 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1062 reverseTree _ Empty = Empty
1063 reverseTree f (Single x) = Single (f x)
1064 reverseTree f (Deep s pr m sf) =
1065 Deep s (reverseDigit f sf)
1066 (reverseTree (reverseNode f) m)
1069 reverseDigit :: (a -> a) -> Digit a -> Digit a
1070 reverseDigit f (One a) = One (f a)
1071 reverseDigit f (Two a b) = Two (f b) (f a)
1072 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1073 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1075 reverseNode :: (a -> a) -> Node a -> Node a
1076 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1077 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1081 ------------------------------------------------------------------------
1083 ------------------------------------------------------------------------
1085 instance Arbitrary a => Arbitrary (Seq a) where
1086 arbitrary = liftM Seq arbitrary
1087 coarbitrary (Seq x) = coarbitrary x
1089 instance Arbitrary a => Arbitrary (Elem a) where
1090 arbitrary = liftM Elem arbitrary
1091 coarbitrary (Elem x) = coarbitrary x
1093 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1094 arbitrary = sized arb
1095 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1096 arb 0 = return Empty
1097 arb 1 = liftM Single arbitrary
1098 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1100 coarbitrary Empty = variant 0
1101 coarbitrary (Single x) = variant 1 . coarbitrary x
1102 coarbitrary (Deep _ pr m sf) =
1103 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1105 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1107 liftM2 node2 arbitrary arbitrary,
1108 liftM3 node3 arbitrary arbitrary arbitrary]
1110 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1111 coarbitrary (Node3 _ a b c) =
1112 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1114 instance Arbitrary a => Arbitrary (Digit a) where
1116 liftM One arbitrary,
1117 liftM2 Two arbitrary arbitrary,
1118 liftM3 Three arbitrary arbitrary arbitrary,
1119 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1121 coarbitrary (One a) = variant 0 . coarbitrary a
1122 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1123 coarbitrary (Three a b c) =
1124 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1125 coarbitrary (Four a b c d) =
1126 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1128 ------------------------------------------------------------------------
1130 ------------------------------------------------------------------------
1135 instance Valid (Elem a) where
1138 instance Valid (Seq a) where
1139 valid (Seq xs) = valid xs
1141 instance (Sized a, Valid a) => Valid (FingerTree a) where
1143 valid (Single x) = valid x
1144 valid (Deep s pr m sf) =
1145 s == size pr + size m + size sf && valid pr && valid m && valid sf
1147 instance (Sized a, Valid a) => Valid (Node a) where
1148 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1149 valid (Node3 s a b c) =
1150 s == size a + size b + size c && valid a && valid b && valid c
1152 instance Valid a => Valid (Digit a) where
1153 valid (One a) = valid a
1154 valid (Two a b) = valid a && valid b
1155 valid (Three a b c) = valid a && valid b && valid c
1156 valid (Four a b c d) = valid a && valid b && valid c && valid d