From: Max Bolingbroke <batterseapower@hotmail.com>
Date: Wed, 13 Feb 2008 21:22:46 +0000 (+0000)
Subject: Added Down class and improved groupWith fusion
X-Git-Tag: 2008-05-28~59
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=4028033c7334eb7fb4aca926fc16685ef89f5d22;p=ghc-base.git

Added Down class and improved groupWith fusion
---

diff --git a/GHC/Exts.hs b/GHC/Exts.hs
index 7869c47..27fecae 100644
--- a/GHC/Exts.hs
+++ b/GHC/Exts.hs
@@ -37,7 +37,7 @@ module GHC.Exts
 	lazy, inline,
 
         -- * Transform comprehensions
-        groupWith, sortWith, the
+        Down(..), groupWith, sortWith, the
 
        ) where
 
@@ -53,6 +53,17 @@ import GHC.Ptr
 import Data.String
 import Data.List
 
+-- | The 'Down' type allows you to reverse sort order conveniently.  A value of type
+-- @'Down' a@ contains a value of type @a@ (represented as @'Down' a@).
+-- If @a@ has an @'Ord'@ instance associated with it then comparing two
+-- values thus wrapped will give you the opposite of their normal sort order.
+-- This is particularly useful when sorting in generalised list comprehensions,
+-- as in: @then sortWith by 'Down' x@
+newtype Down a = Down a deriving (Eq)
+
+instance Ord a => Ord (Down a) where
+    compare (Down x) (Down y) = y `compare` x
+
 -- | 'the' ensures that all the elements of the list are identical
 -- and then returns that unique element
 the :: Eq a => [a] -> a
@@ -69,5 +80,13 @@ sortWith f = sortBy (\x y -> compare (f x) (f y))
 -- | The 'groupWith' function uses the user supplied function which
 -- projects an element out of every list element in order to to first sort the 
 -- input list and then to form groups by equality on these projected elements
+{-# INLINE groupWith #-}
 groupWith :: Ord b => (a -> b) -> [a] -> [[a]]
-groupWith f = groupBy (\x y -> f x == f y) . sortWith f
+groupWith f xs = build (\c n -> groupByFB c n (\x y -> f x == f y) (sortWith f xs))
+
+groupByFB :: ([a] -> lst -> lst) -> lst -> (a -> a -> Bool) -> [a] -> lst
+groupByFB c n eq xs = groupByFBCore xs
+  where groupByFBCore [] = n
+        groupByFBCore (x:xs) = c (x:ys) (groupByFBCore zs)
+            where (ys, zs) = span (eq x) xs
+