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)
84 import Control.Monad (MonadPlus(..))
88 #ifdef __GLASGOW_HASKELL__
89 import GHC.Exts (build)
90 import Data.Generics.Basics (Data(..), Fixity(..),
91 constrIndex, mkConstr, mkDataType)
95 import Control.Monad (liftM, liftM2, liftM3, liftM4)
96 import Test.QuickCheck
109 -- | General-purpose finite sequences.
110 newtype Seq a = Seq (FingerTree (Elem a))
112 instance Functor Seq where
113 fmap f (Seq xs) = Seq (fmap (fmap f) xs)
115 instance Monad Seq where
117 xs >>= f = foldl' add empty xs
118 where add ys x = ys >< f x
120 instance MonadPlus Seq where
124 instance FunctorM Seq where
125 fmapM f = foldlM f' empty
129 fmapM_ f = foldlM f' ()
130 where f' _ x = f x >> return ()
132 instance Eq a => Eq (Seq a) where
133 xs == ys = length xs == length ys && toList xs == toList ys
135 instance Ord a => Ord (Seq a) where
136 compare xs ys = compare (toList xs) (toList ys)
139 instance Show a => Show (Seq a) where
140 showsPrec p (Seq x) = showsPrec p x
142 instance Show a => Show (Seq a) where
143 showsPrec _ xs = showChar '<' .
144 flip (Prelude.foldr ($)) (Data.List.intersperse (showChar ',')
145 (map shows (toList xs))) .
149 #include "Typeable.h"
150 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
152 #if __GLASGOW_HASKELL__
153 instance Data a => Data (Seq a) where
154 gfoldl f z s = case viewl s of
156 x :< xs -> z (<|) `f` x `f` xs
158 gunfold k z c = case constrIndex c of
164 | null xs = emptyConstr
165 | otherwise = consConstr
167 dataTypeOf _ = seqDataType
171 emptyConstr = mkConstr seqDataType "empty" [] Prefix
172 consConstr = mkConstr seqDataType "<|" [] Infix
173 seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
181 | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
186 instance Sized a => Sized (FingerTree a) where
187 {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
188 {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
190 size (Single x) = size x
191 size (Deep v _ _ _) = v
193 instance Functor FingerTree where
195 fmap f (Single x) = Single (f x)
196 fmap f (Deep v pr m sf) =
197 Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
200 {-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
201 {-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
202 deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
203 deep pr m sf = Deep (size pr + size m + size sf) pr m sf
216 instance Functor Digit where
217 fmap f (One a) = One (f a)
218 fmap f (Two a b) = Two (f a) (f b)
219 fmap f (Three a b c) = Three (f a) (f b) (f c)
220 fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)
222 instance Sized a => Sized (Digit a) where
223 {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
224 {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
225 size xs = foldlDigit (\ i x -> i + size x) 0 xs
227 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
228 {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
229 digitToTree :: Sized a => Digit a -> FingerTree a
230 digitToTree (One a) = Single a
231 digitToTree (Two a b) = deep (One a) Empty (One b)
232 digitToTree (Three a b c) = deep (Two a b) Empty (One c)
233 digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
238 = Node2 {-# UNPACK #-} !Int a a
239 | Node3 {-# UNPACK #-} !Int a a a
244 instance Functor (Node) where
245 fmap f (Node2 v a b) = Node2 v (f a) (f b)
246 fmap f (Node3 v a b c) = Node3 v (f a) (f b) (f c)
248 instance Sized (Node a) where
249 size (Node2 v _ _) = v
250 size (Node3 v _ _ _) = v
253 {-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
254 {-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
255 node2 :: Sized a => a -> a -> Node a
256 node2 a b = Node2 (size a + size b) a b
259 {-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
260 {-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
261 node3 :: Sized a => a -> a -> a -> Node a
262 node3 a b c = Node3 (size a + size b + size c) a b c
264 nodeToDigit :: Node a -> Digit a
265 nodeToDigit (Node2 _ a b) = Two a b
266 nodeToDigit (Node3 _ a b c) = Three a b c
270 newtype Elem a = Elem { getElem :: a }
272 instance Sized (Elem a) where
275 instance Functor Elem where
276 fmap f (Elem x) = Elem (f x)
279 instance (Show a) => Show (Elem a) where
280 showsPrec p (Elem x) = showsPrec p x
283 ------------------------------------------------------------------------
285 ------------------------------------------------------------------------
287 -- | /O(1)/. The empty sequence.
291 -- | /O(1)/. A singleton sequence.
292 singleton :: a -> Seq a
293 singleton x = Seq (Single (Elem x))
295 -- | /O(1)/. Add an element to the left end of a sequence.
296 -- Mnemonic: a triangle with the single element at the pointy end.
297 (<|) :: a -> Seq a -> Seq a
298 x <| Seq xs = Seq (Elem x `consTree` xs)
300 {-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
301 {-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
302 consTree :: Sized a => a -> FingerTree a -> FingerTree a
303 consTree a Empty = Single a
304 consTree a (Single b) = deep (One a) Empty (One b)
305 consTree a (Deep s (Four b c d e) m sf) = m `seq`
306 Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
307 consTree a (Deep s (Three b c d) m sf) =
308 Deep (size a + s) (Four a b c d) m sf
309 consTree a (Deep s (Two b c) m sf) =
310 Deep (size a + s) (Three a b c) m sf
311 consTree a (Deep s (One b) m sf) =
312 Deep (size a + s) (Two a b) m sf
314 -- | /O(1)/. Add an element to the right end of a sequence.
315 -- Mnemonic: a triangle with the single element at the pointy end.
316 (|>) :: Seq a -> a -> Seq a
317 Seq xs |> x = Seq (xs `snocTree` Elem x)
319 {-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
320 {-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
321 snocTree :: Sized a => FingerTree a -> a -> FingerTree a
322 snocTree Empty a = Single a
323 snocTree (Single a) b = deep (One a) Empty (One b)
324 snocTree (Deep s pr m (Four a b c d)) e = m `seq`
325 Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
326 snocTree (Deep s pr m (Three a b c)) d =
327 Deep (s + size d) pr m (Four a b c d)
328 snocTree (Deep s pr m (Two a b)) c =
329 Deep (s + size c) pr m (Three a b c)
330 snocTree (Deep s pr m (One a)) b =
331 Deep (s + size b) pr m (Two a b)
333 -- | /O(log(min(n1,n2)))/. Concatenate two sequences.
334 (><) :: Seq a -> Seq a -> Seq a
335 Seq xs >< Seq ys = Seq (appendTree0 xs ys)
337 -- The appendTree/addDigits gunk below is machine generated
339 appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
340 appendTree0 Empty xs =
342 appendTree0 xs Empty =
344 appendTree0 (Single x) xs =
346 appendTree0 xs (Single x) =
348 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
349 Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
351 addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
352 addDigits0 m1 (One a) (One b) m2 =
353 appendTree1 m1 (node2 a b) m2
354 addDigits0 m1 (One a) (Two b c) m2 =
355 appendTree1 m1 (node3 a b c) m2
356 addDigits0 m1 (One a) (Three b c d) m2 =
357 appendTree2 m1 (node2 a b) (node2 c d) m2
358 addDigits0 m1 (One a) (Four b c d e) m2 =
359 appendTree2 m1 (node3 a b c) (node2 d e) m2
360 addDigits0 m1 (Two a b) (One c) m2 =
361 appendTree1 m1 (node3 a b c) m2
362 addDigits0 m1 (Two a b) (Two c d) m2 =
363 appendTree2 m1 (node2 a b) (node2 c d) m2
364 addDigits0 m1 (Two a b) (Three c d e) m2 =
365 appendTree2 m1 (node3 a b c) (node2 d e) m2
366 addDigits0 m1 (Two a b) (Four c d e f) m2 =
367 appendTree2 m1 (node3 a b c) (node3 d e f) m2
368 addDigits0 m1 (Three a b c) (One d) m2 =
369 appendTree2 m1 (node2 a b) (node2 c d) m2
370 addDigits0 m1 (Three a b c) (Two d e) m2 =
371 appendTree2 m1 (node3 a b c) (node2 d e) m2
372 addDigits0 m1 (Three a b c) (Three d e f) m2 =
373 appendTree2 m1 (node3 a b c) (node3 d e f) m2
374 addDigits0 m1 (Three a b c) (Four d e f g) m2 =
375 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
376 addDigits0 m1 (Four a b c d) (One e) m2 =
377 appendTree2 m1 (node3 a b c) (node2 d e) m2
378 addDigits0 m1 (Four a b c d) (Two e f) m2 =
379 appendTree2 m1 (node3 a b c) (node3 d e f) m2
380 addDigits0 m1 (Four a b c d) (Three e f g) m2 =
381 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
382 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
383 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
385 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
386 appendTree1 Empty a xs =
388 appendTree1 xs a Empty =
390 appendTree1 (Single x) a xs =
391 x `consTree` a `consTree` xs
392 appendTree1 xs a (Single x) =
393 xs `snocTree` a `snocTree` x
394 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
395 Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
397 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
398 addDigits1 m1 (One a) b (One c) m2 =
399 appendTree1 m1 (node3 a b c) m2
400 addDigits1 m1 (One a) b (Two c d) m2 =
401 appendTree2 m1 (node2 a b) (node2 c d) m2
402 addDigits1 m1 (One a) b (Three c d e) m2 =
403 appendTree2 m1 (node3 a b c) (node2 d e) m2
404 addDigits1 m1 (One a) b (Four c d e f) m2 =
405 appendTree2 m1 (node3 a b c) (node3 d e f) m2
406 addDigits1 m1 (Two a b) c (One d) m2 =
407 appendTree2 m1 (node2 a b) (node2 c d) m2
408 addDigits1 m1 (Two a b) c (Two d e) m2 =
409 appendTree2 m1 (node3 a b c) (node2 d e) m2
410 addDigits1 m1 (Two a b) c (Three d e f) m2 =
411 appendTree2 m1 (node3 a b c) (node3 d e f) m2
412 addDigits1 m1 (Two a b) c (Four d e f g) m2 =
413 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
414 addDigits1 m1 (Three a b c) d (One e) m2 =
415 appendTree2 m1 (node3 a b c) (node2 d e) m2
416 addDigits1 m1 (Three a b c) d (Two e f) m2 =
417 appendTree2 m1 (node3 a b c) (node3 d e f) m2
418 addDigits1 m1 (Three a b c) d (Three e f g) m2 =
419 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
420 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
421 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
422 addDigits1 m1 (Four a b c d) e (One f) m2 =
423 appendTree2 m1 (node3 a b c) (node3 d e f) m2
424 addDigits1 m1 (Four a b c d) e (Two f g) m2 =
425 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
426 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
427 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
428 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
429 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
431 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
432 appendTree2 Empty a b xs =
433 a `consTree` b `consTree` xs
434 appendTree2 xs a b Empty =
435 xs `snocTree` a `snocTree` b
436 appendTree2 (Single x) a b xs =
437 x `consTree` a `consTree` b `consTree` xs
438 appendTree2 xs a b (Single x) =
439 xs `snocTree` a `snocTree` b `snocTree` x
440 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
441 Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
443 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
444 addDigits2 m1 (One a) b c (One d) m2 =
445 appendTree2 m1 (node2 a b) (node2 c d) m2
446 addDigits2 m1 (One a) b c (Two d e) m2 =
447 appendTree2 m1 (node3 a b c) (node2 d e) m2
448 addDigits2 m1 (One a) b c (Three d e f) m2 =
449 appendTree2 m1 (node3 a b c) (node3 d e f) m2
450 addDigits2 m1 (One a) b c (Four d e f g) m2 =
451 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
452 addDigits2 m1 (Two a b) c d (One e) m2 =
453 appendTree2 m1 (node3 a b c) (node2 d e) m2
454 addDigits2 m1 (Two a b) c d (Two e f) m2 =
455 appendTree2 m1 (node3 a b c) (node3 d e f) m2
456 addDigits2 m1 (Two a b) c d (Three e f g) m2 =
457 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
458 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
459 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
460 addDigits2 m1 (Three a b c) d e (One f) m2 =
461 appendTree2 m1 (node3 a b c) (node3 d e f) m2
462 addDigits2 m1 (Three a b c) d e (Two f g) m2 =
463 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
464 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
465 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
466 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
467 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
468 addDigits2 m1 (Four a b c d) e f (One g) m2 =
469 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
470 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
471 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
472 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
473 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
474 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
475 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
477 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
478 appendTree3 Empty a b c xs =
479 a `consTree` b `consTree` c `consTree` xs
480 appendTree3 xs a b c Empty =
481 xs `snocTree` a `snocTree` b `snocTree` c
482 appendTree3 (Single x) a b c xs =
483 x `consTree` a `consTree` b `consTree` c `consTree` xs
484 appendTree3 xs a b c (Single x) =
485 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
486 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
487 Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
489 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))
490 addDigits3 m1 (One a) b c d (One e) m2 =
491 appendTree2 m1 (node3 a b c) (node2 d e) m2
492 addDigits3 m1 (One a) b c d (Two e f) m2 =
493 appendTree2 m1 (node3 a b c) (node3 d e f) m2
494 addDigits3 m1 (One a) b c d (Three e f g) m2 =
495 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
496 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
497 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
498 addDigits3 m1 (Two a b) c d e (One f) m2 =
499 appendTree2 m1 (node3 a b c) (node3 d e f) m2
500 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
501 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
502 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
503 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
504 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
505 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
506 addDigits3 m1 (Three a b c) d e f (One g) m2 =
507 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
508 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
509 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
510 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
511 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
512 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
513 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
514 addDigits3 m1 (Four a b c d) e f g (One h) m2 =
515 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
516 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
517 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
518 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
519 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
520 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
521 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
523 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
524 appendTree4 Empty a b c d xs =
525 a `consTree` b `consTree` c `consTree` d `consTree` xs
526 appendTree4 xs a b c d Empty =
527 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
528 appendTree4 (Single x) a b c d xs =
529 x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
530 appendTree4 xs a b c d (Single x) =
531 xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
532 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
533 Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
535 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))
536 addDigits4 m1 (One a) b c d e (One f) m2 =
537 appendTree2 m1 (node3 a b c) (node3 d e f) m2
538 addDigits4 m1 (One a) b c d e (Two f g) m2 =
539 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
540 addDigits4 m1 (One a) b c d e (Three f g h) m2 =
541 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
542 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
543 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
544 addDigits4 m1 (Two a b) c d e f (One g) m2 =
545 appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
546 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
547 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
548 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
549 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
550 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
551 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
552 addDigits4 m1 (Three a b c) d e f g (One h) m2 =
553 appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
554 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
555 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
556 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
557 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
558 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
559 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
560 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
561 appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
562 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
563 appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
564 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
565 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
566 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
567 appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
569 ------------------------------------------------------------------------
571 ------------------------------------------------------------------------
573 -- | /O(1)/. Is this the empty sequence?
574 null :: Seq a -> Bool
575 null (Seq Empty) = True
578 -- | /O(1)/. The number of elements in the sequence.
579 length :: Seq a -> Int
580 length (Seq xs) = size xs
584 data Maybe2 a b = Nothing2 | Just2 a b
586 -- | View of the left end of a sequence.
588 = EmptyL -- ^ empty sequence
589 | a :< Seq a -- ^ leftmost element and the rest of the sequence
593 instance Eq a => Eq (ViewL a)
594 instance Show a => Show (ViewL a)
598 instance Functor ViewL where
599 fmap _ EmptyL = EmptyL
600 fmap f (x :< xs) = f x :< fmap f xs
602 -- | /O(1)/. Analyse the left end of a sequence.
603 viewl :: Seq a -> ViewL a
604 viewl (Seq xs) = case viewLTree xs of
606 Just2 (Elem x) xs' -> x :< Seq xs'
608 {-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
609 {-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
610 viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
611 viewLTree Empty = Nothing2
612 viewLTree (Single a) = Just2 a Empty
613 viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
614 Nothing2 -> digitToTree sf
615 Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf)
616 viewLTree (Deep s (Two a b) m sf) =
617 Just2 a (Deep (s - size a) (One b) m sf)
618 viewLTree (Deep s (Three a b c) m sf) =
619 Just2 a (Deep (s - size a) (Two b c) m sf)
620 viewLTree (Deep s (Four a b c d) m sf) =
621 Just2 a (Deep (s - size a) (Three b c d) m sf)
623 -- | View of the right end of a sequence.
625 = EmptyR -- ^ empty sequence
626 | Seq a :> a -- ^ the sequence minus the rightmost element,
627 -- and the rightmost element
631 instance Eq a => Eq (ViewR a)
632 instance Show a => Show (ViewR a)
635 instance Functor ViewR where
636 fmap _ EmptyR = EmptyR
637 fmap f (xs :> x) = fmap f xs :> f x
639 -- | /O(1)/. Analyse the right end of a sequence.
640 viewr :: Seq a -> ViewR a
641 viewr (Seq xs) = case viewRTree xs of
643 Just2 xs' (Elem x) -> Seq xs' :> x
645 {-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
646 {-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
647 viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
648 viewRTree Empty = Nothing2
649 viewRTree (Single z) = Just2 Empty z
650 viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
651 Nothing2 -> digitToTree pr
652 Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z
653 viewRTree (Deep s pr m (Two y z)) =
654 Just2 (Deep (s - size z) pr m (One y)) z
655 viewRTree (Deep s pr m (Three x y z)) =
656 Just2 (Deep (s - size z) pr m (Two x y)) z
657 viewRTree (Deep s pr m (Four w x y z)) =
658 Just2 (Deep (s - size z) pr m (Three w x y)) z
662 -- | /O(log(min(i,n-i)))/. The element at the specified position
663 index :: Seq a -> Int -> a
665 | 0 <= i && i < size xs = case lookupTree (-i) xs of
666 Place _ (Elem x) -> x
667 | otherwise = error "index out of bounds"
669 data Place a = Place {-# UNPACK #-} !Int a
674 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
675 {-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
676 lookupTree :: Sized a => Int -> FingerTree a -> Place a
677 lookupTree _ Empty = error "lookupTree of empty tree"
678 lookupTree i (Single x) = Place i x
679 lookupTree i (Deep _ pr m sf)
680 | vpr > 0 = lookupDigit i pr
681 | vm > 0 = case lookupTree vpr m of
682 Place i' xs -> lookupNode i' xs
683 | otherwise = lookupDigit vm sf
684 where vpr = i + size pr
687 {-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
688 {-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
689 lookupNode :: Sized a => Int -> Node a -> Place a
690 lookupNode i (Node2 _ a b)
692 | otherwise = Place va b
693 where va = i + size a
694 lookupNode i (Node3 _ a b c)
696 | vab > 0 = Place va b
697 | otherwise = Place vab c
698 where va = i + size a
701 {-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
702 {-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
703 lookupDigit :: Sized a => Int -> Digit a -> Place a
704 lookupDigit i (One a) = Place i a
705 lookupDigit i (Two a b)
707 | otherwise = Place va b
708 where va = i + size a
709 lookupDigit i (Three a b c)
711 | vab > 0 = Place va b
712 | otherwise = Place vab c
713 where va = i + size a
715 lookupDigit i (Four a b c d)
717 | vab > 0 = Place va b
718 | vabc > 0 = Place vab c
719 | otherwise = Place vabc d
720 where va = i + size a
724 -- | /O(log(min(i,n-i)))/. Replace the element at the specified position
725 update :: Int -> a -> Seq a -> Seq a
726 update i x = adjust (const x) i
728 -- | /O(log(min(i,n-i)))/. Update the element at the specified position
729 adjust :: (a -> a) -> Int -> Seq a -> Seq a
731 | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
734 {-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
735 {-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
736 adjustTree :: Sized a => (Int -> a -> a) ->
737 Int -> FingerTree a -> FingerTree a
738 adjustTree _ _ Empty = error "adjustTree of empty tree"
739 adjustTree f i (Single x) = Single (f i x)
740 adjustTree f i (Deep s pr m sf)
741 | vpr > 0 = Deep s (adjustDigit f i pr) m sf
742 | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
743 | otherwise = Deep s pr m (adjustDigit f vm sf)
744 where vpr = i + size pr
747 {-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
748 {-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
749 adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
750 adjustNode f i (Node2 s a b)
751 | va > 0 = Node2 s (f i a) b
752 | otherwise = Node2 s a (f va b)
753 where va = i + size a
754 adjustNode f i (Node3 s a b c)
755 | va > 0 = Node3 s (f i a) b c
756 | vab > 0 = Node3 s a (f va b) c
757 | otherwise = Node3 s a b (f vab c)
758 where va = i + size a
761 {-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
762 {-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
763 adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
764 adjustDigit f i (One a) = One (f i a)
765 adjustDigit f i (Two a b)
766 | va > 0 = Two (f i a) b
767 | otherwise = Two a (f va b)
768 where va = i + size a
769 adjustDigit f i (Three a b c)
770 | va > 0 = Three (f i a) b c
771 | vab > 0 = Three a (f va b) c
772 | otherwise = Three a b (f vab c)
773 where va = i + size a
775 adjustDigit f i (Four a b c d)
776 | va > 0 = Four (f i a) b c d
777 | vab > 0 = Four a (f va b) c d
778 | vabc > 0 = Four a b (f vab c) d
779 | otherwise = Four a b c (f vabc d)
780 where va = i + size a
786 -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
787 take :: Int -> Seq a -> Seq a
788 take i = fst . splitAt i
790 -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
791 drop :: Int -> Seq a -> Seq a
792 drop i = snd . splitAt i
794 -- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
795 splitAt :: Int -> Seq a -> (Seq a, Seq a)
796 splitAt i (Seq xs) = (Seq l, Seq r)
797 where (l, r) = split i xs
799 split :: Int -> FingerTree (Elem a) ->
800 (FingerTree (Elem a), FingerTree (Elem a))
801 split i Empty = i `seq` (Empty, Empty)
803 | size xs > i = (l, consTree x r)
804 | otherwise = (xs, Empty)
805 where Split l x r = splitTree (-i) xs
807 data Split t a = Split t a t
812 {-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
813 {-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
814 splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
815 splitTree _ Empty = error "splitTree of empty tree"
816 splitTree i (Single x) = i `seq` Split Empty x Empty
817 splitTree i (Deep _ pr m sf)
818 | vpr > 0 = case splitDigit i pr of
819 Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
820 | vm > 0 = case splitTree vpr m of
821 Split ml xs mr -> case splitNode (vpr + size ml) xs of
822 Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
823 | otherwise = case splitDigit vm sf of
824 Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
825 where vpr = i + size pr
828 {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
829 {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
830 deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
831 deepL Nothing m sf = case viewLTree m of
832 Nothing2 -> digitToTree sf
833 Just2 a m' -> deep (nodeToDigit a) m' sf
834 deepL (Just pr) m sf = deep pr m sf
836 {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
837 {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
838 deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
839 deepR pr m Nothing = case viewRTree m of
840 Nothing2 -> digitToTree pr
841 Just2 m' a -> deep pr m' (nodeToDigit a)
842 deepR pr m (Just sf) = deep pr m sf
844 {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
845 {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
846 splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
847 splitNode i (Node2 _ a b)
848 | va > 0 = Split Nothing a (Just (One b))
849 | otherwise = Split (Just (One a)) b Nothing
850 where va = i + size a
851 splitNode i (Node3 _ a b c)
852 | va > 0 = Split Nothing a (Just (Two b c))
853 | vab > 0 = Split (Just (One a)) b (Just (One c))
854 | otherwise = Split (Just (Two a b)) c Nothing
855 where va = i + size a
858 {-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
859 {-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
860 splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
861 splitDigit i (One a) = i `seq` Split Nothing a Nothing
862 splitDigit i (Two a b)
863 | va > 0 = Split Nothing a (Just (One b))
864 | otherwise = Split (Just (One a)) b Nothing
865 where va = i + size a
866 splitDigit i (Three a b c)
867 | va > 0 = Split Nothing a (Just (Two b c))
868 | vab > 0 = Split (Just (One a)) b (Just (One c))
869 | otherwise = Split (Just (Two a b)) c Nothing
870 where va = i + size a
872 splitDigit i (Four a b c d)
873 | va > 0 = Split Nothing a (Just (Three b c d))
874 | vab > 0 = Split (Just (One a)) b (Just (Two c d))
875 | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
876 | otherwise = Split (Just (Three a b c)) d Nothing
877 where va = i + size a
881 ------------------------------------------------------------------------
883 ------------------------------------------------------------------------
885 -- | /O(n)/. Create a sequence from a finite list of elements.
886 fromList :: [a] -> Seq a
887 fromList = Data.List.foldl' (|>) empty
889 -- | /O(n)/. List of elements of the sequence.
890 toList :: Seq a -> [a]
891 #ifdef __GLASGOW_HASKELL__
892 {-# INLINE toList #-}
893 toList xs = build (\ c n -> foldr c n xs)
895 toList = foldr (:) []
898 ------------------------------------------------------------------------
900 ------------------------------------------------------------------------
902 -- | /O(n*t)/. Fold over the elements of a sequence,
903 -- associating to the right.
904 foldr :: (a -> b -> b) -> b -> Seq a -> b
905 foldr f z (Seq xs) = foldrTree f' z xs
906 where f' (Elem x) y = f x y
908 foldrTree :: (a -> b -> b) -> b -> FingerTree a -> b
909 foldrTree _ z Empty = z
910 foldrTree f z (Single x) = x `f` z
911 foldrTree f z (Deep _ pr m sf) =
912 foldrDigit f (foldrTree (flip (foldrNode f)) (foldrDigit f z sf) m) pr
914 foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
915 foldrDigit f z (One a) = a `f` z
916 foldrDigit f z (Two a b) = a `f` (b `f` z)
917 foldrDigit f z (Three a b c) = a `f` (b `f` (c `f` z))
918 foldrDigit f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
920 foldrNode :: (a -> b -> b) -> b -> Node a -> b
921 foldrNode f z (Node2 _ a b) = a `f` (b `f` z)
922 foldrNode f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
924 -- | /O(n*t)/. A variant of 'foldr' that has no base case,
925 -- and thus may only be applied to non-empty sequences.
926 foldr1 :: (a -> a -> a) -> Seq a -> a
927 foldr1 f (Seq xs) = getElem (foldr1Tree f' xs)
928 where f' (Elem x) (Elem y) = Elem (f x y)
930 foldr1Tree :: (a -> a -> a) -> FingerTree a -> a
931 foldr1Tree _ Empty = error "foldr1: empty sequence"
932 foldr1Tree _ (Single x) = x
933 foldr1Tree f (Deep _ pr m sf) =
934 foldrDigit f (foldrTree (flip (foldrNode f)) (foldr1Digit f sf) m) pr
936 foldr1Digit :: (a -> a -> a) -> Digit a -> a
937 foldr1Digit f (One a) = a
938 foldr1Digit f (Two a b) = a `f` b
939 foldr1Digit f (Three a b c) = a `f` (b `f` c)
940 foldr1Digit f (Four a b c d) = a `f` (b `f` (c `f` d))
942 -- | /O(n*t)/. Fold over the elements of a sequence,
943 -- associating to the left.
944 foldl :: (a -> b -> a) -> a -> Seq b -> a
945 foldl f z (Seq xs) = foldlTree f' z xs
946 where f' x (Elem y) = f x y
948 foldlTree :: (a -> b -> a) -> a -> FingerTree b -> a
949 foldlTree _ z Empty = z
950 foldlTree f z (Single x) = z `f` x
951 foldlTree f z (Deep _ pr m sf) =
952 foldlDigit f (foldlTree (foldlNode f) (foldlDigit f z pr) m) sf
954 foldlDigit :: (a -> b -> a) -> a -> Digit b -> a
955 foldlDigit f z (One a) = z `f` a
956 foldlDigit f z (Two a b) = (z `f` a) `f` b
957 foldlDigit f z (Three a b c) = ((z `f` a) `f` b) `f` c
958 foldlDigit f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
960 foldlNode :: (a -> b -> a) -> a -> Node b -> a
961 foldlNode f z (Node2 _ a b) = (z `f` a) `f` b
962 foldlNode f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
964 -- | /O(n*t)/. A variant of 'foldl' that has no base case,
965 -- and thus may only be applied to non-empty sequences.
966 foldl1 :: (a -> a -> a) -> Seq a -> a
967 foldl1 f (Seq xs) = getElem (foldl1Tree f' xs)
968 where f' (Elem x) (Elem y) = Elem (f x y)
970 foldl1Tree :: (a -> a -> a) -> FingerTree a -> a
971 foldl1Tree _ Empty = error "foldl1: empty sequence"
972 foldl1Tree _ (Single x) = x
973 foldl1Tree f (Deep _ pr m sf) =
974 foldlDigit f (foldlTree (foldlNode f) (foldl1Digit f pr) m) sf
976 foldl1Digit :: (a -> a -> a) -> Digit a -> a
977 foldl1Digit f (One a) = a
978 foldl1Digit f (Two a b) = a `f` b
979 foldl1Digit f (Three a b c) = (a `f` b) `f` c
980 foldl1Digit f (Four a b c d) = ((a `f` b) `f` c) `f` d
982 ------------------------------------------------------------------------
984 ------------------------------------------------------------------------
986 -- | /O(n*t)/. Fold over the elements of a sequence,
987 -- associating to the right, but strictly.
988 foldr' :: (a -> b -> b) -> b -> Seq a -> b
989 foldr' f z xs = foldl f' id xs z
990 where f' k x z = k $! f x z
992 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
993 -- associating to the right, i.e. from right to left.
994 foldrM :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
995 foldrM f z xs = foldl f' return xs z
996 where f' k x z = f x z >>= k
998 -- | /O(n*t)/. Fold over the elements of a sequence,
999 -- associating to the left, but strictly.
1000 foldl' :: (a -> b -> a) -> a -> Seq b -> a
1001 foldl' f z xs = foldr f' id xs z
1002 where f' x k z = k $! f z x
1004 -- | /O(n*t)/. Monadic fold over the elements of a sequence,
1005 -- associating to the left, i.e. from left to right.
1006 foldlM :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
1007 foldlM f z xs = foldr f' return xs z
1008 where f' x k z = f z x >>= k
1010 ------------------------------------------------------------------------
1012 ------------------------------------------------------------------------
1014 -- | /O(n)/. The reverse of a sequence.
1015 reverse :: Seq a -> Seq a
1016 reverse (Seq xs) = Seq (reverseTree id xs)
1018 reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
1019 reverseTree _ Empty = Empty
1020 reverseTree f (Single x) = Single (f x)
1021 reverseTree f (Deep s pr m sf) =
1022 Deep s (reverseDigit f sf)
1023 (reverseTree (reverseNode f) m)
1026 reverseDigit :: (a -> a) -> Digit a -> Digit a
1027 reverseDigit f (One a) = One (f a)
1028 reverseDigit f (Two a b) = Two (f b) (f a)
1029 reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
1030 reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
1032 reverseNode :: (a -> a) -> Node a -> Node a
1033 reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
1034 reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
1038 ------------------------------------------------------------------------
1040 ------------------------------------------------------------------------
1042 instance Arbitrary a => Arbitrary (Seq a) where
1043 arbitrary = liftM Seq arbitrary
1044 coarbitrary (Seq x) = coarbitrary x
1046 instance Arbitrary a => Arbitrary (Elem a) where
1047 arbitrary = liftM Elem arbitrary
1048 coarbitrary (Elem x) = coarbitrary x
1050 instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
1051 arbitrary = sized arb
1052 where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
1053 arb 0 = return Empty
1054 arb 1 = liftM Single arbitrary
1055 arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
1057 coarbitrary Empty = variant 0
1058 coarbitrary (Single x) = variant 1 . coarbitrary x
1059 coarbitrary (Deep _ pr m sf) =
1060 variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
1062 instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
1064 liftM2 node2 arbitrary arbitrary,
1065 liftM3 node3 arbitrary arbitrary arbitrary]
1067 coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
1068 coarbitrary (Node3 _ a b c) =
1069 variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
1071 instance Arbitrary a => Arbitrary (Digit a) where
1073 liftM One arbitrary,
1074 liftM2 Two arbitrary arbitrary,
1075 liftM3 Three arbitrary arbitrary arbitrary,
1076 liftM4 Four arbitrary arbitrary arbitrary arbitrary]
1078 coarbitrary (One a) = variant 0 . coarbitrary a
1079 coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
1080 coarbitrary (Three a b c) =
1081 variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
1082 coarbitrary (Four a b c d) =
1083 variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
1085 ------------------------------------------------------------------------
1087 ------------------------------------------------------------------------
1092 instance Valid (Elem a) where
1095 instance Valid (Seq a) where
1096 valid (Seq xs) = valid xs
1098 instance (Sized a, Valid a) => Valid (FingerTree a) where
1100 valid (Single x) = valid x
1101 valid (Deep s pr m sf) =
1102 s == size pr + size m + size sf && valid pr && valid m && valid sf
1104 instance (Sized a, Valid a) => Valid (Node a) where
1105 valid (Node2 s a b) = s == size a + size b && valid a && valid b
1106 valid (Node3 s a b c) =
1107 s == size a + size b + size c && valid a && valid b && valid c
1109 instance Valid a => Valid (Digit a) where
1110 valid (One a) = valid a
1111 valid (Two a b) = valid a && valid b
1112 valid (Three a b c) = valid a && valid b && valid c
1113 valid (Four a b c d) = valid a && valid b && valid c && valid d