[project @ 1998-02-02 17:27:26 by simonm]

[ghc-hetmet.git] / ghc / lib / std / List.lhs

diff --git a/ghc/lib/required/List.lhs b/ghc/lib/std/List.lhs
similarity index 89%
rename from ghc/lib/required/List.lhs
rename to ghc/lib/std/List.lhs
index 08952a6..1e133a6 100644 (file)
--- a/ghc/lib/required/List.lhs
+++ b/ghc/lib/std/List.lhs
@@ -34,9 +34,9 @@ module List (
   ) where
 
 import Prelude
-import Maybe   (listToMaybe)
+import Maybe   ( listToMaybe )
 import PrelBase        ( Int(..) )
-import GHC     ( (+#) )
+import PrelGHC ( (+#) )
 
 infix 5 \\
 \end{code}
@@ -62,15 +62,16 @@ findIndex p     = listToMaybe . findIndices p
 
 findIndices      :: (a -> Bool) -> [a] -> [Int]
 
--- One line definition
--- findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
-
+#ifdef USE_REPORT_PRELUDE
+findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
+#else
 -- Efficient definition
 findIndices p xs = loop 0# p xs
                 where
                   loop n p [] = []
                   loop n p (x:xs) | p x       = I# n : loop (n +# 1#) p xs
                                   | otherwise = loop (n +# 1#) p xs
+#endif
 
 isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
 isPrefixOf [] _         =  True
@@ -196,12 +197,6 @@ mapAccumR f s (x:xs)       =  (s'', y:ys)
 \end{code}
 
 \begin{code}
-sort :: (Ord a) => [a] -> [a]
-sort = sortBy compare
-
-sortBy :: (a -> a -> Ordering) -> [a] -> [a]
-sortBy cmp = foldr (insertBy cmp) []
-
 insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
 insertBy cmp x [] = [x]
 insertBy cmp x ys@(y:ys')
@@ -339,3 +334,50 @@ tails []           =  [[]]
 tails xxs@(_:xs)       =  xxs : tails xs
 
 \end{code}
+
+%-----------------------------------------------------------------------------
+Quick Sort algorithm taken from HBC's QSort library.
+
+\begin{code}
+sort :: (Ord a) => [a] -> [a]
+sortBy :: (a -> a -> Ordering) -> [a] -> [a]
+
+#ifdef USE_REPORT_PRELUDE
+sort = sortBy compare
+sortBy cmp = foldr (insertBy cmp) []
+#else
+
+sortBy cmp l = qsort cmp l []
+sort l = qsort compare l []
+
+-- rest is not exported:
+
+-- qsort is stable and does not concatenate.
+qsort cmp []     r = r
+qsort cmp [x]    r = x:r
+qsort cmp (x:xs) r = qpart cmp x xs [] [] r
+
+-- qpart partitions and sorts the sublists
+qpart cmp x [] rlt rge r =
+    -- rlt and rge are in reverse order and must be sorted with an
+    -- anti-stable sorting
+    rqsort cmp rlt (x:rqsort cmp rge r)
+qpart cmp x (y:ys) rlt rge r =
+    case cmp x y of
+       GT -> qpart cmp x ys (y:rlt) rge r
+        _  -> qpart cmp x ys rlt (y:rge) r
+
+-- rqsort is as qsort but anti-stable, i.e. reverses equal elements
+rqsort cmp []     r = r
+rqsort cmp [x]    r = x:r
+rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r
+
+rqpart cmp x [] rle rgt r =
+    qsort cmp rle (x:qsort cmp rgt r)
+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 */
+\end{code}