[commit: ghc] master: trac #9744, make program name and product version configurable through DynFlags/Settings (4523d66)
git at git.haskell.org
git at git.haskell.org
Sat Dec 20 21:09:59 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/4523d669989ab3b08e360016a315d6f9cd4808b0/ghc
>---------------------------------------------------------------
commit 4523d669989ab3b08e360016a315d6f9cd4808b0
Author: Luite Stegeman <stegeman at gmail.com>
Date: Fri Dec 19 18:30:08 2014 -0600
trac #9744, make program name and product version configurable through DynFlags/Settings
Summary:
This allows GHC API clients to use a package database and dynamic
library names that do not clash with those of the host GHC
This also updates the Haddock submodule.
Reviewers: hvr, austin
Reviewed By: austin
Subscribers: thomie, carter
Differential Revision: https://phabricator.haskell.org/D496
>---------------------------------------------------------------
4523d669989ab3b08e360016a315d6f9cd4808b0
compiler/ghci/Linker.hs | 3 +--
compiler/main/DynFlags.hs | 11 ++++++++---
compiler/main/Packages.hs | 13 +++++++------
compiler/main/SysTools.hs | 2 ++
utils/haddock | 2 +-
5 files changed, 19 insertions(+), 12 deletions(-)
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index 8573f6a..3a91fc1 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -50,7 +50,6 @@ import SrcLoc
import qualified Maybes
import UniqSet
import FastString
-import Config
import Platform
import SysTools
@@ -1217,7 +1216,7 @@ locateLib dflags is_hs dirs lib
mk_dyn_obj_path dir = dir </> (lib <.> "dyn_o")
mk_arch_path dir = dir </> ("lib" ++ lib <.> "a")
- hs_dyn_lib_name = lib ++ "-ghc" ++ cProjectVersion
+ hs_dyn_lib_name = lib ++ '-':programName dflags ++ projectVersion dflags
mk_hs_dyn_lib_path dir = dir </> mkHsSOName platform hs_dyn_lib_name
so_name = mkSOName platform lib
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 239eed4..fca8219 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -65,7 +65,7 @@ module DynFlags (
-- ** System tool settings and locations
Settings(..),
- targetPlatform,
+ targetPlatform, programName, projectVersion,
ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,
extraGccViaCFlags, systemPackageConfig,
pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T,
@@ -901,6 +901,8 @@ data Settings = Settings {
sGhciUsagePath :: FilePath, -- ditto
sTopDir :: FilePath,
sTmpDir :: String, -- no trailing '/'
+ sProgramName :: String,
+ sProjectVersion :: String,
-- You shouldn't need to look things up in rawSettings directly.
-- They should have their own fields instead.
sRawSettings :: [(String, String)],
@@ -941,7 +943,10 @@ data Settings = Settings {
targetPlatform :: DynFlags -> Platform
targetPlatform dflags = sTargetPlatform (settings dflags)
-
+programName :: DynFlags -> String
+programName dflags = sProgramName (settings dflags)
+projectVersion :: DynFlags -> String
+projectVersion dflags = sProjectVersion (settings dflags)
ghcUsagePath :: DynFlags -> FilePath
ghcUsagePath dflags = sGhcUsagePath (settings dflags)
ghciUsagePath :: DynFlags -> FilePath
@@ -3914,7 +3919,7 @@ compilerInfo dflags
-- in the settings file (as "lookup" uses the first match for the
-- key)
: rawSettings dflags
- ++ [("Project version", cProjectVersion),
+ ++ [("Project version", projectVersion dflags),
("Project Git commit id", cProjectGitCommitId),
("Booter version", cBooterVersion),
("Stage", cStage),
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index 0a875b2..0ffa680 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -53,7 +53,6 @@ where
import GHC.PackageDb
import PackageConfig
import DynFlags
-import Config ( cProjectVersion )
import Name ( Name, nameModule_maybe )
import UniqFM
import Module
@@ -72,6 +71,7 @@ import System.Directory
import System.FilePath as FilePath
import qualified System.FilePath.Posix as FilePath.Posix
import Control.Monad
+import Data.Char ( toUpper )
import Data.List as List
import Data.Map (Map)
#if __GLASGOW_HASKELL__ < 709
@@ -338,7 +338,7 @@ getPackageConfRefs :: DynFlags -> IO [PkgConfRef]
getPackageConfRefs dflags = do
let system_conf_refs = [UserPkgConf, GlobalPkgConf]
- e_pkg_path <- tryIO (getEnv "GHC_PACKAGE_PATH")
+ e_pkg_path <- tryIO (getEnv $ map toUpper (programName dflags) ++ "_PACKAGE_PATH")
let base_conf_refs = case e_pkg_path of
Left _ -> system_conf_refs
Right path
@@ -354,9 +354,9 @@ getPackageConfRefs dflags = do
resolvePackageConfig :: DynFlags -> PkgConfRef -> IO (Maybe FilePath)
resolvePackageConfig dflags GlobalPkgConf = return $ Just (systemPackageConfig dflags)
-resolvePackageConfig _ UserPkgConf = handleIO (\_ -> return Nothing) $ do
- appdir <- getAppUserDataDirectory "ghc"
- let dir = appdir </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
+resolvePackageConfig dflags UserPkgConf = handleIO (\_ -> return Nothing) $ do
+ appdir <- getAppUserDataDirectory (programName dflags)
+ let dir = appdir </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':projectVersion dflags)
pkgconf = dir </> "package.conf.d"
exist <- doesDirectoryExist pkgconf
return $ if exist then Just pkgconf else Nothing
@@ -1107,7 +1107,8 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
mkDynName x
| gopt Opt_Static dflags = x
- | "HS" `isPrefixOf` x = x ++ "-ghc" ++ cProjectVersion
+ | "HS" `isPrefixOf` x =
+ x ++ '-':programName dflags ++ projectVersion dflags
-- For non-Haskell libraries, we use the name "Cfoo". The .a
-- file is libCfoo.a, and the .so is libfoo.so. That way the
-- linker knows what we mean for the vanilla (-lCfoo) and dyn
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index 375cf2e..7b6c82f 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -325,6 +325,8 @@ initSysTools mbMinusB
sLdSupportsBuildId = ldSupportsBuildId,
sLdSupportsFilelist = ldSupportsFilelist,
sLdIsGnuLd = ldIsGnuLd,
+ sProgramName = "ghc",
+ sProjectVersion = cProjectVersion,
sPgm_L = unlit_path,
sPgm_P = (cpp_prog, cpp_args),
sPgm_F = "",
diff --git a/utils/haddock b/utils/haddock
index 60ccf50..7f23bd5 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit 60ccf50433d823f18ee63e9c25c979e7b81f2fc1
+Subproject commit 7f23bd526a6dd6ed0a2ddeeb30724606ea058ef5
More information about the ghc-commits
mailing list