[Git][ghc/ghc][wip/T24528] 4 commits: hadrian: Refactor treatment of extra dependencies

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Fri Apr 12 19:51:09 UTC 2024



Ben Gamari pushed to branch wip/T24528 at Glasgow Haskell Compiler / GHC


Commits:
dd85ae94 by Ben Gamari at 2024-04-12T15:51:03-04:00
hadrian: Refactor treatment of extra dependencies

The previous implementation was both hard to follow and repeated itself,
making changes quite error-prone. Refactor this to be a bit more easier
to reason about.

- - - - -
f8475607 by Ben Gamari at 2024-04-12T15:51:03-04:00
Bump time submodule to 1.14

As requested in #24528.

- - - - -
858505a4 by Ben Gamari at 2024-04-12T15:51:03-04:00
Bump terminfo submodule to current master

- - - - -
d2e0139e by Ben Gamari at 2024-04-12T15:51:03-04:00
Bump parsec submodule

- - - - -


9 changed files:

- compiler/ghc.cabal.in
- ghc/ghc-bin.cabal.in
- hadrian/src/Rules/Dependencies.hs
- libraries/Cabal
- libraries/directory
- libraries/parsec
- libraries/terminfo
- libraries/time
- libraries/unix


Changes:

=====================================
compiler/ghc.cabal.in
=====================================
@@ -111,7 +111,7 @@ Library
                    process    >= 1   && < 1.7,
                    bytestring >= 0.11 && < 0.13,
                    binary     == 0.8.*,
-                   time       >= 1.4 && < 1.13,
+                   time       >= 1.4 && < 1.15,
                    containers >= 0.6.2.1 && < 0.8,
                    array      >= 0.1 && < 0.6,
                    filepath   >= 1   && < 1.6,


=====================================
ghc/ghc-bin.cabal.in
=====================================
@@ -61,7 +61,7 @@ Executable ghc
             ghci           == @ProjectVersionMunged@,
             haskeline      == 0.8.*,
             exceptions     == 0.10.*,
-            time           >= 1.8 && < 1.13
+            time           >= 1.8 && < 1.15
         CPP-Options: -DHAVE_INTERNAL_INTERPRETER
         Other-Modules:
             GHCi.Leak


=====================================
hadrian/src/Rules/Dependencies.hs
=====================================
@@ -20,26 +20,44 @@ import qualified Data.Set as S
 
 import qualified Text.Parsec as Parsec
 
--- These modules use DeriveLift which needs Language.Haskell.TH.Lib.Internal but
+
+data PkgMod = PkgMod { pkg :: Package, _mod :: String }
+
+-- | 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 (fmap concat . 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
-    ]))
+--
+-- This should be dropped when #22229 is fixed.
+extraDepsList :: [(PkgMod, PkgMod)]
+extraDepsList =
+    [ (containers, "Data.IntSet.Internal") --> th_internal
+    , (containers, "Data.Set.Internal") --> th_internal
+    , (containers, "Data.Sequence.Internal") --> th_internal
+    , (containers, "Data.Graph") --> th_internal
+    , (time, "Data.Time.Clock.Internal.UniversalTime") --> th_internal
     ]
-
   where
+    (p1,m1) --> (p2,m2) = (PkgMod p1 m1, PkgMod p2 m2)
     th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal")
-    dep (p1, m1) (p2, m2) s = do
-        let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set")
+
+extraDependenciesFor :: Stage -> Package -> Action [(FilePath, FilePath)]
+extraDependenciesFor stage srcPkg
+  | Just deps <- M.lookup srcPkg byPackage = concat <$> traverse dep deps
+  | otherwise = return []
+  where
+    byPackage :: M.Map Package [(PkgMod, PkgMod)]
+    byPackage = M.fromListWith (++) [ (pkg x, [(x,y)]) | (x,y) <- extraDepsList ]
+
+    -- @dep ((p1, m1), (p2, m2))@ is an extra dependency from
+    -- module m1 of package p1 to module m2 of package p2.
+    dep :: (PkgMod, PkgMod) -> Action [(FilePath, FilePath)]
+    dep (PkgMod p1 m1, PkgMod p2 m2) = do
+        let context = Context stage p1 (error "extra_dependencies: way not set") (error "extra_dependencies: inplace not set")
         ways <- interpretInContext context getLibraryWays
-        mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways)
-    path stage way p m =
+        mapM (\way -> (,) <$> path way p1 m1 <*> path way p2 m2) (S.toList ways)
+
+    path :: Way -> Package -> String -> Action FilePath
+    path way p m =
       let context = Context stage p way Inplace
       in objectPath context . moduleSource $ m
 
@@ -53,7 +71,7 @@ buildPackageDependencies rs = do
         DepMkFile stage pkgpath <- getDepMkFile root mk
         let pkg = unsafeFindPackageByPath pkgpath
             context = Context stage pkg vanilla Inplace
-        extra <- maybe (return []) ($ stage) $ M.lookup pkg extra_dependencies
+        extra <- extraDependenciesFor stage pkg
         srcs <- hsSources context
         gens <- interpretInContext context generatedDependencies
         need (srcs ++ gens)


=====================================
libraries/Cabal
=====================================
@@ -1 +1 @@
-Subproject commit fb3f4d47d261f7401e4ea717ffab31af5d5470fb
+Subproject commit b5ac2f70b0289c5ee1d31211a44133217a8fb9e3


=====================================
libraries/directory
=====================================
@@ -1 +1 @@
-Subproject commit 4b7c231d187cf253c5f446c4aed2fea26b81d5f9
+Subproject commit fc144a581768eb0a328bdcd5adcffca400bd0876


=====================================
libraries/parsec
=====================================
@@ -1 +1 @@
-Subproject commit 4a44a8cdaa8c3eaa97a73a6da05940dd3bf7c93b
+Subproject commit 9c071b05fbb077afbaf0dd2dfdab21265859ae91


=====================================
libraries/terminfo
=====================================
@@ -1 +1 @@
-Subproject commit 500399a1497dfe1786ba67d6d2bfced4832f3fed
+Subproject commit cc1b149fecfa145a5e3fba292927c5c572fb38ce


=====================================
libraries/time
=====================================
@@ -1 +1 @@
-Subproject commit baab563ee2ce547f7b7f7e7069ed09db2d406941
+Subproject commit e5c5d1987011efe88a21ab6ded45aaa33a16274f


=====================================
libraries/unix
=====================================
@@ -1 +1 @@
-Subproject commit 930a8289f96c5353d120af4fd155446c574709f2
+Subproject commit 69552a5267c7dc5c46a8bceec5ec4b40d26b9463



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c432bfda3ed1c7a1954fb6972465bbe013626207...d2e0139e5667298bdb5514dc19dd8b5aa4783994

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c432bfda3ed1c7a1954fb6972465bbe013626207...d2e0139e5667298bdb5514dc19dd8b5aa4783994
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/20240412/3875b58c/attachment-0001.html>


More information about the ghc-commits mailing list