[Git][ghc/ghc][wip/inplace-final] hadrian: Add extra implicit dependencies from DeriveLift

[Matthew Pickering (@mpickering)]

Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC


Commits:
112e9b37 by Matthew Pickering at 2022-09-13T18:02:11+01:00
hadrian: Add extra implicit dependencies from DeriveLift

ghc -M should know that modules which use DeriveLift (or
TemplateHaskellQuotes) need TH.Lib.Internal but until it does, we have
to add these extra edges manually or the modules will be compiled before
TH.Lib.Internal is compiled which leads to a desugarer error.

- - - - -


2 changed files:

- hadrian/src/Oracles/ModuleFiles.hs
- hadrian/src/Rules/Dependencies.hs


Changes:

=====================================
hadrian/src/Oracles/ModuleFiles.hs
=====================================
@@ -2,7 +2,7 @@
 module Oracles.ModuleFiles (
     decodeModule, encodeModule, findGenerator, hsSources, hsObjects,
     determineBuilder,
-    moduleFilesOracle
+    moduleFilesOracle, moduleSource
     ) where
 
 import qualified Data.HashMap.Strict as Map


=====================================
hadrian/src/Rules/Dependencies.hs
=====================================
@@ -12,15 +12,42 @@ import Rules.Generate
 import Settings
 import Target
 import Utilities
+import Packages
+import qualified Data.Map as M
 
 import qualified Text.Parsec as Parsec
 
+-- These modules use DeriveLift which needs Language.Haskell.TH.Lib.Internal but
+-- the dependency is implicit. ghc -M should emit this additional dependency but
+-- until it does we need to add this dependency ourselves.
+extra_dependencies :: M.Map Package (Stage -> Action [(FilePath, FilePath)])
+extra_dependencies =
+  M.fromList [(containers, fmap sequence (sequence
+    [dep (containers, "Data.IntSet.Internal") th_internal
+    ,dep (containers, "Data.Set.Internal") th_internal
+    ,dep (containers, "Data.Sequence.Internal") th_internal
+    ,dep (containers, "Data.Graph") th_internal
+    ]))
+    ]
+
+  where
+    th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal")
+    dep (p1, m1) (p2, m2) s = (,) <$> path s p1 m1 <*> path s p2 m2
+    path stage p m =
+      let context = Context stage p vanilla Inplace
+      in objectPath context . moduleSource $ m
+
+formatExtra :: (FilePath, FilePath) -> String
+formatExtra (fp1, fp2) = fp1 ++ ":" ++ fp2 ++ "\n"
+
 buildPackageDependencies :: [(Resource, Int)] -> Rules ()
 buildPackageDependencies rs = do
     root <- buildRootRules
     root -/- "**/.dependencies.mk" %> \mk -> do
         DepMkFile stage pkgpath <- getDepMkFile root mk
-        let context = Context stage (unsafeFindPackageByPath pkgpath) vanilla Inplace
+        let pkg = unsafeFindPackageByPath pkgpath
+            context = Context stage pkg vanilla Inplace
+        extra <- maybe (return []) ($ stage) $ M.lookup pkg extra_dependencies
         srcs <- hsSources context
         gens <- interpretInContext context generatedDependencies
         need (srcs ++ gens)
@@ -28,6 +55,7 @@ buildPackageDependencies rs = do
         then writeFileChanged mk ""
         else buildWithResources rs $ target context
             (Ghc FindHsDependencies $ Context.stage context) srcs [mk]
+        liftIO $ mapM_ (appendFile mk . formatExtra) extra
         removeFile $ mk <.> "bak"
 
     root -/- "**/.dependencies" %> \deps -> do



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/112e9b37117a7c3d7ac291bea9496b01792c8aa2
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/20220913/4607817b/attachment-0001.html>