From: simonmar Date: Tue, 17 May 2005 10:51:05 +0000 (+0000) Subject: [project @ 2005-05-17 10:51:04 by simonmar] X-Git-Tag: Initial_conversion_from_CVS_complete~533 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=71fce424e0ce10662cca57da96b3175fdf61c9ee;p=ghc-hetmet.git [project @ 2005-05-17 10:51:04 by simonmar] Rationalise the filename handling in a few places, taking some bits from the defunct System.FilePath library. Also fixes a bug I recently introduced in replaceFilenameDirectory. --- diff --git a/ghc/compiler/ghci/Linker.lhs b/ghc/compiler/ghci/Linker.lhs index c971f91..f8a8c8b 100644 --- a/ghc/compiler/ghci/Linker.lhs +++ b/ghc/compiler/ghci/Linker.lhs @@ -827,8 +827,8 @@ locateOneObj dirs lib Just lib_path -> return (DLL (lib ++ "_dyn")) Nothing -> return (DLL lib) }} -- We assume where - mk_obj_path dir = dir ++ '/':lib ++ ".o" - mk_dyn_lib_path dir = dir ++ '/':mkSOName (lib ++ "_dyn") + mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o") + mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "_dyn") -- ---------------------------------------------------------------------------- @@ -843,16 +843,16 @@ loadDynamic paths rootname -- Tried all our known library paths, so let -- dlopen() search its own builtin paths now. where - mk_dll_path dir = dir ++ '/':mkSOName rootname + mk_dll_path dir = dir `joinFileName` mkSOName rootname #if defined(darwin_TARGET_OS) -mkSOName root = "lib" ++ root ++ ".dylib" +mkSOName root = ("lib" ++ root) `joinFileExt` "dylib" #elif defined(mingw32_TARGET_OS) -- Win32 DLLs have no .dll extension here, because addDLL tries -- both foo.dll and foo.drv mkSOName root = root #else -mkSOName root = "lib" ++ root ++ ".so" +mkSOName root = ("lib" ++ root) `joinFileExt` "so" #endif -- Darwin / MacOS X only: load a framework @@ -867,7 +867,7 @@ loadFramework extraPaths rootname -- Tried all our known library paths, but dlopen() -- has no built-in paths for frameworks: give up where - mk_fwk dir = dir ++ '/' : rootname ++ ".framework/" ++ rootname + mk_fwk dir = dir `joinFileName` (rootname ++ ".framework/" ++ rootname) -- sorry for the hardcoded paths, I hope they won't change anytime soon: defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"] #endif diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index 0a461d1..2b25bc5 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -287,7 +287,7 @@ searchPathExts paths mod exts | path <- paths, (ext,fn) <- exts, let base | path == "." = basename - | otherwise = path ++ '/':basename + | otherwise = path `joinFileName` basename file = base `joinFileExt` ext ] @@ -301,7 +301,7 @@ searchPathExts paths mod exts mkHomeModLocationSearched :: DynFlags -> Module -> FileExt -> FilePath -> BaseName -> IO FinderCacheEntry mkHomeModLocationSearched dflags mod suff path basename = do - loc <- mkHomeModLocation2 dflags mod (path ++ '/':basename) suff + loc <- mkHomeModLocation2 dflags mod (path `joinFileName` basename) suff return (loc, Nothing) mkHiOnlyModLocation :: DynFlags -> FileExt -> FilePath -> BaseName @@ -371,7 +371,7 @@ mkHomeModLocation2 dflags mod src_basename ext = do hiOnlyModLocation :: DynFlags -> FilePath -> String -> Suffix -> IO ModLocation hiOnlyModLocation dflags path basename hisuf - = do let full_basename = path++'/':basename + = do let full_basename = path `joinFileName` basename obj_fn <- mkObjPath dflags full_basename basename return ModLocation{ ml_hs_file = Nothing, ml_hi_file = full_basename `joinFileExt` hisuf, @@ -394,7 +394,7 @@ mkObjPath dflags basename mod_basename odir = outputDir dflags osuf = objectSuf dflags - obj_basename | Just dir <- odir = dir ++ '/':mod_basename + obj_basename | Just dir <- odir = dir `joinFileName` mod_basename | otherwise = basename return (obj_basename `joinFileExt` osuf) @@ -411,7 +411,7 @@ mkHiPath dflags basename mod_basename hidir = hiDir dflags hisuf = hiSuf dflags - hi_basename | Just dir <- hidir = dir ++ '/':mod_basename + hi_basename | Just dir <- hidir = dir `joinFileName` mod_basename | otherwise = basename return (hi_basename `joinFileExt` hisuf) diff --git a/ghc/compiler/main/Packages.lhs b/ghc/compiler/main/Packages.lhs index 65f8523..240c132 100644 --- a/ghc/compiler/main/Packages.lhs +++ b/ghc/compiler/main/Packages.lhs @@ -209,8 +209,9 @@ readPackageConfigs dflags = do (exists, pkgconf) <- catch (do appdir <- getAppUserDataDirectory "ghc" let - pkgconf = appdir ++ '/':TARGET_ARCH ++ '-':TARGET_OS - ++ '-':cProjectVersion ++ "/package.conf" + pkgconf = appdir + `joinFileName` (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion) + `joinFileName` "package.conf" flg <- doesFileExist pkgconf return (flg, pkgconf)) -- gobble them all up and turn into False. diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs index 6dadee4..c08ebe4 100644 --- a/ghc/compiler/main/SysTools.lhs +++ b/ghc/compiler/main/SysTools.lhs @@ -49,8 +49,8 @@ import Config import Outputable import ErrUtils ( putMsg, debugTraceMsg ) import Panic ( GhcException(..) ) -import Util ( Suffix, global, notNull, consIORef, - normalisePath, pgmPath, platformPath ) +import Util ( Suffix, global, notNull, consIORef, joinFileName, + normalisePath, pgmPath, platformPath, joinFileExt ) import DynFlags ( DynFlags(..), DynFlag(..), dopt, Option(..), setTmpDir, defaultDynFlags ) @@ -212,8 +212,8 @@ initSysTools minusB_args dflags ; let installed, installed_bin :: FilePath -> FilePath installed_bin pgm = pgmPath top_dir pgm installed file = pgmPath top_dir file - inplace dir pgm = pgmPath (top_dir `slash` - cPROJECT_DIR `slash` dir) pgm + inplace dir pgm = pgmPath (top_dir `joinFileName` + cPROJECT_DIR `joinFileName` dir) pgm ; let pkgconfig_path | am_installed = installed "package.conf" @@ -414,7 +414,7 @@ findTopDir minusbs = do { top_dir <- get_proto -- Discover whether we're running in a build tree or in an installation, -- by looking for the package configuration file. - ; am_installed <- doesFileExist (top_dir `slash` "package.conf") + ; am_installed <- doesFileExist (top_dir `joinFileName` "package.conf") ; return (am_installed, top_dir) } @@ -547,7 +547,7 @@ newTempName DynFlags{tmpDir=tmp_dir} extn findTempName (tmp_dir ++ "/ghc" ++ show x ++ "_") 0 where findTempName prefix x - = do let filename = prefix ++ show x ++ '.':extn + = do let filename = (prefix ++ show x) `joinFileExt` extn b <- doesFileExist filename if b then findTempName prefix (x+1) else do consIORef v_FilesToClean filename -- clean it up later @@ -654,15 +654,6 @@ traceCmd dflags phase_name cmd_line action ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) } \end{code} ------------------------------------------------------------------------------ - Path name construction - -\begin{code} -slash :: String -> String -> String -slash s1 s2 = s1 ++ ('/' : s2) -\end{code} - - %************************************************************************ %* * \subsection{Support code} diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs index a19d2e7..a36be7a 100644 --- a/ghc/compiler/utils/Util.lhs +++ b/ghc/compiler/utils/Util.lhs @@ -63,7 +63,7 @@ module Util ( -- Filename utils Suffix, - splitFilename, getFileSuffix, splitFilenameDir, joinFileExt, + splitFilename, getFileSuffix, splitFilenameDir, joinFileExt, joinFileName, splitFilename3, removeSuffix, dropLongestPrefix, takeLongestPrefix, splitLongestPrefix, replaceFilenameSuffix, directoryOf, filenameOf, @@ -862,6 +862,10 @@ modificationTimeIfExists f = do -- -------------------------------------------------------------- -- 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) @@ -885,11 +889,15 @@ splitFilenameDir str -- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext") splitFilename3 :: String -> (String,String,Suffix) splitFilename3 str - = let (dir, rest) = splitLongestPrefix str isPathSeparator - (dir', rest') | null rest = (".", dir) - | otherwise = (dir, rest) - (name, ext) = splitFilename rest' - in (dir', name, ext) + = let (dir, rest) = splitFilenameDir str + (name, ext) = splitFilename rest + in (dir, name, ext) + +joinFileName :: String -> String -> FilePath +joinFileName "" fname = fname +joinFileName "." fname = fname +joinFileName dir "" = dir +joinFileName dir fname = dir ++ '/':fname removeSuffix :: Char -> String -> Suffix removeSuffix c s = takeLongestPrefix s (==c) @@ -907,7 +915,7 @@ takeLongestPrefix s pred = fst (splitLongestPrefix s pred) -- 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 @@ -916,8 +924,14 @@ splitLongestPrefix s pred (_:pre) -> (reverse pre, reverse suf) where (suf,pre) = break pred (reverse s) +basenameOf :: FilePath -> String +basenameOf = fst . splitFilename + +suffixOf :: FilePath -> Suffix +suffixOf = snd . splitFilename + 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. @@ -930,8 +944,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) ""