X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FUtil.lhs;h=e692ff1aa3afcd868b7deaafcf44f9e9ea5bc39e;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=d3eb975694b4bcaea1906557ab384be7705ee467;hpb=d1c1b7d0e7b94ede238845c91f58582bad3b3ef3;p=ghc-hetmet.git diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs index d3eb975..e692ff1 100644 --- a/ghc/compiler/utils/Util.lhs +++ b/ghc/compiler/utils/Util.lhs @@ -9,10 +9,11 @@ module Util ( -- general list processing zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal, zipLazy, stretchZipWith, + mapFst, mapSnd, mapAndUnzip, mapAndUnzip3, nOfThem, filterOut, lengthExceeds, lengthIs, lengthAtLeast, listLengthCmp, atLength, - isSingleton, only, + isSingleton, only, singleton, notNull, snocView, isIn, isn'tIn, @@ -28,7 +29,7 @@ module Util ( -- accumulating mapAccumL, mapAccumR, mapAccumB, - foldl2, count, + foldl2, count, all2, takeList, dropList, splitAtList, split, @@ -56,17 +57,21 @@ module Util ( -- IO-ish utilities createDirectoryHierarchy, doesDirNameExist, + modificationTimeIfExists, later, handleDyn, handle, -- Filename utils Suffix, - splitFilename, getFileSuffix, splitFilenameDir, - splitFilename3, removeSuffix, - dropLongestPrefix, takeLongestPrefix, splitLongestPrefix, + splitFilename, suffixOf, basenameOf, joinFileExt, + splitFilenameDir, joinFileName, + splitFilename3, + splitLongestPrefix, replaceFilenameSuffix, directoryOf, filenameOf, replaceFilenameDirectory, escapeSpaces, isPathSeparator, + parseSearchPath, + normalisePath, platformPath, pgmPath, ) where #include "HsVersions.h" @@ -88,10 +93,12 @@ import List ( zipWith4 ) #endif import Monad ( when ) -import IO ( catch ) +import IO ( catch, isDoesNotExistError ) import Directory ( doesDirectoryExist, createDirectory ) import Char ( isUpper, isAlphaNum, isSpace, ord, isDigit ) import Ratio ( (%) ) +import Time ( ClockTime ) +import Directory ( getModificationTime ) infixr 9 `thenCmp` \end{code} @@ -219,6 +226,12 @@ stretchZipWith p z f (x:xs) ys \begin{code} +mapFst :: (a->c) -> [(a,b)] -> [(c,b)] +mapSnd :: (b->c) -> [(a,b)] -> [(a,c)] + +mapFst f xys = [(f x, y) | (x,y) <- xys] +mapSnd f xys = [(x, f y) | (x,y) <- xys] + mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c]) mapAndUnzip f [] = ([],[]) @@ -287,6 +300,9 @@ listLengthCmp = atLength atLen atEnd atLen [] = EQ atLen _ = GT +singleton :: a -> [a] +singleton x = [x] + isSingleton :: [a] -> Bool isSingleton [x] = True isSingleton _ = False @@ -556,6 +572,13 @@ A combination of foldl with zip. It works with equal length lists. foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc foldl2 k z [] [] = z foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs + +all2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool +-- True if the lists are the same length, and +-- all corresponding elements satisfy the predicate +all2 p [] [] = True +all2 p (x:xs) (y:ys) = p x y && all2 p xs ys +all2 p xs ys = False \end{code} Count the number of times a predicate is true @@ -839,46 +862,57 @@ handle h f = f `Exception.catch` \e -> case e of #endif -- -------------------------------------------------------------- +-- check existence & modification time at the same time + +modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime) +modificationTimeIfExists f = do + (do t <- getModificationTime f; return (Just t)) + `IO.catch` \e -> if isDoesNotExistError e + then return Nothing + else ioError e + +-- -------------------------------------------------------------- -- Filename manipulation +-- Filenames are kept "normalised" inside GHC, using '/' as the path +-- separator. On Windows these functions will also recognise '\\' as +-- the path separator, but will generally construct paths using '/'. + type Suffix = String splitFilename :: String -> (String,Suffix) splitFilename f = splitLongestPrefix f (=='.') -getFileSuffix :: String -> Suffix -getFileSuffix f = dropLongestPrefix f (=='.') +basenameOf :: FilePath -> String +basenameOf = fst . splitFilename + +suffixOf :: FilePath -> Suffix +suffixOf = snd . splitFilename + +joinFileExt :: String -> String -> FilePath +joinFileExt path "" = path +joinFileExt path ext = path ++ '.':ext -- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy.ext") splitFilenameDir :: String -> (String,String) splitFilenameDir str - = let (dir, rest) = splitLongestPrefix str isPathSeparator - real_dir | null dir = "." - | otherwise = dir - in (real_dir, rest) + = let (dir, rest) = splitLongestPrefix str isPathSeparator + (dir', rest') | null rest = (".", dir) + | otherwise = (dir, rest) + in (dir', rest') -- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext") splitFilename3 :: String -> (String,String,Suffix) splitFilename3 str - = let (dir, rest) = splitLongestPrefix str isPathSeparator + = let (dir, rest) = splitFilenameDir str (name, ext) = splitFilename rest - real_dir | null dir = "." - | otherwise = dir - in (real_dir, name, ext) - -removeSuffix :: Char -> String -> Suffix -removeSuffix c s - | null pre = s - | otherwise = reverse pre - where (suf,pre) = break (==c) (reverse s) - -dropLongestPrefix :: String -> (Char -> Bool) -> String -dropLongestPrefix s pred = reverse suf - where (suf,_pre) = break pred (reverse s) + in (dir, name, ext) -takeLongestPrefix :: String -> (Char -> Bool) -> String -takeLongestPrefix s pred = reverse pre - where (_suf,pre) = break pred (reverse s) +joinFileName :: String -> String -> FilePath +joinFileName "" fname = fname +joinFileName "." fname = fname +joinFileName dir "" = dir +joinFileName dir fname = dir ++ '/':fname -- split a string at the last character where 'pred' is True, -- returning a pair of strings. The first component holds the string @@ -887,17 +921,18 @@ takeLongestPrefix s pred = reverse pre -- last character). -- -- If 'pred' returns False for all characters in the string, the original --- string is returned in the second component (and the first one is just +-- string is returned in the first component (and the second one is just -- empty). splitLongestPrefix :: String -> (Char -> Bool) -> (String,String) -splitLongestPrefix s pred - = case pre of - [] -> ([], reverse suf) - (_:pre) -> (reverse pre, reverse suf) - where (suf,pre) = break pred (reverse s) +splitLongestPrefix str pred + | null r_pre = (str, []) + | otherwise = (reverse (tail r_pre), reverse r_suf) + -- 'tail' drops the char satisfying 'pred' + where + (r_suf, r_pre) = break pred (reverse str) replaceFilenameSuffix :: FilePath -> Suffix -> FilePath -replaceFilenameSuffix s suf = removeSuffix '.' s ++ suf +replaceFilenameSuffix file suf = basenameOf file `joinFileExt` suf -- directoryOf strips the filename off the input string, returning -- the directory. @@ -910,8 +945,7 @@ filenameOf :: FilePath -> String filenameOf = snd . splitFilenameDir replaceFilenameDirectory :: FilePath -> String -> FilePath -replaceFilenameDirectory s dir - = dir ++ '/':dropLongestPrefix s isPathSeparator +replaceFilenameDirectory path dir = dir `joinFileName` filenameOf path escapeSpaces :: String -> String escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) "" @@ -923,4 +957,73 @@ isPathSeparator ch = #else ch == '/' #endif + +-------------------------------------------------------------- +-- * Search path +-------------------------------------------------------------- + +-- | The function splits the given string to substrings +-- using the 'searchPathSeparator'. +parseSearchPath :: String -> [FilePath] +parseSearchPath path = split path + where + split :: String -> [String] + split s = + case rest' of + [] -> [chunk] + _:rest -> chunk : split rest + where + chunk = + case chunk' of +#ifdef mingw32_HOST_OS + ('\"':xs@(_:_)) | last xs == '\"' -> init xs +#endif + _ -> chunk' + + (chunk', rest') = break (==searchPathSeparator) s + +-- | A platform-specific character used to separate search path strings in +-- environment variables. The separator is a colon (\":\") on Unix and Macintosh, +-- and a semicolon (\";\") on the Windows operating system. +searchPathSeparator :: Char +#if mingw32_HOST_OS || mingw32_TARGET_OS +searchPathSeparator = ';' +#else +searchPathSeparator = ':' +#endif + +----------------------------------------------------------------------------- +-- Convert filepath into platform / MSDOS form. + +-- We maintain path names in Unix form ('/'-separated) right until +-- the last moment. On Windows we dos-ify them just before passing them +-- to the Windows command. +-- +-- The alternative, of using '/' consistently on Unix and '\' on Windows, +-- proved quite awkward. There were a lot more calls to platformPath, +-- and even on Windows we might invoke a unix-like utility (eg 'sh'), which +-- interpreted a command line 'foo\baz' as 'foobaz'. + +normalisePath :: String -> String +-- Just changes '\' to '/' + +pgmPath :: String -- Directory string in Unix format + -> String -- Program name with no directory separators + -- (e.g. copy /y) + -> String -- Program invocation string in native format + +#if defined(mingw32_HOST_OS) +--------------------- Windows version ------------------ +normalisePath xs = subst '\\' '/' xs +pgmPath dir pgm = platformPath dir ++ '\\' : pgm +platformPath p = subst '/' '\\' p + +subst a b ls = map (\ x -> if x == a then b else x) ls +#else +--------------------- Non-Windows version -------------- +normalisePath xs = xs +pgmPath dir pgm = dir ++ '/' : pgm +platformPath stuff = stuff +-------------------------------------------------------- +#endif \end{code}