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 -- /Journal of Functional Programming/ 16:2 (2006) pp 197-217.
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
42 fromList, -- :: [a] -> Seq a
44 -- | Additional functions for deconstructing sequences are available
45 -- via the 'Foldable' instance of 'Seq'.
48 null, -- :: Seq a -> Bool
49 length, -- :: Seq a -> Int
52 viewl, -- :: Seq a -> ViewL a
54 viewr, -- :: Seq a -> ViewR a
56 index, -- :: Seq a -> Int -> a
57 adjust, -- :: (a -> a) -> Int -> Seq a -> Seq a
58 update, -- :: Int -> a -> Seq a -> Seq a
59 take, -- :: Int -> Seq a -> Seq a
60 drop, -- :: Int -> Seq a -> Seq a
61 splitAt, -- :: Int -> Seq a -> (Seq a, Seq a)
63 reverse, -- :: Seq a -> Seq a
69 import Prelude hiding (
70 null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
72 import qualified Data.List (foldl')
73 import Control.Applicative (Applicative(..), (<$>))
74 import Control.Monad (MonadPlus(..))
75 import Data.Monoid (Monoid(..))
77 import Data.Traversable
80 #ifdef __GLASGOW_HASKELL__
81 import Text.Read (Lexeme(Ident), lexP, parens, prec,
82 readPrec, readListPrec, readListPrecDefault)
83 import Data.Generics.Basics (Data(..), Fixity(..),
84 constrIndex, mkConstr, mkDataType)
88 import Control.Monad (liftM, liftM3, liftM4)
89 import Test.QuickCheck
102 -- | General-purpose finite sequences.
103 newtype Seq a = Seq (FingerTree (Elem a))
105 instance Functor Seq where
106 fmap f (Seq xs) = Seq (fmap (fmap f) xs)
108 instance Foldable Seq where
109 foldr f z (Seq xs) = foldr (flip (foldr f)) z xs
110 foldl f z (Seq xs) = foldl (foldl f) z xs
112 foldr1 f (Seq xs) = getElem (foldr1 f' xs)
113 where f' (Elem x) (Elem y) = Elem (f x y)
115 foldl1 f (Seq xs) = getElem (foldl1 f' xs)
116 where f' (Elem x) (Elem y) = Elem (f x y)
118 instance Traversable Seq where
119 traverse f (Seq xs) = Seq <$> traverse (traverse f) xs
121 instance Monad Seq where
123 xs >>= f = foldl' add empty xs
124 where add ys x = ys >< f x
126 instance MonadPlus Seq where
130 instance Eq a => Eq (Seq a) where
131 xs == ys = length xs == length ys && toList xs == toList ys
133 instance Ord a => Ord (Seq a) where
134 compare xs ys = compare (toList xs) (toList ys)
137 instance Show a => Show (Seq a) where
138 showsPrec p (Seq x) = showsPrec p x
140 instance Show a => Show (Seq a) where
141 showsPrec p xs = showParen (p > 10) $
142 showString "fromList " . shows (toList xs)
145 instance Read a => Read (Seq a) where
146 #ifdef __GLASGOW_HASKELL__
147 readPrec = parens $ prec 10 $ do
148 Ident "fromList" <- lexP
152 readListPrec = readListPrecDefault
154 readsPrec p = readParen (p > 10) $ \ r -> do
155 ("fromList",s) <- lex r
157 return (fromList xs,t)
160 instance Monoid (Seq a) where
164 #include "Typeable.h"
165 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
167 #if __GLASGOW_HASKELL__
168 instance Data a => Data (Seq a) where
169 gfoldl f z s = case viewl s of
171 x :< xs -> z (<|) `f` x `f` xs
173 gunfold k z c = case constrIndex c of
179 | null xs = emptyConstr
180 | otherwise = consConstr
182 dataTypeOf _ = seqDataType
184 dataCast1 f = gcast1 f
186 emptyConstr = mkConstr seqDataType "empty" [] Prefix
187 consConstr = mkConstr seqDataType "<|" [] Infix
188 seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
196 | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
201 instance Sized a => Sized (FingerTree a) where
202 {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
203 {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
205 size (Single x) = size x
206 size (Deep v _ _ _) = v
208 instance Foldable FingerTree where
210 foldr f z (Single x) = x `f` z
211 foldr f z (Deep _ pr m sf) =
212 foldr f (foldr (flip (foldr f)) (foldr f z sf) m) pr
215 foldl f z (Single x) = z `f` x
216 foldl f z (Deep _ pr m sf) =
217 foldl f (foldl (foldl f) (foldl f z pr) m) sf
219 foldr1 _ Empty = error "foldr1: empty sequence"
220 foldr1 _ (Single x) = x
221 foldr1 f (Deep _ pr m sf) =
222 foldr f (foldr (flip (foldr f)) (foldr1 f sf) m) pr
224 foldl1 _ Empty = error "foldl1: empty sequence"
225 foldl1 _ (Single x) = x
226 foldl1 f (Deep _ pr m sf) =
227 foldl f (foldl (foldl f) (foldl1 f pr) m) sf
229 instance Functor FingerTree where
231 fmap f (Single x) = Single (f x)
232 fmap f (Deep v pr m sf) =
233 Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
235 instance Traversable FingerTree where
236 traverse _ Empty = pure Empty
237 traverse f (Single x) = Single <$> f x
238 traverse f (Deep v pr m sf) =
239 Deep v <$> traverse f pr <*> traverse (traverse f) m <*>
243 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
244 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
245 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
246 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
259 instance Foldable Digit where
260 foldr f z (One a) = a `f` z
261 foldr f z (Two a b) = a `f` (b `f` z)
262 foldr f z (Three a b c) = a `f` (b `f` (c `f` z))
263 foldr f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
265 foldl f z (One a) = z `f` a
266 foldl f z (Two a b) = (z `f` a) `f` b
267 foldl f z (Three a b c) = ((z `f` a) `f` b) `f` c
268 foldl f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
271 foldr1 f (Two a b) = a `f` b
272 foldr1 f (Three a b c) = a `f` (b `f` c)
273 foldr1 f (Four a b c d) = a `f` (b `f` (c `f` d))
276 foldl1 f (Two a b) = a `f` b
277 foldl1 f (Three a b c) = (a `f` b) `f` c
278 foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d
280 instance Functor Digit where
283 instance Traversable Digit where
284 traverse f (One a) = One <$> f a
285 traverse f (Two a b) = Two <$> f a <*> f b
286 traverse f (Three a b c) = Three <$> f a <*> f b <*> f c
287 traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d
289 instance Sized a => Sized (Digit a) where
290 {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
291 {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
292 size xs = foldl (\ i x -> i + size x) 0 xs
294 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
295 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
296 digitToTree :: Sized a => Digit a -> FingerTree a
297 digitToTree (One a) = Single a
298 digitToTree (Two a b) = deep (One a) Empty (One b)
299 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
300 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
305 = Node2 {-# UNPACK #-} !Int a a
306 | Node3 {-# UNPACK #-} !Int a a a
311 instance Foldable Node where
312 foldr f z (Node2 _ a b) = a `f` (b `f` z)
313 foldr f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
315 foldl f z (Node2 _ a b) = (z `f` a) `f` b
316 foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
318 instance Functor Node where
321 instance Traversable Node where
322 traverse f (Node2 v a b) = Node2 v <$> f a <*> f b
323 traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c
325 instance Sized (Node a) where
326 size (Node2 v _ _) = v
327 size (Node3 v _ _ _) = v
330 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
331 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
332 node2 :: Sized a => a -> a -> Node a
333 node2 a b = Node2 (size a + size b) a b
336 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
337 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
338 node3 :: Sized a => a -> a -> a -> Node a
339 node3 a b c = Node3 (size a + size b + size c) a b c
341 nodeToDigit :: Node a -> Digit a
342 nodeToDigit (Node2 _ a b) = Two a b
343 nodeToDigit (Node3 _ a b c) = Three a b c
347 newtype Elem a = Elem { getElem :: a }
349 instance Sized (Elem a) where
352 instance Functor Elem where
353 fmap f (Elem x) = Elem (f x)
355 instance Foldable Elem where
356 foldr f z (Elem x) = f x z
357 foldl f z (Elem x) = f z x
359 instance Traversable Elem where
360 traverse f (Elem x) = Elem <$> f x
363 instance (Show a) => Show (Elem a) where
364 showsPrec p (Elem x) = showsPrec p x
367 ------------------------------------------------------------------------
369 ------------------------------------------------------------------------
371 -- | /O(1)/. The empty sequence.
375 -- | /O(1)/. A singleton sequence.
376 singleton :: a -> Seq a
377 singleton x = Seq (Single (Elem x))
379 -- | /O(1)/. Add an element to the left end of a sequence.
380 -- Mnemonic: a triangle with the single element at the pointy end.
381 (<|) :: a -> Seq a -> Seq a
382 x <| Seq xs = Seq (Elem x `consTree` xs)
384 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
385 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
386 consTree :: Sized a => a -> FingerTree a -> FingerTree a
387 consTree a Empty = Single a
388 consTree a (Single b) = deep (One a) Empty (One b)
389 consTree a (Deep s (Four b c d e) m sf) = m `seq`
390 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
391 consTree a (Deep s (Three b c d) m sf) =
392 Deep (size a + s) (Four a b c d) m sf
393 consTree a (Deep s (Two b c) m sf) =
394 Deep (size a + s) (Three a b c) m sf
395 consTree a (Deep s (One b) m sf) =
396 Deep (size a + s) (Two a b) m sf
398 -- | /O(1)/. Add an element to the right end of a sequence.
399 -- Mnemonic: a triangle with the single element at the pointy end.
400 (|>) :: Seq a -> a -> Seq a
401 Seq xs |> x = Seq (xs `snocTree` Elem x)
403 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
404 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
405 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
406 snocTree Empty a = Single a
407 snocTree (Single a) b = deep (One a) Empty (One b)
408 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
409 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
410 snocTree (Deep s pr m (Three a b c)) d =
411 Deep (s + size d) pr m (Four a b c d)
412 snocTree (Deep s pr m (Two a b)) c =
413 Deep (s + size c) pr m (Three a b c)
414 snocTree (Deep s pr m (One a)) b =
415 Deep (s + size b) pr m (Two a b)
417 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
418 (><) :: Seq a -> Seq a -> Seq a
419 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
421 -- The appendTree/addDigits gunk below is machine generated
423 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
424 appendTree0 Empty xs =
426 appendTree0 xs Empty =
428 appendTree0 (Single x) xs =
430 appendTree0 xs (Single x) =
432 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
433 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
435 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
436 addDigits0 m1 (One a) (One b) m2 =
437 appendTree1 m1 (node2 a b) m2
438 addDigits0 m1 (One a) (Two b c) m2 =
439 appendTree1 m1 (node3 a b c) m2
440 addDigits0 m1 (One a) (Three b c d) m2 =
441 appendTree2 m1 (node2 a b) (node2 c d) m2
442 addDigits0 m1 (One a) (Four b c d e) m2 =
443 appendTree2 m1 (node3 a b c) (node2 d e) m2
444 addDigits0 m1 (Two a b) (One c) m2 =
445 appendTree1 m1 (node3 a b c) m2
446 addDigits0 m1 (Two a b) (Two c d) m2 =
447 appendTree2 m1 (node2 a b) (node2 c d) m2
448 addDigits0 m1 (Two a b) (Three c d e) m2 =
449 appendTree2 m1 (node3 a b c) (node2 d e) m2
450 addDigits0 m1 (Two a b) (Four c d e f) m2 =
451 appendTree2 m1 (node3 a b c) (node3 d e f) m2
452 addDigits0 m1 (Three a b c) (One d) m2 =
453 appendTree2 m1 (node2 a b) (node2 c d) m2
454 addDigits0 m1 (Three a b c) (Two d e) m2 =
455 appendTree2 m1 (node3 a b c) (node2 d e) m2
456 addDigits0 m1 (Three a b c) (Three d e f) m2 =
457 appendTree2 m1 (node3 a b c) (node3 d e f) m2
458 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
459 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
460 addDigits0 m1 (Four a b c d) (One e) m2 =
461 appendTree2 m1 (node3 a b c) (node2 d e) m2
462 addDigits0 m1 (Four a b c d) (Two e f) m2 =
463 appendTree2 m1 (node3 a b c) (node3 d e f) m2
464 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
465 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
466 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
467 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
469 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
470 appendTree1 Empty a xs =
472 appendTree1 xs a Empty =
474 appendTree1 (Single x) a xs =
475 x `consTree` a `consTree` xs
476 appendTree1 xs a (Single x) =
477 xs `snocTree` a `snocTree` x
478 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
479 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
481 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
482 addDigits1 m1 (One a) b (One c) m2 =
483 appendTree1 m1 (node3 a b c) m2
484 addDigits1 m1 (One a) b (Two c d) m2 =
485 appendTree2 m1 (node2 a b) (node2 c d) m2
486 addDigits1 m1 (One a) b (Three c d e) m2 =
487 appendTree2 m1 (node3 a b c) (node2 d e) m2
488 addDigits1 m1 (One a) b (Four c d e f) m2 =
489 appendTree2 m1 (node3 a b c) (node3 d e f) m2
490 addDigits1 m1 (Two a b) c (One d) m2 =
491 appendTree2 m1 (node2 a b) (node2 c d) m2
492 addDigits1 m1 (Two a b) c (Two d e) m2 =
493 appendTree2 m1 (node3 a b c) (node2 d e) m2
494 addDigits1 m1 (Two a b) c (Three d e f) m2 =
495 appendTree2 m1 (node3 a b c) (node3 d e f) m2
496 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
497 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
498 addDigits1 m1 (Three a b c) d (One e) m2 =
499 appendTree2 m1 (node3 a b c) (node2 d e) m2
500 addDigits1 m1 (Three a b c) d (Two e f) m2 =
501 appendTree2 m1 (node3 a b c) (node3 d e f) m2
502 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
503 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
504 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
505 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
506 addDigits1 m1 (Four a b c d) e (One f) m2 =
507 appendTree2 m1 (node3 a b c) (node3 d e f) m2
508 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
509 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
510 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
511 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
512 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
513 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
515 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
516 appendTree2 Empty a b xs =
517 a `consTree` b `consTree` xs
518 appendTree2 xs a b Empty =
519 xs `snocTree` a `snocTree` b
520 appendTree2 (Single x) a b xs =
521 x `consTree` a `consTree` b `consTree` xs
522 appendTree2 xs a b (Single x) =
523 xs `snocTree` a `snocTree` b `snocTree` x
524 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
525 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
527 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
528 addDigits2 m1 (One a) b c (One d) m2 =
529 appendTree2 m1 (node2 a b) (node2 c d) m2
530 addDigits2 m1 (One a) b c (Two d e) m2 =
531 appendTree2 m1 (node3 a b c) (node2 d e) m2
532 addDigits2 m1 (One a) b c (Three d e f) m2 =
533 appendTree2 m1 (node3 a b c) (node3 d e f) m2
534 addDigits2 m1 (One a) b c (Four d e f g) m2 =
535 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
536 addDigits2 m1 (Two a b) c d (One e) m2 =
537 appendTree2 m1 (node3 a b c) (node2 d e) m2
538 addDigits2 m1 (Two a b) c d (Two e f) m2 =
539 appendTree2 m1 (node3 a b c) (node3 d e f) m2
540 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
541 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
542 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
543 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
544 addDigits2 m1 (Three a b c) d e (One f) m2 =
545 appendTree2 m1 (node3 a b c) (node3 d e f) m2
546 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
547 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
548 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
549 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
550 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
551 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
552 addDigits2 m1 (Four a b c d) e f (One g) m2 =
553 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
554 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
555 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
556 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
557 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
558 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
559 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
561 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
562 appendTree3 Empty a b c xs =
563 a `consTree` b `consTree` c `consTree` xs
564 appendTree3 xs a b c Empty =
565 xs `snocTree` a `snocTree` b `snocTree` c
566 appendTree3 (Single x) a b c xs =
567 x `consTree` a `consTree` b `consTree` c `consTree` xs
568 appendTree3 xs a b c (Single x) =
569 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
570 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
571 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
573 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))
574 addDigits3 m1 (One a) b c d (One e) m2 =
575 appendTree2 m1 (node3 a b c) (node2 d e) m2
576 addDigits3 m1 (One a) b c d (Two e f) m2 =
577 appendTree2 m1 (node3 a b c) (node3 d e f) m2
578 addDigits3 m1 (One a) b c d (Three e f g) m2 =
579 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
580 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
581 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
582 addDigits3 m1 (Two a b) c d e (One f) m2 =
583 appendTree2 m1 (node3 a b c) (node3 d e f) m2
584 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
585 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
586 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
587 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
588 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
589 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
590 addDigits3 m1 (Three a b c) d e f (One g) m2 =
591 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
592 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
593 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
594 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
595 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
596 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
597 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
598 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
599 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
600 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
601 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
602 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
603 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
604 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
605 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
607 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
608 appendTree4 Empty a b c d xs =
609 a `consTree` b `consTree` c `consTree` d `consTree` xs
610 appendTree4 xs a b c d Empty =
611 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
612 appendTree4 (Single x) a b c d xs =
613 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
614 appendTree4 xs a b c d (Single x) =
615 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
616 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
617 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
619 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))
620 addDigits4 m1 (One a) b c d e (One f) m2 =
621 appendTree2 m1 (node3 a b c) (node3 d e f) m2
622 addDigits4 m1 (One a) b c d e (Two f g) m2 =
623 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
624 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
625 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
626 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
627 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
628 addDigits4 m1 (Two a b) c d e f (One g) m2 =
629 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
630 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
631 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
632 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
633 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
634 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
635 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
636 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
637 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
638 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
639 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
640 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
641 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
642 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
643 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
644 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
645 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
646 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
647 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
648 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
649 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
650 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
651 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
653 ------------------------------------------------------------------------
655 ------------------------------------------------------------------------
657 -- | /O(1)/. Is this the empty sequence?
658 null :: Seq a -> Bool
659 null (Seq Empty) = True
662 -- | /O(1)/. The number of elements in the sequence.
663 length :: Seq a -> Int
664 length (Seq xs) = size xs
668 data Maybe2 a b = Nothing2 | Just2 a b
670 -- | View of the left end of a sequence.
672 = EmptyL -- ^ empty sequence
673 | a :< Seq a -- ^ leftmost element and the rest of the sequence
675 # if __GLASGOW_HASKELL__
676 deriving (Eq, Ord, Show, Read, Data)
678 deriving (Eq, Ord, Show, Read)
681 instance Eq a => Eq (ViewL a)
682 instance Ord a => Ord (ViewL a)
683 instance Show a => Show (ViewL a)
684 instance Read a => Read (ViewL a)
685 instance Data a => Data (ViewL a)
688 INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL")
690 instance Functor ViewL where
693 instance Foldable ViewL where
695 foldr f z (x :< xs) = f x (foldr f z xs)
698 foldl f z (x :< xs) = foldl f (f z x) xs
700 foldl1 f EmptyL = error "foldl1: empty view"
701 foldl1 f (x :< xs) = foldl f x xs
703 instance Traversable ViewL where
704 traverse _ EmptyL = pure EmptyL
705 traverse f (x :< xs) = (:<) <$> f x <*> traverse f xs
707 -- | /O(1)/. Analyse the left end of a sequence.
708 viewl :: Seq a -> ViewL a
709 viewl (Seq xs) = case viewLTree xs of
711 Just2 (Elem x) xs' -> x :< Seq xs'
713 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
714 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
715 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
716 viewLTree Empty = Nothing2
717 viewLTree (Single a) = Just2 a Empty
718 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
719 Nothing2 -> digitToTree sf
720 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
721 viewLTree (Deep s (Two a b) m sf) =
722 Just2 a (Deep (s - size a) (One b) m sf)
723 viewLTree (Deep s (Three a b c) m sf) =
724 Just2 a (Deep (s - size a) (Two b c) m sf)
725 viewLTree (Deep s (Four a b c d) m sf) =
726 Just2 a (Deep (s - size a) (Three b c d) m sf)
728 -- | View of the right end of a sequence.
730 = EmptyR -- ^ empty sequence
731 | Seq a :> a -- ^ the sequence minus the rightmost element,
732 -- and the rightmost element
734 # if __GLASGOW_HASKELL__
735 deriving (Eq, Ord, Show, Read, Data)
737 deriving (Eq, Ord, Show, Read)
740 instance Eq a => Eq (ViewR a)
741 instance Ord a => Ord (ViewR a)
742 instance Show a => Show (ViewR a)
743 instance Read a => Read (ViewR a)
744 instance Data a => Data (ViewR a)
747 INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR")
749 instance Functor ViewR where
752 instance Foldable ViewR where
754 foldr f z (xs :> x) = foldr f (f x z) xs
757 foldl f z (xs :> x) = f (foldl f z xs) x
759 foldr1 f EmptyR = error "foldr1: empty view"
760 foldr1 f (xs :> x) = foldr f x xs
762 instance Traversable ViewR where
763 traverse _ EmptyR = pure EmptyR
764 traverse f (xs :> x) = (:>) <$> traverse f xs <*> f x
766 -- | /O(1)/. Analyse the right end of a sequence.
767 viewr :: Seq a -> ViewR a
768 viewr (Seq xs) = case viewRTree xs of
770 Just2 xs' (Elem x) -> Seq xs' :> x
772 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
773 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
774 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
775 viewRTree Empty = Nothing2
776 viewRTree (Single z) = Just2 Empty z
777 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
778 Nothing2 -> digitToTree pr
779 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
780 viewRTree (Deep s pr m (Two y z)) =
781 Just2 (Deep (s - size z) pr m (One y)) z
782 viewRTree (Deep s pr m (Three x y z)) =
783 Just2 (Deep (s - size z) pr m (Two x y)) z
784 viewRTree (Deep s pr m (Four w x y z)) =
785 Just2 (Deep (s - size z) pr m (Three w x y)) z
789 -- | /O(log(min(i,n-i)))/. The element at the specified position
790 index :: Seq a -> Int -> a
792 | 0 <= i && i < size xs = case lookupTree i xs of
793 Place _ (Elem x) -> x
794 | otherwise = error "index out of bounds"
796 data Place a = Place {-# UNPACK #-} !Int a
801 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
802 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
803 lookupTree :: Sized a => Int -> FingerTree a -> Place a
804 lookupTree _ Empty = error "lookupTree of empty tree"
805 lookupTree i (Single x) = Place i x
806 lookupTree i (Deep _ pr m sf)
807 | i < spr = lookupDigit i pr
808 | i < spm = case lookupTree (i - spr) m of
809 Place i' xs -> lookupNode i' xs
810 | otherwise = lookupDigit (i - spm) sf
814 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
815 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
816 lookupNode :: Sized a => Int -> Node a -> Place a
817 lookupNode i (Node2 _ a b)
819 | otherwise = Place (i - sa) b
821 lookupNode i (Node3 _ a b c)
823 | i < sab = Place (i - sa) b
824 | otherwise = Place (i - sab) c
828 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
829 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
830 lookupDigit :: Sized a => Int -> Digit a -> Place a
831 lookupDigit i (One a) = Place i a
832 lookupDigit i (Two a b)
834 | otherwise = Place (i - sa) b
836 lookupDigit i (Three a b c)
838 | i < sab = Place (i - sa) b
839 | otherwise = Place (i - sab) c
842 lookupDigit i (Four a b c d)
844 | i < sab = Place (i - sa) b
845 | i < sabc = Place (i - sab) c
846 | otherwise = Place (i - sabc) d
851 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
852 update :: Int -> a -> Seq a -> Seq a
853 update i x = adjust (const x) i
855 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
856 adjust :: (a -> a) -> Int -> Seq a -> Seq a
858 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) i xs)
861 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
862 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
863 adjustTree :: Sized a => (Int -> a -> a) ->
864 Int -> FingerTree a -> FingerTree a
865 adjustTree _ _ Empty = error "adjustTree of empty tree"
866 adjustTree f i (Single x) = Single (f i x)
867 adjustTree f i (Deep s pr m sf)
868 | i < spr = Deep s (adjustDigit f i pr) m sf
869 | i < spm = Deep s pr (adjustTree (adjustNode f) (i - spr) m) sf
870 | otherwise = Deep s pr m (adjustDigit f (i - spm) sf)
874 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
875 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
876 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
877 adjustNode f i (Node2 s a b)
878 | i < sa = Node2 s (f i a) b
879 | otherwise = Node2 s a (f (i - sa) b)
881 adjustNode f i (Node3 s a b c)
882 | i < sa = Node3 s (f i a) b c
883 | i < sab = Node3 s a (f (i - sa) b) c
884 | otherwise = Node3 s a b (f (i - sab) c)
888 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
889 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
890 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
891 adjustDigit f i (One a) = One (f i a)
892 adjustDigit f i (Two a b)
893 | i < sa = Two (f i a) b
894 | otherwise = Two a (f (i - sa) b)
896 adjustDigit f i (Three a b c)
897 | i < sa = Three (f i a) b c
898 | i < sab = Three a (f (i - sa) b) c
899 | otherwise = Three a b (f (i - sab) c)
902 adjustDigit f i (Four a b c d)
903 | i < sa = Four (f i a) b c d
904 | i < sab = Four a (f (i - sa) b) c d
905 | i < sabc = Four a b (f (i - sab) c) d
906 | otherwise = Four a b c (f (i- sabc) d)
913 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
914 take :: Int -> Seq a -> Seq a
915 take i = fst . splitAt i
917 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
918 drop :: Int -> Seq a -> Seq a
919 drop i = snd . splitAt i
921 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
922 splitAt :: Int -> Seq a -> (Seq a, Seq a)
923 splitAt i (Seq xs) = (Seq l, Seq r)
924 where (l, r) = split i xs
926 split :: Int -> FingerTree (Elem a) ->
927 (FingerTree (Elem a), FingerTree (Elem a))
928 split i Empty = i `seq` (Empty, Empty)
930 | size xs > i = (l, consTree x r)
931 | otherwise = (xs, Empty)
932 where Split l x r = splitTree i xs
934 data Split t a = Split t a t
939 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
940 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
941 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
942 splitTree _ Empty = error "splitTree of empty tree"
943 splitTree i (Single x) = i `seq` Split Empty x Empty
944 splitTree i (Deep _ pr m sf)
945 | i < spr = case splitDigit i pr of
946 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
947 | i < spm = case splitTree im m of
948 Split ml xs mr -> case splitNode (im - size ml) xs of
949 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
950 | otherwise = case splitDigit (i - spm) sf of
951 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
956 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
957 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
958 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
959 deepL Nothing m sf = case viewLTree m of
960 Nothing2 -> digitToTree sf
961 Just2 a m' -> deep (nodeToDigit a) m' sf
962 deepL (Just pr) m sf = deep pr m sf
964 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
965 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
966 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
967 deepR pr m Nothing = case viewRTree m of
968 Nothing2 -> digitToTree pr
969 Just2 m' a -> deep pr m' (nodeToDigit a)
970 deepR pr m (Just sf) = deep pr m sf
972 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
973 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
974 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
975 splitNode i (Node2 _ a b)
976 | i < sa = Split Nothing a (Just (One b))
977 | otherwise = Split (Just (One a)) b Nothing
979 splitNode i (Node3 _ a b c)
980 | i < sa = Split Nothing a (Just (Two b c))
981 | i < sab = Split (Just (One a)) b (Just (One c))
982 | otherwise = Split (Just (Two a b)) c Nothing
986 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
987 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
988 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
989 splitDigit i (One a) = i `seq` Split Nothing a Nothing
990 splitDigit i (Two a b)
991 | i < sa = Split Nothing a (Just (One b))
992 | otherwise = Split (Just (One a)) b Nothing
994 splitDigit i (Three a b c)
995 | i < sa = Split Nothing a (Just (Two b c))
996 | i < sab = Split (Just (One a)) b (Just (One c))
997 | otherwise = Split (Just (Two a b)) c Nothing
1000 splitDigit i (Four a b c d)
1001 | i < sa = Split Nothing a (Just (Three b c d))
1002 | i < sab = Split (Just (One a)) b (Just (Two c d))
1003 | i < sabc = Split (Just (Two a b)) c (Just (One d))
1004 | otherwise = Split (Just (Three a b c)) d Nothing
1009 ------------------------------------------------------------------------
1011 ------------------------------------------------------------------------
1013 -- | /O(n)/. Create a sequence from a finite list of elements.
1014 -- There is a function 'toList' in the opposite direction for all
1015 -- instances of the 'Foldable' class, including 'Seq'.
1016 fromList :: [a] -> Seq a
1017 fromList = Data.List.foldl' (|>) empty
1019 ------------------------------------------------------------------------
1021 ------------------------------------------------------------------------
1023 -- | /O(n)/. The reverse of a sequence.
1024 reverse :: Seq a -> Seq a
1025 reverse (Seq xs) = Seq (reverseTree id xs)
1027 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1028 reverseTree _ Empty = Empty
1029 reverseTree f (Single x) = Single (f x)
1030 reverseTree f (Deep s pr m sf) =
1031 Deep s (reverseDigit f sf)
1032 (reverseTree (reverseNode f) m)
1035 reverseDigit :: (a -> a) -> Digit a -> Digit a
1036 reverseDigit f (One a) = One (f a)
1037 reverseDigit f (Two a b) = Two (f b) (f a)
1038 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1039 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1041 reverseNode :: (a -> a) -> Node a -> Node a
1042 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1043 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1047 ------------------------------------------------------------------------
1049 ------------------------------------------------------------------------
1051 instance Arbitrary a => Arbitrary (Seq a) where
1052 arbitrary = liftM Seq arbitrary
1053 coarbitrary (Seq x) = coarbitrary x
1055 instance Arbitrary a => Arbitrary (Elem a) where
1056 arbitrary = liftM Elem arbitrary
1057 coarbitrary (Elem x) = coarbitrary x
1059 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1060 arbitrary = sized arb
1061 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1062 arb 0 = return Empty
1063 arb 1 = liftM Single arbitrary
1064 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1066 coarbitrary Empty = variant 0
1067 coarbitrary (Single x) = variant 1 . coarbitrary x
1068 coarbitrary (Deep _ pr m sf) =
1069 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1071 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1073 liftM2 node2 arbitrary arbitrary,
1074 liftM3 node3 arbitrary arbitrary arbitrary]
1076 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1077 coarbitrary (Node3 _ a b c) =
1078 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1080 instance Arbitrary a => Arbitrary (Digit a) where
1082 liftM One arbitrary,
1083 liftM2 Two arbitrary arbitrary,
1084 liftM3 Three arbitrary arbitrary arbitrary,
1085 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1087 coarbitrary (One a) = variant 0 . coarbitrary a
1088 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1089 coarbitrary (Three a b c) =
1090 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1091 coarbitrary (Four a b c d) =
1092 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1094 ------------------------------------------------------------------------
1096 ------------------------------------------------------------------------
1101 instance Valid (Elem a) where
1104 instance Valid (Seq a) where
1105 valid (Seq xs) = valid xs
1107 instance (Sized a, Valid a) => Valid (FingerTree a) where
1109 valid (Single x) = valid x
1110 valid (Deep s pr m sf) =
1111 s == size pr + size m + size sf && valid pr && valid m && valid sf
1113 instance (Sized a, Valid a) => Valid (Node a) where
1114 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1115 valid (Node3 s a b c) =
1116 s == size a + size b + size c && valid a && valid b && valid c
1118 instance Valid a => Valid (Digit a) where
1119 valid (One a) = valid a
1120 valid (Two a b) = valid a && valid b
1121 valid (Three a b c) = valid a && valid b && valid c
1122 valid (Four a b c d) = valid a && valid b && valid c && valid d