diff options
| -rw-r--r-- | compiler/iface/MkIface.hs | 3 | ||||
| -rw-r--r-- | compiler/main/Plugins.hs | 3 | ||||
| -rw-r--r-- | compiler/main/SysTools/BaseDir.hs | 97 | ||||
| -rw-r--r-- | compiler/utils/GhcPrelude.hs | 6 | ||||
| -rw-r--r-- | configure.ac | 9 | ||||
| -rw-r--r-- | libraries/ghc-boot/GHC/PackageDb.hs | 2 | ||||
| -rw-r--r-- | utils/genapply/Main.hs | 2 | ||||
| -rw-r--r-- | utils/ghc-pkg/Main.hs | 67 |
8 files changed, 4 insertions, 185 deletions
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 4d2fa83f86..e3d1b824be 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -1112,9 +1112,6 @@ instance Semigroup RecompileRequired where instance Monoid RecompileRequired where mempty = UpToDate -#if __GLASGOW_HASKELL__ < 804 - mappend = (Data.Semigroup.<>) -#endif recompileRequired :: RecompileRequired -> Bool recompileRequired UpToDate = False diff --git a/compiler/main/Plugins.hs b/compiler/main/Plugins.hs index e83ec08805..01a9841119 100644 --- a/compiler/main/Plugins.hs +++ b/compiler/main/Plugins.hs @@ -123,9 +123,6 @@ instance Semigroup PluginRecompile where instance Monoid PluginRecompile where mempty = NoForceRecompile -#if __GLASGOW_HASKELL__ < 804 - mappend = (Data.Semigroup.<>) -#endif type CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] type TcPlugin = [CommandLineOption] -> Maybe TcRnTypes.TcPlugin diff --git a/compiler/main/SysTools/BaseDir.hs b/compiler/main/SysTools/BaseDir.hs index f858c8ffad..16f5a44655 100644 --- a/compiler/main/SysTools/BaseDir.hs +++ b/compiler/main/SysTools/BaseDir.hs @@ -33,27 +33,8 @@ 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 -import System.Directory -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) @@ -154,85 +135,7 @@ getBaseDir :: IO (Maybe String) 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. - where - try_size size = allocaArray (fromIntegral size) $ \buf -> do - ret <- c_GetModuleFileName nullPtr buf size - case ret of - 0 -> return Nothing - _ | ret < size -> do - path <- peekCWString buf - real <- getFinalPath path -- try to resolve symlinks paths - let libdir = (buildLibDir . sanitize . maybe path id) real - exists <- doesDirectoryExist libdir - if exists - then return $ Just libdir - else fail path - | otherwise -> try_size (size * 2) - - -- getFinalPath returns paths in full raw form. - -- Unfortunately GHC isn't set up to handle these - -- So if the call succeeded, we need to drop the - -- \\?\ prefix. - sanitize s = if "\\\\?\\" `isPrefixOf` s - then drop 4 s - else s - - buildLibDir :: FilePath -> FilePath - buildLibDir s = - (takeDirectory . takeDirectory . normalise $ s) </> "lib" - - fail s = panic ("can't decompose ghc.exe path: " ++ show s) - -foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW" - c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 - --- Attempt to resolve symlinks in order to find the actual location GHC --- is located at. See Trac #11759. -getFinalPath :: FilePath -> IO (Maybe FilePath) -getFinalPath name = do - dllHwnd <- failIfNull "LoadLibrary" $ loadLibrary "kernel32.dll" - -- Note: The API GetFinalPathNameByHandleW is only available starting from Windows Vista. - -- This means that we can't bind directly to it since it may be missing. - -- Instead try to find it's address at runtime and if we don't succeed consider the - -- function failed. - addr_m <- (fmap Just $ failIfNull "getProcAddress" $ getProcAddress dllHwnd "GetFinalPathNameByHandleW") - `catch` (\(_ :: SomeException) -> return Nothing) - case addr_m of - Nothing -> return Nothing - Just addr -> do handle <- failIf (==iNVALID_HANDLE_VALUE) "CreateFile" - $ createFile name - gENERIC_READ - fILE_SHARE_READ - Nothing - oPEN_EXISTING - (fILE_ATTRIBUTE_NORMAL .|. fILE_FLAG_BACKUP_SEMANTICS) - Nothing - let fnPtr = makeGetFinalPathNameByHandle $ castPtrToFunPtr addr - -- First try to resolve the path to get the actual path - -- of any symlinks or other file system redirections that - -- may be in place. However this function can fail, and in - -- the event it does fail, we need to try using the - -- original path and see if we can decompose that. - -- If the call fails Win32.try will raise an exception - -- that needs to be caught. See #14159 - path <- (Win32.try "GetFinalPathName" - (\buf len -> fnPtr handle buf len 0) 512 - `finally` closeHandle handle) - `catch` - (\(_ :: IOException) -> return name) - return $ Just path - -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 diff --git a/compiler/utils/GhcPrelude.hs b/compiler/utils/GhcPrelude.hs index 66d01be5f8..3437e65bf4 100644 --- a/compiler/utils/GhcPrelude.hs +++ b/compiler/utils/GhcPrelude.hs @@ -12,13 +12,7 @@ module GhcPrelude (module X) where -- clashing with the (Outputable.<>) operator which is heavily used -- through GHC's code-base. -#if MIN_VERSION_base(4,11,0) import Prelude as X hiding ((<>)) -#else -import Prelude as X -import Data.Semigroup as X (Semigroup) -#endif - import Data.Foldable as X (foldl') {- diff --git a/configure.ac b/configure.ac index f7943752cb..0b65770b93 100644 --- a/configure.ac +++ b/configure.ac @@ -132,11 +132,6 @@ AC_ARG_VAR(CC_STAGE0, [C compiler command (bootstrap)]) if test "$WithGhc" != ""; then FPTOOLS_GHC_VERSION([GhcVersion], [GhcMajVersion], [GhcMinVersion], [GhcPatchLevel])dnl - # See #15281 - if test "$GhcMajVersion" = "8" && test "$GhcMinVersion" = "2" && test "$GhcPatchLevel" = "1"; then - AC_MSG_ERROR([GHC 8.2.1 is known to be buggy and cannot bootstrap this GHC release (See Trac 15281); please use GHC 8.2.2 or later.]) - fi - if test "$GhcMajVersion" = "unknown" || test "$GhcMinVersion" = "unknown"; then AC_MSG_ERROR([Cannot determine the version of $WithGhc. Is it really GHC?]) fi @@ -164,8 +159,8 @@ if test "$WithGhc" = "" then AC_MSG_ERROR([GHC is required.]) fi -FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.2], - [AC_MSG_ERROR([GHC version 8.2 or later is required to compile GHC.])]) +FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.4], + [AC_MSG_ERROR([GHC version 8.4 or later is required to compile GHC.])]) if test `expr $GhcMinVersion % 2` = "1" then diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/PackageDb.hs index 5de3a5fc74..c7984d0edb 100644 --- a/libraries/ghc-boot/GHC/PackageDb.hs +++ b/libraries/ghc-boot/GHC/PackageDb.hs @@ -260,9 +260,7 @@ lockPackageDbWith mode file = do lockPackageDb = lockPackageDbWith ExclusiveLock unlockPackageDb (PackageDbLock hnd) = do -#if MIN_VERSION_base(4,11,0) hUnlock hnd -#endif hClose hnd -- | Mode to open a package db in. diff --git a/utils/genapply/Main.hs b/utils/genapply/Main.hs index b30c9f8c46..71b84fde79 100644 --- a/utils/genapply/Main.hs +++ b/utils/genapply/Main.hs @@ -19,9 +19,7 @@ module Main(main) where -- Needed for TAG_BITS #include "../../includes/MachDeps.h" -#if MIN_VERSION_base(4,11,0) import Prelude hiding ((<>)) -#endif import Text.PrettyPrint import Data.Word diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 3aa4186db4..9cbeb3ac61 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -17,24 +17,6 @@ #endif #endif --- The SIMPLE_WIN_GETLIBDIR macro will only be set when --- building on windows. --- --- Its purpose is to let us know whether the Windows implementation of --- 'getExecutablePath' follows symlinks or not (it does follow them in --- base >= 4.11). If it does, the implementation of getLibDir is straightforward --- but if it does not follow symlinks, we need to follow them ourselves here. --- Once we do not have to support building ghc-pkg with base < 4.11 anymore, --- we can keep only the simple, straightforward implementation that just uses --- 'getExecutablePath'. -#if defined(mingw32_HOST_OS) -#if MIN_VERSION_base(4,11,0) -#define SIMPLE_WIN_GETLIBDIR 1 -#else -#define SIMPLE_WIN_GETLIBDIR 0 -#endif -#endif - ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 2004-2009. @@ -84,7 +66,7 @@ import System.Directory ( doesDirectoryExist, getDirectoryContents, getCurrentDirectory ) import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getArgs, getProgName, getEnv ) -#if defined(darwin_HOST_OS) || defined(linux_HOST_OS) || SIMPLE_WIN_GETLIBDIR +#if defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(mingw32_HOST_OS) import System.Environment ( getExecutablePath ) #endif import System.IO @@ -98,12 +80,6 @@ import qualified Data.Set as Set import qualified Data.Map as Map #if defined(mingw32_HOST_OS) -#if !SIMPLE_WIN_GETLIBDIR --- mingw32 needs these for getExecDir when base < 4.11 -import Foreign -import Foreign.C -import System.Directory ( canonicalizePath ) -#endif import GHC.ConsoleHandler #else import System.Posix hiding (fdToHandle) @@ -2215,46 +2191,7 @@ dieForcible s = die (s ++ " (use --force to override)") getLibDir :: IO (Maybe String) -#if defined(mingw32_HOST_OS) && !SIMPLE_WIN_GETLIBDIR -subst :: Char -> Char -> String -> String -subst a b ls = map (\ x -> if x == a then b else x) ls - -unDosifyPath :: FilePath -> FilePath -unDosifyPath xs = subst '\\' '/' xs - -getLibDir = do base <- getExecDir "/ghc-pkg.exe" - case base of - Nothing -> return Nothing - Just base' -> do - libdir <- canonicalizePath $ base' </> "../lib" - exists <- doesDirectoryExist libdir - if exists - then return $ Just libdir - else return Nothing - --- (getExecDir cmd) returns the directory in which the current --- executable, which should be called 'cmd', is running --- So if the full path is /a/b/c/d/e, and you pass "d/e" as cmd, --- you'll get "/a/b/c" back as the result -getExecDir :: String -> IO (Maybe String) -getExecDir cmd = - getExecPath >>= maybe (return Nothing) removeCmdSuffix - where initN n = reverse . drop n . reverse - removeCmdSuffix = return . Just . initN (length cmd) . unDosifyPath - -getExecPath :: IO (Maybe String) -getExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. - where - try_size size = allocaArray (fromIntegral size) $ \buf -> do - ret <- c_GetModuleFileName nullPtr buf size - case ret of - 0 -> return Nothing - _ | ret < size -> fmap Just $ peekCWString buf - | otherwise -> try_size (size * 2) - -foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW" - c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 -#elif SIMPLE_WIN_GETLIBDIR || defined(darwin_HOST_OS) || defined(linux_HOST_OS) +#if defined(mingw32_HOST_OS) || defined(darwin_HOST_OS) || defined(linux_HOST_OS) getLibDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath #else getLibDir = return Nothing |