ghc/lib/std/List.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[List]{Module @Lhar@}
   6
   7 \begin{code}
   8 module List (
   9     {-
  10       This list follows the type signatures for the
  11       standard List interface.  -- 8/97
  12     -}
  13     elemIndex, elemIndices,
  14     find, findIndex, findIndices,
  15     nub, nubBy,
  16     delete, deleteBy, (\\), deleteFirstsBy,
  17     union, unionBy,
  18     intersect, intersectBy,
  19     intersperse, transpose, partition,
  20     group, groupBy,
  21     inits, tails,
  22     isPrefixOf, isSuffixOf,
  23     mapAccumL, mapAccumR,
  24     sort, sortBy,
  25     insertBy,
  26     maximumBy, minimumBy,
  27     genericTake,  genericDrop, genericSplitAt,
  28     genericIndex, genericReplicate, genericLength,
  29
  30     zip4, zip5, zip6, zip7,
  31     zipWith4, zipWith5, zipWith6, zipWith7,
  32     unzip4, unzip5, unzip6, unzip7
  33
  34   ) where
  35
  36 import Prelude
  37 import Maybe    ( listToMaybe )
  38 import PrelBase ( Int(..) )
  39 import PrelGHC  ( (+#) )
  40
  41 infix 5 \\
  42 \end{code}
  43
  44 %*********************************************************
  45 %*                                                      *
  46 \subsection{List functions}
  47 %*                                                      *
  48 %*********************************************************
  49
  50 \begin{code}
  51 elemIndex       :: Eq a => a -> [a] -> Maybe Int
  52 elemIndex x     = findIndex (x==)
  53
  54 elemIndices     :: Eq a => a -> [a] -> [Int]
  55 elemIndices x   = findIndices (x==)
  56
  57 find            :: (a -> Bool) -> [a] -> Maybe a
  58 find p          = listToMaybe . filter p
  59
  60 findIndex       :: (a -> Bool) -> [a] -> Maybe Int
  61 findIndex p     = listToMaybe . findIndices p
  62
  63 findIndices      :: (a -> Bool) -> [a] -> [Int]
  64
  65 #ifdef USE_REPORT_PRELUDE
  66 findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
  67 #else
  68 -- Efficient definition
  69 findIndices p xs = loop 0# p xs
  70                  where
  71                    loop n p [] = []
  72                    loop n p (x:xs) | p x       = I# n : loop (n +# 1#) p xs
  73                                    | otherwise = loop (n +# 1#) p xs
  74 #endif
  75
  76 isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
  77 isPrefixOf [] _         =  True
  78 isPrefixOf _  []        =  False
  79 isPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys
  80
  81 isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
  82 isSuffixOf x y          =  reverse x `isPrefixOf` reverse y
  83
  84 -- nub (meaning "essence") remove duplicate elements from its list argument.
  85 nub                     :: (Eq a) => [a] -> [a]
  86 #ifdef USE_REPORT_PRELUDE
  87 nub                     =  nubBy (==)
  88 #else
  89 -- stolen from HBC
  90 nub l                   = nub' l []
  91   where
  92     nub' [] _           = []
  93     nub' (x:xs) l       = if x `elem` l then nub' xs l else x : nub' xs (x:l)
  94 #endif
  95
  96 nubBy                   :: (a -> a -> Bool) -> [a] -> [a]
  97 #ifdef USE_REPORT_PRELUDE
  98 nubBy eq []             =  []
  99 nubBy eq (x:xs)         =  x : nubBy eq (filter (\ y -> not (eq x y)) xs)
 100 #else
 101 nubBy eq l              = nubBy' l []
 102   where
 103     nubBy' [] _         = []
 104     nubBy' (x:xs) l     = if elemBy eq x l then nubBy' xs l else x : nubBy' xs (x:l)
 105
 106 --not exported:
 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
 110 #endif
 111
 112
 113 -- delete x removes the first occurrence of x from its list argument.
 114 delete                  :: (Eq a) => a -> [a] -> [a]
 115 delete                  =  deleteBy (==)
 116
 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
 120
 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)
 126
 127 -- List union, remove the elements of first list from second.
 128 union                   :: (Eq a) => [a] -> [a] -> [a]
 129 union                   = unionBy (==)
 130
 131 unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 132 unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
 133
 134 intersect               :: (Eq a) => [a] -> [a] -> [a]
 135 intersect               =  intersectBy (==)
 136
 137 intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 138 intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]
 139
 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
 146
 147 transpose               :: [[a]] -> [[a]]
 148 transpose               =  foldr
 149                              (\xs xss -> zipWith (:) xs (xss ++ repeat []))
 150                              []
 151
 152
 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)
 161 \end{code}
 162
 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.
 168
 169 \begin{code}
 170
 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
 175           -> [x]            -- Input list
 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
 181 \end{code}
 182
 183 @mapAccumR@ does the same, but working from right to left instead.  Its type is
 184 the same as @mapAccumL@, though.
 185
 186 \begin{code}
 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
 191             -> [x]              -- Input list
 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
 197 \end{code}
 198
 199 \begin{code}
 200 insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
 201 insertBy cmp x [] = [x]
 202 insertBy cmp x ys@(y:ys')
 203  = case cmp x y of
 204      GT -> y : insertBy cmp x ys'
 205      _  -> x : ys
 206
 207 maximumBy               :: (a -> a -> a) -> [a] -> a
 208 maximumBy max []        =  error "List.maximumBy: empty list"
 209 maximumBy max xs        =  foldl1 max xs
 210
 211 minimumBy               :: (a -> a -> a) -> [a] -> a
 212 minimumBy min []        =  error "List.minimumBy: empty list"
 213 minimumBy min xs        =  foldl1 min xs
 214
 215 genericLength           :: (Num i) => [b] -> i
 216 genericLength []        =  0
 217 genericLength (_:l)     =  1 + genericLength l
 218
 219 genericTake             :: (Integral i) => i -> [a] -> [a]
 220 genericTake 0 _         =  []
 221 genericTake _ []        =  []
 222 genericTake n (x:xs) | n > 0  =  x : genericTake (n-1) xs
 223 genericTake _  _        =  error "List.genericTake: negative argument"
 224
 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"
 230
 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"
 237
 238
 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."
 245
 246 genericReplicate        :: (Integral i) => i -> a -> [a]
 247 genericReplicate n x    =  genericTake n (repeat x)
 248
 249
 250 zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
 251 zip4                    =  zipWith4 (,,,)
 252
 253 zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
 254 zip5                    =  zipWith5 (,,,,)
 255
 256 zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
 257                               [(a,b,c,d,e,f)]
 258 zip6                    =  zipWith6 (,,,,,)
 259
 260 zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
 261                               [g] -> [(a,b,c,d,e,f,g)]
 262 zip7                    =  zipWith7 (,,,,,,)
 263
 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 _ _ _ _ _      =  []
 268
 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 _ _ _ _ _ _    = []
 274
 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 _ _ _ _ _ _ _  = []
 280
 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 _ _ _ _ _ _ _ _ = []
 286
 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))
 290                                  ([],[],[],[])
 291
 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))
 295                                  ([],[],[],[],[])
 296
 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))
 300                                  ([],[],[],[],[],[])
 301
 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                          ([],[],[],[],[],[],[])
 306
 307
 308
 309 deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 310 deleteFirstsBy eq       =  foldl (flip (deleteBy eq))
 311
 312
 313 -- group splits its list argument into a list of lists of equal, adjacent
 314 -- elements.  e.g.,
 315 -- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"]
 316 group                   :: (Eq a) => [a] -> [[a]]
 317 group                   =  groupBy (==)
 318
 319 groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
 320 groupBy eq []           =  []
 321 groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs
 322                            where (ys,zs) = span (eq x) xs
 323
 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]]
 327 inits []                =  [[]]
 328 inits (x:xs)            =  [[]] ++ map (x:) (inits xs)
 329
 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]]
 333 tails []                =  [[]]
 334 tails xxs@(_:xs)        =  xxs : tails xs
 335
 336 \end{code}
 337
 338 %-----------------------------------------------------------------------------
 339 Quick Sort algorithm taken from HBC's QSort library.
 340
 341 \begin{code}
 342 sort :: (Ord a) => [a] -> [a]
 343 sortBy :: (a -> a -> Ordering) -> [a] -> [a]
 344
 345 #ifdef USE_REPORT_PRELUDE
 346 sort = sortBy compare
 347 sortBy cmp = foldr (insertBy cmp) []
 348 #else
 349
 350 sortBy cmp l = qsort cmp l []
 351 sort l = qsort compare l []
 352
 353 -- rest is not exported:
 354
 355 -- qsort is stable and does not concatenate.
 356 qsort cmp []     r = r
 357 qsort cmp [x]    r = x:r
 358 qsort cmp (x:xs) r = qpart cmp x xs [] [] r
 359
 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 =
 366     case cmp x y of
 367         GT -> qpart cmp x ys (y:rlt) rge r
 368         _  -> qpart cmp x ys rlt (y:rge) r
 369
 370 -- rqsort is as qsort but anti-stable, i.e. reverses equal elements
 371 rqsort cmp []     r = r
 372 rqsort cmp [x]    r = x:r
 373 rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r
 374
 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 =
 378     case cmp y x of
 379         GT -> rqpart cmp x ys rle (y:rgt) r
 380         _  -> rqpart cmp x ys (y:rle) rgt r
 381
 382 #endif /* USE_REPORT_PRELUDE */
 383 \end{code}