1 {-# OPTIONS -cpp -fglasgow-exts #-}
2 -----------------------------------------------------------------------------
4 -- Module : Data.Sequence
5 -- Copyright : (c) Ross Paterson 2005
7 -- Maintainer : ross@soi.city.ac.uk
8 -- Stability : experimental
9 -- Portability : portable
11 -- General purpose finite sequences.
12 -- Apart from being finite and having strict operations, sequences
13 -- also differ from lists in supporting a wider variety of operations
16 -- An amortized running time is given for each operation, with /n/ referring
17 -- to the length of the sequence and /i/ being the integral index used by
18 -- some operations. These bounds hold even in a persistent (shared) setting.
20 -- The implementation uses 2-3 finger trees annotated with sizes,
21 -- as described in section 4.2 of
23 -- * Ralf Hinze and Ross Paterson,
24 -- \"Finger trees: a simple general-purpose data structure\",
25 -- to appear in /Journal of Functional Programming/.
26 -- <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
28 -- /Note/: Many of these operations have the same names as similar
29 -- operations on lists in the "Prelude". The ambiguity may be resolved
30 -- using either qualification or the @hiding@ clause.
32 -----------------------------------------------------------------------------
34 module Data.Sequence (
38 singleton, -- :: a -> Seq a
39 (<|), -- :: a -> Seq a -> Seq a
40 (|>), -- :: Seq a -> a -> Seq a
41 (><), -- :: Seq a -> Seq a -> Seq a
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)
86 #ifdef __GLASGOW_HASKELL__
87 import GHC.Exts (build)
91 import Control.Monad (liftM, liftM2, liftM3, liftM4)
92 import Test.QuickCheck
95 #if __GLASGOW_HASKELL__
96 import Data.Generics.Basics (Data(..), Fixity(..),
97 constrIndex, mkConstr, mkDataType)
110 ------------------------------------------------------------------------
111 -- Random access sequences
112 ------------------------------------------------------------------------
114 -- | General-purpose finite sequences.
115 newtype Seq a = Seq (FingerTree (Elem a))
117 instance Functor Seq where
118 fmap f (Seq xs) = Seq (fmap (fmap f) xs)
120 instance Eq a => Eq (Seq a) where
121 xs == ys = length xs == length ys && toList xs == toList ys
123 instance Ord a => Ord (Seq a) where
124 compare xs ys = compare (toList xs) (toList ys)
127 instance Show a => Show (Seq a) where
128 showsPrec p (Seq x) = showsPrec p x
130 instance Show a => Show (Seq a) where
131 showsPrec _ xs = showChar '<' .
132 flip (Prelude.foldr ($)) (Data.List.intersperse (showChar ',')
133 (map shows (toList xs))) .
137 instance FunctorM Seq where
138 fmapM f = foldlM f' empty
142 fmapM_ f = foldlM f' ()
143 where f' _ x = f x >> return ()
145 #include "Typeable.h"
146 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
148 #if __GLASGOW_HASKELL__
149 instance Data a => Data (Seq a) where
150 gfoldl f z s = case viewl s of
152 x :< xs -> z (<|) `f` x `f` xs
154 gunfold k z c = case constrIndex c of
160 | null xs = emptyConstr
161 | otherwise = consConstr
163 dataTypeOf _ = seqDataType
167 emptyConstr = mkConstr seqDataType "empty" [] Prefix
168 consConstr = mkConstr seqDataType "<|" [] Infix
169 seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
177 | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
182 instance Sized a => Sized (FingerTree a) where
183 {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
184 {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
186 size (Single x) = size x
187 size (Deep v _ _ _) = v
189 instance Functor FingerTree where
191 fmap f (Single x) = Single (f x)
192 fmap f (Deep v pr m sf) =
193 Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
196 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
197 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
198 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
199 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
212 instance Functor Digit where
213 fmap f (One a) = One (f a)
214 fmap f (Two a b) = Two (f a) (f b)
215 fmap f (Three a b c) = Three (f a) (f b) (f c)
216 fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)
218 instance Sized a => Sized (Digit a) where
219 {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
220 {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
221 size xs = foldlDigit (\ i x -> i + size x) 0 xs
223 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
224 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
225 digitToTree :: Sized a => Digit a -> FingerTree a
226 digitToTree (One a) = Single a
227 digitToTree (Two a b) = deep (One a) Empty (One b)
228 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
229 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
234 = Node2 {-# UNPACK #-} !Int a a
235 | Node3 {-# UNPACK #-} !Int a a a
240 instance Functor (Node) where
241 fmap f (Node2 v a b) = Node2 v (f a) (f b)
242 fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
244 instance Sized (Node a) where
245 size (Node2 v _ _) = v
246 size (Node3 v _ _ _) = v
249 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
250 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
251 node2 :: Sized a => a -> a -> Node a
252 node2 a b = Node2 (size a + size b) a b
255 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
256 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
257 node3 :: Sized a => a -> a -> a -> Node a
258 node3 a b c = Node3 (size a + size b + size c) a b c
260 nodeToDigit :: Node a -> Digit a
261 nodeToDigit (Node2 _ a b) = Two a b
262 nodeToDigit (Node3 _ a b c) = Three a b c
266 newtype Elem a = Elem { getElem :: a }
268 instance Sized (Elem a) where
271 instance Functor Elem where
272 fmap f (Elem x) = Elem (f x)
275 instance (Show a) => Show (Elem a) where
276 showsPrec p (Elem x) = showsPrec p x
279 ------------------------------------------------------------------------
281 ------------------------------------------------------------------------
283 -- | /O(1)/. The empty sequence.
287 -- | /O(1)/. A singleton sequence.
288 singleton :: a -> Seq a
289 singleton x = Seq (Single (Elem x))
291 -- | /O(1)/. Add an element to the left end of a sequence.
292 -- Mnemonic: a triangle with the single element at the pointy end.
293 (<|) :: a -> Seq a -> Seq a
294 x <| Seq xs = Seq (Elem x `consTree` xs)
296 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
297 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
298 consTree :: Sized a => a -> FingerTree a -> FingerTree a
299 consTree a Empty = Single a
300 consTree a (Single b) = deep (One a) Empty (One b)
301 consTree a (Deep s (Four b c d e) m sf) = m `seq`
302 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
303 consTree a (Deep s (Three b c d) m sf) =
304 Deep (size a + s) (Four a b c d) m sf
305 consTree a (Deep s (Two b c) m sf) =
306 Deep (size a + s) (Three a b c) m sf
307 consTree a (Deep s (One b) m sf) =
308 Deep (size a + s) (Two a b) m sf
310 -- | /O(1)/. Add an element to the right end of a sequence.
311 -- Mnemonic: a triangle with the single element at the pointy end.
312 (|>) :: Seq a -> a -> Seq a
313 Seq xs |> x = Seq (xs `snocTree` Elem x)
315 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
316 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
317 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
318 snocTree Empty a = Single a
319 snocTree (Single a) b = deep (One a) Empty (One b)
320 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
321 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
322 snocTree (Deep s pr m (Three a b c)) d =
323 Deep (s + size d) pr m (Four a b c d)
324 snocTree (Deep s pr m (Two a b)) c =
325 Deep (s + size c) pr m (Three a b c)
326 snocTree (Deep s pr m (One a)) b =
327 Deep (s + size b) pr m (Two a b)
329 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
330 (><) :: Seq a -> Seq a -> Seq a
331 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
333 -- The appendTree/addDigits gunk below is machine generated
335 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
336 appendTree0 Empty xs =
338 appendTree0 xs Empty =
340 appendTree0 (Single x) xs =
342 appendTree0 xs (Single x) =
344 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
345 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
347 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
348 addDigits0 m1 (One a) (One b) m2 =
349 appendTree1 m1 (node2 a b) m2
350 addDigits0 m1 (One a) (Two b c) m2 =
351 appendTree1 m1 (node3 a b c) m2
352 addDigits0 m1 (One a) (Three b c d) m2 =
353 appendTree2 m1 (node2 a b) (node2 c d) m2
354 addDigits0 m1 (One a) (Four b c d e) m2 =
355 appendTree2 m1 (node3 a b c) (node2 d e) m2
356 addDigits0 m1 (Two a b) (One c) m2 =
357 appendTree1 m1 (node3 a b c) m2
358 addDigits0 m1 (Two a b) (Two c d) m2 =
359 appendTree2 m1 (node2 a b) (node2 c d) m2
360 addDigits0 m1 (Two a b) (Three c d e) m2 =
361 appendTree2 m1 (node3 a b c) (node2 d e) m2
362 addDigits0 m1 (Two a b) (Four c d e f) m2 =
363 appendTree2 m1 (node3 a b c) (node3 d e f) m2
364 addDigits0 m1 (Three a b c) (One d) m2 =
365 appendTree2 m1 (node2 a b) (node2 c d) m2
366 addDigits0 m1 (Three a b c) (Two d e) m2 =
367 appendTree2 m1 (node3 a b c) (node2 d e) m2
368 addDigits0 m1 (Three a b c) (Three d e f) m2 =
369 appendTree2 m1 (node3 a b c) (node3 d e f) m2
370 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
371 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
372 addDigits0 m1 (Four a b c d) (One e) m2 =
373 appendTree2 m1 (node3 a b c) (node2 d e) m2
374 addDigits0 m1 (Four a b c d) (Two e f) m2 =
375 appendTree2 m1 (node3 a b c) (node3 d e f) m2
376 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
377 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
378 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
379 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
381 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
382 appendTree1 Empty a xs =
384 appendTree1 xs a Empty =
386 appendTree1 (Single x) a xs =
387 x `consTree` a `consTree` xs
388 appendTree1 xs a (Single x) =
389 xs `snocTree` a `snocTree` x
390 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
391 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
393 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
394 addDigits1 m1 (One a) b (One c) m2 =
395 appendTree1 m1 (node3 a b c) m2
396 addDigits1 m1 (One a) b (Two c d) m2 =
397 appendTree2 m1 (node2 a b) (node2 c d) m2
398 addDigits1 m1 (One a) b (Three c d e) m2 =
399 appendTree2 m1 (node3 a b c) (node2 d e) m2
400 addDigits1 m1 (One a) b (Four c d e f) m2 =
401 appendTree2 m1 (node3 a b c) (node3 d e f) m2
402 addDigits1 m1 (Two a b) c (One d) m2 =
403 appendTree2 m1 (node2 a b) (node2 c d) m2
404 addDigits1 m1 (Two a b) c (Two d e) m2 =
405 appendTree2 m1 (node3 a b c) (node2 d e) m2
406 addDigits1 m1 (Two a b) c (Three d e f) m2 =
407 appendTree2 m1 (node3 a b c) (node3 d e f) m2
408 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
409 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
410 addDigits1 m1 (Three a b c) d (One e) m2 =
411 appendTree2 m1 (node3 a b c) (node2 d e) m2
412 addDigits1 m1 (Three a b c) d (Two e f) m2 =
413 appendTree2 m1 (node3 a b c) (node3 d e f) m2
414 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
415 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
416 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
417 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
418 addDigits1 m1 (Four a b c d) e (One f) m2 =
419 appendTree2 m1 (node3 a b c) (node3 d e f) m2
420 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
421 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
422 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
423 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
424 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
425 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
427 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
428 appendTree2 Empty a b xs =
429 a `consTree` b `consTree` xs
430 appendTree2 xs a b Empty =
431 xs `snocTree` a `snocTree` b
432 appendTree2 (Single x) a b xs =
433 x `consTree` a `consTree` b `consTree` xs
434 appendTree2 xs a b (Single x) =
435 xs `snocTree` a `snocTree` b `snocTree` x
436 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
437 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
439 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
440 addDigits2 m1 (One a) b c (One d) m2 =
441 appendTree2 m1 (node2 a b) (node2 c d) m2
442 addDigits2 m1 (One a) b c (Two d e) m2 =
443 appendTree2 m1 (node3 a b c) (node2 d e) m2
444 addDigits2 m1 (One a) b c (Three d e f) m2 =
445 appendTree2 m1 (node3 a b c) (node3 d e f) m2
446 addDigits2 m1 (One a) b c (Four d e f g) m2 =
447 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
448 addDigits2 m1 (Two a b) c d (One e) m2 =
449 appendTree2 m1 (node3 a b c) (node2 d e) m2
450 addDigits2 m1 (Two a b) c d (Two e f) m2 =
451 appendTree2 m1 (node3 a b c) (node3 d e f) m2
452 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
453 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
454 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
455 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
456 addDigits2 m1 (Three a b c) d e (One f) m2 =
457 appendTree2 m1 (node3 a b c) (node3 d e f) m2
458 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
459 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
460 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
461 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
462 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
463 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
464 addDigits2 m1 (Four a b c d) e f (One g) m2 =
465 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
466 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
467 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
468 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
469 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
470 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
471 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
473 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
474 appendTree3 Empty a b c xs =
475 a `consTree` b `consTree` c `consTree` xs
476 appendTree3 xs a b c Empty =
477 xs `snocTree` a `snocTree` b `snocTree` c
478 appendTree3 (Single x) a b c xs =
479 x `consTree` a `consTree` b `consTree` c `consTree` xs
480 appendTree3 xs a b c (Single x) =
481 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
482 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
483 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
485 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))
486 addDigits3 m1 (One a) b c d (One e) m2 =
487 appendTree2 m1 (node3 a b c) (node2 d e) m2
488 addDigits3 m1 (One a) b c d (Two e f) m2 =
489 appendTree2 m1 (node3 a b c) (node3 d e f) m2
490 addDigits3 m1 (One a) b c d (Three e f g) m2 =
491 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
492 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
493 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
494 addDigits3 m1 (Two a b) c d e (One f) m2 =
495 appendTree2 m1 (node3 a b c) (node3 d e f) m2
496 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
497 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
498 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
499 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
500 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
501 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
502 addDigits3 m1 (Three a b c) d e f (One g) m2 =
503 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
504 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
505 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
506 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
507 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
508 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
509 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
510 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
511 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
512 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
513 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
514 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
515 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
516 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
517 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
519 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
520 appendTree4 Empty a b c d xs =
521 a `consTree` b `consTree` c `consTree` d `consTree` xs
522 appendTree4 xs a b c d Empty =
523 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
524 appendTree4 (Single x) a b c d xs =
525 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
526 appendTree4 xs a b c d (Single x) =
527 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
528 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
529 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
531 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))
532 addDigits4 m1 (One a) b c d e (One f) m2 =
533 appendTree2 m1 (node3 a b c) (node3 d e f) m2
534 addDigits4 m1 (One a) b c d e (Two f g) m2 =
535 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
536 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
537 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
538 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
539 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
540 addDigits4 m1 (Two a b) c d e f (One g) m2 =
541 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
542 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
543 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
544 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
545 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
546 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
547 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
548 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
549 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
550 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
551 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
552 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
553 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
554 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
555 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
556 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
557 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
558 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
559 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
560 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
561 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
562 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
563 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
565 ------------------------------------------------------------------------
567 ------------------------------------------------------------------------
569 -- | /O(1)/. Is this the empty sequence?
570 null :: Seq a -> Bool
571 null (Seq Empty) = True
574 -- | /O(1)/. The number of elements in the sequence.
575 length :: Seq a -> Int
576 length (Seq xs) = size xs
580 data Maybe2 a b = Nothing2 | Just2 a b
582 -- | View of the left end of a sequence.
584 = EmptyL -- ^ empty sequence
585 | a :< Seq a -- ^ leftmost element and the rest of the sequence
589 instance Eq a => Eq (ViewL a)
590 instance Show a => Show (ViewL a)
594 instance Functor ViewL where
595 fmap _ EmptyL = EmptyL
596 fmap f (x :< xs) = f x :< fmap f xs
598 -- | /O(1)/. Analyse the left end of a sequence.
599 viewl :: Seq a -> ViewL a
600 viewl (Seq xs) = case viewLTree xs of
602 Just2 (Elem x) xs' -> x :< Seq xs'
604 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
605 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
606 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
607 viewLTree Empty = Nothing2
608 viewLTree (Single a) = Just2 a Empty
609 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
610 Nothing2 -> digitToTree sf
611 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
612 viewLTree (Deep s (Two a b) m sf) =
613 Just2 a (Deep (s - size a) (One b) m sf)
614 viewLTree (Deep s (Three a b c) m sf) =
615 Just2 a (Deep (s - size a) (Two b c) m sf)
616 viewLTree (Deep s (Four a b c d) m sf) =
617 Just2 a (Deep (s - size a) (Three b c d) m sf)
619 -- | View of the right end of a sequence.
621 = EmptyR -- ^ empty sequence
622 | Seq a :> a -- ^ the sequence minus the rightmost element,
623 -- and the rightmost element
627 instance Eq a => Eq (ViewR a)
628 instance Show a => Show (ViewR a)
631 instance Functor ViewR where
632 fmap _ EmptyR = EmptyR
633 fmap f (xs :> x) = fmap f xs :> f x
635 -- | /O(1)/. Analyse the right end of a sequence.
636 viewr :: Seq a -> ViewR a
637 viewr (Seq xs) = case viewRTree xs of
639 Just2 xs' (Elem x) -> Seq xs' :> x
641 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
642 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
643 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
644 viewRTree Empty = Nothing2
645 viewRTree (Single z) = Just2 Empty z
646 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
647 Nothing2 -> digitToTree pr
648 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
649 viewRTree (Deep s pr m (Two y z)) =
650 Just2 (Deep (s - size z) pr m (One y)) z
651 viewRTree (Deep s pr m (Three x y z)) =
652 Just2 (Deep (s - size z) pr m (Two x y)) z
653 viewRTree (Deep s pr m (Four w x y z)) =
654 Just2 (Deep (s - size z) pr m (Three w x y)) z
658 -- | /O(log(min(i,n-i)))/. The element at the specified position
659 index :: Seq a -> Int -> a
661 | 0 <= i && i < size xs = case lookupTree (-i) xs of
662 Place _ (Elem x) -> x
663 | otherwise = error "index out of bounds"
665 data Place a = Place {-# UNPACK #-} !Int a
670 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
671 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
672 lookupTree :: Sized a => Int -> FingerTree a -> Place a
673 lookupTree _ Empty = error "lookupTree of empty tree"
674 lookupTree i (Single x) = Place i x
675 lookupTree i (Deep _ pr m sf)
676 | vpr > 0 = lookupDigit i pr
677 | vm > 0 = case lookupTree vpr m of
678 Place i' xs -> lookupNode i' xs
679 | otherwise = lookupDigit vm sf
680 where vpr = i + size pr
683 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
684 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
685 lookupNode :: Sized a => Int -> Node a -> Place a
686 lookupNode i (Node2 _ a b)
688 | otherwise = Place va b
689 where va = i + size a
690 lookupNode i (Node3 _ a b c)
692 | vab > 0 = Place va b
693 | otherwise = Place vab c
694 where va = i + size a
697 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
698 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
699 lookupDigit :: Sized a => Int -> Digit a -> Place a
700 lookupDigit i (One a) = Place i a
701 lookupDigit i (Two a b)
703 | otherwise = Place va b
704 where va = i + size a
705 lookupDigit i (Three a b c)
707 | vab > 0 = Place va b
708 | otherwise = Place vab c
709 where va = i + size a
711 lookupDigit i (Four a b c d)
713 | vab > 0 = Place va b
714 | vabc > 0 = Place vab c
715 | otherwise = Place vabc d
716 where va = i + size a
720 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
721 update :: Int -> a -> Seq a -> Seq a
722 update i x = adjust (const x) i
724 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
725 adjust :: (a -> a) -> Int -> Seq a -> Seq a
727 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
730 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
731 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
732 adjustTree :: Sized a => (Int -> a -> a) ->
733 Int -> FingerTree a -> FingerTree a
734 adjustTree _ _ Empty = error "adjustTree of empty tree"
735 adjustTree f i (Single x) = Single (f i x)
736 adjustTree f i (Deep s pr m sf)
737 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
738 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
739 | otherwise = Deep s pr m (adjustDigit f vm sf)
740 where vpr = i + size pr
743 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
744 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
745 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
746 adjustNode f i (Node2 s a b)
747 | va > 0 = Node2 s (f i a) b
748 | otherwise = Node2 s a (f va b)
749 where va = i + size a
750 adjustNode f i (Node3 s a b c)
751 | va > 0 = Node3 s (f i a) b c
752 | vab > 0 = Node3 s a (f va b) c
753 | otherwise = Node3 s a b (f vab c)
754 where va = i + size a
757 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
758 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
759 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
760 adjustDigit f i (One a) = One (f i a)
761 adjustDigit f i (Two a b)
762 | va > 0 = Two (f i a) b
763 | otherwise = Two a (f va b)
764 where va = i + size a
765 adjustDigit f i (Three a b c)
766 | va > 0 = Three (f i a) b c
767 | vab > 0 = Three a (f va b) c
768 | otherwise = Three a b (f vab c)
769 where va = i + size a
771 adjustDigit f i (Four a b c d)
772 | va > 0 = Four (f i a) b c d
773 | vab > 0 = Four a (f va b) c d
774 | vabc > 0 = Four a b (f vab c) d
775 | otherwise = Four a b c (f vabc d)
776 where va = i + size a
782 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
783 take :: Int -> Seq a -> Seq a
784 take i = fst . splitAt i
786 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
787 drop :: Int -> Seq a -> Seq a
788 drop i = snd . splitAt i
790 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
791 splitAt :: Int -> Seq a -> (Seq a, Seq a)
792 splitAt i (Seq xs) = (Seq l, Seq r)
793 where (l, r) = split i xs
795 split :: Int -> FingerTree (Elem a) ->
796 (FingerTree (Elem a), FingerTree (Elem a))
797 split i Empty = i `seq` (Empty, Empty)
799 | size xs > i = (l, consTree x r)
800 | otherwise = (xs, Empty)
801 where Split l x r = splitTree (-i) xs
803 data Split t a = Split t a t
808 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
809 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
810 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
811 splitTree _ Empty = error "splitTree of empty tree"
812 splitTree i (Single x) = i `seq` Split Empty x Empty
813 splitTree i (Deep _ pr m sf)
814 | vpr > 0 = case splitDigit i pr of
815 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
816 | vm > 0 = case splitTree vpr m of
817 Split ml xs mr -> case splitNode (vpr + size ml) xs of
818 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
819 | otherwise = case splitDigit vm sf of
820 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
821 where vpr = i + size pr
824 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
825 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
826 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
827 deepL Nothing m sf = case viewLTree m of
828 Nothing2 -> digitToTree sf
829 Just2 a m' -> deep (nodeToDigit a) m' sf
830 deepL (Just pr) m sf = deep pr m sf
832 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
833 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
834 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
835 deepR pr m Nothing = case viewRTree m of
836 Nothing2 -> digitToTree pr
837 Just2 m' a -> deep pr m' (nodeToDigit a)
838 deepR pr m (Just sf) = deep pr m sf
840 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
841 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
842 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
843 splitNode i (Node2 _ a b)
844 | va > 0 = Split Nothing a (Just (One b))
845 | otherwise = Split (Just (One a)) b Nothing
846 where va = i + size a
847 splitNode i (Node3 _ a b c)
848 | va > 0 = Split Nothing a (Just (Two b c))
849 | vab > 0 = Split (Just (One a)) b (Just (One c))
850 | otherwise = Split (Just (Two a b)) c Nothing
851 where va = i + size a
854 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
855 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
856 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
857 splitDigit i (One a) = i `seq` Split Nothing a Nothing
858 splitDigit i (Two a b)
859 | va > 0 = Split Nothing a (Just (One b))
860 | otherwise = Split (Just (One a)) b Nothing
861 where va = i + size a
862 splitDigit i (Three a b c)
863 | va > 0 = Split Nothing a (Just (Two b c))
864 | vab > 0 = Split (Just (One a)) b (Just (One c))
865 | otherwise = Split (Just (Two a b)) c Nothing
866 where va = i + size a
868 splitDigit i (Four a b c d)
869 | va > 0 = Split Nothing a (Just (Three b c d))
870 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
871 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
872 | otherwise = Split (Just (Three a b c)) d Nothing
873 where va = i + size a
877 ------------------------------------------------------------------------
879 ------------------------------------------------------------------------
881 -- | /O(n)/. Create a sequence from a finite list of elements.
882 fromList :: [a] -> Seq a
883 fromList = Data.List.foldl' (|>) empty
885 -- | /O(n)/. List of elements of the sequence.
886 toList :: Seq a -> [a]
887 #ifdef __GLASGOW_HASKELL__
888 {-# INLINE toList #-}
889 toList xs = build (\ c n -> foldr c n xs)
891 toList = foldr (:) []
894 ------------------------------------------------------------------------
896 ------------------------------------------------------------------------
898 -- | /O(n*t)/. Fold over the elements of a sequence,
899 -- associating to the right.
900 foldr :: (a -> b -> b) -> b -> Seq a -> b
901 foldr f z (Seq xs) = foldrTree f' z xs
902 where f' (Elem x) y = f x y
904 foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
905 foldrTree _ z Empty = z
906 foldrTree f z (Single x) = x `f` z
907 foldrTree f z (Deep _ pr m sf) =
908 foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr
910 foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
911 foldrDigit f z (One a) = a `f` z
912 foldrDigit f z (Two a b) = a `f` (b `f` z)
913 foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z))
914 foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
916 foldrNode :: (a -> b -> b) -> b -> Node a -> b
917 foldrNode f z (Node2 _ a b) = a `f` (b `f` z)
918 foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
920 -- | /O(n*t)/. A variant of 'foldr' that has no base case,
921 -- and thus may only be applied to non-empty sequences.
922 foldr1 :: (a -> a -> a) -> Seq a -> a
923 foldr1 f (Seq xs) = getElem (foldr1Tree f' xs)
924 where f' (Elem x) (Elem y) = Elem (f x y)
926 foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
927 foldr1Tree _ Empty = error "foldr1: empty sequence"
928 foldr1Tree _ (Single x) = x
929 foldr1Tree f (Deep _ pr m sf) =
930 foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr
932 foldr1Digit :: (a -> a -> a) -> Digit a -> a
933 foldr1Digit f (One a) = a
934 foldr1Digit f (Two a b) = a `f` b
935 foldr1Digit f (Three a b c) = a `f` (b `f` c)
936 foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d))
938 -- | /O(n*t)/. Fold over the elements of a sequence,
939 -- associating to the left.
940 foldl :: (a -> b -> a) -> a -> Seq b -> a
941 foldl f z (Seq xs) = foldlTree f' z xs
942 where f' x (Elem y) = f x y
944 foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
945 foldlTree _ z Empty = z
946 foldlTree f z (Single x) = z `f` x
947 foldlTree f z (Deep _ pr m sf) =
948 foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
950 foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
951 foldlDigit f z (One a) = z `f` a
952 foldlDigit f z (Two a b) = (z `f` a) `f` b
953 foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c
954 foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
956 foldlNode :: (a -> b -> a) -> a -> Node b -> a
957 foldlNode f z (Node2 _ a b) = (z `f` a) `f` b
958 foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
960 -- | /O(n*t)/. A variant of 'foldl' that has no base case,
961 -- and thus may only be applied to non-empty sequences.
962 foldl1 :: (a -> a -> a) -> Seq a -> a
963 foldl1 f (Seq xs) = getElem (foldl1Tree f' xs)
964 where f' (Elem x) (Elem y) = Elem (f x y)
966 foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
967 foldl1Tree _ Empty = error "foldl1: empty sequence"
968 foldl1Tree _ (Single x) = x
969 foldl1Tree f (Deep _ pr m sf) =
970 foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf
972 foldl1Digit :: (a -> a -> a) -> Digit a -> a
973 foldl1Digit f (One a) = a
974 foldl1Digit f (Two a b) = a `f` b
975 foldl1Digit f (Three a b c) = (a `f` b) `f` c
976 foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d
978 ------------------------------------------------------------------------
980 ------------------------------------------------------------------------
982 -- | /O(n*t)/. Fold over the elements of a sequence,
983 -- associating to the right, but strictly.
984 foldr' :: (a -> b -> b) -> b -> Seq a -> b
985 foldr' f z xs = foldl f' id xs z
986 where f' k x z = k $! f x z
988 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
989 -- associating to the right, i.e. from right to left.
990 foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
991 foldrM f z xs = foldl f' return xs z
992 where f' k x z = f x z >>= k
994 -- | /O(n*t)/. Fold over the elements of a sequence,
995 -- associating to the left, but strictly.
996 foldl' :: (a -> b -> a) -> a -> Seq b -> a
997 foldl' f z xs = foldr f' id xs z
998 where f' x k z = k $! f z x
1000 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1001 -- associating to the left, i.e. from left to right.
1002 foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
1003 foldlM f z xs = foldr f' return xs z
1004 where f' x k z = f z x >>= k
1006 ------------------------------------------------------------------------
1008 ------------------------------------------------------------------------
1010 -- | /O(n)/. The reverse of a sequence.
1011 reverse :: Seq a -> Seq a
1012 reverse (Seq xs) = Seq (reverseTree id xs)
1014 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1015 reverseTree _ Empty = Empty
1016 reverseTree f (Single x) = Single (f x)
1017 reverseTree f (Deep s pr m sf) =
1018 Deep s (reverseDigit f sf)
1019 (reverseTree (reverseNode f) m)
1022 reverseDigit :: (a -> a) -> Digit a -> Digit a
1023 reverseDigit f (One a) = One (f a)
1024 reverseDigit f (Two a b) = Two (f b) (f a)
1025 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1026 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1028 reverseNode :: (a -> a) -> Node a -> Node a
1029 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1030 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1034 ------------------------------------------------------------------------
1036 ------------------------------------------------------------------------
1038 instance Arbitrary a => Arbitrary (Seq a) where
1039 arbitrary = liftM Seq arbitrary
1040 coarbitrary (Seq x) = coarbitrary x
1042 instance Arbitrary a => Arbitrary (Elem a) where
1043 arbitrary = liftM Elem arbitrary
1044 coarbitrary (Elem x) = coarbitrary x
1046 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1047 arbitrary = sized arb
1048 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1049 arb 0 = return Empty
1050 arb 1 = liftM Single arbitrary
1051 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1053 coarbitrary Empty = variant 0
1054 coarbitrary (Single x) = variant 1 . coarbitrary x
1055 coarbitrary (Deep _ pr m sf) =
1056 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1058 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1060 liftM2 node2 arbitrary arbitrary,
1061 liftM3 node3 arbitrary arbitrary arbitrary]
1063 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1064 coarbitrary (Node3 _ a b c) =
1065 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1067 instance Arbitrary a => Arbitrary (Digit a) where
1069 liftM One arbitrary,
1070 liftM2 Two arbitrary arbitrary,
1071 liftM3 Three arbitrary arbitrary arbitrary,
1072 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1074 coarbitrary (One a) = variant 0 . coarbitrary a
1075 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1076 coarbitrary (Three a b c) =
1077 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1078 coarbitrary (Four a b c d) =
1079 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1081 ------------------------------------------------------------------------
1083 ------------------------------------------------------------------------
1088 instance Valid (Elem a) where
1091 instance Valid (Seq a) where
1092 valid (Seq xs) = valid xs
1094 instance (Sized a, Valid a) => Valid (FingerTree a) where
1096 valid (Single x) = valid x
1097 valid (Deep s pr m sf) =
1098 s == size pr + size m + size sf && valid pr && valid m && valid sf
1100 instance (Sized a, Valid a) => Valid (Node a) where
1101 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1102 valid (Node3 s a b c) =
1103 s == size a + size b + size c && valid a && valid b && valid c
1105 instance Valid a => Valid (Digit a) where
1106 valid (One a) = valid a
1107 valid (Two a b) = valid a && valid b
1108 valid (Three a b c) = valid a && valid b && valid c
1109 valid (Four a b c d) = valid a && valid b && valid c && valid d