X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FSysTools.lhs;h=d393d9799f1e0ae2ee1343cc310f78b66d6064e1;hb=70aef6f55f3da6b7a181ed9e7aeee17f2c2a218a;hp=2c293346bc1b515348b05bd0e66307d4f8730b64;hpb=3b8aa6ae473ed794ba1dd63af1ffbc78636ef21e;p=ghc-hetmet.git diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs index 2c29334..d393d97 100644 --- a/ghc/compiler/main/SysTools.lhs +++ b/ghc/compiler/main/SysTools.lhs @@ -50,13 +50,12 @@ import Util ( global ) import CmdLineOpts ( dynFlag, verbosity ) import Exception ( throwDyn, catchAllIO ) -import IO ( hPutStr, hPutChar, hPutStrLn, hFlush, stderr ) +import IO import Directory ( doesFileExist, removeFile ) import IOExts ( IORef, readIORef, writeIORef ) import Monad ( when, unless ) import System ( system, ExitCode(..), exitWith ) import CString -import Addr import Int #if __GLASGOW_HASKELL__ < 500 @@ -70,10 +69,12 @@ import MarshalArray #if !defined(mingw32_TARGET_OS) import qualified Posix #else -import Addr ( nullAddr ) +import Addr import List ( isPrefixOf ) #endif +import List ( isSuffixOf ) + #include "HsVersions.h" {-# DEPRECATED runSomething "runSomething should be private to SysTools" #-} @@ -203,7 +204,7 @@ initSysTools minusB_args ; config_exists <- doesFileExist pkgconfig_path ; when (not config_exists) $ throwDyn (InstallationError - ("Can't find package.conf in " ++ pkgconfig_path)) + ("Can't find package.conf as " ++ pkgconfig_path)) #if defined(mingw32_TARGET_OS) -- WINDOWS-SPECIFIC STUFF @@ -247,7 +248,7 @@ initSysTools minusB_args #endif - -- For all systems, copy and remove are provided by the host + -- For all systems, copy and remove are provided by the host -- system; architecture-specific stuff is done when building Config.hs ; let cp_path = cGHC_CP @@ -307,7 +308,7 @@ setPgm pgm = unknownFlagErr ("-pgm" ++ pgm) -- 1. Set proto_top_dir -- a) look for (the last) -B flag, and use it -- b) if there are no -B flags, get the directory --- where GHC is running +-- where GHC is running (only on Windows) -- -- 2. If package.conf exists in proto_top_dir, we are running -- installed; and TopDir = proto_top_dir @@ -323,39 +324,39 @@ getTopDir :: [String] String) -- TopDir (in Unix format '/' separated) getTopDir minusbs - = do { top_dir1 <- get_proto - ; let top_dir2 = unDosifyPath top_dir1 -- Convert to standard internal form - - -- Discover whether we're running in a build tree or in an installation, + = 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_dir2 `slash` "package.conf") + ; am_installed <- doesFileExist (top_dir `slash` "package.conf") - ; if am_installed then - return (True, top_dir2) - else - return (False, remove_suffix top_dir2) + ; return (am_installed, top_dir) } where - get_proto | not (null minusbs) - = return (drop 2 (last minusbs)) -- 2 for "-B" + -- get_proto returns a Unix-format path + get_proto | not (null minusbs) + = return (unDosifyPath (drop 2 (last minusbs))) -- 2 for "-B" | otherwise = do { maybe_exec_dir <- getExecDir -- Get directory of executable ; case maybe_exec_dir of -- (only works on Windows; -- returns Nothing on Unix) Nothing -> throwDyn (InstallationError "missing -B