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(..))
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, liftM2, 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 deriving (Eq, Ord, Show, Read)
604 instance Eq a => Eq (ViewL a)
605 instance Ord a => Ord (ViewL a)
606 instance Show a => Show (ViewL a)
607 instance Read a => Read (ViewL a)
610 INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL")
612 instance Functor ViewL where
613 fmap _ EmptyL = EmptyL
614 fmap f (x :< xs) = f x :< fmap f xs
616 -- | /O(1)/. Analyse the left end of a sequence.
617 viewl :: Seq a -> ViewL a
618 viewl (Seq xs) = case viewLTree xs of
620 Just2 (Elem x) xs' -> x :< Seq xs'
622 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
623 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
624 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
625 viewLTree Empty = Nothing2
626 viewLTree (Single a) = Just2 a Empty
627 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
628 Nothing2 -> digitToTree sf
629 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
630 viewLTree (Deep s (Two a b) m sf) =
631 Just2 a (Deep (s - size a) (One b) m sf)
632 viewLTree (Deep s (Three a b c) m sf) =
633 Just2 a (Deep (s - size a) (Two b c) m sf)
634 viewLTree (Deep s (Four a b c d) m sf) =
635 Just2 a (Deep (s - size a) (Three b c d) m sf)
637 -- | View of the right end of a sequence.
639 = EmptyR -- ^ empty sequence
640 | Seq a :> a -- ^ the sequence minus the rightmost element,
641 -- and the rightmost element
643 deriving (Eq, Ord, Show, Read)
645 instance Eq a => Eq (ViewR a)
646 instance Ord a => Ord (ViewR a)
647 instance Show a => Show (ViewR a)
648 instance Read a => Read (ViewR a)
651 INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR")
653 instance Functor ViewR where
654 fmap _ EmptyR = EmptyR
655 fmap f (xs :> x) = fmap f xs :> f x
657 -- | /O(1)/. Analyse the right end of a sequence.
658 viewr :: Seq a -> ViewR a
659 viewr (Seq xs) = case viewRTree xs of
661 Just2 xs' (Elem x) -> Seq xs' :> x
663 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
664 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
665 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
666 viewRTree Empty = Nothing2
667 viewRTree (Single z) = Just2 Empty z
668 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
669 Nothing2 -> digitToTree pr
670 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
671 viewRTree (Deep s pr m (Two y z)) =
672 Just2 (Deep (s - size z) pr m (One y)) z
673 viewRTree (Deep s pr m (Three x y z)) =
674 Just2 (Deep (s - size z) pr m (Two x y)) z
675 viewRTree (Deep s pr m (Four w x y z)) =
676 Just2 (Deep (s - size z) pr m (Three w x y)) z
680 -- | /O(log(min(i,n-i)))/. The element at the specified position
681 index :: Seq a -> Int -> a
683 | 0 <= i && i < size xs = case lookupTree (-i) xs of
684 Place _ (Elem x) -> x
685 | otherwise = error "index out of bounds"
687 data Place a = Place {-# UNPACK #-} !Int a
692 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
693 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
694 lookupTree :: Sized a => Int -> FingerTree a -> Place a
695 lookupTree _ Empty = error "lookupTree of empty tree"
696 lookupTree i (Single x) = Place i x
697 lookupTree i (Deep _ pr m sf)
698 | vpr > 0 = lookupDigit i pr
699 | vm > 0 = case lookupTree vpr m of
700 Place i' xs -> lookupNode i' xs
701 | otherwise = lookupDigit vm sf
702 where vpr = i + size pr
705 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
706 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
707 lookupNode :: Sized a => Int -> Node a -> Place a
708 lookupNode i (Node2 _ a b)
710 | otherwise = Place va b
711 where va = i + size a
712 lookupNode i (Node3 _ a b c)
714 | vab > 0 = Place va b
715 | otherwise = Place vab c
716 where va = i + size a
719 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
720 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
721 lookupDigit :: Sized a => Int -> Digit a -> Place a
722 lookupDigit i (One a) = Place i a
723 lookupDigit i (Two a b)
725 | otherwise = Place va b
726 where va = i + size a
727 lookupDigit i (Three a b c)
729 | vab > 0 = Place va b
730 | otherwise = Place vab c
731 where va = i + size a
733 lookupDigit i (Four a b c d)
735 | vab > 0 = Place va b
736 | vabc > 0 = Place vab c
737 | otherwise = Place vabc d
738 where va = i + size a
742 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
743 update :: Int -> a -> Seq a -> Seq a
744 update i x = adjust (const x) i
746 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
747 adjust :: (a -> a) -> Int -> Seq a -> Seq a
749 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
752 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
753 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
754 adjustTree :: Sized a => (Int -> a -> a) ->
755 Int -> FingerTree a -> FingerTree a
756 adjustTree _ _ Empty = error "adjustTree of empty tree"
757 adjustTree f i (Single x) = Single (f i x)
758 adjustTree f i (Deep s pr m sf)
759 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
760 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
761 | otherwise = Deep s pr m (adjustDigit f vm sf)
762 where vpr = i + size pr
765 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
766 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
767 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
768 adjustNode f i (Node2 s a b)
769 | va > 0 = Node2 s (f i a) b
770 | otherwise = Node2 s a (f va b)
771 where va = i + size a
772 adjustNode f i (Node3 s a b c)
773 | va > 0 = Node3 s (f i a) b c
774 | vab > 0 = Node3 s a (f va b) c
775 | otherwise = Node3 s a b (f vab c)
776 where va = i + size a
779 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
780 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
781 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
782 adjustDigit f i (One a) = One (f i a)
783 adjustDigit f i (Two a b)
784 | va > 0 = Two (f i a) b
785 | otherwise = Two a (f va b)
786 where va = i + size a
787 adjustDigit f i (Three a b c)
788 | va > 0 = Three (f i a) b c
789 | vab > 0 = Three a (f va b) c
790 | otherwise = Three a b (f vab c)
791 where va = i + size a
793 adjustDigit f i (Four a b c d)
794 | va > 0 = Four (f i a) b c d
795 | vab > 0 = Four a (f va b) c d
796 | vabc > 0 = Four a b (f vab c) d
797 | otherwise = Four a b c (f vabc d)
798 where va = i + size a
804 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
805 take :: Int -> Seq a -> Seq a
806 take i = fst . splitAt i
808 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
809 drop :: Int -> Seq a -> Seq a
810 drop i = snd . splitAt i
812 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
813 splitAt :: Int -> Seq a -> (Seq a, Seq a)
814 splitAt i (Seq xs) = (Seq l, Seq r)
815 where (l, r) = split i xs
817 split :: Int -> FingerTree (Elem a) ->
818 (FingerTree (Elem a), FingerTree (Elem a))
819 split i Empty = i `seq` (Empty, Empty)
821 | size xs > i = (l, consTree x r)
822 | otherwise = (xs, Empty)
823 where Split l x r = splitTree (-i) xs
825 data Split t a = Split t a t
830 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
831 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
832 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
833 splitTree _ Empty = error "splitTree of empty tree"
834 splitTree i (Single x) = i `seq` Split Empty x Empty
835 splitTree i (Deep _ pr m sf)
836 | vpr > 0 = case splitDigit i pr of
837 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
838 | vm > 0 = case splitTree vpr m of
839 Split ml xs mr -> case splitNode (vpr + size ml) xs of
840 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
841 | otherwise = case splitDigit vm sf of
842 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
843 where vpr = i + size pr
846 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
847 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
848 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
849 deepL Nothing m sf = case viewLTree m of
850 Nothing2 -> digitToTree sf
851 Just2 a m' -> deep (nodeToDigit a) m' sf
852 deepL (Just pr) m sf = deep pr m sf
854 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
855 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
856 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
857 deepR pr m Nothing = case viewRTree m of
858 Nothing2 -> digitToTree pr
859 Just2 m' a -> deep pr m' (nodeToDigit a)
860 deepR pr m (Just sf) = deep pr m sf
862 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
863 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
864 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
865 splitNode i (Node2 _ a b)
866 | va > 0 = Split Nothing a (Just (One b))
867 | otherwise = Split (Just (One a)) b Nothing
868 where va = i + size a
869 splitNode i (Node3 _ a b c)
870 | va > 0 = Split Nothing a (Just (Two b c))
871 | vab > 0 = Split (Just (One a)) b (Just (One c))
872 | otherwise = Split (Just (Two a b)) c Nothing
873 where va = i + size a
876 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
877 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
878 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
879 splitDigit i (One a) = i `seq` Split Nothing a Nothing
880 splitDigit i (Two a b)
881 | va > 0 = Split Nothing a (Just (One b))
882 | otherwise = Split (Just (One a)) b Nothing
883 where va = i + size a
884 splitDigit i (Three a b c)
885 | va > 0 = Split Nothing a (Just (Two b c))
886 | vab > 0 = Split (Just (One a)) b (Just (One c))
887 | otherwise = Split (Just (Two a b)) c Nothing
888 where va = i + size a
890 splitDigit i (Four a b c d)
891 | va > 0 = Split Nothing a (Just (Three b c d))
892 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
893 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
894 | otherwise = Split (Just (Three a b c)) d Nothing
895 where va = i + size a
899 ------------------------------------------------------------------------
901 ------------------------------------------------------------------------
903 -- | /O(n)/. Create a sequence from a finite list of elements.
904 fromList :: [a] -> Seq a
905 fromList = Data.List.foldl' (|>) empty
907 -- | /O(n)/. List of elements of the sequence.
908 toList :: Seq a -> [a]
909 #ifdef __GLASGOW_HASKELL__
910 {-# INLINE toList #-}
911 toList xs = build (\ c n -> foldr c n xs)
913 toList = foldr (:) []
916 ------------------------------------------------------------------------
918 ------------------------------------------------------------------------
920 -- | /O(n*t)/. Fold over the elements of a sequence,
921 -- associating to the right.
922 foldr :: (a -> b -> b) -> b -> Seq a -> b
923 foldr f z (Seq xs) = foldrTree f' z xs
924 where f' (Elem x) y = f x y
926 foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
927 foldrTree _ z Empty = z
928 foldrTree f z (Single x) = x `f` z
929 foldrTree f z (Deep _ pr m sf) =
930 foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr
932 foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
933 foldrDigit f z (One a) = a `f` z
934 foldrDigit f z (Two a b) = a `f` (b `f` z)
935 foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z))
936 foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
938 foldrNode :: (a -> b -> b) -> b -> Node a -> b
939 foldrNode f z (Node2 _ a b) = a `f` (b `f` z)
940 foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
942 -- | /O(n*t)/. A variant of 'foldr' that has no base case,
943 -- and thus may only be applied to non-empty sequences.
944 foldr1 :: (a -> a -> a) -> Seq a -> a
945 foldr1 f (Seq xs) = getElem (foldr1Tree f' xs)
946 where f' (Elem x) (Elem y) = Elem (f x y)
948 foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
949 foldr1Tree _ Empty = error "foldr1: empty sequence"
950 foldr1Tree _ (Single x) = x
951 foldr1Tree f (Deep _ pr m sf) =
952 foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr
954 foldr1Digit :: (a -> a -> a) -> Digit a -> a
955 foldr1Digit f (One a) = a
956 foldr1Digit f (Two a b) = a `f` b
957 foldr1Digit f (Three a b c) = a `f` (b `f` c)
958 foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d))
960 -- | /O(n*t)/. Fold over the elements of a sequence,
961 -- associating to the left.
962 foldl :: (a -> b -> a) -> a -> Seq b -> a
963 foldl f z (Seq xs) = foldlTree f' z xs
964 where f' x (Elem y) = f x y
966 foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
967 foldlTree _ z Empty = z
968 foldlTree f z (Single x) = z `f` x
969 foldlTree f z (Deep _ pr m sf) =
970 foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
972 foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
973 foldlDigit f z (One a) = z `f` a
974 foldlDigit f z (Two a b) = (z `f` a) `f` b
975 foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c
976 foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
978 foldlNode :: (a -> b -> a) -> a -> Node b -> a
979 foldlNode f z (Node2 _ a b) = (z `f` a) `f` b
980 foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
982 -- | /O(n*t)/. A variant of 'foldl' that has no base case,
983 -- and thus may only be applied to non-empty sequences.
984 foldl1 :: (a -> a -> a) -> Seq a -> a
985 foldl1 f (Seq xs) = getElem (foldl1Tree f' xs)
986 where f' (Elem x) (Elem y) = Elem (f x y)
988 foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
989 foldl1Tree _ Empty = error "foldl1: empty sequence"
990 foldl1Tree _ (Single x) = x
991 foldl1Tree f (Deep _ pr m sf) =
992 foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf
994 foldl1Digit :: (a -> a -> a) -> Digit a -> a
995 foldl1Digit f (One a) = a
996 foldl1Digit f (Two a b) = a `f` b
997 foldl1Digit f (Three a b c) = (a `f` b) `f` c
998 foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d
1000 ------------------------------------------------------------------------
1002 ------------------------------------------------------------------------
1004 -- | /O(n*t)/. Fold over the elements of a sequence,
1005 -- associating to the right, but strictly.
1006 foldr' :: (a -> b -> b) -> b -> Seq a -> b
1007 foldr' f z xs = foldl f' id xs z
1008 where f' k x z = k $! f x z
1010 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1011 -- associating to the right, i.e. from right to left.
1012 foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
1013 foldrM f z xs = foldl f' return xs z
1014 where f' k x z = f x z >>= k
1016 -- | /O(n*t)/. Fold over the elements of a sequence,
1017 -- associating to the left, but strictly.
1018 foldl' :: (a -> b -> a) -> a -> Seq b -> a
1019 foldl' f z xs = foldr f' id xs z
1020 where f' x k z = k $! f z x
1022 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1023 -- associating to the left, i.e. from left to right.
1024 foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
1025 foldlM f z xs = foldr f' return xs z
1026 where f' x k z = f z x >>= k
1028 ------------------------------------------------------------------------
1030 ------------------------------------------------------------------------
1032 -- | /O(n)/. The reverse of a sequence.
1033 reverse :: Seq a -> Seq a
1034 reverse (Seq xs) = Seq (reverseTree id xs)
1036 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1037 reverseTree _ Empty = Empty
1038 reverseTree f (Single x) = Single (f x)
1039 reverseTree f (Deep s pr m sf) =
1040 Deep s (reverseDigit f sf)
1041 (reverseTree (reverseNode f) m)
1044 reverseDigit :: (a -> a) -> Digit a -> Digit a
1045 reverseDigit f (One a) = One (f a)
1046 reverseDigit f (Two a b) = Two (f b) (f a)
1047 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1048 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1050 reverseNode :: (a -> a) -> Node a -> Node a
1051 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1052 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1056 ------------------------------------------------------------------------
1058 ------------------------------------------------------------------------
1060 instance Arbitrary a => Arbitrary (Seq a) where
1061 arbitrary = liftM Seq arbitrary
1062 coarbitrary (Seq x) = coarbitrary x
1064 instance Arbitrary a => Arbitrary (Elem a) where
1065 arbitrary = liftM Elem arbitrary
1066 coarbitrary (Elem x) = coarbitrary x
1068 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1069 arbitrary = sized arb
1070 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1071 arb 0 = return Empty
1072 arb 1 = liftM Single arbitrary
1073 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1075 coarbitrary Empty = variant 0
1076 coarbitrary (Single x) = variant 1 . coarbitrary x
1077 coarbitrary (Deep _ pr m sf) =
1078 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1080 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1082 liftM2 node2 arbitrary arbitrary,
1083 liftM3 node3 arbitrary arbitrary arbitrary]
1085 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1086 coarbitrary (Node3 _ a b c) =
1087 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1089 instance Arbitrary a => Arbitrary (Digit a) where
1091 liftM One arbitrary,
1092 liftM2 Two arbitrary arbitrary,
1093 liftM3 Three arbitrary arbitrary arbitrary,
1094 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1096 coarbitrary (One a) = variant 0 . coarbitrary a
1097 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1098 coarbitrary (Three a b c) =
1099 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1100 coarbitrary (Four a b c d) =
1101 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1103 ------------------------------------------------------------------------
1105 ------------------------------------------------------------------------
1110 instance Valid (Elem a) where
1113 instance Valid (Seq a) where
1114 valid (Seq xs) = valid xs
1116 instance (Sized a, Valid a) => Valid (FingerTree a) where
1118 valid (Single x) = valid x
1119 valid (Deep s pr m sf) =
1120 s == size pr + size m + size sf && valid pr && valid m && valid sf
1122 instance (Sized a, Valid a) => Valid (Node a) where
1123 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1124 valid (Node3 s a b c) =
1125 s == size a + size b + size c && valid a && valid b && valid c
1127 instance Valid a => Valid (Digit a) where
1128 valid (One a) = valid a
1129 valid (Two a b) = valid a && valid b
1130 valid (Three a b c) = valid a && valid b && valid c
1131 valid (Four a b c d) = valid a && valid b && valid c && valid d