ghc/lib/required/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 GHC      ( (+#) )
  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 -- One line definition
  66 -- findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
  67
  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
  75 isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
  76 isPrefixOf [] _         =  True
  77 isPrefixOf _  []        =  False
  78 isPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys
  79
  80 isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
  81 isSuffixOf x y          =  reverse x `isPrefixOf` reverse y
  82
  83 -- nub (meaning "essence") remove duplicate elements from its list argument.
  84 nub                     :: (Eq a) => [a] -> [a]
  85 #ifdef USE_REPORT_PRELUDE
  86 nub                     =  nubBy (==)
  87 #else
  88 -- stolen from HBC
  89 nub l                   = nub' l []
  90   where
  91     nub' [] _           = []
  92     nub' (x:xs) l       = if x `elem` l then nub' xs l else x : nub' xs (x:l)
  93 #endif
  94
  95 nubBy                   :: (a -> a -> Bool) -> [a] -> [a]
  96 #ifdef USE_REPORT_PRELUDE
  97 nubBy eq []             =  []
  98 nubBy eq (x:xs)         =  x : nubBy eq (filter (\ y -> not (eq x y)) xs)
  99 #else
 100 nubBy eq l              = nubBy' l []
 101   where
 102     nubBy' [] _         = []
 103     nubBy' (x:xs) l     = if elemBy eq x l then nubBy' xs l else x : nubBy' xs (x:l)
 104
 105 --not exported:
 106 elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
 107 elemBy eq _ []          =  False
 108 elemBy eq x (y:ys)      =  x `eq` y || elemBy eq x ys
 109 #endif
 110
 111
 112 -- delete x removes the first occurrence of x from its list argument.
 113 delete                  :: (Eq a) => a -> [a] -> [a]
 114 delete                  =  deleteBy (==)
 115
 116 deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]
 117 deleteBy eq x []        = []
 118 deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys
 119
 120 -- list difference (non-associative).  In the result of xs \\ ys,
 121 -- the first occurrence of each element of ys in turn (if any)
 122 -- has been removed from xs.  Thus, (xs ++ ys) \\ xs == ys.
 123 (\\)                    :: (Eq a) => [a] -> [a] -> [a]
 124 (\\)                    =  foldl (flip delete)
 125
 126 -- List union, remove the elements of first list from second.
 127 union                   :: (Eq a) => [a] -> [a] -> [a]
 128 union                   = unionBy (==)
 129
 130 unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 131 unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
 132
 133 intersect               :: (Eq a) => [a] -> [a] -> [a]
 134 intersect               =  intersectBy (==)
 135
 136 intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 137 intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]
 138
 139 -- intersperse sep inserts sep between the elements of its list argument.
 140 -- e.g. intersperse ',' "abcde" == "a,b,c,d,e"
 141 intersperse             :: a -> [a] -> [a]
 142 intersperse sep []      = []
 143 intersperse sep [x]     = [x]
 144 intersperse sep (x:xs)  = x : sep : intersperse sep xs
 145
 146 transpose               :: [[a]] -> [[a]]
 147 transpose               =  foldr
 148                              (\xs xss -> zipWith (:) xs (xss ++ repeat []))
 149                              []
 150
 151
 152 -- partition takes a predicate and a list and returns a pair of lists:
 153 -- those elements of the argument list that do and do not satisfy the
 154 -- predicate, respectively; i,e,,
 155 -- partition p xs == (filter p xs, filter (not . p) xs).
 156 partition               :: (a -> Bool) -> [a] -> ([a],[a])
 157 partition p xs          =  foldr select ([],[]) xs
 158                            where select x (ts,fs) | p x       = (x:ts,fs)
 159                                                   | otherwise = (ts, x:fs)
 160 \end{code}
 161
 162 @mapAccumL@ behaves like a combination
 163 of  @map@ and @foldl@;
 164 it applies a function to each element of a list, passing an accumulating
 165 parameter from left to right, and returning a final value of this
 166 accumulator together with the new list.
 167
 168 \begin{code}
 169
 170 mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
 171                                     -- and accumulator, returning new
 172                                     -- accumulator and elt of result list
 173           -> acc            -- Initial accumulator
 174           -> [x]            -- Input list
 175           -> (acc, [y])     -- Final accumulator and result list
 176 mapAccumL f s []        =  (s, [])
 177 mapAccumL f s (x:xs)    =  (s'',y:ys)
 178                            where (s', y ) = f s x
 179                                  (s'',ys) = mapAccumL f s' xs
 180 \end{code}
 181
 182 @mapAccumR@ does the same, but working from right to left instead.  Its type is
 183 the same as @mapAccumL@, though.
 184
 185 \begin{code}
 186 mapAccumR :: (acc -> x -> (acc, y))     -- Function of elt of input list
 187                                         -- and accumulator, returning new
 188                                         -- accumulator and elt of result list
 189             -> acc              -- Initial accumulator
 190             -> [x]              -- Input list
 191             -> (acc, [y])               -- Final accumulator and result list
 192 mapAccumR f s []        =  (s, [])
 193 mapAccumR f s (x:xs)    =  (s'', y:ys)
 194                            where (s'',y ) = f s' x
 195                                  (s', ys) = mapAccumR f s xs
 196 \end{code}
 197
 198 \begin{code}
 199 sort :: (Ord a) => [a] -> [a]
 200 sort = sortBy compare
 201
 202 sortBy :: (a -> a -> Ordering) -> [a] -> [a]
 203 sortBy cmp = foldr (insertBy cmp) []
 204
 205 insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
 206 insertBy cmp x [] = [x]
 207 insertBy cmp x ys@(y:ys')
 208  = case cmp x y of
 209      GT -> y : insertBy cmp x ys'
 210      _  -> x : ys
 211
 212 maximumBy               :: (a -> a -> a) -> [a] -> a
 213 maximumBy max []        =  error "List.maximumBy: empty list"
 214 maximumBy max xs        =  foldl1 max xs
 215
 216 minimumBy               :: (a -> a -> a) -> [a] -> a
 217 minimumBy min []        =  error "List.minimumBy: empty list"
 218 minimumBy min xs        =  foldl1 min xs
 219
 220 genericLength           :: (Num i) => [b] -> i
 221 genericLength []        =  0
 222 genericLength (_:l)     =  1 + genericLength l
 223
 224 genericTake             :: (Integral i) => i -> [a] -> [a]
 225 genericTake 0 _         =  []
 226 genericTake _ []        =  []
 227 genericTake n (x:xs) | n > 0  =  x : genericTake (n-1) xs
 228 genericTake _  _        =  error "List.genericTake: negative argument"
 229
 230 genericDrop             :: (Integral i) => i -> [a] -> [a]
 231 genericDrop 0 xs        =  xs
 232 genericDrop _ []        =  []
 233 genericDrop n (_:xs) | n > 0  =  genericDrop (n-1) xs
 234 genericDrop _ _         =  error "List.genericDrop: negative argument"
 235
 236 genericSplitAt          :: (Integral i) => i -> [b] -> ([b],[b])
 237 genericSplitAt 0 xs     =  ([],xs)
 238 genericSplitAt _ []     =  ([],[])
 239 genericSplitAt n (x:xs) | n > 0  =  (x:xs',xs'') where
 240                                (xs',xs'') = genericSplitAt (n-1) xs
 241 genericSplitAt _ _      =  error "List.genericSplitAt: negative argument"
 242
 243
 244 genericIndex :: (Integral a) => [b] -> a -> b
 245 genericIndex (x:_)  0 = x
 246 genericIndex (_:xs) n
 247  | n > 0     = genericIndex xs (n-1)
 248  | otherwise = error "List.genericIndex: negative argument."
 249 genericIndex _ _      = error "List.genericIndex: index too large."
 250
 251 genericReplicate        :: (Integral i) => i -> a -> [a]
 252 genericReplicate n x    =  genericTake n (repeat x)
 253
 254
 255 zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
 256 zip4                    =  zipWith4 (,,,)
 257
 258 zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
 259 zip5                    =  zipWith5 (,,,,)
 260
 261 zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
 262                               [(a,b,c,d,e,f)]
 263 zip6                    =  zipWith6 (,,,,,)
 264
 265 zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
 266                               [g] -> [(a,b,c,d,e,f,g)]
 267 zip7                    =  zipWith7 (,,,,,,)
 268
 269 zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
 270 zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
 271                         =  z a b c d : zipWith4 z as bs cs ds
 272 zipWith4 _ _ _ _ _      =  []
 273
 274 zipWith5                :: (a->b->c->d->e->f) ->
 275                            [a]->[b]->[c]->[d]->[e]->[f]
 276 zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
 277                         =  z a b c d e : zipWith5 z as bs cs ds es
 278 zipWith5 _ _ _ _ _ _    = []
 279
 280 zipWith6                :: (a->b->c->d->e->f->g) ->
 281                            [a]->[b]->[c]->[d]->[e]->[f]->[g]
 282 zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
 283                         =  z a b c d e f : zipWith6 z as bs cs ds es fs
 284 zipWith6 _ _ _ _ _ _ _  = []
 285
 286 zipWith7                :: (a->b->c->d->e->f->g->h) ->
 287                            [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
 288 zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
 289                    =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
 290 zipWith7 _ _ _ _ _ _ _ _ = []
 291
 292 unzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])
 293 unzip4                  =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
 294                                         (a:as,b:bs,c:cs,d:ds))
 295                                  ([],[],[],[])
 296
 297 unzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
 298 unzip5                  =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
 299                                         (a:as,b:bs,c:cs,d:ds,e:es))
 300                                  ([],[],[],[],[])
 301
 302 unzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
 303 unzip6                  =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
 304                                         (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
 305                                  ([],[],[],[],[],[])
 306
 307 unzip7          :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
 308 unzip7          =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
 309                                 (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
 310                          ([],[],[],[],[],[],[])
 311
 312
 313
 314 deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 315 deleteFirstsBy eq       =  foldl (flip (deleteBy eq))
 316
 317
 318 -- group splits its list argument into a list of lists of equal, adjacent
 319 -- elements.  e.g.,
 320 -- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"]
 321 group                   :: (Eq a) => [a] -> [[a]]
 322 group                   =  groupBy (==)
 323
 324 groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
 325 groupBy eq []           =  []
 326 groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs
 327                            where (ys,zs) = span (eq x) xs
 328
 329 -- inits xs returns the list of initial segments of xs, shortest first.
 330 -- e.g., inits "abc" == ["","a","ab","abc"]
 331 inits                   :: [a] -> [[a]]
 332 inits []                =  [[]]
 333 inits (x:xs)            =  [[]] ++ map (x:) (inits xs)
 334
 335 -- tails xs returns the list of all final segments of xs, longest first.
 336 -- e.g., tails "abc" == ["abc", "bc", "c",""]
 337 tails                   :: [a] -> [[a]]
 338 tails []                =  [[]]
 339 tails xxs@(_:xs)        =  xxs : tails xs
 340
 341 \end{code}