{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveTraversable #-}

-- | 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
module GHC.Unit.Module.Graph
   (
    -- * Construct a module graph
    --
    -- | A module graph should be constructed once by downsweep and never modified.
     ModuleGraph
   , emptyMG
   , mkModuleGraph

    -- * 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 node
    -- - 'mgNodeUnitId' returns the 'UnitId' of that node
    -- - 'mgNodeModSum' extracts the 'ModSummary' of a node if exists
   , ModuleGraphNode(..)
   , mgNodeDependencies
   , mgNodeModSum
   , mgNodeUnitId

    -- * Module graph operations
   , lengthMG

    -- ** '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, mgMapM
   , mgModSummaries
   , mgLookupModule

    -- ** 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
   , mgQuery
   , mgQueryMany

    -- ** 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'
   , moduleGraphNodes
   , moduleGraphModulesBelow -- needed for 'hptSomeThingsBelowUs',
                             -- but I think we could be more clever and cache
                             -- the graph-ixs of boot modules to efficiently
                             -- filter them out of the returned list.
                             -- hptInstancesBelow is re-doing that work every
                             -- time it's called.
   , filterToposortToModules

    -- * Keys into the 'ModuleGraph'
   , NodeKey(..)
   , mkNodeKey
   , nodeKeyUnitId
   , nodeKeyModName
   , ModNodeKey
   , ModNodeKeyWithUid(..)
   , msKey

    -- ** 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.
   , SummaryNode
   , summaryNodeSummary
   , summaryNodeKey

    -- * Utilities
   , showModMsg
   )
where

import GHC.Prelude
import GHC.Platform

import GHC.Data.Maybe
import GHC.Data.Graph.Directed
import GHC.Data.Graph.Directed.Reachability

import GHC.Driver.Backend
import GHC.Driver.DynFlags

import GHC.Types.SourceFile ( hscSourceString )

import GHC.Unit.Module.ModSummary
import GHC.Unit.Types
import GHC.Utils.Outputable
import GHC.Utils.Misc ( partitionWith )

import System.FilePath
import qualified Data.Map as Map
import GHC.Types.Unique.DSet
import qualified Data.Set as Set
import Data.Set (Set)
import GHC.Unit.Module
import GHC.Linker.Static.Utils

import Data.Bifunctor
import Data.Function
import Data.List (sort)
import Control.Monad

-- | 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
-- 'GHC.topSortModuleGraph' and 'GHC.Data.Graph.Directed.flattenSCC' to achieve this.
data ModuleGraph = ModuleGraph
  { ModuleGraph -> [ModuleGraphNode]
mg_mss :: [ModuleGraphNode]
  , ModuleGraph
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_graph :: (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
    -- A cached transitive dependency calculation so that a lot of work is not
    -- repeated whenever the transitive dependencies need to be calculated (for example, hptInstances)
  }

-- | Why do we ever need to construct empty graphs? Is it because of one shot mode?
emptyMG :: ModuleGraph
emptyMG :: ModuleGraph
emptyMG = [ModuleGraphNode]
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
-> ModuleGraph
ModuleGraph [] (Graph SummaryNode -> ReachabilityIndex SummaryNode
forall node. Graph node -> ReachabilityIndex node
graphReachability Graph SummaryNode
forall a. Graph a
emptyGraph, Maybe SummaryNode -> NodeKey -> Maybe SummaryNode
forall a b. a -> b -> a
const Maybe SummaryNode
forall a. Maybe a
Nothing)

-- | 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.
mkModuleGraph :: [ModuleGraphNode] -> ModuleGraph
mkModuleGraph :: [ModuleGraphNode] -> ModuleGraph
mkModuleGraph = (ModuleGraphNode -> ModuleGraph -> ModuleGraph)
-> ModuleGraph -> [ModuleGraphNode] -> ModuleGraph
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((ModuleGraph -> ModuleGraphNode -> ModuleGraph)
-> ModuleGraphNode -> ModuleGraph -> ModuleGraph
forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleGraph -> ModuleGraphNode -> ModuleGraph
extendMG') ModuleGraph
emptyMG

--------------------------------------------------------------------------------
-- * Module Graph Nodes
--------------------------------------------------------------------------------

-- | A '@ModuleGraphNode@' is a node in the '@ModuleGraph@'.
-- Edges between nodes mark dependencies arising from module imports
-- and dependencies arising from backpack instantiations.
data ModuleGraphNode
  -- | Instantiation nodes track the instantiation of other units
  -- (backpack dependencies) with the holes (signatures) of the current package.
  = InstantiationNode UnitId InstantiatedUnit
  -- | There is a module summary node for each module, signature, and boot module being built.
  | ModuleNode [NodeKey] ModSummary
  -- | Link nodes are whether are are creating a linked product (ie executable/shared object etc) for a unit.
  | LinkNode [NodeKey] UnitId

-- | 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.
mgNodeDependencies :: Bool -> ModuleGraphNode -> [NodeKey]
mgNodeDependencies :: Bool -> ModuleGraphNode -> [NodeKey]
mgNodeDependencies Bool
drop_hs_boot_nodes = \case
    LinkNode [NodeKey]
deps UnitId
_uid -> [NodeKey]
deps
    InstantiationNode UnitId
uid InstantiatedUnit
iuid ->
      ModNodeKeyWithUid -> NodeKey
NodeKey_Module (ModNodeKeyWithUid -> NodeKey)
-> (ModuleName -> ModNodeKeyWithUid) -> ModuleName -> NodeKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ModuleName
mod -> ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
ModNodeKeyWithUid (ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB ModuleName
mod IsBootInterface
NotBoot) UnitId
uid)  (ModuleName -> NodeKey) -> [ModuleName] -> [NodeKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqDSet ModuleName -> [ModuleName]
forall a. UniqDSet a -> [a]
uniqDSetToList (InstantiatedUnit -> UniqDSet ModuleName
forall unit. GenInstantiatedUnit unit -> UniqDSet ModuleName
instUnitHoles InstantiatedUnit
iuid)
    ModuleNode [NodeKey]
deps ModSummary
_ms ->
      (NodeKey -> NodeKey) -> [NodeKey] -> [NodeKey]
forall a b. (a -> b) -> [a] -> [b]
map NodeKey -> NodeKey
drop_hs_boot [NodeKey]
deps
  where
    -- Drop hs-boot nodes by using HsSrcFile as the key
    hs_boot_key :: IsBootInterface
hs_boot_key | Bool
drop_hs_boot_nodes = IsBootInterface
NotBoot -- is regular mod or signature
                | Bool
otherwise          = IsBootInterface
IsBoot

    drop_hs_boot :: NodeKey -> NodeKey
drop_hs_boot (NodeKey_Module (ModNodeKeyWithUid (GWIB ModuleName
mn IsBootInterface
IsBoot) UnitId
uid)) = (ModNodeKeyWithUid -> NodeKey
NodeKey_Module (ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
ModNodeKeyWithUid (ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
GWIB ModuleName
mn IsBootInterface
hs_boot_key) UnitId
uid))
    drop_hs_boot NodeKey
x = NodeKey
x

mgNodeModSum :: ModuleGraphNode -> Maybe ModSummary
mgNodeModSum :: ModuleGraphNode -> Maybe ModSummary
mgNodeModSum (InstantiationNode {}) = Maybe ModSummary
forall a. Maybe a
Nothing
mgNodeModSum (LinkNode {})          = Maybe ModSummary
forall a. Maybe a
Nothing
mgNodeModSum (ModuleNode [NodeKey]
_ ModSummary
ms)      = ModSummary -> Maybe ModSummary
forall a. a -> Maybe a
Just ModSummary
ms

mgNodeUnitId :: ModuleGraphNode -> UnitId
mgNodeUnitId :: ModuleGraphNode -> UnitId
mgNodeUnitId ModuleGraphNode
mgn =
  case ModuleGraphNode
mgn of
    InstantiationNode UnitId
uid InstantiatedUnit
_iud -> UnitId
uid
    ModuleNode [NodeKey]
_ ModSummary
ms           -> GenUnit UnitId -> UnitId
toUnitId (Module -> GenUnit UnitId
forall unit. GenModule unit -> unit
moduleUnit (ModSummary -> Module
ms_mod ModSummary
ms))
    LinkNode [NodeKey]
_ UnitId
uid             -> UnitId
uid

instance Outputable ModuleGraphNode where
  ppr :: ModuleGraphNode -> SDoc
ppr = \case
    InstantiationNode UnitId
_ InstantiatedUnit
iuid -> InstantiatedUnit -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstantiatedUnit
iuid
    ModuleNode [NodeKey]
nks ModSummary
ms -> ModNodeKeyWithUid -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModSummary -> ModNodeKeyWithUid
msKey ModSummary
ms) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [NodeKey] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [NodeKey]
nks
    LinkNode [NodeKey]
uid UnitId
_     -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LN:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [NodeKey] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [NodeKey]
uid

instance Eq ModuleGraphNode where
  == :: ModuleGraphNode -> ModuleGraphNode -> Bool
(==) = NodeKey -> NodeKey -> Bool
forall a. Eq a => a -> a -> Bool
(==) (NodeKey -> NodeKey -> Bool)
-> (ModuleGraphNode -> NodeKey)
-> ModuleGraphNode
-> ModuleGraphNode
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ModuleGraphNode -> NodeKey
mkNodeKey

instance Ord ModuleGraphNode where
  compare :: ModuleGraphNode -> ModuleGraphNode -> Ordering
compare = NodeKey -> NodeKey -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (NodeKey -> NodeKey -> Ordering)
-> (ModuleGraphNode -> NodeKey)
-> ModuleGraphNode
-> ModuleGraphNode
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ModuleGraphNode -> NodeKey
mkNodeKey

--------------------------------------------------------------------------------
-- * Module Graph operations
--------------------------------------------------------------------------------

-- | Returns the number of nodes in a 'ModuleGraph'
lengthMG :: ModuleGraph -> Int
lengthMG :: ModuleGraph -> Int
lengthMG = [ModuleGraphNode] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ModuleGraphNode] -> Int)
-> (ModuleGraph -> [ModuleGraphNode]) -> ModuleGraph -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleGraph -> [ModuleGraphNode]
mg_mss

--------------------------------------------------------------------------------
-- ** ModSummaries
--------------------------------------------------------------------------------

-- | Map a function 'f' over all the 'ModSummaries'.
-- To preserve invariants, 'f' can't change the isBoot status.
mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
mapMG ModSummary -> ModSummary
f mg :: ModuleGraph
mg@ModuleGraph{[ModuleGraphNode]
(ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_mss :: ModuleGraph -> [ModuleGraphNode]
mg_graph :: ModuleGraph
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_mss :: [ModuleGraphNode]
mg_graph :: (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
..} = ModuleGraph
mg
  { mg_mss = flip fmap mg_mss $ \case
      InstantiationNode UnitId
uid InstantiatedUnit
iuid -> UnitId -> InstantiatedUnit -> ModuleGraphNode
InstantiationNode UnitId
uid InstantiatedUnit
iuid
      LinkNode [NodeKey]
uid UnitId
nks -> [NodeKey] -> UnitId -> ModuleGraphNode
LinkNode [NodeKey]
uid UnitId
nks
      ModuleNode [NodeKey]
deps ModSummary
ms  -> [NodeKey] -> ModSummary -> ModuleGraphNode
ModuleNode [NodeKey]
deps (ModSummary -> ModSummary
f ModSummary
ms)
  }

-- | Map a function 'f' over all the 'ModSummaries', in 'IO'.
-- To preserve invariants, 'f' can't change the isBoot status.
mgMapM :: (ModSummary -> IO ModSummary) -> ModuleGraph -> IO ModuleGraph
mgMapM :: (ModSummary -> IO ModSummary) -> ModuleGraph -> IO ModuleGraph
mgMapM ModSummary -> IO ModSummary
f mg :: ModuleGraph
mg@ModuleGraph{[ModuleGraphNode]
(ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_mss :: ModuleGraph -> [ModuleGraphNode]
mg_graph :: ModuleGraph
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_mss :: [ModuleGraphNode]
mg_graph :: (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
..} = do
  mss' <- [ModuleGraphNode]
-> (ModuleGraphNode -> IO ModuleGraphNode) -> IO [ModuleGraphNode]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ModuleGraphNode]
mg_mss ((ModuleGraphNode -> IO ModuleGraphNode) -> IO [ModuleGraphNode])
-> (ModuleGraphNode -> IO ModuleGraphNode) -> IO [ModuleGraphNode]
forall a b. (a -> b) -> a -> b
$ \case
    InstantiationNode UnitId
uid InstantiatedUnit
iuid -> ModuleGraphNode -> IO ModuleGraphNode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleGraphNode -> IO ModuleGraphNode)
-> ModuleGraphNode -> IO ModuleGraphNode
forall a b. (a -> b) -> a -> b
$ UnitId -> InstantiatedUnit -> ModuleGraphNode
InstantiationNode UnitId
uid InstantiatedUnit
iuid
    LinkNode [NodeKey]
uid UnitId
nks -> ModuleGraphNode -> IO ModuleGraphNode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleGraphNode -> IO ModuleGraphNode)
-> ModuleGraphNode -> IO ModuleGraphNode
forall a b. (a -> b) -> a -> b
$ [NodeKey] -> UnitId -> ModuleGraphNode
LinkNode [NodeKey]
uid UnitId
nks
    ModuleNode [NodeKey]
deps ModSummary
ms  -> [NodeKey] -> ModSummary -> ModuleGraphNode
ModuleNode [NodeKey]
deps (ModSummary -> ModuleGraphNode)
-> IO ModSummary -> IO ModuleGraphNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModSummary -> IO ModSummary
f ModSummary
ms)
  return mg
    { mg_mss = mss'
    }

mgModSummaries :: ModuleGraph -> [ModSummary]
mgModSummaries :: ModuleGraph -> [ModSummary]
mgModSummaries ModuleGraph
mg = [ ModSummary
m | ModuleNode [NodeKey]
_ ModSummary
m <- ModuleGraph -> [ModuleGraphNode]
mgModSummaries' ModuleGraph
mg ]

-- | Look up a ModSummary in the ModuleGraph
-- Looks up the non-boot ModSummary
-- Linear in the size of the module graph
mgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary
mgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary
mgLookupModule ModuleGraph{[ModuleGraphNode]
(ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_mss :: ModuleGraph -> [ModuleGraphNode]
mg_graph :: ModuleGraph
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_mss :: [ModuleGraphNode]
mg_graph :: (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
..} Module
m = [ModSummary] -> Maybe ModSummary
forall a. [a] -> Maybe a
listToMaybe ([ModSummary] -> Maybe ModSummary)
-> [ModSummary] -> Maybe ModSummary
forall a b. (a -> b) -> a -> b
$ (ModuleGraphNode -> Maybe ModSummary)
-> [ModuleGraphNode] -> [ModSummary]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ModuleGraphNode -> Maybe ModSummary
go [ModuleGraphNode]
mg_mss
  where
    go :: ModuleGraphNode -> Maybe ModSummary
go (ModuleNode [NodeKey]
_ ModSummary
ms)
      | IsBootInterface
NotBoot <- ModSummary -> IsBootInterface
isBootSummary ModSummary
ms
      , ModSummary -> Module
ms_mod ModSummary
ms Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
m
      = ModSummary -> Maybe ModSummary
forall a. a -> Maybe a
Just ModSummary
ms
    go ModuleGraphNode
_ = Maybe ModSummary
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- ** Reachability
--------------------------------------------------------------------------------

-- | Return all nodes reachable from the given 'NodeKey'.
mgReachable :: ModuleGraph -> NodeKey -> Maybe [ModuleGraphNode]
mgReachable :: ModuleGraph -> NodeKey -> Maybe [ModuleGraphNode]
mgReachable ModuleGraph
mg NodeKey
nk = (SummaryNode -> ModuleGraphNode)
-> [SummaryNode] -> [ModuleGraphNode]
forall a b. (a -> b) -> [a] -> [b]
map SummaryNode -> ModuleGraphNode
summaryNodeSummary ([SummaryNode] -> [ModuleGraphNode])
-> Maybe [SummaryNode] -> Maybe [ModuleGraphNode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [SummaryNode]
modules_below where
  (ReachabilityIndex SummaryNode
td_map, NodeKey -> Maybe SummaryNode
lookup_node) = ModuleGraph
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_graph ModuleGraph
mg
  modules_below :: Maybe [SummaryNode]
modules_below =
    ReachabilityIndex SummaryNode -> SummaryNode -> [SummaryNode]
forall node. ReachabilityIndex node -> node -> [node]
allReachable ReachabilityIndex SummaryNode
td_map (SummaryNode -> [SummaryNode])
-> Maybe SummaryNode -> Maybe [SummaryNode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeKey -> Maybe SummaryNode
lookup_node NodeKey
nk

-- | Reachability Query.
--
-- @mgQuery(g, a, b)@ asks:
-- Can we reach @b@ from @a@ in graph @g@?
--
-- Both @a@ and @b@ must be in @g@.
mgQuery :: ModuleGraph -- ^ @g@
        -> NodeKey -- ^ @a@
        -> NodeKey -- ^ @b@
        -> Bool -- ^ @b@ is reachable from @a@
mgQuery :: ModuleGraph -> NodeKey -> NodeKey -> Bool
mgQuery ModuleGraph
mg NodeKey
nka NodeKey
nkb = ReachabilityIndex SummaryNode -> SummaryNode -> SummaryNode -> Bool
forall node. ReachabilityIndex node -> node -> node -> Bool
isReachable ReachabilityIndex SummaryNode
td_map SummaryNode
na SummaryNode
nb where
  (ReachabilityIndex SummaryNode
td_map, NodeKey -> Maybe SummaryNode
lookup_node) = ModuleGraph
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_graph ModuleGraph
mg
  na :: SummaryNode
na = String -> Maybe SummaryNode -> SummaryNode
forall a. HasDebugCallStack => String -> Maybe a -> a
expectJust String
"mgQuery:a" (Maybe SummaryNode -> SummaryNode)
-> Maybe SummaryNode -> SummaryNode
forall a b. (a -> b) -> a -> b
$ NodeKey -> Maybe SummaryNode
lookup_node NodeKey
nka
  nb :: SummaryNode
nb = String -> Maybe SummaryNode -> SummaryNode
forall a. HasDebugCallStack => String -> Maybe a -> a
expectJust String
"mgQuery:b" (Maybe SummaryNode -> SummaryNode)
-> Maybe SummaryNode -> SummaryNode
forall a b. (a -> b) -> a -> b
$ NodeKey -> Maybe SummaryNode
lookup_node NodeKey
nkb

-- | 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@.
mgQueryMany :: ModuleGraph -- ^ @g@
            -> [NodeKey] -- ^ @roots@
            -> NodeKey -- ^ @b@
            -> Bool -- ^ @b@ is reachable from @roots@
mgQueryMany :: ModuleGraph -> [NodeKey] -> NodeKey -> Bool
mgQueryMany ModuleGraph
mg [NodeKey]
roots NodeKey
nkb = ReachabilityIndex SummaryNode
-> [SummaryNode] -> SummaryNode -> Bool
forall node. ReachabilityIndex node -> [node] -> node -> Bool
isReachableMany ReachabilityIndex SummaryNode
td_map [SummaryNode]
nroots SummaryNode
nb where
  (ReachabilityIndex SummaryNode
td_map, NodeKey -> Maybe SummaryNode
lookup_node) = ModuleGraph
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_graph ModuleGraph
mg
  nroots :: [SummaryNode]
nroots = (NodeKey -> Maybe SummaryNode) -> [NodeKey] -> [SummaryNode]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NodeKey -> Maybe SummaryNode
lookup_node [NodeKey]
roots
  nb :: SummaryNode
nb = String -> Maybe SummaryNode -> SummaryNode
forall a. HasDebugCallStack => String -> Maybe a -> a
expectJust String
"mgQuery:b" (Maybe SummaryNode -> SummaryNode)
-> Maybe SummaryNode -> SummaryNode
forall a b. (a -> b) -> a -> b
$ NodeKey -> Maybe SummaryNode
lookup_node NodeKey
nkb

--------------------------------------------------------------------------------
-- ** Other operations (read haddocks on export list)
--------------------------------------------------------------------------------

mgModSummaries' :: ModuleGraph -> [ModuleGraphNode]
mgModSummaries' :: ModuleGraph -> [ModuleGraphNode]
mgModSummaries' = ModuleGraph -> [ModuleGraphNode]
mg_mss

-- | 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.
moduleGraphNodes :: Bool
  -> [ModuleGraphNode]
  -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
moduleGraphNodes :: Bool
-> [ModuleGraphNode]
-> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
moduleGraphNodes Bool
drop_hs_boot_nodes [ModuleGraphNode]
summaries =
  ([SummaryNode] -> Graph SummaryNode
forall key payload.
Uniquable key =>
[Node key payload] -> Graph (Node key payload)
graphFromEdgedVerticesUniq [SummaryNode]
nodes, NodeKey -> Maybe SummaryNode
lookup_node)
  where
    -- Map from module to extra boot summary dependencies which need to be merged in
    (Map Module [NodeKey]
boot_summaries, [SummaryNode]
nodes) = ([(Module, [NodeKey])] -> Map Module [NodeKey])
-> ([SummaryNode] -> [SummaryNode])
-> ([(Module, [NodeKey])], [SummaryNode])
-> (Map Module [NodeKey], [SummaryNode])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [(Module, [NodeKey])] -> Map Module [NodeKey]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [SummaryNode] -> [SummaryNode]
forall a. a -> a
id (([(Module, [NodeKey])], [SummaryNode])
 -> (Map Module [NodeKey], [SummaryNode]))
-> ([(Module, [NodeKey])], [SummaryNode])
-> (Map Module [NodeKey], [SummaryNode])
forall a b. (a -> b) -> a -> b
$ ((ModuleGraphNode, Int) -> Either (Module, [NodeKey]) SummaryNode)
-> [(ModuleGraphNode, Int)]
-> ([(Module, [NodeKey])], [SummaryNode])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith (ModuleGraphNode, Int) -> Either (Module, [NodeKey]) SummaryNode
go [(ModuleGraphNode, Int)]
numbered_summaries

      where
        go :: (ModuleGraphNode, Int) -> Either (Module, [NodeKey]) SummaryNode
go (ModuleGraphNode
s, Int
key) =
          case ModuleGraphNode
s of
                ModuleNode [NodeKey]
__deps ModSummary
ms | ModSummary -> IsBootInterface
isBootSummary ModSummary
ms IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot, Bool
drop_hs_boot_nodes
                  -- Using nodeDependencies here converts dependencies on other
                  -- boot files to dependencies on dependencies on non-boot files.
                  -> (Module, [NodeKey]) -> Either (Module, [NodeKey]) SummaryNode
forall a b. a -> Either a b
Left (ModSummary -> Module
ms_mod ModSummary
ms, Bool -> ModuleGraphNode -> [NodeKey]
mgNodeDependencies Bool
drop_hs_boot_nodes ModuleGraphNode
s)
                ModuleGraphNode
_ -> Either (Module, [NodeKey]) SummaryNode
normal_case
          where
           normal_case :: Either (Module, [NodeKey]) SummaryNode
normal_case =
              let lkup_key :: Maybe Module
lkup_key = ModSummary -> Module
ms_mod (ModSummary -> Module) -> Maybe ModSummary -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleGraphNode -> Maybe ModSummary
mgNodeModSum ModuleGraphNode
s
                  extra :: Maybe [NodeKey]
extra = (Maybe Module
lkup_key Maybe Module -> (Module -> Maybe [NodeKey]) -> Maybe [NodeKey]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Module
key -> Module -> Map Module [NodeKey] -> Maybe [NodeKey]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Module
key Map Module [NodeKey]
boot_summaries)

              in SummaryNode -> Either (Module, [NodeKey]) SummaryNode
forall a b. b -> Either a b
Right (SummaryNode -> Either (Module, [NodeKey]) SummaryNode)
-> SummaryNode -> Either (Module, [NodeKey]) SummaryNode
forall a b. (a -> b) -> a -> b
$ ModuleGraphNode -> Int -> [Int] -> SummaryNode
forall key payload. payload -> key -> [key] -> Node key payload
DigraphNode ModuleGraphNode
s Int
key ([Int] -> SummaryNode) -> [Int] -> SummaryNode
forall a b. (a -> b) -> a -> b
$ [NodeKey] -> [Int]
out_edge_keys ([NodeKey] -> [Int]) -> [NodeKey] -> [Int]
forall a b. (a -> b) -> a -> b
$
                      ([NodeKey] -> Maybe [NodeKey] -> [NodeKey]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [NodeKey]
extra
                        [NodeKey] -> [NodeKey] -> [NodeKey]
forall a. [a] -> [a] -> [a]
++ Bool -> ModuleGraphNode -> [NodeKey]
mgNodeDependencies Bool
drop_hs_boot_nodes ModuleGraphNode
s)

    numbered_summaries :: [(ModuleGraphNode, Int)]
numbered_summaries = [ModuleGraphNode] -> [Int] -> [(ModuleGraphNode, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ModuleGraphNode]
summaries [Int
1..]

    lookup_node :: NodeKey -> Maybe SummaryNode
    lookup_node :: NodeKey -> Maybe SummaryNode
lookup_node NodeKey
key = NodeKey -> Map NodeKey SummaryNode -> Maybe SummaryNode
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NodeKey
key (NodeMap SummaryNode -> Map NodeKey SummaryNode
forall a. NodeMap a -> Map NodeKey a
unNodeMap NodeMap SummaryNode
node_map)

    lookup_key :: NodeKey -> Maybe Int
    lookup_key :: NodeKey -> Maybe Int
lookup_key = (SummaryNode -> Int) -> Maybe SummaryNode -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SummaryNode -> Int
summaryNodeKey (Maybe SummaryNode -> Maybe Int)
-> (NodeKey -> Maybe SummaryNode) -> NodeKey -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeKey -> Maybe SummaryNode
lookup_node

    node_map :: NodeMap SummaryNode
    node_map :: NodeMap SummaryNode
node_map = Map NodeKey SummaryNode -> NodeMap SummaryNode
forall a. Map NodeKey a -> NodeMap a
NodeMap (Map NodeKey SummaryNode -> NodeMap SummaryNode)
-> Map NodeKey SummaryNode -> NodeMap SummaryNode
forall a b. (a -> b) -> a -> b
$
      [(NodeKey, SummaryNode)] -> Map NodeKey SummaryNode
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (ModuleGraphNode -> NodeKey
mkNodeKey ModuleGraphNode
s, SummaryNode
node)
                   | SummaryNode
node <- [SummaryNode]
nodes
                   , let s :: ModuleGraphNode
s = SummaryNode -> ModuleGraphNode
summaryNodeSummary SummaryNode
node
                   ]

    out_edge_keys :: [NodeKey] -> [Int]
    out_edge_keys :: [NodeKey] -> [Int]
out_edge_keys = (NodeKey -> Maybe Int) -> [NodeKey] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NodeKey -> Maybe Int
lookup_key
        -- If we want keep_hi_boot_nodes, then we do lookup_key with
        -- IsBoot; else False

-- | 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.
moduleGraphModulesBelow :: ModuleGraph -> UnitId -> ModuleNameWithIsBoot -> Set ModNodeKeyWithUid
moduleGraphModulesBelow :: ModuleGraph
-> UnitId -> ModuleNameWithIsBoot -> Set ModNodeKeyWithUid
moduleGraphModulesBelow ModuleGraph
mg UnitId
uid ModuleNameWithIsBoot
mn = [ModNodeKeyWithUid] -> Set ModNodeKeyWithUid
filtered_mods [ ModNodeKeyWithUid
mn | NodeKey_Module ModNodeKeyWithUid
mn <- [NodeKey]
modules_below ]
  where
    modules_below :: [NodeKey]
modules_below = [NodeKey]
-> ([ModuleGraphNode] -> [NodeKey])
-> Maybe [ModuleGraphNode]
-> [NodeKey]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((ModuleGraphNode -> NodeKey) -> [ModuleGraphNode] -> [NodeKey]
forall a b. (a -> b) -> [a] -> [b]
map ModuleGraphNode -> NodeKey
mkNodeKey) (ModuleGraph -> NodeKey -> Maybe [ModuleGraphNode]
mgReachable ModuleGraph
mg (ModNodeKeyWithUid -> NodeKey
NodeKey_Module (ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
ModNodeKeyWithUid ModuleNameWithIsBoot
mn UnitId
uid)))
    filtered_mods :: [ModNodeKeyWithUid] -> Set ModNodeKeyWithUid
filtered_mods = [ModNodeKeyWithUid] -> Set ModNodeKeyWithUid
forall a. [a] -> Set a
Set.fromDistinctAscList ([ModNodeKeyWithUid] -> Set ModNodeKeyWithUid)
-> ([ModNodeKeyWithUid] -> [ModNodeKeyWithUid])
-> [ModNodeKeyWithUid]
-> Set ModNodeKeyWithUid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModNodeKeyWithUid] -> [ModNodeKeyWithUid]
filter_mods ([ModNodeKeyWithUid] -> [ModNodeKeyWithUid])
-> ([ModNodeKeyWithUid] -> [ModNodeKeyWithUid])
-> [ModNodeKeyWithUid]
-> [ModNodeKeyWithUid]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModNodeKeyWithUid] -> [ModNodeKeyWithUid]
forall a. Ord a => [a] -> [a]
sort

    -- IsBoot and NotBoot modules are necessarily consecutive in the sorted list
    -- (cf Ord instance of GenWithIsBoot). Hence we only have to perform a
    -- linear sweep with a window of size 2 to remove boot modules for which we
    -- have the corresponding non-boot.
    filter_mods :: [ModNodeKeyWithUid] -> [ModNodeKeyWithUid]
filter_mods = \case
      (r1 :: ModNodeKeyWithUid
r1@(ModNodeKeyWithUid (GWIB ModuleName
m1 IsBootInterface
b1) UnitId
uid1) : r2 :: ModNodeKeyWithUid
r2@(ModNodeKeyWithUid (GWIB ModuleName
m2 IsBootInterface
_) UnitId
uid2): [ModNodeKeyWithUid]
rs)
        | ModuleName
m1 ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
m2  Bool -> Bool -> Bool
&& UnitId
uid1 UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
uid2 ->
                       let !r' :: ModNodeKeyWithUid
r' = case IsBootInterface
b1 of
                                  IsBootInterface
NotBoot -> ModNodeKeyWithUid
r1
                                  IsBootInterface
IsBoot  -> ModNodeKeyWithUid
r2
                       in ModNodeKeyWithUid
r' ModNodeKeyWithUid -> [ModNodeKeyWithUid] -> [ModNodeKeyWithUid]
forall a. a -> [a] -> [a]
: [ModNodeKeyWithUid] -> [ModNodeKeyWithUid]
filter_mods [ModNodeKeyWithUid]
rs
        | Bool
otherwise -> ModNodeKeyWithUid
r1 ModNodeKeyWithUid -> [ModNodeKeyWithUid] -> [ModNodeKeyWithUid]
forall a. a -> [a] -> [a]
: [ModNodeKeyWithUid] -> [ModNodeKeyWithUid]
filter_mods (ModNodeKeyWithUid
r2ModNodeKeyWithUid -> [ModNodeKeyWithUid] -> [ModNodeKeyWithUid]
forall a. a -> [a] -> [a]
:[ModNodeKeyWithUid]
rs)
      [ModNodeKeyWithUid]
rs -> [ModNodeKeyWithUid]
rs

-- | 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.
filterToposortToModules
  :: [SCC ModuleGraphNode] -> [SCC ModSummary]
filterToposortToModules :: [SCC ModuleGraphNode] -> [SCC ModSummary]
filterToposortToModules = (SCC ModuleGraphNode -> Maybe (SCC ModSummary))
-> [SCC ModuleGraphNode] -> [SCC ModSummary]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((SCC ModuleGraphNode -> Maybe (SCC ModSummary))
 -> [SCC ModuleGraphNode] -> [SCC ModSummary])
-> (SCC ModuleGraphNode -> Maybe (SCC ModSummary))
-> [SCC ModuleGraphNode]
-> [SCC ModSummary]
forall a b. (a -> b) -> a -> b
$ (ModuleGraphNode -> Maybe ModSummary)
-> SCC ModuleGraphNode -> Maybe (SCC ModSummary)
forall a b. (a -> Maybe b) -> SCC a -> Maybe (SCC b)
mapMaybeSCC ((ModuleGraphNode -> Maybe ModSummary)
 -> SCC ModuleGraphNode -> Maybe (SCC ModSummary))
-> (ModuleGraphNode -> Maybe ModSummary)
-> SCC ModuleGraphNode
-> Maybe (SCC ModSummary)
forall a b. (a -> b) -> a -> b
$ \case
  InstantiationNode UnitId
_ InstantiatedUnit
_ -> Maybe ModSummary
forall a. Maybe a
Nothing
  LinkNode{} -> Maybe ModSummary
forall a. Maybe a
Nothing
  ModuleNode [NodeKey]
_deps ModSummary
node -> ModSummary -> Maybe ModSummary
forall a. a -> Maybe a
Just ModSummary
node
  where
    -- This higher order function is somewhat bogus,
    -- as the definition of "strongly connected component"
    -- is not necessarily respected.
    mapMaybeSCC :: (a -> Maybe b) -> SCC a -> Maybe (SCC b)
    mapMaybeSCC :: forall a b. (a -> Maybe b) -> SCC a -> Maybe (SCC b)
mapMaybeSCC a -> Maybe b
f = \case
      AcyclicSCC a
a -> b -> SCC b
forall vertex. vertex -> SCC vertex
AcyclicSCC (b -> SCC b) -> Maybe b -> Maybe (SCC b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe b
f a
a
      CyclicSCC [a]
as -> case (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [a]
as of
        [] -> Maybe (SCC b)
forall a. Maybe a
Nothing
        [b
a] -> SCC b -> Maybe (SCC b)
forall a. a -> Maybe a
Just (SCC b -> Maybe (SCC b)) -> SCC b -> Maybe (SCC b)
forall a b. (a -> b) -> a -> b
$ b -> SCC b
forall vertex. vertex -> SCC vertex
AcyclicSCC b
a
        [b]
as -> SCC b -> Maybe (SCC b)
forall a. a -> Maybe a
Just (SCC b -> Maybe (SCC b)) -> SCC b -> Maybe (SCC b)
forall a b. (a -> b) -> a -> b
$ [b] -> SCC b
forall vertex. [vertex] -> SCC vertex
CyclicSCC [b]
as

--------------------------------------------------------------------------------
-- * Keys into ModuleGraph
--------------------------------------------------------------------------------

data NodeKey = NodeKey_Unit {-# UNPACK #-} !InstantiatedUnit
             | NodeKey_Module {-# UNPACK #-} !ModNodeKeyWithUid
             | NodeKey_Link !UnitId
  deriving (NodeKey -> NodeKey -> Bool
(NodeKey -> NodeKey -> Bool)
-> (NodeKey -> NodeKey -> Bool) -> Eq NodeKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeKey -> NodeKey -> Bool
== :: NodeKey -> NodeKey -> Bool
$c/= :: NodeKey -> NodeKey -> Bool
/= :: NodeKey -> NodeKey -> Bool
Eq, Eq NodeKey
Eq NodeKey =>
(NodeKey -> NodeKey -> Ordering)
-> (NodeKey -> NodeKey -> Bool)
-> (NodeKey -> NodeKey -> Bool)
-> (NodeKey -> NodeKey -> Bool)
-> (NodeKey -> NodeKey -> Bool)
-> (NodeKey -> NodeKey -> NodeKey)
-> (NodeKey -> NodeKey -> NodeKey)
-> Ord NodeKey
NodeKey -> NodeKey -> Bool
NodeKey -> NodeKey -> Ordering
NodeKey -> NodeKey -> NodeKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NodeKey -> NodeKey -> Ordering
compare :: NodeKey -> NodeKey -> Ordering
$c< :: NodeKey -> NodeKey -> Bool
< :: NodeKey -> NodeKey -> Bool
$c<= :: NodeKey -> NodeKey -> Bool
<= :: NodeKey -> NodeKey -> Bool
$c> :: NodeKey -> NodeKey -> Bool
> :: NodeKey -> NodeKey -> Bool
$c>= :: NodeKey -> NodeKey -> Bool
>= :: NodeKey -> NodeKey -> Bool
$cmax :: NodeKey -> NodeKey -> NodeKey
max :: NodeKey -> NodeKey -> NodeKey
$cmin :: NodeKey -> NodeKey -> NodeKey
min :: NodeKey -> NodeKey -> NodeKey
Ord)

instance Outputable NodeKey where
  ppr :: NodeKey -> SDoc
ppr (NodeKey_Unit InstantiatedUnit
iu)   = InstantiatedUnit -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstantiatedUnit
iu
  ppr (NodeKey_Module ModNodeKeyWithUid
mk) = ModNodeKeyWithUid -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModNodeKeyWithUid
mk
  ppr (NodeKey_Link UnitId
uid)  = UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid

mkNodeKey :: ModuleGraphNode -> NodeKey
mkNodeKey :: ModuleGraphNode -> NodeKey
mkNodeKey = \case
  InstantiationNode UnitId
_ InstantiatedUnit
iu -> InstantiatedUnit -> NodeKey
NodeKey_Unit InstantiatedUnit
iu
  ModuleNode [NodeKey]
_ ModSummary
x -> ModNodeKeyWithUid -> NodeKey
NodeKey_Module (ModNodeKeyWithUid -> NodeKey) -> ModNodeKeyWithUid -> NodeKey
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModNodeKeyWithUid
msKey ModSummary
x
  LinkNode [NodeKey]
_ UnitId
uid   -> UnitId -> NodeKey
NodeKey_Link UnitId
uid

nodeKeyUnitId :: NodeKey -> UnitId
nodeKeyUnitId :: NodeKey -> UnitId
nodeKeyUnitId (NodeKey_Unit InstantiatedUnit
iu)   = InstantiatedUnit -> UnitId
forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf InstantiatedUnit
iu
nodeKeyUnitId (NodeKey_Module ModNodeKeyWithUid
mk) = ModNodeKeyWithUid -> UnitId
mnkUnitId ModNodeKeyWithUid
mk
nodeKeyUnitId (NodeKey_Link UnitId
uid)  = UnitId
uid

nodeKeyModName :: NodeKey -> Maybe ModuleName
nodeKeyModName :: NodeKey -> Maybe ModuleName
nodeKeyModName (NodeKey_Module ModNodeKeyWithUid
mk) = ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleNameWithIsBoot -> ModuleName
forall mod. GenWithIsBoot mod -> mod
gwib_mod (ModuleNameWithIsBoot -> ModuleName)
-> ModuleNameWithIsBoot -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModNodeKeyWithUid -> ModuleNameWithIsBoot
mnkModuleName ModNodeKeyWithUid
mk)
nodeKeyModName NodeKey
_ = Maybe ModuleName
forall a. Maybe a
Nothing

type ModNodeKey = ModuleNameWithIsBoot
data ModNodeKeyWithUid = ModNodeKeyWithUid { ModNodeKeyWithUid -> ModuleNameWithIsBoot
mnkModuleName :: !ModuleNameWithIsBoot
                                           , ModNodeKeyWithUid -> UnitId
mnkUnitId     :: !UnitId } deriving (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
(ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> Eq ModNodeKeyWithUid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
== :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
$c/= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
/= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
Eq, Eq ModNodeKeyWithUid
Eq ModNodeKeyWithUid =>
(ModNodeKeyWithUid -> ModNodeKeyWithUid -> Ordering)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid)
-> (ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid)
-> Ord ModNodeKeyWithUid
ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
ModNodeKeyWithUid -> ModNodeKeyWithUid -> Ordering
ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Ordering
compare :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Ordering
$c< :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
< :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
$c<= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
<= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
$c> :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
> :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
$c>= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
>= :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> Bool
$cmax :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid
max :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid
$cmin :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid
min :: ModNodeKeyWithUid -> ModNodeKeyWithUid -> ModNodeKeyWithUid
Ord)

instance Outputable ModNodeKeyWithUid where
  ppr :: ModNodeKeyWithUid -> SDoc
ppr (ModNodeKeyWithUid ModuleNameWithIsBoot
mnwib UnitId
uid) = UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ModuleNameWithIsBoot -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleNameWithIsBoot
mnwib

msKey :: ModSummary -> ModNodeKeyWithUid
msKey :: ModSummary -> ModNodeKeyWithUid
msKey ModSummary
ms = ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
ModNodeKeyWithUid (ModSummary -> ModuleNameWithIsBoot
ms_mnwib ModSummary
ms) (ModSummary -> UnitId
ms_unitid ModSummary
ms)

--------------------------------------------------------------------------------
-- ** Internal node representation (exposed)
--------------------------------------------------------------------------------

type SummaryNode = Node Int ModuleGraphNode

summaryNodeKey :: SummaryNode -> Int
summaryNodeKey :: SummaryNode -> Int
summaryNodeKey = SummaryNode -> Int
forall key payload. Node key payload -> key
node_key

summaryNodeSummary :: SummaryNode -> ModuleGraphNode
summaryNodeSummary :: SummaryNode -> ModuleGraphNode
summaryNodeSummary = SummaryNode -> ModuleGraphNode
forall key payload. Node key payload -> payload
node_payload

--------------------------------------------------------------------------------
-- * Misc utilities
--------------------------------------------------------------------------------

showModMsg :: DynFlags -> Bool -> ModuleGraphNode -> SDoc
showModMsg :: DynFlags -> Bool -> ModuleGraphNode -> SDoc
showModMsg DynFlags
dflags Bool
_ (LinkNode {}) =
      let staticLink :: Bool
staticLink = case DynFlags -> GhcLink
ghcLink DynFlags
dflags of
                          GhcLink
LinkStaticLib -> Bool
True
                          GhcLink
_ -> Bool
False

          platform :: Platform
platform  = DynFlags -> Platform
targetPlatform DynFlags
dflags
          arch_os :: ArchOS
arch_os   = Platform -> ArchOS
platformArchOS Platform
platform
          exe_file :: String
exe_file  = ArchOS -> Bool -> Maybe String -> String
exeFileName ArchOS
arch_os Bool
staticLink (DynFlags -> Maybe String
outputFile_ DynFlags
dflags)
      in String -> SDoc
forall doc. IsLine doc => String -> doc
text String
exe_file
showModMsg DynFlags
_ Bool
_ (InstantiationNode UnitId
_uid InstantiatedUnit
indef_unit) =
  UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitId -> SDoc) -> UnitId -> SDoc
forall a b. (a -> b) -> a -> b
$ InstantiatedUnit -> UnitId
forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf InstantiatedUnit
indef_unit
showModMsg DynFlags
dflags Bool
recomp (ModuleNode [NodeKey]
_ ModSummary
mod_summary) =
  if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HideSourcePaths DynFlags
dflags
      then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
mod_str
      else [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$
         [ String -> SDoc
forall doc. IsLine doc => String -> doc
text (String
mod_str String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
mod_str)) Char
' ')
         , Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'('
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> String
op (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ModSummary -> String
msHsFilePath ModSummary
mod_summary) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
','
         , SDoc
message, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
')' ]

  where
    op :: String -> String
op       = String -> String
normalise
    mod_str :: String
mod_str  = ModuleName -> String
moduleNameString (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModSummary -> Module
ms_mod ModSummary
mod_summary)) String -> String -> String
forall a. [a] -> [a] -> [a]
++
               HscSource -> String
hscSourceString (ModSummary -> HscSource
ms_hsc_src ModSummary
mod_summary)
    dyn_file :: String
dyn_file = String -> String
op (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ModSummary -> String
msDynObjFilePath ModSummary
mod_summary
    obj_file :: String
obj_file = String -> String
op (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ModSummary -> String
msObjFilePath ModSummary
mod_summary
    files :: [String]
files    = [ String
obj_file ]
               [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
dyn_file | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_BuildDynamicToo DynFlags
dflags ]
               [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"interpreted" | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ByteCodeAndObjectCode DynFlags
dflags ]
    message :: SDoc
message = case Backend -> Bool -> Maybe String
backendSpecialModuleSource (DynFlags -> Backend
backend DynFlags
dflags) Bool
recomp of
                Just String
special -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
special
                Maybe String
Nothing -> (SDoc -> SDoc -> SDoc) -> [SDoc] -> SDoc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\SDoc
ofile SDoc
rest -> SDoc
ofile SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
rest) ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
forall doc. IsLine doc => String -> doc
text [String]
files)

--------------------------------------------------------------------------------
-- * Internal methods for module graph
--
-- These are *really* meant to be internal!
-- Don't expose them without careful consideration about the invariants
-- described in the export list haddocks.
--------------------------------------------------------------------------------

newtype NodeMap a = NodeMap { forall a. NodeMap a -> Map NodeKey a
unNodeMap :: Map.Map NodeKey a }
  deriving ((forall a b. (a -> b) -> NodeMap a -> NodeMap b)
-> (forall a b. a -> NodeMap b -> NodeMap a) -> Functor NodeMap
forall a b. a -> NodeMap b -> NodeMap a
forall a b. (a -> b) -> NodeMap a -> NodeMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NodeMap a -> NodeMap b
fmap :: forall a b. (a -> b) -> NodeMap a -> NodeMap b
$c<$ :: forall a b. a -> NodeMap b -> NodeMap a
<$ :: forall a b. a -> NodeMap b -> NodeMap a
Functor, Functor NodeMap
Foldable NodeMap
(Functor NodeMap, Foldable NodeMap) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> NodeMap a -> f (NodeMap b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NodeMap (f a) -> f (NodeMap a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NodeMap a -> m (NodeMap b))
-> (forall (m :: * -> *) a.
    Monad m =>
    NodeMap (m a) -> m (NodeMap a))
-> Traversable NodeMap
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => NodeMap (m a) -> m (NodeMap a)
forall (f :: * -> *) a.
Applicative f =>
NodeMap (f a) -> f (NodeMap a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeMap a -> m (NodeMap b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeMap a -> f (NodeMap b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeMap a -> f (NodeMap b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeMap a -> f (NodeMap b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NodeMap (f a) -> f (NodeMap a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NodeMap (f a) -> f (NodeMap a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeMap a -> m (NodeMap b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeMap a -> m (NodeMap b)
$csequence :: forall (m :: * -> *) a. Monad m => NodeMap (m a) -> m (NodeMap a)
sequence :: forall (m :: * -> *) a. Monad m => NodeMap (m a) -> m (NodeMap a)
Traversable, (forall m. Monoid m => NodeMap m -> m)
-> (forall m a. Monoid m => (a -> m) -> NodeMap a -> m)
-> (forall m a. Monoid m => (a -> m) -> NodeMap a -> m)
-> (forall a b. (a -> b -> b) -> b -> NodeMap a -> b)
-> (forall a b. (a -> b -> b) -> b -> NodeMap a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodeMap a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodeMap a -> b)
-> (forall a. (a -> a -> a) -> NodeMap a -> a)
-> (forall a. (a -> a -> a) -> NodeMap a -> a)
-> (forall a. NodeMap a -> [a])
-> (forall a. NodeMap a -> Bool)
-> (forall a. NodeMap a -> Int)
-> (forall a. Eq a => a -> NodeMap a -> Bool)
-> (forall a. Ord a => NodeMap a -> a)
-> (forall a. Ord a => NodeMap a -> a)
-> (forall a. Num a => NodeMap a -> a)
-> (forall a. Num a => NodeMap a -> a)
-> Foldable NodeMap
forall a. Eq a => a -> NodeMap a -> Bool
forall a. Num a => NodeMap a -> a
forall a. Ord a => NodeMap a -> a
forall m. Monoid m => NodeMap m -> m
forall a. NodeMap a -> Bool
forall a. NodeMap a -> Int
forall a. NodeMap a -> [a]
forall a. (a -> a -> a) -> NodeMap a -> a
forall m a. Monoid m => (a -> m) -> NodeMap a -> m
forall b a. (b -> a -> b) -> b -> NodeMap a -> b
forall a b. (a -> b -> b) -> b -> NodeMap a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => NodeMap m -> m
fold :: forall m. Monoid m => NodeMap m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NodeMap a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NodeMap a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NodeMap a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> NodeMap a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> NodeMap a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NodeMap a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NodeMap a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NodeMap a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NodeMap a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NodeMap a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NodeMap a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> NodeMap a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> NodeMap a -> a
foldr1 :: forall a. (a -> a -> a) -> NodeMap a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NodeMap a -> a
foldl1 :: forall a. (a -> a -> a) -> NodeMap a -> a
$ctoList :: forall a. NodeMap a -> [a]
toList :: forall a. NodeMap a -> [a]
$cnull :: forall a. NodeMap a -> Bool
null :: forall a. NodeMap a -> Bool
$clength :: forall a. NodeMap a -> Int
length :: forall a. NodeMap a -> Int
$celem :: forall a. Eq a => a -> NodeMap a -> Bool
elem :: forall a. Eq a => a -> NodeMap a -> Bool
$cmaximum :: forall a. Ord a => NodeMap a -> a
maximum :: forall a. Ord a => NodeMap a -> a
$cminimum :: forall a. Ord a => NodeMap a -> a
minimum :: forall a. Ord a => NodeMap a -> a
$csum :: forall a. Num a => NodeMap a -> a
sum :: forall a. Num a => NodeMap a -> a
$cproduct :: forall a. Num a => NodeMap a -> a
product :: forall a. Num a => NodeMap a -> a
Foldable)

mkTransDeps :: [ModuleGraphNode] -> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mkTransDeps :: [ModuleGraphNode]
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mkTransDeps = (Graph SummaryNode -> ReachabilityIndex SummaryNode)
-> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Graph SummaryNode -> ReachabilityIndex SummaryNode
forall node. Graph node -> ReachabilityIndex node
graphReachability {- module graph is acyclic -} ((Graph SummaryNode, NodeKey -> Maybe SummaryNode)
 -> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode))
-> ([ModuleGraphNode]
    -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode))
-> [ModuleGraphNode]
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> [ModuleGraphNode]
-> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
moduleGraphNodes Bool
False

extendMG' :: ModuleGraph -> ModuleGraphNode -> ModuleGraph
extendMG' :: ModuleGraph -> ModuleGraphNode -> ModuleGraph
extendMG' ModuleGraph
mg = \case
  InstantiationNode UnitId
uid InstantiatedUnit
depUnitId -> ModuleGraph -> UnitId -> InstantiatedUnit -> ModuleGraph
extendMGInst ModuleGraph
mg UnitId
uid InstantiatedUnit
depUnitId
  ModuleNode [NodeKey]
deps ModSummary
ms -> ModuleGraph -> [NodeKey] -> ModSummary -> ModuleGraph
extendMG ModuleGraph
mg [NodeKey]
deps ModSummary
ms
  LinkNode [NodeKey]
deps UnitId
uid   -> ModuleGraph -> UnitId -> [NodeKey] -> ModuleGraph
extendMGLink ModuleGraph
mg UnitId
uid [NodeKey]
deps

-- | Add an ExtendedModSummary to ModuleGraph. Assumes that the new ModSummary is
-- not an element of the ModuleGraph.
extendMG :: ModuleGraph -> [NodeKey] -> ModSummary -> ModuleGraph
extendMG :: ModuleGraph -> [NodeKey] -> ModSummary -> ModuleGraph
extendMG ModuleGraph{[ModuleGraphNode]
(ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_mss :: ModuleGraph -> [ModuleGraphNode]
mg_graph :: ModuleGraph
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_mss :: [ModuleGraphNode]
mg_graph :: (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
..} [NodeKey]
deps ModSummary
ms = ModuleGraph
  { mg_mss :: [ModuleGraphNode]
mg_mss = [NodeKey] -> ModSummary -> ModuleGraphNode
ModuleNode [NodeKey]
deps ModSummary
ms ModuleGraphNode -> [ModuleGraphNode] -> [ModuleGraphNode]
forall a. a -> [a] -> [a]
: [ModuleGraphNode]
mg_mss
  , mg_graph :: (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mg_graph = [ModuleGraphNode]
-> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
mkTransDeps ([NodeKey] -> ModSummary -> ModuleGraphNode
ModuleNode [NodeKey]
deps ModSummary
ms ModuleGraphNode -> [ModuleGraphNode] -> [ModuleGraphNode]
forall a. a -> [a] -> [a]
: [ModuleGraphNode]
mg_mss)
  }

extendMGInst :: ModuleGraph -> UnitId -> InstantiatedUnit -> ModuleGraph
extendMGInst :: ModuleGraph -> UnitId -> InstantiatedUnit -> ModuleGraph
extendMGInst ModuleGraph
mg UnitId
uid InstantiatedUnit
depUnitId = ModuleGraph
mg
  { mg_mss = InstantiationNode uid depUnitId : mg_mss mg
  }

extendMGLink :: ModuleGraph -> UnitId -> [NodeKey] -> ModuleGraph
extendMGLink :: ModuleGraph -> UnitId -> [NodeKey] -> ModuleGraph
extendMGLink ModuleGraph
mg UnitId
uid [NodeKey]
nks = ModuleGraph
mg { mg_mss = LinkNode nks uid : mg_mss mg }