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)
84 import Data.Monoid (Monoid(..))
88 #ifdef __GLASGOW_HASKELL__
89 import GHC.Exts (build)
90 import Text.Read (Lexeme(Ident), lexP, parens, prec,
91 readPrec, readListPrec, readListPrecDefault)
92 import Data.Generics.Basics (Data(..), Fixity(..),
93 constrIndex, mkConstr, mkDataType)
97 import Control.Monad (liftM, liftM3, liftM4)
98 import Test.QuickCheck
111 -- | General-purpose finite sequences.
112 newtype Seq a = Seq (FingerTree (Elem a))
114 instance Functor Seq where
115 fmap f (Seq xs) = Seq (fmap (fmap f) xs)
117 instance Monad Seq where
119 xs >>= f = foldl' add empty xs
120 where add ys x = ys >< f x
122 instance MonadPlus Seq where
126 instance FunctorM Seq where
127 fmapM f = foldlM f' empty
131 fmapM_ f = foldlM f' ()
132 where f' _ x = f x >> return ()
134 instance Eq a => Eq (Seq a) where
135 xs == ys = length xs == length ys && toList xs == toList ys
137 instance Ord a => Ord (Seq a) where
138 compare xs ys = compare (toList xs) (toList ys)
141 instance Show a => Show (Seq a) where
142 showsPrec p (Seq x) = showsPrec p x
144 instance Show a => Show (Seq a) where
145 showsPrec p xs = showParen (p > 10) $
146 showString "fromList " . shows (toList xs)
149 instance Read a => Read (Seq a) where
150 #ifdef __GLASGOW_HASKELL__
151 readPrec = parens $ prec 10 $ do
152 Ident "fromList" <- lexP
156 readListPrec = readListPrecDefault
158 readsPrec p = readParen (p > 10) $ \ r -> do
159 ("fromList",s) <- lex r
161 return (fromList xs,t)
164 instance Monoid (Seq a) where
168 #include "Typeable.h"
169 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
171 #if __GLASGOW_HASKELL__
172 instance Data a => Data (Seq a) where
173 gfoldl f z s = case viewl s of
175 x :< xs -> z (<|) `f` x `f` xs
177 gunfold k z c = case constrIndex c of
183 | null xs = emptyConstr
184 | otherwise = consConstr
186 dataTypeOf _ = seqDataType
190 emptyConstr = mkConstr seqDataType "empty" [] Prefix
191 consConstr = mkConstr seqDataType "<|" [] Infix
192 seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
200 | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
205 instance Sized a => Sized (FingerTree a) where
206 {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
207 {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
209 size (Single x) = size x
210 size (Deep v _ _ _) = v
212 instance Functor FingerTree where
214 fmap f (Single x) = Single (f x)
215 fmap f (Deep v pr m sf) =
216 Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
219 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
220 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
221 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
222 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
235 instance Functor Digit where
236 fmap f (One a) = One (f a)
237 fmap f (Two a b) = Two (f a) (f b)
238 fmap f (Three a b c) = Three (f a) (f b) (f c)
239 fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)
241 instance Sized a => Sized (Digit a) where
242 {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
243 {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
244 size xs = foldlDigit (\ i x -> i + size x) 0 xs
246 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
247 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
248 digitToTree :: Sized a => Digit a -> FingerTree a
249 digitToTree (One a) = Single a
250 digitToTree (Two a b) = deep (One a) Empty (One b)
251 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
252 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
257 = Node2 {-# UNPACK #-} !Int a a
258 | Node3 {-# UNPACK #-} !Int a a a
263 instance Functor (Node) where
264 fmap f (Node2 v a b) = Node2 v (f a) (f b)
265 fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
267 instance Sized (Node a) where
268 size (Node2 v _ _) = v
269 size (Node3 v _ _ _) = v
272 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
273 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
274 node2 :: Sized a => a -> a -> Node a
275 node2 a b = Node2 (size a + size b) a b
278 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
279 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
280 node3 :: Sized a => a -> a -> a -> Node a
281 node3 a b c = Node3 (size a + size b + size c) a b c
283 nodeToDigit :: Node a -> Digit a
284 nodeToDigit (Node2 _ a b) = Two a b
285 nodeToDigit (Node3 _ a b c) = Three a b c
289 newtype Elem a = Elem { getElem :: a }
291 instance Sized (Elem a) where
294 instance Functor Elem where
295 fmap f (Elem x) = Elem (f x)
298 instance (Show a) => Show (Elem a) where
299 showsPrec p (Elem x) = showsPrec p x
302 ------------------------------------------------------------------------
304 ------------------------------------------------------------------------
306 -- | /O(1)/. The empty sequence.
310 -- | /O(1)/. A singleton sequence.
311 singleton :: a -> Seq a
312 singleton x = Seq (Single (Elem x))
314 -- | /O(1)/. Add an element to the left end of a sequence.
315 -- Mnemonic: a triangle with the single element at the pointy end.
316 (<|) :: a -> Seq a -> Seq a
317 x <| Seq xs = Seq (Elem x `consTree` xs)
319 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
320 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
321 consTree :: Sized a => a -> FingerTree a -> FingerTree a
322 consTree a Empty = Single a
323 consTree a (Single b) = deep (One a) Empty (One b)
324 consTree a (Deep s (Four b c d e) m sf) = m `seq`
325 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
326 consTree a (Deep s (Three b c d) m sf) =
327 Deep (size a + s) (Four a b c d) m sf
328 consTree a (Deep s (Two b c) m sf) =
329 Deep (size a + s) (Three a b c) m sf
330 consTree a (Deep s (One b) m sf) =
331 Deep (size a + s) (Two a b) m sf
333 -- | /O(1)/. Add an element to the right end of a sequence.
334 -- Mnemonic: a triangle with the single element at the pointy end.
335 (|>) :: Seq a -> a -> Seq a
336 Seq xs |> x = Seq (xs `snocTree` Elem x)
338 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
339 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
340 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
341 snocTree Empty a = Single a
342 snocTree (Single a) b = deep (One a) Empty (One b)
343 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
344 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
345 snocTree (Deep s pr m (Three a b c)) d =
346 Deep (s + size d) pr m (Four a b c d)
347 snocTree (Deep s pr m (Two a b)) c =
348 Deep (s + size c) pr m (Three a b c)
349 snocTree (Deep s pr m (One a)) b =
350 Deep (s + size b) pr m (Two a b)
352 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
353 (><) :: Seq a -> Seq a -> Seq a
354 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
356 -- The appendTree/addDigits gunk below is machine generated
358 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
359 appendTree0 Empty xs =
361 appendTree0 xs Empty =
363 appendTree0 (Single x) xs =
365 appendTree0 xs (Single x) =
367 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
368 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
370 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
371 addDigits0 m1 (One a) (One b) m2 =
372 appendTree1 m1 (node2 a b) m2
373 addDigits0 m1 (One a) (Two b c) m2 =
374 appendTree1 m1 (node3 a b c) m2
375 addDigits0 m1 (One a) (Three b c d) m2 =
376 appendTree2 m1 (node2 a b) (node2 c d) m2
377 addDigits0 m1 (One a) (Four b c d e) m2 =
378 appendTree2 m1 (node3 a b c) (node2 d e) m2
379 addDigits0 m1 (Two a b) (One c) m2 =
380 appendTree1 m1 (node3 a b c) m2
381 addDigits0 m1 (Two a b) (Two c d) m2 =
382 appendTree2 m1 (node2 a b) (node2 c d) m2
383 addDigits0 m1 (Two a b) (Three c d e) m2 =
384 appendTree2 m1 (node3 a b c) (node2 d e) m2
385 addDigits0 m1 (Two a b) (Four c d e f) m2 =
386 appendTree2 m1 (node3 a b c) (node3 d e f) m2
387 addDigits0 m1 (Three a b c) (One d) m2 =
388 appendTree2 m1 (node2 a b) (node2 c d) m2
389 addDigits0 m1 (Three a b c) (Two d e) m2 =
390 appendTree2 m1 (node3 a b c) (node2 d e) m2
391 addDigits0 m1 (Three a b c) (Three d e f) m2 =
392 appendTree2 m1 (node3 a b c) (node3 d e f) m2
393 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
394 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
395 addDigits0 m1 (Four a b c d) (One e) m2 =
396 appendTree2 m1 (node3 a b c) (node2 d e) m2
397 addDigits0 m1 (Four a b c d) (Two e f) m2 =
398 appendTree2 m1 (node3 a b c) (node3 d e f) m2
399 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
400 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
401 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
402 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
404 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
405 appendTree1 Empty a xs =
407 appendTree1 xs a Empty =
409 appendTree1 (Single x) a xs =
410 x `consTree` a `consTree` xs
411 appendTree1 xs a (Single x) =
412 xs `snocTree` a `snocTree` x
413 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
414 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
416 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
417 addDigits1 m1 (One a) b (One c) m2 =
418 appendTree1 m1 (node3 a b c) m2
419 addDigits1 m1 (One a) b (Two c d) m2 =
420 appendTree2 m1 (node2 a b) (node2 c d) m2
421 addDigits1 m1 (One a) b (Three c d e) m2 =
422 appendTree2 m1 (node3 a b c) (node2 d e) m2
423 addDigits1 m1 (One a) b (Four c d e f) m2 =
424 appendTree2 m1 (node3 a b c) (node3 d e f) m2
425 addDigits1 m1 (Two a b) c (One d) m2 =
426 appendTree2 m1 (node2 a b) (node2 c d) m2
427 addDigits1 m1 (Two a b) c (Two d e) m2 =
428 appendTree2 m1 (node3 a b c) (node2 d e) m2
429 addDigits1 m1 (Two a b) c (Three d e f) m2 =
430 appendTree2 m1 (node3 a b c) (node3 d e f) m2
431 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
432 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
433 addDigits1 m1 (Three a b c) d (One e) m2 =
434 appendTree2 m1 (node3 a b c) (node2 d e) m2
435 addDigits1 m1 (Three a b c) d (Two e f) m2 =
436 appendTree2 m1 (node3 a b c) (node3 d e f) m2
437 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
438 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
439 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
440 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
441 addDigits1 m1 (Four a b c d) e (One f) m2 =
442 appendTree2 m1 (node3 a b c) (node3 d e f) m2
443 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
444 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
445 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
446 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
447 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
448 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
450 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
451 appendTree2 Empty a b xs =
452 a `consTree` b `consTree` xs
453 appendTree2 xs a b Empty =
454 xs `snocTree` a `snocTree` b
455 appendTree2 (Single x) a b xs =
456 x `consTree` a `consTree` b `consTree` xs
457 appendTree2 xs a b (Single x) =
458 xs `snocTree` a `snocTree` b `snocTree` x
459 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
460 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
462 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
463 addDigits2 m1 (One a) b c (One d) m2 =
464 appendTree2 m1 (node2 a b) (node2 c d) m2
465 addDigits2 m1 (One a) b c (Two d e) m2 =
466 appendTree2 m1 (node3 a b c) (node2 d e) m2
467 addDigits2 m1 (One a) b c (Three d e f) m2 =
468 appendTree2 m1 (node3 a b c) (node3 d e f) m2
469 addDigits2 m1 (One a) b c (Four d e f g) m2 =
470 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
471 addDigits2 m1 (Two a b) c d (One e) m2 =
472 appendTree2 m1 (node3 a b c) (node2 d e) m2
473 addDigits2 m1 (Two a b) c d (Two e f) m2 =
474 appendTree2 m1 (node3 a b c) (node3 d e f) m2
475 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
476 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
477 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
478 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
479 addDigits2 m1 (Three a b c) d e (One f) m2 =
480 appendTree2 m1 (node3 a b c) (node3 d e f) m2
481 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
482 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
483 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
484 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
485 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
486 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
487 addDigits2 m1 (Four a b c d) e f (One g) m2 =
488 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
489 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
490 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
491 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
492 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
493 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
494 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
496 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
497 appendTree3 Empty a b c xs =
498 a `consTree` b `consTree` c `consTree` xs
499 appendTree3 xs a b c Empty =
500 xs `snocTree` a `snocTree` b `snocTree` c
501 appendTree3 (Single x) a b c xs =
502 x `consTree` a `consTree` b `consTree` c `consTree` xs
503 appendTree3 xs a b c (Single x) =
504 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
505 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
506 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
508 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))
509 addDigits3 m1 (One a) b c d (One e) m2 =
510 appendTree2 m1 (node3 a b c) (node2 d e) m2
511 addDigits3 m1 (One a) b c d (Two e f) m2 =
512 appendTree2 m1 (node3 a b c) (node3 d e f) m2
513 addDigits3 m1 (One a) b c d (Three e f g) m2 =
514 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
515 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
516 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
517 addDigits3 m1 (Two a b) c d e (One f) m2 =
518 appendTree2 m1 (node3 a b c) (node3 d e f) m2
519 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
520 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
521 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
522 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
523 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
524 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
525 addDigits3 m1 (Three a b c) d e f (One g) m2 =
526 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
527 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
528 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
529 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
530 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
531 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
532 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
533 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
534 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
535 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
536 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
537 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
538 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
539 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
540 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
542 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
543 appendTree4 Empty a b c d xs =
544 a `consTree` b `consTree` c `consTree` d `consTree` xs
545 appendTree4 xs a b c d Empty =
546 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
547 appendTree4 (Single x) a b c d xs =
548 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
549 appendTree4 xs a b c d (Single x) =
550 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
551 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
552 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
554 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))
555 addDigits4 m1 (One a) b c d e (One f) m2 =
556 appendTree2 m1 (node3 a b c) (node3 d e f) m2
557 addDigits4 m1 (One a) b c d e (Two f g) m2 =
558 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
559 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
560 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
561 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
562 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
563 addDigits4 m1 (Two a b) c d e f (One g) m2 =
564 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
565 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
566 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
567 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
568 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
569 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
570 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
571 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
572 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
573 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
574 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
575 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
576 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
577 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
578 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
579 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
580 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
581 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
582 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
583 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
584 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
585 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
586 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
588 ------------------------------------------------------------------------
590 ------------------------------------------------------------------------
592 -- | /O(1)/. Is this the empty sequence?
593 null :: Seq a -> Bool
594 null (Seq Empty) = True
597 -- | /O(1)/. The number of elements in the sequence.
598 length :: Seq a -> Int
599 length (Seq xs) = size xs
603 data Maybe2 a b = Nothing2 | Just2 a b
605 -- | View of the left end of a sequence.
607 = EmptyL -- ^ empty sequence
608 | a :< Seq a -- ^ leftmost element and the rest of the sequence
610 # if __GLASGOW_HASKELL__
611 deriving (Eq, Ord, Show, Read, Data)
613 deriving (Eq, Ord, Show, Read)
616 instance Eq a => Eq (ViewL a)
617 instance Ord a => Ord (ViewL a)
618 instance Show a => Show (ViewL a)
619 instance Read a => Read (ViewL a)
620 instance Data a => Data (ViewL a)
623 INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL")
625 instance Functor ViewL where
626 fmap _ EmptyL = EmptyL
627 fmap f (x :< xs) = f x :< fmap f xs
629 instance FunctorM ViewL where
630 fmapM _ EmptyL = return EmptyL
631 fmapM f (x :< xs) = liftM2 (:<) (f x) (fmapM f xs)
632 fmapM_ _ EmptyL = return ()
633 fmapM_ f (x :< xs) = f x >> fmapM_ f xs >> return ()
635 -- | /O(1)/. Analyse the left end of a sequence.
636 viewl :: Seq a -> ViewL a
637 viewl (Seq xs) = case viewLTree xs of
639 Just2 (Elem x) xs' -> x :< Seq xs'
641 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
642 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
643 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
644 viewLTree Empty = Nothing2
645 viewLTree (Single a) = Just2 a Empty
646 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
647 Nothing2 -> digitToTree sf
648 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
649 viewLTree (Deep s (Two a b) m sf) =
650 Just2 a (Deep (s - size a) (One b) m sf)
651 viewLTree (Deep s (Three a b c) m sf) =
652 Just2 a (Deep (s - size a) (Two b c) m sf)
653 viewLTree (Deep s (Four a b c d) m sf) =
654 Just2 a (Deep (s - size a) (Three b c d) m sf)
656 -- | View of the right end of a sequence.
658 = EmptyR -- ^ empty sequence
659 | Seq a :> a -- ^ the sequence minus the rightmost element,
660 -- and the rightmost element
662 # if __GLASGOW_HASKELL__
663 deriving (Eq, Ord, Show, Read, Data)
665 deriving (Eq, Ord, Show, Read)
668 instance Eq a => Eq (ViewR a)
669 instance Ord a => Ord (ViewR a)
670 instance Show a => Show (ViewR a)
671 instance Read a => Read (ViewR a)
672 instance Data a => Data (ViewR a)
675 INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR")
677 instance Functor ViewR where
678 fmap _ EmptyR = EmptyR
679 fmap f (xs :> x) = fmap f xs :> f x
681 instance FunctorM ViewR where
682 fmapM _ EmptyR = return EmptyR
683 fmapM f (xs :> x) = liftM2 (:>) (fmapM f xs) (f x)
684 fmapM_ _ EmptyR = return ()
685 fmapM_ f (xs :> x) = fmapM_ f xs >> f x >> return ()
687 -- | /O(1)/. Analyse the right end of a sequence.
688 viewr :: Seq a -> ViewR a
689 viewr (Seq xs) = case viewRTree xs of
691 Just2 xs' (Elem x) -> Seq xs' :> x
693 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
694 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
695 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
696 viewRTree Empty = Nothing2
697 viewRTree (Single z) = Just2 Empty z
698 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
699 Nothing2 -> digitToTree pr
700 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
701 viewRTree (Deep s pr m (Two y z)) =
702 Just2 (Deep (s - size z) pr m (One y)) z
703 viewRTree (Deep s pr m (Three x y z)) =
704 Just2 (Deep (s - size z) pr m (Two x y)) z
705 viewRTree (Deep s pr m (Four w x y z)) =
706 Just2 (Deep (s - size z) pr m (Three w x y)) z
710 -- | /O(log(min(i,n-i)))/. The element at the specified position
711 index :: Seq a -> Int -> a
713 | 0 <= i && i < size xs = case lookupTree (-i) xs of
714 Place _ (Elem x) -> x
715 | otherwise = error "index out of bounds"
717 data Place a = Place {-# UNPACK #-} !Int a
722 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
723 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
724 lookupTree :: Sized a => Int -> FingerTree a -> Place a
725 lookupTree _ Empty = error "lookupTree of empty tree"
726 lookupTree i (Single x) = Place i x
727 lookupTree i (Deep _ pr m sf)
728 | vpr > 0 = lookupDigit i pr
729 | vm > 0 = case lookupTree vpr m of
730 Place i' xs -> lookupNode i' xs
731 | otherwise = lookupDigit vm sf
732 where vpr = i + size pr
735 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
736 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
737 lookupNode :: Sized a => Int -> Node a -> Place a
738 lookupNode i (Node2 _ a b)
740 | otherwise = Place va b
741 where va = i + size a
742 lookupNode i (Node3 _ a b c)
744 | vab > 0 = Place va b
745 | otherwise = Place vab c
746 where va = i + size a
749 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
750 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
751 lookupDigit :: Sized a => Int -> Digit a -> Place a
752 lookupDigit i (One a) = Place i a
753 lookupDigit i (Two a b)
755 | otherwise = Place va b
756 where va = i + size a
757 lookupDigit i (Three a b c)
759 | vab > 0 = Place va b
760 | otherwise = Place vab c
761 where va = i + size a
763 lookupDigit i (Four a b c d)
765 | vab > 0 = Place va b
766 | vabc > 0 = Place vab c
767 | otherwise = Place vabc d
768 where va = i + size a
772 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
773 update :: Int -> a -> Seq a -> Seq a
774 update i x = adjust (const x) i
776 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
777 adjust :: (a -> a) -> Int -> Seq a -> Seq a
779 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
782 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
783 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
784 adjustTree :: Sized a => (Int -> a -> a) ->
785 Int -> FingerTree a -> FingerTree a
786 adjustTree _ _ Empty = error "adjustTree of empty tree"
787 adjustTree f i (Single x) = Single (f i x)
788 adjustTree f i (Deep s pr m sf)
789 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
790 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
791 | otherwise = Deep s pr m (adjustDigit f vm sf)
792 where vpr = i + size pr
795 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
796 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
797 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
798 adjustNode f i (Node2 s a b)
799 | va > 0 = Node2 s (f i a) b
800 | otherwise = Node2 s a (f va b)
801 where va = i + size a
802 adjustNode f i (Node3 s a b c)
803 | va > 0 = Node3 s (f i a) b c
804 | vab > 0 = Node3 s a (f va b) c
805 | otherwise = Node3 s a b (f vab c)
806 where va = i + size a
809 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
810 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
811 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
812 adjustDigit f i (One a) = One (f i a)
813 adjustDigit f i (Two a b)
814 | va > 0 = Two (f i a) b
815 | otherwise = Two a (f va b)
816 where va = i + size a
817 adjustDigit f i (Three a b c)
818 | va > 0 = Three (f i a) b c
819 | vab > 0 = Three a (f va b) c
820 | otherwise = Three a b (f vab c)
821 where va = i + size a
823 adjustDigit f i (Four a b c d)
824 | va > 0 = Four (f i a) b c d
825 | vab > 0 = Four a (f va b) c d
826 | vabc > 0 = Four a b (f vab c) d
827 | otherwise = Four a b c (f vabc d)
828 where va = i + size a
834 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
835 take :: Int -> Seq a -> Seq a
836 take i = fst . splitAt i
838 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
839 drop :: Int -> Seq a -> Seq a
840 drop i = snd . splitAt i
842 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
843 splitAt :: Int -> Seq a -> (Seq a, Seq a)
844 splitAt i (Seq xs) = (Seq l, Seq r)
845 where (l, r) = split i xs
847 split :: Int -> FingerTree (Elem a) ->
848 (FingerTree (Elem a), FingerTree (Elem a))
849 split i Empty = i `seq` (Empty, Empty)
851 | size xs > i = (l, consTree x r)
852 | otherwise = (xs, Empty)
853 where Split l x r = splitTree (-i) xs
855 data Split t a = Split t a t
860 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
861 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
862 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
863 splitTree _ Empty = error "splitTree of empty tree"
864 splitTree i (Single x) = i `seq` Split Empty x Empty
865 splitTree i (Deep _ pr m sf)
866 | vpr > 0 = case splitDigit i pr of
867 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
868 | vm > 0 = case splitTree vpr m of
869 Split ml xs mr -> case splitNode (vpr + size ml) xs of
870 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
871 | otherwise = case splitDigit vm sf of
872 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
873 where vpr = i + size pr
876 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
877 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
878 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
879 deepL Nothing m sf = case viewLTree m of
880 Nothing2 -> digitToTree sf
881 Just2 a m' -> deep (nodeToDigit a) m' sf
882 deepL (Just pr) m sf = deep pr m sf
884 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
885 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
886 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
887 deepR pr m Nothing = case viewRTree m of
888 Nothing2 -> digitToTree pr
889 Just2 m' a -> deep pr m' (nodeToDigit a)
890 deepR pr m (Just sf) = deep pr m sf
892 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
893 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
894 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
895 splitNode i (Node2 _ a b)
896 | va > 0 = Split Nothing a (Just (One b))
897 | otherwise = Split (Just (One a)) b Nothing
898 where va = i + size a
899 splitNode i (Node3 _ a b c)
900 | va > 0 = Split Nothing a (Just (Two b c))
901 | vab > 0 = Split (Just (One a)) b (Just (One c))
902 | otherwise = Split (Just (Two a b)) c Nothing
903 where va = i + size a
906 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
907 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
908 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
909 splitDigit i (One a) = i `seq` Split Nothing a Nothing
910 splitDigit i (Two a b)
911 | va > 0 = Split Nothing a (Just (One b))
912 | otherwise = Split (Just (One a)) b Nothing
913 where va = i + size a
914 splitDigit i (Three a b c)
915 | va > 0 = Split Nothing a (Just (Two b c))
916 | vab > 0 = Split (Just (One a)) b (Just (One c))
917 | otherwise = Split (Just (Two a b)) c Nothing
918 where va = i + size a
920 splitDigit i (Four a b c d)
921 | va > 0 = Split Nothing a (Just (Three b c d))
922 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
923 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
924 | otherwise = Split (Just (Three a b c)) d Nothing
925 where va = i + size a
929 ------------------------------------------------------------------------
931 ------------------------------------------------------------------------
933 -- | /O(n)/. Create a sequence from a finite list of elements.
934 fromList :: [a] -> Seq a
935 fromList = Data.List.foldl' (|>) empty
937 -- | /O(n)/. List of elements of the sequence.
938 toList :: Seq a -> [a]
939 #ifdef __GLASGOW_HASKELL__
940 {-# INLINE toList #-}
941 toList xs = build (\ c n -> foldr c n xs)
943 toList = foldr (:) []
946 ------------------------------------------------------------------------
948 ------------------------------------------------------------------------
950 -- | /O(n*t)/. Fold over the elements of a sequence,
951 -- associating to the right.
952 foldr :: (a -> b -> b) -> b -> Seq a -> b
953 foldr f z (Seq xs) = foldrTree f' z xs
954 where f' (Elem x) y = f x y
956 foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
957 foldrTree _ z Empty = z
958 foldrTree f z (Single x) = x `f` z
959 foldrTree f z (Deep _ pr m sf) =
960 foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr
962 foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
963 foldrDigit f z (One a) = a `f` z
964 foldrDigit f z (Two a b) = a `f` (b `f` z)
965 foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z))
966 foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
968 foldrNode :: (a -> b -> b) -> b -> Node a -> b
969 foldrNode f z (Node2 _ a b) = a `f` (b `f` z)
970 foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
972 -- | /O(n*t)/. A variant of 'foldr' that has no base case,
973 -- and thus may only be applied to non-empty sequences.
974 foldr1 :: (a -> a -> a) -> Seq a -> a
975 foldr1 f (Seq xs) = getElem (foldr1Tree f' xs)
976 where f' (Elem x) (Elem y) = Elem (f x y)
978 foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
979 foldr1Tree _ Empty = error "foldr1: empty sequence"
980 foldr1Tree _ (Single x) = x
981 foldr1Tree f (Deep _ pr m sf) =
982 foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr
984 foldr1Digit :: (a -> a -> a) -> Digit a -> a
985 foldr1Digit f (One a) = a
986 foldr1Digit f (Two a b) = a `f` b
987 foldr1Digit f (Three a b c) = a `f` (b `f` c)
988 foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d))
990 -- | /O(n*t)/. Fold over the elements of a sequence,
991 -- associating to the left.
992 foldl :: (a -> b -> a) -> a -> Seq b -> a
993 foldl f z (Seq xs) = foldlTree f' z xs
994 where f' x (Elem y) = f x y
996 foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
997 foldlTree _ z Empty = z
998 foldlTree f z (Single x) = z `f` x
999 foldlTree f z (Deep _ pr m sf) =
1000 foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
1002 foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
1003 foldlDigit f z (One a) = z `f` a
1004 foldlDigit f z (Two a b) = (z `f` a) `f` b
1005 foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c
1006 foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
1008 foldlNode :: (a -> b -> a) -> a -> Node b -> a
1009 foldlNode f z (Node2 _ a b) = (z `f` a) `f` b
1010 foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
1012 -- | /O(n*t)/. A variant of 'foldl' that has no base case,
1013 -- and thus may only be applied to non-empty sequences.
1014 foldl1 :: (a -> a -> a) -> Seq a -> a
1015 foldl1 f (Seq xs) = getElem (foldl1Tree f' xs)
1016 where f' (Elem x) (Elem y) = Elem (f x y)
1018 foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
1019 foldl1Tree _ Empty = error "foldl1: empty sequence"
1020 foldl1Tree _ (Single x) = x
1021 foldl1Tree f (Deep _ pr m sf) =
1022 foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf
1024 foldl1Digit :: (a -> a -> a) -> Digit a -> a
1025 foldl1Digit f (One a) = a
1026 foldl1Digit f (Two a b) = a `f` b
1027 foldl1Digit f (Three a b c) = (a `f` b) `f` c
1028 foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d
1030 ------------------------------------------------------------------------
1032 ------------------------------------------------------------------------
1034 -- | /O(n*t)/. Fold over the elements of a sequence,
1035 -- associating to the right, but strictly.
1036 foldr' :: (a -> b -> b) -> b -> Seq a -> b
1037 foldr' f z xs = foldl f' id xs z
1038 where f' k x z = k $! f x z
1040 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1041 -- associating to the right, i.e. from right to left.
1042 foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
1043 foldrM f z xs = foldl f' return xs z
1044 where f' k x z = f x z >>= k
1046 -- | /O(n*t)/. Fold over the elements of a sequence,
1047 -- associating to the left, but strictly.
1048 foldl' :: (a -> b -> a) -> a -> Seq b -> a
1049 foldl' f z xs = foldr f' id xs z
1050 where f' x k z = k $! f z x
1052 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1053 -- associating to the left, i.e. from left to right.
1054 foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
1055 foldlM f z xs = foldr f' return xs z
1056 where f' x k z = f z x >>= k
1058 ------------------------------------------------------------------------
1060 ------------------------------------------------------------------------
1062 -- | /O(n)/. The reverse of a sequence.
1063 reverse :: Seq a -> Seq a
1064 reverse (Seq xs) = Seq (reverseTree id xs)
1066 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1067 reverseTree _ Empty = Empty
1068 reverseTree f (Single x) = Single (f x)
1069 reverseTree f (Deep s pr m sf) =
1070 Deep s (reverseDigit f sf)
1071 (reverseTree (reverseNode f) m)
1074 reverseDigit :: (a -> a) -> Digit a -> Digit a
1075 reverseDigit f (One a) = One (f a)
1076 reverseDigit f (Two a b) = Two (f b) (f a)
1077 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1078 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1080 reverseNode :: (a -> a) -> Node a -> Node a
1081 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1082 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1086 ------------------------------------------------------------------------
1088 ------------------------------------------------------------------------
1090 instance Arbitrary a => Arbitrary (Seq a) where
1091 arbitrary = liftM Seq arbitrary
1092 coarbitrary (Seq x) = coarbitrary x
1094 instance Arbitrary a => Arbitrary (Elem a) where
1095 arbitrary = liftM Elem arbitrary
1096 coarbitrary (Elem x) = coarbitrary x
1098 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1099 arbitrary = sized arb
1100 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1101 arb 0 = return Empty
1102 arb 1 = liftM Single arbitrary
1103 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1105 coarbitrary Empty = variant 0
1106 coarbitrary (Single x) = variant 1 . coarbitrary x
1107 coarbitrary (Deep _ pr m sf) =
1108 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1110 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1112 liftM2 node2 arbitrary arbitrary,
1113 liftM3 node3 arbitrary arbitrary arbitrary]
1115 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1116 coarbitrary (Node3 _ a b c) =
1117 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1119 instance Arbitrary a => Arbitrary (Digit a) where
1121 liftM One arbitrary,
1122 liftM2 Two arbitrary arbitrary,
1123 liftM3 Three arbitrary arbitrary arbitrary,
1124 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1126 coarbitrary (One a) = variant 0 . coarbitrary a
1127 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1128 coarbitrary (Three a b c) =
1129 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1130 coarbitrary (Four a b c d) =
1131 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1133 ------------------------------------------------------------------------
1135 ------------------------------------------------------------------------
1140 instance Valid (Elem a) where
1143 instance Valid (Seq a) where
1144 valid (Seq xs) = valid xs
1146 instance (Sized a, Valid a) => Valid (FingerTree a) where
1148 valid (Single x) = valid x
1149 valid (Deep s pr m sf) =
1150 s == size pr + size m + size sf && valid pr && valid m && valid sf
1152 instance (Sized a, Valid a) => Valid (Node a) where
1153 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1154 valid (Node3 s a b c) =
1155 s == size a + size b + size c && valid a && valid b && valid c
1157 instance Valid a => Valid (Digit a) where
1158 valid (One a) = valid a
1159 valid (Two a b) = valid a && valid b
1160 valid (Three a b c) = valid a && valid b && valid c
1161 valid (Four a b c d) = valid a && valid b && valid c && valid d