Zubin pushed to branch wip/26853 at Glasgow Haskell Compiler / GHC Commits: f93e9415 by Zubin Duggal at 2026-02-17T18:08:58+05:30 hadrian: Add a flag for debugging --hash-unit-ids. Prints out the inputs of the hash to stdout and a file. - - - - - 2 changed files: - hadrian/src/CommandLine.hs - hadrian/src/Hadrian/Haskell/Hash.hs Changes: ===================================== hadrian/src/CommandLine.hs ===================================== @@ -1,7 +1,7 @@ module CommandLine ( optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, lookupFreeze2, lookupSkipDepends, cmdBignum, cmdBignumCheck, cmdProgressInfo, cmdCompleteSetting, - cmdDocsArgs, cmdUnitIdHash, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs, + cmdDocsArgs, cmdUnitIdHash, cmdDebugHashInputs, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs, cmdPrefix, DocArgs(..), defaultDocArgs ) where @@ -37,7 +37,8 @@ data CommandLineArgs = CommandLineArgs , docsArgs :: DocArgs , docTargets :: DocTargets , prefix :: Maybe FilePath - , completeStg :: Maybe String } + , completeStg :: Maybe String + , debugHashInputs :: Bool } deriving (Eq, Show) -- | Default values for 'CommandLineArgs'. @@ -57,7 +58,8 @@ defaultCommandLineArgs = CommandLineArgs , docsArgs = defaultDocArgs , docTargets = Set.fromList [minBound..maxBound] , prefix = Nothing - , completeStg = Nothing } + , completeStg = Nothing + , debugHashInputs = False } -- | These arguments are used by the `test` target. data TestArgs = TestArgs @@ -143,6 +145,9 @@ readUnitIdHash = Right $ \flags -> trace "--hash-unit-ids is deprecated. It is enabled by release flavour or +hash_unit_ids flavour transformer" $ flags { unitIdHash = True } +readDebugHashInputs :: Either String (CommandLineArgs -> CommandLineArgs) +readDebugHashInputs = Right $ \flags -> flags { debugHashInputs = True } + readProgressInfo :: String -> Either String (CommandLineArgs -> CommandLineArgs) readProgressInfo ms = case lower ms of @@ -278,6 +283,8 @@ optDescrs = "Freeze Stage2 GHC." , Option [] ["hash-unit-ids"] (NoArg readUnitIdHash) "Include package hashes in unit ids." + , Option [] ["debug-hash-inputs"] (NoArg readDebugHashInputs) + "Debug: print and log hash inputs for each package." , Option [] ["skip-depends"] (NoArg readSkipDepends) "Skip rebuilding dependency information." , Option [] ["bignum"] (OptArg readBignum "BACKEND") @@ -401,5 +408,8 @@ cmdBignumCheck = bignumCheck <$> cmdLineArgs cmdProgressInfo :: Action ProgressInfo cmdProgressInfo = progressInfo <$> cmdLineArgs +cmdDebugHashInputs :: Action Bool +cmdDebugHashInputs = debugHashInputs <$> cmdLineArgs + cmdDocsArgs :: Action DocTargets cmdDocsArgs = docTargets <$> cmdLineArgs ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -34,6 +34,8 @@ import Control.Monad import Base import System.Directory.Extra (listFilesRecursive) import Control.Arrow (first) +import CommandLine (cmdDebugHashInputs) +import System.Directory (createDirectoryIfMissing) -- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0-abcd@. @@ -165,15 +167,25 @@ pkgHashOracle = void $ addOracleCache $ \(PkgHashKey (stag, pkg)) -> do need files files_hash <- liftIO (SHA256.finalize <$> hashFiles (SHA256.init) files) - return $ BS.unpack $ Base16.encode $ SHA256.hash $ - renderPackageHashInputs $ PackageHashInputs - { - pkgHashPkgId = name - , pkgHashComponent = pkgType pkg - , pkgHashSourceHash = files_hash - , pkgHashDirectDeps = Set.fromList depsHashes - , pkgHashOtherConfig = other_config - } + let hashInputs = PackageHashInputs + { pkgHashPkgId = name + , pkgHashComponent = pkgType pkg + , pkgHashSourceHash = files_hash + , pkgHashDirectDeps = Set.fromList depsHashes + , pkgHashOtherConfig = other_config + } + rendered = renderPackageHashInputs hashInputs + + debugHash <- cmdDebugHashInputs + when debugHash $ do + root <- buildRoot + let debugDir = root -/- "hash-inputs" + debugFile = debugDir -/- name <.> "txt" + liftIO $ createDirectoryIfMissing True debugDir + liftIO $ BS.writeFile debugFile rendered + putNormal $ "Hash inputs for " ++ name ++ ":\n" ++ BS.unpack rendered + + return $ BS.unpack $ Base16.encode $ SHA256.hash rendered allFilesInDirectory :: FilePath -> Action [FilePath] allFilesInDirectory dir = liftIO $ listFilesRecursive dir View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f93e9415c7fdd01cb6b6ccb910bf903e... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f93e9415c7fdd01cb6b6ccb910bf903e... You're receiving this email because of your account on gitlab.haskell.org.