X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FUtil.lhs;h=ed4a4b9ead2f7ad259df70ae7b57a643519d7e0f;hb=b98b590f7f62cd8f5c1653584ce37ebf5ac09ffd;hp=a7b65e8eb979910ee588e3f329b7b21b02501a0f;hpb=308cb59e89a5be1ed6d55da39a843ca5f1828445;p=ghc-hetmet.git diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index a7b65e8..ed4a4b9 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -12,7 +12,7 @@ module Util ( zipLazy, stretchZipWith, mapFst, mapSnd, mapAndUnzip, mapAndUnzip3, - nOfThem, filterOut, partitionWith, + nOfThem, filterOut, partitionWith, splitEithers, lengthExceeds, lengthIs, lengthAtLeast, listLengthCmp, atLength, equalLength, compareLength, @@ -39,7 +39,7 @@ module Util ( -- comparisons isEqual, eqListBy, - thenCmp, cmpList, prefixMatch, suffixMatch, maybePrefixMatch, + thenCmp, cmpList, maybePrefixMatch, removeSpaces, -- strictness @@ -177,6 +177,13 @@ partitionWith f (x:xs) = case f x of where (bs,cs) = partitionWith f xs +splitEithers :: [Either a b] -> ([a], [b]) +splitEithers [] = ([],[]) +splitEithers (e : es) = case e of + Left x -> (x:xs, ys) + Right y -> (xs, y:ys) + where + (xs,ys) = splitEithers es \end{code} A paranoid @zip@ (and some @zipWith@ friends) that checks the lists @@ -681,12 +688,6 @@ cmpList cmp (a:as) (b:bs) \end{code} \begin{code} -prefixMatch :: Eq a => [a] -> [a] -> Bool -prefixMatch [] _str = True -prefixMatch _pat [] = False -prefixMatch (p:ps) (s:ss) | p == s = prefixMatch ps ss - | otherwise = False - maybePrefixMatch :: String -> String -> Maybe String maybePrefixMatch [] rest = Just rest maybePrefixMatch (_:_) [] = Nothing @@ -694,9 +695,6 @@ maybePrefixMatch (p:pat) (r:rest) | p == r = maybePrefixMatch pat rest | otherwise = Nothing -suffixMatch :: Eq a => [a] -> [a] -> Bool -suffixMatch pat str = prefixMatch (reverse pat) (reverse str) - removeSpaces :: String -> String removeSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace \end{code} @@ -707,15 +705,6 @@ removeSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace %* * %************************************************************************ -The following are curried versions of @fst@ and @snd@. - -\begin{code} -#if NOT_USED -cfst :: a -> b -> a -- stranal-sem only (Note) -cfst x y = x -#endif -\end{code} - The following provide us higher order functions that, when applied to a function, operate on pairs. @@ -883,13 +872,9 @@ handleDyn :: Typeable ex => (ex -> IO a) -> IO a -> IO a handleDyn = flip catchDyn handle :: (Exception -> IO a) -> IO a -> IO a -#if __GLASGOW_HASKELL__ < 501 -handle = flip Exception.catchAllIO -#else handle h f = f `Exception.catch` \e -> case e of ExitException _ -> throw e _ -> h e -#endif -- -------------------------------------------------------------- -- check existence & modification time at the same time