Commit a838ae37 authored by Ryan Scott's avatar Ryan Scott
Browse files

Drop GHC 8.2 compatibility

Summary:
GHC 8.6.1 is out, so now GHC's support window only extends
back to GHC 8.4. This means we can delete gobs of code that were
only used for GHC 8.2 support. Hooray!

Test Plan: ./validate

Reviewers: bgamari, Phyx, erikd

Reviewed By: bgamari, Phyx

Subscribers: rwbarton, erikd, carter

Differential Revision: https://phabricator.haskell.org/D5192
parent 21efbc75
...@@ -1112,9 +1112,6 @@ instance Semigroup RecompileRequired where ...@@ -1112,9 +1112,6 @@ instance Semigroup RecompileRequired where
instance Monoid RecompileRequired where instance Monoid RecompileRequired where
mempty = UpToDate mempty = UpToDate
#if __GLASGOW_HASKELL__ < 804
mappend = (Data.Semigroup.<>)
#endif
recompileRequired :: RecompileRequired -> Bool recompileRequired :: RecompileRequired -> Bool
recompileRequired UpToDate = False recompileRequired UpToDate = False
......
...@@ -123,9 +123,6 @@ instance Semigroup PluginRecompile where ...@@ -123,9 +123,6 @@ instance Semigroup PluginRecompile where
instance Monoid PluginRecompile where instance Monoid PluginRecompile where
mempty = NoForceRecompile mempty = NoForceRecompile
#if __GLASGOW_HASKELL__ < 804
mappend = (Data.Semigroup.<>)
#endif
type CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] type CorePlugin = [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
type TcPlugin = [CommandLineOption] -> Maybe TcRnTypes.TcPlugin type TcPlugin = [CommandLineOption] -> Maybe TcRnTypes.TcPlugin
......
...@@ -33,27 +33,8 @@ import System.Environment (getExecutablePath) ...@@ -33,27 +33,8 @@ import System.Environment (getExecutablePath)
-- Windows -- Windows
#if defined(mingw32_HOST_OS) #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.Environment (getExecutablePath)
import System.Directory (doesDirectoryExist) 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 #endif
#if defined(mingw32_HOST_OS) #if defined(mingw32_HOST_OS)
...@@ -154,85 +135,7 @@ getBaseDir :: IO (Maybe String) ...@@ -154,85 +135,7 @@ getBaseDir :: IO (Maybe String)
rootDir :: FilePath -> FilePath rootDir :: FilePath -> FilePath
rootDir = takeDirectory . takeDirectory . normalise rootDir = takeDirectory . takeDirectory . normalise
#if MIN_VERSION_base(4,11,0)
getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath 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) #elif defined(darwin_HOST_OS) || defined(linux_HOST_OS)
-- on unix, this is a bit more confusing. -- on unix, this is a bit more confusing.
-- The layout right now is something like -- The layout right now is something like
......
...@@ -12,13 +12,7 @@ module GhcPrelude (module X) where ...@@ -12,13 +12,7 @@ module GhcPrelude (module X) where
-- clashing with the (Outputable.<>) operator which is heavily used -- clashing with the (Outputable.<>) operator which is heavily used
-- through GHC's code-base. -- through GHC's code-base.
#if MIN_VERSION_base(4,11,0)
import Prelude as X hiding ((<>)) import Prelude as X hiding ((<>))
#else
import Prelude as X
import Data.Semigroup as X (Semigroup)
#endif
import Data.Foldable as X (foldl') import Data.Foldable as X (foldl')
{- {-
......
...@@ -132,11 +132,6 @@ AC_ARG_VAR(CC_STAGE0, [C compiler command (bootstrap)]) ...@@ -132,11 +132,6 @@ AC_ARG_VAR(CC_STAGE0, [C compiler command (bootstrap)])
if test "$WithGhc" != ""; then if test "$WithGhc" != ""; then
FPTOOLS_GHC_VERSION([GhcVersion], [GhcMajVersion], [GhcMinVersion], [GhcPatchLevel])dnl 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 if test "$GhcMajVersion" = "unknown" || test "$GhcMinVersion" = "unknown"; then
AC_MSG_ERROR([Cannot determine the version of $WithGhc. Is it really GHC?]) AC_MSG_ERROR([Cannot determine the version of $WithGhc. Is it really GHC?])
fi fi
...@@ -164,8 +159,8 @@ if test "$WithGhc" = "" ...@@ -164,8 +159,8 @@ if test "$WithGhc" = ""
then then
AC_MSG_ERROR([GHC is required.]) AC_MSG_ERROR([GHC is required.])
fi fi
FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.2], FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.4],
[AC_MSG_ERROR([GHC version 8.2 or later is required to compile GHC.])]) [AC_MSG_ERROR([GHC version 8.4 or later is required to compile GHC.])])
if test `expr $GhcMinVersion % 2` = "1" if test `expr $GhcMinVersion % 2` = "1"
then then
......
...@@ -260,9 +260,7 @@ lockPackageDbWith mode file = do ...@@ -260,9 +260,7 @@ lockPackageDbWith mode file = do
lockPackageDb = lockPackageDbWith ExclusiveLock lockPackageDb = lockPackageDbWith ExclusiveLock
unlockPackageDb (PackageDbLock hnd) = do unlockPackageDb (PackageDbLock hnd) = do
#if MIN_VERSION_base(4,11,0)
hUnlock hnd hUnlock hnd
#endif
hClose hnd hClose hnd
-- | Mode to open a package db in. -- | Mode to open a package db in.
......
...@@ -19,9 +19,7 @@ module Main(main) where ...@@ -19,9 +19,7 @@ module Main(main) where
-- Needed for TAG_BITS -- Needed for TAG_BITS
#include "../../includes/MachDeps.h" #include "../../includes/MachDeps.h"
#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>)) import Prelude hiding ((<>))
#endif
import Text.PrettyPrint import Text.PrettyPrint
import Data.Word import Data.Word
......
...@@ -17,24 +17,6 @@ ...@@ -17,24 +17,6 @@
#endif #endif
#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. -- (c) The University of Glasgow 2004-2009.
...@@ -84,7 +66,7 @@ import System.Directory ( doesDirectoryExist, getDirectoryContents, ...@@ -84,7 +66,7 @@ import System.Directory ( doesDirectoryExist, getDirectoryContents,
getCurrentDirectory ) getCurrentDirectory )
import System.Exit ( exitWith, ExitCode(..) ) import System.Exit ( exitWith, ExitCode(..) )
import System.Environment ( getArgs, getProgName, getEnv ) 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 ) import System.Environment ( getExecutablePath )
#endif #endif
import System.IO import System.IO
...@@ -98,12 +80,6 @@ import qualified Data.Set as Set ...@@ -98,12 +80,6 @@ import qualified Data.Set as Set
import qualified Data.Map as Map import qualified Data.Map as Map
#if defined(mingw32_HOST_OS) #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 import GHC.ConsoleHandler
#else #else
import System.Posix hiding (fdToHandle) import System.Posix hiding (fdToHandle)
...@@ -2215,46 +2191,7 @@ dieForcible s = die (s ++ " (use --force to override)") ...@@ -2215,46 +2191,7 @@ dieForcible s = die (s ++ " (use --force to override)")
getLibDir :: IO (Maybe String) getLibDir :: IO (Maybe String)
#if defined(mingw32_HOST_OS) && !SIMPLE_WIN_GETLIBDIR #if defined(mingw32_HOST_OS) || defined(darwin_HOST_OS) || defined(linux_HOST_OS)
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)
getLibDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath getLibDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath
#else #else
getLibDir = return Nothing getLibDir = return Nothing
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment