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
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
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
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 Traversable FingerTree where
227 traverse _ Empty = pure Empty
228 traverse f (Single x) = Single <$> f x
229 traverse f (Deep v pr m sf) =
230 Deep v <$> traverse f pr <*> traverse (traverse f) m <*>
234 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
235 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
236 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
237 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
250 instance Foldable Digit where
251 foldr f z (One a) = a `f` z
252 foldr f z (Two a b) = a `f` (b `f` z)
253 foldr f z (Three a b c) = a `f` (b `f` (c `f` z))
254 foldr f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
256 foldl f z (One a) = z `f` a
257 foldl f z (Two a b) = (z `f` a) `f` b
258 foldl f z (Three a b c) = ((z `f` a) `f` b) `f` c
259 foldl f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
262 foldr1 f (Two a b) = a `f` b
263 foldr1 f (Three a b c) = a `f` (b `f` c)
264 foldr1 f (Four a b c d) = a `f` (b `f` (c `f` d))
267 foldl1 f (Two a b) = a `f` b
268 foldl1 f (Three a b c) = (a `f` b) `f` c
269 foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d
271 instance Traversable Digit where
272 traverse f (One a) = One <$> f a
273 traverse f (Two a b) = Two <$> f a <*> f b
274 traverse f (Three a b c) = Three <$> f a <*> f b <*> f c
275 traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d
277 instance Sized a => Sized (Digit a) where
278 {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
279 {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
280 size xs = foldl (\ i x -> i + size x) 0 xs
282 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
283 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
284 digitToTree :: Sized a => Digit a -> FingerTree a
285 digitToTree (One a) = Single a
286 digitToTree (Two a b) = deep (One a) Empty (One b)
287 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
288 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
293 = Node2 {-# UNPACK #-} !Int a a
294 | Node3 {-# UNPACK #-} !Int a a a
299 instance Foldable Node where
300 foldr f z (Node2 _ a b) = a `f` (b `f` z)
301 foldr f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
303 foldl f z (Node2 _ a b) = (z `f` a) `f` b
304 foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
306 instance Traversable Node where
307 traverse f (Node2 v a b) = Node2 v <$> f a <*> f b
308 traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c
310 instance Sized (Node a) where
311 size (Node2 v _ _) = v
312 size (Node3 v _ _ _) = v
315 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
316 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
317 node2 :: Sized a => a -> a -> Node a
318 node2 a b = Node2 (size a + size b) a b
321 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
322 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
323 node3 :: Sized a => a -> a -> a -> Node a
324 node3 a b c = Node3 (size a + size b + size c) a b c
326 nodeToDigit :: Node a -> Digit a
327 nodeToDigit (Node2 _ a b) = Two a b
328 nodeToDigit (Node3 _ a b c) = Three a b c
332 newtype Elem a = Elem { getElem :: a }
334 instance Sized (Elem a) where
337 instance Functor Elem where
338 fmap f (Elem x) = Elem (f x)
340 instance Foldable Elem where
341 foldr f z (Elem x) = f x z
342 foldl f z (Elem x) = f z x
344 instance Traversable Elem where
345 traverse f (Elem x) = Elem <$> f x
348 instance (Show a) => Show (Elem a) where
349 showsPrec p (Elem x) = showsPrec p x
352 ------------------------------------------------------------------------
354 ------------------------------------------------------------------------
356 -- | /O(1)/. The empty sequence.
360 -- | /O(1)/. A singleton sequence.
361 singleton :: a -> Seq a
362 singleton x = Seq (Single (Elem x))
364 -- | /O(1)/. Add an element to the left end of a sequence.
365 -- Mnemonic: a triangle with the single element at the pointy end.
366 (<|) :: a -> Seq a -> Seq a
367 x <| Seq xs = Seq (Elem x `consTree` xs)
369 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
370 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
371 consTree :: Sized a => a -> FingerTree a -> FingerTree a
372 consTree a Empty = Single a
373 consTree a (Single b) = deep (One a) Empty (One b)
374 consTree a (Deep s (Four b c d e) m sf) = m `seq`
375 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
376 consTree a (Deep s (Three b c d) m sf) =
377 Deep (size a + s) (Four a b c d) m sf
378 consTree a (Deep s (Two b c) m sf) =
379 Deep (size a + s) (Three a b c) m sf
380 consTree a (Deep s (One b) m sf) =
381 Deep (size a + s) (Two a b) m sf
383 -- | /O(1)/. Add an element to the right end of a sequence.
384 -- Mnemonic: a triangle with the single element at the pointy end.
385 (|>) :: Seq a -> a -> Seq a
386 Seq xs |> x = Seq (xs `snocTree` Elem x)
388 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
389 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
390 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
391 snocTree Empty a = Single a
392 snocTree (Single a) b = deep (One a) Empty (One b)
393 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
394 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
395 snocTree (Deep s pr m (Three a b c)) d =
396 Deep (s + size d) pr m (Four a b c d)
397 snocTree (Deep s pr m (Two a b)) c =
398 Deep (s + size c) pr m (Three a b c)
399 snocTree (Deep s pr m (One a)) b =
400 Deep (s + size b) pr m (Two a b)
402 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
403 (><) :: Seq a -> Seq a -> Seq a
404 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
406 -- The appendTree/addDigits gunk below is machine generated
408 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
409 appendTree0 Empty xs =
411 appendTree0 xs Empty =
413 appendTree0 (Single x) xs =
415 appendTree0 xs (Single x) =
417 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
418 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
420 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
421 addDigits0 m1 (One a) (One b) m2 =
422 appendTree1 m1 (node2 a b) m2
423 addDigits0 m1 (One a) (Two b c) m2 =
424 appendTree1 m1 (node3 a b c) m2
425 addDigits0 m1 (One a) (Three b c d) m2 =
426 appendTree2 m1 (node2 a b) (node2 c d) m2
427 addDigits0 m1 (One a) (Four b c d e) m2 =
428 appendTree2 m1 (node3 a b c) (node2 d e) m2
429 addDigits0 m1 (Two a b) (One c) m2 =
430 appendTree1 m1 (node3 a b c) m2
431 addDigits0 m1 (Two a b) (Two c d) m2 =
432 appendTree2 m1 (node2 a b) (node2 c d) m2
433 addDigits0 m1 (Two a b) (Three c d e) m2 =
434 appendTree2 m1 (node3 a b c) (node2 d e) m2
435 addDigits0 m1 (Two a b) (Four c d e f) m2 =
436 appendTree2 m1 (node3 a b c) (node3 d e f) m2
437 addDigits0 m1 (Three a b c) (One d) m2 =
438 appendTree2 m1 (node2 a b) (node2 c d) m2
439 addDigits0 m1 (Three a b c) (Two d e) m2 =
440 appendTree2 m1 (node3 a b c) (node2 d e) m2
441 addDigits0 m1 (Three a b c) (Three d e f) m2 =
442 appendTree2 m1 (node3 a b c) (node3 d e f) m2
443 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
444 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
445 addDigits0 m1 (Four a b c d) (One e) m2 =
446 appendTree2 m1 (node3 a b c) (node2 d e) m2
447 addDigits0 m1 (Four a b c d) (Two e f) m2 =
448 appendTree2 m1 (node3 a b c) (node3 d e f) m2
449 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
450 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
451 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
452 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
454 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
455 appendTree1 Empty a xs =
457 appendTree1 xs a Empty =
459 appendTree1 (Single x) a xs =
460 x `consTree` a `consTree` xs
461 appendTree1 xs a (Single x) =
462 xs `snocTree` a `snocTree` x
463 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
464 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
466 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
467 addDigits1 m1 (One a) b (One c) m2 =
468 appendTree1 m1 (node3 a b c) m2
469 addDigits1 m1 (One a) b (Two c d) m2 =
470 appendTree2 m1 (node2 a b) (node2 c d) m2
471 addDigits1 m1 (One a) b (Three c d e) m2 =
472 appendTree2 m1 (node3 a b c) (node2 d e) m2
473 addDigits1 m1 (One a) b (Four c d e f) m2 =
474 appendTree2 m1 (node3 a b c) (node3 d e f) m2
475 addDigits1 m1 (Two a b) c (One d) m2 =
476 appendTree2 m1 (node2 a b) (node2 c d) m2
477 addDigits1 m1 (Two a b) c (Two d e) m2 =
478 appendTree2 m1 (node3 a b c) (node2 d e) m2
479 addDigits1 m1 (Two a b) c (Three d e f) m2 =
480 appendTree2 m1 (node3 a b c) (node3 d e f) m2
481 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
482 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
483 addDigits1 m1 (Three a b c) d (One e) m2 =
484 appendTree2 m1 (node3 a b c) (node2 d e) m2
485 addDigits1 m1 (Three a b c) d (Two e f) m2 =
486 appendTree2 m1 (node3 a b c) (node3 d e f) m2
487 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
488 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
489 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
490 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
491 addDigits1 m1 (Four a b c d) e (One f) m2 =
492 appendTree2 m1 (node3 a b c) (node3 d e f) m2
493 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
494 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
495 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
496 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
497 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
498 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
500 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
501 appendTree2 Empty a b xs =
502 a `consTree` b `consTree` xs
503 appendTree2 xs a b Empty =
504 xs `snocTree` a `snocTree` b
505 appendTree2 (Single x) a b xs =
506 x `consTree` a `consTree` b `consTree` xs
507 appendTree2 xs a b (Single x) =
508 xs `snocTree` a `snocTree` b `snocTree` x
509 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
510 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
512 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
513 addDigits2 m1 (One a) b c (One d) m2 =
514 appendTree2 m1 (node2 a b) (node2 c d) m2
515 addDigits2 m1 (One a) b c (Two d e) m2 =
516 appendTree2 m1 (node3 a b c) (node2 d e) m2
517 addDigits2 m1 (One a) b c (Three d e f) m2 =
518 appendTree2 m1 (node3 a b c) (node3 d e f) m2
519 addDigits2 m1 (One a) b c (Four d e f g) m2 =
520 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
521 addDigits2 m1 (Two a b) c d (One e) m2 =
522 appendTree2 m1 (node3 a b c) (node2 d e) m2
523 addDigits2 m1 (Two a b) c d (Two e f) m2 =
524 appendTree2 m1 (node3 a b c) (node3 d e f) m2
525 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
526 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
527 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
528 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
529 addDigits2 m1 (Three a b c) d e (One f) m2 =
530 appendTree2 m1 (node3 a b c) (node3 d e f) m2
531 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
532 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
533 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
534 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
535 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
536 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
537 addDigits2 m1 (Four a b c d) e f (One g) m2 =
538 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
539 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
540 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
541 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
542 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
543 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
544 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
546 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
547 appendTree3 Empty a b c xs =
548 a `consTree` b `consTree` c `consTree` xs
549 appendTree3 xs a b c Empty =
550 xs `snocTree` a `snocTree` b `snocTree` c
551 appendTree3 (Single x) a b c xs =
552 x `consTree` a `consTree` b `consTree` c `consTree` xs
553 appendTree3 xs a b c (Single x) =
554 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
555 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
556 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
558 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))
559 addDigits3 m1 (One a) b c d (One e) m2 =
560 appendTree2 m1 (node3 a b c) (node2 d e) m2
561 addDigits3 m1 (One a) b c d (Two e f) m2 =
562 appendTree2 m1 (node3 a b c) (node3 d e f) m2
563 addDigits3 m1 (One a) b c d (Three e f g) m2 =
564 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
565 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
566 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
567 addDigits3 m1 (Two a b) c d e (One f) m2 =
568 appendTree2 m1 (node3 a b c) (node3 d e f) m2
569 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
570 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
571 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
572 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
573 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
574 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
575 addDigits3 m1 (Three a b c) d e f (One g) m2 =
576 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
577 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
578 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
579 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
580 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
581 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
582 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
583 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
584 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
585 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
586 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
587 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
588 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
589 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
590 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
592 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
593 appendTree4 Empty a b c d xs =
594 a `consTree` b `consTree` c `consTree` d `consTree` xs
595 appendTree4 xs a b c d Empty =
596 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
597 appendTree4 (Single x) a b c d xs =
598 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
599 appendTree4 xs a b c d (Single x) =
600 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
601 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
602 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
604 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))
605 addDigits4 m1 (One a) b c d e (One f) m2 =
606 appendTree2 m1 (node3 a b c) (node3 d e f) m2
607 addDigits4 m1 (One a) b c d e (Two f g) m2 =
608 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
609 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
610 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
611 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
612 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
613 addDigits4 m1 (Two a b) c d e f (One g) m2 =
614 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
615 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
616 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
617 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
618 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
619 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
620 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
621 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
622 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
623 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
624 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
625 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
626 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
627 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
628 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
629 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
630 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
631 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
632 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
633 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
634 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
635 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
636 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
638 ------------------------------------------------------------------------
640 ------------------------------------------------------------------------
642 -- | /O(1)/. Is this the empty sequence?
643 null :: Seq a -> Bool
644 null (Seq Empty) = True
647 -- | /O(1)/. The number of elements in the sequence.
648 length :: Seq a -> Int
649 length (Seq xs) = size xs
653 data Maybe2 a b = Nothing2 | Just2 a b
655 -- | View of the left end of a sequence.
657 = EmptyL -- ^ empty sequence
658 | a :< Seq a -- ^ leftmost element and the rest of the sequence
660 # if __GLASGOW_HASKELL__
661 deriving (Eq, Ord, Show, Read, Data)
663 deriving (Eq, Ord, Show, Read)
666 instance Eq a => Eq (ViewL a)
667 instance Ord a => Ord (ViewL a)
668 instance Show a => Show (ViewL a)
669 instance Read a => Read (ViewL a)
670 instance Data a => Data (ViewL a)
673 INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL")
675 instance Functor ViewL where
678 instance Foldable ViewL where
680 foldr f z (x :< xs) = f x (foldr f z xs)
683 foldl f z (x :< xs) = foldl f (f z x) xs
685 foldl1 f EmptyL = error "foldl1: empty view"
686 foldl1 f (x :< xs) = foldl f x xs
688 instance Traversable ViewL where
689 traverse _ EmptyL = pure EmptyL
690 traverse f (x :< xs) = (:<) <$> f x <*> traverse f xs
692 -- | /O(1)/. Analyse the left end of a sequence.
693 viewl :: Seq a -> ViewL a
694 viewl (Seq xs) = case viewLTree xs of
696 Just2 (Elem x) xs' -> x :< Seq xs'
698 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
699 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
700 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
701 viewLTree Empty = Nothing2
702 viewLTree (Single a) = Just2 a Empty
703 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
704 Nothing2 -> digitToTree sf
705 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
706 viewLTree (Deep s (Two a b) m sf) =
707 Just2 a (Deep (s - size a) (One b) m sf)
708 viewLTree (Deep s (Three a b c) m sf) =
709 Just2 a (Deep (s - size a) (Two b c) m sf)
710 viewLTree (Deep s (Four a b c d) m sf) =
711 Just2 a (Deep (s - size a) (Three b c d) m sf)
713 -- | View of the right end of a sequence.
715 = EmptyR -- ^ empty sequence
716 | Seq a :> a -- ^ the sequence minus the rightmost element,
717 -- and the rightmost element
719 # if __GLASGOW_HASKELL__
720 deriving (Eq, Ord, Show, Read, Data)
722 deriving (Eq, Ord, Show, Read)
725 instance Eq a => Eq (ViewR a)
726 instance Ord a => Ord (ViewR a)
727 instance Show a => Show (ViewR a)
728 instance Read a => Read (ViewR a)
729 instance Data a => Data (ViewR a)
732 INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR")
734 instance Functor ViewR where
737 instance Foldable ViewR where
739 foldr f z (xs :> x) = foldr f (f x z) xs
742 foldl f z (xs :> x) = f (foldl f z xs) x
744 foldr1 f EmptyR = error "foldr1: empty view"
745 foldr1 f (xs :> x) = foldr f x xs
747 instance Traversable ViewR where
748 traverse _ EmptyR = pure EmptyR
749 traverse f (xs :> x) = (:>) <$> traverse f xs <*> f x
751 -- | /O(1)/. Analyse the right end of a sequence.
752 viewr :: Seq a -> ViewR a
753 viewr (Seq xs) = case viewRTree xs of
755 Just2 xs' (Elem x) -> Seq xs' :> x
757 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
758 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
759 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
760 viewRTree Empty = Nothing2
761 viewRTree (Single z) = Just2 Empty z
762 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
763 Nothing2 -> digitToTree pr
764 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
765 viewRTree (Deep s pr m (Two y z)) =
766 Just2 (Deep (s - size z) pr m (One y)) z
767 viewRTree (Deep s pr m (Three x y z)) =
768 Just2 (Deep (s - size z) pr m (Two x y)) z
769 viewRTree (Deep s pr m (Four w x y z)) =
770 Just2 (Deep (s - size z) pr m (Three w x y)) z
774 -- | /O(log(min(i,n-i)))/. The element at the specified position
775 index :: Seq a -> Int -> a
777 | 0 <= i && i < size xs = case lookupTree (-i) xs of
778 Place _ (Elem x) -> x
779 | otherwise = error "index out of bounds"
781 data Place a = Place {-# UNPACK #-} !Int a
786 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
787 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
788 lookupTree :: Sized a => Int -> FingerTree a -> Place a
789 lookupTree _ Empty = error "lookupTree of empty tree"
790 lookupTree i (Single x) = Place i x
791 lookupTree i (Deep _ pr m sf)
792 | vpr > 0 = lookupDigit i pr
793 | vm > 0 = case lookupTree vpr m of
794 Place i' xs -> lookupNode i' xs
795 | otherwise = lookupDigit vm sf
796 where vpr = i + size pr
799 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
800 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
801 lookupNode :: Sized a => Int -> Node a -> Place a
802 lookupNode i (Node2 _ a b)
804 | otherwise = Place va b
805 where va = i + size a
806 lookupNode i (Node3 _ a b c)
808 | vab > 0 = Place va b
809 | otherwise = Place vab c
810 where va = i + size a
813 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
814 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
815 lookupDigit :: Sized a => Int -> Digit a -> Place a
816 lookupDigit i (One a) = Place i a
817 lookupDigit i (Two a b)
819 | otherwise = Place va b
820 where va = i + size a
821 lookupDigit i (Three a b c)
823 | vab > 0 = Place va b
824 | otherwise = Place vab c
825 where va = i + size a
827 lookupDigit i (Four a b c d)
829 | vab > 0 = Place va b
830 | vabc > 0 = Place vab c
831 | otherwise = Place vabc d
832 where va = i + size a
836 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
837 update :: Int -> a -> Seq a -> Seq a
838 update i x = adjust (const x) i
840 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
841 adjust :: (a -> a) -> Int -> Seq a -> Seq a
843 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
846 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
847 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
848 adjustTree :: Sized a => (Int -> a -> a) ->
849 Int -> FingerTree a -> FingerTree a
850 adjustTree _ _ Empty = error "adjustTree of empty tree"
851 adjustTree f i (Single x) = Single (f i x)
852 adjustTree f i (Deep s pr m sf)
853 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
854 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
855 | otherwise = Deep s pr m (adjustDigit f vm sf)
856 where vpr = i + size pr
859 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
860 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
861 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
862 adjustNode f i (Node2 s a b)
863 | va > 0 = Node2 s (f i a) b
864 | otherwise = Node2 s a (f va b)
865 where va = i + size a
866 adjustNode f i (Node3 s a b c)
867 | va > 0 = Node3 s (f i a) b c
868 | vab > 0 = Node3 s a (f va b) c
869 | otherwise = Node3 s a b (f vab c)
870 where va = i + size a
873 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
874 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
875 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
876 adjustDigit f i (One a) = One (f i a)
877 adjustDigit f i (Two a b)
878 | va > 0 = Two (f i a) b
879 | otherwise = Two a (f va b)
880 where va = i + size a
881 adjustDigit f i (Three a b c)
882 | va > 0 = Three (f i a) b c
883 | vab > 0 = Three a (f va b) c
884 | otherwise = Three a b (f vab c)
885 where va = i + size a
887 adjustDigit f i (Four a b c d)
888 | va > 0 = Four (f i a) b c d
889 | vab > 0 = Four a (f va b) c d
890 | vabc > 0 = Four a b (f vab c) d
891 | otherwise = Four a b c (f vabc d)
892 where va = i + size a
898 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
899 take :: Int -> Seq a -> Seq a
900 take i = fst . splitAt i
902 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
903 drop :: Int -> Seq a -> Seq a
904 drop i = snd . splitAt i
906 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
907 splitAt :: Int -> Seq a -> (Seq a, Seq a)
908 splitAt i (Seq xs) = (Seq l, Seq r)
909 where (l, r) = split i xs
911 split :: Int -> FingerTree (Elem a) ->
912 (FingerTree (Elem a), FingerTree (Elem a))
913 split i Empty = i `seq` (Empty, Empty)
915 | size xs > i = (l, consTree x r)
916 | otherwise = (xs, Empty)
917 where Split l x r = splitTree (-i) xs
919 data Split t a = Split t a t
924 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
925 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
926 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
927 splitTree _ Empty = error "splitTree of empty tree"
928 splitTree i (Single x) = i `seq` Split Empty x Empty
929 splitTree i (Deep _ pr m sf)
930 | vpr > 0 = case splitDigit i pr of
931 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
932 | vm > 0 = case splitTree vpr m of
933 Split ml xs mr -> case splitNode (vpr + size ml) xs of
934 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
935 | otherwise = case splitDigit vm sf of
936 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
937 where vpr = i + size pr
940 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
941 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
942 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
943 deepL Nothing m sf = case viewLTree m of
944 Nothing2 -> digitToTree sf
945 Just2 a m' -> deep (nodeToDigit a) m' sf
946 deepL (Just pr) m sf = deep pr m sf
948 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
949 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
950 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
951 deepR pr m Nothing = case viewRTree m of
952 Nothing2 -> digitToTree pr
953 Just2 m' a -> deep pr m' (nodeToDigit a)
954 deepR pr m (Just sf) = deep pr m sf
956 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
957 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
958 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
959 splitNode i (Node2 _ a b)
960 | va > 0 = Split Nothing a (Just (One b))
961 | otherwise = Split (Just (One a)) b Nothing
962 where va = i + size a
963 splitNode i (Node3 _ a b c)
964 | va > 0 = Split Nothing a (Just (Two b c))
965 | vab > 0 = Split (Just (One a)) b (Just (One c))
966 | otherwise = Split (Just (Two a b)) c Nothing
967 where va = i + size a
970 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
971 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
972 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
973 splitDigit i (One a) = i `seq` Split Nothing a Nothing
974 splitDigit i (Two a b)
975 | va > 0 = Split Nothing a (Just (One b))
976 | otherwise = Split (Just (One a)) b Nothing
977 where va = i + size a
978 splitDigit i (Three a b c)
979 | va > 0 = Split Nothing a (Just (Two b c))
980 | vab > 0 = Split (Just (One a)) b (Just (One c))
981 | otherwise = Split (Just (Two a b)) c Nothing
982 where va = i + size a
984 splitDigit i (Four a b c d)
985 | va > 0 = Split Nothing a (Just (Three b c d))
986 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
987 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
988 | otherwise = Split (Just (Three a b c)) d Nothing
989 where va = i + size a
993 ------------------------------------------------------------------------
995 ------------------------------------------------------------------------
997 -- | /O(n)/. Create a sequence from a finite list of elements.
998 fromList :: [a] -> Seq a
999 fromList = Data.List.foldl' (|>) empty
1001 ------------------------------------------------------------------------
1003 ------------------------------------------------------------------------
1005 -- | /O(n)/. The reverse of a sequence.
1006 reverse :: Seq a -> Seq a
1007 reverse (Seq xs) = Seq (reverseTree id xs)
1009 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1010 reverseTree _ Empty = Empty
1011 reverseTree f (Single x) = Single (f x)
1012 reverseTree f (Deep s pr m sf) =
1013 Deep s (reverseDigit f sf)
1014 (reverseTree (reverseNode f) m)
1017 reverseDigit :: (a -> a) -> Digit a -> Digit a
1018 reverseDigit f (One a) = One (f a)
1019 reverseDigit f (Two a b) = Two (f b) (f a)
1020 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1021 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1023 reverseNode :: (a -> a) -> Node a -> Node a
1024 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1025 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1029 ------------------------------------------------------------------------
1031 ------------------------------------------------------------------------
1033 instance Arbitrary a => Arbitrary (Seq a) where
1034 arbitrary = liftM Seq arbitrary
1035 coarbitrary (Seq x) = coarbitrary x
1037 instance Arbitrary a => Arbitrary (Elem a) where
1038 arbitrary = liftM Elem arbitrary
1039 coarbitrary (Elem x) = coarbitrary x
1041 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1042 arbitrary = sized arb
1043 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1044 arb 0 = return Empty
1045 arb 1 = liftM Single arbitrary
1046 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1048 coarbitrary Empty = variant 0
1049 coarbitrary (Single x) = variant 1 . coarbitrary x
1050 coarbitrary (Deep _ pr m sf) =
1051 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1053 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1055 liftM2 node2 arbitrary arbitrary,
1056 liftM3 node3 arbitrary arbitrary arbitrary]
1058 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1059 coarbitrary (Node3 _ a b c) =
1060 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1062 instance Arbitrary a => Arbitrary (Digit a) where
1064 liftM One arbitrary,
1065 liftM2 Two arbitrary arbitrary,
1066 liftM3 Three arbitrary arbitrary arbitrary,
1067 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1069 coarbitrary (One a) = variant 0 . coarbitrary a
1070 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1071 coarbitrary (Three a b c) =
1072 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1073 coarbitrary (Four a b c d) =
1074 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1076 ------------------------------------------------------------------------
1078 ------------------------------------------------------------------------
1083 instance Valid (Elem a) where
1086 instance Valid (Seq a) where
1087 valid (Seq xs) = valid xs
1089 instance (Sized a, Valid a) => Valid (FingerTree a) where
1091 valid (Single x) = valid x
1092 valid (Deep s pr m sf) =
1093 s == size pr + size m + size sf && valid pr && valid m && valid sf
1095 instance (Sized a, Valid a) => Valid (Node a) where
1096 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1097 valid (Node3 s a b c) =
1098 s == size a + size b + size c && valid a && valid b && valid c
1100 instance Valid a => Valid (Digit a) where
1101 valid (One a) = valid a
1102 valid (Two a b) = valid a && valid b
1103 valid (Three a b c) = valid a && valid b && valid c
1104 valid (Four a b c d) = valid a && valid b && valid c && valid d