[project @ 2005-01-28 12:55:17 by simonmar]

[ghc-hetmet.git] / ghc / compiler / utils / Util.lhs

diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 34a5b53..11d1b5e 100644 (file)
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -21,7 +21,7 @@ module Util (
        nTimes,
 
        -- sorting
-       sortLe,
+       sortLe, sortWith,
 
        -- transitive closures
        transitiveClosure,
@@ -33,7 +33,7 @@ module Util (
        takeList, dropList, splitAtList,
 
        -- comparisons
-       eqListBy, equalLength, compareLength,
+       isEqual, eqListBy, equalLength, compareLength,
        thenCmp, cmpList, prefixMatch, suffixMatch, maybePrefixMatch,
 
        -- strictness
@@ -53,7 +53,6 @@ module Util (
        readRational,
     ) where
 
-#include "../includes/ghcconfig.h"
 #include "HsVersions.h"
 
 import Panic           ( panic, trace )
@@ -373,34 +372,24 @@ Carsten
 
 \begin{code}
 group :: (a -> a -> Bool) -> [a] -> [[a]]
+-- Given a <= function, group finds maximal contiguous up-runs 
+-- or down-runs in the input list.
+-- It's stable, in the sense that it never re-orders equal elements
+--
+-- Date: Mon, 12 Feb 1996 15:09:41 +0000
+-- From: Andy Gill <andy@dcs.gla.ac.uk>
+-- Here is a `better' definition of group.
 
-{-
-Date: Mon, 12 Feb 1996 15:09:41 +0000
-From: Andy Gill <andy@dcs.gla.ac.uk>
-
-Here is a `better' definition of group.
--}
 group p []     = []
 group p (x:xs) = group' xs x x (x :)
   where
     group' []     _     _     s  = [s []]
     group' (x:xs) x_min x_max s 
-       | not (x `p` x_max) = group' xs x_min x (s . (x :)) 
-       | x `p` x_min       = group' xs x x_max ((x :) . s) 
+       |      x_max `p` x  = group' xs x_min x (s . (x :)) 
+       | not (x_min `p` x) = group' xs x x_max ((x :) . s) 
        | otherwise         = s [] : group' xs x x (x :) 
-
--- This one works forwards *and* backwards, as well as also being
--- faster that the one in Util.lhs.
-
-{- ORIG:
-group p [] = [[]]
-group p (x:xs) =
-   let ((h1:t1):tt1) = group p xs
-       (t,tt) = if null xs then ([],[]) else
-               if x `p` h1 then (h1:t1,tt1) else
-                  ([], (h1:t1):tt1)
-   in ((x:t):tt)
--}
+       -- NB: the 'not' is essential for stablity
+       --      x `p` x_min would reverse equal elements
 
 generalMerge :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 generalMerge p xs [] = xs
@@ -436,6 +425,11 @@ mergeSortLe le = generalMergeSort le
 
 sortLe :: (a->a->Bool) -> [a] -> [a]
 sortLe le = generalNaturalMergeSort le
+
+sortWith :: Ord b => (a->b) -> [a] -> [a]
+sortWith get_key xs = sortLe le xs
+  where
+    x `le` y = get_key x < get_key y   
 \end{code}
 
 %************************************************************************
@@ -587,6 +581,17 @@ splitAtList (_:xs) (y:ys) = (y:ys', ys'')
 %************************************************************************
 
 \begin{code}
+isEqual :: Ordering -> Bool
+-- Often used in (isEqual (a `compare` b))
+isEqual GT = False
+isEqual EQ = True
+isEqual LT = False
+
+thenCmp :: Ordering -> Ordering -> Ordering
+{-# INLINE thenCmp #-}
+thenCmp EQ   any = any
+thenCmp other any = other
+
 eqListBy :: (a->a->Bool) -> [a] -> [a] -> Bool
 eqListBy eq []     []     = True
 eqListBy eq (x:xs) (y:ys) = eq x y && eqListBy eq xs ys
@@ -603,11 +608,6 @@ compareLength (_:xs) (_:ys) = compareLength xs ys
 compareLength [] _ys        = LT
 compareLength _xs []        = GT
 
-thenCmp :: Ordering -> Ordering -> Ordering
-{-# INLINE thenCmp #-}
-thenCmp EQ   any = any
-thenCmp other any = other
-
 cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
     -- `cmpList' uses a user-specified comparer