projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Use System.FilePath
[ghc-hetmet.git]
/
compiler
/
main
/
SysTools.lhs
diff --git
a/compiler/main/SysTools.lhs
b/compiler/main/SysTools.lhs
index
f5812f4
..
41421d6
100644
(file)
--- a/
compiler/main/SysTools.lhs
+++ b/
compiler/main/SysTools.lhs
@@
-29,7
+29,6
@@
module SysTools (
touch, -- String -> String -> IO ()
copy,
copyWithHeader,
touch, -- String -> String -> IO ()
copy,
copyWithHeader,
- normalisePath, -- FilePath -> FilePath
getExtraViaCOpts,
-- Temporary-file management
getExtraViaCOpts,
-- Temporary-file management
@@
-58,6
+57,7
@@
import Data.IORef
import Control.Monad
import System.Exit
import System.Environment
import Control.Monad
import System.Exit
import System.Environment
+import System.FilePath
import System.IO
import SYSTEM_IO_ERROR as IO
import System.Directory
import System.IO
import SYSTEM_IO_ERROR as IO
import System.Directory
@@
-172,10
+172,9
@@
initSysTools mbMinusB dflags
-- format, '/' separated
; let installed, installed_bin :: FilePath -> FilePath
-- format, '/' separated
; 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 `joinFileName`
- cPROJECT_DIR `joinFileName` dir) pgm
+ installed_bin pgm = top_dir </> pgm
+ installed file = top_dir </> file
+ inplace dir pgm = top_dir </> cPROJECT_DIR </> dir </> pgm
; let pkgconfig_path
| am_installed = installed "package.conf"
; let pkgconfig_path
| am_installed = installed "package.conf"
@@
-281,9
+280,9
@@
initSysTools mbMinusB dflags
; let (mkdll_prog, mkdll_args)
| am_installed =
; let (mkdll_prog, mkdll_args)
| am_installed =
- (pgmPath (installed "gcc-lib/") cMKDLL,
+ (installed "gcc-lib/" </> cMKDLL,
[ Option "--dlltool-name",
[ Option "--dlltool-name",
- Option (pgmPath (installed "gcc-lib/") "dlltool"),
+ Option (installed "gcc-lib/" </> "dlltool"),
Option "--driver-name",
Option gcc_prog, gcc_b_arg ])
| otherwise = (cMKDLL, [])
Option "--driver-name",
Option gcc_prog, gcc_b_arg ])
| otherwise = (cMKDLL, [])
@@
-374,14
+373,14
@@
findTopDir mbMinusB
= 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.
= 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 `joinFileName` "package.conf")
+ ; am_installed <- doesFileExist (top_dir </> "package.conf")
; return (am_installed, top_dir)
}
where
-- get_proto returns a Unix-format path (relying on getBaseDir to do so too)
get_proto = case mbMinusB of
; return (am_installed, top_dir)
}
where
-- get_proto returns a Unix-format path (relying on getBaseDir to do so too)
get_proto = case mbMinusB of
- Just minusb -> return (normalisePath minusb)
+ Just minusb -> return (normalise minusb)
Nothing
-> do maybe_exec_dir <- getBaseDir -- Get directory of executable
case maybe_exec_dir of -- (only works on Windows;
Nothing
-> do maybe_exec_dir <- getBaseDir -- Get directory of executable
case maybe_exec_dir of -- (only works on Windows;
@@
-573,7
+572,7
@@
copyWithHeader dflags purpose maybe_header from to = do
getExtraViaCOpts :: DynFlags -> IO [String]
getExtraViaCOpts dflags = do
getExtraViaCOpts :: DynFlags -> IO [String]
getExtraViaCOpts dflags = do
- f <- readFile (topDir dflags `joinFileName` "extra-gcc-opts")
+ f <- readFile (topDir dflags </> "extra-gcc-opts")
return (words f)
\end{code}
return (words f)
\end{code}
@@
-621,11
+620,11
@@
newTempName dflags extn
where
findTempName :: FilePath -> Integer -> IO FilePath
findTempName prefix x
where
findTempName :: FilePath -> Integer -> IO FilePath
findTempName prefix x
- = 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
- return filename
+ = do let filename = (prefix ++ show x) <.> extn
+ b <- doesFileExist filename
+ if b then findTempName prefix (x+1)
+ else do consIORef v_FilesToClean filename -- clean it up later
+ return filename
-- return our temporary directory within tmp_dir, creating one if we
-- don't have one yet
-- return our temporary directory within tmp_dir, creating one if we
-- don't have one yet
@@
-862,7
+861,7
@@
data BuildMessage
| EOF
#endif
| EOF
#endif
-showOpt (FileOption pre f) = pre ++ platformPath f
+showOpt (FileOption pre f) = pre ++ f
showOpt (Option s) = s
traceCmd :: DynFlags -> String -> String -> IO () -> IO ()
showOpt (Option s) = s
traceCmd :: DynFlags -> String -> String -> IO () -> IO ()
@@
-908,7
+907,12
@@
getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
free buf
return (Just (rootDir s))
where
free buf
return (Just (rootDir s))
where
- rootDir s = reverse (dropList "/bin/ghc.exe" (reverse (normalisePath s)))
+ rootDir s = case splitFileName $ normalise s of
+ (d, "ghc.exe") ->
+ case splitFileName $ takeDirectory d of
+ (d', "bin") -> takeDirectory d'
+ _ -> panic ("Expected \"bin\" in " ++ show s)
+ _ -> panic ("Expected \"ghc.exe\" in " ++ show s)
foreign import stdcall unsafe "GetModuleFileNameA"
getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
foreign import stdcall unsafe "GetModuleFileNameA"
getModuleFileName :: Ptr () -> CString -> Int -> IO Int32