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
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:
| ... | ... | @@ -2,7 +2,7 @@ module GHC.HsToCore.Usage ( |
| 2 | 2 | -- * Dependency/fingerprinting code (used by GHC.Iface.Make)
|
| 3 | 3 | mkUsageInfo, mkUsedNames,
|
| 4 | 4 | |
| 5 | - UsageConfig(..),
|
|
| 5 | + UsageConfig(..)
|
|
| 6 | 6 | ) where
|
| 7 | 7 | |
| 8 | 8 | import GHC.Prelude
|
| ... | ... | @@ -31,6 +31,7 @@ import GHC.Unit.External |
| 31 | 31 | import GHC.Unit.Module.Imported
|
| 32 | 32 | import GHC.Unit.Module.ModIface
|
| 33 | 33 | import GHC.Unit.Module.Deps
|
| 34 | +import GHC.Unit.Finder(getDirHash)
|
|
| 34 | 35 | |
| 35 | 36 | import GHC.Data.Maybe
|
| 36 | 37 | import GHC.Data.FastString
|
| ... | ... | @@ -48,6 +49,8 @@ import GHC.Types.Unique.DFM |
| 48 | 49 | import GHC.Driver.Plugins
|
| 49 | 50 | import qualified GHC.Unit.Home.Graph as HUG
|
| 50 | 51 | |
| 52 | +import qualified System.Directory as SD
|
|
| 53 | + |
|
| 51 | 54 | {- Note [Module self-dependency]
|
| 52 | 55 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
| 53 | 56 | GHC.Rename.Names.calculateAvails asserts the invariant that a module must not occur in
|
| ... | ... | @@ -231,6 +231,7 @@ instance Outputable RecompReason where |
| 231 | 231 | ModuleRemoved (_st, _uid, m) -> ppr m <+> text "removed"
|
| 232 | 232 | ModuleAdded (_st, _uid, m) -> ppr m <+> text "added"
|
| 233 | 233 | FileChanged fp -> text fp <+> text "changed"
|
| 234 | + DirChanged dp -> text dp <+> text "changed"
|
|
| 234 | 235 | CustomReason s -> text s
|
| 235 | 236 | FlagsChanged -> text "Flags changed"
|
| 236 | 237 | LinkFlagsChanged -> text "Flags changed"
|
| ... | ... | @@ -31,6 +31,9 @@ module GHC.Unit.Finder ( |
| 31 | 31 | |
| 32 | 32 | findObjectLinkableMaybe,
|
| 33 | 33 | findObjectLinkable,
|
| 34 | + |
|
| 35 | + -- important that GHC.HsToCore.Usage uses the same hashing method for usage dirs as is done here.
|
|
| 36 | + getDirHash,
|
|
| 34 | 37 | ) where
|
| 35 | 38 | |
| 36 | 39 | import GHC.Prelude
|
| ... | ... | @@ -69,6 +72,7 @@ import GHC.Driver.Env |
| 69 | 72 | import GHC.Driver.Config.Finder
|
| 70 | 73 | import qualified Data.Set as Set
|
| 71 | 74 | import Data.List.NonEmpty ( NonEmpty (..) )
|
| 75 | +import qualified System.Directory as SD
|
|
| 72 | 76 | import qualified System.OsPath as OsPath
|
| 73 | 77 | import qualified Data.List.NonEmpty as NE
|
| 74 | 78 | |
| ... | ... | @@ -147,10 +151,20 @@ initFinderCache = do |
| 147 | 151 | hash <- getDirHash key
|
| 148 | 152 | atomicModifyIORef' dir_cache $ \c -> (M.insert key hash c, ())
|
| 149 | 153 | return hash
|
| 150 | - Just fp -> return fp
|
|
| 151 | - |
|
| 154 | + Just fp -> return fp
|
|
| 152 | 155 | return FinderCache{..}
|
| 153 | 156 | |
| 157 | +-- | This function computes a shallow hash of a directory, so really just what files and directories are directly inside it.
|
|
| 158 | +-- It does not look at the contents of the files, or the contents of the directories it contains.
|
|
| 159 | +getDirHash :: FilePath -> IO Fingerprint
|
|
| 160 | +getDirHash dir = do
|
|
| 161 | + contents <- SD.listDirectory dir
|
|
| 162 | + -- The documentation of Fingerprints describes this as an easy naive implementation
|
|
| 163 | + -- I wonder if we should do something more sophisticated here?
|
|
| 164 | + let hashes = fingerprintString <$> contents
|
|
| 165 | + let hash = fingerprintFingerprints hashes
|
|
| 166 | + return hash
|
|
| 167 | + |
|
| 154 | 168 | -- -----------------------------------------------------------------------------
|
| 155 | 169 | -- The three external entry points
|
| 156 | 170 |
| ... | ... | @@ -368,9 +368,9 @@ data Usage |
| 368 | 368 | -- ^ An optional string which is used in recompilation messages if
|
| 369 | 369 | -- dir in question has changed.
|
| 370 | 370 | |
| 371 | - -- Note: We this is a very shallow check, just what the contents of
|
|
| 372 | - -- the directory are, aka what files and directories are within it,
|
|
| 373 | - -- if those files/directories have their own contents changed...
|
|
| 371 | + -- Note: We do a very shallow check indeed, just what the contents of
|
|
| 372 | + -- the directory are, aka what files and directories are within it.
|
|
| 373 | + -- If those files/directories have their own contents changed...
|
|
| 374 | 374 | -- We won't spot it here, better recursive add them to your usage
|
| 375 | 375 | -- seperately.
|
| 376 | 376 | }
|
| ... | ... | @@ -21,7 +21,6 @@ module GHC.Utils.Fingerprint ( |
| 21 | 21 | fingerprintString,
|
| 22 | 22 | fingerprintStrings,
|
| 23 | 23 | getFileHash,
|
| 24 | - getDirHash,
|
|
| 25 | 24 | ) where
|
| 26 | 25 | |
| 27 | 26 | import GHC.Prelude.Basic
|
| ... | ... | @@ -5,8 +5,7 @@ module GHC.Fingerprint ( |
| 5 | 5 | fingerprintData,
|
| 6 | 6 | fingerprintString,
|
| 7 | 7 | fingerprintFingerprints,
|
| 8 | - getFileHash,
|
|
| 9 | - getDirHash,
|
|
| 8 | + getFileHash,
|
|
| 10 | 9 | ) where
|
| 11 | 10 | |
| 12 | 11 | import GHC.Internal.Fingerprint |
| ... | ... | @@ -17,7 +17,6 @@ module GHC.Internal.Fingerprint ( |
| 17 | 17 | fingerprintString,
|
| 18 | 18 | fingerprintFingerprints,
|
| 19 | 19 | getFileHash,
|
| 20 | - getDirHash
|
|
| 21 | 20 | ) where
|
| 22 | 21 | |
| 23 | 22 | import GHC.Internal.IO
|
| ... | ... | @@ -107,16 +106,6 @@ getFileHash path = withBinaryFile path ReadMode $ \h -> |
| 107 | 106 | |
| 108 | 107 | in loop
|
| 109 | 108 | |
| 110 | --- | Computes the hash of a given file.
|
|
| 111 | --- This function computes a shallow hash of a directory, so really just what files and directories are directly inside it.
|
|
| 112 | --- It does not look at the contents of the files, or the contents of the directories it contains.
|
|
| 113 | -getDirHash :: FilePath -> IO Fingerprint
|
|
| 114 | -getDirHash dir = do
|
|
| 115 | - contens <- listDirectory dir
|
|
| 116 | - let hashes = fingerprintString <$> contents
|
|
| 117 | - let hash = fingerprintFingerprints hashes
|
|
| 118 | - return hash
|
|
| 119 | - |
|
| 120 | 109 | data MD5Context
|
| 121 | 110 | |
| 122 | 111 | foreign import ccall unsafe "__hsbase_MD5Init"
|
| ... | ... | @@ -836,7 +836,7 @@ getPackageRoot = Q qGetPackageRoot |
| 836 | 836 | --
|
| 837 | 837 | -- * ghc -M does not know about these dependencies - it does not execute TH.
|
| 838 | 838 | --
|
| 839 | --- * The dependency is shallow, just a hash of its direct contents
|
|
| 839 | +-- * The dependency is shallow, just a hash of its direct contents
|
|
| 840 | 840 | addDependentDirectory :: FilePath -> Q ()
|
| 841 | 841 | addDependentDirectory dp = Q (qAddDependentDirectory dp)
|
| 842 | 842 |
| ... | ... | @@ -7087,7 +7087,6 @@ module GHC.Fingerprint where |
| 7087 | 7087 | fingerprintFingerprints :: [Fingerprint] -> Fingerprint
|
| 7088 | 7088 | fingerprintString :: GHC.Internal.Base.String -> Fingerprint
|
| 7089 | 7089 | getFileHash :: GHC.Internal.IO.FilePath -> GHC.Internal.Types.IO Fingerprint
|
| 7090 | - getDirHash :: GHC.Internal.IO.FilePath -> GHC.Internal.Types.IO Fingerprint
|
|
| 7091 | 7090 | |
| 7092 | 7091 | module GHC.Fingerprint.Type where
|
| 7093 | 7092 | -- Safety: Safe
|