[Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] wip finalize
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon Mar 27 09:54:49 UTC 2023
Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC
Commits:
b62fbecf by romes at 2023-03-27T10:54:40+01:00
wip finalize
- - - - -
5 changed files:
- hadrian/src/Context.hs
- hadrian/src/Hadrian/BuildPath.hs
- hadrian/src/Hadrian/Haskell/Cabal.hs
- hadrian/src/Hadrian/Haskell/Hash.hs
- hadrian/src/Rules/Register.hs
Changes:
=====================================
hadrian/src/Context.hs
=====================================
@@ -97,7 +97,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config")
pkgHaddockFile :: Context -> Action FilePath
pkgHaddockFile context at Context {..} = do
root <- buildRoot
- version <- pkgUnitId context package
+ version <- pkgSimpleIdentifier package
return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock"
-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.:
=====================================
hadrian/src/Hadrian/BuildPath.hs
=====================================
@@ -110,22 +110,25 @@ parseWayUnit = Parsec.choice
, Parsec.char 'l' *> pure Logging
] Parsec.<?> "way unit (thr, debug, dyn, p, l)"
--- | Parse a @"pkgname-pkgversion"@ string into the package name and the
+-- | Parse a @"pkgname-pkgversion-pkghash"@ string into the package name and the
-- integers that make up the package version.
+--
+-- If no hash was assigned, an empty string is returned in its place.
parsePkgId :: Parsec.Parsec String () (String, [Integer], String)
-parsePkgId = parseRTS <|> (parsePkgId' "" Parsec.<?> "package identifier (<name>-<version>-<hash>)")
+parsePkgId = parsePkgId' "" Parsec.<?> "package identifier (<name>-<version>(-<hash>?))"
where
parsePkgId' currName = do
s <- Parsec.many1 Parsec.alphaNum
_ <- Parsec.char '-'
let newName = if null currName then s else currName ++ "-" ++ s
- Parsec.choice [ (,,) newName <$> parsePkgVersion <*> (Parsec.char '-' *> parsePkgHash)
- , parsePkgId' newName ]
-
- parseRTS = do
- _ <- Parsec.string "rts" <* Parsec.char '-'
- v <- parsePkgVersion
- pure ("rts", v, "")
+ Parsec.choice
+ [ (,,) newName <$> parsePkgVersion
+ <*> Parsec.option "" (Parsec.try $ do
+ _ <- Parsec.char '-'
+ -- Ensure we're not parsing a libDynName as a hash
+ _ <- Parsec.notFollowedBy (Parsec.string "ghc" *> parsePkgVersion)
+ parsePkgHash)
+ , parsePkgId' newName ]
parsePkgHash :: Parsec.Parsec String () String
parsePkgHash = Parsec.many1 Parsec.alphaNum
=====================================
hadrian/src/Hadrian/Haskell/Cabal.hs
=====================================
@@ -10,7 +10,7 @@
-- Cabal files.
-----------------------------------------------------------------------------
module Hadrian.Haskell.Cabal (
- pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription,
+ pkgVersion, pkgUnitId, pkgSynopsis, pkgDescription, pkgSimpleIdentifier,
pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString
) where
@@ -27,6 +27,17 @@ import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId)
pkgVersion :: Package -> Action String
pkgVersion = fmap version . readPackageData
+-- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at .
+-- The Cabal file is tracked.
+--
+-- For an identifier complete with the hash use 'pkgUnitId'
+pkgSimpleIdentifier :: Package -> Action String
+pkgSimpleIdentifier package = do
+ cabal <- readPackageData package
+ return $ if null (version cabal)
+ then name cabal
+ else name cabal ++ "-" ++ version cabal
+
-- | Read a Cabal file and return the package synopsis. The Cabal file is tracked.
pkgSynopsis :: Package -> Action String
pkgSynopsis = fmap synopsis . readPackageData
=====================================
hadrian/src/Hadrian/Haskell/Hash.hs
=====================================
@@ -6,7 +6,7 @@ module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where
import Development.Shake
-import Hadrian.Haskell.Cabal.Type as C
+import Hadrian.Haskell.Cabal.Type
import Hadrian.Haskell.Cabal
import Hadrian.Oracles.Cabal
import Hadrian.Package
@@ -41,32 +41,19 @@ pkgUnitId ctx' pkg = do
pid <- pkgSimpleIdentifier (package ctx)
phash <- pkgHash ctx
if pkgName pkg == "rts"
- -- The Unit-id will change depending on the way... rTS BReaks. At some
- -- point it's not even clear which way we're building
+ -- The unit-id will change depending on the way, we need to treat the rts separately
then pure pid
else do
-- Other boot packages still hardcode their unit-id to just <name>, but we
-- can have hadrian generate a different unit-id for them just as cabal does
-- because the boot packages unit-ids are overriden by setting -this-unit-id
-- in the cabal file
- -- liftIO $ print $ pid <> "-" <> truncateHash 4 phash
pure $ pid <> "-" <> truncateHash 4 phash
where
truncateHash :: Int -> String -> String
truncateHash = take
--- | Read a Cabal file and return the package identifier without a hash, e.g. @base-4.10.0.0 at .
--- The Cabal file is tracked.
---
--- For an identifier complete with the hash use 'pkgUnitId'
-pkgSimpleIdentifier :: Package -> Action String
-pkgSimpleIdentifier package = do
- cabal <- readPackageData package
- return $ if null (version cabal)
- then C.name cabal
- else C.name cabal ++ "-" ++ version cabal
-
data PackageHashInputs = PackageHashInputs {
pkgHashPkgId :: String, -- ^ name-version
pkgHashComponent :: PackageType,
@@ -119,17 +106,14 @@ type instance RuleResult PkgHashKey = String
pkgHash :: Context -> Action String
pkgHash = askOracle . PkgHashKey
--- TODO: Needs to be oracle to be cached? Called lots of times
+-- Needs to be an oracle to be cached. Called lots of times.
pkgHashOracle :: Rules ()
pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do
- -- RECURSIVE ORACLE: ctx_data <- readContextData ctx
pkg_data <- readPackageData (package ctx)
name <- pkgSimpleIdentifier (package ctx)
let stag = stage ctx
- liftIO $ print ("Package and Package Dependencies", package ctx, packageDependencies pkg_data)
stagePkgs <- stagePackages stag
depsHashes <- mapM (\pkg -> pkgHash (ctx { package = pkg })) [pkg | pkg <- packageDependencies pkg_data, pkg `elem` stagePkgs]
- liftIO $ print ("Pkg Deps Hashes", depsHashes)
flav <- flavour
let flavourArgs = args flav
@@ -144,8 +128,7 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do
pkgHashVanillaLib = vanilla `Set.member` libWays
pkgHashSharedLib = dynamic `Set.member` libWays
pkgHashDynExe = dyn_ghc
- -- TODO: fullyStatic flavour transformer
- pkgHashFullyStaticExe = False
+ pkgHashFullyStaticExe = False -- TODO: fullyStatic flavour transformer
pkgHashGHCiLib = False
pkgHashProfLib = profiling `Set.member` libWays
pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag
@@ -158,7 +141,9 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do
pkgHashDebugInfo = undefined
-- ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs
- let pkgHashProgramArgs = mempty -- Map.singleton "ghc" ghcArgs
+ let pkgHashProgramArgs = mempty -- TODO: Map.singleton "ghc" ghcArgs,
+ -- but the above call to 'interpret' causes a
+ -- build-time loop
pkgHashExtraLibDirs = []
pkgHashExtraLibDirsStatic = []
pkgHashExtraFrameworkDirs = []
@@ -172,7 +157,7 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do
pkgHashPkgId = name
, pkgHashComponent = pkgType (package ctx)
, pkgHashSourceHash = ""
- , pkgHashDirectDeps = Set.empty
+ , pkgHashDirectDeps = Set.fromList depsHashes
, pkgHashOtherConfig = other_config
}
=====================================
hadrian/src/Rules/Register.hs
=====================================
@@ -270,7 +270,7 @@ parseCabalName s = bimap show id (Cabal.runParsecParser nameWithHashParser "<par
nameWithHashParser = Cabal.PP $ \_ -> do
xs' <- Parsec.sepBy component (Parsec.char '-')
case reverse xs' of
- hash:version_str:xs ->
+ _hash:version_str:xs ->
case Cabal.simpleParsec @Version version_str of
Nothing -> fail ("failed to parse a version from " <> version_str)
Just v ->
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b62fbecf19f036796a23d83b8f4372307feea729
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b62fbecf19f036796a23d83b8f4372307feea729
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230327/60949544/attachment-0001.html>
More information about the ghc-commits
mailing list