'permutations' is now more lazy and also faster
[ghc-base.git] / Data / List.hs
1 {-# OPTIONS_GHC -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module      :  Data.List
5 -- Copyright   :  (c) The University of Glasgow 2001
6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
7 -- 
8 -- Maintainer  :  libraries@haskell.org
9 -- Stability   :  stable
10 -- Portability :  portable
11 --
12 -- Operations on lists.
13 --
14 -----------------------------------------------------------------------------
15
16 module Data.List
17    (
18 #ifdef __NHC__
19      [] (..)
20    ,
21 #endif
22
23    -- * Basic functions
24
25      (++)              -- :: [a] -> [a] -> [a]
26    , head              -- :: [a] -> a
27    , last              -- :: [a] -> a
28    , tail              -- :: [a] -> [a]
29    , init              -- :: [a] -> [a]
30    , null              -- :: [a] -> Bool
31    , length            -- :: [a] -> Int
32
33    -- * List transformations
34    , map               -- :: (a -> b) -> [a] -> [b]
35    , reverse           -- :: [a] -> [a]
36
37    , intersperse       -- :: a -> [a] -> [a]
38    , intercalate       -- :: [a] -> [[a]] -> [a]
39    , transpose         -- :: [[a]] -> [[a]]
40    
41    , subsequences      -- :: [a] -> [[a]]
42    , permutations      -- :: [a] -> [[a]]
43
44    -- * Reducing lists (folds)
45
46    , foldl             -- :: (a -> b -> a) -> a -> [b] -> a
47    , foldl'            -- :: (a -> b -> a) -> a -> [b] -> a
48    , foldl1            -- :: (a -> a -> a) -> [a] -> a
49    , foldl1'           -- :: (a -> a -> a) -> [a] -> a
50    , foldr             -- :: (a -> b -> b) -> b -> [a] -> b
51    , foldr1            -- :: (a -> a -> a) -> [a] -> a
52
53    -- ** Special folds
54
55    , concat            -- :: [[a]] -> [a]
56    , concatMap         -- :: (a -> [b]) -> [a] -> [b]
57    , and               -- :: [Bool] -> Bool
58    , or                -- :: [Bool] -> Bool
59    , any               -- :: (a -> Bool) -> [a] -> Bool
60    , all               -- :: (a -> Bool) -> [a] -> Bool
61    , sum               -- :: (Num a) => [a] -> a
62    , product           -- :: (Num a) => [a] -> a
63    , maximum           -- :: (Ord a) => [a] -> a
64    , minimum           -- :: (Ord a) => [a] -> a
65
66    -- * Building lists
67
68    -- ** Scans
69    , scanl             -- :: (a -> b -> a) -> a -> [b] -> [a]
70    , scanl1            -- :: (a -> a -> a) -> [a] -> [a]
71    , scanr             -- :: (a -> b -> b) -> b -> [a] -> [b]
72    , scanr1            -- :: (a -> a -> a) -> [a] -> [a]
73
74    -- ** Accumulating maps
75    , mapAccumL         -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
76    , mapAccumR         -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
77
78    -- ** Infinite lists
79    , iterate           -- :: (a -> a) -> a -> [a]
80    , repeat            -- :: a -> [a]
81    , replicate         -- :: Int -> a -> [a]
82    , cycle             -- :: [a] -> [a]
83
84    -- ** Unfolding
85    , unfoldr           -- :: (b -> Maybe (a, b)) -> b -> [a]
86
87    -- * Sublists
88
89    -- ** Extracting sublists
90    , take              -- :: Int -> [a] -> [a]
91    , drop              -- :: Int -> [a] -> [a]
92    , splitAt           -- :: Int -> [a] -> ([a], [a])
93
94    , takeWhile         -- :: (a -> Bool) -> [a] -> [a]
95    , dropWhile         -- :: (a -> Bool) -> [a] -> [a]
96    , span              -- :: (a -> Bool) -> [a] -> ([a], [a])
97    , break             -- :: (a -> Bool) -> [a] -> ([a], [a])
98
99    , stripPrefix       -- :: Eq a => [a] -> [a] -> Maybe [a]
100
101    , group             -- :: Eq a => [a] -> [[a]]
102
103    , inits             -- :: [a] -> [[a]]
104    , tails             -- :: [a] -> [[a]]
105
106    -- ** Predicates
107    , isPrefixOf        -- :: (Eq a) => [a] -> [a] -> Bool
108    , isSuffixOf        -- :: (Eq a) => [a] -> [a] -> Bool
109    , isInfixOf         -- :: (Eq a) => [a] -> [a] -> Bool
110
111    -- * Searching lists
112
113    -- ** Searching by equality
114    , elem              -- :: a -> [a] -> Bool
115    , notElem           -- :: a -> [a] -> Bool
116    , lookup            -- :: (Eq a) => a -> [(a,b)] -> Maybe b
117
118    -- ** Searching with a predicate
119    , find              -- :: (a -> Bool) -> [a] -> Maybe a
120    , filter            -- :: (a -> Bool) -> [a] -> [a]
121    , partition         -- :: (a -> Bool) -> [a] -> ([a], [a])
122
123    -- * Indexing lists
124    -- | These functions treat a list @xs@ as a indexed collection,
125    -- with indices ranging from 0 to @'length' xs - 1@.
126
127    , (!!)              -- :: [a] -> Int -> a
128
129    , elemIndex         -- :: (Eq a) => a -> [a] -> Maybe Int
130    , elemIndices       -- :: (Eq a) => a -> [a] -> [Int]
131
132    , findIndex         -- :: (a -> Bool) -> [a] -> Maybe Int
133    , findIndices       -- :: (a -> Bool) -> [a] -> [Int]
134
135    -- * Zipping and unzipping lists
136
137    , zip               -- :: [a] -> [b] -> [(a,b)]
138    , zip3
139    , zip4, zip5, zip6, zip7
140
141    , zipWith           -- :: (a -> b -> c) -> [a] -> [b] -> [c]
142    , zipWith3
143    , zipWith4, zipWith5, zipWith6, zipWith7
144
145    , unzip             -- :: [(a,b)] -> ([a],[b])
146    , unzip3
147    , unzip4, unzip5, unzip6, unzip7
148
149    -- * Special lists
150
151    -- ** Functions on strings
152    , lines             -- :: String   -> [String]
153    , words             -- :: String   -> [String]
154    , unlines           -- :: [String] -> String
155    , unwords           -- :: [String] -> String
156
157    -- ** \"Set\" operations
158
159    , nub               -- :: (Eq a) => [a] -> [a]
160
161    , delete            -- :: (Eq a) => a -> [a] -> [a]
162    , (\\)              -- :: (Eq a) => [a] -> [a] -> [a]
163
164    , union             -- :: (Eq a) => [a] -> [a] -> [a]
165    , intersect         -- :: (Eq a) => [a] -> [a] -> [a]
166
167    -- ** Ordered lists
168    , sort              -- :: (Ord a) => [a] -> [a]
169    , insert            -- :: (Ord a) => a -> [a] -> [a]
170
171    -- * Generalized functions
172
173    -- ** The \"@By@\" operations
174    -- | By convention, overloaded functions have a non-overloaded
175    -- counterpart whose name is suffixed with \`@By@\'.
176    --
177    -- It is often convenient to use these functions together with
178    -- 'Data.Function.on', for instance @'sortBy' ('compare'
179    -- \`on\` 'fst')@.
180
181    -- *** User-supplied equality (replacing an @Eq@ context)
182    -- | The predicate is assumed to define an equivalence.
183    , nubBy             -- :: (a -> a -> Bool) -> [a] -> [a]
184    , deleteBy          -- :: (a -> a -> Bool) -> a -> [a] -> [a]
185    , deleteFirstsBy    -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
186    , unionBy           -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
187    , intersectBy       -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
188    , groupBy           -- :: (a -> a -> Bool) -> [a] -> [[a]]
189
190    -- *** User-supplied comparison (replacing an @Ord@ context)
191    -- | The function is assumed to define a total ordering.
192    , sortBy            -- :: (a -> a -> Ordering) -> [a] -> [a]
193    , insertBy          -- :: (a -> a -> Ordering) -> a -> [a] -> [a]
194    , maximumBy         -- :: (a -> a -> Ordering) -> [a] -> a
195    , minimumBy         -- :: (a -> a -> Ordering) -> [a] -> a
196
197    -- ** The \"@generic@\" operations
198    -- | The prefix \`@generic@\' indicates an overloaded function that
199    -- is a generalized version of a "Prelude" function.
200
201    , genericLength     -- :: (Integral a) => [b] -> a
202    , genericTake       -- :: (Integral a) => a -> [b] -> [b]
203    , genericDrop       -- :: (Integral a) => a -> [b] -> [b]
204    , genericSplitAt    -- :: (Integral a) => a -> [b] -> ([b], [b])
205    , genericIndex      -- :: (Integral a) => [b] -> a -> b
206    , genericReplicate  -- :: (Integral a) => a -> b -> [b]
207
208    ) where
209
210 #ifdef __NHC__
211 import Prelude
212 #endif
213
214 import Data.Maybe
215 import Data.Char        ( isSpace )
216
217 #ifdef __GLASGOW_HASKELL__
218 import GHC.Num
219 import GHC.Real
220 import GHC.List
221 import GHC.Base
222 #endif
223
224 infix 5 \\ -- comment to fool cpp
225
226 -- -----------------------------------------------------------------------------
227 -- List functions
228
229 -- | The 'stripPrefix' function drops the given prefix from a list.
230 -- It returns 'Nothing' if the list did not start with the prefix
231 -- given, or 'Just' the list after the prefix, if it does.
232 --
233 -- > stripPrefix "foo" "foobar" -> Just "bar"
234 -- > stripPrefix "foo" "foo" -> Just ""
235 -- > stripPrefix "foo" "barfoo" -> Nothing
236 -- > stripPrefix "foo" "barfoobaz" -> Nothing
237 stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
238 stripPrefix [] ys = Just ys
239 stripPrefix (x:xs) (y:ys)
240  | x == y = stripPrefix xs ys
241 stripPrefix _ _ = Nothing
242
243 -- | The 'elemIndex' function returns the index of the first element
244 -- in the given list which is equal (by '==') to the query element,
245 -- or 'Nothing' if there is no such element.
246 elemIndex       :: Eq a => a -> [a] -> Maybe Int
247 elemIndex x     = findIndex (x==)
248
249 -- | The 'elemIndices' function extends 'elemIndex', by returning the
250 -- indices of all elements equal to the query element, in ascending order.
251 elemIndices     :: Eq a => a -> [a] -> [Int]
252 elemIndices x   = findIndices (x==)
253
254 -- | The 'find' function takes a predicate and a list and returns the
255 -- first element in the list matching the predicate, or 'Nothing' if
256 -- there is no such element.
257 find            :: (a -> Bool) -> [a] -> Maybe a
258 find p          = listToMaybe . filter p
259
260 -- | The 'findIndex' function takes a predicate and a list and returns
261 -- the index of the first element in the list satisfying the predicate,
262 -- or 'Nothing' if there is no such element.
263 findIndex       :: (a -> Bool) -> [a] -> Maybe Int
264 findIndex p     = listToMaybe . findIndices p
265
266 -- | The 'findIndices' function extends 'findIndex', by returning the
267 -- indices of all elements satisfying the predicate, in ascending order.
268 findIndices      :: (a -> Bool) -> [a] -> [Int]
269
270 #if defined(USE_REPORT_PRELUDE) || !defined(__GLASGOW_HASKELL__)
271 findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
272 #else
273 -- Efficient definition
274 findIndices p ls = loop 0# ls
275                  where
276                    loop _ [] = []
277                    loop n (x:xs) | p x       = I# n : loop (n +# 1#) xs
278                                  | otherwise = loop (n +# 1#) xs
279 #endif  /* USE_REPORT_PRELUDE */
280
281 -- | The 'isPrefixOf' function takes two lists and returns 'True'
282 -- iff the first list is a prefix of the second.
283 isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
284 isPrefixOf [] _         =  True
285 isPrefixOf _  []        =  False
286 isPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys
287
288 -- | The 'isSuffixOf' function takes two lists and returns 'True'
289 -- iff the first list is a suffix of the second.
290 -- Both lists must be finite.
291 isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
292 isSuffixOf x y          =  reverse x `isPrefixOf` reverse y
293
294 -- | The 'isInfixOf' function takes two lists and returns 'True'
295 -- iff the first list is contained, wholly and intact,
296 -- anywhere within the second.
297 --
298 -- Example:
299 --
300 -- >isInfixOf "Haskell" "I really like Haskell." -> True
301 -- >isInfixOf "Ial" "I really like Haskell." -> False
302 isInfixOf               :: (Eq a) => [a] -> [a] -> Bool
303 isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
304
305 -- | The 'nub' function removes duplicate elements from a list.
306 -- In particular, it keeps only the first occurrence of each element.
307 -- (The name 'nub' means \`essence\'.)
308 -- It is a special case of 'nubBy', which allows the programmer to supply
309 -- their own equality test.
310 nub                     :: (Eq a) => [a] -> [a]
311 #ifdef USE_REPORT_PRELUDE
312 nub                     =  nubBy (==)
313 #else
314 -- stolen from HBC
315 nub l                   = nub' l []             -- '
316   where
317     nub' [] _           = []                    -- '
318     nub' (x:xs) ls                              -- '
319         | x `elem` ls   = nub' xs ls            -- '
320         | otherwise     = x : nub' xs (x:ls)    -- '
321 #endif
322
323 -- | The 'nubBy' function behaves just like 'nub', except it uses a
324 -- user-supplied equality predicate instead of the overloaded '=='
325 -- function.
326 nubBy                   :: (a -> a -> Bool) -> [a] -> [a]
327 #ifdef USE_REPORT_PRELUDE
328 nubBy eq []             =  []
329 nubBy eq (x:xs)         =  x : nubBy eq (filter (\ y -> not (eq x y)) xs)
330 #else
331 nubBy eq l              = nubBy' l []
332   where
333     nubBy' [] _         = []
334     nubBy' (y:ys) xs
335        | elem_by eq y xs = nubBy' ys xs
336        | otherwise       = y : nubBy' ys (y:xs)
337
338 -- Not exported:
339 -- Note that we keep the call to `eq` with arguments in the
340 -- same order as in the reference implementation
341 -- 'xs' is the list of things we've seen so far, 
342 -- 'y' is the potential new element
343 elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
344 elem_by _  _ []         =  False
345 elem_by eq y (x:xs)     =  x `eq` y || elem_by eq y xs
346 #endif
347
348
349 -- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.
350 -- For example,
351 --
352 -- > delete 'a' "banana" == "bnana"
353 --
354 -- It is a special case of 'deleteBy', which allows the programmer to
355 -- supply their own equality test.
356
357 delete                  :: (Eq a) => a -> [a] -> [a]
358 delete                  =  deleteBy (==)
359
360 -- | The 'deleteBy' function behaves like 'delete', but takes a
361 -- user-supplied equality predicate.
362 deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]
363 deleteBy _  _ []        = []
364 deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys
365
366 -- | The '\\' function is list difference ((non-associative).
367 -- In the result of @xs@ '\\' @ys@, the first occurrence of each element of
368 -- @ys@ in turn (if any) has been removed from @xs@.  Thus
369 --
370 -- > (xs ++ ys) \\ xs == ys.
371 --
372 -- It is a special case of 'deleteFirstsBy', which allows the programmer
373 -- to supply their own equality test.
374
375 (\\)                    :: (Eq a) => [a] -> [a] -> [a]
376 (\\)                    =  foldl (flip delete)
377
378 -- | The 'union' function returns the list union of the two lists.
379 -- For example,
380 --
381 -- > "dog" `union` "cow" == "dogcw"
382 --
383 -- Duplicates, and elements of the first list, are removed from the
384 -- the second list, but if the first list contains duplicates, so will
385 -- the result.
386 -- It is a special case of 'unionBy', which allows the programmer to supply
387 -- their own equality test.
388
389 union                   :: (Eq a) => [a] -> [a] -> [a]
390 union                   = unionBy (==)
391
392 -- | The 'unionBy' function is the non-overloaded version of 'union'.
393 unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
394 unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
395
396 -- | The 'intersect' function takes the list intersection of two lists.
397 -- For example,
398 --
399 -- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]
400 --
401 -- If the first list contains duplicates, so will the result.
402 -- It is a special case of 'intersectBy', which allows the programmer to
403 -- supply their own equality test.
404
405 intersect               :: (Eq a) => [a] -> [a] -> [a]
406 intersect               =  intersectBy (==)
407
408 -- | The 'intersectBy' function is the non-overloaded version of 'intersect'.
409 intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
410 intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]
411
412 -- | The 'intersperse' function takes an element and a list and
413 -- \`intersperses\' that element between the elements of the list.
414 -- For example,
415 --
416 -- > intersperse ',' "abcde" == "a,b,c,d,e"
417
418 intersperse             :: a -> [a] -> [a]
419 intersperse _   []      = []
420 intersperse _   [x]     = [x]
421 intersperse sep (x:xs)  = x : sep : intersperse sep xs
422
423 -- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@.
424 -- It inserts the list @xs@ in between the lists in @xss@ and concatenates the
425 -- result.
426 intercalate :: [a] -> [[a]] -> [a]
427 intercalate xs xss = concat (intersperse xs xss)
428
429 -- | The 'transpose' function transposes the rows and columns of its argument.
430 -- For example,
431 --
432 -- > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]
433
434 transpose               :: [[a]] -> [[a]]
435 transpose []             = []
436 transpose ([]   : xss)   = transpose xss
437 transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : transpose (xs : [ t | (h:t) <- xss])
438
439
440 -- | The 'partition' function takes a predicate a list and returns
441 -- the pair of lists of elements which do and do not satisfy the
442 -- predicate, respectively; i.e.,
443 --
444 -- > partition p xs == (filter p xs, filter (not . p) xs)
445
446 partition               :: (a -> Bool) -> [a] -> ([a],[a])
447 {-# INLINE partition #-}
448 partition p xs = foldr (select p) ([],[]) xs
449
450 select p x ~(ts,fs) | p x       = (x:ts,fs)
451                     | otherwise = (ts, x:fs)
452
453 -- | The 'mapAccumL' function behaves like a combination of 'map' and
454 -- 'foldl'; it applies a function to each element of a list, passing
455 -- an accumulating parameter from left to right, and returning a final
456 -- value of this accumulator together with the new list.
457 mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
458                                     -- and accumulator, returning new
459                                     -- accumulator and elt of result list
460           -> acc            -- Initial accumulator 
461           -> [x]            -- Input list
462           -> (acc, [y])     -- Final accumulator and result list
463 mapAccumL _ s []        =  (s, [])
464 mapAccumL f s (x:xs)    =  (s'',y:ys)
465                            where (s', y ) = f s x
466                                  (s'',ys) = mapAccumL f s' xs
467
468 -- | The 'mapAccumR' function behaves like a combination of 'map' and
469 -- 'foldr'; it applies a function to each element of a list, passing
470 -- an accumulating parameter from right to left, and returning a final
471 -- value of this accumulator together with the new list.
472 mapAccumR :: (acc -> x -> (acc, y))     -- Function of elt of input list
473                                         -- and accumulator, returning new
474                                         -- accumulator and elt of result list
475             -> acc              -- Initial accumulator
476             -> [x]              -- Input list
477             -> (acc, [y])               -- Final accumulator and result list
478 mapAccumR _ s []        =  (s, [])
479 mapAccumR f s (x:xs)    =  (s'', y:ys)
480                            where (s'',y ) = f s' x
481                                  (s', ys) = mapAccumR f s xs
482
483 -- | The 'insert' function takes an element and a list and inserts the
484 -- element into the list at the last position where it is still less
485 -- than or equal to the next element.  In particular, if the list
486 -- is sorted before the call, the result will also be sorted.
487 -- It is a special case of 'insertBy', which allows the programmer to
488 -- supply their own comparison function.
489 insert :: Ord a => a -> [a] -> [a]
490 insert e ls = insertBy (compare) e ls
491
492 -- | The non-overloaded version of 'insert'.
493 insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
494 insertBy _   x [] = [x]
495 insertBy cmp x ys@(y:ys')
496  = case cmp x y of
497      GT -> y : insertBy cmp x ys'
498      _  -> x : ys
499
500 #ifdef __GLASGOW_HASKELL__
501
502 -- | 'maximum' returns the maximum value from a list,
503 -- which must be non-empty, finite, and of an ordered type.
504 -- It is a special case of 'Data.List.maximumBy', which allows the
505 -- programmer to supply their own comparison function.
506 maximum                 :: (Ord a) => [a] -> a
507 maximum []              =  errorEmptyList "maximum"
508 maximum xs              =  foldl1 max xs
509
510 {-# RULES
511   "maximumInt"     maximum = (strictMaximum :: [Int]     -> Int);
512   "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer)
513  #-}
514
515 -- We can't make the overloaded version of maximum strict without
516 -- changing its semantics (max might not be strict), but we can for
517 -- the version specialised to 'Int'.
518 strictMaximum           :: (Ord a) => [a] -> a
519 strictMaximum []        =  errorEmptyList "maximum"
520 strictMaximum xs        =  foldl1' max xs
521
522 -- | 'minimum' returns the minimum value from a list,
523 -- which must be non-empty, finite, and of an ordered type.
524 -- It is a special case of 'Data.List.minimumBy', which allows the
525 -- programmer to supply their own comparison function.
526 minimum                 :: (Ord a) => [a] -> a
527 minimum []              =  errorEmptyList "minimum"
528 minimum xs              =  foldl1 min xs
529
530 {-# RULES
531   "minimumInt"     minimum = (strictMinimum :: [Int]     -> Int);
532   "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer)
533  #-}
534
535 strictMinimum           :: (Ord a) => [a] -> a
536 strictMinimum []        =  errorEmptyList "minimum"
537 strictMinimum xs        =  foldl1' min xs
538
539 #endif /* __GLASGOW_HASKELL__ */
540
541 -- | The 'maximumBy' function takes a comparison function and a list
542 -- and returns the greatest element of the list by the comparison function.
543 -- The list must be finite and non-empty.
544 maximumBy               :: (a -> a -> Ordering) -> [a] -> a
545 maximumBy _ []          =  error "List.maximumBy: empty list"
546 maximumBy cmp xs        =  foldl1 max xs
547                         where
548                            max x y = case cmp x y of
549                                         GT -> x
550                                         _  -> y
551
552 -- | The 'minimumBy' function takes a comparison function and a list
553 -- and returns the least element of the list by the comparison function.
554 -- The list must be finite and non-empty.
555 minimumBy               :: (a -> a -> Ordering) -> [a] -> a
556 minimumBy _ []          =  error "List.minimumBy: empty list"
557 minimumBy cmp xs        =  foldl1 min xs
558                         where
559                            min x y = case cmp x y of
560                                         GT -> y
561                                         _  -> x
562
563 -- | The 'genericLength' function is an overloaded version of 'length'.  In
564 -- particular, instead of returning an 'Int', it returns any type which is
565 -- an instance of 'Num'.  It is, however, less efficient than 'length'.
566 genericLength           :: (Num i) => [b] -> i
567 genericLength []        =  0
568 genericLength (_:l)     =  1 + genericLength l
569
570 -- | The 'genericTake' function is an overloaded version of 'take', which
571 -- accepts any 'Integral' value as the number of elements to take.
572 genericTake             :: (Integral i) => i -> [a] -> [a]
573 genericTake 0 _         =  []
574 genericTake _ []        =  []
575 genericTake n (x:xs) | n > 0  =  x : genericTake (n-1) xs
576 genericTake _  _        =  error "List.genericTake: negative argument"
577
578 -- | The 'genericDrop' function is an overloaded version of 'drop', which
579 -- accepts any 'Integral' value as the number of elements to drop.
580 genericDrop             :: (Integral i) => i -> [a] -> [a]
581 genericDrop 0 xs        =  xs
582 genericDrop _ []        =  []
583 genericDrop n (_:xs) | n > 0  =  genericDrop (n-1) xs
584 genericDrop _ _         =  error "List.genericDrop: negative argument"
585
586 -- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which
587 -- accepts any 'Integral' value as the position at which to split.
588 genericSplitAt          :: (Integral i) => i -> [b] -> ([b],[b])
589 genericSplitAt 0 xs     =  ([],xs)
590 genericSplitAt _ []     =  ([],[])
591 genericSplitAt n (x:xs) | n > 0  =  (x:xs',xs'') where
592                                (xs',xs'') = genericSplitAt (n-1) xs
593 genericSplitAt _ _      =  error "List.genericSplitAt: negative argument"
594
595 -- | The 'genericIndex' function is an overloaded version of '!!', which
596 -- accepts any 'Integral' value as the index.
597 genericIndex :: (Integral a) => [b] -> a -> b
598 genericIndex (x:_)  0 = x
599 genericIndex (_:xs) n
600  | n > 0     = genericIndex xs (n-1)
601  | otherwise = error "List.genericIndex: negative argument."
602 genericIndex _ _      = error "List.genericIndex: index too large."
603
604 -- | The 'genericReplicate' function is an overloaded version of 'replicate',
605 -- which accepts any 'Integral' value as the number of repetitions to make.
606 genericReplicate        :: (Integral i) => i -> a -> [a]
607 genericReplicate n x    =  genericTake n (repeat x)
608
609 -- | The 'zip4' function takes four lists and returns a list of
610 -- quadruples, analogous to 'zip'.
611 zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
612 zip4                    =  zipWith4 (,,,)
613
614 -- | The 'zip5' function takes five lists and returns a list of
615 -- five-tuples, analogous to 'zip'.
616 zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
617 zip5                    =  zipWith5 (,,,,)
618
619 -- | The 'zip6' function takes six lists and returns a list of six-tuples,
620 -- analogous to 'zip'.
621 zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
622                               [(a,b,c,d,e,f)]
623 zip6                    =  zipWith6 (,,,,,)
624
625 -- | The 'zip7' function takes seven lists and returns a list of
626 -- seven-tuples, analogous to 'zip'.
627 zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
628                               [g] -> [(a,b,c,d,e,f,g)]
629 zip7                    =  zipWith7 (,,,,,,)
630
631 -- | The 'zipWith4' function takes a function which combines four
632 -- elements, as well as four lists and returns a list of their point-wise
633 -- combination, analogous to 'zipWith'.
634 zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
635 zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
636                         =  z a b c d : zipWith4 z as bs cs ds
637 zipWith4 _ _ _ _ _      =  []
638
639 -- | The 'zipWith5' function takes a function which combines five
640 -- elements, as well as five lists and returns a list of their point-wise
641 -- combination, analogous to 'zipWith'.
642 zipWith5                :: (a->b->c->d->e->f) ->
643                            [a]->[b]->[c]->[d]->[e]->[f]
644 zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
645                         =  z a b c d e : zipWith5 z as bs cs ds es
646 zipWith5 _ _ _ _ _ _    = []
647
648 -- | The 'zipWith6' function takes a function which combines six
649 -- elements, as well as six lists and returns a list of their point-wise
650 -- combination, analogous to 'zipWith'.
651 zipWith6                :: (a->b->c->d->e->f->g) ->
652                            [a]->[b]->[c]->[d]->[e]->[f]->[g]
653 zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
654                         =  z a b c d e f : zipWith6 z as bs cs ds es fs
655 zipWith6 _ _ _ _ _ _ _  = []
656
657 -- | The 'zipWith7' function takes a function which combines seven
658 -- elements, as well as seven lists and returns a list of their point-wise
659 -- combination, analogous to 'zipWith'.
660 zipWith7                :: (a->b->c->d->e->f->g->h) ->
661                            [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
662 zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
663                    =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
664 zipWith7 _ _ _ _ _ _ _ _ = []
665
666 -- | The 'unzip4' function takes a list of quadruples and returns four
667 -- lists, analogous to 'unzip'.
668 unzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])
669 unzip4                  =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
670                                         (a:as,b:bs,c:cs,d:ds))
671                                  ([],[],[],[])
672
673 -- | The 'unzip5' function takes a list of five-tuples and returns five
674 -- lists, analogous to 'unzip'.
675 unzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
676 unzip5                  =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
677                                         (a:as,b:bs,c:cs,d:ds,e:es))
678                                  ([],[],[],[],[])
679
680 -- | The 'unzip6' function takes a list of six-tuples and returns six
681 -- lists, analogous to 'unzip'.
682 unzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
683 unzip6                  =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
684                                         (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
685                                  ([],[],[],[],[],[])
686
687 -- | The 'unzip7' function takes a list of seven-tuples and returns
688 -- seven lists, analogous to 'unzip'.
689 unzip7          :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
690 unzip7          =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
691                                 (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
692                          ([],[],[],[],[],[],[])
693
694
695 -- | The 'deleteFirstsBy' function takes a predicate and two lists and
696 -- returns the first list with the first occurrence of each element of
697 -- the second list removed.
698 deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
699 deleteFirstsBy eq       =  foldl (flip (deleteBy eq))
700
701 -- | The 'group' function takes a list and returns a list of lists such
702 -- that the concatenation of the result is equal to the argument.  Moreover,
703 -- each sublist in the result contains only equal elements.  For example,
704 --
705 -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
706 --
707 -- It is a special case of 'groupBy', which allows the programmer to supply
708 -- their own equality test.
709 group                   :: Eq a => [a] -> [[a]]
710 group                   =  groupBy (==)
711
712 -- | The 'groupBy' function is the non-overloaded version of 'group'.
713 groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
714 groupBy _  []           =  []
715 groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs
716                            where (ys,zs) = span (eq x) xs
717
718 -- | The 'inits' function returns all initial segments of the argument,
719 -- shortest first.  For example,
720 --
721 -- > inits "abc" == ["","a","ab","abc"]
722 --
723 inits                   :: [a] -> [[a]]
724 inits []                =  [[]]
725 inits (x:xs)            =  [[]] ++ map (x:) (inits xs)
726
727 -- | The 'tails' function returns all final segments of the argument,
728 -- longest first.  For example,
729 --
730 -- > tails "abc" == ["abc", "bc", "c",""]
731 --
732 tails                   :: [a] -> [[a]]
733 tails []                =  [[]]
734 tails xxs@(_:xs)        =  xxs : tails xs
735
736
737 -- | The 'subsequences' function returns the list of all subsequences of the argument.
738 --
739 -- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
740 subsequences            :: [a] -> [[a]]
741 subsequences xs         =  [] : nonEmptySubsequences xs
742
743 -- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,
744 --   except for the empty list.
745 --
746 -- > nonEmptySubsequences "abc" == ["a","b","ab","c","ac","bc","abc"]
747 nonEmptySubsequences         :: [a] -> [[a]]
748 nonEmptySubsequences []      =  []
749 nonEmptySubsequences (x:xs)  =  [x] : foldr f [] (nonEmptySubsequences xs)
750   where f ys r = ys : (x : ys) : r
751
752
753 -- | The 'permutations' function returns the list of all permutations of the argument.
754 --
755 -- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]
756 permutations            :: [a] -> [[a]]
757 permutations xs         =  xs : perms xs []
758   where
759     perms []     is = []
760     perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
761       where interleave    xs     r = let (_,zs) = interleave' id xs r in zs
762             interleave' f []     r = (ts, r)
763             interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
764                                      in  (y:us, f (t:y:us) : zs)
765
766
767 ------------------------------------------------------------------------------
768 -- Quick Sort algorithm taken from HBC's QSort library.
769
770 -- | The 'sort' function implements a stable sorting algorithm.
771 -- It is a special case of 'sortBy', which allows the programmer to supply
772 -- their own comparison function.
773 sort :: (Ord a) => [a] -> [a]
774
775 -- | The 'sortBy' function is the non-overloaded version of 'sort'.
776 sortBy :: (a -> a -> Ordering) -> [a] -> [a]
777
778 #ifdef USE_REPORT_PRELUDE
779 sort = sortBy compare
780 sortBy cmp = foldr (insertBy cmp) []
781 #else
782
783 sortBy cmp l = mergesort cmp l
784 sort l = mergesort compare l
785
786 {-
787 Quicksort replaced by mergesort, 14/5/2002.
788
789 From: Ian Lynagh <igloo@earth.li>
790
791 I am curious as to why the List.sort implementation in GHC is a
792 quicksort algorithm rather than an algorithm that guarantees n log n
793 time in the worst case? I have attached a mergesort implementation along
794 with a few scripts to time it's performance, the results of which are
795 shown below (* means it didn't finish successfully - in all cases this
796 was due to a stack overflow).
797
798 If I heap profile the random_list case with only 10000 then I see
799 random_list peaks at using about 2.5M of memory, whereas in the same
800 program using List.sort it uses only 100k.
801
802 Input style     Input length     Sort data     Sort alg    User time
803 stdin           10000            random_list   sort        2.82
804 stdin           10000            random_list   mergesort   2.96
805 stdin           10000            sorted        sort        31.37
806 stdin           10000            sorted        mergesort   1.90
807 stdin           10000            revsorted     sort        31.21
808 stdin           10000            revsorted     mergesort   1.88
809 stdin           100000           random_list   sort        *
810 stdin           100000           random_list   mergesort   *
811 stdin           100000           sorted        sort        *
812 stdin           100000           sorted        mergesort   *
813 stdin           100000           revsorted     sort        *
814 stdin           100000           revsorted     mergesort   *
815 func            10000            random_list   sort        0.31
816 func            10000            random_list   mergesort   0.91
817 func            10000            sorted        sort        19.09
818 func            10000            sorted        mergesort   0.15
819 func            10000            revsorted     sort        19.17
820 func            10000            revsorted     mergesort   0.16
821 func            100000           random_list   sort        3.85
822 func            100000           random_list   mergesort   *
823 func            100000           sorted        sort        5831.47
824 func            100000           sorted        mergesort   2.23
825 func            100000           revsorted     sort        5872.34
826 func            100000           revsorted     mergesort   2.24
827 -}
828
829 mergesort :: (a -> a -> Ordering) -> [a] -> [a]
830 mergesort cmp = mergesort' cmp . map wrap
831
832 mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
833 mergesort' cmp [] = []
834 mergesort' cmp [xs] = xs
835 mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
836
837 merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
838 merge_pairs cmp [] = []
839 merge_pairs cmp [xs] = [xs]
840 merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
841
842 merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
843 merge cmp [] ys = ys
844 merge cmp xs [] = xs
845 merge cmp (x:xs) (y:ys)
846  = case x `cmp` y of
847         GT -> y : merge cmp (x:xs)   ys
848         _  -> x : merge cmp    xs (y:ys)
849
850 wrap :: a -> [a]
851 wrap x = [x]
852
853 {-
854 OLD: qsort version
855
856 -- qsort is stable and does not concatenate.
857 qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
858 qsort _   []     r = r
859 qsort _   [x]    r = x:r
860 qsort cmp (x:xs) r = qpart cmp x xs [] [] r
861
862 -- qpart partitions and sorts the sublists
863 qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
864 qpart cmp x [] rlt rge r =
865     -- rlt and rge are in reverse order and must be sorted with an
866     -- anti-stable sorting
867     rqsort cmp rlt (x:rqsort cmp rge r)
868 qpart cmp x (y:ys) rlt rge r =
869     case cmp x y of
870         GT -> qpart cmp x ys (y:rlt) rge r
871         _  -> qpart cmp x ys rlt (y:rge) r
872
873 -- rqsort is as qsort but anti-stable, i.e. reverses equal elements
874 rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
875 rqsort _   []     r = r
876 rqsort _   [x]    r = x:r
877 rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r
878
879 rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
880 rqpart cmp x [] rle rgt r =
881     qsort cmp rle (x:qsort cmp rgt r)
882 rqpart cmp x (y:ys) rle rgt r =
883     case cmp y x of
884         GT -> rqpart cmp x ys rle (y:rgt) r
885         _  -> rqpart cmp x ys (y:rle) rgt r
886 -}
887
888 #endif /* USE_REPORT_PRELUDE */
889
890 -- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'
891 -- reduces a list to a summary value, 'unfoldr' builds a list from
892 -- a seed value.  The function takes the element and returns 'Nothing'
893 -- if it is done producing the list or returns 'Just' @(a,b)@, in which
894 -- case, @a@ is a prepended to the list and @b@ is used as the next
895 -- element in a recursive call.  For example,
896 --
897 -- > iterate f == unfoldr (\x -> Just (x, f x))
898 --
899 -- In some cases, 'unfoldr' can undo a 'foldr' operation:
900 --
901 -- > unfoldr f' (foldr f z xs) == xs
902 --
903 -- if the following holds:
904 --
905 -- > f' (f x y) = Just (x,y)
906 -- > f' z       = Nothing
907 --
908 -- A simple use of unfoldr:
909 --
910 -- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
911 -- >  [10,9,8,7,6,5,4,3,2,1]
912 --
913 unfoldr      :: (b -> Maybe (a, b)) -> b -> [a]
914 unfoldr f b  =
915   case f b of
916    Just (a,new_b) -> a : unfoldr f new_b
917    Nothing        -> []
918
919 -- -----------------------------------------------------------------------------
920
921 -- | A strict version of 'foldl'.
922 foldl'           :: (a -> b -> a) -> a -> [b] -> a
923 #ifdef __GLASGOW_HASKELL__
924 foldl' f z xs = lgo z xs
925     where lgo z []     = z
926           lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
927 #else
928 foldl' f a []     = a
929 foldl' f a (x:xs) = let a' = f a x in a' `seq` foldl' f a' xs
930 #endif
931
932 #ifdef __GLASGOW_HASKELL__
933 -- | 'foldl1' is a variant of 'foldl' that has no starting value argument,
934 -- and thus must be applied to non-empty lists.
935 foldl1                  :: (a -> a -> a) -> [a] -> a
936 foldl1 f (x:xs)         =  foldl f x xs
937 foldl1 _ []             =  errorEmptyList "foldl1"
938 #endif /* __GLASGOW_HASKELL__ */
939
940 -- | A strict version of 'foldl1'
941 foldl1'                  :: (a -> a -> a) -> [a] -> a
942 foldl1' f (x:xs)         =  foldl' f x xs
943 foldl1' _ []             =  errorEmptyList "foldl1'"
944
945 #ifdef __GLASGOW_HASKELL__
946 -- -----------------------------------------------------------------------------
947 -- List sum and product
948
949 {-# SPECIALISE sum     :: [Int] -> Int #-}
950 {-# SPECIALISE sum     :: [Integer] -> Integer #-}
951 {-# SPECIALISE product :: [Int] -> Int #-}
952 {-# SPECIALISE product :: [Integer] -> Integer #-}
953 -- | The 'sum' function computes the sum of a finite list of numbers.
954 sum                     :: (Num a) => [a] -> a
955 -- | The 'product' function computes the product of a finite list of numbers.
956 product                 :: (Num a) => [a] -> a
957 #ifdef USE_REPORT_PRELUDE
958 sum                     =  foldl (+) 0
959 product                 =  foldl (*) 1
960 #else
961 sum     l       = sum' l 0
962   where
963     sum' []     a = a
964     sum' (x:xs) a = sum' xs (a+x)
965 product l       = prod l 1
966   where
967     prod []     a = a
968     prod (x:xs) a = prod xs (a*x)
969 #endif
970
971 -- -----------------------------------------------------------------------------
972 -- Functions on strings
973
974 -- | 'lines' breaks a string up into a list of strings at newline
975 -- characters.  The resulting strings do not contain newlines.
976 lines                   :: String -> [String]
977 lines ""                =  []
978 lines s                 =  let (l, s') = break (== '\n') s
979                            in  l : case s' of
980                                         []      -> []
981                                         (_:s'') -> lines s''
982
983 -- | 'unlines' is an inverse operation to 'lines'.
984 -- It joins lines, after appending a terminating newline to each.
985 unlines                 :: [String] -> String
986 #ifdef USE_REPORT_PRELUDE
987 unlines                 =  concatMap (++ "\n")
988 #else
989 -- HBC version (stolen)
990 -- here's a more efficient version
991 unlines [] = []
992 unlines (l:ls) = l ++ '\n' : unlines ls
993 #endif
994
995 -- | 'words' breaks a string up into a list of words, which were delimited
996 -- by white space.
997 words                   :: String -> [String]
998 words s                 =  case dropWhile {-partain:Char.-}isSpace s of
999                                 "" -> []
1000                                 s' -> w : words s''
1001                                       where (w, s'') =
1002                                              break {-partain:Char.-}isSpace s'
1003
1004 -- | 'unwords' is an inverse operation to 'words'.
1005 -- It joins words with separating spaces.
1006 unwords                 :: [String] -> String
1007 #ifdef USE_REPORT_PRELUDE
1008 unwords []              =  ""
1009 unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
1010 #else
1011 -- HBC version (stolen)
1012 -- here's a more efficient version
1013 unwords []              =  ""
1014 unwords [w]             = w
1015 unwords (w:ws)          = w ++ ' ' : unwords ws
1016 #endif
1017
1018 #else  /* !__GLASGOW_HASKELL__ */
1019
1020 errorEmptyList :: String -> a
1021 errorEmptyList fun =
1022   error ("Prelude." ++ fun ++ ": empty list")
1023
1024 #endif /* !__GLASGOW_HASKELL__ */