home *** CD-ROM | disk | FTP | other *** search
/ PSION CD 2 / PsionCDVol2.iso / Programs / 876 / hugs.sis / List.hs < prev    next >
Encoding:
Text File  |  2000-09-21  |  9.5 KB  |  268 lines
  1. -----------------------------------------------------------------------------
  2. -- Standard Library: List operations
  3. --
  4. -- Suitable for use with Hugs 98
  5. -----------------------------------------------------------------------------
  6.  
  7. module List ( 
  8.     elemIndex, elemIndices,
  9.     find, findIndex, findIndices,
  10.     nub, nubBy, delete, deleteBy, (\\), deleteFirstsBy,
  11.     union, unionBy, intersect, intersectBy,
  12.     intersperse, transpose, partition, group, groupBy,
  13.     inits, tails, isPrefixOf, isSuffixOf,
  14.     mapAccumL, mapAccumR,
  15.     sort, sortBy, insert, insertBy, maximumBy, minimumBy,
  16.     genericLength, genericTake, genericDrop,
  17.     genericSplitAt, genericIndex, genericReplicate,
  18.     zip4, zip5, zip6, zip7,
  19.     zipWith4, zipWith5, zipWith6, zipWith7,
  20.     unzip4, unzip5, unzip6, unzip7, unfoldr,
  21.  
  22.     -- ... and what the Prelude exports
  23.     --  List type: []((:), [])
  24.     (:),
  25.     map, (++), concat, filter,
  26.     head, last, tail, init, null, length, (!!),
  27.     foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,
  28.     iterate, repeat, replicate, cycle,
  29.     take, drop, splitAt, takeWhile, dropWhile, span, break,
  30.     lines, words, unlines, unwords, reverse, and, or,
  31.     any, all, elem, notElem, lookup,
  32.     sum, product, maximum, minimum, concatMap, 
  33.     zip, zip3, zipWith, zipWith3, unzip, unzip3
  34.     ) where
  35.  
  36. import Maybe( listToMaybe )
  37.  
  38. infix 5 \\
  39.  
  40. elemIndex               :: Eq a => a -> [a] -> Maybe Int
  41. elemIndex x              = findIndex (x ==)
  42.         
  43. elemIndices             :: Eq a => a -> [a] -> [Int]
  44. elemIndices x            = findIndices (x ==)
  45.                 
  46. find                    :: (a -> Bool) -> [a] -> Maybe a
  47. find p                   = listToMaybe . filter p
  48.  
  49. findIndex               :: (a -> Bool) -> [a] -> Maybe Int
  50. findIndex p              = listToMaybe . findIndices p
  51.  
  52. findIndices             :: (a -> Bool) -> [a] -> [Int]
  53. findIndices p xs         = [ i | (x,i) <- zip xs [0..], p x ]
  54.  
  55. nub                     :: (Eq a) => [a] -> [a]
  56. nub                      = nubBy (==)
  57.  
  58. nubBy            :: (a -> a -> Bool) -> [a] -> [a]
  59. nubBy eq []              = []
  60. nubBy eq (x:xs)          = x : nubBy eq (filter (\y -> not (eq x y)) xs)
  61.  
  62. delete                  :: (Eq a) => a -> [a] -> [a]
  63. delete                   = deleteBy (==)
  64.  
  65. deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]
  66. deleteBy eq x []         = []
  67. deleteBy eq x (y:ys)     = if x `eq` y then ys else y : deleteBy eq x ys
  68.  
  69. (\\)                    :: (Eq a) => [a] -> [a] -> [a]
  70. (\\)                     = foldl (flip delete)
  71.  
  72. deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
  73. deleteFirstsBy eq        = foldl (flip (deleteBy eq))
  74.  
  75. union                   :: (Eq a) => [a] -> [a] -> [a]
  76. union                    = unionBy (==)    
  77.  
  78. unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
  79. unionBy eq xs ys         = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
  80.  
  81. intersect               :: (Eq a) => [a] -> [a] -> [a]
  82. intersect                = intersectBy (==)
  83.  
  84. intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
  85. intersectBy eq xs ys     = [x | x <- xs, any (eq x) ys]
  86.  
  87. intersperse             :: a -> [a] -> [a]
  88. intersperse sep []       = []
  89. intersperse sep [x]      = [x]
  90. intersperse sep (x:xs)   = x : sep : intersperse sep xs
  91.  
  92. transpose               :: [[a]] -> [[a]]
  93. transpose []             = []
  94. transpose ([] : xss)     = transpose xss
  95. transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) :
  96.                            transpose (xs : [ t | (h:t) <- xss])
  97.  
  98. partition               :: (a -> Bool) -> [a] -> ([a],[a])
  99. partition p xs           = foldr select ([],[]) xs
  100.                  where select x (ts,fs) | p x       = (x:ts,fs)
  101.                                   | otherwise = (ts,x:fs)
  102.  
  103. -- group splits its list argument into a list of lists of equal, adjacent
  104. -- elements.  e.g.,
  105. -- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"]
  106. group                   :: (Eq a) => [a] -> [[a]]
  107. group                    = groupBy (==)
  108.  
  109. groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
  110. groupBy eq []            = []
  111. groupBy eq (x:xs)        = (x:ys) : groupBy eq zs
  112.                            where (ys,zs) = span (eq x) xs
  113.  
  114. -- inits xs returns the list of initial segments of xs, shortest first.
  115. -- e.g., inits "abc" == ["","a","ab","abc"]
  116. inits                   :: [a] -> [[a]]
  117. inits []                 = [[]]
  118. inits (x:xs)             = [[]] ++ map (x:) (inits xs)
  119.  
  120. -- tails xs returns the list of all final segments of xs, longest first.
  121. -- e.g., tails "abc" == ["abc", "bc", "c",""]
  122. tails                   :: [a] -> [[a]]
  123. tails []                 = [[]]
  124. tails xxs@(_:xs)         = xxs : tails xs
  125.  
  126. isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
  127. isPrefixOf [] _          = True
  128. isPrefixOf _  []         = False
  129. isPrefixOf (x:xs) (y:ys) = x == y && isPrefixOf xs ys
  130.  
  131. isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
  132. isSuffixOf x y           = reverse x `isPrefixOf` reverse y
  133.  
  134. mapAccumL               :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])
  135. mapAccumL f s []         = (s, [])
  136. mapAccumL f s (x:xs)     = (s'',y:ys)
  137.                          where (s', y ) = f s x
  138.                                (s'',ys) = mapAccumL f s' xs
  139.  
  140. mapAccumR               :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])
  141. mapAccumR f s []         = (s, [])
  142. mapAccumR f s (x:xs)     = (s'', y:ys)
  143.                          where (s'',y ) = f s' x
  144.                                (s', ys) = mapAccumR f s xs
  145.  
  146. unfoldr                 :: (b -> Maybe (a,b)) -> b -> [a]
  147. unfoldr f b              = case f b of Nothing    -> []
  148.                                        Just (a,b) -> a : unfoldr f b
  149.  
  150. sort            :: (Ord a) => [a] -> [a]
  151. sort             = sortBy compare
  152.  
  153. sortBy            :: (a -> a -> Ordering) -> [a] -> [a]
  154. sortBy cmp         = foldr (insertBy cmp) []
  155.  
  156. insert                  :: (Ord a) => a -> [a] -> [a]
  157. insert                   = insertBy compare
  158.  
  159. insertBy        :: (a -> a -> Ordering) -> a -> [a] -> [a]
  160. insertBy cmp x []     = [x]
  161. insertBy cmp x ys@(y:ys')
  162.              = case cmp x y of
  163.                 GT -> y : insertBy cmp x ys'
  164.                 _  -> x : ys
  165.  
  166. maximumBy        :: (a -> a -> a) -> [a] -> a
  167. maximumBy max []     = error "List.maximumBy: empty list"
  168. maximumBy max xs     = foldl1 max xs
  169.  
  170. minimumBy        :: (a -> a -> a) -> [a] -> a
  171. minimumBy min []     = error "List.minimumBy: empty list"
  172. minimumBy min xs     = foldl1 min xs
  173.  
  174. genericLength           :: (Integral a) => [b] -> a
  175. genericLength []         = 0
  176. genericLength (x:xs)     = 1 + genericLength xs
  177.  
  178. genericTake             :: (Integral a) => a -> [b] -> [b]
  179. genericTake 0 _          = []
  180. genericTake _ []         = []
  181. genericTake n (x:xs) 
  182.    | n > 0               = x : genericTake (n-1) xs
  183.    | otherwise           = error "List.genericTake: negative argument"
  184.  
  185. genericDrop             :: (Integral a) => a -> [b] -> [b]
  186. genericDrop 0 xs         = xs
  187. genericDrop _ []         = []
  188. genericDrop n (_:xs) 
  189.    | n > 0               = genericDrop (n-1) xs
  190.    | otherwise           = error "List.genericDrop: negative argument"
  191.  
  192. genericSplitAt          :: (Integral a) => a -> [b] -> ([b],[b])
  193. genericSplitAt 0 xs      = ([],xs)
  194. genericSplitAt _ []      = ([],[])
  195. genericSplitAt n (x:xs) 
  196.    | n > 0              =  (x:xs',xs'')
  197.    | otherwise          =  error "List.genericSplitAt: negative argument"
  198.        where (xs',xs'') =  genericSplitAt (n-1) xs
  199.  
  200. genericIndex            :: (Integral a) => [b] -> a -> b
  201. genericIndex (x:_)  0    = x
  202. genericIndex (_:xs) n 
  203.         | n > 0          = genericIndex xs (n-1)
  204.         | otherwise      = error "List.genericIndex: negative argument"
  205. genericIndex _ _         = error "List.genericIndex: index too large"
  206.  
  207. genericReplicate        :: (Integral a) => a -> b -> [b]
  208. genericReplicate n x     = genericTake n (repeat x)
  209.  
  210. zip4            :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
  211. zip4             = zipWith4 (,,,)
  212.  
  213. zip5            :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
  214. zip5             = zipWith5 (,,,,)
  215.  
  216. zip6            :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> 
  217.                               [(a,b,c,d,e,f)]
  218. zip6             = zipWith6 (,,,,,)
  219.  
  220. zip7            :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
  221.                               [g] -> [(a,b,c,d,e,f,g)]
  222. zip7             = zipWith7 (,,,,,,)
  223.  
  224. zipWith4        :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
  225. zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
  226.              = z a b c d : zipWith4 z as bs cs ds
  227. zipWith4 _ _ _ _ _     = []
  228.  
  229. zipWith5        :: (a->b->c->d->e->f) -> 
  230.                            [a]->[b]->[c]->[d]->[e]->[f]
  231. zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
  232.              = z a b c d e : zipWith5 z as bs cs ds es
  233. zipWith5 _ _ _ _ _ _     = []
  234.  
  235. zipWith6        :: (a->b->c->d->e->f->g) ->
  236.                            [a]->[b]->[c]->[d]->[e]->[f]->[g]
  237. zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
  238.              = z a b c d e f : zipWith6 z as bs cs ds es fs
  239. zipWith6 _ _ _ _ _ _ _     = []
  240.  
  241. zipWith7        :: (a->b->c->d->e->f->g->h) ->
  242.                            [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
  243. zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
  244.            =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
  245. zipWith7 _ _ _ _ _ _ _ _ = []
  246.  
  247. unzip4            :: [(a,b,c,d)] -> ([a],[b],[c],[d])
  248. unzip4             = foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
  249.                     (a:as,b:bs,c:cs,d:ds))
  250.                  ([],[],[],[])
  251.  
  252. unzip5            :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
  253. unzip5             = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
  254.                     (a:as,b:bs,c:cs,d:ds,e:es))
  255.                  ([],[],[],[],[])
  256.  
  257. unzip6            :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
  258. unzip6             = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
  259.                     (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
  260.                  ([],[],[],[],[],[])
  261.  
  262. unzip7        :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
  263. unzip7        =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
  264.                 (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
  265.              ([],[],[],[],[],[],[])
  266.  
  267. -----------------------------------------------------------------------------
  268.