abdde601ff1aa2d02fffe502f307477e16498d96
[ghc-hetmet.git] / ghc / lib / std / List.lhs
1 %
2 % (c) The AQUA Project, Glasgow University, 1994-1999
3 %
4
5 \section[List]{Module @Lhar@}
6
7 \begin{code}
8 module List 
9    ( 
10      []((:), [])
11
12    , elemIndex         -- :: (Eq a) => a -> [a] -> Maybe Int
13    , elemIndices       -- :: (Eq a) => a -> [a] -> [Int]
14
15    , find              -- :: (a -> Bool) -> [a] -> Maybe a
16    , findIndex         -- :: (a -> Bool) -> [a] -> Maybe Int
17    , findIndices       -- :: (a -> Bool) -> [a] -> [Int]
18    
19    , nub               -- :: (Eq a) => [a] -> [a]
20    , nubBy             -- :: (a -> a -> Bool) -> [a] -> [a]
21
22    , delete            -- :: (Eq a) => a -> [a] -> [a]
23    , deleteBy          -- :: (a -> a -> Bool) -> a -> [a] -> [a]
24    , (\\)              -- :: (Eq a) => [a] -> [a] -> [a]
25    , deleteFirstsBy    -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
26    
27    , union             -- :: (Eq a) => [a] -> [a] -> [a]
28    , unionBy           -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
29
30    , intersect         -- :: (Eq a) => [a] -> [a] -> [a]
31    , intersectBy       -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
32
33    , intersperse       -- :: a -> [a] -> [a]
34    , transpose         -- :: [[a]] -> [[a]]
35    , partition         -- :: (a -> Bool) -> [a] -> ([a], [a])
36
37    , group             -- :: Eq a => [a] -> [[a]]
38    , groupBy           -- :: (a -> a -> Bool) -> [a] -> [[a]]
39
40    , inits             -- :: [a] -> [[a]]
41    , tails             -- :: [a] -> [[a]]
42
43    , isPrefixOf        -- :: (Eq a) => [a] -> [a] -> Bool
44    , isSuffixOf        -- :: (Eq a) => [a] -> [a] -> Bool
45    
46    , mapAccumL         -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
47    , mapAccumR         -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
48    
49    , sort              -- :: (Ord a) => [a] -> [a]
50    , sortBy            -- :: (a -> a -> Ordering) -> [a] -> [a]
51    
52    , insert            -- :: (Ord a) => a -> [a] -> [a]
53    , insertBy          -- :: (a -> a -> Ordering) -> a -> [a] -> [a]
54    
55    , maximumBy         -- :: (a -> a -> Ordering) -> [a] -> a
56    , minimumBy         -- :: (a -> a -> Ordering) -> [a] -> a
57    
58    , genericLength     -- :: (Integral a) => [b] -> a
59    , genericTake       -- :: (Integral a) => a -> [b] -> [b]
60    , genericDrop       -- :: (Integral a) => a -> [b] -> [b]
61    , genericSplitAt    -- :: (Integral a) => a -> [b] -> ([b], [b])
62    , genericIndex      -- :: (Integral a) => [b] -> a -> b
63    , genericReplicate  -- :: (Integral a) => a -> b -> [b]
64    
65    , unfoldr            -- :: (a -> Maybe (b,a)) -> a -> (a,[b])
66
67    , zip4, zip5, zip6, zip7
68    , zipWith4, zipWith5, zipWith6, zipWith7
69    , unzip4, unzip5, unzip6, unzip7
70
71    , map               -- :: ( a -> b ) -> [a] -> [b]
72    , (++)              -- :: [a] -> [a] -> [a]
73    , concat            -- :: [[a]] -> [a]
74    , filter            -- :: (a -> Bool) -> [a] -> [a]
75    , head              -- :: [a] -> a
76    , last              -- :: [a] -> a
77    , tail              -- :: [a] -> [a]
78    , init              -- :: [a] -> [a]
79    , null              -- :: [a] -> Bool
80    , length            -- :: [a] -> Int
81    , (!!)              -- :: [a] -> Int -> a
82    , foldl             -- :: (a -> b -> a) -> a -> [b] -> a
83    , foldl1            -- :: (a -> a -> a) -> [a] -> a
84    , scanl             -- :: (a -> b -> a) -> a -> [b] -> [a]
85    , scanl1            -- :: (a -> a -> a) -> [a] -> [a]
86    , foldr             -- :: (a -> b -> b) -> b -> [a] -> b
87    , foldr1            -- :: (a -> a -> a) -> [a] -> a
88    , scanr             -- :: (a -> b -> b) -> b -> [a] -> [b]
89    , scanr1            -- :: (a -> a -> a) -> [a] -> [a]
90    , iterate           -- :: (a -> a) -> a -> [a]
91    , repeat            -- :: a -> [a]
92    , replicate         -- :: Int -> a -> [a]
93    , cycle             -- :: [a] -> [a]
94    , take              -- :: Int -> [a] -> [a]
95    , drop              -- :: Int -> [a] -> [a]
96    , splitAt           -- :: Int -> [a] -> ([a], [a])
97    , takeWhile         -- :: (a -> Bool) -> [a] -> [a]
98    , dropWhile         -- :: (a -> Bool) -> [a] -> [a]
99    , span              -- :: (a -> Bool) -> [a] -> ([a], [a])
100    , break             -- :: (a -> Bool) -> [a] -> ([a], [a])
101
102    , lines             -- :: String   -> [String]
103    , words             -- :: String   -> [String]
104    , unlines           -- :: [String] -> String
105    , unwords           -- :: [String] -> String
106    , reverse           -- :: [a] -> [a]
107    , and               -- :: [Bool] -> Bool
108    , or                -- :: [Bool] -> Bool
109    , any               -- :: (a -> Bool) -> [a] -> Bool
110    , all               -- :: (a -> Bool) -> [a] -> Bool
111    , elem              -- :: a -> [a] -> Bool
112    , notElem           -- :: a -> [a] -> Bool
113    , lookup            -- :: (Eq a) => a -> [(a,b)] -> Maybe b
114    , sum               -- :: (Num a) => [a] -> a
115    , product           -- :: (Num a) => [a] -> a
116    , maximum           -- :: (Ord a) => [a] -> a
117    , minimum           -- :: (Ord a) => [a] -> a
118    , concatMap         -- :: (a -> [b]) -> [a] -> [b]
119    , zip               -- :: [a] -> [b] -> [(a,b)]
120    , zip3  
121    , zipWith           -- :: (a -> b -> c) -> [a] -> [b] -> [c]
122    , zipWith3
123    , unzip             -- :: [(a,b)] -> ([a],[b])
124    , unzip3
125
126      -- Implementation checked wrt. Haskell 98 lib report, 1/99.
127    ) where
128
129 import Prelude
130 import PrelShow ( lines, words, unlines, unwords )
131 import Maybe    ( listToMaybe )
132 import PrelBase ( Int(..), map, (++) )
133 import PrelGHC  ( (+#) )
134
135 infix 5 \\
136 \end{code}
137
138 %*********************************************************
139 %*                                                      *
140 \subsection{List functions}
141 %*                                                      *
142 %*********************************************************
143
144 \begin{code}
145 elemIndex       :: Eq a => a -> [a] -> Maybe Int
146 elemIndex x     = findIndex (x==)
147
148 elemIndices     :: Eq a => a -> [a] -> [Int]
149 elemIndices x   = findIndices (x==)
150
151 find            :: (a -> Bool) -> [a] -> Maybe a
152 find p          = listToMaybe . filter p
153
154 findIndex       :: (a -> Bool) -> [a] -> Maybe Int
155 findIndex p     = listToMaybe . findIndices p
156
157 findIndices      :: (a -> Bool) -> [a] -> [Int]
158
159 #ifdef USE_REPORT_PRELUDE
160 findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
161 #else
162 -- Efficient definition
163 findIndices p ls = loop 0# ls
164                  where
165                    loop _ [] = []
166                    loop n (x:xs) | p x       = I# n : loop (n +# 1#) xs
167                                  | otherwise = loop (n +# 1#) xs
168 #endif
169
170 isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
171 isPrefixOf [] _         =  True
172 isPrefixOf _  []        =  False
173 isPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys
174
175 isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
176 isSuffixOf x y          =  reverse x `isPrefixOf` reverse y
177
178 -- nub (meaning "essence") remove duplicate elements from its list argument.
179 nub                     :: (Eq a) => [a] -> [a]
180 #ifdef USE_REPORT_PRELUDE
181 nub                     =  nubBy (==)
182 #else
183 -- stolen from HBC
184 nub l                   = nub' l []
185   where
186     nub' [] _           = []
187     nub' (x:xs) ls      
188         | x `elem` ls   = nub' xs ls
189         | otherwise     = x : nub' xs (x:ls)
190 #endif
191
192 nubBy                   :: (a -> a -> Bool) -> [a] -> [a]
193 #ifdef USE_REPORT_PRELUDE
194 nubBy eq []             =  []
195 nubBy eq (x:xs)         =  x : nubBy eq (filter (\ y -> not (eq x y)) xs)
196 #else
197 nubBy eq l              = nubBy' l []
198   where
199     nubBy' [] _         = []
200     nubBy' (x:xs) ls
201        | elemBy eq x ls = nubBy' xs ls 
202        | otherwise      = x : nubBy' xs (x:ls)
203
204 --not exported:
205 elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
206 elemBy _  _ []          =  False
207 elemBy eq x (y:ys)      =  x `eq` y || elemBy eq x ys
208 #endif
209
210
211 -- delete x removes the first occurrence of x from its list argument.
212 delete                  :: (Eq a) => a -> [a] -> [a]
213 delete                  =  deleteBy (==)
214
215 deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]
216 deleteBy _  _ []        = []
217 deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys
218
219 -- list difference (non-associative).  In the result of xs \\ ys,
220 -- the first occurrence of each element of ys in turn (if any)
221 -- has been removed from xs.  Thus, (xs ++ ys) \\ xs == ys.
222 (\\)                    :: (Eq a) => [a] -> [a] -> [a]
223 (\\)                    =  foldl (flip delete)
224
225 -- List union, remove the elements of first list from second.
226 union                   :: (Eq a) => [a] -> [a] -> [a]
227 union                   = unionBy (==)
228
229 unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
230 unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
231
232 intersect               :: (Eq a) => [a] -> [a] -> [a]
233 intersect               =  intersectBy (==)
234
235 intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
236 intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]
237
238 -- intersperse sep inserts sep between the elements of its list argument.
239 -- e.g. intersperse ',' "abcde" == "a,b,c,d,e"
240 intersperse             :: a -> [a] -> [a]
241 intersperse _   []      = []
242 intersperse _   [x]     = [x]
243 intersperse sep (x:xs)  = x : sep : intersperse sep xs
244
245 transpose               :: [[a]] -> [[a]]
246 transpose []             = []
247 transpose ([]   : xss)   = transpose xss
248 transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : transpose (xs : [ t | (h:t) <- xss])
249
250
251 -- partition takes a predicate and a list and returns a pair of lists:
252 -- those elements of the argument list that do and do not satisfy the
253 -- predicate, respectively; i,e,,
254 -- partition p xs == (filter p xs, filter (not . p) xs).
255 partition               :: (a -> Bool) -> [a] -> ([a],[a])
256 {-# INLINE partition #-}
257 partition p xs = foldr (select p) ([],[]) xs
258
259 select p x (ts,fs) | p x       = (x:ts,fs)
260                    | otherwise = (ts, x:fs)
261 \end{code}
262
263 @mapAccumL@ behaves like a combination
264 of  @map@ and @foldl@;
265 it applies a function to each element of a list, passing an accumulating
266 parameter from left to right, and returning a final value of this
267 accumulator together with the new list.
268
269 \begin{code}
270
271 mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
272                                     -- and accumulator, returning new
273                                     -- accumulator and elt of result list
274           -> acc            -- Initial accumulator 
275           -> [x]            -- Input list
276           -> (acc, [y])     -- Final accumulator and result list
277 mapAccumL _ s []        =  (s, [])
278 mapAccumL f s (x:xs)    =  (s'',y:ys)
279                            where (s', y ) = f s x
280                                  (s'',ys) = mapAccumL f s' xs
281 \end{code}
282
283 @mapAccumR@ does the same, but working from right to left instead.  Its type is
284 the same as @mapAccumL@, though.
285
286 \begin{code}
287 mapAccumR :: (acc -> x -> (acc, y))     -- Function of elt of input list
288                                         -- and accumulator, returning new
289                                         -- accumulator and elt of result list
290             -> acc              -- Initial accumulator
291             -> [x]              -- Input list
292             -> (acc, [y])               -- Final accumulator and result list
293 mapAccumR _ s []        =  (s, [])
294 mapAccumR f s (x:xs)    =  (s'', y:ys)
295                            where (s'',y ) = f s' x
296                                  (s', ys) = mapAccumR f s xs
297 \end{code}
298
299 \begin{code}
300 insert :: Ord a => a -> [a] -> [a]
301 insert e ls = insertBy (compare) e ls
302
303 insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
304 insertBy _   x [] = [x]
305 insertBy cmp x ys@(y:ys')
306  = case cmp x y of
307      GT -> y : insertBy cmp x ys'
308      _  -> x : ys
309
310 maximumBy               :: (a -> a -> a) -> [a] -> a
311 maximumBy _   []        =  error "List.maximumBy: empty list"
312 maximumBy max xs        =  foldl1 max xs
313
314 minimumBy               :: (a -> a -> a) -> [a] -> a
315 minimumBy _   []        =  error "List.minimumBy: empty list"
316 minimumBy min xs        =  foldl1 min xs
317
318 genericLength           :: (Num i) => [b] -> i
319 genericLength []        =  0
320 genericLength (_:l)     =  1 + genericLength l
321
322 genericTake             :: (Integral i) => i -> [a] -> [a]
323 genericTake 0 _         =  []
324 genericTake _ []        =  []
325 genericTake n (x:xs) | n > 0  =  x : genericTake (n-1) xs
326 genericTake _  _        =  error "List.genericTake: negative argument"
327
328 genericDrop             :: (Integral i) => i -> [a] -> [a]
329 genericDrop 0 xs        =  xs
330 genericDrop _ []        =  []
331 genericDrop n (_:xs) | n > 0  =  genericDrop (n-1) xs
332 genericDrop _ _         =  error "List.genericDrop: negative argument"
333
334 genericSplitAt          :: (Integral i) => i -> [b] -> ([b],[b])
335 genericSplitAt 0 xs     =  ([],xs)
336 genericSplitAt _ []     =  ([],[])
337 genericSplitAt n (x:xs) | n > 0  =  (x:xs',xs'') where
338                                (xs',xs'') = genericSplitAt (n-1) xs
339 genericSplitAt _ _      =  error "List.genericSplitAt: negative argument"
340
341
342 genericIndex :: (Integral a) => [b] -> a -> b
343 genericIndex (x:_)  0 = x
344 genericIndex (_:xs) n 
345  | n > 0     = genericIndex xs (n-1)
346  | otherwise = error "List.genericIndex: negative argument."
347 genericIndex _ _      = error "List.genericIndex: index too large."
348
349 genericReplicate        :: (Integral i) => i -> a -> [a]
350 genericReplicate n x    =  genericTake n (repeat x)
351
352
353 zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
354 zip4                    =  zipWith4 (,,,)
355
356 zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
357 zip5                    =  zipWith5 (,,,,)
358
359 zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> 
360                               [(a,b,c,d,e,f)]
361 zip6                    =  zipWith6 (,,,,,)
362
363 zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
364                               [g] -> [(a,b,c,d,e,f,g)]
365 zip7                    =  zipWith7 (,,,,,,)
366
367 zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
368 zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
369                         =  z a b c d : zipWith4 z as bs cs ds
370 zipWith4 _ _ _ _ _      =  []
371
372 zipWith5                :: (a->b->c->d->e->f) -> 
373                            [a]->[b]->[c]->[d]->[e]->[f]
374 zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
375                         =  z a b c d e : zipWith5 z as bs cs ds es
376 zipWith5 _ _ _ _ _ _    = []
377
378 zipWith6                :: (a->b->c->d->e->f->g) ->
379                            [a]->[b]->[c]->[d]->[e]->[f]->[g]
380 zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
381                         =  z a b c d e f : zipWith6 z as bs cs ds es fs
382 zipWith6 _ _ _ _ _ _ _  = []
383
384 zipWith7                :: (a->b->c->d->e->f->g->h) ->
385                            [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
386 zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
387                    =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
388 zipWith7 _ _ _ _ _ _ _ _ = []
389
390 unzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])
391 unzip4                  =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
392                                         (a:as,b:bs,c:cs,d:ds))
393                                  ([],[],[],[])
394
395 unzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
396 unzip5                  =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
397                                         (a:as,b:bs,c:cs,d:ds,e:es))
398                                  ([],[],[],[],[])
399
400 unzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
401 unzip6                  =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
402                                         (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
403                                  ([],[],[],[],[],[])
404
405 unzip7          :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
406 unzip7          =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
407                                 (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
408                          ([],[],[],[],[],[],[])
409
410
411
412 deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
413 deleteFirstsBy eq       =  foldl (flip (deleteBy eq))
414
415
416 -- group splits its list argument into a list of lists of equal, adjacent
417 -- elements.  e.g.,
418 -- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"]
419 group                   :: (Eq a) => [a] -> [[a]]
420 group                   =  groupBy (==)
421
422 groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
423 groupBy _  []           =  []
424 groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs
425                            where (ys,zs) = span (eq x) xs
426
427 -- inits xs returns the list of initial segments of xs, shortest first.
428 -- e.g., inits "abc" == ["","a","ab","abc"]
429 inits                   :: [a] -> [[a]]
430 inits []                =  [[]]
431 inits (x:xs)            =  [[]] ++ map (x:) (inits xs)
432
433 -- tails xs returns the list of all final segments of xs, longest first.
434 -- e.g., tails "abc" == ["abc", "bc", "c",""]
435 tails                   :: [a] -> [[a]]
436 tails []                =  [[]]
437 tails xxs@(_:xs)        =  xxs : tails xs
438
439 \end{code}
440
441 %-----------------------------------------------------------------------------
442 Quick Sort algorithm taken from HBC's QSort library.
443
444 \begin{code}
445 sort :: (Ord a) => [a] -> [a]
446 sortBy :: (a -> a -> Ordering) -> [a] -> [a]
447
448 #ifdef USE_REPORT_PRELUDE
449 sort = sortBy compare
450 sortBy cmp = foldr (insertBy cmp) []
451 #else
452
453 sortBy cmp l = qsort cmp l []
454 sort l = qsort compare l []
455
456 -- rest is not exported:
457
458 -- qsort is stable and does not concatenate.
459 qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
460 qsort _   []     r = r
461 qsort _   [x]    r = x:r
462 qsort cmp (x:xs) r = qpart cmp x xs [] [] r
463
464 -- qpart partitions and sorts the sublists
465 qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
466 qpart cmp x [] rlt rge r =
467     -- rlt and rge are in reverse order and must be sorted with an
468     -- anti-stable sorting
469     rqsort cmp rlt (x:rqsort cmp rge r)
470 qpart cmp x (y:ys) rlt rge r =
471     case cmp x y of
472         GT -> qpart cmp x ys (y:rlt) rge r
473         _  -> qpart cmp x ys rlt (y:rge) r
474
475 -- rqsort is as qsort but anti-stable, i.e. reverses equal elements
476 rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
477 rqsort _   []     r = r
478 rqsort _   [x]    r = x:r
479 rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r
480
481 rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
482 rqpart cmp x [] rle rgt r =
483     qsort cmp rle (x:qsort cmp rgt r)
484 rqpart cmp x (y:ys) rle rgt r =
485     case cmp y x of
486         GT -> rqpart cmp x ys rle (y:rgt) r
487         _  -> rqpart cmp x ys (y:rle) rgt r
488
489 #endif /* USE_REPORT_PRELUDE */
490 \end{code}
491
492 \begin{verbatim}
493   unfoldr f' (foldr f z xs) == (z,xs)
494
495  if the following holds:
496
497    f' (f x y) = Just (x,y)
498    f' z       = Nothing
499 \end{verbatim}
500
501 \begin{code}
502 unfoldr      :: (b -> Maybe (a, b)) -> b -> [a]
503 unfoldr f b  =
504   case f b of
505    Just (a,new_b) -> a : unfoldr f new_b
506    Nothing        -> []
507 \end{code}