doc wibble: Haskell 98 I/O Error -> 'IOError'

[ghc-base.git] / Data / List.hs

diff --git a/Data/List.hs b/Data/List.hs
index 4cc9fdf..cc166d8 100644 (file)
--- a/Data/List.hs
+++ b/Data/List.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}

 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.List
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.List

@@ -230,10 +230,10 @@ infix 5 \\ -- comment to fool cpp
 -- It returns 'Nothing' if the list did not start with the prefix
 -- given, or 'Just' the list after the prefix, if it does.
 --
 -- It returns 'Nothing' if the list did not start with the prefix
 -- given, or 'Just' the list after the prefix, if it does.
 --

--- > stripPrefix "foo" "foobar" -> Just "bar"
--- > stripPrefix "foo" "foo" -> Just ""
--- > stripPrefix "foo" "barfoo" -> Nothing
--- > stripPrefix "foo" "barfoobaz" -> Nothing
+-- > stripPrefix "foo" "foobar" == Just "bar"
+-- > stripPrefix "foo" "foo" == Just ""
+-- > stripPrefix "foo" "barfoo" == Nothing
+-- > stripPrefix "foo" "barfoobaz" == Nothing

 stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
 stripPrefix [] ys = Just ys
 stripPrefix (x:xs) (y:ys)
 stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
 stripPrefix [] ys = Just ys
 stripPrefix (x:xs) (y:ys)

@@ -297,12 +297,12 @@ isSuffixOf x y          =  reverse x `isPrefixOf` reverse y
 --
 -- Example:
 --
 --
 -- Example:
 --

--- >isInfixOf "Haskell" "I really like Haskell." -> True
--- >isInfixOf "Ial" "I really like Haskell." -> False
+-- >isInfixOf "Haskell" "I really like Haskell." == True
+-- >isInfixOf "Ial" "I really like Haskell." == False

 isInfixOf               :: (Eq a) => [a] -> [a] -> Bool
 isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
 
 isInfixOf               :: (Eq a) => [a] -> [a] -> Bool
 isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
 

--- | The 'nub' function removes duplicate elements from a list.
+-- | /O(n^2)/. The 'nub' function removes duplicate elements from a list.

 -- In particular, it keeps only the first occurrence of each element.
 -- (The name 'nub' means \`essence\'.)
 -- It is a special case of 'nubBy', which allows the programmer to supply
 -- In particular, it keeps only the first occurrence of each element.
 -- (The name 'nub' means \`essence\'.)
 -- It is a special case of 'nubBy', which allows the programmer to supply

@@ -342,7 +342,7 @@ nubBy eq l              = nubBy' l []
 -- 'y' is the potential new element
 elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
 elem_by _  _ []         =  False
 -- 'y' is the potential new element
 elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
 elem_by _  _ []         =  False

-elem_by eq y (x:xs)     =  x `eq` y || elem_by eq y xs
+elem_by eq y (x:xs)     =  y `eq` x || elem_by eq y xs

 #endif
 
 
 #endif
 
 

@@ -399,6 +399,9 @@ unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
 -- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]
 --
 -- If the first list contains duplicates, so will the result.
 -- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]
 --
 -- If the first list contains duplicates, so will the result.

+--
+-- > [1,2,2,3,4] `intersect` [6,4,4,2] == [2,2,4]
+--

 -- It is a special case of 'intersectBy', which allows the programmer to
 -- supply their own equality test.
 
 -- It is a special case of 'intersectBy', which allows the programmer to
 -- supply their own equality test.
 

@@ -434,7 +437,7 @@ intercalate xs xss = concat (intersperse xs xss)
 transpose               :: [[a]] -> [[a]]
 transpose []             = []
 transpose ([]   : xss)   = transpose xss
 transpose               :: [[a]] -> [[a]]
 transpose []             = []
 transpose ([]   : xss)   = transpose xss

-transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : transpose (xs : [ t | (h:t) <- xss])
+transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])

 
 
 -- | The 'partition' function takes a predicate a list and returns
 
 
 -- | The 'partition' function takes a predicate a list and returns

@@ -447,6 +450,7 @@ partition               :: (a -> Bool) -> [a] -> ([a],[a])
 {-# INLINE partition #-}
 partition p xs = foldr (select p) ([],[]) xs
 
 {-# INLINE partition #-}
 partition p xs = foldr (select p) ([],[]) xs
 

+select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])

 select p x ~(ts,fs) | p x       = (x:ts,fs)
                     | otherwise = (ts, x:fs)
 
 select p x ~(ts,fs) | p x       = (x:ts,fs)
                     | otherwise = (ts, x:fs)
 

@@ -543,22 +547,22 @@ strictMinimum xs        =  foldl1' min xs
 -- The list must be finite and non-empty.
 maximumBy               :: (a -> a -> Ordering) -> [a] -> a
 maximumBy _ []          =  error "List.maximumBy: empty list"
 -- The list must be finite and non-empty.
 maximumBy               :: (a -> a -> Ordering) -> [a] -> a
 maximumBy _ []          =  error "List.maximumBy: empty list"

-maximumBy cmp xs        =  foldl1 max xs
+maximumBy cmp xs        =  foldl1 maxBy xs

                         where
                         where

-                           max x y = case cmp x y of
-                                        GT -> x
-                                        _  -> y
+                           maxBy x y = case cmp x y of
+                                       GT -> x
+                                       _  -> y

 
 -- | The 'minimumBy' function takes a comparison function and a list
 -- and returns the least element of the list by the comparison function.
 -- The list must be finite and non-empty.
 minimumBy               :: (a -> a -> Ordering) -> [a] -> a
 minimumBy _ []          =  error "List.minimumBy: empty list"
 
 -- | The 'minimumBy' function takes a comparison function and a list
 -- and returns the least element of the list by the comparison function.
 -- The list must be finite and non-empty.
 minimumBy               :: (a -> a -> Ordering) -> [a] -> a
 minimumBy _ []          =  error "List.minimumBy: empty list"

-minimumBy cmp xs        =  foldl1 min xs
+minimumBy cmp xs        =  foldl1 minBy xs

                         where
                         where

-                           min x y = case cmp x y of
-                                        GT -> y
-                                        _  -> x
+                           minBy x y = case cmp x y of
+                                       GT -> y
+                                       _  -> x

 
 -- | The 'genericLength' function is an overloaded version of 'length'.  In
 -- particular, instead of returning an 'Int', it returns any type which is
 
 -- | The 'genericLength' function is an overloaded version of 'length'.  In
 -- particular, instead of returning an 'Int', it returns any type which is

@@ -567,30 +571,39 @@ genericLength           :: (Num i) => [b] -> i
 genericLength []        =  0
 genericLength (_:l)     =  1 + genericLength l
 
 genericLength []        =  0
 genericLength (_:l)     =  1 + genericLength l
 

+{-# RULES
+  "genericLengthInt"     genericLength = (strictGenericLength :: [a] -> Int);
+  "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer);
+ #-}
+
+strictGenericLength     :: (Num i) => [b] -> i
+strictGenericLength l   =  gl l 0
+                        where
+                           gl [] a     = a
+                           gl (_:xs) a = let a' = a + 1 in a' `seq` gl xs a'
+

 -- | The 'genericTake' function is an overloaded version of 'take', which
 -- accepts any 'Integral' value as the number of elements to take.
 genericTake             :: (Integral i) => i -> [a] -> [a]
 -- | The 'genericTake' function is an overloaded version of 'take', which
 -- accepts any 'Integral' value as the number of elements to take.
 genericTake             :: (Integral i) => i -> [a] -> [a]

-genericTake 0 _         =  []
+genericTake n _ | n <= 0 = []

 genericTake _ []        =  []
 genericTake _ []        =  []

-genericTake n (x:xs) | n > 0  =  x : genericTake (n-1) xs
-genericTake _  _        =  error "List.genericTake: negative argument"
+genericTake n (x:xs)    =  x : genericTake (n-1) xs

 
 -- | The 'genericDrop' function is an overloaded version of 'drop', which
 -- accepts any 'Integral' value as the number of elements to drop.
 genericDrop             :: (Integral i) => i -> [a] -> [a]
 
 -- | The 'genericDrop' function is an overloaded version of 'drop', which
 -- accepts any 'Integral' value as the number of elements to drop.
 genericDrop             :: (Integral i) => i -> [a] -> [a]

-genericDrop 0 xs        =  xs
+genericDrop n xs | n <= 0 = xs

 genericDrop _ []        =  []
 genericDrop _ []        =  []

-genericDrop n (_:xs) | n > 0  =  genericDrop (n-1) xs
-genericDrop _ _         =  error "List.genericDrop: negative argument"
+genericDrop n (_:xs)    =  genericDrop (n-1) xs
+

 
 -- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which
 -- accepts any 'Integral' value as the position at which to split.
 genericSplitAt          :: (Integral i) => i -> [b] -> ([b],[b])
 
 -- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which
 -- accepts any 'Integral' value as the position at which to split.
 genericSplitAt          :: (Integral i) => i -> [b] -> ([b],[b])

-genericSplitAt 0 xs     =  ([],xs)
+genericSplitAt n xs | n <= 0 =  ([],xs)

 genericSplitAt _ []     =  ([],[])
 genericSplitAt _ []     =  ([],[])

-genericSplitAt n (x:xs) | n > 0  =  (x:xs',xs'') where
-                               (xs',xs'') = genericSplitAt (n-1) xs
-genericSplitAt _ _      =  error "List.genericSplitAt: negative argument"
+genericSplitAt n (x:xs) =  (x:xs',xs'') where
+    (xs',xs'') = genericSplitAt (n-1) xs

 
 -- | The 'genericIndex' function is an overloaded version of '!!', which
 -- accepts any 'Integral' value as the index.
 
 -- | The 'genericIndex' function is an overloaded version of '!!', which
 -- accepts any 'Integral' value as the index.

@@ -752,13 +765,16 @@ nonEmptySubsequences (x:xs)  =  [x] : foldr f [] (nonEmptySubsequences xs)
 
 -- | The 'permutations' function returns the list of all permutations of the argument.
 --
 
 -- | The 'permutations' function returns the list of all permutations of the argument.
 --

--- > permutations "abc" == ["abc","bac","bca","acb","cab","cba"]
+-- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]

 permutations            :: [a] -> [[a]]
 permutations            :: [a] -> [[a]]

-permutations []         =  [[]]
-permutations (x:xs)     =  [zs | ys <- permutations xs, zs <- interleave x ys ]
-  where interleave          :: a -> [a] -> [[a]]
-        interleave x []     =  [[x]]
-        interleave x (y:ys) =  [x:y:ys] ++ map (y:) (interleave x ys)
+permutations xs0        =  xs0 : perms xs0 []
+  where
+    perms []     _  = []
+    perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
+      where interleave    xs     r = let (_,zs) = interleave' id xs r in zs
+            interleave' _ []     r = (ts, r)
+            interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
+                                     in  (y:us, f (t:y:us) : zs)

 
 
 ------------------------------------------------------------------------------
 
 
 ------------------------------------------------------------------------------

@@ -777,10 +793,50 @@ sort = sortBy compare
 sortBy cmp = foldr (insertBy cmp) []
 #else
 
 sortBy cmp = foldr (insertBy cmp) []
 #else
 

+{-
+GHC's mergesort replaced by a better implementation, 24/12/2009.
+This code originally contributed to the nhc12 compiler by Thomas Nordin
+in 2002.  Rumoured to have been based on code by Lennart Augustsson, e.g.
+    http://www.mail-archive.com/haskell@haskell.org/msg01822.html
+and possibly to bear similarities to a 1982 paper by Richard O'Keefe:
+"A smooth applicative merge sort".
+
+Benchmarks show it to be often 2x the speed of the previous implementation.
+Fixes ticket http://hackage.haskell.org/trac/ghc/ticket/2143
+-}
+
+sort = sortBy compare
+sortBy cmp = mergeAll . sequences
+  where
+    sequences (a:b:xs)
+      | a `cmp` b == GT = descending b [a]  xs
+      | otherwise       = ascending  b (a:) xs
+    sequences xs = [xs]
+
+    descending a as (b:bs)
+      | a `cmp` b == GT = descending b (a:as) bs
+    descending a as bs  = (a:as): sequences bs
+
+    ascending a as (b:bs)
+      | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs
+    ascending a as bs   = as [a]: sequences bs
+
+    mergeAll [x] = x
+    mergeAll xs  = mergeAll (mergePairs xs)
+
+    mergePairs (a:b:xs) = merge a b: mergePairs xs
+    mergePairs xs       = xs
+
+    merge as@(a:as') bs@(b:bs')
+      | a `cmp` b == GT = b:merge as  bs'
+      | otherwise       = a:merge as' bs
+    merge [] bs         = bs
+    merge as []         = as
+
+{-

 sortBy cmp l = mergesort cmp l
 sort l = mergesort compare l
 
 sortBy cmp l = mergesort cmp l
 sort l = mergesort compare l
 

-{-

 Quicksort replaced by mergesort, 14/5/2002.
 
 From: Ian Lynagh <igloo@earth.li>
 Quicksort replaced by mergesort, 14/5/2002.
 
 From: Ian Lynagh <igloo@earth.li>

@@ -821,24 +877,23 @@ func            100000           sorted        sort        5831.47
 func            100000           sorted        mergesort   2.23
 func            100000           revsorted     sort        5872.34
 func            100000           revsorted     mergesort   2.24
 func            100000           sorted        mergesort   2.23
 func            100000           revsorted     sort        5872.34
 func            100000           revsorted     mergesort   2.24

--}

 
 mergesort :: (a -> a -> Ordering) -> [a] -> [a]
 mergesort cmp = mergesort' cmp . map wrap
 
 mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
 
 mergesort :: (a -> a -> Ordering) -> [a] -> [a]
 mergesort cmp = mergesort' cmp . map wrap
 
 mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]

-mergesort' cmp [] = []
-mergesort' cmp [xs] = xs
+mergesort' _   [] = []
+mergesort' _   [xs] = xs

 mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
 
 merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
 mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
 
 merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]

-merge_pairs cmp [] = []
-merge_pairs cmp [xs] = [xs]
+merge_pairs _   [] = []
+merge_pairs _   [xs] = [xs]

 merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
 
 merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
 merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
 
 merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]

-merge cmp [] ys = ys
-merge cmp xs [] = xs
+merge _   [] ys = ys
+merge _   xs [] = xs

 merge cmp (x:xs) (y:ys)
  = case x `cmp` y of
         GT -> y : merge cmp (x:xs)   ys
 merge cmp (x:xs) (y:ys)
  = case x `cmp` y of
         GT -> y : merge cmp (x:xs)   ys

@@ -847,8 +902,9 @@ merge cmp (x:xs) (y:ys)
 wrap :: a -> [a]
 wrap x = [x]
 
 wrap :: a -> [a]
 wrap x = [x]
 

-{-
-OLD: qsort version
+
+
+OLDER: qsort version

 
 -- qsort is stable and does not concatenate.
 qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
 
 -- qsort is stable and does not concatenate.
 qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]

@@ -918,7 +974,7 @@ unfoldr f b  =
 -- | A strict version of 'foldl'.
 foldl'           :: (a -> b -> a) -> a -> [b] -> a
 #ifdef __GLASGOW_HASKELL__
 -- | A strict version of 'foldl'.
 foldl'           :: (a -> b -> a) -> a -> [b] -> a
 #ifdef __GLASGOW_HASKELL__

-foldl' f z xs = lgo z xs
+foldl' f z0 xs0 = lgo z0 xs0

     where lgo z []     = z
           lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
 #else
     where lgo z []     = z
           lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
 #else