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(..), lexP, parens, prec, readPrec)
90 import Data.Generics.Basics (Data(..), Fixity(..),
91 constrIndex, mkConstr, mkDataType)
95 import Control.Monad (liftM, liftM3, liftM4)
96 import Test.QuickCheck
109 -- | General-purpose finite sequences.
110 newtype Seq a = Seq (FingerTree (Elem a))
112 instance Functor Seq where
113 fmap f (Seq xs) = Seq (fmap (fmap f) xs)
115 instance Monad Seq where
117 xs >>= f = foldl' add empty xs
118 where add ys x = ys >< f x
120 instance MonadPlus Seq where
124 instance FunctorM Seq where
125 fmapM f = foldlM f' empty
129 fmapM_ f = foldlM f' ()
130 where f' _ x = f x >> return ()
132 instance Eq a => Eq (Seq a) where
133 xs == ys = length xs == length ys && toList xs == toList ys
135 instance Ord a => Ord (Seq a) where
136 compare xs ys = compare (toList xs) (toList ys)
139 instance Show a => Show (Seq a) where
140 showsPrec p (Seq x) = showsPrec p x
142 instance Show a => Show (Seq a) where
143 showsPrec p xs = showParen (p > 10) $
144 showString "fromList " . shows (toList xs)
147 instance Read a => Read (Seq a) where
148 #ifdef __GLASGOW_HASKELL__
149 readPrec = parens $ prec 10 $ do
150 Ident "fromList" <- lexP
154 readsPrec p = readParen (p > 10) $ \ r -> do
155 ("fromList",s) <- lex
157 return (fromList xs,t)
160 #include "Typeable.h"
161 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
163 #if __GLASGOW_HASKELL__
164 instance Data a => Data (Seq a) where
165 gfoldl f z s = case viewl s of
167 x :< xs -> z (<|) `f` x `f` xs
169 gunfold k z c = case constrIndex c of
175 | null xs = emptyConstr
176 | otherwise = consConstr
178 dataTypeOf _ = seqDataType
182 emptyConstr = mkConstr seqDataType "empty" [] Prefix
183 consConstr = mkConstr seqDataType "<|" [] Infix
184 seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
192 | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
197 instance Sized a => Sized (FingerTree a) where
198 {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
199 {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
201 size (Single x) = size x
202 size (Deep v _ _ _) = v
204 instance Functor FingerTree where
206 fmap f (Single x) = Single (f x)
207 fmap f (Deep v pr m sf) =
208 Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
211 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
212 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
213 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
214 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
227 instance Functor Digit where
228 fmap f (One a) = One (f a)
229 fmap f (Two a b) = Two (f a) (f b)
230 fmap f (Three a b c) = Three (f a) (f b) (f c)
231 fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)
233 instance Sized a => Sized (Digit a) where
234 {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
235 {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
236 size xs = foldlDigit (\ i x -> i + size x) 0 xs
238 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
239 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
240 digitToTree :: Sized a => Digit a -> FingerTree a
241 digitToTree (One a) = Single a
242 digitToTree (Two a b) = deep (One a) Empty (One b)
243 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
244 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
249 = Node2 {-# UNPACK #-} !Int a a
250 | Node3 {-# UNPACK #-} !Int a a a
255 instance Functor (Node) where
256 fmap f (Node2 v a b) = Node2 v (f a) (f b)
257 fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
259 instance Sized (Node a) where
260 size (Node2 v _ _) = v
261 size (Node3 v _ _ _) = v
264 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
265 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
266 node2 :: Sized a => a -> a -> Node a
267 node2 a b = Node2 (size a + size b) a b
270 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
271 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
272 node3 :: Sized a => a -> a -> a -> Node a
273 node3 a b c = Node3 (size a + size b + size c) a b c
275 nodeToDigit :: Node a -> Digit a
276 nodeToDigit (Node2 _ a b) = Two a b
277 nodeToDigit (Node3 _ a b c) = Three a b c
281 newtype Elem a = Elem { getElem :: a }
283 instance Sized (Elem a) where
286 instance Functor Elem where
287 fmap f (Elem x) = Elem (f x)
290 instance (Show a) => Show (Elem a) where
291 showsPrec p (Elem x) = showsPrec p x
294 ------------------------------------------------------------------------
296 ------------------------------------------------------------------------
298 -- | /O(1)/. The empty sequence.
302 -- | /O(1)/. A singleton sequence.
303 singleton :: a -> Seq a
304 singleton x = Seq (Single (Elem x))
306 -- | /O(1)/. Add an element to the left end of a sequence.
307 -- Mnemonic: a triangle with the single element at the pointy end.
308 (<|) :: a -> Seq a -> Seq a
309 x <| Seq xs = Seq (Elem x `consTree` xs)
311 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
312 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
313 consTree :: Sized a => a -> FingerTree a -> FingerTree a
314 consTree a Empty = Single a
315 consTree a (Single b) = deep (One a) Empty (One b)
316 consTree a (Deep s (Four b c d e) m sf) = m `seq`
317 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
318 consTree a (Deep s (Three b c d) m sf) =
319 Deep (size a + s) (Four a b c d) m sf
320 consTree a (Deep s (Two b c) m sf) =
321 Deep (size a + s) (Three a b c) m sf
322 consTree a (Deep s (One b) m sf) =
323 Deep (size a + s) (Two a b) m sf
325 -- | /O(1)/. Add an element to the right end of a sequence.
326 -- Mnemonic: a triangle with the single element at the pointy end.
327 (|>) :: Seq a -> a -> Seq a
328 Seq xs |> x = Seq (xs `snocTree` Elem x)
330 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
331 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
332 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
333 snocTree Empty a = Single a
334 snocTree (Single a) b = deep (One a) Empty (One b)
335 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
336 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
337 snocTree (Deep s pr m (Three a b c)) d =
338 Deep (s + size d) pr m (Four a b c d)
339 snocTree (Deep s pr m (Two a b)) c =
340 Deep (s + size c) pr m (Three a b c)
341 snocTree (Deep s pr m (One a)) b =
342 Deep (s + size b) pr m (Two a b)
344 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
345 (><) :: Seq a -> Seq a -> Seq a
346 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
348 -- The appendTree/addDigits gunk below is machine generated
350 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
351 appendTree0 Empty xs =
353 appendTree0 xs Empty =
355 appendTree0 (Single x) xs =
357 appendTree0 xs (Single x) =
359 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
360 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
362 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
363 addDigits0 m1 (One a) (One b) m2 =
364 appendTree1 m1 (node2 a b) m2
365 addDigits0 m1 (One a) (Two b c) m2 =
366 appendTree1 m1 (node3 a b c) m2
367 addDigits0 m1 (One a) (Three b c d) m2 =
368 appendTree2 m1 (node2 a b) (node2 c d) m2
369 addDigits0 m1 (One a) (Four b c d e) m2 =
370 appendTree2 m1 (node3 a b c) (node2 d e) m2
371 addDigits0 m1 (Two a b) (One c) m2 =
372 appendTree1 m1 (node3 a b c) m2
373 addDigits0 m1 (Two a b) (Two c d) m2 =
374 appendTree2 m1 (node2 a b) (node2 c d) m2
375 addDigits0 m1 (Two a b) (Three c d e) m2 =
376 appendTree2 m1 (node3 a b c) (node2 d e) m2
377 addDigits0 m1 (Two a b) (Four c d e f) m2 =
378 appendTree2 m1 (node3 a b c) (node3 d e f) m2
379 addDigits0 m1 (Three a b c) (One d) m2 =
380 appendTree2 m1 (node2 a b) (node2 c d) m2
381 addDigits0 m1 (Three a b c) (Two d e) m2 =
382 appendTree2 m1 (node3 a b c) (node2 d e) m2
383 addDigits0 m1 (Three a b c) (Three d e f) m2 =
384 appendTree2 m1 (node3 a b c) (node3 d e f) m2
385 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
386 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
387 addDigits0 m1 (Four a b c d) (One e) m2 =
388 appendTree2 m1 (node3 a b c) (node2 d e) m2
389 addDigits0 m1 (Four a b c d) (Two e f) m2 =
390 appendTree2 m1 (node3 a b c) (node3 d e f) m2
391 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
392 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
393 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
394 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
396 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
397 appendTree1 Empty a xs =
399 appendTree1 xs a Empty =
401 appendTree1 (Single x) a xs =
402 x `consTree` a `consTree` xs
403 appendTree1 xs a (Single x) =
404 xs `snocTree` a `snocTree` x
405 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
406 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
408 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
409 addDigits1 m1 (One a) b (One c) m2 =
410 appendTree1 m1 (node3 a b c) m2
411 addDigits1 m1 (One a) b (Two c d) m2 =
412 appendTree2 m1 (node2 a b) (node2 c d) m2
413 addDigits1 m1 (One a) b (Three c d e) m2 =
414 appendTree2 m1 (node3 a b c) (node2 d e) m2
415 addDigits1 m1 (One a) b (Four c d e f) m2 =
416 appendTree2 m1 (node3 a b c) (node3 d e f) m2
417 addDigits1 m1 (Two a b) c (One d) m2 =
418 appendTree2 m1 (node2 a b) (node2 c d) m2
419 addDigits1 m1 (Two a b) c (Two d e) m2 =
420 appendTree2 m1 (node3 a b c) (node2 d e) m2
421 addDigits1 m1 (Two a b) c (Three d e f) m2 =
422 appendTree2 m1 (node3 a b c) (node3 d e f) m2
423 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
424 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
425 addDigits1 m1 (Three a b c) d (One e) m2 =
426 appendTree2 m1 (node3 a b c) (node2 d e) m2
427 addDigits1 m1 (Three a b c) d (Two e f) m2 =
428 appendTree2 m1 (node3 a b c) (node3 d e f) m2
429 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
430 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
431 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
432 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
433 addDigits1 m1 (Four a b c d) e (One f) m2 =
434 appendTree2 m1 (node3 a b c) (node3 d e f) m2
435 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
436 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
437 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
438 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
439 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
440 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
442 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
443 appendTree2 Empty a b xs =
444 a `consTree` b `consTree` xs
445 appendTree2 xs a b Empty =
446 xs `snocTree` a `snocTree` b
447 appendTree2 (Single x) a b xs =
448 x `consTree` a `consTree` b `consTree` xs
449 appendTree2 xs a b (Single x) =
450 xs `snocTree` a `snocTree` b `snocTree` x
451 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
452 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
454 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
455 addDigits2 m1 (One a) b c (One d) m2 =
456 appendTree2 m1 (node2 a b) (node2 c d) m2
457 addDigits2 m1 (One a) b c (Two d e) m2 =
458 appendTree2 m1 (node3 a b c) (node2 d e) m2
459 addDigits2 m1 (One a) b c (Three d e f) m2 =
460 appendTree2 m1 (node3 a b c) (node3 d e f) m2
461 addDigits2 m1 (One a) b c (Four d e f g) m2 =
462 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
463 addDigits2 m1 (Two a b) c d (One e) m2 =
464 appendTree2 m1 (node3 a b c) (node2 d e) m2
465 addDigits2 m1 (Two a b) c d (Two e f) m2 =
466 appendTree2 m1 (node3 a b c) (node3 d e f) m2
467 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
468 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
469 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
470 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
471 addDigits2 m1 (Three a b c) d e (One f) m2 =
472 appendTree2 m1 (node3 a b c) (node3 d e f) m2
473 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
474 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
475 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
476 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
477 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
478 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
479 addDigits2 m1 (Four a b c d) e f (One g) m2 =
480 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
481 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
482 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
483 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
484 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
485 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
486 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
488 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
489 appendTree3 Empty a b c xs =
490 a `consTree` b `consTree` c `consTree` xs
491 appendTree3 xs a b c Empty =
492 xs `snocTree` a `snocTree` b `snocTree` c
493 appendTree3 (Single x) a b c xs =
494 x `consTree` a `consTree` b `consTree` c `consTree` xs
495 appendTree3 xs a b c (Single x) =
496 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
497 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
498 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
500 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))
501 addDigits3 m1 (One a) b c d (One e) m2 =
502 appendTree2 m1 (node3 a b c) (node2 d e) m2
503 addDigits3 m1 (One a) b c d (Two e f) m2 =
504 appendTree2 m1 (node3 a b c) (node3 d e f) m2
505 addDigits3 m1 (One a) b c d (Three e f g) m2 =
506 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
507 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
508 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
509 addDigits3 m1 (Two a b) c d e (One f) m2 =
510 appendTree2 m1 (node3 a b c) (node3 d e f) m2
511 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
512 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
513 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
514 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
515 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
516 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
517 addDigits3 m1 (Three a b c) d e f (One g) m2 =
518 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
519 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
520 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
521 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
522 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
523 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
524 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
525 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
526 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
527 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
528 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
529 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
530 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
531 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
532 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
534 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
535 appendTree4 Empty a b c d xs =
536 a `consTree` b `consTree` c `consTree` d `consTree` xs
537 appendTree4 xs a b c d Empty =
538 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
539 appendTree4 (Single x) a b c d xs =
540 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
541 appendTree4 xs a b c d (Single x) =
542 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
543 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
544 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
546 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))
547 addDigits4 m1 (One a) b c d e (One f) m2 =
548 appendTree2 m1 (node3 a b c) (node3 d e f) m2
549 addDigits4 m1 (One a) b c d e (Two f g) m2 =
550 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
551 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
552 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
553 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
554 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
555 addDigits4 m1 (Two a b) c d e f (One g) m2 =
556 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
557 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
558 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
559 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
560 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
561 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
562 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
563 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
564 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
565 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
566 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
567 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
568 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
569 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
570 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
571 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
572 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
573 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
574 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
575 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
576 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
577 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
578 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
580 ------------------------------------------------------------------------
582 ------------------------------------------------------------------------
584 -- | /O(1)/. Is this the empty sequence?
585 null :: Seq a -> Bool
586 null (Seq Empty) = True
589 -- | /O(1)/. The number of elements in the sequence.
590 length :: Seq a -> Int
591 length (Seq xs) = size xs
595 data Maybe2 a b = Nothing2 | Just2 a b
597 -- | View of the left end of a sequence.
599 = EmptyL -- ^ empty sequence
600 | a :< Seq a -- ^ leftmost element and the rest of the sequence
602 # if __GLASGOW_HASKELL__
603 deriving (Eq, Ord, Show, Read, Data)
605 deriving (Eq, Ord, Show, Read)
608 instance Eq a => Eq (ViewL a)
609 instance Ord a => Ord (ViewL a)
610 instance Show a => Show (ViewL a)
611 instance Read a => Read (ViewL a)
612 instance Data a => Data (ViewL a)
615 INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL")
617 instance Functor ViewL where
618 fmap _ EmptyL = EmptyL
619 fmap f (x :< xs) = f x :< fmap f xs
621 instance FunctorM ViewL where
622 fmapM _ EmptyL = return EmptyL
623 fmapM f (x :< xs) = liftM2 (:<) (f x) (fmapM f xs)
624 fmapM_ _ EmptyL = return ()
625 fmapM_ f (x :< xs) = f x >> fmapM_ f xs >> return ()
627 -- | /O(1)/. Analyse the left end of a sequence.
628 viewl :: Seq a -> ViewL a
629 viewl (Seq xs) = case viewLTree xs of
631 Just2 (Elem x) xs' -> x :< Seq xs'
633 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
634 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
635 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
636 viewLTree Empty = Nothing2
637 viewLTree (Single a) = Just2 a Empty
638 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
639 Nothing2 -> digitToTree sf
640 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
641 viewLTree (Deep s (Two a b) m sf) =
642 Just2 a (Deep (s - size a) (One b) m sf)
643 viewLTree (Deep s (Three a b c) m sf) =
644 Just2 a (Deep (s - size a) (Two b c) m sf)
645 viewLTree (Deep s (Four a b c d) m sf) =
646 Just2 a (Deep (s - size a) (Three b c d) m sf)
648 -- | View of the right end of a sequence.
650 = EmptyR -- ^ empty sequence
651 | Seq a :> a -- ^ the sequence minus the rightmost element,
652 -- and the rightmost element
654 # if __GLASGOW_HASKELL__
655 deriving (Eq, Ord, Show, Read, Data)
657 deriving (Eq, Ord, Show, Read)
660 instance Eq a => Eq (ViewR a)
661 instance Ord a => Ord (ViewR a)
662 instance Show a => Show (ViewR a)
663 instance Read a => Read (ViewR a)
664 instance Data a => Data (ViewR a)
667 INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR")
669 instance Functor ViewR where
670 fmap _ EmptyR = EmptyR
671 fmap f (xs :> x) = fmap f xs :> f x
673 instance FunctorM ViewR where
674 fmapM _ EmptyR = return EmptyR
675 fmapM f (xs :> x) = liftM2 (:>) (fmapM f xs) (f x)
676 fmapM_ _ EmptyR = return ()
677 fmapM_ f (xs :> x) = fmapM_ f xs >> f x >> return ()
679 -- | /O(1)/. Analyse the right end of a sequence.
680 viewr :: Seq a -> ViewR a
681 viewr (Seq xs) = case viewRTree xs of
683 Just2 xs' (Elem x) -> Seq xs' :> x
685 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
686 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
687 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
688 viewRTree Empty = Nothing2
689 viewRTree (Single z) = Just2 Empty z
690 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
691 Nothing2 -> digitToTree pr
692 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
693 viewRTree (Deep s pr m (Two y z)) =
694 Just2 (Deep (s - size z) pr m (One y)) z
695 viewRTree (Deep s pr m (Three x y z)) =
696 Just2 (Deep (s - size z) pr m (Two x y)) z
697 viewRTree (Deep s pr m (Four w x y z)) =
698 Just2 (Deep (s - size z) pr m (Three w x y)) z
702 -- | /O(log(min(i,n-i)))/. The element at the specified position
703 index :: Seq a -> Int -> a
705 | 0 <= i && i < size xs = case lookupTree (-i) xs of
706 Place _ (Elem x) -> x
707 | otherwise = error "index out of bounds"
709 data Place a = Place {-# UNPACK #-} !Int a
714 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
715 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
716 lookupTree :: Sized a => Int -> FingerTree a -> Place a
717 lookupTree _ Empty = error "lookupTree of empty tree"
718 lookupTree i (Single x) = Place i x
719 lookupTree i (Deep _ pr m sf)
720 | vpr > 0 = lookupDigit i pr
721 | vm > 0 = case lookupTree vpr m of
722 Place i' xs -> lookupNode i' xs
723 | otherwise = lookupDigit vm sf
724 where vpr = i + size pr
727 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
728 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
729 lookupNode :: Sized a => Int -> Node a -> Place a
730 lookupNode i (Node2 _ a b)
732 | otherwise = Place va b
733 where va = i + size a
734 lookupNode i (Node3 _ a b c)
736 | vab > 0 = Place va b
737 | otherwise = Place vab c
738 where va = i + size a
741 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
742 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
743 lookupDigit :: Sized a => Int -> Digit a -> Place a
744 lookupDigit i (One a) = Place i a
745 lookupDigit i (Two a b)
747 | otherwise = Place va b
748 where va = i + size a
749 lookupDigit i (Three a b c)
751 | vab > 0 = Place va b
752 | otherwise = Place vab c
753 where va = i + size a
755 lookupDigit i (Four a b c d)
757 | vab > 0 = Place va b
758 | vabc > 0 = Place vab c
759 | otherwise = Place vabc d
760 where va = i + size a
764 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
765 update :: Int -> a -> Seq a -> Seq a
766 update i x = adjust (const x) i
768 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
769 adjust :: (a -> a) -> Int -> Seq a -> Seq a
771 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
774 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
775 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
776 adjustTree :: Sized a => (Int -> a -> a) ->
777 Int -> FingerTree a -> FingerTree a
778 adjustTree _ _ Empty = error "adjustTree of empty tree"
779 adjustTree f i (Single x) = Single (f i x)
780 adjustTree f i (Deep s pr m sf)
781 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
782 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
783 | otherwise = Deep s pr m (adjustDigit f vm sf)
784 where vpr = i + size pr
787 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
788 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
789 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
790 adjustNode f i (Node2 s a b)
791 | va > 0 = Node2 s (f i a) b
792 | otherwise = Node2 s a (f va b)
793 where va = i + size a
794 adjustNode f i (Node3 s a b c)
795 | va > 0 = Node3 s (f i a) b c
796 | vab > 0 = Node3 s a (f va b) c
797 | otherwise = Node3 s a b (f vab c)
798 where va = i + size a
801 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
802 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
803 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
804 adjustDigit f i (One a) = One (f i a)
805 adjustDigit f i (Two a b)
806 | va > 0 = Two (f i a) b
807 | otherwise = Two a (f va b)
808 where va = i + size a
809 adjustDigit f i (Three a b c)
810 | va > 0 = Three (f i a) b c
811 | vab > 0 = Three a (f va b) c
812 | otherwise = Three a b (f vab c)
813 where va = i + size a
815 adjustDigit f i (Four a b c d)
816 | va > 0 = Four (f i a) b c d
817 | vab > 0 = Four a (f va b) c d
818 | vabc > 0 = Four a b (f vab c) d
819 | otherwise = Four a b c (f vabc d)
820 where va = i + size a
826 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
827 take :: Int -> Seq a -> Seq a
828 take i = fst . splitAt i
830 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
831 drop :: Int -> Seq a -> Seq a
832 drop i = snd . splitAt i
834 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
835 splitAt :: Int -> Seq a -> (Seq a, Seq a)
836 splitAt i (Seq xs) = (Seq l, Seq r)
837 where (l, r) = split i xs
839 split :: Int -> FingerTree (Elem a) ->
840 (FingerTree (Elem a), FingerTree (Elem a))
841 split i Empty = i `seq` (Empty, Empty)
843 | size xs > i = (l, consTree x r)
844 | otherwise = (xs, Empty)
845 where Split l x r = splitTree (-i) xs
847 data Split t a = Split t a t
852 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
853 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
854 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
855 splitTree _ Empty = error "splitTree of empty tree"
856 splitTree i (Single x) = i `seq` Split Empty x Empty
857 splitTree i (Deep _ pr m sf)
858 | vpr > 0 = case splitDigit i pr of
859 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
860 | vm > 0 = case splitTree vpr m of
861 Split ml xs mr -> case splitNode (vpr + size ml) xs of
862 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
863 | otherwise = case splitDigit vm sf of
864 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
865 where vpr = i + size pr
868 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
869 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
870 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
871 deepL Nothing m sf = case viewLTree m of
872 Nothing2 -> digitToTree sf
873 Just2 a m' -> deep (nodeToDigit a) m' sf
874 deepL (Just pr) m sf = deep pr m sf
876 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
877 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
878 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
879 deepR pr m Nothing = case viewRTree m of
880 Nothing2 -> digitToTree pr
881 Just2 m' a -> deep pr m' (nodeToDigit a)
882 deepR pr m (Just sf) = deep pr m sf
884 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
885 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
886 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
887 splitNode i (Node2 _ a b)
888 | va > 0 = Split Nothing a (Just (One b))
889 | otherwise = Split (Just (One a)) b Nothing
890 where va = i + size a
891 splitNode i (Node3 _ a b c)
892 | va > 0 = Split Nothing a (Just (Two b c))
893 | vab > 0 = Split (Just (One a)) b (Just (One c))
894 | otherwise = Split (Just (Two a b)) c Nothing
895 where va = i + size a
898 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
899 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
900 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
901 splitDigit i (One a) = i `seq` Split Nothing a Nothing
902 splitDigit i (Two a b)
903 | va > 0 = Split Nothing a (Just (One b))
904 | otherwise = Split (Just (One a)) b Nothing
905 where va = i + size a
906 splitDigit i (Three a b c)
907 | va > 0 = Split Nothing a (Just (Two b c))
908 | vab > 0 = Split (Just (One a)) b (Just (One c))
909 | otherwise = Split (Just (Two a b)) c Nothing
910 where va = i + size a
912 splitDigit i (Four a b c d)
913 | va > 0 = Split Nothing a (Just (Three b c d))
914 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
915 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
916 | otherwise = Split (Just (Three a b c)) d Nothing
917 where va = i + size a
921 ------------------------------------------------------------------------
923 ------------------------------------------------------------------------
925 -- | /O(n)/. Create a sequence from a finite list of elements.
926 fromList :: [a] -> Seq a
927 fromList = Data.List.foldl' (|>) empty
929 -- | /O(n)/. List of elements of the sequence.
930 toList :: Seq a -> [a]
931 #ifdef __GLASGOW_HASKELL__
932 {-# INLINE toList #-}
933 toList xs = build (\ c n -> foldr c n xs)
935 toList = foldr (:) []
938 ------------------------------------------------------------------------
940 ------------------------------------------------------------------------
942 -- | /O(n*t)/. Fold over the elements of a sequence,
943 -- associating to the right.
944 foldr :: (a -> b -> b) -> b -> Seq a -> b
945 foldr f z (Seq xs) = foldrTree f' z xs
946 where f' (Elem x) y = f x y
948 foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
949 foldrTree _ z Empty = z
950 foldrTree f z (Single x) = x `f` z
951 foldrTree f z (Deep _ pr m sf) =
952 foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr
954 foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
955 foldrDigit f z (One a) = a `f` z
956 foldrDigit f z (Two a b) = a `f` (b `f` z)
957 foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z))
958 foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
960 foldrNode :: (a -> b -> b) -> b -> Node a -> b
961 foldrNode f z (Node2 _ a b) = a `f` (b `f` z)
962 foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
964 -- | /O(n*t)/. A variant of 'foldr' that has no base case,
965 -- and thus may only be applied to non-empty sequences.
966 foldr1 :: (a -> a -> a) -> Seq a -> a
967 foldr1 f (Seq xs) = getElem (foldr1Tree f' xs)
968 where f' (Elem x) (Elem y) = Elem (f x y)
970 foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
971 foldr1Tree _ Empty = error "foldr1: empty sequence"
972 foldr1Tree _ (Single x) = x
973 foldr1Tree f (Deep _ pr m sf) =
974 foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr
976 foldr1Digit :: (a -> a -> a) -> Digit a -> a
977 foldr1Digit f (One a) = a
978 foldr1Digit f (Two a b) = a `f` b
979 foldr1Digit f (Three a b c) = a `f` (b `f` c)
980 foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d))
982 -- | /O(n*t)/. Fold over the elements of a sequence,
983 -- associating to the left.
984 foldl :: (a -> b -> a) -> a -> Seq b -> a
985 foldl f z (Seq xs) = foldlTree f' z xs
986 where f' x (Elem y) = f x y
988 foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
989 foldlTree _ z Empty = z
990 foldlTree f z (Single x) = z `f` x
991 foldlTree f z (Deep _ pr m sf) =
992 foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
994 foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
995 foldlDigit f z (One a) = z `f` a
996 foldlDigit f z (Two a b) = (z `f` a) `f` b
997 foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c
998 foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
1000 foldlNode :: (a -> b -> a) -> a -> Node b -> a
1001 foldlNode f z (Node2 _ a b) = (z `f` a) `f` b
1002 foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
1004 -- | /O(n*t)/. A variant of 'foldl' that has no base case,
1005 -- and thus may only be applied to non-empty sequences.
1006 foldl1 :: (a -> a -> a) -> Seq a -> a
1007 foldl1 f (Seq xs) = getElem (foldl1Tree f' xs)
1008 where f' (Elem x) (Elem y) = Elem (f x y)
1010 foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
1011 foldl1Tree _ Empty = error "foldl1: empty sequence"
1012 foldl1Tree _ (Single x) = x
1013 foldl1Tree f (Deep _ pr m sf) =
1014 foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf
1016 foldl1Digit :: (a -> a -> a) -> Digit a -> a
1017 foldl1Digit f (One a) = a
1018 foldl1Digit f (Two a b) = a `f` b
1019 foldl1Digit f (Three a b c) = (a `f` b) `f` c
1020 foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d
1022 ------------------------------------------------------------------------
1024 ------------------------------------------------------------------------
1026 -- | /O(n*t)/. Fold over the elements of a sequence,
1027 -- associating to the right, but strictly.
1028 foldr' :: (a -> b -> b) -> b -> Seq a -> b
1029 foldr' f z xs = foldl f' id xs z
1030 where f' k x z = k $! f x z
1032 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1033 -- associating to the right, i.e. from right to left.
1034 foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
1035 foldrM f z xs = foldl f' return xs z
1036 where f' k x z = f x z >>= k
1038 -- | /O(n*t)/. Fold over the elements of a sequence,
1039 -- associating to the left, but strictly.
1040 foldl' :: (a -> b -> a) -> a -> Seq b -> a
1041 foldl' f z xs = foldr f' id xs z
1042 where f' x k z = k $! f z x
1044 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1045 -- associating to the left, i.e. from left to right.
1046 foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
1047 foldlM f z xs = foldr f' return xs z
1048 where f' x k z = f z x >>= k
1050 ------------------------------------------------------------------------
1052 ------------------------------------------------------------------------
1054 -- | /O(n)/. The reverse of a sequence.
1055 reverse :: Seq a -> Seq a
1056 reverse (Seq xs) = Seq (reverseTree id xs)
1058 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1059 reverseTree _ Empty = Empty
1060 reverseTree f (Single x) = Single (f x)
1061 reverseTree f (Deep s pr m sf) =
1062 Deep s (reverseDigit f sf)
1063 (reverseTree (reverseNode f) m)
1066 reverseDigit :: (a -> a) -> Digit a -> Digit a
1067 reverseDigit f (One a) = One (f a)
1068 reverseDigit f (Two a b) = Two (f b) (f a)
1069 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1070 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1072 reverseNode :: (a -> a) -> Node a -> Node a
1073 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1074 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1078 ------------------------------------------------------------------------
1080 ------------------------------------------------------------------------
1082 instance Arbitrary a => Arbitrary (Seq a) where
1083 arbitrary = liftM Seq arbitrary
1084 coarbitrary (Seq x) = coarbitrary x
1086 instance Arbitrary a => Arbitrary (Elem a) where
1087 arbitrary = liftM Elem arbitrary
1088 coarbitrary (Elem x) = coarbitrary x
1090 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1091 arbitrary = sized arb
1092 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1093 arb 0 = return Empty
1094 arb 1 = liftM Single arbitrary
1095 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1097 coarbitrary Empty = variant 0
1098 coarbitrary (Single x) = variant 1 . coarbitrary x
1099 coarbitrary (Deep _ pr m sf) =
1100 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1102 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1104 liftM2 node2 arbitrary arbitrary,
1105 liftM3 node3 arbitrary arbitrary arbitrary]
1107 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1108 coarbitrary (Node3 _ a b c) =
1109 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1111 instance Arbitrary a => Arbitrary (Digit a) where
1113 liftM One arbitrary,
1114 liftM2 Two arbitrary arbitrary,
1115 liftM3 Three arbitrary arbitrary arbitrary,
1116 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1118 coarbitrary (One a) = variant 0 . coarbitrary a
1119 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1120 coarbitrary (Three a b c) =
1121 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1122 coarbitrary (Four a b c d) =
1123 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1125 ------------------------------------------------------------------------
1127 ------------------------------------------------------------------------
1132 instance Valid (Elem a) where
1135 instance Valid (Seq a) where
1136 valid (Seq xs) = valid xs
1138 instance (Sized a, Valid a) => Valid (FingerTree a) where
1140 valid (Single x) = valid x
1141 valid (Deep s pr m sf) =
1142 s == size pr + size m + size sf && valid pr && valid m && valid sf
1144 instance (Sized a, Valid a) => Valid (Node a) where
1145 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1146 valid (Node3 s a b c) =
1147 s == size a + size b + size c && valid a && valid b && valid c
1149 instance Valid a => Valid (Digit a) where
1150 valid (One a) = valid a
1151 valid (Two a b) = valid a && valid b
1152 valid (Three a b c) = valid a && valid b && valid c
1153 valid (Four a b c d) = valid a && valid b && valid c && valid d