[Git][ghc/ghc][master] Factor out 'getLibDir' / 'getBaseDir' into a new GHC.BaseDir ghc-boot module
Marge Bot
gitlab at gitlab.haskell.org
Fri Jun 7 14:23:28 UTC 2019
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
387050d0 by John Ericson at 2019-06-07T14:23:23Z
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.
- - - - -
4 changed files:
- compiler/main/SysTools/BaseDir.hs
- + libraries/ghc-boot/GHC/BaseDir.hs
- libraries/ghc-boot/ghc-boot.cabal.in
- utils/ghc-pkg/Main.hs
Changes:
=====================================
compiler/main/SysTools/BaseDir.hs
=====================================
@@ -20,20 +20,17 @@ module SysTools.BaseDir
import GhcPrelude
+-- See note [Base Dir] for why some of this logic is shared with ghc-pkg.
+import GHC.BaseDir
+
import Panic
import System.Environment (lookupEnv)
import System.FilePath
import Data.List
--- POSIX
-#if defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
-import System.Environment (getExecutablePath)
-#endif
-
-- Windows
#if defined(mingw32_HOST_OS)
-import System.Environment (getExecutablePath)
import System.Directory (doesDirectoryExist)
#endif
@@ -125,40 +122,6 @@ findTopDir Nothing
InstallationError "missing -B<dir> option"
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
-
-getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath
-#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
--- on unix, this is a bit more confusing.
--- The layout right now is something like
---
--- /bin/ghc-X.Y.Z <- wrapper script (1)
--- /bin/ghc <- symlink to wrapper script (2)
--- /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3)
--- /lib/ghc-X.Y.Z <- $topdir (4)
---
--- As such, we first need to find the absolute location to the
--- binary.
---
--- getExecutablePath will return (3). One takeDirectory will
--- give use /lib/ghc-X.Y.Z/bin, and another will give us (4).
---
--- This of course only works due to the current layout. If
--- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib}
--- this would need to be changed accordingly.
---
-getBaseDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath
-#else
-getBaseDir = return Nothing
-#endif
-- See Note [tooldir: How GHC finds mingw and perl on Windows]
-- Returns @Nothing@ when not on Windows.
=====================================
libraries/ghc-boot/GHC/BaseDir.hs
=====================================
@@ -0,0 +1,61 @@
+{-# LANGUAGE CPP #-}
+
+-- | Note [Base Dir]
+-- ~~~~~~~~~~~~~~~~~
+--
+-- GHC's base directory or top directory containers miscellaneous settings and
+-- the package database. The main compiler of course needs this directory to
+-- read those settings and read and write packages. ghc-pkg uses it to find the
+-- global package database too.
+--
+-- In the interest of making GHC builds more relocatable, many settings also
+-- will expand `${top_dir}` inside strings so GHC doesn't need to know it's on
+-- installation location at build time. ghc-pkg also can expand those variables
+-- and so needs the top dir location to do that too.
+module GHC.BaseDir where
+
+import Prelude -- See note [Why do we import Prelude here?]
+
+import System.FilePath
+
+-- Windows
+#if defined(mingw32_HOST_OS)
+import System.Environment (getExecutablePath)
+-- POSIX
+#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
+import System.Environment (getExecutablePath)
+#endif
+
+-- | Calculate the location of the base dir
+getBaseDir :: IO (Maybe String)
+#if defined(mingw32_HOST_OS)
+getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath
+ where
+ -- 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
+#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
+-- on unix, this is a bit more confusing.
+-- The layout right now is something like
+--
+-- /bin/ghc-X.Y.Z <- wrapper script (1)
+-- /bin/ghc <- symlink to wrapper script (2)
+-- /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3)
+-- /lib/ghc-X.Y.Z <- $topdir (4)
+--
+-- As such, we first need to find the absolute location to the
+-- binary.
+--
+-- getExecutablePath will return (3). One takeDirectory will
+-- give use /lib/ghc-X.Y.Z/bin, and another will give us (4).
+--
+-- This of course only works due to the current layout. If
+-- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib}
+-- this would need to be changed accordingly.
+--
+getBaseDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath
+#else
+getBaseDir = return Nothing
+#endif
=====================================
libraries/ghc-boot/ghc-boot.cabal.in
=====================================
@@ -37,6 +37,7 @@ Library
default-extensions: NoImplicitPrelude
exposed-modules:
+ GHC.BaseDir
GHC.LanguageExtensions
GHC.PackageDb
GHC.Serialized
=====================================
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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/387050d0e26a9e6466b31c9d8e4e4f6273c64c9e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/387050d0e26a9e6466b31c9d8e4e4f6273c64c9e
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190607/248b2a13/attachment-0001.html>
More information about the ghc-commits
mailing list