Hassan Al-Awwadi pushed to branch wip/haanss/depdir at Glasgow Haskell Compiler / GHC
Commits:
-
48faafcd
by Hassan Al-Awwadi at 2025-07-07T11:33:23+02:00
2 changed files:
Changes:
| ... | ... | @@ -71,6 +71,7 @@ import qualified Data.Map as M |
| 71 | 71 | import GHC.Driver.Env
|
| 72 | 72 | import GHC.Driver.Config.Finder
|
| 73 | 73 | import qualified Data.Set as Set
|
| 74 | +import qualified Data.List as L(sort)
|
|
| 74 | 75 | import Data.List.NonEmpty ( NonEmpty (..) )
|
| 75 | 76 | import qualified System.Directory as SD
|
| 76 | 77 | import qualified System.OsPath as OsPath
|
| ... | ... | @@ -161,8 +162,9 @@ getDirHash dir = do |
| 161 | 162 | contents <- SD.listDirectory dir
|
| 162 | 163 | -- The documentation of Fingerprints describes this as an easy naive implementation
|
| 163 | 164 | -- I wonder if we should do something more sophisticated here?
|
| 164 | - let hashes = fingerprintString <$> contents
|
|
| 165 | - let hash = fingerprintFingerprints hashes
|
|
| 165 | + let hashes = fingerprintString <$> contents
|
|
| 166 | + let s_hashes = L.sort hashes
|
|
| 167 | + let hash = fingerprintFingerprints s_hashes
|
|
| 166 | 168 | return hash
|
| 167 | 169 | |
| 168 | 170 | -- -----------------------------------------------------------------------------
|
| ... | ... | @@ -1780,8 +1780,8 @@ module Language.Haskell.TH.Syntax where |
| 1780 | 1780 | type VarStrictType :: *
|
| 1781 | 1781 | type VarStrictType = VarBangType
|
| 1782 | 1782 | addCorePlugin :: GHC.Internal.Base.String -> Q ()
|
| 1783 | - addDependentFile :: GHC.Internal.IO.FilePath -> Q ()
|
|
| 1784 | 1783 | addDependentDirectory :: GHC.Internal.IO.FilePath -> Q ()
|
| 1784 | + addDependentFile :: GHC.Internal.IO.FilePath -> Q ()
|
|
| 1785 | 1785 | addForeignFile :: ForeignSrcLang -> GHC.Internal.Base.String -> Q ()
|
| 1786 | 1786 | addForeignFilePath :: ForeignSrcLang -> GHC.Internal.IO.FilePath -> Q ()
|
| 1787 | 1787 | addForeignSource :: ForeignSrcLang -> GHC.Internal.Base.String -> Q ()
|