summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn Ericson <John.Ericson@Obsidian.Systems>2019-06-20 18:04:30 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-07-09 22:56:18 -0400
commit24782b89907ab36fb5aef3a17584f4c10f1e2690 (patch)
treeb0d55f9b146f33fc901aa10b166a647aeded0c0e
parent0472f0f6a92395d478e9644c0dbd12948518099f (diff)
downloadhaskell-24782b89907ab36fb5aef3a17584f4c10f1e2690.tar.gz
Deduplicate "unique subdir" code between GHC and Cabal
The code, including the generated module with the version, is now in ghc-boot. Config.hs reexports stuff as needed, ghc-pkg doesn't need any tricks at all.
-rw-r--r--.gitignore1
-rwxr-xr-xboot3
-rw-r--r--compiler/ghc.mk26
-rw-r--r--compiler/main/DynFlags.hs12
-rw-r--r--hadrian/src/Rules/Generate.hs67
-rw-r--r--libraries/ghc-boot/GHC/UniqueSubdir.hs32
-rw-r--r--libraries/ghc-boot/ghc-boot.cabal.in6
-rw-r--r--libraries/ghc-boot/ghc.mk36
-rw-r--r--utils/ghc-pkg/Main.hs15
-rw-r--r--utils/ghc-pkg/ghc-pkg.cabal1
-rw-r--r--utils/ghc-pkg/ghc.mk13
11 files changed, 143 insertions, 69 deletions
diff --git a/.gitignore b/.gitignore
index 27709cb449..08485567fb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -142,7 +142,6 @@ _darcs/
/libraries/frames.html
/libraries/ghc-boot/GNUmakefile
/libraries/ghc-boot/ghc-boot.cabal
-/libraries/ghc-boot/ghc.mk
/libraries/ghc-boot-th/GNUmakefile
/libraries/ghc-boot-th/ghc-boot-th.cabal
/libraries/ghc-boot-th/ghc.mk
diff --git a/boot b/boot
index fc5dd29336..04dec14314 100755
--- a/boot
+++ b/boot
@@ -126,6 +126,9 @@ def boot_pkgs():
top = os.path.join(*['..'] * len(os.path.normpath(package).split(os.path.sep)))
ghc_mk = os.path.join(package, 'ghc.mk')
+ if os.path.exists(ghc_mk):
+ print('Skipping %s which already exists' % ghc_mk)
+ continue
print('Creating %s' % ghc_mk)
with open(ghc_mk, 'w') as f:
f.write(dedent(
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 1cd82d1635..4e0fb9095b 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -49,33 +49,33 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
$(call removeFiles,$@)
@echo 'Creating $@ ... '
@echo '{-# LANGUAGE CPP #-}' >> $@
- @echo 'module Config where' >> $@
+ @echo 'module Config' >> $@
+ @echo ' ( module GHC.Version' >> $@
+ @echo ' , cBuildPlatformString' >> $@
+ @echo ' , cHostPlatformString' >> $@
+ @echo ' , cProjectName' >> $@
+ @echo ' , cBooterVersion' >> $@
+ @echo ' , cStage' >> $@
+ @echo ' ) where' >> $@
@echo >> $@
@echo 'import GhcPrelude' >> $@
@echo >> $@
+ @echo 'import GHC.Version' >> $@
+ @echo >> $@
@echo '#include "ghc_boot_platform.h"' >> $@
@echo >> $@
@echo 'cBuildPlatformString :: String' >> $@
@echo 'cBuildPlatformString = BuildPlatform_NAME' >> $@
+ @echo >> $@
@echo 'cHostPlatformString :: String' >> $@
@echo 'cHostPlatformString = HostPlatform_NAME' >> $@
@echo >> $@
@echo 'cProjectName :: String' >> $@
@echo 'cProjectName = "$(ProjectName)"' >> $@
- @echo 'cProjectGitCommitId :: String' >> $@
- @echo 'cProjectGitCommitId = "$(ProjectGitCommitId)"' >> $@
- @echo 'cProjectVersion :: String' >> $@
- @echo 'cProjectVersion = "$(ProjectVersion)"' >> $@
- @echo 'cProjectVersionInt :: String' >> $@
- @echo 'cProjectVersionInt = "$(ProjectVersionInt)"' >> $@
- @echo 'cProjectPatchLevel :: String' >> $@
- @echo 'cProjectPatchLevel = "$(ProjectPatchLevel)"' >> $@
- @echo 'cProjectPatchLevel1 :: String' >> $@
- @echo 'cProjectPatchLevel1 = "$(ProjectPatchLevel1)"' >> $@
- @echo 'cProjectPatchLevel2 :: String' >> $@
- @echo 'cProjectPatchLevel2 = "$(ProjectPatchLevel2)"' >> $@
+ @echo >> $@
@echo 'cBooterVersion :: String' >> $@
@echo 'cBooterVersion = "$(GhcVersion)"' >> $@
+ @echo >> $@
@echo 'cStage :: String' >> $@
@echo 'cStage = show (STAGE :: Int)' >> $@
@echo done.
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 2379f484e9..7009771aa4 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -250,6 +250,7 @@ module DynFlags (
import GhcPrelude
import GHC.Platform
+import GHC.UniqueSubdir (uniqueSubdir)
import PlatformConstants
import Module
import PackageConfig
@@ -1499,17 +1500,8 @@ versionedAppDir dflags = do
appdir <- tryMaybeT $ getAppUserDataDirectory (programName dflags)
return $ appdir </> versionedFilePath dflags
--- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when
--- constructing platform-version-dependent files that need to co-exist.
---
versionedFilePath :: DynFlags -> FilePath
-versionedFilePath dflags = intercalate "-"
- [ stringEncodeArch $ platformArch $ targetPlatform dflags
- , stringEncodeOS $ platformOS $ targetPlatform dflags
- , projectVersion dflags
- ]
- -- NB: This functionality is reimplemented in Cabal, so if you
- -- change it, be sure to update Cabal.
+versionedFilePath dflags = uniqueSubdir $ targetPlatform dflags
-- | The target code type of the compilation (if any).
--
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index edf6783055..1949c3bfe2 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -116,8 +116,8 @@ generatePackageCode context@(Context stage pkg _) = do
when (pkg == ghcPrim) $ do
root <//> dir -/- "GHC/Prim.hs" %> genPrimopCode context
root <//> dir -/- "GHC/PrimopWrappers.hs" %> genPrimopCode context
- when (pkg == ghcPkg) $
- root <//> dir -/- "Version.hs" %> go generateVersionHs
+ when (pkg == ghcBoot) $
+ root <//> dir -/- "GHC/Version.hs" %> go generateVersionHs
when (pkg == compiler) $ do
root -/- primopsTxt stage %> \file -> do
@@ -337,42 +337,36 @@ generateConfigHs :: Expr String
generateConfigHs = do
trackGenerateHs
cProjectName <- getSetting ProjectName
- cProjectGitCommitId <- getSetting ProjectGitCommitId
- cProjectVersion <- getSetting ProjectVersion
- cProjectVersionInt <- getSetting ProjectVersionInt
- cProjectPatchLevel <- getSetting ProjectPatchLevel
- cProjectPatchLevel1 <- getSetting ProjectPatchLevel1
- cProjectPatchLevel2 <- getSetting ProjectPatchLevel2
cBooterVersion <- getSetting GhcVersion
return $ unlines
[ "{-# LANGUAGE CPP #-}"
- , "module Config where"
+ , "module Config"
+ , " ( module GHC.Version"
+ , " , cBuildPlatformString"
+ , " , cHostPlatformString"
+ , " , cProjectName"
+ , " , cBooterVersion"
+ , " , cStage"
+ , " ) where"
, ""
, "import GhcPrelude"
, ""
+ , "import GHC.Version"
+ , ""
, "#include \"ghc_boot_platform.h\""
, ""
, "cBuildPlatformString :: String"
, "cBuildPlatformString = BuildPlatform_NAME"
+ , ""
, "cHostPlatformString :: String"
, "cHostPlatformString = HostPlatform_NAME"
, ""
, "cProjectName :: String"
, "cProjectName = " ++ show cProjectName
- , "cProjectGitCommitId :: String"
- , "cProjectGitCommitId = " ++ show cProjectGitCommitId
- , "cProjectVersion :: String"
- , "cProjectVersion = " ++ show cProjectVersion
- , "cProjectVersionInt :: String"
- , "cProjectVersionInt = " ++ show cProjectVersionInt
- , "cProjectPatchLevel :: String"
- , "cProjectPatchLevel = " ++ show cProjectPatchLevel
- , "cProjectPatchLevel1 :: String"
- , "cProjectPatchLevel1 = " ++ show cProjectPatchLevel1
- , "cProjectPatchLevel2 :: String"
- , "cProjectPatchLevel2 = " ++ show cProjectPatchLevel2
+ , ""
, "cBooterVersion :: String"
, "cBooterVersion = " ++ show cBooterVersion
+ , ""
, "cStage :: String"
, "cStage = show (STAGE :: Int)"
]
@@ -492,9 +486,32 @@ generateGhcVersionH = do
generateVersionHs :: Expr String
generateVersionHs = do
trackGenerateHs
- projectVersion <- getSetting ProjectVersion
+ cProjectGitCommitId <- getSetting ProjectGitCommitId
+ cProjectVersion <- getSetting ProjectVersion
+ cProjectVersionInt <- getSetting ProjectVersionInt
+ cProjectPatchLevel <- getSetting ProjectPatchLevel
+ cProjectPatchLevel1 <- getSetting ProjectPatchLevel1
+ cProjectPatchLevel2 <- getSetting ProjectPatchLevel2
return $ unlines
- [ "module Version where"
- , "version :: String"
- , "version = " ++ show projectVersion
+ [ "module GHC.Version where"
+ , ""
+ , "import Prelude -- See Note [Why do we import Prelude here?]"
+ , ""
+ , "cProjectGitCommitId :: String"
+ , "cProjectGitCommitId = " ++ show cProjectGitCommitId
+ , ""
+ , "cProjectVersion :: String"
+ , "cProjectVersion = " ++ show cProjectVersion
+ , ""
+ , "cProjectVersionInt :: String"
+ , "cProjectVersionInt = " ++ show cProjectVersionInt
+ , ""
+ , "cProjectPatchLevel :: String"
+ , "cProjectPatchLevel = " ++ show cProjectPatchLevel
+ , ""
+ , "cProjectPatchLevel1 :: String"
+ , "cProjectPatchLevel1 = " ++ show cProjectPatchLevel1
+ , ""
+ , "cProjectPatchLevel2 :: String"
+ , "cProjectPatchLevel2 = " ++ show cProjectPatchLevel2
]
diff --git a/libraries/ghc-boot/GHC/UniqueSubdir.hs b/libraries/ghc-boot/GHC/UniqueSubdir.hs
new file mode 100644
index 0000000000..49ae05e526
--- /dev/null
+++ b/libraries/ghc-boot/GHC/UniqueSubdir.hs
@@ -0,0 +1,32 @@
+module GHC.UniqueSubdir
+ ( uniqueSubdir
+ , uniqueSubdir0
+ ) where
+
+import Prelude -- See Note [Why do we import Prelude here?]
+
+import Data.List (intercalate)
+
+import GHC.Platform
+import GHC.Version (cProjectVersion)
+
+-- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when
+-- constructing platform-version-dependent files that need to co-exist.
+--
+uniqueSubdir :: Platform -> FilePath
+uniqueSubdir platform = uniqueSubdir0
+ (stringEncodeArch $ platformArch platform)
+ (stringEncodeOS $ platformOS platform)
+
+-- | 'ghc-pkg' falls back on the host platform if the settings file is missing,
+-- and so needs this since we don't have information about the host platform in
+-- as much detail as 'Platform'.
+uniqueSubdir0 :: String -> String -> FilePath
+uniqueSubdir0 arch os = intercalate "-"
+ [ arch
+ , os
+ , cProjectVersion
+ ]
+ -- NB: This functionality is reimplemented in Cabal, so if you
+ -- change it, be sure to update Cabal.
+ -- TODO make Cabal use this now that it is in ghc-boot.
diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in
index 650f7518dc..aed75b0c8a 100644
--- a/libraries/ghc-boot/ghc-boot.cabal.in
+++ b/libraries/ghc-boot/ghc-boot.cabal.in
@@ -45,6 +45,12 @@ Library
GHC.HandleEncoding
GHC.Platform
GHC.Settings
+ GHC.UniqueSubdir
+ GHC.Version
+
+ -- but done by Hadrian
+ -- autogen-modules:
+ -- GHC.Version
build-depends: base >= 4.7 && < 4.14,
binary == 0.8.*,
diff --git a/libraries/ghc-boot/ghc.mk b/libraries/ghc-boot/ghc.mk
new file mode 100644
index 0000000000..29c5376560
--- /dev/null
+++ b/libraries/ghc-boot/ghc.mk
@@ -0,0 +1,36 @@
+libraries/ghc-boot_PACKAGE = ghc-boot
+libraries/ghc-boot_dist-install_GROUP = libraries
+$(if $(filter ghc-boot,$(PACKAGES_STAGE0)),$(eval $(call build-package,libraries/ghc-boot,dist-boot,0)))
+$(if $(filter ghc-boot,$(PACKAGES_STAGE1)),$(eval $(call build-package,libraries/ghc-boot,dist-install,1)))
+$(if $(filter ghc-boot,$(PACKAGES_STAGE2)),$(eval $(call build-package,libraries/ghc-boot,dist-install,2)))
+
+libraries/ghc-boot/dist-boot/build/GHC/Version.hs \
+libraries/ghc-boot/dist-install/build/GHC/Version.hs: mk/project.mk | $$(dir $$@)/.
+ $(call removeFiles,$@)
+ @echo "module GHC.Version where" >> $@
+ @echo >> $@
+ @echo 'import Prelude -- See Note [Why do we import Prelude here?]' >> $@
+ @echo >> $@
+ @echo 'cProjectGitCommitId :: String' >> $@
+ @echo 'cProjectGitCommitId = "$(ProjectGitCommitId)"' >> $@
+ @echo >> $@
+ @echo 'cProjectVersion :: String' >> $@
+ @echo 'cProjectVersion = "$(ProjectVersion)"' >> $@
+ @echo >> $@
+ @echo 'cProjectVersionInt :: String' >> $@
+ @echo 'cProjectVersionInt = "$(ProjectVersionInt)"' >> $@
+ @echo >> $@
+ @echo 'cProjectPatchLevel :: String' >> $@
+ @echo 'cProjectPatchLevel = "$(ProjectPatchLevel)"' >> $@
+ @echo >> $@
+ @echo 'cProjectPatchLevel1 :: String' >> $@
+ @echo 'cProjectPatchLevel1 = "$(ProjectPatchLevel1)"' >> $@
+ @echo >> $@
+ @echo 'cProjectPatchLevel2 :: String' >> $@
+ @echo 'cProjectPatchLevel2 = "$(ProjectPatchLevel2)"' >> $@
+ @echo done.
+
+libraries/ghc-boot/dist-boot/package-data.mk: \
+ libraries/ghc-boot/dist-boot/build/GHC/Version.hs
+libraries/ghc-boot/dist-install/package-data.mk: \
+ libraries/ghc-boot/dist-install/build/GHC/Version.hs
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 0e28ce9353..bace7356cd 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -30,7 +30,6 @@
module Main (main) where
-import Version ( version )
import qualified GHC.PackageDb as GhcPkg
import GHC.PackageDb (BinaryStringRep(..))
import GHC.HandleEncoding
@@ -40,6 +39,10 @@ import GHC.Platform
( platformArch, platformOS
, stringEncodeArch, stringEncodeOS
)
+import GHC.UniqueSubdir
+ ( uniqueSubdir0
+ )
+import GHC.Version ( cProjectVersion )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import qualified Data.Graph as Graph
import qualified Distribution.ModuleName as ModuleName
@@ -229,7 +232,7 @@ deprecFlags = [
]
ourCopyright :: String
-ourCopyright = "GHC package manager version " ++ Version.version ++ "\n"
+ourCopyright = "GHC package manager version " ++ GHC.Version.cProjectVersion ++ "\n"
shortUsage :: String -> String
shortUsage prog = "For usage information see '" ++ prog ++ " --help'."
@@ -654,7 +657,7 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
case getTargetPlatform settingsFile mySettings of
Right platform -> pure (stringEncodeArch $ platformArch platform, stringEncodeOS $ platformOS platform)
Left e -> die e
- let subdir = arch ++ '-':os ++ '-':Version.version
+ let subdir = uniqueSubdir0 arch os
dir = appdir </> subdir
r <- lookForPackageDBIn dir
case r of
@@ -2016,9 +2019,9 @@ checkHSLib :: Verbosity -> [String] -> String -> Validate ()
checkHSLib _verbosity dirs lib = do
let filenames = ["lib" ++ lib ++ ".a",
"lib" ++ lib ++ "_p.a",
- "lib" ++ lib ++ "-ghc" ++ Version.version ++ ".so",
- "lib" ++ lib ++ "-ghc" ++ Version.version ++ ".dylib",
- lib ++ "-ghc" ++ Version.version ++ ".dll"]
+ "lib" ++ lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".so",
+ "lib" ++ lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dylib",
+ lib ++ "-ghc" ++ GHC.Version.cProjectVersion ++ ".dll"]
b <- liftIO $ doesFileExistOnPath filenames dirs
when (not b) $
verror ForceFiles ("cannot find any of " ++ show filenames ++
diff --git a/utils/ghc-pkg/ghc-pkg.cabal b/utils/ghc-pkg/ghc-pkg.cabal
index 4b1aae7631..13f47c0c3e 100644
--- a/utils/ghc-pkg/ghc-pkg.cabal
+++ b/utils/ghc-pkg/ghc-pkg.cabal
@@ -23,7 +23,6 @@ Flag terminfo
Executable ghc-pkg
Default-Language: Haskell2010
Main-Is: Main.hs
- Other-Modules: Version
Other-Extensions: CPP
Build-Depends: base >= 4 && < 5,
diff --git a/utils/ghc-pkg/ghc.mk b/utils/ghc-pkg/ghc.mk
index 32e18f490d..1ba38329d2 100644
--- a/utils/ghc-pkg/ghc.mk
+++ b/utils/ghc-pkg/ghc.mk
@@ -13,13 +13,6 @@
# -----------------------------------------------------------------------------
# Bootstrapping ghc-pkg
-utils/ghc-pkg/dist/build/Version.hs \
-utils/ghc-pkg/dist-install/build/Version.hs: mk/project.mk | $$(dir $$@)/.
- $(call removeFiles,$@)
- echo "module Version where" >> $@
- echo "version :: String" >> $@
- echo "version = \"$(ProjectVersion)\"" >> $@
-
utils/ghc-pkg_PACKAGE = ghc-pkg
# Note [Why build certain utils twice?]
@@ -72,9 +65,6 @@ $(eval $(call build-prog,utils/ghc-pkg,dist,0))
# is to specify global package db only.
$(ghc-pkg_INPLACE) : | $(INPLACE_PACKAGE_CONF)/. $(INPLACE_LIB)/settings
-utils/ghc-pkg/dist/package-data.mk: \
- utils/ghc-pkg/dist/build/Version.hs
-
# -----------------------------------------------------------------------------
# Build another copy of ghc-pkg with the stage1 compiler in the dist-install
# directory. Don't install it inplace (we use the dist copy there), but do
@@ -92,9 +82,6 @@ utils/ghc-pkg_dist-install_INSTALL = YES
utils/ghc-pkg_dist-install_INSTALL_SHELL_WRAPPER_NAME = ghc-pkg-$(ProjectVersion)
$(eval $(call build-prog,utils/ghc-pkg,dist-install,1))
-
-utils/ghc-pkg/dist-install/package-data.mk: \
- utils/ghc-pkg/dist-install/build/Version.hs
endif
# -----------------------------------------------------------------------------