Prefer #if defined to #ifdef
[ghc.git] / libraries / base / Data / OldList.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables,
3 MagicHash, BangPatterns #-}
4
5 -----------------------------------------------------------------------------
6 -- |
7 -- Module : Data.List
8 -- Copyright : (c) The University of Glasgow 2001
9 -- License : BSD-style (see the file libraries/base/LICENSE)
10 --
11 -- Maintainer : libraries@haskell.org
12 -- Stability : stable
13 -- Portability : portable
14 --
15 -- Operations on lists.
16 --
17 -----------------------------------------------------------------------------
18
19 module Data.OldList
20 (
21 -- * Basic functions
22
23 (++)
24 , head
25 , last
26 , tail
27 , init
28 , uncons
29 , null
30 , length
31
32 -- * List transformations
33 , map
34 , reverse
35
36 , intersperse
37 , intercalate
38 , transpose
39
40 , subsequences
41 , permutations
42
43 -- * Reducing lists (folds)
44
45 , foldl
46 , foldl'
47 , foldl1
48 , foldl1'
49 , foldr
50 , foldr1
51
52 -- ** Special folds
53
54 , concat
55 , concatMap
56 , and
57 , or
58 , any
59 , all
60 , sum
61 , product
62 , maximum
63 , minimum
64
65 -- * Building lists
66
67 -- ** Scans
68 , scanl
69 , scanl'
70 , scanl1
71 , scanr
72 , scanr1
73
74 -- ** Accumulating maps
75 , mapAccumL
76 , mapAccumR
77
78 -- ** Infinite lists
79 , iterate
80 , repeat
81 , replicate
82 , cycle
83
84 -- ** Unfolding
85 , unfoldr
86
87 -- * Sublists
88
89 -- ** Extracting sublists
90 , take
91 , drop
92 , splitAt
93
94 , takeWhile
95 , dropWhile
96 , dropWhileEnd
97 , span
98 , break
99
100 , stripPrefix
101
102 , group
103
104 , inits
105 , tails
106
107 -- ** Predicates
108 , isPrefixOf
109 , isSuffixOf
110 , isInfixOf
111
112 -- * Searching lists
113
114 -- ** Searching by equality
115 , elem
116 , notElem
117 , lookup
118
119 -- ** Searching with a predicate
120 , find
121 , filter
122 , partition
123
124 -- * Indexing lists
125 -- | These functions treat a list @xs@ as a indexed collection,
126 -- with indices ranging from 0 to @'length' xs - 1@.
127
128 , (!!)
129
130 , elemIndex
131 , elemIndices
132
133 , findIndex
134 , findIndices
135
136 -- * Zipping and unzipping lists
137
138 , zip
139 , zip3
140 , zip4, zip5, zip6, zip7
141
142 , zipWith
143 , zipWith3
144 , zipWith4, zipWith5, zipWith6, zipWith7
145
146 , unzip
147 , unzip3
148 , unzip4, unzip5, unzip6, unzip7
149
150 -- * Special lists
151
152 -- ** Functions on strings
153 , lines
154 , words
155 , unlines
156 , unwords
157
158 -- ** \"Set\" operations
159
160 , nub
161
162 , delete
163 , (\\)
164
165 , union
166 , intersect
167
168 -- ** Ordered lists
169 , sort
170 , sortOn
171 , insert
172
173 -- * Generalized functions
174
175 -- ** The \"@By@\" operations
176 -- | By convention, overloaded functions have a non-overloaded
177 -- counterpart whose name is suffixed with \`@By@\'.
178 --
179 -- It is often convenient to use these functions together with
180 -- 'Data.Function.on', for instance @'sortBy' ('compare'
181 -- \`on\` 'fst')@.
182
183 -- *** User-supplied equality (replacing an @Eq@ context)
184 -- | The predicate is assumed to define an equivalence.
185 , nubBy
186 , deleteBy
187 , deleteFirstsBy
188 , unionBy
189 , intersectBy
190 , groupBy
191
192 -- *** User-supplied comparison (replacing an @Ord@ context)
193 -- | The function is assumed to define a total ordering.
194 , sortBy
195 , insertBy
196 , maximumBy
197 , minimumBy
198
199 -- ** The \"@generic@\" operations
200 -- | The prefix \`@generic@\' indicates an overloaded function that
201 -- is a generalized version of a "Prelude" function.
202
203 , genericLength
204 , genericTake
205 , genericDrop
206 , genericSplitAt
207 , genericIndex
208 , genericReplicate
209
210 ) where
211
212 import Data.Maybe
213 import Data.Bits ( (.&.) )
214 import Data.Char ( isSpace )
215 import Data.Ord ( comparing )
216 import Data.Tuple ( fst, snd )
217
218 import GHC.Num
219 import GHC.Real
220 import GHC.List
221 import GHC.Base
222
223 infix 5 \\ -- comment to fool cpp: https://www.haskell.org/ghc/docs/latest/html/users_guide/options-phases.html#cpp-string-gaps
224
225 -- -----------------------------------------------------------------------------
226 -- List functions
227
228 -- | The 'dropWhileEnd' function drops the largest suffix of a list
229 -- in which the given predicate holds for all elements. For example:
230 --
231 -- > dropWhileEnd isSpace "foo\n" == "foo"
232 -- > dropWhileEnd isSpace "foo bar" == "foo bar"
233 -- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined
234 --
235 -- @since 4.5.0.0
236 dropWhileEnd :: (a -> Bool) -> [a] -> [a]
237 dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
238
239 -- | The 'stripPrefix' function drops the given prefix from a list.
240 -- It returns 'Nothing' if the list did not start with the prefix
241 -- given, or 'Just' the list after the prefix, if it does.
242 --
243 -- > stripPrefix "foo" "foobar" == Just "bar"
244 -- > stripPrefix "foo" "foo" == Just ""
245 -- > stripPrefix "foo" "barfoo" == Nothing
246 -- > stripPrefix "foo" "barfoobaz" == Nothing
247 stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
248 stripPrefix [] ys = Just ys
249 stripPrefix (x:xs) (y:ys)
250 | x == y = stripPrefix xs ys
251 stripPrefix _ _ = Nothing
252
253 -- | The 'elemIndex' function returns the index of the first element
254 -- in the given list which is equal (by '==') to the query element,
255 -- or 'Nothing' if there is no such element.
256 elemIndex :: Eq a => a -> [a] -> Maybe Int
257 elemIndex x = findIndex (x==)
258
259 -- | The 'elemIndices' function extends 'elemIndex', by returning the
260 -- indices of all elements equal to the query element, in ascending order.
261 elemIndices :: Eq a => a -> [a] -> [Int]
262 elemIndices x = findIndices (x==)
263
264 -- | The 'find' function takes a predicate and a list and returns the
265 -- first element in the list matching the predicate, or 'Nothing' if
266 -- there is no such element.
267 find :: (a -> Bool) -> [a] -> Maybe a
268 find p = listToMaybe . filter p
269
270 -- | The 'findIndex' function takes a predicate and a list and returns
271 -- the index of the first element in the list satisfying the predicate,
272 -- or 'Nothing' if there is no such element.
273 findIndex :: (a -> Bool) -> [a] -> Maybe Int
274 findIndex p = listToMaybe . findIndices p
275
276 -- | The 'findIndices' function extends 'findIndex', by returning the
277 -- indices of all elements satisfying the predicate, in ascending order.
278 findIndices :: (a -> Bool) -> [a] -> [Int]
279 #if defined(USE_REPORT_PRELUDE)
280 findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
281 #else
282 -- Efficient definition, adapted from Data.Sequence
283 {-# INLINE findIndices #-}
284 findIndices p ls = build $ \c n ->
285 let go x r k | p x = I# k `c` r (k +# 1#)
286 | otherwise = r (k +# 1#)
287 in foldr go (\_ -> n) ls 0#
288 #endif /* USE_REPORT_PRELUDE */
289
290 -- | The 'isPrefixOf' function takes two lists and returns 'True'
291 -- iff the first list is a prefix of the second.
292 isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
293 isPrefixOf [] _ = True
294 isPrefixOf _ [] = False
295 isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys
296
297 -- | The 'isSuffixOf' function takes two lists and returns 'True' iff
298 -- the first list is a suffix of the second. The second list must be
299 -- finite.
300 isSuffixOf :: (Eq a) => [a] -> [a] -> Bool
301 ns `isSuffixOf` hs = maybe False id $ do
302 delta <- dropLengthMaybe ns hs
303 return $ ns == dropLength delta hs
304 -- Since dropLengthMaybe ns hs succeeded, we know that (if hs is finite)
305 -- length ns + length delta = length hs
306 -- so dropping the length of delta from hs will yield a suffix exactly
307 -- the length of ns.
308
309 -- A version of drop that drops the length of the first argument from the
310 -- second argument. If xs is longer than ys, xs will not be traversed in its
311 -- entirety. dropLength is also generally faster than (drop . length)
312 -- Both this and dropLengthMaybe could be written as folds over their first
313 -- arguments, but this reduces clarity with no benefit to isSuffixOf.
314 dropLength :: [a] -> [b] -> [b]
315 dropLength [] y = y
316 dropLength _ [] = []
317 dropLength (_:x') (_:y') = dropLength x' y'
318
319 -- A version of dropLength that returns Nothing if the second list runs out of
320 -- elements before the first.
321 dropLengthMaybe :: [a] -> [b] -> Maybe [b]
322 dropLengthMaybe [] y = Just y
323 dropLengthMaybe _ [] = Nothing
324 dropLengthMaybe (_:x') (_:y') = dropLengthMaybe x' y'
325
326 -- | The 'isInfixOf' function takes two lists and returns 'True'
327 -- iff the first list is contained, wholly and intact,
328 -- anywhere within the second.
329 --
330 -- Example:
331 --
332 -- >isInfixOf "Haskell" "I really like Haskell." == True
333 -- >isInfixOf "Ial" "I really like Haskell." == False
334 isInfixOf :: (Eq a) => [a] -> [a] -> Bool
335 isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
336
337 -- | /O(n^2)/. The 'nub' function removes duplicate elements from a list.
338 -- In particular, it keeps only the first occurrence of each element.
339 -- (The name 'nub' means \`essence\'.)
340 -- It is a special case of 'nubBy', which allows the programmer to supply
341 -- their own equality test.
342 nub :: (Eq a) => [a] -> [a]
343 nub = nubBy (==)
344
345 -- | The 'nubBy' function behaves just like 'nub', except it uses a
346 -- user-supplied equality predicate instead of the overloaded '=='
347 -- function.
348 nubBy :: (a -> a -> Bool) -> [a] -> [a]
349 #if defined(USE_REPORT_PRELUDE)
350 nubBy eq [] = []
351 nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs)
352 #else
353 -- stolen from HBC
354 nubBy eq l = nubBy' l []
355 where
356 nubBy' [] _ = []
357 nubBy' (y:ys) xs
358 | elem_by eq y xs = nubBy' ys xs
359 | otherwise = y : nubBy' ys (y:xs)
360
361 -- Not exported:
362 -- Note that we keep the call to `eq` with arguments in the
363 -- same order as in the reference (prelude) implementation,
364 -- and that this order is different from how `elem` calls (==).
365 -- See #2528, #3280 and #7913.
366 -- 'xs' is the list of things we've seen so far,
367 -- 'y' is the potential new element
368 elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
369 elem_by _ _ [] = False
370 elem_by eq y (x:xs) = x `eq` y || elem_by eq y xs
371 #endif
372
373
374 -- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.
375 -- For example,
376 --
377 -- > delete 'a' "banana" == "bnana"
378 --
379 -- It is a special case of 'deleteBy', which allows the programmer to
380 -- supply their own equality test.
381
382 delete :: (Eq a) => a -> [a] -> [a]
383 delete = deleteBy (==)
384
385 -- | The 'deleteBy' function behaves like 'delete', but takes a
386 -- user-supplied equality predicate.
387 deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
388 deleteBy _ _ [] = []
389 deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys
390
391 -- | The '\\' function is list difference (non-associative).
392 -- In the result of @xs@ '\\' @ys@, the first occurrence of each element of
393 -- @ys@ in turn (if any) has been removed from @xs@. Thus
394 --
395 -- > (xs ++ ys) \\ xs == ys.
396 --
397 -- It is a special case of 'deleteFirstsBy', which allows the programmer
398 -- to supply their own equality test.
399
400 (\\) :: (Eq a) => [a] -> [a] -> [a]
401 (\\) = foldl (flip delete)
402
403 -- | The 'union' function returns the list union of the two lists.
404 -- For example,
405 --
406 -- > "dog" `union` "cow" == "dogcw"
407 --
408 -- Duplicates, and elements of the first list, are removed from the
409 -- the second list, but if the first list contains duplicates, so will
410 -- the result.
411 -- It is a special case of 'unionBy', which allows the programmer to supply
412 -- their own equality test.
413
414 union :: (Eq a) => [a] -> [a] -> [a]
415 union = unionBy (==)
416
417 -- | The 'unionBy' function is the non-overloaded version of 'union'.
418 unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
419 unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
420
421 -- | The 'intersect' function takes the list intersection of two lists.
422 -- For example,
423 --
424 -- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]
425 --
426 -- If the first list contains duplicates, so will the result.
427 --
428 -- > [1,2,2,3,4] `intersect` [6,4,4,2] == [2,2,4]
429 --
430 -- It is a special case of 'intersectBy', which allows the programmer to
431 -- supply their own equality test. If the element is found in both the first
432 -- and the second list, the element from the first list will be used.
433
434 intersect :: (Eq a) => [a] -> [a] -> [a]
435 intersect = intersectBy (==)
436
437 -- | The 'intersectBy' function is the non-overloaded version of 'intersect'.
438 intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
439 intersectBy _ [] _ = []
440 intersectBy _ _ [] = []
441 intersectBy eq xs ys = [x | x <- xs, any (eq x) ys]
442
443 -- | The 'intersperse' function takes an element and a list and
444 -- \`intersperses\' that element between the elements of the list.
445 -- For example,
446 --
447 -- > intersperse ',' "abcde" == "a,b,c,d,e"
448
449 intersperse :: a -> [a] -> [a]
450 intersperse _ [] = []
451 intersperse sep (x:xs) = x : prependToAll sep xs
452
453
454 -- Not exported:
455 -- We want to make every element in the 'intersperse'd list available
456 -- as soon as possible to avoid space leaks. Experiments suggested that
457 -- a separate top-level helper is more efficient than a local worker.
458 prependToAll :: a -> [a] -> [a]
459 prependToAll _ [] = []
460 prependToAll sep (x:xs) = sep : x : prependToAll sep xs
461
462 -- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@.
463 -- It inserts the list @xs@ in between the lists in @xss@ and concatenates the
464 -- result.
465 intercalate :: [a] -> [[a]] -> [a]
466 intercalate xs xss = concat (intersperse xs xss)
467
468 -- | The 'transpose' function transposes the rows and columns of its argument.
469 -- For example,
470 --
471 -- > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]
472 --
473 -- If some of the rows are shorter than the following rows, their elements are skipped:
474 --
475 -- > transpose [[10,11],[20],[],[30,31,32]] == [[10,20,30],[11,31],[32]]
476
477 transpose :: [[a]] -> [[a]]
478 transpose [] = []
479 transpose ([] : xss) = transpose xss
480 transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])
481
482
483 -- | The 'partition' function takes a predicate a list and returns
484 -- the pair of lists of elements which do and do not satisfy the
485 -- predicate, respectively; i.e.,
486 --
487 -- > partition p xs == (filter p xs, filter (not . p) xs)
488
489 partition :: (a -> Bool) -> [a] -> ([a],[a])
490 {-# INLINE partition #-}
491 partition p xs = foldr (select p) ([],[]) xs
492
493 select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
494 select p x ~(ts,fs) | p x = (x:ts,fs)
495 | otherwise = (ts, x:fs)
496
497 -- | The 'mapAccumL' function behaves like a combination of 'map' and
498 -- 'foldl'; it applies a function to each element of a list, passing
499 -- an accumulating parameter from left to right, and returning a final
500 -- value of this accumulator together with the new list.
501 mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
502 -- and accumulator, returning new
503 -- accumulator and elt of result list
504 -> acc -- Initial accumulator
505 -> [x] -- Input list
506 -> (acc, [y]) -- Final accumulator and result list
507 {-# NOINLINE [1] mapAccumL #-}
508 mapAccumL _ s [] = (s, [])
509 mapAccumL f s (x:xs) = (s'',y:ys)
510 where (s', y ) = f s x
511 (s'',ys) = mapAccumL f s' xs
512
513 {-# RULES
514 "mapAccumL" [~1] forall f s xs . mapAccumL f s xs = foldr (mapAccumLF f) pairWithNil xs s
515 "mapAccumLList" [1] forall f s xs . foldr (mapAccumLF f) pairWithNil xs s = mapAccumL f s xs
516 #-}
517
518 pairWithNil :: acc -> (acc, [y])
519 {-# INLINE [0] pairWithNil #-}
520 pairWithNil x = (x, [])
521
522 mapAccumLF :: (acc -> x -> (acc, y)) -> x -> (acc -> (acc, [y])) -> acc -> (acc, [y])
523 {-# INLINE [0] mapAccumLF #-}
524 mapAccumLF f = \x r -> oneShot (\s ->
525 let (s', y) = f s x
526 (s'', ys) = r s'
527 in (s'', y:ys))
528 -- See Note [Left folds via right fold]
529
530
531 -- | The 'mapAccumR' function behaves like a combination of 'map' and
532 -- 'foldr'; it applies a function to each element of a list, passing
533 -- an accumulating parameter from right to left, and returning a final
534 -- value of this accumulator together with the new list.
535 mapAccumR :: (acc -> x -> (acc, y)) -- Function of elt of input list
536 -- and accumulator, returning new
537 -- accumulator and elt of result list
538 -> acc -- Initial accumulator
539 -> [x] -- Input list
540 -> (acc, [y]) -- Final accumulator and result list
541 mapAccumR _ s [] = (s, [])
542 mapAccumR f s (x:xs) = (s'', y:ys)
543 where (s'',y ) = f s' x
544 (s', ys) = mapAccumR f s xs
545
546 -- | The 'insert' function takes an element and a list and inserts the
547 -- element into the list at the first position where it is less
548 -- than or equal to the next element. In particular, if the list
549 -- is sorted before the call, the result will also be sorted.
550 -- It is a special case of 'insertBy', which allows the programmer to
551 -- supply their own comparison function.
552 insert :: Ord a => a -> [a] -> [a]
553 insert e ls = insertBy (compare) e ls
554
555 -- | The non-overloaded version of 'insert'.
556 insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
557 insertBy _ x [] = [x]
558 insertBy cmp x ys@(y:ys')
559 = case cmp x y of
560 GT -> y : insertBy cmp x ys'
561 _ -> x : ys
562
563 -- | The 'maximumBy' function takes a comparison function and a list
564 -- and returns the greatest element of the list by the comparison function.
565 -- The list must be finite and non-empty.
566 maximumBy :: (a -> a -> Ordering) -> [a] -> a
567 maximumBy _ [] = errorWithoutStackTrace "List.maximumBy: empty list"
568 maximumBy cmp xs = foldl1 maxBy xs
569 where
570 maxBy x y = case cmp x y of
571 GT -> x
572 _ -> y
573
574 -- | The 'minimumBy' function takes a comparison function and a list
575 -- and returns the least element of the list by the comparison function.
576 -- The list must be finite and non-empty.
577 minimumBy :: (a -> a -> Ordering) -> [a] -> a
578 minimumBy _ [] = errorWithoutStackTrace "List.minimumBy: empty list"
579 minimumBy cmp xs = foldl1 minBy xs
580 where
581 minBy x y = case cmp x y of
582 GT -> y
583 _ -> x
584
585 -- | The 'genericLength' function is an overloaded version of 'length'. In
586 -- particular, instead of returning an 'Int', it returns any type which is
587 -- an instance of 'Num'. It is, however, less efficient than 'length'.
588 genericLength :: (Num i) => [a] -> i
589 {-# NOINLINE [1] genericLength #-}
590 genericLength [] = 0
591 genericLength (_:l) = 1 + genericLength l
592
593 {-# RULES
594 "genericLengthInt" genericLength = (strictGenericLength :: [a] -> Int);
595 "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer);
596 #-}
597
598 strictGenericLength :: (Num i) => [b] -> i
599 strictGenericLength l = gl l 0
600 where
601 gl [] a = a
602 gl (_:xs) a = let a' = a + 1 in a' `seq` gl xs a'
603
604 -- | The 'genericTake' function is an overloaded version of 'take', which
605 -- accepts any 'Integral' value as the number of elements to take.
606 genericTake :: (Integral i) => i -> [a] -> [a]
607 genericTake n _ | n <= 0 = []
608 genericTake _ [] = []
609 genericTake n (x:xs) = x : genericTake (n-1) xs
610
611 -- | The 'genericDrop' function is an overloaded version of 'drop', which
612 -- accepts any 'Integral' value as the number of elements to drop.
613 genericDrop :: (Integral i) => i -> [a] -> [a]
614 genericDrop n xs | n <= 0 = xs
615 genericDrop _ [] = []
616 genericDrop n (_:xs) = genericDrop (n-1) xs
617
618
619 -- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which
620 -- accepts any 'Integral' value as the position at which to split.
621 genericSplitAt :: (Integral i) => i -> [a] -> ([a], [a])
622 genericSplitAt n xs | n <= 0 = ([],xs)
623 genericSplitAt _ [] = ([],[])
624 genericSplitAt n (x:xs) = (x:xs',xs'') where
625 (xs',xs'') = genericSplitAt (n-1) xs
626
627 -- | The 'genericIndex' function is an overloaded version of '!!', which
628 -- accepts any 'Integral' value as the index.
629 genericIndex :: (Integral i) => [a] -> i -> a
630 genericIndex (x:_) 0 = x
631 genericIndex (_:xs) n
632 | n > 0 = genericIndex xs (n-1)
633 | otherwise = errorWithoutStackTrace "List.genericIndex: negative argument."
634 genericIndex _ _ = errorWithoutStackTrace "List.genericIndex: index too large."
635
636 -- | The 'genericReplicate' function is an overloaded version of 'replicate',
637 -- which accepts any 'Integral' value as the number of repetitions to make.
638 genericReplicate :: (Integral i) => i -> a -> [a]
639 genericReplicate n x = genericTake n (repeat x)
640
641 -- | The 'zip4' function takes four lists and returns a list of
642 -- quadruples, analogous to 'zip'.
643 zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
644 zip4 = zipWith4 (,,,)
645
646 -- | The 'zip5' function takes five lists and returns a list of
647 -- five-tuples, analogous to 'zip'.
648 zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
649 zip5 = zipWith5 (,,,,)
650
651 -- | The 'zip6' function takes six lists and returns a list of six-tuples,
652 -- analogous to 'zip'.
653 zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
654 [(a,b,c,d,e,f)]
655 zip6 = zipWith6 (,,,,,)
656
657 -- | The 'zip7' function takes seven lists and returns a list of
658 -- seven-tuples, analogous to 'zip'.
659 zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
660 [g] -> [(a,b,c,d,e,f,g)]
661 zip7 = zipWith7 (,,,,,,)
662
663 -- | The 'zipWith4' function takes a function which combines four
664 -- elements, as well as four lists and returns a list of their point-wise
665 -- combination, analogous to 'zipWith'.
666 zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
667 zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
668 = z a b c d : zipWith4 z as bs cs ds
669 zipWith4 _ _ _ _ _ = []
670
671 -- | The 'zipWith5' function takes a function which combines five
672 -- elements, as well as five lists and returns a list of their point-wise
673 -- combination, analogous to 'zipWith'.
674 zipWith5 :: (a->b->c->d->e->f) ->
675 [a]->[b]->[c]->[d]->[e]->[f]
676 zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
677 = z a b c d e : zipWith5 z as bs cs ds es
678 zipWith5 _ _ _ _ _ _ = []
679
680 -- | The 'zipWith6' function takes a function which combines six
681 -- elements, as well as six lists and returns a list of their point-wise
682 -- combination, analogous to 'zipWith'.
683 zipWith6 :: (a->b->c->d->e->f->g) ->
684 [a]->[b]->[c]->[d]->[e]->[f]->[g]
685 zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
686 = z a b c d e f : zipWith6 z as bs cs ds es fs
687 zipWith6 _ _ _ _ _ _ _ = []
688
689 -- | The 'zipWith7' function takes a function which combines seven
690 -- elements, as well as seven lists and returns a list of their point-wise
691 -- combination, analogous to 'zipWith'.
692 zipWith7 :: (a->b->c->d->e->f->g->h) ->
693 [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
694 zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
695 = z a b c d e f g : zipWith7 z as bs cs ds es fs gs
696 zipWith7 _ _ _ _ _ _ _ _ = []
697
698 -- | The 'unzip4' function takes a list of quadruples and returns four
699 -- lists, analogous to 'unzip'.
700 unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d])
701 unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
702 (a:as,b:bs,c:cs,d:ds))
703 ([],[],[],[])
704
705 -- | The 'unzip5' function takes a list of five-tuples and returns five
706 -- lists, analogous to 'unzip'.
707 unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
708 unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
709 (a:as,b:bs,c:cs,d:ds,e:es))
710 ([],[],[],[],[])
711
712 -- | The 'unzip6' function takes a list of six-tuples and returns six
713 -- lists, analogous to 'unzip'.
714 unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
715 unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
716 (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
717 ([],[],[],[],[],[])
718
719 -- | The 'unzip7' function takes a list of seven-tuples and returns
720 -- seven lists, analogous to 'unzip'.
721 unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
722 unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
723 (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
724 ([],[],[],[],[],[],[])
725
726
727 -- | The 'deleteFirstsBy' function takes a predicate and two lists and
728 -- returns the first list with the first occurrence of each element of
729 -- the second list removed.
730 deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
731 deleteFirstsBy eq = foldl (flip (deleteBy eq))
732
733 -- | The 'group' function takes a list and returns a list of lists such
734 -- that the concatenation of the result is equal to the argument. Moreover,
735 -- each sublist in the result contains only equal elements. For example,
736 --
737 -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
738 --
739 -- It is a special case of 'groupBy', which allows the programmer to supply
740 -- their own equality test.
741 group :: Eq a => [a] -> [[a]]
742 group = groupBy (==)
743
744 -- | The 'groupBy' function is the non-overloaded version of 'group'.
745 groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
746 groupBy _ [] = []
747 groupBy eq (x:xs) = (x:ys) : groupBy eq zs
748 where (ys,zs) = span (eq x) xs
749
750 -- | The 'inits' function returns all initial segments of the argument,
751 -- shortest first. For example,
752 --
753 -- > inits "abc" == ["","a","ab","abc"]
754 --
755 -- Note that 'inits' has the following strictness property:
756 -- @inits (xs ++ _|_) = inits xs ++ _|_@
757 --
758 -- In particular,
759 -- @inits _|_ = [] : _|_@
760 inits :: [a] -> [[a]]
761 inits = map toListSB . scanl' snocSB emptySB
762 {-# NOINLINE inits #-}
763
764 -- We do not allow inits to inline, because it plays havoc with Call Arity
765 -- if it fuses with a consumer, and it would generally lead to serious
766 -- loss of sharing if allowed to fuse with a producer.
767
768 -- | The 'tails' function returns all final segments of the argument,
769 -- longest first. For example,
770 --
771 -- > tails "abc" == ["abc", "bc", "c",""]
772 --
773 -- Note that 'tails' has the following strictness property:
774 -- @tails _|_ = _|_ : _|_@
775 tails :: [a] -> [[a]]
776 {-# INLINABLE tails #-}
777 tails lst = build (\c n ->
778 let tailsGo xs = xs `c` case xs of
779 [] -> n
780 _ : xs' -> tailsGo xs'
781 in tailsGo lst)
782
783 -- | The 'subsequences' function returns the list of all subsequences of the argument.
784 --
785 -- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
786 subsequences :: [a] -> [[a]]
787 subsequences xs = [] : nonEmptySubsequences xs
788
789 -- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,
790 -- except for the empty list.
791 --
792 -- > nonEmptySubsequences "abc" == ["a","b","ab","c","ac","bc","abc"]
793 nonEmptySubsequences :: [a] -> [[a]]
794 nonEmptySubsequences [] = []
795 nonEmptySubsequences (x:xs) = [x] : foldr f [] (nonEmptySubsequences xs)
796 where f ys r = ys : (x : ys) : r
797
798
799 -- | The 'permutations' function returns the list of all permutations of the argument.
800 --
801 -- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]
802 permutations :: [a] -> [[a]]
803 permutations xs0 = xs0 : perms xs0 []
804 where
805 perms [] _ = []
806 perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
807 where interleave xs r = let (_,zs) = interleave' id xs r in zs
808 interleave' _ [] r = (ts, r)
809 interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
810 in (y:us, f (t:y:us) : zs)
811
812
813 ------------------------------------------------------------------------------
814 -- Quick Sort algorithm taken from HBC's QSort library.
815
816 -- | The 'sort' function implements a stable sorting algorithm.
817 -- It is a special case of 'sortBy', which allows the programmer to supply
818 -- their own comparison function.
819 --
820 -- Elements are arranged from from lowest to highest, keeping duplicates in
821 -- the order they appeared in the input.
822 sort :: (Ord a) => [a] -> [a]
823
824 -- | The 'sortBy' function is the non-overloaded version of 'sort'.
825 sortBy :: (a -> a -> Ordering) -> [a] -> [a]
826
827 #if defined(USE_REPORT_PRELUDE)
828 sort = sortBy compare
829 sortBy cmp = foldr (insertBy cmp) []
830 #else
831
832 {-
833 GHC's mergesort replaced by a better implementation, 24/12/2009.
834 This code originally contributed to the nhc12 compiler by Thomas Nordin
835 in 2002. Rumoured to have been based on code by Lennart Augustsson, e.g.
836 http://www.mail-archive.com/haskell@haskell.org/msg01822.html
837 and possibly to bear similarities to a 1982 paper by Richard O'Keefe:
838 "A smooth applicative merge sort".
839
840 Benchmarks show it to be often 2x the speed of the previous implementation.
841 Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/2143
842 -}
843
844 sort = sortBy compare
845 sortBy cmp = mergeAll . sequences
846 where
847 sequences (a:b:xs)
848 | a `cmp` b == GT = descending b [a] xs
849 | otherwise = ascending b (a:) xs
850 sequences xs = [xs]
851
852 descending a as (b:bs)
853 | a `cmp` b == GT = descending b (a:as) bs
854 descending a as bs = (a:as): sequences bs
855
856 ascending a as (b:bs)
857 | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs
858 ascending a as bs = let !x = as [a]
859 in x : sequences bs
860
861 mergeAll [x] = x
862 mergeAll xs = mergeAll (mergePairs xs)
863
864 mergePairs (a:b:xs) = let !x = merge a b
865 in x : mergePairs xs
866 mergePairs xs = xs
867
868 merge as@(a:as') bs@(b:bs')
869 | a `cmp` b == GT = b:merge as bs'
870 | otherwise = a:merge as' bs
871 merge [] bs = bs
872 merge as [] = as
873
874 {-
875 sortBy cmp l = mergesort cmp l
876 sort l = mergesort compare l
877
878 Quicksort replaced by mergesort, 14/5/2002.
879
880 From: Ian Lynagh <igloo@earth.li>
881
882 I am curious as to why the List.sort implementation in GHC is a
883 quicksort algorithm rather than an algorithm that guarantees n log n
884 time in the worst case? I have attached a mergesort implementation along
885 with a few scripts to time it's performance, the results of which are
886 shown below (* means it didn't finish successfully - in all cases this
887 was due to a stack overflow).
888
889 If I heap profile the random_list case with only 10000 then I see
890 random_list peaks at using about 2.5M of memory, whereas in the same
891 program using List.sort it uses only 100k.
892
893 Input style Input length Sort data Sort alg User time
894 stdin 10000 random_list sort 2.82
895 stdin 10000 random_list mergesort 2.96
896 stdin 10000 sorted sort 31.37
897 stdin 10000 sorted mergesort 1.90
898 stdin 10000 revsorted sort 31.21
899 stdin 10000 revsorted mergesort 1.88
900 stdin 100000 random_list sort *
901 stdin 100000 random_list mergesort *
902 stdin 100000 sorted sort *
903 stdin 100000 sorted mergesort *
904 stdin 100000 revsorted sort *
905 stdin 100000 revsorted mergesort *
906 func 10000 random_list sort 0.31
907 func 10000 random_list mergesort 0.91
908 func 10000 sorted sort 19.09
909 func 10000 sorted mergesort 0.15
910 func 10000 revsorted sort 19.17
911 func 10000 revsorted mergesort 0.16
912 func 100000 random_list sort 3.85
913 func 100000 random_list mergesort *
914 func 100000 sorted sort 5831.47
915 func 100000 sorted mergesort 2.23
916 func 100000 revsorted sort 5872.34
917 func 100000 revsorted mergesort 2.24
918
919 mergesort :: (a -> a -> Ordering) -> [a] -> [a]
920 mergesort cmp = mergesort' cmp . map wrap
921
922 mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
923 mergesort' _ [] = []
924 mergesort' _ [xs] = xs
925 mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
926
927 merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
928 merge_pairs _ [] = []
929 merge_pairs _ [xs] = [xs]
930 merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
931
932 merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
933 merge _ [] ys = ys
934 merge _ xs [] = xs
935 merge cmp (x:xs) (y:ys)
936 = case x `cmp` y of
937 GT -> y : merge cmp (x:xs) ys
938 _ -> x : merge cmp xs (y:ys)
939
940 wrap :: a -> [a]
941 wrap x = [x]
942
943
944
945 OLDER: qsort version
946
947 -- qsort is stable and does not concatenate.
948 qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
949 qsort _ [] r = r
950 qsort _ [x] r = x:r
951 qsort cmp (x:xs) r = qpart cmp x xs [] [] r
952
953 -- qpart partitions and sorts the sublists
954 qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
955 qpart cmp x [] rlt rge r =
956 -- rlt and rge are in reverse order and must be sorted with an
957 -- anti-stable sorting
958 rqsort cmp rlt (x:rqsort cmp rge r)
959 qpart cmp x (y:ys) rlt rge r =
960 case cmp x y of
961 GT -> qpart cmp x ys (y:rlt) rge r
962 _ -> qpart cmp x ys rlt (y:rge) r
963
964 -- rqsort is as qsort but anti-stable, i.e. reverses equal elements
965 rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
966 rqsort _ [] r = r
967 rqsort _ [x] r = x:r
968 rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r
969
970 rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
971 rqpart cmp x [] rle rgt r =
972 qsort cmp rle (x:qsort cmp rgt r)
973 rqpart cmp x (y:ys) rle rgt r =
974 case cmp y x of
975 GT -> rqpart cmp x ys rle (y:rgt) r
976 _ -> rqpart cmp x ys (y:rle) rgt r
977 -}
978
979 #endif /* USE_REPORT_PRELUDE */
980
981 -- | Sort a list by comparing the results of a key function applied to each
982 -- element. @sortOn f@ is equivalent to @sortBy (comparing f)@, but has the
983 -- performance advantage of only evaluating @f@ once for each element in the
984 -- input list. This is called the decorate-sort-undecorate paradigm, or
985 -- Schwartzian transform.
986 --
987 -- Elements are arranged from from lowest to highest, keeping duplicates in
988 -- the order they appeared in the input.
989 --
990 -- @since 4.8.0.0
991 sortOn :: Ord b => (a -> b) -> [a] -> [a]
992 sortOn f =
993 map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))
994
995 -- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'
996 -- reduces a list to a summary value, 'unfoldr' builds a list from
997 -- a seed value. The function takes the element and returns 'Nothing'
998 -- if it is done producing the list or returns 'Just' @(a,b)@, in which
999 -- case, @a@ is a prepended to the list and @b@ is used as the next
1000 -- element in a recursive call. For example,
1001 --
1002 -- > iterate f == unfoldr (\x -> Just (x, f x))
1003 --
1004 -- In some cases, 'unfoldr' can undo a 'foldr' operation:
1005 --
1006 -- > unfoldr f' (foldr f z xs) == xs
1007 --
1008 -- if the following holds:
1009 --
1010 -- > f' (f x y) = Just (x,y)
1011 -- > f' z = Nothing
1012 --
1013 -- A simple use of unfoldr:
1014 --
1015 -- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
1016 -- > [10,9,8,7,6,5,4,3,2,1]
1017 --
1018
1019 -- Note [INLINE unfoldr]
1020 -- We treat unfoldr a little differently from some other forms for list fusion
1021 -- for two reasons:
1022 --
1023 -- 1. We don't want to use a rule to rewrite a basic form to a fusible
1024 -- form because this would inline before constant floating. As Simon Peyton-
1025 -- Jones and others have pointed out, this could reduce sharing in some cases
1026 -- where sharing is beneficial. Thus we simply INLINE it, which is, for
1027 -- example, how enumFromTo::Int becomes eftInt. Unfortunately, we don't seem
1028 -- to get enough of an inlining discount to get a version of eftInt based on
1029 -- unfoldr to inline as readily as the usual one. We know that all the Maybe
1030 -- nonsense will go away, but the compiler does not.
1031 --
1032 -- 2. The benefit of inlining unfoldr is likely to be huge in many common cases,
1033 -- even apart from list fusion. In particular, inlining unfoldr often
1034 -- allows GHC to erase all the Maybes. This appears to be critical if unfoldr
1035 -- is to be used in high-performance code. A small increase in code size
1036 -- in the relatively rare cases when this does not happen looks like a very
1037 -- small price to pay.
1038 --
1039 -- Doing a back-and-forth dance doesn't seem to accomplish anything if the
1040 -- final form has to be inlined in any case.
1041
1042 unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
1043
1044 {-# INLINE unfoldr #-} -- See Note [INLINE unfoldr]
1045 unfoldr f b0 = build (\c n ->
1046 let go b = case f b of
1047 Just (a, new_b) -> a `c` go new_b
1048 Nothing -> n
1049 in go b0)
1050
1051 -- -----------------------------------------------------------------------------
1052 -- Functions on strings
1053
1054 -- | 'lines' breaks a string up into a list of strings at newline
1055 -- characters. The resulting strings do not contain newlines.
1056 --
1057 -- Note that after splitting the string at newline characters, the
1058 -- last part of the string is considered a line even if it doesn't end
1059 -- with a newline. For example,
1060 --
1061 -- > lines "" == []
1062 -- > lines "\n" == [""]
1063 -- > lines "one" == ["one"]
1064 -- > lines "one\n" == ["one"]
1065 -- > lines "one\n\n" == ["one",""]
1066 -- > lines "one\ntwo" == ["one","two"]
1067 -- > lines "one\ntwo\n" == ["one","two"]
1068 --
1069 -- Thus @'lines' s@ contains at least as many elements as newlines in @s@.
1070 lines :: String -> [String]
1071 lines "" = []
1072 -- Somehow GHC doesn't detect the selector thunks in the below code,
1073 -- so s' keeps a reference to the first line via the pair and we have
1074 -- a space leak (cf. #4334).
1075 -- So we need to make GHC see the selector thunks with a trick.
1076 lines s = cons (case break (== '\n') s of
1077 (l, s') -> (l, case s' of
1078 [] -> []
1079 _:s'' -> lines s''))
1080 where
1081 cons ~(h, t) = h : t
1082
1083 -- | 'unlines' is an inverse operation to 'lines'.
1084 -- It joins lines, after appending a terminating newline to each.
1085 unlines :: [String] -> String
1086 #if defined(USE_REPORT_PRELUDE)
1087 unlines = concatMap (++ "\n")
1088 #else
1089 -- HBC version (stolen)
1090 -- here's a more efficient version
1091 unlines [] = []
1092 unlines (l:ls) = l ++ '\n' : unlines ls
1093 #endif
1094
1095 -- | 'words' breaks a string up into a list of words, which were delimited
1096 -- by white space.
1097 words :: String -> [String]
1098 {-# NOINLINE [1] words #-}
1099 words s = case dropWhile {-partain:Char.-}isSpace s of
1100 "" -> []
1101 s' -> w : words s''
1102 where (w, s'') =
1103 break {-partain:Char.-}isSpace s'
1104
1105 {-# RULES
1106 "words" [~1] forall s . words s = build (\c n -> wordsFB c n s)
1107 "wordsList" [1] wordsFB (:) [] = words
1108 #-}
1109 wordsFB :: ([Char] -> b -> b) -> b -> String -> b
1110 {-# INLINE [0] wordsFB #-} -- See Note [Inline FB functions] in GHC.List
1111 wordsFB c n = go
1112 where
1113 go s = case dropWhile isSpace s of
1114 "" -> n
1115 s' -> w `c` go s''
1116 where (w, s'') = break isSpace s'
1117
1118 -- | 'unwords' is an inverse operation to 'words'.
1119 -- It joins words with separating spaces.
1120 unwords :: [String] -> String
1121 #if defined(USE_REPORT_PRELUDE)
1122 unwords [] = ""
1123 unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
1124 #else
1125 -- Here's a lazier version that can get the last element of a
1126 -- _|_-terminated list.
1127 {-# NOINLINE [1] unwords #-}
1128 unwords [] = ""
1129 unwords (w:ws) = w ++ go ws
1130 where
1131 go [] = ""
1132 go (v:vs) = ' ' : (v ++ go vs)
1133
1134 -- In general, the foldr-based version is probably slightly worse
1135 -- than the HBC version, because it adds an extra space and then takes
1136 -- it back off again. But when it fuses, it reduces allocation. How much
1137 -- depends entirely on the average word length--it's most effective when
1138 -- the words are on the short side.
1139 {-# RULES
1140 "unwords" [~1] forall ws .
1141 unwords ws = tailUnwords (foldr unwordsFB "" ws)
1142 "unwordsList" [1] forall ws .
1143 tailUnwords (foldr unwordsFB "" ws) = unwords ws
1144 #-}
1145
1146 {-# INLINE [0] tailUnwords #-}
1147 tailUnwords :: String -> String
1148 tailUnwords [] = []
1149 tailUnwords (_:xs) = xs
1150
1151 {-# INLINE [0] unwordsFB #-}
1152 unwordsFB :: String -> String -> String
1153 unwordsFB w r = ' ' : w ++ r
1154 #endif
1155
1156 {- A "SnocBuilder" is a version of Chris Okasaki's banker's queue that supports
1157 toListSB instead of uncons. In single-threaded use, its performance
1158 characteristics are similar to John Hughes's functional difference lists, but
1159 likely somewhat worse. In heavily persistent settings, however, it does much
1160 better, because it takes advantage of sharing. The banker's queue guarantees
1161 (amortized) O(1) snoc and O(1) uncons, meaning that we can think of toListSB as
1162 an O(1) conversion to a list-like structure a constant factor slower than
1163 normal lists--we pay the O(n) cost incrementally as we consume the list. Using
1164 functional difference lists, on the other hand, we would have to pay the whole
1165 cost up front for each output list. -}
1166
1167 {- We store a front list, a rear list, and the length of the queue. Because we
1168 only snoc onto the queue and never uncons, we know it's time to rotate when the
1169 length of the queue plus 1 is a power of 2. Note that we rely on the value of
1170 the length field only for performance. In the unlikely event of overflow, the
1171 performance will suffer but the semantics will remain correct. -}
1172
1173 data SnocBuilder a = SnocBuilder {-# UNPACK #-} !Word [a] [a]
1174
1175 {- Smart constructor that rotates the builder when lp is one minus a power of
1176 2. Does not rotate very small builders because doing so is not worth the
1177 trouble. The lp < 255 test goes first because the power-of-2 test gives awful
1178 branch prediction for very small n (there are 5 powers of 2 between 1 and
1179 16). Putting the well-predicted lp < 255 test first avoids branching on the
1180 power-of-2 test until powers of 2 have become sufficiently rare to be predicted
1181 well. -}
1182
1183 {-# INLINE sb #-}
1184 sb :: Word -> [a] -> [a] -> SnocBuilder a
1185 sb lp f r
1186 | lp < 255 || (lp .&. (lp + 1)) /= 0 = SnocBuilder lp f r
1187 | otherwise = SnocBuilder lp (f ++ reverse r) []
1188
1189 -- The empty builder
1190
1191 emptySB :: SnocBuilder a
1192 emptySB = SnocBuilder 0 [] []
1193
1194 -- Add an element to the end of a queue.
1195
1196 snocSB :: SnocBuilder a -> a -> SnocBuilder a
1197 snocSB (SnocBuilder lp f r) x = sb (lp + 1) f (x:r)
1198
1199 -- Convert a builder to a list
1200
1201 toListSB :: SnocBuilder a -> [a]
1202 toListSB (SnocBuilder _ f r) = f ++ reverse r