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
45 null, -- :: Seq a -> Bool
46 length, -- :: Seq a -> Int
49 viewl, -- :: Seq a -> ViewL a
51 viewr, -- :: Seq a -> ViewR a
53 index, -- :: Seq a -> Int -> a
54 adjust, -- :: (a -> a) -> Int -> Seq a -> Seq a
55 update, -- :: Int -> a -> Seq a -> Seq a
56 take, -- :: Int -> Seq a -> Seq a
57 drop, -- :: Int -> Seq a -> Seq a
58 splitAt, -- :: Int -> Seq a -> (Seq a, Seq a)
60 reverse, -- :: Seq a -> Seq a
66 import Prelude hiding (
67 null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
69 import qualified Data.List (foldl')
70 import Control.Applicative (Applicative(..), (<$>))
71 import Control.Monad (MonadPlus(..))
72 import Data.Monoid (Monoid(..))
74 import Data.Traversable
77 #ifdef __GLASGOW_HASKELL__
78 import Text.Read (Lexeme(Ident), lexP, parens, prec,
79 readPrec, readListPrec, readListPrecDefault)
80 import Data.Generics.Basics (Data(..), Fixity(..),
81 constrIndex, mkConstr, mkDataType)
85 import Control.Monad (liftM, liftM3, liftM4)
86 import Test.QuickCheck
99 -- | General-purpose finite sequences.
100 newtype Seq a = Seq (FingerTree (Elem a))
102 instance Functor Seq where
103 fmap f (Seq xs) = Seq (fmap (fmap f) xs)
105 instance Foldable Seq where
106 foldr f z (Seq xs) = foldr (flip (foldr f)) z xs
107 foldl f z (Seq xs) = foldl (foldl f) z xs
109 foldr1 f (Seq xs) = getElem (foldr1 f' xs)
110 where f' (Elem x) (Elem y) = Elem (f x y)
112 foldl1 f (Seq xs) = getElem (foldl1 f' xs)
113 where f' (Elem x) (Elem y) = Elem (f x y)
115 instance Traversable Seq where
116 traverse f (Seq xs) = Seq <$> traverse (traverse f) xs
118 instance Monad Seq where
120 xs >>= f = foldl' add empty xs
121 where add ys x = ys >< f x
123 instance MonadPlus Seq where
127 instance Eq a => Eq (Seq a) where
128 xs == ys = length xs == length ys && toList xs == toList ys
130 instance Ord a => Ord (Seq a) where
131 compare xs ys = compare (toList xs) (toList ys)
134 instance Show a => Show (Seq a) where
135 showsPrec p (Seq x) = showsPrec p x
137 instance Show a => Show (Seq a) where
138 showsPrec p xs = showParen (p > 10) $
139 showString "fromList " . shows (toList xs)
142 instance Read a => Read (Seq a) where
143 #ifdef __GLASGOW_HASKELL__
144 readPrec = parens $ prec 10 $ do
145 Ident "fromList" <- lexP
149 readListPrec = readListPrecDefault
151 readsPrec p = readParen (p > 10) $ \ r -> do
152 ("fromList",s) <- lex r
154 return (fromList xs,t)
157 instance Monoid (Seq a) where
161 #include "Typeable.h"
162 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
164 #if __GLASGOW_HASKELL__
165 instance Data a => Data (Seq a) where
166 gfoldl f z s = case viewl s of
168 x :< xs -> z (<|) `f` x `f` xs
170 gunfold k z c = case constrIndex c of
176 | null xs = emptyConstr
177 | otherwise = consConstr
179 dataTypeOf _ = seqDataType
181 dataCast1 f = gcast1 f
183 emptyConstr = mkConstr seqDataType "empty" [] Prefix
184 consConstr = mkConstr seqDataType "<|" [] Infix
185 seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
193 | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
198 instance Sized a => Sized (FingerTree a) where
199 {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
200 {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
202 size (Single x) = size x
203 size (Deep v _ _ _) = v
205 instance Foldable FingerTree where
207 foldr f z (Single x) = x `f` z
208 foldr f z (Deep _ pr m sf) =
209 foldr f (foldr (flip (foldr f)) (foldr f z sf) m) pr
212 foldl f z (Single x) = z `f` x
213 foldl f z (Deep _ pr m sf) =
214 foldl f (foldl (foldl f) (foldl f z pr) m) sf
216 foldr1 _ Empty = error "foldr1: empty sequence"
217 foldr1 _ (Single x) = x
218 foldr1 f (Deep _ pr m sf) =
219 foldr f (foldr (flip (foldr f)) (foldr1 f sf) m) pr
221 foldl1 _ Empty = error "foldl1: empty sequence"
222 foldl1 _ (Single x) = x
223 foldl1 f (Deep _ pr m sf) =
224 foldl f (foldl (foldl f) (foldl1 f pr) m) sf
226 instance Functor FingerTree where
228 fmap f (Single x) = Single (f x)
229 fmap f (Deep v pr m sf) =
230 Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
232 instance Traversable FingerTree where
233 traverse _ Empty = pure Empty
234 traverse f (Single x) = Single <$> f x
235 traverse f (Deep v pr m sf) =
236 Deep v <$> traverse f pr <*> traverse (traverse f) m <*>
240 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
241 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
242 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
243 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
256 instance Foldable Digit where
257 foldr f z (One a) = a `f` z
258 foldr f z (Two a b) = a `f` (b `f` z)
259 foldr f z (Three a b c) = a `f` (b `f` (c `f` z))
260 foldr f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
262 foldl f z (One a) = z `f` a
263 foldl f z (Two a b) = (z `f` a) `f` b
264 foldl f z (Three a b c) = ((z `f` a) `f` b) `f` c
265 foldl f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
268 foldr1 f (Two a b) = a `f` b
269 foldr1 f (Three a b c) = a `f` (b `f` c)
270 foldr1 f (Four a b c d) = a `f` (b `f` (c `f` d))
273 foldl1 f (Two a b) = a `f` b
274 foldl1 f (Three a b c) = (a `f` b) `f` c
275 foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d
277 instance Functor Digit where
280 instance Traversable Digit where
281 traverse f (One a) = One <$> f a
282 traverse f (Two a b) = Two <$> f a <*> f b
283 traverse f (Three a b c) = Three <$> f a <*> f b <*> f c
284 traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d
286 instance Sized a => Sized (Digit a) where
287 {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
288 {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
289 size xs = foldl (\ i x -> i + size x) 0 xs
291 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
292 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
293 digitToTree :: Sized a => Digit a -> FingerTree a
294 digitToTree (One a) = Single a
295 digitToTree (Two a b) = deep (One a) Empty (One b)
296 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
297 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
302 = Node2 {-# UNPACK #-} !Int a a
303 | Node3 {-# UNPACK #-} !Int a a a
308 instance Foldable Node where
309 foldr f z (Node2 _ a b) = a `f` (b `f` z)
310 foldr f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
312 foldl f z (Node2 _ a b) = (z `f` a) `f` b
313 foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
315 instance Functor Node where
318 instance Traversable Node where
319 traverse f (Node2 v a b) = Node2 v <$> f a <*> f b
320 traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c
322 instance Sized (Node a) where
323 size (Node2 v _ _) = v
324 size (Node3 v _ _ _) = v
327 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
328 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
329 node2 :: Sized a => a -> a -> Node a
330 node2 a b = Node2 (size a + size b) a b
333 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
334 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
335 node3 :: Sized a => a -> a -> a -> Node a
336 node3 a b c = Node3 (size a + size b + size c) a b c
338 nodeToDigit :: Node a -> Digit a
339 nodeToDigit (Node2 _ a b) = Two a b
340 nodeToDigit (Node3 _ a b c) = Three a b c
344 newtype Elem a = Elem { getElem :: a }
346 instance Sized (Elem a) where
349 instance Functor Elem where
350 fmap f (Elem x) = Elem (f x)
352 instance Foldable Elem where
353 foldr f z (Elem x) = f x z
354 foldl f z (Elem x) = f z x
356 instance Traversable Elem where
357 traverse f (Elem x) = Elem <$> f x
360 instance (Show a) => Show (Elem a) where
361 showsPrec p (Elem x) = showsPrec p x
364 ------------------------------------------------------------------------
366 ------------------------------------------------------------------------
368 -- | /O(1)/. The empty sequence.
372 -- | /O(1)/. A singleton sequence.
373 singleton :: a -> Seq a
374 singleton x = Seq (Single (Elem x))
376 -- | /O(1)/. Add an element to the left end of a sequence.
377 -- Mnemonic: a triangle with the single element at the pointy end.
378 (<|) :: a -> Seq a -> Seq a
379 x <| Seq xs = Seq (Elem x `consTree` xs)
381 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
382 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
383 consTree :: Sized a => a -> FingerTree a -> FingerTree a
384 consTree a Empty = Single a
385 consTree a (Single b) = deep (One a) Empty (One b)
386 consTree a (Deep s (Four b c d e) m sf) = m `seq`
387 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
388 consTree a (Deep s (Three b c d) m sf) =
389 Deep (size a + s) (Four a b c d) m sf
390 consTree a (Deep s (Two b c) m sf) =
391 Deep (size a + s) (Three a b c) m sf
392 consTree a (Deep s (One b) m sf) =
393 Deep (size a + s) (Two a b) m sf
395 -- | /O(1)/. Add an element to the right end of a sequence.
396 -- Mnemonic: a triangle with the single element at the pointy end.
397 (|>) :: Seq a -> a -> Seq a
398 Seq xs |> x = Seq (xs `snocTree` Elem x)
400 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
401 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
402 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
403 snocTree Empty a = Single a
404 snocTree (Single a) b = deep (One a) Empty (One b)
405 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
406 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
407 snocTree (Deep s pr m (Three a b c)) d =
408 Deep (s + size d) pr m (Four a b c d)
409 snocTree (Deep s pr m (Two a b)) c =
410 Deep (s + size c) pr m (Three a b c)
411 snocTree (Deep s pr m (One a)) b =
412 Deep (s + size b) pr m (Two a b)
414 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
415 (><) :: Seq a -> Seq a -> Seq a
416 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
418 -- The appendTree/addDigits gunk below is machine generated
420 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
421 appendTree0 Empty xs =
423 appendTree0 xs Empty =
425 appendTree0 (Single x) xs =
427 appendTree0 xs (Single x) =
429 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
430 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
432 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
433 addDigits0 m1 (One a) (One b) m2 =
434 appendTree1 m1 (node2 a b) m2
435 addDigits0 m1 (One a) (Two b c) m2 =
436 appendTree1 m1 (node3 a b c) m2
437 addDigits0 m1 (One a) (Three b c d) m2 =
438 appendTree2 m1 (node2 a b) (node2 c d) m2
439 addDigits0 m1 (One a) (Four b c d e) m2 =
440 appendTree2 m1 (node3 a b c) (node2 d e) m2
441 addDigits0 m1 (Two a b) (One c) m2 =
442 appendTree1 m1 (node3 a b c) m2
443 addDigits0 m1 (Two a b) (Two c d) m2 =
444 appendTree2 m1 (node2 a b) (node2 c d) m2
445 addDigits0 m1 (Two a b) (Three c d e) m2 =
446 appendTree2 m1 (node3 a b c) (node2 d e) m2
447 addDigits0 m1 (Two a b) (Four c d e f) m2 =
448 appendTree2 m1 (node3 a b c) (node3 d e f) m2
449 addDigits0 m1 (Three a b c) (One d) m2 =
450 appendTree2 m1 (node2 a b) (node2 c d) m2
451 addDigits0 m1 (Three a b c) (Two d e) m2 =
452 appendTree2 m1 (node3 a b c) (node2 d e) m2
453 addDigits0 m1 (Three a b c) (Three d e f) m2 =
454 appendTree2 m1 (node3 a b c) (node3 d e f) m2
455 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
456 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
457 addDigits0 m1 (Four a b c d) (One e) m2 =
458 appendTree2 m1 (node3 a b c) (node2 d e) m2
459 addDigits0 m1 (Four a b c d) (Two e f) m2 =
460 appendTree2 m1 (node3 a b c) (node3 d e f) m2
461 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
462 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
463 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
464 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
466 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
467 appendTree1 Empty a xs =
469 appendTree1 xs a Empty =
471 appendTree1 (Single x) a xs =
472 x `consTree` a `consTree` xs
473 appendTree1 xs a (Single x) =
474 xs `snocTree` a `snocTree` x
475 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
476 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
478 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
479 addDigits1 m1 (One a) b (One c) m2 =
480 appendTree1 m1 (node3 a b c) m2
481 addDigits1 m1 (One a) b (Two c d) m2 =
482 appendTree2 m1 (node2 a b) (node2 c d) m2
483 addDigits1 m1 (One a) b (Three c d e) m2 =
484 appendTree2 m1 (node3 a b c) (node2 d e) m2
485 addDigits1 m1 (One a) b (Four c d e f) m2 =
486 appendTree2 m1 (node3 a b c) (node3 d e f) m2
487 addDigits1 m1 (Two a b) c (One d) m2 =
488 appendTree2 m1 (node2 a b) (node2 c d) m2
489 addDigits1 m1 (Two a b) c (Two d e) m2 =
490 appendTree2 m1 (node3 a b c) (node2 d e) m2
491 addDigits1 m1 (Two a b) c (Three d e f) m2 =
492 appendTree2 m1 (node3 a b c) (node3 d e f) m2
493 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
494 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
495 addDigits1 m1 (Three a b c) d (One e) m2 =
496 appendTree2 m1 (node3 a b c) (node2 d e) m2
497 addDigits1 m1 (Three a b c) d (Two e f) m2 =
498 appendTree2 m1 (node3 a b c) (node3 d e f) m2
499 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
500 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
501 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
502 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
503 addDigits1 m1 (Four a b c d) e (One f) m2 =
504 appendTree2 m1 (node3 a b c) (node3 d e f) m2
505 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
506 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
507 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
508 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
509 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
510 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
512 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
513 appendTree2 Empty a b xs =
514 a `consTree` b `consTree` xs
515 appendTree2 xs a b Empty =
516 xs `snocTree` a `snocTree` b
517 appendTree2 (Single x) a b xs =
518 x `consTree` a `consTree` b `consTree` xs
519 appendTree2 xs a b (Single x) =
520 xs `snocTree` a `snocTree` b `snocTree` x
521 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
522 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
524 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
525 addDigits2 m1 (One a) b c (One d) m2 =
526 appendTree2 m1 (node2 a b) (node2 c d) m2
527 addDigits2 m1 (One a) b c (Two d e) m2 =
528 appendTree2 m1 (node3 a b c) (node2 d e) m2
529 addDigits2 m1 (One a) b c (Three d e f) m2 =
530 appendTree2 m1 (node3 a b c) (node3 d e f) m2
531 addDigits2 m1 (One a) b c (Four d e f g) m2 =
532 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
533 addDigits2 m1 (Two a b) c d (One e) m2 =
534 appendTree2 m1 (node3 a b c) (node2 d e) m2
535 addDigits2 m1 (Two a b) c d (Two e f) m2 =
536 appendTree2 m1 (node3 a b c) (node3 d e f) m2
537 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
538 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
539 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
540 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
541 addDigits2 m1 (Three a b c) d e (One f) m2 =
542 appendTree2 m1 (node3 a b c) (node3 d e f) m2
543 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
544 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
545 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
546 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
547 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
548 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
549 addDigits2 m1 (Four a b c d) e f (One g) m2 =
550 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
551 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
552 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
553 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
554 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
555 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
556 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
558 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
559 appendTree3 Empty a b c xs =
560 a `consTree` b `consTree` c `consTree` xs
561 appendTree3 xs a b c Empty =
562 xs `snocTree` a `snocTree` b `snocTree` c
563 appendTree3 (Single x) a b c xs =
564 x `consTree` a `consTree` b `consTree` c `consTree` xs
565 appendTree3 xs a b c (Single x) =
566 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
567 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
568 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
570 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))
571 addDigits3 m1 (One a) b c d (One e) m2 =
572 appendTree2 m1 (node3 a b c) (node2 d e) m2
573 addDigits3 m1 (One a) b c d (Two e f) m2 =
574 appendTree2 m1 (node3 a b c) (node3 d e f) m2
575 addDigits3 m1 (One a) b c d (Three e f g) m2 =
576 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
577 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
578 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
579 addDigits3 m1 (Two a b) c d e (One f) m2 =
580 appendTree2 m1 (node3 a b c) (node3 d e f) m2
581 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
582 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
583 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
584 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
585 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
586 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
587 addDigits3 m1 (Three a b c) d e f (One g) m2 =
588 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
589 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
590 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
591 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
592 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
593 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
594 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
595 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
596 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
597 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
598 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
599 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
600 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
601 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
602 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
604 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
605 appendTree4 Empty a b c d xs =
606 a `consTree` b `consTree` c `consTree` d `consTree` xs
607 appendTree4 xs a b c d Empty =
608 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
609 appendTree4 (Single x) a b c d xs =
610 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
611 appendTree4 xs a b c d (Single x) =
612 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
613 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
614 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
616 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))
617 addDigits4 m1 (One a) b c d e (One f) m2 =
618 appendTree2 m1 (node3 a b c) (node3 d e f) m2
619 addDigits4 m1 (One a) b c d e (Two f g) m2 =
620 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
621 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
622 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
623 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
624 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
625 addDigits4 m1 (Two a b) c d e f (One g) m2 =
626 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
627 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
628 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
629 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
630 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
631 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
632 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
633 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
634 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
635 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
636 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
637 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
638 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
639 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
640 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
641 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
642 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
643 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
644 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
645 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
646 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
647 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
648 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
650 ------------------------------------------------------------------------
652 ------------------------------------------------------------------------
654 -- | /O(1)/. Is this the empty sequence?
655 null :: Seq a -> Bool
656 null (Seq Empty) = True
659 -- | /O(1)/. The number of elements in the sequence.
660 length :: Seq a -> Int
661 length (Seq xs) = size xs
665 data Maybe2 a b = Nothing2 | Just2 a b
667 -- | View of the left end of a sequence.
669 = EmptyL -- ^ empty sequence
670 | a :< Seq a -- ^ leftmost element and the rest of the sequence
672 # if __GLASGOW_HASKELL__
673 deriving (Eq, Ord, Show, Read, Data)
675 deriving (Eq, Ord, Show, Read)
678 instance Eq a => Eq (ViewL a)
679 instance Ord a => Ord (ViewL a)
680 instance Show a => Show (ViewL a)
681 instance Read a => Read (ViewL a)
682 instance Data a => Data (ViewL a)
685 INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL")
687 instance Functor ViewL where
690 instance Foldable ViewL where
692 foldr f z (x :< xs) = f x (foldr f z xs)
695 foldl f z (x :< xs) = foldl f (f z x) xs
697 foldl1 f EmptyL = error "foldl1: empty view"
698 foldl1 f (x :< xs) = foldl f x xs
700 instance Traversable ViewL where
701 traverse _ EmptyL = pure EmptyL
702 traverse f (x :< xs) = (:<) <$> f x <*> traverse f xs
704 -- | /O(1)/. Analyse the left end of a sequence.
705 viewl :: Seq a -> ViewL a
706 viewl (Seq xs) = case viewLTree xs of
708 Just2 (Elem x) xs' -> x :< Seq xs'
710 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
711 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
712 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
713 viewLTree Empty = Nothing2
714 viewLTree (Single a) = Just2 a Empty
715 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
716 Nothing2 -> digitToTree sf
717 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
718 viewLTree (Deep s (Two a b) m sf) =
719 Just2 a (Deep (s - size a) (One b) m sf)
720 viewLTree (Deep s (Three a b c) m sf) =
721 Just2 a (Deep (s - size a) (Two b c) m sf)
722 viewLTree (Deep s (Four a b c d) m sf) =
723 Just2 a (Deep (s - size a) (Three b c d) m sf)
725 -- | View of the right end of a sequence.
727 = EmptyR -- ^ empty sequence
728 | Seq a :> a -- ^ the sequence minus the rightmost element,
729 -- and the rightmost element
731 # if __GLASGOW_HASKELL__
732 deriving (Eq, Ord, Show, Read, Data)
734 deriving (Eq, Ord, Show, Read)
737 instance Eq a => Eq (ViewR a)
738 instance Ord a => Ord (ViewR a)
739 instance Show a => Show (ViewR a)
740 instance Read a => Read (ViewR a)
741 instance Data a => Data (ViewR a)
744 INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR")
746 instance Functor ViewR where
749 instance Foldable ViewR where
751 foldr f z (xs :> x) = foldr f (f x z) xs
754 foldl f z (xs :> x) = f (foldl f z xs) x
756 foldr1 f EmptyR = error "foldr1: empty view"
757 foldr1 f (xs :> x) = foldr f x xs
759 instance Traversable ViewR where
760 traverse _ EmptyR = pure EmptyR
761 traverse f (xs :> x) = (:>) <$> traverse f xs <*> f x
763 -- | /O(1)/. Analyse the right end of a sequence.
764 viewr :: Seq a -> ViewR a
765 viewr (Seq xs) = case viewRTree xs of
767 Just2 xs' (Elem x) -> Seq xs' :> x
769 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
770 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
771 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
772 viewRTree Empty = Nothing2
773 viewRTree (Single z) = Just2 Empty z
774 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
775 Nothing2 -> digitToTree pr
776 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
777 viewRTree (Deep s pr m (Two y z)) =
778 Just2 (Deep (s - size z) pr m (One y)) z
779 viewRTree (Deep s pr m (Three x y z)) =
780 Just2 (Deep (s - size z) pr m (Two x y)) z
781 viewRTree (Deep s pr m (Four w x y z)) =
782 Just2 (Deep (s - size z) pr m (Three w x y)) z
786 -- | /O(log(min(i,n-i)))/. The element at the specified position
787 index :: Seq a -> Int -> a
789 | 0 <= i && i < size xs = case lookupTree i xs of
790 Place _ (Elem x) -> x
791 | otherwise = error "index out of bounds"
793 data Place a = Place {-# UNPACK #-} !Int a
798 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
799 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
800 lookupTree :: Sized a => Int -> FingerTree a -> Place a
801 lookupTree _ Empty = error "lookupTree of empty tree"
802 lookupTree i (Single x) = Place i x
803 lookupTree i (Deep _ pr m sf)
804 | i < spr = lookupDigit i pr
805 | i < spm = case lookupTree (i - spr) m of
806 Place i' xs -> lookupNode i' xs
807 | otherwise = lookupDigit (i - spm) sf
811 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
812 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
813 lookupNode :: Sized a => Int -> Node a -> Place a
814 lookupNode i (Node2 _ a b)
816 | otherwise = Place (i - sa) b
818 lookupNode i (Node3 _ a b c)
820 | i < sab = Place (i - sa) b
821 | otherwise = Place (i - sab) c
825 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
826 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
827 lookupDigit :: Sized a => Int -> Digit a -> Place a
828 lookupDigit i (One a) = Place i a
829 lookupDigit i (Two a b)
831 | otherwise = Place (i - sa) b
833 lookupDigit i (Three a b c)
835 | i < sab = Place (i - sa) b
836 | otherwise = Place (i - sab) c
839 lookupDigit i (Four a b c d)
841 | i < sab = Place (i - sa) b
842 | i < sabc = Place (i - sab) c
843 | otherwise = Place (i - sabc) d
848 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
849 update :: Int -> a -> Seq a -> Seq a
850 update i x = adjust (const x) i
852 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
853 adjust :: (a -> a) -> Int -> Seq a -> Seq a
855 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) i xs)
858 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
859 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
860 adjustTree :: Sized a => (Int -> a -> a) ->
861 Int -> FingerTree a -> FingerTree a
862 adjustTree _ _ Empty = error "adjustTree of empty tree"
863 adjustTree f i (Single x) = Single (f i x)
864 adjustTree f i (Deep s pr m sf)
865 | i < spr = Deep s (adjustDigit f i pr) m sf
866 | i < spm = Deep s pr (adjustTree (adjustNode f) (i - spr) m) sf
867 | otherwise = Deep s pr m (adjustDigit f (i - spm) sf)
871 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
872 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
873 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
874 adjustNode f i (Node2 s a b)
875 | i < sa = Node2 s (f i a) b
876 | otherwise = Node2 s a (f (i - sa) b)
878 adjustNode f i (Node3 s a b c)
879 | i < sa = Node3 s (f i a) b c
880 | i < sab = Node3 s a (f (i - sa) b) c
881 | otherwise = Node3 s a b (f (i - sab) c)
885 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
886 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
887 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
888 adjustDigit f i (One a) = One (f i a)
889 adjustDigit f i (Two a b)
890 | i < sa = Two (f i a) b
891 | otherwise = Two a (f (i - sa) b)
893 adjustDigit f i (Three a b c)
894 | i < sa = Three (f i a) b c
895 | i < sab = Three a (f (i - sa) b) c
896 | otherwise = Three a b (f (i - sab) c)
899 adjustDigit f i (Four a b c d)
900 | i < sa = Four (f i a) b c d
901 | i < sab = Four a (f (i - sa) b) c d
902 | i < sabc = Four a b (f (i - sab) c) d
903 | otherwise = Four a b c (f (i- sabc) d)
910 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
911 take :: Int -> Seq a -> Seq a
912 take i = fst . splitAt i
914 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
915 drop :: Int -> Seq a -> Seq a
916 drop i = snd . splitAt i
918 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
919 splitAt :: Int -> Seq a -> (Seq a, Seq a)
920 splitAt i (Seq xs) = (Seq l, Seq r)
921 where (l, r) = split i xs
923 split :: Int -> FingerTree (Elem a) ->
924 (FingerTree (Elem a), FingerTree (Elem a))
925 split i Empty = i `seq` (Empty, Empty)
927 | size xs > i = (l, consTree x r)
928 | otherwise = (xs, Empty)
929 where Split l x r = splitTree i xs
931 data Split t a = Split t a t
936 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
937 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
938 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
939 splitTree _ Empty = error "splitTree of empty tree"
940 splitTree i (Single x) = i `seq` Split Empty x Empty
941 splitTree i (Deep _ pr m sf)
942 | i < spr = case splitDigit i pr of
943 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
944 | i < spm = case splitTree im m of
945 Split ml xs mr -> case splitNode (im - size ml) xs of
946 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
947 | otherwise = case splitDigit (i - spm) sf of
948 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
953 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
954 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
955 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
956 deepL Nothing m sf = case viewLTree m of
957 Nothing2 -> digitToTree sf
958 Just2 a m' -> deep (nodeToDigit a) m' sf
959 deepL (Just pr) m sf = deep pr m sf
961 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
962 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
963 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
964 deepR pr m Nothing = case viewRTree m of
965 Nothing2 -> digitToTree pr
966 Just2 m' a -> deep pr m' (nodeToDigit a)
967 deepR pr m (Just sf) = deep pr m sf
969 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
970 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
971 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
972 splitNode i (Node2 _ a b)
973 | i < sa = Split Nothing a (Just (One b))
974 | otherwise = Split (Just (One a)) b Nothing
976 splitNode i (Node3 _ a b c)
977 | i < sa = Split Nothing a (Just (Two b c))
978 | i < sab = Split (Just (One a)) b (Just (One c))
979 | otherwise = Split (Just (Two a b)) c Nothing
983 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
984 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
985 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
986 splitDigit i (One a) = i `seq` Split Nothing a Nothing
987 splitDigit i (Two a b)
988 | i < sa = Split Nothing a (Just (One b))
989 | otherwise = Split (Just (One a)) b Nothing
991 splitDigit i (Three a b c)
992 | i < sa = Split Nothing a (Just (Two b c))
993 | i < sab = Split (Just (One a)) b (Just (One c))
994 | otherwise = Split (Just (Two a b)) c Nothing
997 splitDigit i (Four a b c d)
998 | i < sa = Split Nothing a (Just (Three b c d))
999 | i < sab = Split (Just (One a)) b (Just (Two c d))
1000 | i < sabc = Split (Just (Two a b)) c (Just (One d))
1001 | otherwise = Split (Just (Three a b c)) d Nothing
1006 ------------------------------------------------------------------------
1008 ------------------------------------------------------------------------
1010 -- | /O(n)/. Create a sequence from a finite list of elements.
1011 fromList :: [a] -> Seq a
1012 fromList = Data.List.foldl' (|>) empty
1014 ------------------------------------------------------------------------
1016 ------------------------------------------------------------------------
1018 -- | /O(n)/. The reverse of a sequence.
1019 reverse :: Seq a -> Seq a
1020 reverse (Seq xs) = Seq (reverseTree id xs)
1022 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1023 reverseTree _ Empty = Empty
1024 reverseTree f (Single x) = Single (f x)
1025 reverseTree f (Deep s pr m sf) =
1026 Deep s (reverseDigit f sf)
1027 (reverseTree (reverseNode f) m)
1030 reverseDigit :: (a -> a) -> Digit a -> Digit a
1031 reverseDigit f (One a) = One (f a)
1032 reverseDigit f (Two a b) = Two (f b) (f a)
1033 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1034 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1036 reverseNode :: (a -> a) -> Node a -> Node a
1037 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1038 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1042 ------------------------------------------------------------------------
1044 ------------------------------------------------------------------------
1046 instance Arbitrary a => Arbitrary (Seq a) where
1047 arbitrary = liftM Seq arbitrary
1048 coarbitrary (Seq x) = coarbitrary x
1050 instance Arbitrary a => Arbitrary (Elem a) where
1051 arbitrary = liftM Elem arbitrary
1052 coarbitrary (Elem x) = coarbitrary x
1054 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1055 arbitrary = sized arb
1056 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1057 arb 0 = return Empty
1058 arb 1 = liftM Single arbitrary
1059 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1061 coarbitrary Empty = variant 0
1062 coarbitrary (Single x) = variant 1 . coarbitrary x
1063 coarbitrary (Deep _ pr m sf) =
1064 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1066 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1068 liftM2 node2 arbitrary arbitrary,
1069 liftM3 node3 arbitrary arbitrary arbitrary]
1071 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1072 coarbitrary (Node3 _ a b c) =
1073 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1075 instance Arbitrary a => Arbitrary (Digit a) where
1077 liftM One arbitrary,
1078 liftM2 Two arbitrary arbitrary,
1079 liftM3 Three arbitrary arbitrary arbitrary,
1080 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1082 coarbitrary (One a) = variant 0 . coarbitrary a
1083 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1084 coarbitrary (Three a b c) =
1085 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1086 coarbitrary (Four a b c d) =
1087 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1089 ------------------------------------------------------------------------
1091 ------------------------------------------------------------------------
1096 instance Valid (Elem a) where
1099 instance Valid (Seq a) where
1100 valid (Seq xs) = valid xs
1102 instance (Sized a, Valid a) => Valid (FingerTree a) where
1104 valid (Single x) = valid x
1105 valid (Deep s pr m sf) =
1106 s == size pr + size m + size sf && valid pr && valid m && valid sf
1108 instance (Sized a, Valid a) => Valid (Node a) where
1109 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1110 valid (Node3 s a b c) =
1111 s == size a + size b + size c && valid a && valid b && valid c
1113 instance Valid a => Valid (Digit a) where
1114 valid (One a) = valid a
1115 valid (Two a b) = valid a && valid b
1116 valid (Three a b c) = valid a && valid b && valid c
1117 valid (Four a b c d) = valid a && valid b && valid c && valid d