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