[project @ 2003-05-27 08:46:38 by malcolm]

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

diff --git a/Data/List.hs b/Data/List.hs
index ea2ff2a..856e0e9 100644 (file)
--- a/Data/List.hs
+++ b/Data/List.hs
@@ -1,25 +1,25 @@
 {-# OPTIONS -fno-implicit-prelude #-}
 -----------------------------------------------------------------------------
--- 
+-- |
 -- Module      :  Data.List
 -- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/core/LICENSE)
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: List.hs,v 1.3 2002/04/02 10:19:21 simonmar Exp $
---
 -- Operations on lists.
 --
 -----------------------------------------------------------------------------
 
 module Data.List
    ( 
-    [] (..),
-
-   , elemIndex        -- :: (Eq a) => a -> [a] -> Maybe Int
+#ifdef __NHC__
+     [] (..)
+   ,
+#endif
+     elemIndex        -- :: (Eq a) => a -> [a] -> Maybe Int
    , elemIndices       -- :: (Eq a) => a -> [a] -> [Int]
 
    , find             -- :: (a -> Bool) -> [a] -> Maybe a
@@ -136,6 +136,10 @@ module Data.List
 
    ) where
 
+#ifdef __NHC__
+import Prelude hiding (Maybe(..))
+#endif
+
 import Data.Maybe
 
 #ifdef __GLASGOW_HASKELL__
@@ -165,19 +169,15 @@ findIndex p     = listToMaybe . findIndices p
 
 findIndices      :: (a -> Bool) -> [a] -> [Int]
 
-#ifdef USE_REPORT_PRELUDE
+#if defined(USE_REPORT_PRELUDE) || !defined(__GLASGOW_HASKELL__)
 findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
 #else
-#ifdef __HUGS__
-findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
-#else 
 -- Efficient definition
 findIndices p ls = loop 0# ls
                 where
                   loop _ [] = []
                   loop n (x:xs) | p x       = I# n : loop (n +# 1#) xs
                                 | otherwise = loop (n +# 1#) xs
-#endif  /* __HUGS__ */
 #endif  /* USE_REPORT_PRELUDE */
 
 isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
@@ -467,10 +467,78 @@ sort = sortBy compare
 sortBy cmp = foldr (insertBy cmp) []
 #else
 
-sortBy cmp l = qsort cmp l []
-sort l = qsort compare l []
+sortBy cmp l = mergesort cmp l
+sort l = mergesort compare l
 
--- rest is not exported:
+{-
+Quicksort replaced by mergesort, 14/5/2002.
+
+From: Ian Lynagh <igloo@earth.li>
+
+I am curious as to why the List.sort implementation in GHC is a
+quicksort algorithm rather than an algorithm that guarantees n log n
+time in the worst case? I have attached a mergesort implementation along
+with a few scripts to time it's performance, the results of which are
+shown below (* means it didn't finish successfully - in all cases this
+was due to a stack overflow).
+
+If I heap profile the random_list case with only 10000 then I see
+random_list peaks at using about 2.5M of memory, whereas in the same
+program using List.sort it uses only 100k.
+
+Input style     Input length     Sort data     Sort alg    User time
+stdin           10000            random_list   sort        2.82
+stdin           10000            random_list   mergesort   2.96
+stdin           10000            sorted        sort        31.37
+stdin           10000            sorted        mergesort   1.90
+stdin           10000            revsorted     sort        31.21
+stdin           10000            revsorted     mergesort   1.88
+stdin           100000           random_list   sort        *
+stdin           100000           random_list   mergesort   *
+stdin           100000           sorted        sort        *
+stdin           100000           sorted        mergesort   *
+stdin           100000           revsorted     sort        *
+stdin           100000           revsorted     mergesort   *
+func            10000            random_list   sort        0.31
+func            10000            random_list   mergesort   0.91
+func            10000            sorted        sort        19.09
+func            10000            sorted        mergesort   0.15
+func            10000            revsorted     sort        19.17
+func            10000            revsorted     mergesort   0.16
+func            100000           random_list   sort        3.85
+func            100000           random_list   mergesort   *
+func            100000           sorted        sort        5831.47
+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' cmp [] = []
+mergesort' cmp [xs] = xs
+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 cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
+
+merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
+merge cmp xs [] = xs
+merge cmp [] ys = ys
+merge cmp (x:xs) (y:ys)
+ = case x `cmp` y of
+        GT -> y : merge cmp (x:xs)   ys
+        _  -> x : merge cmp    xs (y:ys)
+
+wrap :: a -> [a]
+wrap x = [x]
+
+{-
+OLD: qsort version
 
 -- qsort is stable and does not concatenate.
 qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
@@ -502,6 +570,7 @@ rqpart cmp x (y:ys) rle rgt r =
     case cmp y x of
        GT -> rqpart cmp x ys rle (y:rgt) r
        _  -> rqpart cmp x ys (y:rle) rgt r
+-}
 
 #endif /* USE_REPORT_PRELUDE */
 
@@ -530,6 +599,7 @@ foldl'           :: (a -> b -> a) -> a -> [b] -> a
 foldl' f a []     = a
 foldl' f a (x:xs) = let a' = f a x in a' `seq` foldl' f a' xs
 
+#ifdef __GLASGOW_HASKELL__
 -- -----------------------------------------------------------------------------
 -- List sum and product
 
@@ -552,3 +622,4 @@ product     l       = prod l 1
     prod []     a = a
     prod (x:xs) a = prod xs (a*x)
 #endif
+#endif  /* __GLASGOW_HASKELL__ */