Safe Haskell | None |
---|---|
Language | GHC2021 |
A module graph should be constructed once and never change from there onwards.
The only operations should be for building the ModuleGraph
(once and for all -- no update-like/insert-like functions)
and querying the structure in various ways, e.g. to determine reachability.
We should avoid exposing fields like mg_mss
since it may be a footgun
trying to use the nodes directly... We do still expose it, but it feels like
all its use cases would be better served by a more proper ModuleGraph
abstraction
Synopsis
- data ModuleGraph
- emptyMG :: ModuleGraph
- mkModuleGraph :: [ModuleGraphNode] -> ModuleGraph
- data ModuleGraphNode
- mgNodeDependencies :: Bool -> ModuleGraphNode -> [NodeKey]
- mgNodeModSum :: ModuleGraphNode -> Maybe ModSummary
- mgNodeUnitId :: ModuleGraphNode -> UnitId
- lengthMG :: ModuleGraph -> Int
- mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
- mgMapM :: (ModSummary -> IO ModSummary) -> ModuleGraph -> IO ModuleGraph
- mgModSummaries :: ModuleGraph -> [ModSummary]
- mgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary
- mgReachable :: ModuleGraph -> NodeKey -> Maybe [ModuleGraphNode]
- mgQuery :: ModuleGraph -> NodeKey -> NodeKey -> Bool
- mgQueryMany :: ModuleGraph -> [NodeKey] -> NodeKey -> Bool
- mgModSummaries' :: ModuleGraph -> [ModuleGraphNode]
- moduleGraphNodes :: Bool -> [ModuleGraphNode] -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
- moduleGraphModulesBelow :: ModuleGraph -> UnitId -> ModuleNameWithIsBoot -> Set ModNodeKeyWithUid
- filterToposortToModules :: [SCC ModuleGraphNode] -> [SCC ModSummary]
- data NodeKey
- mkNodeKey :: ModuleGraphNode -> NodeKey
- nodeKeyUnitId :: NodeKey -> UnitId
- nodeKeyModName :: NodeKey -> Maybe ModuleName
- type ModNodeKey = ModuleNameWithIsBoot
- data ModNodeKeyWithUid = ModNodeKeyWithUid {}
- msKey :: ModSummary -> ModNodeKeyWithUid
- type SummaryNode = Node Int ModuleGraphNode
- summaryNodeSummary :: SummaryNode -> ModuleGraphNode
- summaryNodeKey :: SummaryNode -> Int
- showModMsg :: DynFlags -> Bool -> ModuleGraphNode -> SDoc
Construct a module graph
A module graph should be constructed once by downsweep and never modified.
data ModuleGraph Source #
A 'ModuleGraph
' contains all the nodes from the home package (only). See
'ModuleGraphNode
' for information about the nodes.
Modules need to be compiled. hs-boots need to be typechecked before the associated "real" module so modules with {-# SOURCE #-} imports can be built. Instantiations also need to be typechecked to ensure that the module fits the signature. Substantiation typechecking is roughly comparable to the check that the module and its hs-boot agree.
The graph is not necessarily stored in topologically-sorted order. Use
topSortModuleGraph
and flattenSCC
to achieve this.
emptyMG :: ModuleGraph Source #
Why do we ever need to construct empty graphs? Is it because of one shot mode?
mkModuleGraph :: [ModuleGraphNode] -> ModuleGraph Source #
Construct a module graph. This function should be the only entry point for
building a ModuleGraph
, since it is supposed to be built once and never modified.
If you ever find the need to build a ModuleGraph
iteratively, don't
add insert and update functions to the API since they become footguns.
Instead, design an API that allows iterative construction without posterior
modification, perhaps like what is done for building arrays from mutable
arrays.
Nodes in a module graph
The user-facing nodes in a module graph are ModuleGraphNode
s.
There are a few things which we can query out of each ModuleGraphNode
:
mgNodeDependencies
gets the immediate dependencies of this nodemgNodeUnitId
returns theUnitId
of that nodemgNodeModSum
extracts theModSummary
of a node if exists
data ModuleGraphNode Source #
A 'ModuleGraphNode
' is a node in the 'ModuleGraph
'.
Edges between nodes mark dependencies arising from module imports
and dependencies arising from backpack instantiations.
InstantiationNode UnitId InstantiatedUnit | Instantiation nodes track the instantiation of other units (backpack dependencies) with the holes (signatures) of the current package. |
ModuleNode [NodeKey] ModSummary | There is a module summary node for each module, signature, and boot module being built. |
LinkNode [NodeKey] UnitId | Link nodes are whether are are creating a linked product (ie executable/shared object etc) for a unit. |
Instances
Outputable ModuleGraphNode Source # | |
Defined in GHC.Unit.Module.Graph ppr :: ModuleGraphNode -> SDoc Source # | |
Eq ModuleGraphNode Source # | |
Defined in GHC.Unit.Module.Graph (==) :: ModuleGraphNode -> ModuleGraphNode -> Bool # (/=) :: ModuleGraphNode -> ModuleGraphNode -> Bool # | |
Ord ModuleGraphNode Source # | |
Defined in GHC.Unit.Module.Graph compare :: ModuleGraphNode -> ModuleGraphNode -> Ordering # (<) :: ModuleGraphNode -> ModuleGraphNode -> Bool # (<=) :: ModuleGraphNode -> ModuleGraphNode -> Bool # (>) :: ModuleGraphNode -> ModuleGraphNode -> Bool # (>=) :: ModuleGraphNode -> ModuleGraphNode -> Bool # max :: ModuleGraphNode -> ModuleGraphNode -> ModuleGraphNode # min :: ModuleGraphNode -> ModuleGraphNode -> ModuleGraphNode # |
mgNodeDependencies :: Bool -> ModuleGraphNode -> [NodeKey] Source #
Collect the immediate dependencies of a ModuleGraphNode, optionally avoiding hs-boot dependencies. If the drop_hs_boot_nodes flag is False, and if this is a .hs and there is an equivalent .hs-boot, add a link from the former to the latter. This has the effect of detecting bogus cases where the .hs-boot depends on the .hs, by introducing a cycle. Additionally, it ensures that we will always process the .hs-boot before the .hs, and so the HomePackageTable will always have the most up to date information.
mgNodeUnitId :: ModuleGraphNode -> UnitId Source #
Module graph operations
lengthMG :: ModuleGraph -> Int Source #
Returns the number of nodes in a ModuleGraph
ModSummary
operations
A couple of operations on the module graph allow access to the
ModSummary
s of the modules in it contained.
In particular, mapMG
and mapMGM
allow updating these ModSummary
s
(without changing the ModuleGraph
structure itself!).
mgModSummaries
lists out all ModSummary
s, and
mgLookupModule
looks up a ModSummary
for a given module.
mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph Source #
Map a function f
over all the ModSummaries
.
To preserve invariants, f
can't change the isBoot status.
mgMapM :: (ModSummary -> IO ModSummary) -> ModuleGraph -> IO ModuleGraph Source #
Map a function f
over all the ModSummaries
, in IO
.
To preserve invariants, f
can't change the isBoot status.
mgModSummaries :: ModuleGraph -> [ModSummary] Source #
mgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary Source #
Look up a ModSummary in the ModuleGraph Looks up the non-boot ModSummary Linear in the size of the module graph
Reachability queries
A module graph explains the structure and relationship between the modules being compiled. Often times, this structure is relevant to answer reachability queries -- is X reachable from Y; or, what is the transitive closure of Z?
mgReachable :: ModuleGraph -> NodeKey -> Maybe [ModuleGraphNode] Source #
Return all nodes reachable from the given NodeKey
.
:: ModuleGraph | g |
-> NodeKey | a |
-> NodeKey | b |
-> Bool |
|
Reachability Query.
mgQuery(g, a, b)
asks:
Can we reach b
from a
in graph g
?
Both a
and b
must be in g
.
:: ModuleGraph | g |
-> [NodeKey] | roots |
-> NodeKey | b |
-> Bool |
|
Many roots reachability Query.
mgQuery(g, roots, b)
asks:
Can we reach b
from any of the roots
in graph g
?
Node b
must be in g
.
Other operations
These operations allow more-internal-than-ideal access to the ModuleGraph structure. Ideally, we could restructure the code using these functions to avoid deconstructing/reconstructing the ModuleGraph and instead extend the "proper interface" of the ModuleGraph to achieve what is currently done but through a better abstraction.
mgModSummaries' :: ModuleGraph -> [ModuleGraphNode] Source #
moduleGraphNodes :: Bool -> [ModuleGraphNode] -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode) Source #
Turn a list of graph nodes into an efficient queriable graph. The first boolean parameter indicates whether nodes corresponding to hs-boot files should be collapsed into their relevant hs nodes.
moduleGraphModulesBelow :: ModuleGraph -> UnitId -> ModuleNameWithIsBoot -> Set ModNodeKeyWithUid Source #
This function returns all the modules belonging to the home-unit that can be reached by following the given dependencies. Additionally, if both the boot module and the non-boot module can be reached, it only returns the non-boot one.
filterToposortToModules :: [SCC ModuleGraphNode] -> [SCC ModSummary] Source #
This function filters out all the instantiation nodes from each SCC of a topological sort. Use this with care, as the resulting "strongly connected components" may not really be strongly connected in a direct way, as instantiations have been removed. It would probably be best to eliminate uses of this function where possible.
Keys into the ModuleGraph
mkNodeKey :: ModuleGraphNode -> NodeKey Source #
nodeKeyUnitId :: NodeKey -> UnitId Source #
nodeKeyModName :: NodeKey -> Maybe ModuleName Source #
type ModNodeKey = ModuleNameWithIsBoot Source #
data ModNodeKeyWithUid Source #
Instances
Outputable ModNodeKeyWithUid Source # | |
Defined in GHC.Unit.Module.Graph ppr :: ModNodeKeyWithUid -> SDoc Source # | |
Eq ModNodeKeyWithUid Source # | |
Defined in GHC.Unit.Module.Graph (==) :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool # (/=) :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool # | |
Ord ModNodeKeyWithUid Source # | |
Defined in GHC.Unit.Module.Graph compare :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Ordering # (<) :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool # (<=) :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool # (>) :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool # (>=) :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool # max :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid # min :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid # |
msKey :: ModSummary -> ModNodeKeyWithUid Source #
Internal node representation
SummaryNode
is the internal representation for each node stored in
the graph. It's not immediately clear to me why users do depend on them.
type SummaryNode = Node Int ModuleGraphNode Source #
summaryNodeKey :: SummaryNode -> Int Source #
Utilities
showModMsg :: DynFlags -> Bool -> ModuleGraphNode -> SDoc Source #