Hassan Al-Awwadi pushed to branch wip/haanss/depdir at Glasgow Haskell Compiler / GHC Commits: 0163c08f by Hassan Al-Awwadi at 2025-07-05T11:26:13+02:00 this commit takes the previously defined getDirHash and moves it from Fingerprints module to being locally defined within GHC.Unit.Finder (which is lower in the module tree that GHC.HsToCore.Usage). This way we avoid altering GHC.Internals or base, which is maybe for the best, but one could argue it really does belong inside Fingerprint... - - - - - 9 changed files: - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Utils/Fingerprint.hs - libraries/base/src/GHC/Fingerprint.hs - libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -2,7 +2,7 @@ module GHC.HsToCore.Usage ( -- * Dependency/fingerprinting code (used by GHC.Iface.Make) mkUsageInfo, mkUsedNames, - UsageConfig(..), + UsageConfig(..) ) where import GHC.Prelude @@ -31,6 +31,7 @@ import GHC.Unit.External import GHC.Unit.Module.Imported import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps +import GHC.Unit.Finder(getDirHash) import GHC.Data.Maybe import GHC.Data.FastString @@ -48,6 +49,8 @@ import GHC.Types.Unique.DFM import GHC.Driver.Plugins import qualified GHC.Unit.Home.Graph as HUG +import qualified System.Directory as SD + {- Note [Module self-dependency] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC.Rename.Names.calculateAvails asserts the invariant that a module must not occur in ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -231,6 +231,7 @@ instance Outputable RecompReason where ModuleRemoved (_st, _uid, m) -> ppr m <+> text "removed" ModuleAdded (_st, _uid, m) -> ppr m <+> text "added" FileChanged fp -> text fp <+> text "changed" + DirChanged dp -> text dp <+> text "changed" CustomReason s -> text s FlagsChanged -> text "Flags changed" LinkFlagsChanged -> text "Flags changed" ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -31,6 +31,9 @@ module GHC.Unit.Finder ( findObjectLinkableMaybe, findObjectLinkable, + + -- important that GHC.HsToCore.Usage uses the same hashing method for usage dirs as is done here. + getDirHash, ) where import GHC.Prelude @@ -69,6 +72,7 @@ import GHC.Driver.Env import GHC.Driver.Config.Finder import qualified Data.Set as Set import Data.List.NonEmpty ( NonEmpty (..) ) +import qualified System.Directory as SD import qualified System.OsPath as OsPath import qualified Data.List.NonEmpty as NE @@ -147,10 +151,20 @@ initFinderCache = do hash <- getDirHash key atomicModifyIORef' dir_cache $ \c -> (M.insert key hash c, ()) return hash - Just fp -> return fp - + Just fp -> return fp return FinderCache{..} +-- | This function computes a shallow hash of a directory, so really just what files and directories are directly inside it. +-- It does not look at the contents of the files, or the contents of the directories it contains. +getDirHash :: FilePath -> IO Fingerprint +getDirHash dir = do + contents <- SD.listDirectory dir + -- The documentation of Fingerprints describes this as an easy naive implementation + -- I wonder if we should do something more sophisticated here? + let hashes = fingerprintString <$> contents + let hash = fingerprintFingerprints hashes + return hash + -- ----------------------------------------------------------------------------- -- The three external entry points ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -368,9 +368,9 @@ data Usage -- ^ An optional string which is used in recompilation messages if -- dir in question has changed. - -- Note: We this is a very shallow check, just what the contents of - -- the directory are, aka what files and directories are within it, - -- if those files/directories have their own contents changed... + -- Note: We do a very shallow check indeed, just what the contents of + -- the directory are, aka what files and directories are within it. + -- If those files/directories have their own contents changed... -- We won't spot it here, better recursive add them to your usage -- seperately. } ===================================== compiler/GHC/Utils/Fingerprint.hs ===================================== @@ -21,7 +21,6 @@ module GHC.Utils.Fingerprint ( fingerprintString, fingerprintStrings, getFileHash, - getDirHash, ) where import GHC.Prelude.Basic ===================================== libraries/base/src/GHC/Fingerprint.hs ===================================== @@ -5,8 +5,7 @@ module GHC.Fingerprint ( fingerprintData, fingerprintString, fingerprintFingerprints, - getFileHash, - getDirHash, + getFileHash, ) where import GHC.Internal.Fingerprint ===================================== libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs ===================================== @@ -17,7 +17,6 @@ module GHC.Internal.Fingerprint ( fingerprintString, fingerprintFingerprints, getFileHash, - getDirHash ) where import GHC.Internal.IO @@ -107,16 +106,6 @@ getFileHash path = withBinaryFile path ReadMode $ \h -> in loop --- | Computes the hash of a given file. --- This function computes a shallow hash of a directory, so really just what files and directories are directly inside it. --- It does not look at the contents of the files, or the contents of the directories it contains. -getDirHash :: FilePath -> IO Fingerprint -getDirHash dir = do - contens <- listDirectory dir - let hashes = fingerprintString <$> contents - let hash = fingerprintFingerprints hashes - return hash - data MD5Context foreign import ccall unsafe "__hsbase_MD5Init" ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs ===================================== @@ -836,7 +836,7 @@ getPackageRoot = Q qGetPackageRoot -- -- * ghc -M does not know about these dependencies - it does not execute TH. -- --- * The dependency is shallow, just a hash of its direct contents +-- * The dependency is shallow, just a hash of its direct contents addDependentDirectory :: FilePath -> Q () addDependentDirectory dp = Q (qAddDependentDirectory dp) ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -7087,7 +7087,6 @@ module GHC.Fingerprint where fingerprintFingerprints :: [Fingerprint] -> Fingerprint fingerprintString :: GHC.Internal.Base.String -> Fingerprint getFileHash :: GHC.Internal.IO.FilePath -> GHC.Internal.Types.IO Fingerprint - getDirHash :: GHC.Internal.IO.FilePath -> GHC.Internal.Types.IO Fingerprint module GHC.Fingerprint.Type where -- Safety: Safe View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0163c08f28fd8cfed1623a7de91c3699... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0163c08f28fd8cfed1623a7de91c3699... You're receiving this email because of your account on gitlab.haskell.org.