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 -- submitted to /Journal of Functional Programming/.
26 -- <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
28 -- /Note/: Many of these operations have the same names as similar
29 -- operations on lists in the "Prelude". The ambiguity may be resolved
30 -- using either qualification or the @hiding@ clause.
32 -----------------------------------------------------------------------------
34 module Data.Sequence (
38 singleton, -- :: a -> Seq a
39 (<|), -- :: a -> Seq a -> Seq a
40 (|>), -- :: Seq a -> a -> Seq a
41 (><), -- :: Seq a -> Seq a -> Seq a
44 null, -- :: Seq a -> Bool
45 length, -- :: Seq a -> Int
48 viewl, -- :: Seq a -> ViewL a
50 viewr, -- :: Seq a -> ViewR a
52 index, -- :: Seq a -> Int -> a
53 adjust, -- :: (a -> a) -> Int -> Seq a -> Seq a
54 update, -- :: Int -> a -> Seq a -> Seq a
55 take, -- :: Int -> Seq a -> Seq a
56 drop, -- :: Int -> Seq a -> Seq a
57 splitAt, -- :: Int -> Seq a -> (Seq a, Seq a)
59 fromList, -- :: [a] -> Seq a
60 toList, -- :: Seq a -> [a]
62 -- ** Right associative
63 foldr, -- :: (a -> b -> b) -> b -> Seq a -> b
64 foldr1, -- :: (a -> a -> a) -> Seq a -> a
65 foldr', -- :: (a -> b -> b) -> b -> Seq a -> b
66 foldrM, -- :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
67 -- ** Left associative
68 foldl, -- :: (a -> b -> a) -> a -> Seq b -> a
69 foldl1, -- :: (a -> a -> a) -> Seq a -> a
70 foldl', -- :: (a -> b -> a) -> a -> Seq b -> a
71 foldlM, -- :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
73 reverse, -- :: Seq a -> Seq a
79 import Prelude hiding (
80 null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
82 import qualified Prelude (foldr)
83 import qualified Data.List (foldl', intersperse)
88 import Control.Monad (liftM, liftM2, liftM3, liftM4)
89 import Test.QuickCheck
92 #if __GLASGOW_HASKELL__
93 import Data.Generics.Basics (Data(..), mkNorepType)
106 ------------------------------------------------------------------------
107 -- Random access sequences
108 ------------------------------------------------------------------------
110 -- | General-purpose finite sequences.
111 newtype Seq a = Seq (FingerTree (Elem a))
113 instance Functor Seq where
114 fmap f (Seq xs) = Seq (fmap (fmap f) xs)
116 instance Eq a => Eq (Seq a) where
117 xs == ys = length xs == length ys && toList xs == toList ys
119 instance Ord a => Ord (Seq a) where
120 compare xs ys = compare (toList xs) (toList ys)
123 instance (Show a) => Show (Seq a) where
124 showsPrec p (Seq x) = showsPrec p x
126 instance Show a => Show (Seq a) where
127 showsPrec _ xs = showChar '<' .
128 flip (Prelude.foldr ($)) (Data.List.intersperse (showChar ',')
129 (map shows (toList xs))) .
133 instance FunctorM Seq where
134 fmapM f = foldlM f' empty
138 fmapM_ f = foldlM f' ()
139 where f' _ x = f x >> return ()
141 #include "Typeable.h"
142 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
144 #if __GLASGOW_HASKELL__
145 instance Data a => Data (Seq a) where
146 gfoldl f z = gfoldSeq f z id
147 toConstr _ = error "toConstr"
148 gunfold _ _ = error "gunfold"
149 dataTypeOf _ = mkNorepType "Data.Sequence.Seq"
151 -- Treat the type as consisting of constructors of arity 0, 1, 2, ...
152 gfoldSeq :: Data a => (forall a b. Data a => c (a -> b) -> a -> c b) ->
153 (forall g. g -> c g) -> (Seq a -> r) -> Seq a -> c r
154 gfoldSeq f z k s = case viewr s of
155 EmptyR -> z (k empty)
156 xs :> x -> gfoldSeq f z (snoc k) xs `f` x
157 where snoc k xs x = k (xs |> x)
165 | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
170 instance Sized a => Sized (FingerTree a) where
172 size (Single x) = size x
173 size (Deep v _ _ _) = v
175 instance Functor FingerTree where
177 fmap f (Single x) = Single (f x)
178 fmap f (Deep v pr m sf) =
179 Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
182 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
183 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
196 instance Functor Digit where
197 fmap f (One a) = One (f a)
198 fmap f (Two a b) = Two (f a) (f b)
199 fmap f (Three a b c) = Three (f a) (f b) (f c)
200 fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)
202 instance Sized a => Sized (Digit a) where
203 size xs = foldlDigit (\ i x -> i + size x) 0 xs
205 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
206 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
207 digitToTree :: Sized a => Digit a -> FingerTree a
208 digitToTree (One a) = Single a
209 digitToTree (Two a b) = deep (One a) Empty (One b)
210 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
211 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
216 = Node2 {-# UNPACK #-} !Int a a
217 | Node3 {-# UNPACK #-} !Int a a a
222 instance Functor (Node) where
223 fmap f (Node2 v a b) = Node2 v (f a) (f b)
224 fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
226 instance Sized (Node a) where
227 size (Node2 v _ _) = v
228 size (Node3 v _ _ _) = v
231 node2 :: Sized a => a -> a -> Node a
232 node2 a b = Node2 (size a + size b) a b
235 node3 :: Sized a => a -> a -> a -> Node a
236 node3 a b c = Node3 (size a + size b + size c) a b c
238 nodeToDigit :: Node a -> Digit a
239 nodeToDigit (Node2 _ a b) = Two a b
240 nodeToDigit (Node3 _ a b c) = Three a b c
244 newtype Elem a = Elem { getElem :: a }
246 instance Sized (Elem a) where
249 instance Functor Elem where
250 fmap f (Elem x) = Elem (f x)
253 instance (Show a) => Show (Elem a) where
254 showsPrec p (Elem x) = showsPrec p x
257 ------------------------------------------------------------------------
259 ------------------------------------------------------------------------
261 -- | /O(1)/. The empty sequence.
265 -- | /O(1)/. A singleton sequence.
266 singleton :: a -> Seq a
267 singleton x = Seq (Single (Elem x))
269 -- | /O(1)/. Add an element to the left end of a sequence.
270 -- Mnemonic: a triangle with the single element at the pointy end.
271 (<|) :: a -> Seq a -> Seq a
272 x <| Seq xs = Seq (Elem x `consTree` xs)
274 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
275 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
276 consTree :: Sized a => a -> FingerTree a -> FingerTree a
277 consTree a Empty = Single a
278 consTree a (Single b) = deep (One a) Empty (One b)
279 consTree a (Deep s (Four b c d e) m sf) = m `seq`
280 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
281 consTree a (Deep s (Three b c d) m sf) =
282 Deep (size a + s) (Four a b c d) m sf
283 consTree a (Deep s (Two b c) m sf) =
284 Deep (size a + s) (Three a b c) m sf
285 consTree a (Deep s (One b) m sf) =
286 Deep (size a + s) (Two a b) m sf
288 -- | /O(1)/. Add an element to the right end of a sequence.
289 -- Mnemonic: a triangle with the single element at the pointy end.
290 (|>) :: Seq a -> a -> Seq a
291 Seq xs |> x = Seq (xs `snocTree` Elem x)
293 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
294 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
295 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
296 snocTree Empty a = Single a
297 snocTree (Single a) b = deep (One a) Empty (One b)
298 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
299 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
300 snocTree (Deep s pr m (Three a b c)) d =
301 Deep (s + size d) pr m (Four a b c d)
302 snocTree (Deep s pr m (Two a b)) c =
303 Deep (s + size c) pr m (Three a b c)
304 snocTree (Deep s pr m (One a)) b =
305 Deep (s + size b) pr m (Two a b)
307 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
308 (><) :: Seq a -> Seq a -> Seq a
309 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
311 -- The appendTree/addDigits gunk below is machine generated
313 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
314 appendTree0 Empty xs =
316 appendTree0 xs Empty =
318 appendTree0 (Single x) xs =
320 appendTree0 xs (Single x) =
322 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
323 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
325 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
326 addDigits0 m1 (One a) (One b) m2 =
327 appendTree1 m1 (node2 a b) m2
328 addDigits0 m1 (One a) (Two b c) m2 =
329 appendTree1 m1 (node3 a b c) m2
330 addDigits0 m1 (One a) (Three b c d) m2 =
331 appendTree2 m1 (node2 a b) (node2 c d) m2
332 addDigits0 m1 (One a) (Four b c d e) m2 =
333 appendTree2 m1 (node3 a b c) (node2 d e) m2
334 addDigits0 m1 (Two a b) (One c) m2 =
335 appendTree1 m1 (node3 a b c) m2
336 addDigits0 m1 (Two a b) (Two c d) m2 =
337 appendTree2 m1 (node2 a b) (node2 c d) m2
338 addDigits0 m1 (Two a b) (Three c d e) m2 =
339 appendTree2 m1 (node3 a b c) (node2 d e) m2
340 addDigits0 m1 (Two a b) (Four c d e f) m2 =
341 appendTree2 m1 (node3 a b c) (node3 d e f) m2
342 addDigits0 m1 (Three a b c) (One d) m2 =
343 appendTree2 m1 (node2 a b) (node2 c d) m2
344 addDigits0 m1 (Three a b c) (Two d e) m2 =
345 appendTree2 m1 (node3 a b c) (node2 d e) m2
346 addDigits0 m1 (Three a b c) (Three d e f) m2 =
347 appendTree2 m1 (node3 a b c) (node3 d e f) m2
348 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
349 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
350 addDigits0 m1 (Four a b c d) (One e) m2 =
351 appendTree2 m1 (node3 a b c) (node2 d e) m2
352 addDigits0 m1 (Four a b c d) (Two e f) m2 =
353 appendTree2 m1 (node3 a b c) (node3 d e f) m2
354 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
355 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
356 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
357 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
359 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
360 appendTree1 Empty a xs =
362 appendTree1 xs a Empty =
364 appendTree1 (Single x) a xs =
365 x `consTree` a `consTree` xs
366 appendTree1 xs a (Single x) =
367 xs `snocTree` a `snocTree` x
368 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
369 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
371 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
372 addDigits1 m1 (One a) b (One c) m2 =
373 appendTree1 m1 (node3 a b c) m2
374 addDigits1 m1 (One a) b (Two c d) m2 =
375 appendTree2 m1 (node2 a b) (node2 c d) m2
376 addDigits1 m1 (One a) b (Three c d e) m2 =
377 appendTree2 m1 (node3 a b c) (node2 d e) m2
378 addDigits1 m1 (One a) b (Four c d e f) m2 =
379 appendTree2 m1 (node3 a b c) (node3 d e f) m2
380 addDigits1 m1 (Two a b) c (One d) m2 =
381 appendTree2 m1 (node2 a b) (node2 c d) m2
382 addDigits1 m1 (Two a b) c (Two d e) m2 =
383 appendTree2 m1 (node3 a b c) (node2 d e) m2
384 addDigits1 m1 (Two a b) c (Three d e f) m2 =
385 appendTree2 m1 (node3 a b c) (node3 d e f) m2
386 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
387 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
388 addDigits1 m1 (Three a b c) d (One e) m2 =
389 appendTree2 m1 (node3 a b c) (node2 d e) m2
390 addDigits1 m1 (Three a b c) d (Two e f) m2 =
391 appendTree2 m1 (node3 a b c) (node3 d e f) m2
392 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
393 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
394 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
395 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
396 addDigits1 m1 (Four a b c d) e (One f) m2 =
397 appendTree2 m1 (node3 a b c) (node3 d e f) m2
398 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
399 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
400 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
401 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
402 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
403 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
405 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
406 appendTree2 Empty a b xs =
407 a `consTree` b `consTree` xs
408 appendTree2 xs a b Empty =
409 xs `snocTree` a `snocTree` b
410 appendTree2 (Single x) a b xs =
411 x `consTree` a `consTree` b `consTree` xs
412 appendTree2 xs a b (Single x) =
413 xs `snocTree` a `snocTree` b `snocTree` x
414 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
415 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
417 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
418 addDigits2 m1 (One a) b c (One d) m2 =
419 appendTree2 m1 (node2 a b) (node2 c d) m2
420 addDigits2 m1 (One a) b c (Two d e) m2 =
421 appendTree2 m1 (node3 a b c) (node2 d e) m2
422 addDigits2 m1 (One a) b c (Three d e f) m2 =
423 appendTree2 m1 (node3 a b c) (node3 d e f) m2
424 addDigits2 m1 (One a) b c (Four d e f g) m2 =
425 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
426 addDigits2 m1 (Two a b) c d (One e) m2 =
427 appendTree2 m1 (node3 a b c) (node2 d e) m2
428 addDigits2 m1 (Two a b) c d (Two e f) m2 =
429 appendTree2 m1 (node3 a b c) (node3 d e f) m2
430 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
431 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
432 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
433 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
434 addDigits2 m1 (Three a b c) d e (One f) m2 =
435 appendTree2 m1 (node3 a b c) (node3 d e f) m2
436 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
437 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
438 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
439 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
440 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
441 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
442 addDigits2 m1 (Four a b c d) e f (One g) m2 =
443 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
444 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
445 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
446 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
447 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
448 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
449 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
451 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
452 appendTree3 Empty a b c xs =
453 a `consTree` b `consTree` c `consTree` xs
454 appendTree3 xs a b c Empty =
455 xs `snocTree` a `snocTree` b `snocTree` c
456 appendTree3 (Single x) a b c xs =
457 x `consTree` a `consTree` b `consTree` c `consTree` xs
458 appendTree3 xs a b c (Single x) =
459 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
460 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
461 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
463 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))
464 addDigits3 m1 (One a) b c d (One e) m2 =
465 appendTree2 m1 (node3 a b c) (node2 d e) m2
466 addDigits3 m1 (One a) b c d (Two e f) m2 =
467 appendTree2 m1 (node3 a b c) (node3 d e f) m2
468 addDigits3 m1 (One a) b c d (Three e f g) m2 =
469 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
470 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
471 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
472 addDigits3 m1 (Two a b) c d e (One f) m2 =
473 appendTree2 m1 (node3 a b c) (node3 d e f) m2
474 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
475 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
476 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
477 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
478 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
479 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
480 addDigits3 m1 (Three a b c) d e f (One g) m2 =
481 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
482 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
483 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
484 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
485 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
486 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
487 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
488 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
489 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
490 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
491 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
492 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
493 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
494 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
495 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
497 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
498 appendTree4 Empty a b c d xs =
499 a `consTree` b `consTree` c `consTree` d `consTree` xs
500 appendTree4 xs a b c d Empty =
501 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
502 appendTree4 (Single x) a b c d xs =
503 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
504 appendTree4 xs a b c d (Single x) =
505 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
506 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
507 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
509 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))
510 addDigits4 m1 (One a) b c d e (One f) m2 =
511 appendTree2 m1 (node3 a b c) (node3 d e f) m2
512 addDigits4 m1 (One a) b c d e (Two f g) m2 =
513 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
514 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
515 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
516 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
517 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
518 addDigits4 m1 (Two a b) c d e f (One g) m2 =
519 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
520 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
521 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
522 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
523 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
524 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
525 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
526 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
527 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
528 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
529 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
530 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
531 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
532 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
533 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
534 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
535 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
536 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
537 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
538 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
539 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
540 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
541 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
543 ------------------------------------------------------------------------
545 ------------------------------------------------------------------------
547 -- | /O(1)/. Is this the empty sequence?
548 null :: Seq a -> Bool
549 null (Seq Empty) = True
552 -- | /O(1)/. The number of elements in the sequence.
553 length :: Seq a -> Int
554 length (Seq xs) = size xs
558 data Maybe2 a b = Nothing2 | Just2 a b
560 -- | View of the left end of a sequence.
562 = EmptyL -- ^ empty sequence
563 | a :< Seq a -- ^ leftmost element and the rest of the sequence
567 instance Eq a => Eq (ViewL a)
568 instance Show a => Show (ViewL a)
572 instance Functor ViewL where
573 fmap _ EmptyL = EmptyL
574 fmap f (x :< xs) = f x :< fmap f xs
576 -- | /O(1)/. Analyse the left end of a sequence.
577 viewl :: Seq a -> ViewL a
578 viewl (Seq xs) = case viewLTree xs of
580 Just2 (Elem x) xs' -> x :< Seq xs'
582 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
583 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
584 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
585 viewLTree Empty = Nothing2
586 viewLTree (Single a) = Just2 a Empty
587 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
588 Nothing2 -> digitToTree sf
589 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
590 viewLTree (Deep s (Two a b) m sf) =
591 Just2 a (Deep (s - size a) (One b) m sf)
592 viewLTree (Deep s (Three a b c) m sf) =
593 Just2 a (Deep (s - size a) (Two b c) m sf)
594 viewLTree (Deep s (Four a b c d) m sf) =
595 Just2 a (Deep (s - size a) (Three b c d) m sf)
597 -- | View of the right end of a sequence.
599 = EmptyR -- ^ empty sequence
600 | Seq a :> a -- ^ the sequence minus the rightmost element,
601 -- and the rightmost element
605 instance Eq a => Eq (ViewR a)
606 instance Show a => Show (ViewR a)
609 instance Functor ViewR where
610 fmap _ EmptyR = EmptyR
611 fmap f (xs :> x) = fmap f xs :> f x
613 -- | /O(1)/. Analyse the right end of a sequence.
614 viewr :: Seq a -> ViewR a
615 viewr (Seq xs) = case viewRTree xs of
617 Just2 xs' (Elem x) -> Seq xs' :> x
619 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
620 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
621 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
622 viewRTree Empty = Nothing2
623 viewRTree (Single z) = Just2 Empty z
624 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
625 Nothing2 -> digitToTree pr
626 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
627 viewRTree (Deep s pr m (Two y z)) =
628 Just2 (Deep (s - size z) pr m (One y)) z
629 viewRTree (Deep s pr m (Three x y z)) =
630 Just2 (Deep (s - size z) pr m (Two x y)) z
631 viewRTree (Deep s pr m (Four w x y z)) =
632 Just2 (Deep (s - size z) pr m (Three w x y)) z
636 -- | /O(log(min(i,n-i)))/. The element at the specified position
637 index :: Seq a -> Int -> a
639 | 0 <= i && i < size xs = case lookupTree (-i) xs of
640 Place _ (Elem x) -> x
641 | otherwise = error "index out of bounds"
643 data Place a = Place {-# UNPACK #-} !Int a
648 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
649 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
650 lookupTree :: Sized a => Int -> FingerTree a -> Place a
651 lookupTree _ Empty = error "lookupTree of empty tree"
652 lookupTree i (Single x) = Place i x
653 lookupTree i (Deep _ pr m sf)
654 | vpr > 0 = lookupDigit i pr
655 | vm > 0 = case lookupTree vpr m of
656 Place i' xs -> lookupNode i' xs
657 | otherwise = lookupDigit vm sf
658 where vpr = i + size pr
661 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
662 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
663 lookupNode :: Sized a => Int -> Node a -> Place a
664 lookupNode i (Node2 _ a b)
666 | otherwise = Place va b
667 where va = i + size a
668 lookupNode i (Node3 _ a b c)
670 | vab > 0 = Place va b
671 | otherwise = Place vab c
672 where va = i + size a
675 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
676 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
677 lookupDigit :: Sized a => Int -> Digit a -> Place a
678 lookupDigit i (One a) = Place i a
679 lookupDigit i (Two a b)
681 | otherwise = Place va b
682 where va = i + size a
683 lookupDigit i (Three a b c)
685 | vab > 0 = Place va b
686 | otherwise = Place vab c
687 where va = i + size a
689 lookupDigit i (Four a b c d)
691 | vab > 0 = Place va b
692 | vabc > 0 = Place vab c
693 | otherwise = Place vabc d
694 where va = i + size a
698 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
699 update :: Int -> a -> Seq a -> Seq a
700 update i x = adjust (const x) i
702 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
703 adjust :: (a -> a) -> Int -> Seq a -> Seq a
705 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
708 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
709 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
710 adjustTree :: Sized a => (Int -> a -> a) ->
711 Int -> FingerTree a -> FingerTree a
712 adjustTree _ _ Empty = error "adjustTree of empty tree"
713 adjustTree f i (Single x) = Single (f i x)
714 adjustTree f i (Deep s pr m sf)
715 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
716 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
717 | otherwise = Deep s pr m (adjustDigit f vm sf)
718 where vpr = i + size pr
721 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
722 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
723 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
724 adjustNode f i (Node2 s a b)
725 | va > 0 = Node2 s (f i a) b
726 | otherwise = Node2 s a (f va b)
727 where va = i + size a
728 adjustNode f i (Node3 s a b c)
729 | va > 0 = Node3 s (f i a) b c
730 | vab > 0 = Node3 s a (f va b) c
731 | otherwise = Node3 s a b (f vab c)
732 where va = i + size a
735 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
736 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
737 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
738 adjustDigit f i (One a) = One (f i a)
739 adjustDigit f i (Two a b)
740 | va > 0 = Two (f i a) b
741 | otherwise = Two a (f va b)
742 where va = i + size a
743 adjustDigit f i (Three a b c)
744 | va > 0 = Three (f i a) b c
745 | vab > 0 = Three a (f va b) c
746 | otherwise = Three a b (f vab c)
747 where va = i + size a
749 adjustDigit f i (Four a b c d)
750 | va > 0 = Four (f i a) b c d
751 | vab > 0 = Four a (f va b) c d
752 | vabc > 0 = Four a b (f vab c) d
753 | otherwise = Four a b c (f vabc d)
754 where va = i + size a
760 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
761 take :: Int -> Seq a -> Seq a
762 take i = fst . splitAt i
764 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
765 drop :: Int -> Seq a -> Seq a
766 drop i = snd . splitAt i
768 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
769 splitAt :: Int -> Seq a -> (Seq a, Seq a)
770 splitAt i (Seq xs) = (Seq l, Seq r)
771 where (l, r) = split i xs
773 split :: Int -> FingerTree (Elem a) ->
774 (FingerTree (Elem a), FingerTree (Elem a))
775 split i Empty = i `seq` (Empty, Empty)
777 | size xs > i = (l, consTree x r)
778 | otherwise = (xs, Empty)
779 where Split l x r = splitTree (-i) xs
781 data Split t a = Split t a t
786 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
787 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
788 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
789 splitTree _ Empty = error "splitTree of empty tree"
790 splitTree i (Single x) = i `seq` Split Empty x Empty
791 splitTree i (Deep _ pr m sf)
792 | vpr > 0 = case splitDigit i pr of
793 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
794 | vm > 0 = case splitTree vpr m of
795 Split ml xs mr -> case splitNode (vpr + size ml) xs of
796 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
797 | otherwise = case splitDigit vm sf of
798 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
799 where vpr = i + size pr
802 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
803 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
804 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
805 deepL Nothing m sf = case viewLTree m of
806 Nothing2 -> digitToTree sf
807 Just2 a m' -> deep (nodeToDigit a) m' sf
808 deepL (Just pr) m sf = deep pr m sf
810 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
811 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
812 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
813 deepR pr m Nothing = case viewRTree m of
814 Nothing2 -> digitToTree pr
815 Just2 m' a -> deep pr m' (nodeToDigit a)
816 deepR pr m (Just sf) = deep pr m sf
818 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
819 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
820 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
821 splitNode i (Node2 _ a b)
822 | va > 0 = Split Nothing a (Just (One b))
823 | otherwise = Split (Just (One a)) b Nothing
824 where va = i + size a
825 splitNode i (Node3 _ a b c)
826 | va > 0 = Split Nothing a (Just (Two b c))
827 | vab > 0 = Split (Just (One a)) b (Just (One c))
828 | otherwise = Split (Just (Two a b)) c Nothing
829 where va = i + size a
832 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
833 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
834 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
835 splitDigit i (One a) = i `seq` Split Nothing a Nothing
836 splitDigit i (Two a b)
837 | va > 0 = Split Nothing a (Just (One b))
838 | otherwise = Split (Just (One a)) b Nothing
839 where va = i + size a
840 splitDigit i (Three a b c)
841 | va > 0 = Split Nothing a (Just (Two b c))
842 | vab > 0 = Split (Just (One a)) b (Just (One c))
843 | otherwise = Split (Just (Two a b)) c Nothing
844 where va = i + size a
846 splitDigit i (Four a b c d)
847 | va > 0 = Split Nothing a (Just (Three b c d))
848 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
849 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
850 | otherwise = Split (Just (Three a b c)) d Nothing
851 where va = i + size a
855 ------------------------------------------------------------------------
857 ------------------------------------------------------------------------
859 -- | /O(n)/. Create a sequence from a finite list of elements.
860 fromList :: [a] -> Seq a
861 fromList = Data.List.foldl' (|>) empty
863 -- | /O(n)/. List of elements of the sequence.
864 toList :: Seq a -> [a]
865 toList = foldr (:) []
867 ------------------------------------------------------------------------
869 ------------------------------------------------------------------------
871 -- | /O(n*t)/. Fold over the elements of a sequence,
872 -- associating to the right.
873 foldr :: (a -> b -> b) -> b -> Seq a -> b
874 foldr f z (Seq xs) = foldrTree f' z xs
875 where f' (Elem x) y = f x y
877 foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
878 foldrTree _ z Empty = z
879 foldrTree f z (Single x) = x `f` z
880 foldrTree f z (Deep _ pr m sf) =
881 foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr
883 foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
884 foldrDigit f z (One a) = a `f` z
885 foldrDigit f z (Two a b) = a `f` (b `f` z)
886 foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z))
887 foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
889 foldrNode :: (a -> b -> b) -> b -> Node a -> b
890 foldrNode f z (Node2 _ a b) = a `f` (b `f` z)
891 foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
893 -- | /O(n*t)/. A variant of 'foldr' that has no base case,
894 -- and thus may only be applied to non-empty sequences.
895 foldr1 :: (a -> a -> a) -> Seq a -> a
896 foldr1 f (Seq xs) = getElem (foldr1Tree f' xs)
897 where f' (Elem x) (Elem y) = Elem (f x y)
899 foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
900 foldr1Tree _ Empty = error "foldr1: empty sequence"
901 foldr1Tree _ (Single x) = x
902 foldr1Tree f (Deep _ pr m sf) =
903 foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr
905 foldr1Digit :: (a -> a -> a) -> Digit a -> a
906 foldr1Digit f (One a) = a
907 foldr1Digit f (Two a b) = a `f` b
908 foldr1Digit f (Three a b c) = a `f` (b `f` c)
909 foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d))
911 -- | /O(n*t)/. Fold over the elements of a sequence,
912 -- associating to the left.
913 foldl :: (a -> b -> a) -> a -> Seq b -> a
914 foldl f z (Seq xs) = foldlTree f' z xs
915 where f' x (Elem y) = f x y
917 foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
918 foldlTree _ z Empty = z
919 foldlTree f z (Single x) = z `f` x
920 foldlTree f z (Deep _ pr m sf) =
921 foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
923 foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
924 foldlDigit f z (One a) = z `f` a
925 foldlDigit f z (Two a b) = (z `f` a) `f` b
926 foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c
927 foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
929 foldlNode :: (a -> b -> a) -> a -> Node b -> a
930 foldlNode f z (Node2 _ a b) = (z `f` a) `f` b
931 foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
933 -- | /O(n*t)/. A variant of 'foldl' that has no base case,
934 -- and thus may only be applied to non-empty sequences.
935 foldl1 :: (a -> a -> a) -> Seq a -> a
936 foldl1 f (Seq xs) = getElem (foldl1Tree f' xs)
937 where f' (Elem x) (Elem y) = Elem (f x y)
939 foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
940 foldl1Tree _ Empty = error "foldl1: empty sequence"
941 foldl1Tree _ (Single x) = x
942 foldl1Tree f (Deep _ pr m sf) =
943 foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf
945 foldl1Digit :: (a -> a -> a) -> Digit a -> a
946 foldl1Digit f (One a) = a
947 foldl1Digit f (Two a b) = a `f` b
948 foldl1Digit f (Three a b c) = (a `f` b) `f` c
949 foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d
951 ------------------------------------------------------------------------
953 ------------------------------------------------------------------------
955 -- | /O(n*t)/. Fold over the elements of a sequence,
956 -- associating to the right, but strictly.
957 foldr' :: (a -> b -> b) -> b -> Seq a -> b
958 foldr' f z xs = foldl f' id xs z
959 where f' k x z = k $! f x z
961 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
962 -- associating to the right, i.e. from right to left.
963 foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
964 foldrM f z xs = foldl f' return xs z
965 where f' k x z = f x z >>= k
967 -- | /O(n*t)/. Fold over the elements of a sequence,
968 -- associating to the left, but strictly.
969 foldl' :: (a -> b -> a) -> a -> Seq b -> a
970 foldl' f z xs = foldr f' id xs z
971 where f' x k z = k $! f z x
973 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
974 -- associating to the left, i.e. from left to right.
975 foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
976 foldlM f z xs = foldr f' return xs z
977 where f' x k z = f z x >>= k
979 ------------------------------------------------------------------------
981 ------------------------------------------------------------------------
983 -- | /O(n)/. The reverse of a sequence.
984 reverse :: Seq a -> Seq a
985 reverse (Seq xs) = Seq (reverseTree id xs)
987 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
988 reverseTree _ Empty = Empty
989 reverseTree f (Single x) = Single (f x)
990 reverseTree f (Deep s pr m sf) =
991 Deep s (reverseDigit f sf)
992 (reverseTree (reverseNode f) m)
995 reverseDigit :: (a -> a) -> Digit a -> Digit a
996 reverseDigit f (One a) = One (f a)
997 reverseDigit f (Two a b) = Two (f b) (f a)
998 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
999 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1001 reverseNode :: (a -> a) -> Node a -> Node a
1002 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1003 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1007 ------------------------------------------------------------------------
1009 ------------------------------------------------------------------------
1011 instance Arbitrary a => Arbitrary (Seq a) where
1012 arbitrary = liftM Seq arbitrary
1013 coarbitrary (Seq x) = coarbitrary x
1015 instance Arbitrary a => Arbitrary (Elem a) where
1016 arbitrary = liftM Elem arbitrary
1017 coarbitrary (Elem x) = coarbitrary x
1019 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1020 arbitrary = sized arb
1021 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1022 arb 0 = return Empty
1023 arb 1 = liftM Single arbitrary
1024 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1026 coarbitrary Empty = variant 0
1027 coarbitrary (Single x) = variant 1 . coarbitrary x
1028 coarbitrary (Deep _ pr m sf) =
1029 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1031 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1033 liftM2 node2 arbitrary arbitrary,
1034 liftM3 node3 arbitrary arbitrary arbitrary]
1036 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1037 coarbitrary (Node3 _ a b c) =
1038 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1040 instance Arbitrary a => Arbitrary (Digit a) where
1042 liftM One arbitrary,
1043 liftM2 Two arbitrary arbitrary,
1044 liftM3 Three arbitrary arbitrary arbitrary,
1045 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1047 coarbitrary (One a) = variant 0 . coarbitrary a
1048 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1049 coarbitrary (Three a b c) =
1050 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1051 coarbitrary (Four a b c d) =
1052 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1054 ------------------------------------------------------------------------
1056 ------------------------------------------------------------------------
1061 instance Valid (Elem a) where
1064 instance Valid (Seq a) where
1065 valid (Seq xs) = valid xs
1067 instance (Sized a, Valid a) => Valid (FingerTree a) where
1069 valid (Single x) = valid x
1070 valid (Deep s pr m sf) =
1071 s == size pr + size m + size sf && valid pr && valid m && valid sf
1073 instance (Sized a, Valid a) => Valid (Node a) where
1074 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1075 valid (Node3 s a b c) =
1076 s == size a + size b + size c && valid a && valid b && valid c
1078 instance Valid a => Valid (Digit a) where
1079 valid (One a) = valid a
1080 valid (Two a b) = valid a && valid b
1081 valid (Three a b c) = valid a && valid b && valid c
1082 valid (Four a b c d) = valid a && valid b && valid c && valid d