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(..), Fixity(..),
94 constrIndex, mkConstr, mkDataType)
107 ------------------------------------------------------------------------
108 -- Random access sequences
109 ------------------------------------------------------------------------
111 -- | General-purpose finite sequences.
112 newtype Seq a = Seq (FingerTree (Elem a))
114 instance Functor Seq where
115 fmap f (Seq xs) = Seq (fmap (fmap f) xs)
117 instance Eq a => Eq (Seq a) where
118 xs == ys = length xs == length ys && toList xs == toList ys
120 instance Ord a => Ord (Seq a) where
121 compare xs ys = compare (toList xs) (toList ys)
124 instance Show a => Show (Seq a) where
125 showsPrec p (Seq x) = showsPrec p x
127 instance Show a => Show (Seq a) where
128 showsPrec _ xs = showChar '<' .
129 flip (Prelude.foldr ($)) (Data.List.intersperse (showChar ',')
130 (map shows (toList xs))) .
134 instance FunctorM Seq where
135 fmapM f = foldlM f' empty
139 fmapM_ f = foldlM f' ()
140 where f' _ x = f x >> return ()
142 #include "Typeable.h"
143 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
145 #if __GLASGOW_HASKELL__
146 instance Data a => Data (Seq a) where
147 gfoldl f z s = case viewl s of
149 x :< xs -> z (<|) `f` x `f` xs
151 gunfold k z c = case constrIndex c of
157 | null xs = emptyConstr
158 | otherwise = consConstr
160 dataTypeOf _ = seqDataType
164 emptyConstr = mkConstr seqDataType "empty" [] Prefix
165 consConstr = mkConstr seqDataType "<|" [] Infix
166 seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
174 | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
179 instance Sized a => Sized (FingerTree a) where
181 size (Single x) = size x
182 size (Deep v _ _ _) = v
184 instance Functor FingerTree where
186 fmap f (Single x) = Single (f x)
187 fmap f (Deep v pr m sf) =
188 Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
191 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
192 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
193 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
194 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
207 instance Functor Digit where
208 fmap f (One a) = One (f a)
209 fmap f (Two a b) = Two (f a) (f b)
210 fmap f (Three a b c) = Three (f a) (f b) (f c)
211 fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)
213 instance Sized a => Sized (Digit a) where
214 size xs = foldlDigit (\ i x -> i + size x) 0 xs
216 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
217 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
218 digitToTree :: Sized a => Digit a -> FingerTree a
219 digitToTree (One a) = Single a
220 digitToTree (Two a b) = deep (One a) Empty (One b)
221 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
222 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
227 = Node2 {-# UNPACK #-} !Int a a
228 | Node3 {-# UNPACK #-} !Int a a a
233 instance Functor (Node) where
234 fmap f (Node2 v a b) = Node2 v (f a) (f b)
235 fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
237 instance Sized (Node a) where
238 size (Node2 v _ _) = v
239 size (Node3 v _ _ _) = v
242 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
243 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
244 node2 :: Sized a => a -> a -> Node a
245 node2 a b = Node2 (size a + size b) a b
248 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
249 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
250 node3 :: Sized a => a -> a -> a -> Node a
251 node3 a b c = Node3 (size a + size b + size c) a b c
253 nodeToDigit :: Node a -> Digit a
254 nodeToDigit (Node2 _ a b) = Two a b
255 nodeToDigit (Node3 _ a b c) = Three a b c
259 newtype Elem a = Elem { getElem :: a }
261 instance Sized (Elem a) where
264 instance Functor Elem where
265 fmap f (Elem x) = Elem (f x)
268 instance (Show a) => Show (Elem a) where
269 showsPrec p (Elem x) = showsPrec p x
272 ------------------------------------------------------------------------
274 ------------------------------------------------------------------------
276 -- | /O(1)/. The empty sequence.
280 -- | /O(1)/. A singleton sequence.
281 singleton :: a -> Seq a
282 singleton x = Seq (Single (Elem x))
284 -- | /O(1)/. Add an element to the left end of a sequence.
285 -- Mnemonic: a triangle with the single element at the pointy end.
286 (<|) :: a -> Seq a -> Seq a
287 x <| Seq xs = Seq (Elem x `consTree` xs)
289 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
290 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
291 consTree :: Sized a => a -> FingerTree a -> FingerTree a
292 consTree a Empty = Single a
293 consTree a (Single b) = deep (One a) Empty (One b)
294 consTree a (Deep s (Four b c d e) m sf) = m `seq`
295 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
296 consTree a (Deep s (Three b c d) m sf) =
297 Deep (size a + s) (Four a b c d) m sf
298 consTree a (Deep s (Two b c) m sf) =
299 Deep (size a + s) (Three a b c) m sf
300 consTree a (Deep s (One b) m sf) =
301 Deep (size a + s) (Two a b) m sf
303 -- | /O(1)/. Add an element to the right end of a sequence.
304 -- Mnemonic: a triangle with the single element at the pointy end.
305 (|>) :: Seq a -> a -> Seq a
306 Seq xs |> x = Seq (xs `snocTree` Elem x)
308 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
309 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
310 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
311 snocTree Empty a = Single a
312 snocTree (Single a) b = deep (One a) Empty (One b)
313 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
314 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
315 snocTree (Deep s pr m (Three a b c)) d =
316 Deep (s + size d) pr m (Four a b c d)
317 snocTree (Deep s pr m (Two a b)) c =
318 Deep (s + size c) pr m (Three a b c)
319 snocTree (Deep s pr m (One a)) b =
320 Deep (s + size b) pr m (Two a b)
322 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
323 (><) :: Seq a -> Seq a -> Seq a
324 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
326 -- The appendTree/addDigits gunk below is machine generated
328 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
329 appendTree0 Empty xs =
331 appendTree0 xs Empty =
333 appendTree0 (Single x) xs =
335 appendTree0 xs (Single x) =
337 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
338 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
340 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
341 addDigits0 m1 (One a) (One b) m2 =
342 appendTree1 m1 (node2 a b) m2
343 addDigits0 m1 (One a) (Two b c) m2 =
344 appendTree1 m1 (node3 a b c) m2
345 addDigits0 m1 (One a) (Three b c d) m2 =
346 appendTree2 m1 (node2 a b) (node2 c d) m2
347 addDigits0 m1 (One a) (Four b c d e) m2 =
348 appendTree2 m1 (node3 a b c) (node2 d e) m2
349 addDigits0 m1 (Two a b) (One c) m2 =
350 appendTree1 m1 (node3 a b c) m2
351 addDigits0 m1 (Two a b) (Two c d) m2 =
352 appendTree2 m1 (node2 a b) (node2 c d) m2
353 addDigits0 m1 (Two a b) (Three c d e) m2 =
354 appendTree2 m1 (node3 a b c) (node2 d e) m2
355 addDigits0 m1 (Two a b) (Four c d e f) m2 =
356 appendTree2 m1 (node3 a b c) (node3 d e f) m2
357 addDigits0 m1 (Three a b c) (One d) m2 =
358 appendTree2 m1 (node2 a b) (node2 c d) m2
359 addDigits0 m1 (Three a b c) (Two d e) m2 =
360 appendTree2 m1 (node3 a b c) (node2 d e) m2
361 addDigits0 m1 (Three a b c) (Three d e f) m2 =
362 appendTree2 m1 (node3 a b c) (node3 d e f) m2
363 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
364 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
365 addDigits0 m1 (Four a b c d) (One e) m2 =
366 appendTree2 m1 (node3 a b c) (node2 d e) m2
367 addDigits0 m1 (Four a b c d) (Two e f) m2 =
368 appendTree2 m1 (node3 a b c) (node3 d e f) m2
369 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
370 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
371 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
372 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
374 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
375 appendTree1 Empty a xs =
377 appendTree1 xs a Empty =
379 appendTree1 (Single x) a xs =
380 x `consTree` a `consTree` xs
381 appendTree1 xs a (Single x) =
382 xs `snocTree` a `snocTree` x
383 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
384 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
386 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
387 addDigits1 m1 (One a) b (One c) m2 =
388 appendTree1 m1 (node3 a b c) m2
389 addDigits1 m1 (One a) b (Two c d) m2 =
390 appendTree2 m1 (node2 a b) (node2 c d) m2
391 addDigits1 m1 (One a) b (Three c d e) m2 =
392 appendTree2 m1 (node3 a b c) (node2 d e) m2
393 addDigits1 m1 (One a) b (Four c d e f) m2 =
394 appendTree2 m1 (node3 a b c) (node3 d e f) m2
395 addDigits1 m1 (Two a b) c (One d) m2 =
396 appendTree2 m1 (node2 a b) (node2 c d) m2
397 addDigits1 m1 (Two a b) c (Two d e) m2 =
398 appendTree2 m1 (node3 a b c) (node2 d e) m2
399 addDigits1 m1 (Two a b) c (Three d e f) m2 =
400 appendTree2 m1 (node3 a b c) (node3 d e f) m2
401 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
402 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
403 addDigits1 m1 (Three a b c) d (One e) m2 =
404 appendTree2 m1 (node3 a b c) (node2 d e) m2
405 addDigits1 m1 (Three a b c) d (Two e f) m2 =
406 appendTree2 m1 (node3 a b c) (node3 d e f) m2
407 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
408 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
409 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
410 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
411 addDigits1 m1 (Four a b c d) e (One f) m2 =
412 appendTree2 m1 (node3 a b c) (node3 d e f) m2
413 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
414 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
415 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
416 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
417 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
418 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
420 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
421 appendTree2 Empty a b xs =
422 a `consTree` b `consTree` xs
423 appendTree2 xs a b Empty =
424 xs `snocTree` a `snocTree` b
425 appendTree2 (Single x) a b xs =
426 x `consTree` a `consTree` b `consTree` xs
427 appendTree2 xs a b (Single x) =
428 xs `snocTree` a `snocTree` b `snocTree` x
429 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
430 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
432 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
433 addDigits2 m1 (One a) b c (One d) m2 =
434 appendTree2 m1 (node2 a b) (node2 c d) m2
435 addDigits2 m1 (One a) b c (Two d e) m2 =
436 appendTree2 m1 (node3 a b c) (node2 d e) m2
437 addDigits2 m1 (One a) b c (Three d e f) m2 =
438 appendTree2 m1 (node3 a b c) (node3 d e f) m2
439 addDigits2 m1 (One a) b c (Four d e f g) m2 =
440 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
441 addDigits2 m1 (Two a b) c d (One e) m2 =
442 appendTree2 m1 (node3 a b c) (node2 d e) m2
443 addDigits2 m1 (Two a b) c d (Two e f) m2 =
444 appendTree2 m1 (node3 a b c) (node3 d e f) m2
445 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
446 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
447 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
448 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
449 addDigits2 m1 (Three a b c) d e (One f) m2 =
450 appendTree2 m1 (node3 a b c) (node3 d e f) m2
451 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
452 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
453 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
454 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
455 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
456 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
457 addDigits2 m1 (Four a b c d) e f (One g) m2 =
458 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
459 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
460 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
461 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
462 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
463 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
464 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
466 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
467 appendTree3 Empty a b c xs =
468 a `consTree` b `consTree` c `consTree` xs
469 appendTree3 xs a b c Empty =
470 xs `snocTree` a `snocTree` b `snocTree` c
471 appendTree3 (Single x) a b c xs =
472 x `consTree` a `consTree` b `consTree` c `consTree` xs
473 appendTree3 xs a b c (Single x) =
474 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
475 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
476 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
478 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))
479 addDigits3 m1 (One a) b c d (One e) m2 =
480 appendTree2 m1 (node3 a b c) (node2 d e) m2
481 addDigits3 m1 (One a) b c d (Two e f) m2 =
482 appendTree2 m1 (node3 a b c) (node3 d e f) m2
483 addDigits3 m1 (One a) b c d (Three e f g) m2 =
484 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
485 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
486 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
487 addDigits3 m1 (Two a b) c d e (One f) m2 =
488 appendTree2 m1 (node3 a b c) (node3 d e f) m2
489 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
490 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
491 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
492 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
493 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
494 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
495 addDigits3 m1 (Three a b c) d e f (One g) m2 =
496 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
497 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
498 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
499 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
500 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
501 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
502 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
503 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
504 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
505 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
506 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
507 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
508 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
509 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
510 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
512 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
513 appendTree4 Empty a b c d xs =
514 a `consTree` b `consTree` c `consTree` d `consTree` xs
515 appendTree4 xs a b c d Empty =
516 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
517 appendTree4 (Single x) a b c d xs =
518 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
519 appendTree4 xs a b c d (Single x) =
520 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
521 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
522 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
524 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))
525 addDigits4 m1 (One a) b c d e (One f) m2 =
526 appendTree2 m1 (node3 a b c) (node3 d e f) m2
527 addDigits4 m1 (One a) b c d e (Two f g) m2 =
528 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
529 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
530 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
531 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
532 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
533 addDigits4 m1 (Two a b) c d e f (One g) m2 =
534 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
535 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
536 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
537 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
538 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
539 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
540 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
541 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
542 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
543 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
544 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
545 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
546 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
547 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
548 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
549 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
550 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
551 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
552 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
553 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
554 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
555 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
556 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
558 ------------------------------------------------------------------------
560 ------------------------------------------------------------------------
562 -- | /O(1)/. Is this the empty sequence?
563 null :: Seq a -> Bool
564 null (Seq Empty) = True
567 -- | /O(1)/. The number of elements in the sequence.
568 length :: Seq a -> Int
569 length (Seq xs) = size xs
573 data Maybe2 a b = Nothing2 | Just2 a b
575 -- | View of the left end of a sequence.
577 = EmptyL -- ^ empty sequence
578 | a :< Seq a -- ^ leftmost element and the rest of the sequence
582 instance Eq a => Eq (ViewL a)
583 instance Show a => Show (ViewL a)
587 instance Functor ViewL where
588 fmap _ EmptyL = EmptyL
589 fmap f (x :< xs) = f x :< fmap f xs
591 -- | /O(1)/. Analyse the left end of a sequence.
592 viewl :: Seq a -> ViewL a
593 viewl (Seq xs) = case viewLTree xs of
595 Just2 (Elem x) xs' -> x :< Seq xs'
597 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
598 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
599 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
600 viewLTree Empty = Nothing2
601 viewLTree (Single a) = Just2 a Empty
602 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
603 Nothing2 -> digitToTree sf
604 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
605 viewLTree (Deep s (Two a b) m sf) =
606 Just2 a (Deep (s - size a) (One b) m sf)
607 viewLTree (Deep s (Three a b c) m sf) =
608 Just2 a (Deep (s - size a) (Two b c) m sf)
609 viewLTree (Deep s (Four a b c d) m sf) =
610 Just2 a (Deep (s - size a) (Three b c d) m sf)
612 -- | View of the right end of a sequence.
614 = EmptyR -- ^ empty sequence
615 | Seq a :> a -- ^ the sequence minus the rightmost element,
616 -- and the rightmost element
620 instance Eq a => Eq (ViewR a)
621 instance Show a => Show (ViewR a)
624 instance Functor ViewR where
625 fmap _ EmptyR = EmptyR
626 fmap f (xs :> x) = fmap f xs :> f x
628 -- | /O(1)/. Analyse the right end of a sequence.
629 viewr :: Seq a -> ViewR a
630 viewr (Seq xs) = case viewRTree xs of
632 Just2 xs' (Elem x) -> Seq xs' :> x
634 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
635 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
636 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
637 viewRTree Empty = Nothing2
638 viewRTree (Single z) = Just2 Empty z
639 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
640 Nothing2 -> digitToTree pr
641 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
642 viewRTree (Deep s pr m (Two y z)) =
643 Just2 (Deep (s - size z) pr m (One y)) z
644 viewRTree (Deep s pr m (Three x y z)) =
645 Just2 (Deep (s - size z) pr m (Two x y)) z
646 viewRTree (Deep s pr m (Four w x y z)) =
647 Just2 (Deep (s - size z) pr m (Three w x y)) z
651 -- | /O(log(min(i,n-i)))/. The element at the specified position
652 index :: Seq a -> Int -> a
654 | 0 <= i && i < size xs = case lookupTree (-i) xs of
655 Place _ (Elem x) -> x
656 | otherwise = error "index out of bounds"
658 data Place a = Place {-# UNPACK #-} !Int a
663 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
664 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
665 lookupTree :: Sized a => Int -> FingerTree a -> Place a
666 lookupTree _ Empty = error "lookupTree of empty tree"
667 lookupTree i (Single x) = Place i x
668 lookupTree i (Deep _ pr m sf)
669 | vpr > 0 = lookupDigit i pr
670 | vm > 0 = case lookupTree vpr m of
671 Place i' xs -> lookupNode i' xs
672 | otherwise = lookupDigit vm sf
673 where vpr = i + size pr
676 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
677 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
678 lookupNode :: Sized a => Int -> Node a -> Place a
679 lookupNode i (Node2 _ a b)
681 | otherwise = Place va b
682 where va = i + size a
683 lookupNode i (Node3 _ a b c)
685 | vab > 0 = Place va b
686 | otherwise = Place vab c
687 where va = i + size a
690 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
691 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
692 lookupDigit :: Sized a => Int -> Digit a -> Place a
693 lookupDigit i (One a) = Place i a
694 lookupDigit i (Two a b)
696 | otherwise = Place va b
697 where va = i + size a
698 lookupDigit i (Three a b c)
700 | vab > 0 = Place va b
701 | otherwise = Place vab c
702 where va = i + size a
704 lookupDigit i (Four a b c d)
706 | vab > 0 = Place va b
707 | vabc > 0 = Place vab c
708 | otherwise = Place vabc d
709 where va = i + size a
713 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
714 update :: Int -> a -> Seq a -> Seq a
715 update i x = adjust (const x) i
717 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
718 adjust :: (a -> a) -> Int -> Seq a -> Seq a
720 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
723 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
724 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
725 adjustTree :: Sized a => (Int -> a -> a) ->
726 Int -> FingerTree a -> FingerTree a
727 adjustTree _ _ Empty = error "adjustTree of empty tree"
728 adjustTree f i (Single x) = Single (f i x)
729 adjustTree f i (Deep s pr m sf)
730 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
731 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
732 | otherwise = Deep s pr m (adjustDigit f vm sf)
733 where vpr = i + size pr
736 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
737 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
738 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
739 adjustNode f i (Node2 s a b)
740 | va > 0 = Node2 s (f i a) b
741 | otherwise = Node2 s a (f va b)
742 where va = i + size a
743 adjustNode f i (Node3 s a b c)
744 | va > 0 = Node3 s (f i a) b c
745 | vab > 0 = Node3 s a (f va b) c
746 | otherwise = Node3 s a b (f vab c)
747 where va = i + size a
750 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
751 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
752 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
753 adjustDigit f i (One a) = One (f i a)
754 adjustDigit f i (Two a b)
755 | va > 0 = Two (f i a) b
756 | otherwise = Two a (f va b)
757 where va = i + size a
758 adjustDigit f i (Three a b c)
759 | va > 0 = Three (f i a) b c
760 | vab > 0 = Three a (f va b) c
761 | otherwise = Three a b (f vab c)
762 where va = i + size a
764 adjustDigit f i (Four a b c d)
765 | va > 0 = Four (f i a) b c d
766 | vab > 0 = Four a (f va b) c d
767 | vabc > 0 = Four a b (f vab c) d
768 | otherwise = Four a b c (f vabc d)
769 where va = i + size a
775 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
776 take :: Int -> Seq a -> Seq a
777 take i = fst . splitAt i
779 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
780 drop :: Int -> Seq a -> Seq a
781 drop i = snd . splitAt i
783 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
784 splitAt :: Int -> Seq a -> (Seq a, Seq a)
785 splitAt i (Seq xs) = (Seq l, Seq r)
786 where (l, r) = split i xs
788 split :: Int -> FingerTree (Elem a) ->
789 (FingerTree (Elem a), FingerTree (Elem a))
790 split i Empty = i `seq` (Empty, Empty)
792 | size xs > i = (l, consTree x r)
793 | otherwise = (xs, Empty)
794 where Split l x r = splitTree (-i) xs
796 data Split t a = Split t a t
801 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
802 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
803 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
804 splitTree _ Empty = error "splitTree of empty tree"
805 splitTree i (Single x) = i `seq` Split Empty x Empty
806 splitTree i (Deep _ pr m sf)
807 | vpr > 0 = case splitDigit i pr of
808 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
809 | vm > 0 = case splitTree vpr m of
810 Split ml xs mr -> case splitNode (vpr + size ml) xs of
811 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
812 | otherwise = case splitDigit vm sf of
813 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
814 where vpr = i + size pr
817 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
818 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
819 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
820 deepL Nothing m sf = case viewLTree m of
821 Nothing2 -> digitToTree sf
822 Just2 a m' -> deep (nodeToDigit a) m' sf
823 deepL (Just pr) m sf = deep pr m sf
825 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
826 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
827 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
828 deepR pr m Nothing = case viewRTree m of
829 Nothing2 -> digitToTree pr
830 Just2 m' a -> deep pr m' (nodeToDigit a)
831 deepR pr m (Just sf) = deep pr m sf
833 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
834 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
835 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
836 splitNode i (Node2 _ 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 splitNode i (Node3 _ 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
847 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
848 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
849 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
850 splitDigit i (One a) = i `seq` Split Nothing a Nothing
851 splitDigit i (Two a b)
852 | va > 0 = Split Nothing a (Just (One b))
853 | otherwise = Split (Just (One a)) b Nothing
854 where va = i + size a
855 splitDigit i (Three a b c)
856 | va > 0 = Split Nothing a (Just (Two b c))
857 | vab > 0 = Split (Just (One a)) b (Just (One c))
858 | otherwise = Split (Just (Two a b)) c Nothing
859 where va = i + size a
861 splitDigit i (Four a b c d)
862 | va > 0 = Split Nothing a (Just (Three b c d))
863 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
864 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
865 | otherwise = Split (Just (Three a b c)) d Nothing
866 where va = i + size a
870 ------------------------------------------------------------------------
872 ------------------------------------------------------------------------
874 -- | /O(n)/. Create a sequence from a finite list of elements.
875 fromList :: [a] -> Seq a
876 fromList = Data.List.foldl' (|>) empty
878 -- | /O(n)/. List of elements of the sequence.
879 toList :: Seq a -> [a]
880 toList = foldr (:) []
882 ------------------------------------------------------------------------
884 ------------------------------------------------------------------------
886 -- | /O(n*t)/. Fold over the elements of a sequence,
887 -- associating to the right.
888 foldr :: (a -> b -> b) -> b -> Seq a -> b
889 foldr f z (Seq xs) = foldrTree f' z xs
890 where f' (Elem x) y = f x y
892 foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
893 foldrTree _ z Empty = z
894 foldrTree f z (Single x) = x `f` z
895 foldrTree f z (Deep _ pr m sf) =
896 foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr
898 foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
899 foldrDigit f z (One a) = a `f` z
900 foldrDigit f z (Two a b) = a `f` (b `f` z)
901 foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z))
902 foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
904 foldrNode :: (a -> b -> b) -> b -> Node a -> b
905 foldrNode f z (Node2 _ a b) = a `f` (b `f` z)
906 foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
908 -- | /O(n*t)/. A variant of 'foldr' that has no base case,
909 -- and thus may only be applied to non-empty sequences.
910 foldr1 :: (a -> a -> a) -> Seq a -> a
911 foldr1 f (Seq xs) = getElem (foldr1Tree f' xs)
912 where f' (Elem x) (Elem y) = Elem (f x y)
914 foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
915 foldr1Tree _ Empty = error "foldr1: empty sequence"
916 foldr1Tree _ (Single x) = x
917 foldr1Tree f (Deep _ pr m sf) =
918 foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr
920 foldr1Digit :: (a -> a -> a) -> Digit a -> a
921 foldr1Digit f (One a) = a
922 foldr1Digit f (Two a b) = a `f` b
923 foldr1Digit f (Three a b c) = a `f` (b `f` c)
924 foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d))
926 -- | /O(n*t)/. Fold over the elements of a sequence,
927 -- associating to the left.
928 foldl :: (a -> b -> a) -> a -> Seq b -> a
929 foldl f z (Seq xs) = foldlTree f' z xs
930 where f' x (Elem y) = f x y
932 foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
933 foldlTree _ z Empty = z
934 foldlTree f z (Single x) = z `f` x
935 foldlTree f z (Deep _ pr m sf) =
936 foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
938 foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
939 foldlDigit f z (One a) = z `f` a
940 foldlDigit f z (Two a b) = (z `f` a) `f` b
941 foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c
942 foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
944 foldlNode :: (a -> b -> a) -> a -> Node b -> a
945 foldlNode f z (Node2 _ a b) = (z `f` a) `f` b
946 foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
948 -- | /O(n*t)/. A variant of 'foldl' that has no base case,
949 -- and thus may only be applied to non-empty sequences.
950 foldl1 :: (a -> a -> a) -> Seq a -> a
951 foldl1 f (Seq xs) = getElem (foldl1Tree f' xs)
952 where f' (Elem x) (Elem y) = Elem (f x y)
954 foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
955 foldl1Tree _ Empty = error "foldl1: empty sequence"
956 foldl1Tree _ (Single x) = x
957 foldl1Tree f (Deep _ pr m sf) =
958 foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf
960 foldl1Digit :: (a -> a -> a) -> Digit a -> a
961 foldl1Digit f (One a) = a
962 foldl1Digit f (Two a b) = a `f` b
963 foldl1Digit f (Three a b c) = (a `f` b) `f` c
964 foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d
966 ------------------------------------------------------------------------
968 ------------------------------------------------------------------------
970 -- | /O(n*t)/. Fold over the elements of a sequence,
971 -- associating to the right, but strictly.
972 foldr' :: (a -> b -> b) -> b -> Seq a -> b
973 foldr' f z xs = foldl f' id xs z
974 where f' k x z = k $! f x z
976 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
977 -- associating to the right, i.e. from right to left.
978 foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
979 foldrM f z xs = foldl f' return xs z
980 where f' k x z = f x z >>= k
982 -- | /O(n*t)/. Fold over the elements of a sequence,
983 -- associating to the left, but strictly.
984 foldl' :: (a -> b -> a) -> a -> Seq b -> a
985 foldl' f z xs = foldr f' id xs z
986 where f' x k z = k $! f z x
988 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
989 -- associating to the left, i.e. from left to right.
990 foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
991 foldlM f z xs = foldr f' return xs z
992 where f' x k z = f z x >>= k
994 ------------------------------------------------------------------------
996 ------------------------------------------------------------------------
998 -- | /O(n)/. The reverse of a sequence.
999 reverse :: Seq a -> Seq a
1000 reverse (Seq xs) = Seq (reverseTree id xs)
1002 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1003 reverseTree _ Empty = Empty
1004 reverseTree f (Single x) = Single (f x)
1005 reverseTree f (Deep s pr m sf) =
1006 Deep s (reverseDigit f sf)
1007 (reverseTree (reverseNode f) m)
1010 reverseDigit :: (a -> a) -> Digit a -> Digit a
1011 reverseDigit f (One a) = One (f a)
1012 reverseDigit f (Two a b) = Two (f b) (f a)
1013 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1014 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1016 reverseNode :: (a -> a) -> Node a -> Node a
1017 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1018 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1022 ------------------------------------------------------------------------
1024 ------------------------------------------------------------------------
1026 instance Arbitrary a => Arbitrary (Seq a) where
1027 arbitrary = liftM Seq arbitrary
1028 coarbitrary (Seq x) = coarbitrary x
1030 instance Arbitrary a => Arbitrary (Elem a) where
1031 arbitrary = liftM Elem arbitrary
1032 coarbitrary (Elem x) = coarbitrary x
1034 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1035 arbitrary = sized arb
1036 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1037 arb 0 = return Empty
1038 arb 1 = liftM Single arbitrary
1039 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1041 coarbitrary Empty = variant 0
1042 coarbitrary (Single x) = variant 1 . coarbitrary x
1043 coarbitrary (Deep _ pr m sf) =
1044 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1046 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1048 liftM2 node2 arbitrary arbitrary,
1049 liftM3 node3 arbitrary arbitrary arbitrary]
1051 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1052 coarbitrary (Node3 _ a b c) =
1053 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1055 instance Arbitrary a => Arbitrary (Digit a) where
1057 liftM One arbitrary,
1058 liftM2 Two arbitrary arbitrary,
1059 liftM3 Three arbitrary arbitrary arbitrary,
1060 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1062 coarbitrary (One a) = variant 0 . coarbitrary a
1063 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1064 coarbitrary (Three a b c) =
1065 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1066 coarbitrary (Four a b c d) =
1067 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1069 ------------------------------------------------------------------------
1071 ------------------------------------------------------------------------
1076 instance Valid (Elem a) where
1079 instance Valid (Seq a) where
1080 valid (Seq xs) = valid xs
1082 instance (Sized a, Valid a) => Valid (FingerTree a) where
1084 valid (Single x) = valid x
1085 valid (Deep s pr m sf) =
1086 s == size pr + size m + size sf && valid pr && valid m && valid sf
1088 instance (Sized a, Valid a) => Valid (Node a) where
1089 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1090 valid (Node3 s a b c) =
1091 s == size a + size b + size c && valid a && valid b && valid c
1093 instance Valid a => Valid (Digit a) where
1094 valid (One a) = valid a
1095 valid (Two a b) = valid a && valid b
1096 valid (Three a b c) = valid a && valid b && valid c
1097 valid (Four a b c d) = valid a && valid b && valid c && valid d