Commit 24782b89 authored by John Ericson's avatar John Ericson Committed by Marge Bot

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.
parent 0472f0f6
Pipeline #8140 canceled with stages
......@@ -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
......
......@@ -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(
......
......@@ -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.
......
......@@ -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).
--
......
......@@ -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
]
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.
......@@ -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.*,
......
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
......@@ -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 ++
......
......@@ -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,
......
......@@ -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
# -----------------------------------------------------------------------------
......
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