Commit 4523d669 authored by Luite Stegeman's avatar Luite Stegeman Committed by Austin Seipp

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
parent e7eef005
......@@ -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
......
......@@ -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),
......
......@@ -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
......
......@@ -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 = "",
......
Subproject commit 60ccf50433d823f18ee63e9c25c979e7b81f2fc1
Subproject commit 7f23bd526a6dd6ed0a2ddeeb30724606ea058ef5
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