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 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
183 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
184 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
185 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
198 instance Functor Digit where
199 fmap f (One a) = One (f a)
200 fmap f (Two a b) = Two (f a) (f b)
201 fmap f (Three a b c) = Three (f a) (f b) (f c)
202 fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)
204 instance Sized a => Sized (Digit a) where
205 size xs = foldlDigit (\ i x -> i + size x) 0 xs
207 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
208 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
209 digitToTree :: Sized a => Digit a -> FingerTree a
210 digitToTree (One a) = Single a
211 digitToTree (Two a b) = deep (One a) Empty (One b)
212 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
213 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
218 = Node2 {-# UNPACK #-} !Int a a
219 | Node3 {-# UNPACK #-} !Int a a a
224 instance Functor (Node) where
225 fmap f (Node2 v a b) = Node2 v (f a) (f b)
226 fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
228 instance Sized (Node a) where
229 size (Node2 v _ _) = v
230 size (Node3 v _ _ _) = v
233 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
234 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
235 node2 :: Sized a => a -> a -> Node a
236 node2 a b = Node2 (size a + size b) a b
239 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
240 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
241 node3 :: Sized a => a -> a -> a -> Node a
242 node3 a b c = Node3 (size a + size b + size c) a b c
244 nodeToDigit :: Node a -> Digit a
245 nodeToDigit (Node2 _ a b) = Two a b
246 nodeToDigit (Node3 _ a b c) = Three a b c
250 newtype Elem a = Elem { getElem :: a }
252 instance Sized (Elem a) where
255 instance Functor Elem where
256 fmap f (Elem x) = Elem (f x)
259 instance (Show a) => Show (Elem a) where
260 showsPrec p (Elem x) = showsPrec p x
263 ------------------------------------------------------------------------
265 ------------------------------------------------------------------------
267 -- | /O(1)/. The empty sequence.
271 -- | /O(1)/. A singleton sequence.
272 singleton :: a -> Seq a
273 singleton x = Seq (Single (Elem x))
275 -- | /O(1)/. Add an element to the left end of a sequence.
276 -- Mnemonic: a triangle with the single element at the pointy end.
277 (<|) :: a -> Seq a -> Seq a
278 x <| Seq xs = Seq (Elem x `consTree` xs)
280 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
281 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
282 consTree :: Sized a => a -> FingerTree a -> FingerTree a
283 consTree a Empty = Single a
284 consTree a (Single b) = deep (One a) Empty (One b)
285 consTree a (Deep s (Four b c d e) m sf) = m `seq`
286 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
287 consTree a (Deep s (Three b c d) m sf) =
288 Deep (size a + s) (Four a b c d) m sf
289 consTree a (Deep s (Two b c) m sf) =
290 Deep (size a + s) (Three a b c) m sf
291 consTree a (Deep s (One b) m sf) =
292 Deep (size a + s) (Two a b) m sf
294 -- | /O(1)/. Add an element to the right end of a sequence.
295 -- Mnemonic: a triangle with the single element at the pointy end.
296 (|>) :: Seq a -> a -> Seq a
297 Seq xs |> x = Seq (xs `snocTree` Elem x)
299 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
300 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
301 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
302 snocTree Empty a = Single a
303 snocTree (Single a) b = deep (One a) Empty (One b)
304 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
305 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
306 snocTree (Deep s pr m (Three a b c)) d =
307 Deep (s + size d) pr m (Four a b c d)
308 snocTree (Deep s pr m (Two a b)) c =
309 Deep (s + size c) pr m (Three a b c)
310 snocTree (Deep s pr m (One a)) b =
311 Deep (s + size b) pr m (Two a b)
313 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
314 (><) :: Seq a -> Seq a -> Seq a
315 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
317 -- The appendTree/addDigits gunk below is machine generated
319 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
320 appendTree0 Empty xs =
322 appendTree0 xs Empty =
324 appendTree0 (Single x) xs =
326 appendTree0 xs (Single x) =
328 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
329 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
331 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
332 addDigits0 m1 (One a) (One b) m2 =
333 appendTree1 m1 (node2 a b) m2
334 addDigits0 m1 (One a) (Two b c) m2 =
335 appendTree1 m1 (node3 a b c) m2
336 addDigits0 m1 (One a) (Three b c d) m2 =
337 appendTree2 m1 (node2 a b) (node2 c d) m2
338 addDigits0 m1 (One a) (Four b c d e) m2 =
339 appendTree2 m1 (node3 a b c) (node2 d e) m2
340 addDigits0 m1 (Two a b) (One c) m2 =
341 appendTree1 m1 (node3 a b c) m2
342 addDigits0 m1 (Two a b) (Two c d) m2 =
343 appendTree2 m1 (node2 a b) (node2 c d) m2
344 addDigits0 m1 (Two a b) (Three c d e) m2 =
345 appendTree2 m1 (node3 a b c) (node2 d e) m2
346 addDigits0 m1 (Two a b) (Four c d e f) m2 =
347 appendTree2 m1 (node3 a b c) (node3 d e f) m2
348 addDigits0 m1 (Three a b c) (One d) m2 =
349 appendTree2 m1 (node2 a b) (node2 c d) m2
350 addDigits0 m1 (Three a b c) (Two d e) m2 =
351 appendTree2 m1 (node3 a b c) (node2 d e) m2
352 addDigits0 m1 (Three a b c) (Three d e f) m2 =
353 appendTree2 m1 (node3 a b c) (node3 d e f) m2
354 addDigits0 m1 (Three a b c) (Four d 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) (One e) m2 =
357 appendTree2 m1 (node3 a b c) (node2 d e) m2
358 addDigits0 m1 (Four a b c d) (Two e f) m2 =
359 appendTree2 m1 (node3 a b c) (node3 d e f) m2
360 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
361 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
362 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
363 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
365 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
366 appendTree1 Empty a xs =
368 appendTree1 xs a Empty =
370 appendTree1 (Single x) a xs =
371 x `consTree` a `consTree` xs
372 appendTree1 xs a (Single x) =
373 xs `snocTree` a `snocTree` x
374 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
375 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
377 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
378 addDigits1 m1 (One a) b (One c) m2 =
379 appendTree1 m1 (node3 a b c) m2
380 addDigits1 m1 (One a) b (Two c d) m2 =
381 appendTree2 m1 (node2 a b) (node2 c d) m2
382 addDigits1 m1 (One a) b (Three c d e) m2 =
383 appendTree2 m1 (node3 a b c) (node2 d e) m2
384 addDigits1 m1 (One a) b (Four c d e f) m2 =
385 appendTree2 m1 (node3 a b c) (node3 d e f) m2
386 addDigits1 m1 (Two a b) c (One d) m2 =
387 appendTree2 m1 (node2 a b) (node2 c d) m2
388 addDigits1 m1 (Two a b) c (Two d e) m2 =
389 appendTree2 m1 (node3 a b c) (node2 d e) m2
390 addDigits1 m1 (Two a b) c (Three d e f) m2 =
391 appendTree2 m1 (node3 a b c) (node3 d e f) m2
392 addDigits1 m1 (Two a b) c (Four d 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 (One e) m2 =
395 appendTree2 m1 (node3 a b c) (node2 d e) m2
396 addDigits1 m1 (Three a b c) d (Two e f) m2 =
397 appendTree2 m1 (node3 a b c) (node3 d e f) m2
398 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
399 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
400 addDigits1 m1 (Three a b c) d (Four e 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 (One f) m2 =
403 appendTree2 m1 (node3 a b c) (node3 d e f) m2
404 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
405 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
406 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
407 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
408 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
409 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
411 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
412 appendTree2 Empty a b xs =
413 a `consTree` b `consTree` xs
414 appendTree2 xs a b Empty =
415 xs `snocTree` a `snocTree` b
416 appendTree2 (Single x) a b xs =
417 x `consTree` a `consTree` b `consTree` xs
418 appendTree2 xs a b (Single x) =
419 xs `snocTree` a `snocTree` b `snocTree` x
420 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
421 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
423 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
424 addDigits2 m1 (One a) b c (One d) m2 =
425 appendTree2 m1 (node2 a b) (node2 c d) m2
426 addDigits2 m1 (One a) b c (Two d e) m2 =
427 appendTree2 m1 (node3 a b c) (node2 d e) m2
428 addDigits2 m1 (One a) b c (Three d e f) m2 =
429 appendTree2 m1 (node3 a b c) (node3 d e f) m2
430 addDigits2 m1 (One a) b c (Four d 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 (One e) m2 =
433 appendTree2 m1 (node3 a b c) (node2 d e) m2
434 addDigits2 m1 (Two a b) c d (Two e f) m2 =
435 appendTree2 m1 (node3 a b c) (node3 d e f) m2
436 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
437 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
438 addDigits2 m1 (Two a b) c d (Four e 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 (One f) m2 =
441 appendTree2 m1 (node3 a b c) (node3 d e f) m2
442 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
443 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
444 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
445 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
446 addDigits2 m1 (Three a b c) d e (Four f 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 (One g) m2 =
449 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
450 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
451 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
452 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
453 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
454 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
455 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
457 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
458 appendTree3 Empty a b c xs =
459 a `consTree` b `consTree` c `consTree` xs
460 appendTree3 xs a b c Empty =
461 xs `snocTree` a `snocTree` b `snocTree` c
462 appendTree3 (Single x) a b c xs =
463 x `consTree` a `consTree` b `consTree` c `consTree` xs
464 appendTree3 xs a b c (Single x) =
465 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
466 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
467 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
469 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))
470 addDigits3 m1 (One a) b c d (One e) m2 =
471 appendTree2 m1 (node3 a b c) (node2 d e) m2
472 addDigits3 m1 (One a) b c d (Two e f) m2 =
473 appendTree2 m1 (node3 a b c) (node3 d e f) m2
474 addDigits3 m1 (One a) b c d (Three e f g) m2 =
475 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
476 addDigits3 m1 (One a) b c d (Four e 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 (One f) m2 =
479 appendTree2 m1 (node3 a b c) (node3 d e f) m2
480 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
481 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
482 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
483 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
484 addDigits3 m1 (Two a b) c d e (Four f 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 (One g) m2 =
487 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
488 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
489 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
490 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
491 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
492 addDigits3 m1 (Three a b c) d e f (Four g 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 (One h) m2 =
495 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
496 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
497 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
498 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
499 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
500 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
501 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
503 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
504 appendTree4 Empty a b c d xs =
505 a `consTree` b `consTree` c `consTree` d `consTree` xs
506 appendTree4 xs a b c d Empty =
507 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
508 appendTree4 (Single x) a b c d xs =
509 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
510 appendTree4 xs a b c d (Single x) =
511 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
512 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
513 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
515 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))
516 addDigits4 m1 (One a) b c d e (One f) m2 =
517 appendTree2 m1 (node3 a b c) (node3 d e f) m2
518 addDigits4 m1 (One a) b c d e (Two f g) m2 =
519 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
520 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
521 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
522 addDigits4 m1 (One a) b c d e (Four f 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 (One g) m2 =
525 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
526 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
527 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
528 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
529 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
530 addDigits4 m1 (Two a b) c d e f (Four g 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 (One h) m2 =
533 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
534 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
535 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
536 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
537 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
538 addDigits4 m1 (Three a b c) d e f g (Four h 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 (One i) m2 =
541 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
542 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
543 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
544 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
545 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
546 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
547 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
549 ------------------------------------------------------------------------
551 ------------------------------------------------------------------------
553 -- | /O(1)/. Is this the empty sequence?
554 null :: Seq a -> Bool
555 null (Seq Empty) = True
558 -- | /O(1)/. The number of elements in the sequence.
559 length :: Seq a -> Int
560 length (Seq xs) = size xs
564 data Maybe2 a b = Nothing2 | Just2 a b
566 -- | View of the left end of a sequence.
568 = EmptyL -- ^ empty sequence
569 | a :< Seq a -- ^ leftmost element and the rest of the sequence
573 instance Eq a => Eq (ViewL a)
574 instance Show a => Show (ViewL a)
578 instance Functor ViewL where
579 fmap _ EmptyL = EmptyL
580 fmap f (x :< xs) = f x :< fmap f xs
582 -- | /O(1)/. Analyse the left end of a sequence.
583 viewl :: Seq a -> ViewL a
584 viewl (Seq xs) = case viewLTree xs of
586 Just2 (Elem x) xs' -> x :< Seq xs'
588 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
589 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
590 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
591 viewLTree Empty = Nothing2
592 viewLTree (Single a) = Just2 a Empty
593 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
594 Nothing2 -> digitToTree sf
595 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
596 viewLTree (Deep s (Two a b) m sf) =
597 Just2 a (Deep (s - size a) (One b) m sf)
598 viewLTree (Deep s (Three a b c) m sf) =
599 Just2 a (Deep (s - size a) (Two b c) m sf)
600 viewLTree (Deep s (Four a b c d) m sf) =
601 Just2 a (Deep (s - size a) (Three b c d) m sf)
603 -- | View of the right end of a sequence.
605 = EmptyR -- ^ empty sequence
606 | Seq a :> a -- ^ the sequence minus the rightmost element,
607 -- and the rightmost element
611 instance Eq a => Eq (ViewR a)
612 instance Show a => Show (ViewR a)
615 instance Functor ViewR where
616 fmap _ EmptyR = EmptyR
617 fmap f (xs :> x) = fmap f xs :> f x
619 -- | /O(1)/. Analyse the right end of a sequence.
620 viewr :: Seq a -> ViewR a
621 viewr (Seq xs) = case viewRTree xs of
623 Just2 xs' (Elem x) -> Seq xs' :> x
625 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
626 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
627 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
628 viewRTree Empty = Nothing2
629 viewRTree (Single z) = Just2 Empty z
630 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
631 Nothing2 -> digitToTree pr
632 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
633 viewRTree (Deep s pr m (Two y z)) =
634 Just2 (Deep (s - size z) pr m (One y)) z
635 viewRTree (Deep s pr m (Three x y z)) =
636 Just2 (Deep (s - size z) pr m (Two x y)) z
637 viewRTree (Deep s pr m (Four w x y z)) =
638 Just2 (Deep (s - size z) pr m (Three w x y)) z
642 -- | /O(log(min(i,n-i)))/. The element at the specified position
643 index :: Seq a -> Int -> a
645 | 0 <= i && i < size xs = case lookupTree (-i) xs of
646 Place _ (Elem x) -> x
647 | otherwise = error "index out of bounds"
649 data Place a = Place {-# UNPACK #-} !Int a
654 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
655 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
656 lookupTree :: Sized a => Int -> FingerTree a -> Place a
657 lookupTree _ Empty = error "lookupTree of empty tree"
658 lookupTree i (Single x) = Place i x
659 lookupTree i (Deep _ pr m sf)
660 | vpr > 0 = lookupDigit i pr
661 | vm > 0 = case lookupTree vpr m of
662 Place i' xs -> lookupNode i' xs
663 | otherwise = lookupDigit vm sf
664 where vpr = i + size pr
667 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
668 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
669 lookupNode :: Sized a => Int -> Node a -> Place a
670 lookupNode i (Node2 _ a b)
672 | otherwise = Place va b
673 where va = i + size a
674 lookupNode i (Node3 _ a b c)
676 | vab > 0 = Place va b
677 | otherwise = Place vab c
678 where va = i + size a
681 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
682 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
683 lookupDigit :: Sized a => Int -> Digit a -> Place a
684 lookupDigit i (One a) = Place i a
685 lookupDigit i (Two a b)
687 | otherwise = Place va b
688 where va = i + size a
689 lookupDigit i (Three a b c)
691 | vab > 0 = Place va b
692 | otherwise = Place vab c
693 where va = i + size a
695 lookupDigit i (Four a b c d)
697 | vab > 0 = Place va b
698 | vabc > 0 = Place vab c
699 | otherwise = Place vabc d
700 where va = i + size a
704 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
705 update :: Int -> a -> Seq a -> Seq a
706 update i x = adjust (const x) i
708 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
709 adjust :: (a -> a) -> Int -> Seq a -> Seq a
711 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
714 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
715 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
716 adjustTree :: Sized a => (Int -> a -> a) ->
717 Int -> FingerTree a -> FingerTree a
718 adjustTree _ _ Empty = error "adjustTree of empty tree"
719 adjustTree f i (Single x) = Single (f i x)
720 adjustTree f i (Deep s pr m sf)
721 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
722 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
723 | otherwise = Deep s pr m (adjustDigit f vm sf)
724 where vpr = i + size pr
727 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
728 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
729 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
730 adjustNode f i (Node2 s a b)
731 | va > 0 = Node2 s (f i a) b
732 | otherwise = Node2 s a (f va b)
733 where va = i + size a
734 adjustNode f i (Node3 s a b c)
735 | va > 0 = Node3 s (f i a) b c
736 | vab > 0 = Node3 s a (f va b) c
737 | otherwise = Node3 s a b (f vab c)
738 where va = i + size a
741 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
742 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
743 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
744 adjustDigit f i (One a) = One (f i a)
745 adjustDigit f i (Two a b)
746 | va > 0 = Two (f i a) b
747 | otherwise = Two a (f va b)
748 where va = i + size a
749 adjustDigit f i (Three a b c)
750 | va > 0 = Three (f i a) b c
751 | vab > 0 = Three a (f va b) c
752 | otherwise = Three a b (f vab c)
753 where va = i + size a
755 adjustDigit f i (Four a b c d)
756 | va > 0 = Four (f i a) b c d
757 | vab > 0 = Four a (f va b) c d
758 | vabc > 0 = Four a b (f vab c) d
759 | otherwise = Four a b c (f vabc d)
760 where va = i + size a
766 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
767 take :: Int -> Seq a -> Seq a
768 take i = fst . splitAt i
770 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
771 drop :: Int -> Seq a -> Seq a
772 drop i = snd . splitAt i
774 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
775 splitAt :: Int -> Seq a -> (Seq a, Seq a)
776 splitAt i (Seq xs) = (Seq l, Seq r)
777 where (l, r) = split i xs
779 split :: Int -> FingerTree (Elem a) ->
780 (FingerTree (Elem a), FingerTree (Elem a))
781 split i Empty = i `seq` (Empty, Empty)
783 | size xs > i = (l, consTree x r)
784 | otherwise = (xs, Empty)
785 where Split l x r = splitTree (-i) xs
787 data Split t a = Split t a t
792 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
793 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
794 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
795 splitTree _ Empty = error "splitTree of empty tree"
796 splitTree i (Single x) = i `seq` Split Empty x Empty
797 splitTree i (Deep _ pr m sf)
798 | vpr > 0 = case splitDigit i pr of
799 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
800 | vm > 0 = case splitTree vpr m of
801 Split ml xs mr -> case splitNode (vpr + size ml) xs of
802 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
803 | otherwise = case splitDigit vm sf of
804 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
805 where vpr = i + size pr
808 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
809 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
810 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
811 deepL Nothing m sf = case viewLTree m of
812 Nothing2 -> digitToTree sf
813 Just2 a m' -> deep (nodeToDigit a) m' sf
814 deepL (Just pr) m sf = deep pr m sf
816 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
817 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
818 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
819 deepR pr m Nothing = case viewRTree m of
820 Nothing2 -> digitToTree pr
821 Just2 m' a -> deep pr m' (nodeToDigit a)
822 deepR pr m (Just sf) = deep pr m sf
824 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
825 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
826 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
827 splitNode i (Node2 _ a b)
828 | va > 0 = Split Nothing a (Just (One b))
829 | otherwise = Split (Just (One a)) b Nothing
830 where va = i + size a
831 splitNode i (Node3 _ a b c)
832 | va > 0 = Split Nothing a (Just (Two b c))
833 | vab > 0 = Split (Just (One a)) b (Just (One c))
834 | otherwise = Split (Just (Two a b)) c Nothing
835 where va = i + size a
838 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
839 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
840 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
841 splitDigit i (One a) = i `seq` Split Nothing a Nothing
842 splitDigit i (Two a b)
843 | va > 0 = Split Nothing a (Just (One b))
844 | otherwise = Split (Just (One a)) b Nothing
845 where va = i + size a
846 splitDigit i (Three a b c)
847 | va > 0 = Split Nothing a (Just (Two b c))
848 | vab > 0 = Split (Just (One a)) b (Just (One c))
849 | otherwise = Split (Just (Two a b)) c Nothing
850 where va = i + size a
852 splitDigit i (Four a b c d)
853 | va > 0 = Split Nothing a (Just (Three b c d))
854 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
855 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
856 | otherwise = Split (Just (Three a b c)) d Nothing
857 where va = i + size a
861 ------------------------------------------------------------------------
863 ------------------------------------------------------------------------
865 -- | /O(n)/. Create a sequence from a finite list of elements.
866 fromList :: [a] -> Seq a
867 fromList = Data.List.foldl' (|>) empty
869 -- | /O(n)/. List of elements of the sequence.
870 toList :: Seq a -> [a]
871 toList = foldr (:) []
873 ------------------------------------------------------------------------
875 ------------------------------------------------------------------------
877 -- | /O(n*t)/. Fold over the elements of a sequence,
878 -- associating to the right.
879 foldr :: (a -> b -> b) -> b -> Seq a -> b
880 foldr f z (Seq xs) = foldrTree f' z xs
881 where f' (Elem x) y = f x y
883 foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
884 foldrTree _ z Empty = z
885 foldrTree f z (Single x) = x `f` z
886 foldrTree f z (Deep _ pr m sf) =
887 foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr
889 foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
890 foldrDigit f z (One a) = a `f` z
891 foldrDigit f z (Two a b) = a `f` (b `f` z)
892 foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z))
893 foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
895 foldrNode :: (a -> b -> b) -> b -> Node a -> b
896 foldrNode f z (Node2 _ a b) = a `f` (b `f` z)
897 foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
899 -- | /O(n*t)/. A variant of 'foldr' that has no base case,
900 -- and thus may only be applied to non-empty sequences.
901 foldr1 :: (a -> a -> a) -> Seq a -> a
902 foldr1 f (Seq xs) = getElem (foldr1Tree f' xs)
903 where f' (Elem x) (Elem y) = Elem (f x y)
905 foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
906 foldr1Tree _ Empty = error "foldr1: empty sequence"
907 foldr1Tree _ (Single x) = x
908 foldr1Tree f (Deep _ pr m sf) =
909 foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr
911 foldr1Digit :: (a -> a -> a) -> Digit a -> a
912 foldr1Digit f (One a) = a
913 foldr1Digit f (Two a b) = a `f` b
914 foldr1Digit f (Three a b c) = a `f` (b `f` c)
915 foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d))
917 -- | /O(n*t)/. Fold over the elements of a sequence,
918 -- associating to the left.
919 foldl :: (a -> b -> a) -> a -> Seq b -> a
920 foldl f z (Seq xs) = foldlTree f' z xs
921 where f' x (Elem y) = f x y
923 foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
924 foldlTree _ z Empty = z
925 foldlTree f z (Single x) = z `f` x
926 foldlTree f z (Deep _ pr m sf) =
927 foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
929 foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
930 foldlDigit f z (One a) = z `f` a
931 foldlDigit f z (Two a b) = (z `f` a) `f` b
932 foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c
933 foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
935 foldlNode :: (a -> b -> a) -> a -> Node b -> a
936 foldlNode f z (Node2 _ a b) = (z `f` a) `f` b
937 foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
939 -- | /O(n*t)/. A variant of 'foldl' that has no base case,
940 -- and thus may only be applied to non-empty sequences.
941 foldl1 :: (a -> a -> a) -> Seq a -> a
942 foldl1 f (Seq xs) = getElem (foldl1Tree f' xs)
943 where f' (Elem x) (Elem y) = Elem (f x y)
945 foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
946 foldl1Tree _ Empty = error "foldl1: empty sequence"
947 foldl1Tree _ (Single x) = x
948 foldl1Tree f (Deep _ pr m sf) =
949 foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf
951 foldl1Digit :: (a -> a -> a) -> Digit a -> a
952 foldl1Digit f (One a) = a
953 foldl1Digit f (Two a b) = a `f` b
954 foldl1Digit f (Three a b c) = (a `f` b) `f` c
955 foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d
957 ------------------------------------------------------------------------
959 ------------------------------------------------------------------------
961 -- | /O(n*t)/. Fold over the elements of a sequence,
962 -- associating to the right, but strictly.
963 foldr' :: (a -> b -> b) -> b -> Seq a -> b
964 foldr' f z xs = foldl f' id xs z
965 where f' k x z = k $! f x z
967 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
968 -- associating to the right, i.e. from right to left.
969 foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
970 foldrM f z xs = foldl f' return xs z
971 where f' k x z = f x z >>= k
973 -- | /O(n*t)/. Fold over the elements of a sequence,
974 -- associating to the left, but strictly.
975 foldl' :: (a -> b -> a) -> a -> Seq b -> a
976 foldl' f z xs = foldr f' id xs z
977 where f' x k z = k $! f z x
979 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
980 -- associating to the left, i.e. from left to right.
981 foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
982 foldlM f z xs = foldr f' return xs z
983 where f' x k z = f z x >>= k
985 ------------------------------------------------------------------------
987 ------------------------------------------------------------------------
989 -- | /O(n)/. The reverse of a sequence.
990 reverse :: Seq a -> Seq a
991 reverse (Seq xs) = Seq (reverseTree id xs)
993 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
994 reverseTree _ Empty = Empty
995 reverseTree f (Single x) = Single (f x)
996 reverseTree f (Deep s pr m sf) =
997 Deep s (reverseDigit f sf)
998 (reverseTree (reverseNode f) m)
1001 reverseDigit :: (a -> a) -> Digit a -> Digit a
1002 reverseDigit f (One a) = One (f a)
1003 reverseDigit f (Two a b) = Two (f b) (f a)
1004 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1005 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1007 reverseNode :: (a -> a) -> Node a -> Node a
1008 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1009 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1013 ------------------------------------------------------------------------
1015 ------------------------------------------------------------------------
1017 instance Arbitrary a => Arbitrary (Seq a) where
1018 arbitrary = liftM Seq arbitrary
1019 coarbitrary (Seq x) = coarbitrary x
1021 instance Arbitrary a => Arbitrary (Elem a) where
1022 arbitrary = liftM Elem arbitrary
1023 coarbitrary (Elem x) = coarbitrary x
1025 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1026 arbitrary = sized arb
1027 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1028 arb 0 = return Empty
1029 arb 1 = liftM Single arbitrary
1030 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1032 coarbitrary Empty = variant 0
1033 coarbitrary (Single x) = variant 1 . coarbitrary x
1034 coarbitrary (Deep _ pr m sf) =
1035 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1037 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1039 liftM2 node2 arbitrary arbitrary,
1040 liftM3 node3 arbitrary arbitrary arbitrary]
1042 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1043 coarbitrary (Node3 _ a b c) =
1044 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1046 instance Arbitrary a => Arbitrary (Digit a) where
1048 liftM One arbitrary,
1049 liftM2 Two arbitrary arbitrary,
1050 liftM3 Three arbitrary arbitrary arbitrary,
1051 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1053 coarbitrary (One a) = variant 0 . coarbitrary a
1054 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1055 coarbitrary (Three a b c) =
1056 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1057 coarbitrary (Four a b c d) =
1058 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1060 ------------------------------------------------------------------------
1062 ------------------------------------------------------------------------
1067 instance Valid (Elem a) where
1070 instance Valid (Seq a) where
1071 valid (Seq xs) = valid xs
1073 instance (Sized a, Valid a) => Valid (FingerTree a) where
1075 valid (Single x) = valid x
1076 valid (Deep s pr m sf) =
1077 s == size pr + size m + size sf && valid pr && valid m && valid sf
1079 instance (Sized a, Valid a) => Valid (Node a) where
1080 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1081 valid (Node3 s a b c) =
1082 s == size a + size b + size c && valid a && valid b && valid c
1084 instance Valid a => Valid (Digit a) where
1085 valid (One a) = valid a
1086 valid (Two a b) = valid a && valid b
1087 valid (Three a b c) = valid a && valid b && valid c
1088 valid (Four a b c d) = valid a && valid b && valid c && valid d