`LoadDependenciesOf` also loads given module
Summary
LoadDependenciesOf also loads module itself, even though its documentation states:
Load only the dependencies of the given module, but not the module itself.
In fact, I can see no difference at all in how GHC handles LoadUpTo and LoadDependenciesOf, by looking at the definition of load.
Steps to reproduce
git clone https://github.com/martijnbastiaan/load-upto-debug.git
cabal run --with-compiler=ghc-9.4.4Expected behavior
No modules should be loaded, as Foo does not have any dependencies.
[]
Succeeded
[]Actual
[]
Succeeded
[ModSummary {
ms_hs_hash = 154c8207fb74c60096bf34e3cbe34208
ms_mod = Foo,
unit = main
ms_textual_imps = [(, Prelude)]
ms_srcimps = []
}]Environment
- GHC version used: 9.4.4
Optional:
- Operating System: Linux
- System Architecture: x86_64
Potential fix
Either take care of LoadHowMuch in topSortModules, or remove LoadDependenciesOf alltogether. Patch:
handle_LoadHowMuch_in_topSortModules.diff
commit 604a43784e94fb5822dd87e6bda82f477936a42e
Author: Martijn Bastiaan <martijn@hmbastiaan.nl>
Date: Sat May 6 22:38:17 2023 +0200
Handle 'LoadHowMuch' in 'topSortModules'
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index a8187074fe..b590c8909a 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -16,6 +16,7 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
-- -----------------------------------------------------------------------------
--
@@ -131,7 +132,7 @@ import qualified Control.Monad.Catch as MC
import Data.IORef
import Data.Maybe
import Data.Time
-import Data.List (sortOn)
+import Data.List (sortOn, deleteBy)
import Data.Bifunctor (first)
import System.Directory
import System.FilePath
@@ -467,9 +468,6 @@ newIfaceCache = do
, iface_addToCache = \hmi -> atomicModifyIORef' ioref (\c -> (hmi:c, ()))
}
-
-
-
-- | Try to load the program. See 'LoadHowMuch' for the different modes.
--
-- This function implements the core of GHC's @--make@ mode. It preprocesses,
@@ -582,16 +580,16 @@ countMods (ResolvedCycle ns) = length ns
countMods (UnresolvedCycle ns) = length ns
-- See Note [Upsweep] for a high-level description.
-createBuildPlan :: ModuleGraph -> Maybe HomeUnitModule -> [BuildPlan]
-createBuildPlan mod_graph maybe_top_mod =
+createBuildPlan :: ModuleGraph -> LoadHowMuch -> [BuildPlan]
+createBuildPlan mod_graph how_much =
let -- Step 1: Compute SCCs without .hi-boot files, to find the cycles
- cycle_mod_graph = topSortModuleGraph True mod_graph maybe_top_mod
+ cycle_mod_graph = topSortModuleGraph True mod_graph (Just how_much)
-- Step 2: Reanalyse loops, with relevant boot modules, to solve the cycles.
build_plan :: [BuildPlan]
build_plan
-- Fast path, if there are no boot modules just do a normal toposort
- | isEmptyModuleEnv boot_modules = collapseAcyclic $ topSortModuleGraph False mod_graph maybe_top_mod
+ | isEmptyModuleEnv boot_modules = collapseAcyclic $ topSortModuleGraph False mod_graph (Just how_much)
| otherwise = toBuildPlan cycle_mod_graph []
toBuildPlan :: [SCC ModuleGraphNode] -> [ModuleGraphNode] -> [BuildPlan]
@@ -724,7 +722,7 @@ load' mhmi_cache how_much mHscMessage mod_graph = do
-- topSortModuleGraph will bomb later.
let checkHowMuch (LoadUpTo m) = checkMod m
checkHowMuch (LoadDependenciesOf m) = checkMod m
- checkHowMuch _ = id
+ checkHowMuch LoadAllTargets = id
checkMod m and_then
| m `Set.member` all_home_mods = and_then
@@ -744,13 +742,7 @@ load' mhmi_cache how_much mHscMessage mod_graph = do
-- are definitely unnecessary, then emit a warning.
warnUnnecessarySourceImports (filterToposortToModules mg2_with_srcimps)
- let maybe_top_mod = case how_much of
- LoadUpTo m -> Just m
- LoadDependenciesOf m -> Just m
- _ -> Nothing
-
- build_plan = createBuildPlan mod_graph maybe_top_mod
-
+ let build_plan = createBuildPlan mod_graph how_much
cache <- liftIO $ maybe (return []) iface_clearCache mhmi_cache
let
@@ -1449,7 +1441,7 @@ topSortModuleGraph
:: Bool
-- ^ Drop hi-boot nodes? (see below)
-> ModuleGraph
- -> Maybe HomeUnitModule
+ -> Maybe LoadHowMuch
-- ^ Root module name. If @Nothing@, use the full graph.
-> [SCC ModuleGraphNode]
-- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
@@ -1466,31 +1458,44 @@ topSortModuleGraph
-- - @True@: eliminate the hi-boot nodes, and instead pretend
-- the a source-import of Foo is an import of Foo
-- The resulting graph has no hi-boot nodes, but can be cyclic
-topSortModuleGraph drop_hs_boot_nodes module_graph mb_root_mod =
+topSortModuleGraph drop_hs_boot_nodes module_graph mb_how_much =
-- stronglyConnCompG flips the original order, so if we reverse
-- the summaries we get a stable topological sort.
- topSortModules drop_hs_boot_nodes (reverse $ mgModSummaries' module_graph) mb_root_mod
+ topSortModules drop_hs_boot_nodes (reverse $ mgModSummaries' module_graph) mb_how_much
-topSortModules :: Bool -> [ModuleGraphNode] -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
-topSortModules drop_hs_boot_nodes summaries mb_root_mod
- = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph
+topSortModules :: Bool -> [ModuleGraphNode] -> Maybe LoadHowMuch -> [SCC ModuleGraphNode]
+topSortModules drop_hs_boot_nodes summaries = map (fmap summaryNodeSummary) . initial_graph
where
(graph, lookup_node) =
moduleGraphNodes drop_hs_boot_nodes summaries
- initial_graph = case mb_root_mod of
- Nothing -> graph
- Just (Module uid root_mod) ->
+ modNodeOrError (Module uid mod)
+ | Just node <- lookup_node $ NodeKey_Module $ ModNodeKeyWithUid (GWIB mod NotBoot) uid
+ , graph `hasVertexG` node
+ = node
+ | otherwise = throwGhcException (ProgramError "module does not exist")
+
+ initial_graph :: Maybe LoadHowMuch -> [SCC SummaryNode]
+ initial_graph = \case
+ Nothing -> stronglyConnCompG graph
+ Just LoadAllTargets -> stronglyConnCompG graph
+ Just (LoadUpTo mod) ->
-- restrict the graph to just those modules reachable from
-- the specified module. We do this by building a graph with
-- the full set of nodes, and determining the reachable set from
-- the specified node.
- let root | Just node <- lookup_node $ NodeKey_Module $ ModNodeKeyWithUid (GWIB root_mod NotBoot) uid
- , graph `hasVertexG` node
- = node
- | otherwise
- = throwGhcException (ProgramError "module does not exist")
- in graphFromEdgedVerticesUniq (seq root (reachableG graph root))
+ let root = modNodeOrError mod
+ reducedGraph = graphFromEdgedVerticesUniq (seq root (reachableG graph root))
+ in stronglyConnCompG reducedGraph
+ Just (LoadDependenciesOf mod) ->
+ -- Restrict graph to module and everything reachable from it. Then, remove
+ -- the given mod if it is _not_ part of a cycle.
+ let root = modNodeOrError mod
+ reducedGraph = graphFromEdgedVerticesUniq (reachableG graph root)
+ in deleteBy
+ (\a b -> fmap node_key a == fmap node_key b)
+ (AcyclicSCC root)
+ (stronglyConnCompG reducedGraph)
newtype ModNodeMap a = ModNodeMap { unModNodeMap :: Map.Map ModNodeKey a }
deriving (Functor, Traversable, Foldable)