X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FUtil.lhs;h=e5f702355244f20521c63c1ddbb27f84aba924d6;hb=fa6c4bf01427a4191a595afecf90d96b27bad306;hp=bfb499a2c8ad020d45649b7d69749d324544b290;hpb=3da243bf737dc3e26dfbfa943df1fda1ce7c1bab;p=ghc-hetmet.git diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index bfb499a..e5f7023 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -26,7 +26,7 @@ module Util ( nTimes, -- sorting - sortLe, sortWith, + sortLe, sortWith, on, -- transitive closures transitiveClosure, @@ -457,6 +457,10 @@ sortWith :: Ord b => (a->b) -> [a] -> [a] sortWith get_key xs = sortLe le xs where x `le` y = get_key x < get_key y + +on :: (a -> a -> Ordering) -> (b -> a) -> b -> b -> Ordering +on cmp sel = \x y -> sel x `cmp` sel y + \end{code} %************************************************************************ @@ -590,6 +594,8 @@ cmpList cmp (a:as) (b:bs) \end{code} \begin{code} +-- This (with a more general type) is Data.List.stripPrefix from GHC 6.8. +-- This definition can be removed once we require at least 6.8 to build. maybePrefixMatch :: String -> String -> Maybe String maybePrefixMatch [] rest = Just rest maybePrefixMatch (_:_) [] = Nothing