X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Futils%2FUtil.lhs;h=79f62eaf0825dcc414c10e0a83b6677c4170f514;hp=8d790010a9f0b237734049c64fe6d202787b0686;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hpb=cfe89540b4a0620d02b47786599ad1836d851b25 diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 8d79001..79f62ea 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -5,6 +5,13 @@ \section[Util]{Highly random utility functions} \begin{code} +{-# OPTIONS -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/CodingStyle#Warnings +-- for details + module Util ( -- general list processing @@ -26,13 +33,12 @@ module Util ( nTimes, -- sorting - sortLe, sortWith, + sortLe, sortWith, on, -- transitive closures transitiveClosure, -- accumulating - mapAccumL, mapAccumR, mapAccumB, foldl2, count, all2, takeList, dropList, splitAtList, split, @@ -43,7 +49,7 @@ module Util ( removeSpaces, -- strictness - foldl', seqList, + seqList, -- pairs unzipWith, @@ -80,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 ) @@ -90,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 ) @@ -109,41 +119,6 @@ infixr 9 `thenCmp` %************************************************************************ %* * -\subsection{The Eager monad} -%* * -%************************************************************************ - -The @Eager@ monad is just an encoding of continuation-passing style, -used to allow you to express "do this and then that", mainly to avoid -space leaks. It's done with a type synonym to save bureaucracy. - -\begin{code} -#if NOT_USED - -type Eager ans a = (a -> ans) -> ans - -runEager :: Eager a a -> a -runEager m = m (\x -> x) - -appEager :: Eager ans a -> (a -> ans) -> ans -appEager m cont = m cont - -thenEager :: Eager ans a -> (a -> Eager ans b) -> Eager ans b -thenEager m k cont = m (\r -> k r cont) - -returnEager :: a -> Eager ans a -returnEager v cont = cont v - -mapEager :: (a -> Eager ans b) -> [a] -> Eager ans [b] -mapEager f [] = returnEager [] -mapEager f (x:xs) = f x `thenEager` \ y -> - mapEager f xs `thenEager` \ ys -> - returnEager (y:ys) -#endif -\end{code} - -%************************************************************************ -%* * \subsection{A for loop} %* * %************************************************************************ @@ -489,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} %************************************************************************ @@ -523,72 +502,6 @@ transitiveClosure succ eq xs %* * %************************************************************************ -@mapAccumL@ behaves like a combination -of @map@ and @foldl@; -it applies a function to each element of a list, passing an accumulating -parameter from left to right, and returning a final value of this -accumulator together with the new list. - -\begin{code} -mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list - -- and accumulator, returning new - -- accumulator and elt of result list - -> acc -- Initial accumulator - -> [x] -- Input list - -> (acc, [y]) -- Final accumulator and result list - -mapAccumL f b [] = (b, []) -mapAccumL f b (x:xs) = (b'', x':xs') where - (b', x') = f b x - (b'', xs') = mapAccumL f b' xs -\end{code} - -@mapAccumR@ does the same, but working from right to left instead. Its type is -the same as @mapAccumL@, though. - -\begin{code} -mapAccumR :: (acc -> x -> (acc, y)) -- Function of elt of input list - -- and accumulator, returning new - -- accumulator and elt of result list - -> acc -- Initial accumulator - -> [x] -- Input list - -> (acc, [y]) -- Final accumulator and result list - -mapAccumR f b [] = (b, []) -mapAccumR f b (x:xs) = (b'', x':xs') where - (b'', x') = f b' x - (b', xs') = mapAccumR f b xs -\end{code} - -Here is the bi-directional version, that works from both left and right. - -\begin{code} -mapAccumB :: (accl -> accr -> x -> (accl, accr,y)) - -- Function of elt of input list - -- and accumulator, returning new - -- accumulator and elt of result list - -> accl -- Initial accumulator from left - -> accr -- Initial accumulator from right - -> [x] -- Input list - -> (accl, accr, [y]) -- Final accumulators and result list - -mapAccumB f a b [] = (a,b,[]) -mapAccumB f a b (x:xs) = (a'',b'',y:ys) - where - (a',b'',y) = f a b' x - (a'',b',ys) = mapAccumB f a' b xs -\end{code} - -A strict version of foldl. - -\begin{code} -foldl' :: (a -> b -> a) -> a -> [b] -> a -foldl' f z xs = lgo z xs - where - lgo z [] = z - lgo z (x:xs) = (lgo $! (f z x)) xs -\end{code} - A combination of foldl with zip. It works with equal length lists. \begin{code} @@ -688,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 @@ -733,6 +648,7 @@ consIORef var x = do Module names: \begin{code} +looksLikeModuleName :: String -> Bool looksLikeModuleName [] = False looksLikeModuleName (c:cs) = isUpper c && go cs where go [] = True