2 -----------------------------------------------------------------------------
4 -- Module : Data.Sequence
5 -- Copyright : (c) Ross Paterson 2005
7 -- Maintainer : ross@soi.city.ac.uk
8 -- Stability : experimental
9 -- Portability : portable
11 -- General purpose finite sequences.
12 -- Apart from being finite and having strict operations, sequences
13 -- also differ from lists in supporting a wider variety of operations
16 -- An amortized running time is given for each operation, with /n/ referring
17 -- to the length of the sequence and /i/ being the integral index used by
18 -- some operations. These bounds hold even in a persistent (shared) setting.
20 -- The implementation uses 2-3 finger trees annotated with sizes,
21 -- as described in section 4.2 of
23 -- * Ralf Hinze and Ross Paterson,
24 -- \"Finger trees: a simple general-purpose data structure\",
25 -- to appear in /Journal of Functional Programming/.
26 -- <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
28 -- /Note/: Many of these operations have the same names as similar
29 -- operations on lists in the "Prelude". The ambiguity may be resolved
30 -- using either qualification or the @hiding@ clause.
32 -----------------------------------------------------------------------------
34 module Data.Sequence (
38 singleton, -- :: a -> Seq a
39 (<|), -- :: a -> Seq a -> Seq a
40 (|>), -- :: Seq a -> a -> Seq a
41 (><), -- :: Seq a -> Seq a -> Seq a
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
180 {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
181 {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
183 size (Single x) = size x
184 size (Deep v _ _ _) = v
186 instance Functor FingerTree where
188 fmap f (Single x) = Single (f x)
189 fmap f (Deep v pr m sf) =
190 Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
193 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
194 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
195 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
196 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
209 instance Functor Digit where
210 fmap f (One a) = One (f a)
211 fmap f (Two a b) = Two (f a) (f b)
212 fmap f (Three a b c) = Three (f a) (f b) (f c)
213 fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)
215 instance Sized a => Sized (Digit a) where
216 {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
217 {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
218 size xs = foldlDigit (\ i x -> i + size x) 0 xs
220 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
221 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
222 digitToTree :: Sized a => Digit a -> FingerTree a
223 digitToTree (One a) = Single a
224 digitToTree (Two a b) = deep (One a) Empty (One b)
225 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
226 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
231 = Node2 {-# UNPACK #-} !Int a a
232 | Node3 {-# UNPACK #-} !Int a a a
237 instance Functor (Node) where
238 fmap f (Node2 v a b) = Node2 v (f a) (f b)
239 fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
241 instance Sized (Node a) where
242 size (Node2 v _ _) = v
243 size (Node3 v _ _ _) = v
246 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
247 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
248 node2 :: Sized a => a -> a -> Node a
249 node2 a b = Node2 (size a + size b) a b
252 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
253 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
254 node3 :: Sized a => a -> a -> a -> Node a
255 node3 a b c = Node3 (size a + size b + size c) a b c
257 nodeToDigit :: Node a -> Digit a
258 nodeToDigit (Node2 _ a b) = Two a b
259 nodeToDigit (Node3 _ a b c) = Three a b c
263 newtype Elem a = Elem { getElem :: a }
265 instance Sized (Elem a) where
268 instance Functor Elem where
269 fmap f (Elem x) = Elem (f x)
272 instance (Show a) => Show (Elem a) where
273 showsPrec p (Elem x) = showsPrec p x
276 ------------------------------------------------------------------------
278 ------------------------------------------------------------------------
280 -- | /O(1)/. The empty sequence.
284 -- | /O(1)/. A singleton sequence.
285 singleton :: a -> Seq a
286 singleton x = Seq (Single (Elem x))
288 -- | /O(1)/. Add an element to the left end of a sequence.
289 -- Mnemonic: a triangle with the single element at the pointy end.
290 (<|) :: a -> Seq a -> Seq a
291 x <| Seq xs = Seq (Elem x `consTree` xs)
293 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
294 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
295 consTree :: Sized a => a -> FingerTree a -> FingerTree a
296 consTree a Empty = Single a
297 consTree a (Single b) = deep (One a) Empty (One b)
298 consTree a (Deep s (Four b c d e) m sf) = m `seq`
299 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
300 consTree a (Deep s (Three b c d) m sf) =
301 Deep (size a + s) (Four a b c d) m sf
302 consTree a (Deep s (Two b c) m sf) =
303 Deep (size a + s) (Three a b c) m sf
304 consTree a (Deep s (One b) m sf) =
305 Deep (size a + s) (Two a b) m sf
307 -- | /O(1)/. Add an element to the right end of a sequence.
308 -- Mnemonic: a triangle with the single element at the pointy end.
309 (|>) :: Seq a -> a -> Seq a
310 Seq xs |> x = Seq (xs `snocTree` Elem x)
312 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
313 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
314 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
315 snocTree Empty a = Single a
316 snocTree (Single a) b = deep (One a) Empty (One b)
317 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
318 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
319 snocTree (Deep s pr m (Three a b c)) d =
320 Deep (s + size d) pr m (Four a b c d)
321 snocTree (Deep s pr m (Two a b)) c =
322 Deep (s + size c) pr m (Three a b c)
323 snocTree (Deep s pr m (One a)) b =
324 Deep (s + size b) pr m (Two a b)
326 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
327 (><) :: Seq a -> Seq a -> Seq a
328 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
330 -- The appendTree/addDigits gunk below is machine generated
332 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
333 appendTree0 Empty xs =
335 appendTree0 xs Empty =
337 appendTree0 (Single x) xs =
339 appendTree0 xs (Single x) =
341 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
342 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
344 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
345 addDigits0 m1 (One a) (One b) m2 =
346 appendTree1 m1 (node2 a b) m2
347 addDigits0 m1 (One a) (Two b c) m2 =
348 appendTree1 m1 (node3 a b c) m2
349 addDigits0 m1 (One a) (Three b c d) m2 =
350 appendTree2 m1 (node2 a b) (node2 c d) m2
351 addDigits0 m1 (One a) (Four b c d e) m2 =
352 appendTree2 m1 (node3 a b c) (node2 d e) m2
353 addDigits0 m1 (Two a b) (One c) m2 =
354 appendTree1 m1 (node3 a b c) m2
355 addDigits0 m1 (Two a b) (Two c d) m2 =
356 appendTree2 m1 (node2 a b) (node2 c d) m2
357 addDigits0 m1 (Two a b) (Three c d e) m2 =
358 appendTree2 m1 (node3 a b c) (node2 d e) m2
359 addDigits0 m1 (Two a b) (Four c d e f) m2 =
360 appendTree2 m1 (node3 a b c) (node3 d e f) m2
361 addDigits0 m1 (Three a b c) (One d) m2 =
362 appendTree2 m1 (node2 a b) (node2 c d) m2
363 addDigits0 m1 (Three a b c) (Two d e) m2 =
364 appendTree2 m1 (node3 a b c) (node2 d e) m2
365 addDigits0 m1 (Three a b c) (Three d e f) m2 =
366 appendTree2 m1 (node3 a b c) (node3 d e f) m2
367 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
368 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
369 addDigits0 m1 (Four a b c d) (One e) m2 =
370 appendTree2 m1 (node3 a b c) (node2 d e) m2
371 addDigits0 m1 (Four a b c d) (Two e f) m2 =
372 appendTree2 m1 (node3 a b c) (node3 d e f) m2
373 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
374 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
375 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
376 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
378 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
379 appendTree1 Empty a xs =
381 appendTree1 xs a Empty =
383 appendTree1 (Single x) a xs =
384 x `consTree` a `consTree` xs
385 appendTree1 xs a (Single x) =
386 xs `snocTree` a `snocTree` x
387 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
388 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
390 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
391 addDigits1 m1 (One a) b (One c) m2 =
392 appendTree1 m1 (node3 a b c) m2
393 addDigits1 m1 (One a) b (Two c d) m2 =
394 appendTree2 m1 (node2 a b) (node2 c d) m2
395 addDigits1 m1 (One a) b (Three c d e) m2 =
396 appendTree2 m1 (node3 a b c) (node2 d e) m2
397 addDigits1 m1 (One a) b (Four c d e f) m2 =
398 appendTree2 m1 (node3 a b c) (node3 d e f) m2
399 addDigits1 m1 (Two a b) c (One d) m2 =
400 appendTree2 m1 (node2 a b) (node2 c d) m2
401 addDigits1 m1 (Two a b) c (Two d e) m2 =
402 appendTree2 m1 (node3 a b c) (node2 d e) m2
403 addDigits1 m1 (Two a b) c (Three d e f) m2 =
404 appendTree2 m1 (node3 a b c) (node3 d e f) m2
405 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
406 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
407 addDigits1 m1 (Three a b c) d (One e) m2 =
408 appendTree2 m1 (node3 a b c) (node2 d e) m2
409 addDigits1 m1 (Three a b c) d (Two e f) m2 =
410 appendTree2 m1 (node3 a b c) (node3 d e f) m2
411 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
412 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
413 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
414 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
415 addDigits1 m1 (Four a b c d) e (One f) m2 =
416 appendTree2 m1 (node3 a b c) (node3 d e f) m2
417 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
418 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
419 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
420 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
421 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
422 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
424 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
425 appendTree2 Empty a b xs =
426 a `consTree` b `consTree` xs
427 appendTree2 xs a b Empty =
428 xs `snocTree` a `snocTree` b
429 appendTree2 (Single x) a b xs =
430 x `consTree` a `consTree` b `consTree` xs
431 appendTree2 xs a b (Single x) =
432 xs `snocTree` a `snocTree` b `snocTree` x
433 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
434 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
436 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
437 addDigits2 m1 (One a) b c (One d) m2 =
438 appendTree2 m1 (node2 a b) (node2 c d) m2
439 addDigits2 m1 (One a) b c (Two d e) m2 =
440 appendTree2 m1 (node3 a b c) (node2 d e) m2
441 addDigits2 m1 (One a) b c (Three d e f) m2 =
442 appendTree2 m1 (node3 a b c) (node3 d e f) m2
443 addDigits2 m1 (One a) b c (Four d e f g) m2 =
444 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
445 addDigits2 m1 (Two a b) c d (One e) m2 =
446 appendTree2 m1 (node3 a b c) (node2 d e) m2
447 addDigits2 m1 (Two a b) c d (Two e f) m2 =
448 appendTree2 m1 (node3 a b c) (node3 d e f) m2
449 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
450 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
451 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
452 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
453 addDigits2 m1 (Three a b c) d e (One f) m2 =
454 appendTree2 m1 (node3 a b c) (node3 d e f) m2
455 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
456 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
457 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
458 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
459 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
460 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
461 addDigits2 m1 (Four a b c d) e f (One g) m2 =
462 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
463 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
464 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
465 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
466 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
467 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
468 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
470 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
471 appendTree3 Empty a b c xs =
472 a `consTree` b `consTree` c `consTree` xs
473 appendTree3 xs a b c Empty =
474 xs `snocTree` a `snocTree` b `snocTree` c
475 appendTree3 (Single x) a b c xs =
476 x `consTree` a `consTree` b `consTree` c `consTree` xs
477 appendTree3 xs a b c (Single x) =
478 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
479 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
480 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
482 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))
483 addDigits3 m1 (One a) b c d (One e) m2 =
484 appendTree2 m1 (node3 a b c) (node2 d e) m2
485 addDigits3 m1 (One a) b c d (Two e f) m2 =
486 appendTree2 m1 (node3 a b c) (node3 d e f) m2
487 addDigits3 m1 (One a) b c d (Three e f g) m2 =
488 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
489 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
490 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
491 addDigits3 m1 (Two a b) c d e (One f) m2 =
492 appendTree2 m1 (node3 a b c) (node3 d e f) m2
493 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
494 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
495 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
496 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
497 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
498 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
499 addDigits3 m1 (Three a b c) d e f (One g) m2 =
500 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
501 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
502 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
503 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
504 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
505 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
506 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
507 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
508 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
509 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
510 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
511 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
512 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
513 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
514 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
516 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
517 appendTree4 Empty a b c d xs =
518 a `consTree` b `consTree` c `consTree` d `consTree` xs
519 appendTree4 xs a b c d Empty =
520 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
521 appendTree4 (Single x) a b c d xs =
522 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
523 appendTree4 xs a b c d (Single x) =
524 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
525 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
526 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
528 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))
529 addDigits4 m1 (One a) b c d e (One f) m2 =
530 appendTree2 m1 (node3 a b c) (node3 d e f) m2
531 addDigits4 m1 (One a) b c d e (Two f g) m2 =
532 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
533 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
534 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
535 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
536 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
537 addDigits4 m1 (Two a b) c d e f (One g) m2 =
538 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
539 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
540 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
541 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
542 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
543 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
544 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
545 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
546 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
547 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
548 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
549 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
550 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
551 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
552 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
553 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
554 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
555 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
556 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
557 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
558 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
559 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
560 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
562 ------------------------------------------------------------------------
564 ------------------------------------------------------------------------
566 -- | /O(1)/. Is this the empty sequence?
567 null :: Seq a -> Bool
568 null (Seq Empty) = True
571 -- | /O(1)/. The number of elements in the sequence.
572 length :: Seq a -> Int
573 length (Seq xs) = size xs
577 data Maybe2 a b = Nothing2 | Just2 a b
579 -- | View of the left end of a sequence.
581 = EmptyL -- ^ empty sequence
582 | a :< Seq a -- ^ leftmost element and the rest of the sequence
586 instance Eq a => Eq (ViewL a)
587 instance Show a => Show (ViewL a)
591 instance Functor ViewL where
592 fmap _ EmptyL = EmptyL
593 fmap f (x :< xs) = f x :< fmap f xs
595 -- | /O(1)/. Analyse the left end of a sequence.
596 viewl :: Seq a -> ViewL a
597 viewl (Seq xs) = case viewLTree xs of
599 Just2 (Elem x) xs' -> x :< Seq xs'
601 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
602 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
603 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
604 viewLTree Empty = Nothing2
605 viewLTree (Single a) = Just2 a Empty
606 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
607 Nothing2 -> digitToTree sf
608 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
609 viewLTree (Deep s (Two a b) m sf) =
610 Just2 a (Deep (s - size a) (One b) m sf)
611 viewLTree (Deep s (Three a b c) m sf) =
612 Just2 a (Deep (s - size a) (Two b c) m sf)
613 viewLTree (Deep s (Four a b c d) m sf) =
614 Just2 a (Deep (s - size a) (Three b c d) m sf)
616 -- | View of the right end of a sequence.
618 = EmptyR -- ^ empty sequence
619 | Seq a :> a -- ^ the sequence minus the rightmost element,
620 -- and the rightmost element
624 instance Eq a => Eq (ViewR a)
625 instance Show a => Show (ViewR a)
628 instance Functor ViewR where
629 fmap _ EmptyR = EmptyR
630 fmap f (xs :> x) = fmap f xs :> f x
632 -- | /O(1)/. Analyse the right end of a sequence.
633 viewr :: Seq a -> ViewR a
634 viewr (Seq xs) = case viewRTree xs of
636 Just2 xs' (Elem x) -> Seq xs' :> x
638 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
639 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
640 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
641 viewRTree Empty = Nothing2
642 viewRTree (Single z) = Just2 Empty z
643 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
644 Nothing2 -> digitToTree pr
645 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
646 viewRTree (Deep s pr m (Two y z)) =
647 Just2 (Deep (s - size z) pr m (One y)) z
648 viewRTree (Deep s pr m (Three x y z)) =
649 Just2 (Deep (s - size z) pr m (Two x y)) z
650 viewRTree (Deep s pr m (Four w x y z)) =
651 Just2 (Deep (s - size z) pr m (Three w x y)) z
655 -- | /O(log(min(i,n-i)))/. The element at the specified position
656 index :: Seq a -> Int -> a
658 | 0 <= i && i < size xs = case lookupTree (-i) xs of
659 Place _ (Elem x) -> x
660 | otherwise = error "index out of bounds"
662 data Place a = Place {-# UNPACK #-} !Int a
667 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
668 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
669 lookupTree :: Sized a => Int -> FingerTree a -> Place a
670 lookupTree _ Empty = error "lookupTree of empty tree"
671 lookupTree i (Single x) = Place i x
672 lookupTree i (Deep _ pr m sf)
673 | vpr > 0 = lookupDigit i pr
674 | vm > 0 = case lookupTree vpr m of
675 Place i' xs -> lookupNode i' xs
676 | otherwise = lookupDigit vm sf
677 where vpr = i + size pr
680 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
681 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
682 lookupNode :: Sized a => Int -> Node a -> Place a
683 lookupNode i (Node2 _ a b)
685 | otherwise = Place va b
686 where va = i + size a
687 lookupNode i (Node3 _ a b c)
689 | vab > 0 = Place va b
690 | otherwise = Place vab c
691 where va = i + size a
694 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
695 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
696 lookupDigit :: Sized a => Int -> Digit a -> Place a
697 lookupDigit i (One a) = Place i a
698 lookupDigit i (Two a b)
700 | otherwise = Place va b
701 where va = i + size a
702 lookupDigit i (Three a b c)
704 | vab > 0 = Place va b
705 | otherwise = Place vab c
706 where va = i + size a
708 lookupDigit i (Four a b c d)
710 | vab > 0 = Place va b
711 | vabc > 0 = Place vab c
712 | otherwise = Place vabc d
713 where va = i + size a
717 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
718 update :: Int -> a -> Seq a -> Seq a
719 update i x = adjust (const x) i
721 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
722 adjust :: (a -> a) -> Int -> Seq a -> Seq a
724 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
727 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
728 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
729 adjustTree :: Sized a => (Int -> a -> a) ->
730 Int -> FingerTree a -> FingerTree a
731 adjustTree _ _ Empty = error "adjustTree of empty tree"
732 adjustTree f i (Single x) = Single (f i x)
733 adjustTree f i (Deep s pr m sf)
734 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
735 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
736 | otherwise = Deep s pr m (adjustDigit f vm sf)
737 where vpr = i + size pr
740 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
741 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
742 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
743 adjustNode f i (Node2 s a b)
744 | va > 0 = Node2 s (f i a) b
745 | otherwise = Node2 s a (f va b)
746 where va = i + size a
747 adjustNode f i (Node3 s a b c)
748 | va > 0 = Node3 s (f i a) b c
749 | vab > 0 = Node3 s a (f va b) c
750 | otherwise = Node3 s a b (f vab c)
751 where va = i + size a
754 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
755 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
756 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
757 adjustDigit f i (One a) = One (f i a)
758 adjustDigit f i (Two a b)
759 | va > 0 = Two (f i a) b
760 | otherwise = Two a (f va b)
761 where va = i + size a
762 adjustDigit f i (Three a b c)
763 | va > 0 = Three (f i a) b c
764 | vab > 0 = Three a (f va b) c
765 | otherwise = Three a b (f vab c)
766 where va = i + size a
768 adjustDigit f i (Four a b c d)
769 | va > 0 = Four (f i a) b c d
770 | vab > 0 = Four a (f va b) c d
771 | vabc > 0 = Four a b (f vab c) d
772 | otherwise = Four a b c (f vabc d)
773 where va = i + size a
779 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
780 take :: Int -> Seq a -> Seq a
781 take i = fst . splitAt i
783 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
784 drop :: Int -> Seq a -> Seq a
785 drop i = snd . splitAt i
787 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
788 splitAt :: Int -> Seq a -> (Seq a, Seq a)
789 splitAt i (Seq xs) = (Seq l, Seq r)
790 where (l, r) = split i xs
792 split :: Int -> FingerTree (Elem a) ->
793 (FingerTree (Elem a), FingerTree (Elem a))
794 split i Empty = i `seq` (Empty, Empty)
796 | size xs > i = (l, consTree x r)
797 | otherwise = (xs, Empty)
798 where Split l x r = splitTree (-i) xs
800 data Split t a = Split t a t
805 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
806 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
807 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
808 splitTree _ Empty = error "splitTree of empty tree"
809 splitTree i (Single x) = i `seq` Split Empty x Empty
810 splitTree i (Deep _ pr m sf)
811 | vpr > 0 = case splitDigit i pr of
812 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
813 | vm > 0 = case splitTree vpr m of
814 Split ml xs mr -> case splitNode (vpr + size ml) xs of
815 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
816 | otherwise = case splitDigit vm sf of
817 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
818 where vpr = i + size pr
821 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
822 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
823 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
824 deepL Nothing m sf = case viewLTree m of
825 Nothing2 -> digitToTree sf
826 Just2 a m' -> deep (nodeToDigit a) m' sf
827 deepL (Just pr) m sf = deep pr m sf
829 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
830 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
831 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
832 deepR pr m Nothing = case viewRTree m of
833 Nothing2 -> digitToTree pr
834 Just2 m' a -> deep pr m' (nodeToDigit a)
835 deepR pr m (Just sf) = deep pr m sf
837 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
838 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
839 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
840 splitNode i (Node2 _ a b)
841 | va > 0 = Split Nothing a (Just (One b))
842 | otherwise = Split (Just (One a)) b Nothing
843 where va = i + size a
844 splitNode i (Node3 _ a b c)
845 | va > 0 = Split Nothing a (Just (Two b c))
846 | vab > 0 = Split (Just (One a)) b (Just (One c))
847 | otherwise = Split (Just (Two a b)) c Nothing
848 where va = i + size a
851 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
852 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
853 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
854 splitDigit i (One a) = i `seq` Split Nothing a Nothing
855 splitDigit i (Two a b)
856 | va > 0 = Split Nothing a (Just (One b))
857 | otherwise = Split (Just (One a)) b Nothing
858 where va = i + size a
859 splitDigit i (Three a b c)
860 | va > 0 = Split Nothing a (Just (Two b c))
861 | vab > 0 = Split (Just (One a)) b (Just (One c))
862 | otherwise = Split (Just (Two a b)) c Nothing
863 where va = i + size a
865 splitDigit i (Four a b c d)
866 | va > 0 = Split Nothing a (Just (Three b c d))
867 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
868 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
869 | otherwise = Split (Just (Three a b c)) d Nothing
870 where va = i + size a
874 ------------------------------------------------------------------------
876 ------------------------------------------------------------------------
878 -- | /O(n)/. Create a sequence from a finite list of elements.
879 fromList :: [a] -> Seq a
880 fromList = Data.List.foldl' (|>) empty
882 -- | /O(n)/. List of elements of the sequence.
883 toList :: Seq a -> [a]
884 toList = foldr (:) []
886 ------------------------------------------------------------------------
888 ------------------------------------------------------------------------
890 -- | /O(n*t)/. Fold over the elements of a sequence,
891 -- associating to the right.
892 foldr :: (a -> b -> b) -> b -> Seq a -> b
893 foldr f z (Seq xs) = foldrTree f' z xs
894 where f' (Elem x) y = f x y
896 foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
897 foldrTree _ z Empty = z
898 foldrTree f z (Single x) = x `f` z
899 foldrTree f z (Deep _ pr m sf) =
900 foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr
902 foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
903 foldrDigit f z (One a) = a `f` z
904 foldrDigit f z (Two a b) = a `f` (b `f` z)
905 foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z))
906 foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
908 foldrNode :: (a -> b -> b) -> b -> Node a -> b
909 foldrNode f z (Node2 _ a b) = a `f` (b `f` z)
910 foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
912 -- | /O(n*t)/. A variant of 'foldr' that has no base case,
913 -- and thus may only be applied to non-empty sequences.
914 foldr1 :: (a -> a -> a) -> Seq a -> a
915 foldr1 f (Seq xs) = getElem (foldr1Tree f' xs)
916 where f' (Elem x) (Elem y) = Elem (f x y)
918 foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
919 foldr1Tree _ Empty = error "foldr1: empty sequence"
920 foldr1Tree _ (Single x) = x
921 foldr1Tree f (Deep _ pr m sf) =
922 foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr
924 foldr1Digit :: (a -> a -> a) -> Digit a -> a
925 foldr1Digit f (One a) = a
926 foldr1Digit f (Two a b) = a `f` b
927 foldr1Digit f (Three a b c) = a `f` (b `f` c)
928 foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d))
930 -- | /O(n*t)/. Fold over the elements of a sequence,
931 -- associating to the left.
932 foldl :: (a -> b -> a) -> a -> Seq b -> a
933 foldl f z (Seq xs) = foldlTree f' z xs
934 where f' x (Elem y) = f x y
936 foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
937 foldlTree _ z Empty = z
938 foldlTree f z (Single x) = z `f` x
939 foldlTree f z (Deep _ pr m sf) =
940 foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
942 foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
943 foldlDigit f z (One a) = z `f` a
944 foldlDigit f z (Two a b) = (z `f` a) `f` b
945 foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c
946 foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
948 foldlNode :: (a -> b -> a) -> a -> Node b -> a
949 foldlNode f z (Node2 _ a b) = (z `f` a) `f` b
950 foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
952 -- | /O(n*t)/. A variant of 'foldl' that has no base case,
953 -- and thus may only be applied to non-empty sequences.
954 foldl1 :: (a -> a -> a) -> Seq a -> a
955 foldl1 f (Seq xs) = getElem (foldl1Tree f' xs)
956 where f' (Elem x) (Elem y) = Elem (f x y)
958 foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
959 foldl1Tree _ Empty = error "foldl1: empty sequence"
960 foldl1Tree _ (Single x) = x
961 foldl1Tree f (Deep _ pr m sf) =
962 foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf
964 foldl1Digit :: (a -> a -> a) -> Digit a -> a
965 foldl1Digit f (One a) = a
966 foldl1Digit f (Two a b) = a `f` b
967 foldl1Digit f (Three a b c) = (a `f` b) `f` c
968 foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d
970 ------------------------------------------------------------------------
972 ------------------------------------------------------------------------
974 -- | /O(n*t)/. Fold over the elements of a sequence,
975 -- associating to the right, but strictly.
976 foldr' :: (a -> b -> b) -> b -> Seq a -> b
977 foldr' f z xs = foldl f' id xs z
978 where f' k x z = k $! f x z
980 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
981 -- associating to the right, i.e. from right to left.
982 foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
983 foldrM f z xs = foldl f' return xs z
984 where f' k x z = f x z >>= k
986 -- | /O(n*t)/. Fold over the elements of a sequence,
987 -- associating to the left, but strictly.
988 foldl' :: (a -> b -> a) -> a -> Seq b -> a
989 foldl' f z xs = foldr f' id xs z
990 where f' x k z = k $! f z x
992 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
993 -- associating to the left, i.e. from left to right.
994 foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
995 foldlM f z xs = foldr f' return xs z
996 where f' x k z = f z x >>= k
998 ------------------------------------------------------------------------
1000 ------------------------------------------------------------------------
1002 -- | /O(n)/. The reverse of a sequence.
1003 reverse :: Seq a -> Seq a
1004 reverse (Seq xs) = Seq (reverseTree id xs)
1006 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1007 reverseTree _ Empty = Empty
1008 reverseTree f (Single x) = Single (f x)
1009 reverseTree f (Deep s pr m sf) =
1010 Deep s (reverseDigit f sf)
1011 (reverseTree (reverseNode f) m)
1014 reverseDigit :: (a -> a) -> Digit a -> Digit a
1015 reverseDigit f (One a) = One (f a)
1016 reverseDigit f (Two a b) = Two (f b) (f a)
1017 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1018 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1020 reverseNode :: (a -> a) -> Node a -> Node a
1021 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1022 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1026 ------------------------------------------------------------------------
1028 ------------------------------------------------------------------------
1030 instance Arbitrary a => Arbitrary (Seq a) where
1031 arbitrary = liftM Seq arbitrary
1032 coarbitrary (Seq x) = coarbitrary x
1034 instance Arbitrary a => Arbitrary (Elem a) where
1035 arbitrary = liftM Elem arbitrary
1036 coarbitrary (Elem x) = coarbitrary x
1038 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1039 arbitrary = sized arb
1040 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1041 arb 0 = return Empty
1042 arb 1 = liftM Single arbitrary
1043 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1045 coarbitrary Empty = variant 0
1046 coarbitrary (Single x) = variant 1 . coarbitrary x
1047 coarbitrary (Deep _ pr m sf) =
1048 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1050 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1052 liftM2 node2 arbitrary arbitrary,
1053 liftM3 node3 arbitrary arbitrary arbitrary]
1055 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1056 coarbitrary (Node3 _ a b c) =
1057 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1059 instance Arbitrary a => Arbitrary (Digit a) where
1061 liftM One arbitrary,
1062 liftM2 Two arbitrary arbitrary,
1063 liftM3 Three arbitrary arbitrary arbitrary,
1064 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1066 coarbitrary (One a) = variant 0 . coarbitrary a
1067 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1068 coarbitrary (Three a b c) =
1069 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1070 coarbitrary (Four a b c d) =
1071 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1073 ------------------------------------------------------------------------
1075 ------------------------------------------------------------------------
1080 instance Valid (Elem a) where
1083 instance Valid (Seq a) where
1084 valid (Seq xs) = valid xs
1086 instance (Sized a, Valid a) => Valid (FingerTree a) where
1088 valid (Single x) = valid x
1089 valid (Deep s pr m sf) =
1090 s == size pr + size m + size sf && valid pr && valid m && valid sf
1092 instance (Sized a, Valid a) => Valid (Node a) where
1093 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1094 valid (Node3 s a b c) =
1095 s == size a + size b + size c && valid a && valid b && valid c
1097 instance Valid a => Valid (Digit a) where
1098 valid (One a) = valid a
1099 valid (Two a b) = valid a && valid b
1100 valid (Three a b c) = valid a && valid b && valid c
1101 valid (Four a b c d) = valid a && valid b && valid c && valid d