2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[List]{Module @Lhar@}
10 This list follows the type signatures for the
11 standard List interface. -- 8/97
13 elemIndex, elemIndices,
14 find, findIndex, findIndices,
16 delete, deleteBy, (\\), deleteFirstsBy,
18 intersect, intersectBy,
19 intersperse, transpose, partition,
22 isPrefixOf, isSuffixOf,
27 genericTake, genericDrop, genericSplitAt,
28 genericIndex, genericReplicate, genericLength,
30 zip4, zip5, zip6, zip7,
31 zipWith4, zipWith5, zipWith6, zipWith7,
32 unzip4, unzip5, unzip6, unzip7
37 import Maybe ( listToMaybe )
38 import PrelBase ( Int(..) )
39 import PrelGHC ( (+#) )
44 %*********************************************************
46 \subsection{List functions}
48 %*********************************************************
51 elemIndex :: Eq a => a -> [a] -> Maybe Int
52 elemIndex x = findIndex (x==)
54 elemIndices :: Eq a => a -> [a] -> [Int]
55 elemIndices x = findIndices (x==)
57 find :: (a -> Bool) -> [a] -> Maybe a
58 find p = listToMaybe . filter p
60 findIndex :: (a -> Bool) -> [a] -> Maybe Int
61 findIndex p = listToMaybe . findIndices p
63 findIndices :: (a -> Bool) -> [a] -> [Int]
65 #ifdef USE_REPORT_PRELUDE
66 findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
68 -- Efficient definition
69 findIndices p xs = loop 0# p xs
72 loop n p (x:xs) | p x = I# n : loop (n +# 1#) p xs
73 | otherwise = loop (n +# 1#) p xs
76 isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
77 isPrefixOf [] _ = True
78 isPrefixOf _ [] = False
79 isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys
81 isSuffixOf :: (Eq a) => [a] -> [a] -> Bool
82 isSuffixOf x y = reverse x `isPrefixOf` reverse y
84 -- nub (meaning "essence") remove duplicate elements from its list argument.
85 nub :: (Eq a) => [a] -> [a]
86 #ifdef USE_REPORT_PRELUDE
93 nub' (x:xs) l = if x `elem` l then nub' xs l else x : nub' xs (x:l)
96 nubBy :: (a -> a -> Bool) -> [a] -> [a]
97 #ifdef USE_REPORT_PRELUDE
99 nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs)
101 nubBy eq l = nubBy' l []
104 nubBy' (x:xs) l = if elemBy eq x l then nubBy' xs l else x : nubBy' xs (x:l)
107 elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
108 elemBy eq _ [] = False
109 elemBy eq x (y:ys) = x `eq` y || elemBy eq x ys
113 -- delete x removes the first occurrence of x from its list argument.
114 delete :: (Eq a) => a -> [a] -> [a]
115 delete = deleteBy (==)
117 deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
118 deleteBy eq x [] = []
119 deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys
121 -- list difference (non-associative). In the result of xs \\ ys,
122 -- the first occurrence of each element of ys in turn (if any)
123 -- has been removed from xs. Thus, (xs ++ ys) \\ xs == ys.
124 (\\) :: (Eq a) => [a] -> [a] -> [a]
125 (\\) = foldl (flip delete)
127 -- List union, remove the elements of first list from second.
128 union :: (Eq a) => [a] -> [a] -> [a]
131 unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
132 unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
134 intersect :: (Eq a) => [a] -> [a] -> [a]
135 intersect = intersectBy (==)
137 intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
138 intersectBy eq xs ys = [x | x <- xs, any (eq x) ys]
140 -- intersperse sep inserts sep between the elements of its list argument.
141 -- e.g. intersperse ',' "abcde" == "a,b,c,d,e"
142 intersperse :: a -> [a] -> [a]
143 intersperse sep [] = []
144 intersperse sep [x] = [x]
145 intersperse sep (x:xs) = x : sep : intersperse sep xs
147 transpose :: [[a]] -> [[a]]
149 (\xs xss -> zipWith (:) xs (xss ++ repeat []))
153 -- partition takes a predicate and a list and returns a pair of lists:
154 -- those elements of the argument list that do and do not satisfy the
155 -- predicate, respectively; i,e,,
156 -- partition p xs == (filter p xs, filter (not . p) xs).
157 partition :: (a -> Bool) -> [a] -> ([a],[a])
158 partition p xs = foldr select ([],[]) xs
159 where select x (ts,fs) | p x = (x:ts,fs)
160 | otherwise = (ts, x:fs)
163 @mapAccumL@ behaves like a combination
164 of @map@ and @foldl@;
165 it applies a function to each element of a list, passing an accumulating
166 parameter from left to right, and returning a final value of this
167 accumulator together with the new list.
171 mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
172 -- and accumulator, returning new
173 -- accumulator and elt of result list
174 -> acc -- Initial accumulator
176 -> (acc, [y]) -- Final accumulator and result list
177 mapAccumL f s [] = (s, [])
178 mapAccumL f s (x:xs) = (s'',y:ys)
179 where (s', y ) = f s x
180 (s'',ys) = mapAccumL f s' xs
183 @mapAccumR@ does the same, but working from right to left instead. Its type is
184 the same as @mapAccumL@, though.
187 mapAccumR :: (acc -> x -> (acc, y)) -- Function of elt of input list
188 -- and accumulator, returning new
189 -- accumulator and elt of result list
190 -> acc -- Initial accumulator
192 -> (acc, [y]) -- Final accumulator and result list
193 mapAccumR f s [] = (s, [])
194 mapAccumR f s (x:xs) = (s'', y:ys)
195 where (s'',y ) = f s' x
196 (s', ys) = mapAccumR f s xs
200 insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
201 insertBy cmp x [] = [x]
202 insertBy cmp x ys@(y:ys')
204 GT -> y : insertBy cmp x ys'
207 maximumBy :: (a -> a -> a) -> [a] -> a
208 maximumBy max [] = error "List.maximumBy: empty list"
209 maximumBy max xs = foldl1 max xs
211 minimumBy :: (a -> a -> a) -> [a] -> a
212 minimumBy min [] = error "List.minimumBy: empty list"
213 minimumBy min xs = foldl1 min xs
215 genericLength :: (Num i) => [b] -> i
217 genericLength (_:l) = 1 + genericLength l
219 genericTake :: (Integral i) => i -> [a] -> [a]
221 genericTake _ [] = []
222 genericTake n (x:xs) | n > 0 = x : genericTake (n-1) xs
223 genericTake _ _ = error "List.genericTake: negative argument"
225 genericDrop :: (Integral i) => i -> [a] -> [a]
226 genericDrop 0 xs = xs
227 genericDrop _ [] = []
228 genericDrop n (_:xs) | n > 0 = genericDrop (n-1) xs
229 genericDrop _ _ = error "List.genericDrop: negative argument"
231 genericSplitAt :: (Integral i) => i -> [b] -> ([b],[b])
232 genericSplitAt 0 xs = ([],xs)
233 genericSplitAt _ [] = ([],[])
234 genericSplitAt n (x:xs) | n > 0 = (x:xs',xs'') where
235 (xs',xs'') = genericSplitAt (n-1) xs
236 genericSplitAt _ _ = error "List.genericSplitAt: negative argument"
239 genericIndex :: (Integral a) => [b] -> a -> b
240 genericIndex (x:_) 0 = x
241 genericIndex (_:xs) n
242 | n > 0 = genericIndex xs (n-1)
243 | otherwise = error "List.genericIndex: negative argument."
244 genericIndex _ _ = error "List.genericIndex: index too large."
246 genericReplicate :: (Integral i) => i -> a -> [a]
247 genericReplicate n x = genericTake n (repeat x)
250 zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
251 zip4 = zipWith4 (,,,)
253 zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
254 zip5 = zipWith5 (,,,,)
256 zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
258 zip6 = zipWith6 (,,,,,)
260 zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
261 [g] -> [(a,b,c,d,e,f,g)]
262 zip7 = zipWith7 (,,,,,,)
264 zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
265 zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
266 = z a b c d : zipWith4 z as bs cs ds
267 zipWith4 _ _ _ _ _ = []
269 zipWith5 :: (a->b->c->d->e->f) ->
270 [a]->[b]->[c]->[d]->[e]->[f]
271 zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
272 = z a b c d e : zipWith5 z as bs cs ds es
273 zipWith5 _ _ _ _ _ _ = []
275 zipWith6 :: (a->b->c->d->e->f->g) ->
276 [a]->[b]->[c]->[d]->[e]->[f]->[g]
277 zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
278 = z a b c d e f : zipWith6 z as bs cs ds es fs
279 zipWith6 _ _ _ _ _ _ _ = []
281 zipWith7 :: (a->b->c->d->e->f->g->h) ->
282 [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
283 zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
284 = z a b c d e f g : zipWith7 z as bs cs ds es fs gs
285 zipWith7 _ _ _ _ _ _ _ _ = []
287 unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d])
288 unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
289 (a:as,b:bs,c:cs,d:ds))
292 unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
293 unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
294 (a:as,b:bs,c:cs,d:ds,e:es))
297 unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
298 unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
299 (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
302 unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
303 unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
304 (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
305 ([],[],[],[],[],[],[])
309 deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
310 deleteFirstsBy eq = foldl (flip (deleteBy eq))
313 -- group splits its list argument into a list of lists of equal, adjacent
315 -- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"]
316 group :: (Eq a) => [a] -> [[a]]
319 groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
321 groupBy eq (x:xs) = (x:ys) : groupBy eq zs
322 where (ys,zs) = span (eq x) xs
324 -- inits xs returns the list of initial segments of xs, shortest first.
325 -- e.g., inits "abc" == ["","a","ab","abc"]
326 inits :: [a] -> [[a]]
328 inits (x:xs) = [[]] ++ map (x:) (inits xs)
330 -- tails xs returns the list of all final segments of xs, longest first.
331 -- e.g., tails "abc" == ["abc", "bc", "c",""]
332 tails :: [a] -> [[a]]
334 tails xxs@(_:xs) = xxs : tails xs
338 %-----------------------------------------------------------------------------
339 Quick Sort algorithm taken from HBC's QSort library.
342 sort :: (Ord a) => [a] -> [a]
343 sortBy :: (a -> a -> Ordering) -> [a] -> [a]
345 #ifdef USE_REPORT_PRELUDE
346 sort = sortBy compare
347 sortBy cmp = foldr (insertBy cmp) []
350 sortBy cmp l = qsort cmp l []
351 sort l = qsort compare l []
353 -- rest is not exported:
355 -- qsort is stable and does not concatenate.
357 qsort cmp [x] r = x:r
358 qsort cmp (x:xs) r = qpart cmp x xs [] [] r
360 -- qpart partitions and sorts the sublists
361 qpart cmp x [] rlt rge r =
362 -- rlt and rge are in reverse order and must be sorted with an
363 -- anti-stable sorting
364 rqsort cmp rlt (x:rqsort cmp rge r)
365 qpart cmp x (y:ys) rlt rge r =
367 GT -> qpart cmp x ys (y:rlt) rge r
368 _ -> qpart cmp x ys rlt (y:rge) r
370 -- rqsort is as qsort but anti-stable, i.e. reverses equal elements
372 rqsort cmp [x] r = x:r
373 rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r
375 rqpart cmp x [] rle rgt r =
376 qsort cmp rle (x:qsort cmp rgt r)
377 rqpart cmp x (y:ys) rle rgt r =
379 GT -> rqpart cmp x ys rle (y:rgt) r
380 _ -> rqpart cmp x ys (y:rle) rgt r
382 #endif /* USE_REPORT_PRELUDE */