diff options
Diffstat (limited to 'compiler/main/SysTools/BaseDir.hs')
| -rw-r--r-- | compiler/main/SysTools/BaseDir.hs | 26 |
1 files changed, 25 insertions, 1 deletions
diff --git a/compiler/main/SysTools/BaseDir.hs b/compiler/main/SysTools/BaseDir.hs index 625baec8d9..f858c8ffad 100644 --- a/compiler/main/SysTools/BaseDir.hs +++ b/compiler/main/SysTools/BaseDir.hs @@ -33,7 +33,18 @@ import System.Environment (getExecutablePath) -- Windows #if defined(mingw32_HOST_OS) +# if MIN_VERSION_Win32(2,5,0) +# if !MIN_VERSION_base(4,11,0) import qualified System.Win32.Types as Win32 +# endif +# else +import qualified System.Win32.Info as Win32 +# endif +# if MIN_VERSION_base(4,11,0) +import System.Environment (getExecutablePath) +import System.Directory (doesDirectoryExist) +# else +import Data.Char import Exception import Foreign import Foreign.C.String @@ -42,6 +53,7 @@ import System.Win32.Types (DWORD, LPTSTR, HANDLE) import System.Win32.Types (failIfNull, failIf, iNVALID_HANDLE_VALUE) import System.Win32.File (createFile,closeHandle, gENERIC_READ, fILE_SHARE_READ, oPEN_EXISTING, fILE_ATTRIBUTE_NORMAL, fILE_FLAG_BACKUP_SEMANTICS ) import System.Win32.DLL (loadLibrary, getProcAddress) +# endif #endif #if defined(mingw32_HOST_OS) @@ -133,7 +145,18 @@ findTopDir Nothing Just dir -> return dir getBaseDir :: IO (Maybe String) + #if defined(mingw32_HOST_OS) + +-- locate the "base dir" when given the path +-- to the real ghc executable (as opposed to symlink) +-- that is running this function. +rootDir :: FilePath -> FilePath +rootDir = takeDirectory . takeDirectory . normalise + +#if MIN_VERSION_base(4,11,0) +getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath +#else -- Assuming we are running ghc, accessed by path $(stuff)/<foo>/ghc.exe, -- return the path $(stuff)/lib. getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. @@ -209,6 +232,7 @@ type GetFinalPath = HANDLE -> LPTSTR -> DWORD -> DWORD -> IO DWORD foreign import WINDOWS_CCONV unsafe "dynamic" makeGetFinalPathNameByHandle :: FunPtr GetFinalPath -> GetFinalPath +#endif #elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) -- on unix, this is a bit more confusing. -- The layout right now is something like @@ -242,7 +266,7 @@ findToolDir -> IO (Maybe FilePath) #if defined(mingw32_HOST_OS) findToolDir top_dir = go 0 (top_dir </> "..") - where maxDepth = 2 + where maxDepth = 3 go :: Int -> FilePath -> IO (Maybe FilePath) go k path | k == maxDepth = throwGhcExceptionIO $ |