From 387050d0e26a9e6466b31c9d8e4e4f6273c64c9e Mon Sep 17 00:00:00 2001 From: John Ericson Date: Thu, 30 May 2019 21:08:44 -0400 Subject: Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module ghc-pkg and ghc already both needed this. I figure it is better to deduplicate, especially seeing that changes to one (FreeBSD CPP) didn't make it to the other. Additionally in !1090 I make ghc-pkg look up the settings file, which makes it use the top dir a bit more widely. If that lands, any difference in the way they find the top dir would be more noticable. That change also means sharing more code between ghc and ghc-package (namely the settings file parsing code), so I'd think it better to get off the slipperly slope of duplicating code now. --- utils/ghc-pkg/Main.hs | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) (limited to 'utils') diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 4886d85f74..02ac7d22d9 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -31,6 +31,7 @@ import Version ( version, targetOS, targetARCH ) import qualified GHC.PackageDb as GhcPkg import GHC.PackageDb (BinaryStringRep(..)) import GHC.HandleEncoding +import GHC.BaseDir (getBaseDir) import qualified Distribution.Simple.PackageIndex as PackageIndex import qualified Data.Graph as Graph import qualified Distribution.ModuleName as ModuleName @@ -66,9 +67,6 @@ 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) || defined(mingw32_HOST_OS) -import System.Environment ( getExecutablePath ) -#endif import System.IO import System.IO.Error import GHC.IO.Exception (IOErrorType(InappropriateType)) @@ -601,7 +599,8 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do let err_msg = "missing --global-package-db option, location of global package database unknown\n" global_conf <- case [ f | FlagGlobalConfig f <- my_flags ] of - [] -> do mb_dir <- getLibDir + -- See note [Base Dir] for more information on the base dir / top dir. + [] -> do mb_dir <- getBaseDir case mb_dir of Nothing -> die err_msg Just dir -> do @@ -2177,17 +2176,6 @@ reportError s = do hFlush stdout; hPutStrLn stderr s dieForcible :: String -> IO () dieForcible s = die (s ++ " (use --force to override)") ------------------------------------------ --- Cut and pasted from ghc/compiler/main/SysTools - -getLibDir :: IO (Maybe String) - -#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 -#endif - ----------------------------------------- -- Adapted from ghc/compiler/utils/Panic -- cgit v1.2.1