[Git][ghc/ghc][wip/romes/hardwire-ghc-unit-id] WIP: Better Hash

Rodrigo Mesquita (@alt-romes) gitlab at gitlab.haskell.org
Mon Mar 20 14:53:03 UTC 2023



Rodrigo Mesquita pushed to branch wip/romes/hardwire-ghc-unit-id at Glasgow Haskell Compiler / GHC


Commits:
a73f90e8 by romes at 2023-03-20T14:50:21+00:00
WIP: Better Hash

Co-author: @mpickering

TODO: Fix identifier of rts which is depended on.
What about the simple identifiers in haddocks?
Perhaps we only need the full unitid for the pacckage databases.

- - - - -


15 changed files:

- hadrian/hadrian.cabal
- hadrian/src/Context.hs
- hadrian/src/Hadrian/Haskell/Cabal.hs
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- + hadrian/src/Hadrian/Haskell/Hash.hs
- + hadrian/src/Hadrian/Haskell/Hash.hs-boot
- hadrian/src/Hadrian/Package.hs
- hadrian/src/Rules.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Builders/Haddock.hs


Changes:

=====================================
hadrian/hadrian.cabal
=====================================
@@ -55,6 +55,7 @@ executable hadrian
                        , Hadrian.BuildPath
                        , Hadrian.Expression
                        , Hadrian.Haskell.Cabal
+                       , Hadrian.Haskell.Hash
                        , Hadrian.Haskell.Cabal.Type
                        , Hadrian.Haskell.Cabal.Parse
                        , Hadrian.Oracles.ArgsHash
@@ -163,6 +164,8 @@ executable hadrian
                        , transformers         >= 0.4     && < 0.7
                        , unordered-containers >= 0.2.1   && < 0.3
                        , text                 >= 1.2     && < 3
+                       , cryptohash-sha256    >= 0.11    && < 0.12
+                       , base16-bytestring    >= 0.1.1 && < 1.1.0.0
     ghc-options:       -Wall
                        -Wincomplete-record-updates
                        -Wredundant-constraints


=====================================
hadrian/src/Context.hs
=====================================
@@ -72,7 +72,7 @@ distDir st = do
 
 pkgFileName :: Package -> String -> String -> Action FilePath
 pkgFileName package prefix suffix = do
-    pid  <- pkgIdentifier package
+    pid  <- pkgSimpleIdentifier package
     return $ prefix ++ pid ++ suffix
 
 pkgFile :: Context -> String -> String -> Action FilePath
@@ -97,7 +97,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config")
 pkgHaddockFile :: Context -> Action FilePath
 pkgHaddockFile Context {..} = do
     root <- buildRoot
-    version <- pkgIdentifier 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.:
@@ -106,7 +106,7 @@ pkgHaddockFile Context {..} = do
 pkgRegisteredLibraryFile :: Context -> Action FilePath
 pkgRegisteredLibraryFile context at Context {..} = do
     libDir    <- libPath context
-    pkgId     <- pkgIdentifier package
+    pkgId     <- pkgSimpleIdentifier package
     fileName  <- pkgRegisteredLibraryFileName context
     distDir   <- distDir stage
     return $ if Dynamic `wayUnit` way
@@ -136,8 +136,8 @@ pkgGhciLibraryFile context at Context {..} = do
 
 -- | Path to the configuration file of a given 'Context'.
 pkgConfFile :: Context -> Action FilePath
-pkgConfFile Context {..} = do
-    pid  <- pkgIdentifier package
+pkgConfFile context at Context {..} = do
+    pid  <- pkgSimpleIdentifier package
     dbPath <- packageDbPath (PackageDbLoc stage iplace)
     return $ dbPath -/- pid <.> "conf"
 


=====================================
hadrian/src/Hadrian/Haskell/Cabal.hs
=====================================
@@ -10,8 +10,8 @@
 -- Cabal files.
 -----------------------------------------------------------------------------
 module Hadrian.Haskell.Cabal (
-    pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies,
-    pkgGenericDescription, cabalArchString, cabalOsString,
+    pkgVersion, pkgSimpleIdentifier, pkgUnitId, pkgSynopsis, pkgDescription,
+    pkgDependencies, pkgGenericDescription, cabalArchString, cabalOsString
     ) where
 
 import Development.Shake
@@ -20,15 +20,20 @@ import Distribution.PackageDescription (GenericPackageDescription)
 import Hadrian.Haskell.Cabal.Type
 import Hadrian.Oracles.Cabal
 import Hadrian.Package
+import {-# SOURCE #-} Hadrian.Haskell.Hash (pkgUnitId)
+
 
 -- | Read a Cabal file and return the package version. The Cabal file is tracked.
 pkgVersion :: Package -> Action String
 pkgVersion = fmap version . readPackageData
 
--- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0 at .
+
+-- | 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.
-pkgIdentifier :: Package -> Action String
-pkgIdentifier package = do
+--
+-- 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
@@ -72,3 +77,4 @@ cabalOsString "mingw32"  = "windows"
 cabalOsString "darwin"   = "osx"
 cabalOsString "solaris2" = "solaris"
 cabalOsString other      = other
+


=====================================
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
=====================================
@@ -345,7 +345,7 @@ registerPackage rs context = do
     pd <- packageDescription <$> readContextData context
     db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context))
     dist_dir <- Context.buildPath context
-    pid <- pkgIdentifier (package context)
+    pid <- pkgUnitId context
     -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path
     -- from the local build info @lbi at .
     lbi <- liftIO $ C.getPersistBuildConfig cPath


=====================================
hadrian/src/Hadrian/Haskell/Hash.hs
=====================================
@@ -0,0 +1,229 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+module Hadrian.Haskell.Hash (pkgUnitId, pkgHashOracle) where
+
+import Development.Shake
+
+import Hadrian.Haskell.Cabal.Type
+import Hadrian.Haskell.Cabal
+import Hadrian.Oracles.Cabal
+import Hadrian.Package
+
+import qualified Crypto.Hash.SHA256     as SHA256
+import qualified Data.ByteString.Base16 as Base16
+import qualified Data.ByteString.Char8  as BS
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.Maybe
+import Data.List
+import Context.Type
+import Oracles.Setting
+import Hadrian.Target
+import Hadrian.Expression
+import Builder
+import Flavour.Type
+import Settings
+import Way.Type
+import Way
+import Packages
+import Development.Shake.Classes
+import Control.Monad
+
+
+-- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd at .
+-- This needs to be an oracle so it's cached
+pkgUnitId :: Context -> Action String
+pkgUnitId ctx = do
+  pid   <- pkgSimpleIdentifier (package ctx)
+  phash <- pkgHash ctx
+  -- 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
+
+
+data PackageHashInputs = PackageHashInputs {
+       pkgHashPkgId         :: String, -- ^ name-version
+       pkgHashComponent     :: PackageType,
+       pkgHashSourceHash    :: BS.ByteString,
+       -- pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion),
+       pkgHashDirectDeps    :: Set.Set String,
+       pkgHashOtherConfig   :: PackageHashConfigInputs
+     }
+
+-- | Those parts of the package configuration that contribute to the
+-- package hash computed by hadrian (which is simpler than cabal's).
+--
+-- setting in Oracle.setting, which come from system.config
+data PackageHashConfigInputs = PackageHashConfigInputs {
+       pkgHashCompilerId          :: String,
+       pkgHashPlatform            :: String,
+       pkgHashFlagAssignment      :: [String], -- complete not partial
+       -- pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure
+       pkgHashVanillaLib          :: Bool,
+       pkgHashSharedLib           :: Bool,
+       pkgHashDynExe              :: Bool,
+       pkgHashFullyStaticExe      :: Bool,
+       pkgHashGHCiLib             :: Bool,
+       pkgHashProfLib             :: Bool,
+       pkgHashProfExe             :: Bool,
+--       pkgHashProfLibDetail       :: ProfDetailLevel,
+--       pkgHashProfExeDetail       :: ProfDetailLevel,
+       pkgHashCoverage            :: Bool,
+       pkgHashOptimization        :: Int,
+       pkgHashSplitObjs           :: Bool,
+       pkgHashSplitSections       :: Bool,
+       pkgHashStripLibs           :: Bool,
+       pkgHashStripExes           :: Bool,
+--       pkgHashDebugInfo           :: DebugInfoLevel,
+       pkgHashProgramArgs         :: Map String [String],
+       pkgHashExtraLibDirs        :: [FilePath],
+       pkgHashExtraLibDirsStatic  :: [FilePath],
+       pkgHashExtraFrameworkDirs  :: [FilePath],
+       pkgHashExtraIncludeDirs    :: [FilePath]
+       -- pkgHashProgPrefix          :: Maybe PathTemplate,
+       -- pkgHashProgSuffix          :: Maybe PathTemplate,
+       -- pkgHashPackageDbs          :: [Maybe PackageDB]
+     }
+  deriving Show
+
+newtype PkgHashKey = PkgHashKey Context
+  deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+type instance RuleResult PkgHashKey = String
+
+pkgHash :: Context -> Action String
+pkgHash = askOracle . PkgHashKey
+
+-- TODO: Needs to be oracle to be cached? Called lots of times
+pkgHashOracle :: Rules ()
+pkgHashOracle = void $ addOracleCache $ \(PkgHashKey ctx) -> do
+  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
+
+  targetOs       <- setting TargetOs
+  let pkgHashCompilerId = ""
+      pkgHashPlatform = targetOs
+  libWays <- interpretInContext ctx (libraryWays flav)
+  dyn_ghc <- dynamicGhcPrograms flav
+  flags <-  interpret (target ctx (Cabal Flags stag) [] []) flavourArgs
+  let pkgHashFlagAssignment = flags
+      pkgHashConfigureScriptArgs = ""
+      pkgHashVanillaLib = vanilla `Set.member` libWays
+      pkgHashSharedLib = dynamic `Set.member` libWays
+      pkgHashDynExe = dyn_ghc
+      -- TODO: fullyStatic flavour transformer
+      pkgHashFullyStaticExe = False
+      pkgHashGHCiLib = False
+      pkgHashProfLib = profiling `Set.member` libWays
+      pkgHashProfExe = package ctx == ghc && ghcProfiled flav stag
+      pkgHashCoverage = False -- Can't configure this
+      pkgHashOptimization = 0 -- TODO: A bit tricky to configure
+      pkgHashSplitObjs = False -- Deprecated
+      pkgHashSplitSections = ghcSplitSections flav
+      pkgHashStripExes = False
+      pkgHashStripLibs = False
+      pkgHashDebugInfo = undefined
+
+  ghcArgs <- interpret (target ctx (Cabal Setup stag) [] []) flavourArgs
+  let pkgHashProgramArgs = Map.singleton "ghc" ghcArgs
+      pkgHashExtraLibDirs = []
+      pkgHashExtraLibDirsStatic = []
+      pkgHashExtraFrameworkDirs = []
+      pkgHashExtraIncludeDirs = []
+
+  let other_config = PackageHashConfigInputs{..}
+
+  return $ BS.unpack $ Base16.encode $ SHA256.hash $
+    renderPackageHashInputs $ PackageHashInputs
+    {
+       pkgHashPkgId       = name
+    ,  pkgHashComponent   = pkgType (package ctx)
+    ,  pkgHashSourceHash  = ""
+    ,  pkgHashDirectDeps  = Set.empty
+    ,  pkgHashOtherConfig = other_config
+    }
+
+prettyShow, showHashValue :: Show a => a -> String
+prettyShow = show
+showHashValue = show
+
+renderPackageHashInputs :: PackageHashInputs -> BS.ByteString
+renderPackageHashInputs PackageHashInputs{
+                          pkgHashPkgId,
+                          pkgHashComponent,
+                          pkgHashSourceHash,
+                          pkgHashDirectDeps,
+                          -- pkgHashPkgConfigDeps,
+                          pkgHashOtherConfig =
+                            PackageHashConfigInputs{..}
+                        } =
+    -- The purpose of this somewhat laboured rendering (e.g. why not just
+    -- use show?) is so that existing package hashes do not change
+    -- unnecessarily when new configuration inputs are added into the hash.
+    BS.pack $ unlines $ catMaybes $
+      [ entry "pkgid"       prettyShow pkgHashPkgId
+--      , mentry "component"  show pkgHashComponent
+      , entry "src"         showHashValue pkgHashSourceHash
+      {-
+      , entry "pkg-config-deps"
+                            (intercalate ", " . map (\(pn, mb_v) -> prettyShow pn ++
+                                                    case mb_v of
+                                                        Nothing -> ""
+                                                        Just v -> " " ++ prettyShow v)
+                                              . Set.toList) pkgHashPkgConfigDeps
+                                              -}
+      , entry "deps"        (intercalate ", " . map prettyShow
+                                              . Set.toList) pkgHashDirectDeps
+        -- and then all the config
+      , entry "compilerid"  prettyShow pkgHashCompilerId
+      , entry "platform" prettyShow pkgHashPlatform
+      , opt   "flags" mempty show pkgHashFlagAssignment
+--      , opt   "configure-script" [] unwords pkgHashConfigureScriptArgs
+      , opt   "vanilla-lib" True  prettyShow pkgHashVanillaLib
+      , opt   "shared-lib"  False prettyShow pkgHashSharedLib
+      , opt   "dynamic-exe" False prettyShow pkgHashDynExe
+      , opt   "fully-static-exe" False prettyShow pkgHashFullyStaticExe
+      , opt   "ghci-lib"    False prettyShow pkgHashGHCiLib
+      , opt   "prof-lib"    False prettyShow pkgHashProfLib
+      , opt   "prof-exe"    False prettyShow pkgHashProfExe
+ --     , opt   "prof-lib-detail" ProfDetailDefault showProfDetailLevel pkgHashProfLibDetail
+ --     , opt   "prof-exe-detail" ProfDetailDefault showProfDetailLevel pkgHashProfExeDetail
+      , opt   "hpc"          False prettyShow pkgHashCoverage
+      , opt   "optimisation" 0 (show) pkgHashOptimization
+      , opt   "split-objs"   False prettyShow pkgHashSplitObjs
+      , opt   "split-sections" False prettyShow pkgHashSplitSections
+      , opt   "stripped-lib" False prettyShow pkgHashStripLibs
+      , opt   "stripped-exe" True  prettyShow pkgHashStripExes
+--      , opt   "debug-info"   NormalDebugInfo (show . fromEnum) pkgHashDebugInfo
+      , opt   "extra-lib-dirs"     [] unwords pkgHashExtraLibDirs
+      , opt   "extra-lib-dirs-static" [] unwords pkgHashExtraLibDirsStatic
+      , opt   "extra-framework-dirs" [] unwords pkgHashExtraFrameworkDirs
+      , opt   "extra-include-dirs" [] unwords pkgHashExtraIncludeDirs
+--      , opt   "prog-prefix" Nothing (maybe "" fromPathTemplate) pkgHashProgPrefix
+--      , opt   "prog-suffix" Nothing (maybe "" fromPathTemplate) pkgHashProgSuffix
+--      , opt   "package-dbs" [] (unwords . map show) pkgHashPackageDbs
+
+      ] ++ Map.foldrWithKey (\prog args acc -> opt (prog ++ "-options") [] unwords args : acc) [] pkgHashProgramArgs
+  where
+    entry key     format value = Just (key ++ ": " ++ format value)
+    mentry key    format value = fmap (\v -> key ++ ": " ++ format v) value
+    opt   key def format value
+         | value == def = Nothing
+         | otherwise    = entry key format value


=====================================
hadrian/src/Hadrian/Haskell/Hash.hs-boot
=====================================
@@ -0,0 +1,7 @@
+module Hadrian.Haskell.Hash where
+
+import Context.Type
+import Development.Shake
+
+pkgUnitId :: Context -> Action String
+


=====================================
hadrian/src/Hadrian/Package.hs
=====================================
@@ -81,4 +81,4 @@ instance NFData   PackageType
 
 instance Binary   Package
 instance Hashable Package
-instance NFData   Package
\ No newline at end of file
+instance NFData   Package


=====================================
hadrian/src/Rules.hs
=====================================
@@ -8,6 +8,7 @@ import qualified Hadrian.Oracles.Cabal.Rules
 import qualified Hadrian.Oracles.DirectoryContents
 import qualified Hadrian.Oracles.Path
 import qualified Hadrian.Oracles.TextFile
+import qualified Hadrian.Haskell.Hash
 
 import Expression
 import qualified Oracles.Flavour
@@ -142,6 +143,7 @@ oracleRules :: Rules ()
 oracleRules = do
     Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs
     Hadrian.Oracles.Cabal.Rules.cabalOracle
+    Hadrian.Haskell.Hash.pkgHashOracle
     Hadrian.Oracles.DirectoryContents.directoryContentsOracle
     Hadrian.Oracles.Path.pathOracle
     Hadrian.Oracles.TextFile.textFileOracle


=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -132,7 +132,7 @@ bindistRules = do
         version        <- setting ProjectVersion
         targetPlatform <- setting TargetPlatformFull
         distDir        <- Context.distDir Stage1
-        rtsDir         <- pkgIdentifier rts
+        rtsDir         <- pkgSimpleIdentifier rts
 
         let ghcBuildDir      = root -/- stageString Stage1
             bindistFilesDir  = root -/- "bindist" -/- ghcVersionPretty


=====================================
hadrian/src/Rules/CabalReinstall.hs
=====================================
@@ -10,7 +10,7 @@ import Utilities
 import qualified System.Directory.Extra as IO
 import Data.Either
 import Rules.BinaryDist
-import Hadrian.Haskell.Cabal (pkgIdentifier)
+import Hadrian.Haskell.Cabal (pkgSimpleIdentifier)
 import Oracles.Setting
 
 {-
@@ -54,7 +54,7 @@ cabalBuildRules = do
         need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets)))
 
         distDir        <- Context.distDir Stage1
-        rtsDir         <- pkgIdentifier rts
+        rtsDir         <- pkgSimpleIdentifier rts
 
         let ghcBuildDir      = root -/- stageString Stage1
             rtsIncludeDir    = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir


=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -14,6 +14,8 @@ import Oracles.Flag
 import Oracles.ModuleFiles
 import Oracles.Setting
 import Hadrian.Haskell.Cabal.Type (PackageData(version))
+import Hadrian.Haskell.Cabal
+import Hadrian.Haskell.Hash
 import Hadrian.Oracles.Cabal (readPackageData)
 import Packages
 import Rules.Libffi
@@ -486,16 +488,14 @@ generateConfigHs = do
     trackGenerateHs
     cProjectName        <- getSetting ProjectName
     cBooterVersion      <- getSetting GhcVersion
-    cProjectVersionMunged  <- getSetting ProjectVersionMunged
-    -- ROMES:TODO:HASH First we attempt a fixed unit-id with version but without hash.
-    --
-    -- We now use a more informative unit-id for ghc. See Note [GHC's Unit Id]
-    -- in GHC.Unit.Types
+    -- We now give a unit-id with a version and a hash to ghc.
+    -- See Note [GHC's Unit Id] in GHC.Unit.Types
     --
     -- It's crucial that the unit-id matches the unit-key -- ghc is no longer
     -- part of the WiringMap, so we don't to go back and forth between the
-    -- unit-id and the unit-key -- we take care here that they are the same.
-    let cProjectUnitId = "ghc-" ++ cProjectVersionMunged -- ROMES:TODO:HASH
+    -- unit-id and the unit-key -- we take care that they are the same by using
+    -- 'pkgUnitId' to create the unit-id in both situations.
+    cProjectUnitId <- expr . pkgUnitId =<< getContext
     return $ unlines
         [ "module GHC.Settings.Config"
         , "  ( module GHC.Version"
@@ -592,3 +592,5 @@ generatePlatformHostHs = do
         , "hostPlatformArchOS :: ArchOS"
         , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS"
         ]
+
+


=====================================
hadrian/src/Rules/Register.hs
=====================================
@@ -183,7 +183,7 @@ buildConfFinal rs context at Context {..} _conf = do
     -- so that if any change ends up modifying a library (but not its .conf
     -- file), we still rebuild things that depend on it.
     dir <- (-/-) <$> libPath context <*> distDir stage
-    pkgid <- pkgIdentifier package
+    pkgid <- pkgUnitId context
     files <- liftIO $
       (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"]
            <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"]


=====================================
hadrian/src/Settings/Builders/Cabal.hs
=====================================
@@ -84,8 +84,9 @@ cabalSetupArgs = builder (Cabal Setup) ? do
 commonCabalArgs :: Stage -> Args
 commonCabalArgs stage = do
   verbosity <- expr getVerbosity
+  ctx       <- getContext
   pkg       <- getPackage
-  package_id <- expr $ pkgIdentifier pkg
+  package_id <- expr $ pkgSimpleIdentifier pkg
   let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..")
   mconcat [ -- Don't strip libraries when cross compiling.
             -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@,


=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -3,6 +3,7 @@
 module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where
 
 import Hadrian.Haskell.Cabal
+import Hadrian.Haskell.Hash
 import Hadrian.Haskell.Cabal.Type
 
 import Flavour
@@ -14,6 +15,7 @@ import Rules.Libffi (libffiName)
 import qualified Data.Set as Set
 import System.Directory
 import Data.Version.Extra
+import Hadrian.Haskell.Hash
 
 ghcBuilderArgs :: Args
 ghcBuilderArgs = mconcat
@@ -243,21 +245,24 @@ wayGhcArgs = do
             , (way == debug || way == debugDynamic) ?
               pure ["-ticky", "-DTICKY_TICKY"] ]
 
+-- | Args related to correct handling of packages, such as setting
+-- -this-unit-id and passing -package-id for dependencies
 packageGhcArgs :: Args
 packageGhcArgs = do
     package <- getPackage
+    ctx <- getContext
     ghc_ver <- readVersion <$> (expr . ghcVersionStage =<< getStage)
     -- ROMES: Until the boot compiler no longer needs ghc's
     -- unit-id to be "ghc", the stage0 compiler must be built
     -- with `-this-unit-id ghc`, while the wired-in unit-id of
     -- ghc is correctly set to the unit-id we'll generate for
-    -- stage1 (set in generateVersionHs in Rules.Generate).
+    -- stage1 (set in generateConfigHs in Rules.Generate).
     --
     -- However, we don't need to set the unit-id of "ghc" to "ghc" when
     -- building stage0 because we have a flag in compiler/ghc.cabal.in that is
     -- sets `-this-unit-id ghc` when hadrian is building stage0, which will
     -- overwrite this one.
-    pkgId   <- expr $ pkgIdentifier package
+    pkgId   <- expr $ pkgUnitId ctx
     mconcat [ arg "-hide-all-packages"
             , arg "-no-user-package-db"
             , arg "-package-env -"


=====================================
hadrian/src/Settings/Builders/Haddock.hs
=====================================
@@ -42,7 +42,7 @@ haddockBuilderArgs = mconcat
         version  <- expr $ pkgVersion  pkg
         synopsis <- expr $ pkgSynopsis pkg
         haddocks <- expr $ haddockDependencies context
-        haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks]
+        haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgSimpleIdentifier p | (p, h) <- haddocks]
         hVersion <- expr $ pkgVersion haddock
         statsDir <- expr $ haddockStatsFilesDir
         baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a73f90e80faa7bf7f770a7edd52320ecff60f683

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a73f90e80faa7bf7f770a7edd52320ecff60f683
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/20230320/102da930/attachment-0001.html>


More information about the ghc-commits mailing list