trac #9744, make program name and product version configurable through DynFlags/Settings
authorLuite Stegeman <stegeman@gmail.com>
Sat, 20 Dec 2014 00:30:08 +0000 (18:30 -0600)
committerAustin Seipp <austin@well-typed.com>
Sat, 20 Dec 2014 21:10:39 +0000 (15:10 -0600)
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

compiler/ghci/Linker.hs
compiler/main/DynFlags.hs
compiler/main/Packages.hs
compiler/main/SysTools.hs
utils/haddock

index 8573f6a..3a91fc1 100644 (file)
@@ -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
index 239eed4..fca8219 100644 (file)
@@ -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),
index 0a875b2..0ffa680 100644 (file)
@@ -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
index 375cf2e..7b6c82f 100644 (file)
@@ -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   = "",
index 60ccf50..7f23bd5 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 60ccf50433d823f18ee63e9c25c979e7b81f2fc1
+Subproject commit 7f23bd526a6dd6ed0a2ddeeb30724606ea058ef5