X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FUtil.lhs;h=64ed4f1e61223b22aea961625b6efc4b060ebd8a;hb=17b297d97d327620ed6bfab942f8992b2446f1bf;hp=8473faf42eeb94d29641c35e850b2e5d7a9454d7;hpb=8100c58a929d993d2dd7022412ed6113cf97fba7;p=ghc-hetmet.git diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 8473faf..64ed4f1 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -5,6 +5,13 @@ \section[Util]{Highly random utility functions} \begin{code} +{-# OPTIONS_GHC -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings +-- for details + module Util ( -- general list processing @@ -26,7 +33,7 @@ module Util ( nTimes, -- sorting - sortLe, sortWith, + sortLe, sortWith, on, -- transitive closures transitiveClosure, @@ -79,9 +86,12 @@ module Util ( #include "HsVersions.h" -import Panic ( panic, trace ) import FastTypes +#ifdef DEBUG +import Panic ( panic, trace ) +#endif + import Control.Exception ( Exception(..), finally, catchDyn, throw ) import qualified Control.Exception as Exception import Data.Dynamic ( Typeable ) @@ -89,10 +99,11 @@ import Data.IORef ( IORef, newIORef ) import System.IO.Unsafe ( unsafePerformIO ) import Data.IORef ( readIORef, writeIORef ) -import qualified Data.List as List ( elem, notElem ) - +import qualified Data.List as List ( elem ) #ifndef DEBUG import Data.List ( zipWith4 ) +#else +import qualified Data.List as List ( notElem ) #endif import Control.Monad ( when ) @@ -453,6 +464,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} %************************************************************************ @@ -586,6 +601,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