Skip to content
Snippets Groups Projects
Commit 39bc9621 authored by Cheng Shao's avatar Cheng Shao
Browse files

Revert "hadrian: Refactor treatment of extra dependencies"

This reverts commit 3a18d9e7.
parent 934a8bb9
No related branches found
No related tags found
No related merge requests found
...@@ -20,41 +20,26 @@ import qualified Data.Set as S ...@@ -20,41 +20,26 @@ import qualified Data.Set as S
import qualified Text.Parsec as Parsec import qualified Text.Parsec as Parsec
data PkgMod = PkgMod { pkg :: Package, _mod :: String }
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
]
where
(p1,m1) --> (p2,m2) = (PkgMod p1 m1, PkgMod p2 m2)
th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal")
-- These modules use DeriveLift which needs Language.Haskell.TH.Lib.Internal but -- These modules use DeriveLift which needs Language.Haskell.TH.Lib.Internal but
-- the dependency is implicit. ghc -M should emit this additional dependency but -- the dependency is implicit. ghc -M should emit this additional dependency but
-- until it does we need to add this dependency ourselves. -- until it does we need to add this dependency ourselves.
extraDependenciesFor :: Stage -> Package -> Action [(FilePath, FilePath)] extra_dependencies :: M.Map Package (Stage -> Action [(FilePath, FilePath)])
extraDependenciesFor stage srcPkg extra_dependencies =
| Just deps <- M.lookup srcPkg byPackage = concat <$> traverse dep deps M.fromList [(containers, fmap (fmap concat . sequence) (sequence
| otherwise = return [] [dep (containers, "Data.IntSet.Internal") th_internal
where ,dep (containers, "Data.Set.Internal") th_internal
byPackage :: M.Map Package [(PkgMod, PkgMod)] ,dep (containers, "Data.Sequence.Internal") th_internal
byPackage = M.fromListWith (++) [ (pkg x, [(x,y)]) | (x,y) <- extraDepsList ] ,dep (containers, "Data.Graph") th_internal
]))
]
-- @dep ((p1, m1), (p2, m2))@ is an extra dependency from where
-- module m1 of package p1 to module m2 of package p2. th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal")
dep :: (PkgMod, PkgMod) -> Action [(FilePath, FilePath)] dep (p1, m1) (p2, m2) s = do
dep (PkgMod p1 m1, PkgMod p2 m2) = do let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set")
let context = Context stage p1 (error "extra_dependencies: way not set") (error "extra_dependencies: inplace not set")
ways <- interpretInContext context getLibraryWays ways <- interpretInContext context getLibraryWays
mapM (\way -> (,) <$> path way p1 m1 <*> path way p2 m2) (S.toList ways) mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways)
path stage way p m =
path :: Way -> Package -> String -> Action FilePath
path way p m =
let context = Context stage p way Inplace let context = Context stage p way Inplace
in objectPath context . moduleSource $ m in objectPath context . moduleSource $ m
...@@ -68,7 +53,7 @@ buildPackageDependencies rs = do ...@@ -68,7 +53,7 @@ buildPackageDependencies rs = do
DepMkFile stage pkgpath <- getDepMkFile root mk DepMkFile stage pkgpath <- getDepMkFile root mk
let pkg = unsafeFindPackageByPath pkgpath let pkg = unsafeFindPackageByPath pkgpath
context = Context stage pkg vanilla Inplace context = Context stage pkg vanilla Inplace
extra <- extraDependenciesFor stage pkg extra <- maybe (return []) ($ stage) $ M.lookup pkg extra_dependencies
srcs <- hsSources context srcs <- hsSources context
gens <- interpretInContext context generatedDependencies gens <- interpretInContext context generatedDependencies
need (srcs ++ gens) need (srcs ++ gens)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment