never executed always true always false
1 {-# LANGUAGE LambdaCase #-}
2 {-# LANGUAGE RecordWildCards #-}
3
4 module GHC.Unit.Module.Graph
5 ( ModuleGraph
6 , ModuleGraphNode(..)
7 , emptyMG
8 , mkModuleGraph
9 , mkModuleGraph'
10 , extendMG
11 , extendMGInst
12 , extendMG'
13 , filterToposortToModules
14 , mapMG
15 , mgModSummaries
16 , mgModSummaries'
17 , mgExtendedModSummaries
18 , mgElemModule
19 , mgLookupModule
20 , mgBootModules
21 , needsTemplateHaskellOrQQ
22 , isTemplateHaskellOrQQNonBoot
23 , showModMsg
24 , moduleGraphNodeModule)
25 where
26
27 import GHC.Prelude
28
29 import qualified GHC.LanguageExtensions as LangExt
30
31 import GHC.Data.Maybe
32 import GHC.Data.Graph.Directed ( SCC(..) )
33
34 import GHC.Driver.Backend
35 import GHC.Driver.Ppr
36 import GHC.Driver.Session
37
38 import GHC.Types.SourceFile ( hscSourceString )
39
40 import GHC.Unit.Module.ModSummary
41 import GHC.Unit.Module.Env
42 import GHC.Unit.Types
43 import GHC.Utils.Outputable
44
45 import System.FilePath
46
47 -- | A '@ModuleGraphNode@' is a node in the '@ModuleGraph@'.
48 -- Edges between nodes mark dependencies arising from module imports
49 -- and dependencies arising from backpack instantiations.
50 data ModuleGraphNode
51 -- | Instantiation nodes track the instantiation of other units
52 -- (backpack dependencies) with the holes (signatures) of the current package.
53 = InstantiationNode InstantiatedUnit
54 -- | There is a module summary node for each module, signature, and boot module being built.
55 | ModuleNode ExtendedModSummary
56
57 moduleGraphNodeModule :: ModuleGraphNode -> Maybe ExtendedModSummary
58 moduleGraphNodeModule (InstantiationNode {}) = Nothing
59 moduleGraphNodeModule (ModuleNode ems) = Just ems
60
61 instance Outputable ModuleGraphNode where
62 ppr = \case
63 InstantiationNode iuid -> ppr iuid
64 ModuleNode ems -> ppr ems
65
66 -- | A '@ModuleGraph@' contains all the nodes from the home package (only). See
67 -- '@ModuleGraphNode@' for information about the nodes.
68 --
69 -- Modules need to be compiled. hs-boots need to be typechecked before
70 -- the associated "real" module so modules with {-# SOURCE #-} imports can be
71 -- built. Instantiations also need to be typechecked to ensure that the module
72 -- fits the signature. Substantiation typechecking is roughly comparable to the
73 -- check that the module and its hs-boot agree.
74 --
75 -- The graph is not necessarily stored in topologically-sorted order. Use
76 -- 'GHC.topSortModuleGraph' and 'GHC.Data.Graph.Directed.flattenSCC' to achieve this.
77 data ModuleGraph = ModuleGraph
78 { mg_mss :: [ModuleGraphNode]
79 , mg_non_boot :: ModuleEnv ModSummary
80 -- a map of all non-boot ModSummaries keyed by Modules
81 , mg_boot :: ModuleSet
82 -- a set of boot Modules
83 , mg_needs_th_or_qq :: !Bool
84 -- does any of the modules in mg_mss require TemplateHaskell or
85 -- QuasiQuotes?
86 }
87
88 -- | Determines whether a set of modules requires Template Haskell or
89 -- Quasi Quotes
90 --
91 -- Note that if the session's 'DynFlags' enabled Template Haskell when
92 -- 'depanal' was called, then each module in the returned module graph will
93 -- have Template Haskell enabled whether it is actually needed or not.
94 needsTemplateHaskellOrQQ :: ModuleGraph -> Bool
95 needsTemplateHaskellOrQQ mg = mg_needs_th_or_qq mg
96
97 -- | Map a function 'f' over all the 'ModSummaries'.
98 -- To preserve invariants 'f' can't change the isBoot status.
99 mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
100 mapMG f mg@ModuleGraph{..} = mg
101 { mg_mss = flip fmap mg_mss $ \case
102 InstantiationNode iuid -> InstantiationNode iuid
103 ModuleNode (ExtendedModSummary ms bds) -> ModuleNode (ExtendedModSummary (f ms) bds)
104 , mg_non_boot = mapModuleEnv f mg_non_boot
105 }
106
107 mgBootModules :: ModuleGraph -> ModuleSet
108 mgBootModules ModuleGraph{..} = mg_boot
109
110 mgModSummaries :: ModuleGraph -> [ModSummary]
111 mgModSummaries mg = [ m | ModuleNode (ExtendedModSummary m _) <- mgModSummaries' mg ]
112
113 mgExtendedModSummaries :: ModuleGraph -> [ExtendedModSummary]
114 mgExtendedModSummaries mg = [ ems | ModuleNode ems <- mgModSummaries' mg ]
115
116 mgModSummaries' :: ModuleGraph -> [ModuleGraphNode]
117 mgModSummaries' = mg_mss
118
119 mgElemModule :: ModuleGraph -> Module -> Bool
120 mgElemModule ModuleGraph{..} m = elemModuleEnv m mg_non_boot
121
122 -- | Look up a ModSummary in the ModuleGraph
123 mgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary
124 mgLookupModule ModuleGraph{..} m = lookupModuleEnv mg_non_boot m
125
126 emptyMG :: ModuleGraph
127 emptyMG = ModuleGraph [] emptyModuleEnv emptyModuleSet False
128
129 isTemplateHaskellOrQQNonBoot :: ModSummary -> Bool
130 isTemplateHaskellOrQQNonBoot ms =
131 (xopt LangExt.TemplateHaskell (ms_hspp_opts ms)
132 || xopt LangExt.QuasiQuotes (ms_hspp_opts ms)) &&
133 (isBootSummary ms == NotBoot)
134
135 -- | Add an ExtendedModSummary to ModuleGraph. Assumes that the new ModSummary is
136 -- not an element of the ModuleGraph.
137 extendMG :: ModuleGraph -> ExtendedModSummary -> ModuleGraph
138 extendMG ModuleGraph{..} ems@(ExtendedModSummary ms _) = ModuleGraph
139 { mg_mss = ModuleNode ems : mg_mss
140 , mg_non_boot = case isBootSummary ms of
141 IsBoot -> mg_non_boot
142 NotBoot -> extendModuleEnv mg_non_boot (ms_mod ms) ms
143 , mg_boot = case isBootSummary ms of
144 NotBoot -> mg_boot
145 IsBoot -> extendModuleSet mg_boot (ms_mod ms)
146 , mg_needs_th_or_qq = mg_needs_th_or_qq || isTemplateHaskellOrQQNonBoot ms
147 }
148
149 extendMGInst :: ModuleGraph -> InstantiatedUnit -> ModuleGraph
150 extendMGInst mg depUnitId = mg
151 { mg_mss = InstantiationNode depUnitId : mg_mss mg
152 }
153
154 extendMG' :: ModuleGraph -> ModuleGraphNode -> ModuleGraph
155 extendMG' mg = \case
156 InstantiationNode depUnitId -> extendMGInst mg depUnitId
157 ModuleNode ems -> extendMG mg ems
158
159 mkModuleGraph :: [ExtendedModSummary] -> ModuleGraph
160 mkModuleGraph = foldr (flip extendMG) emptyMG
161
162 mkModuleGraph' :: [ModuleGraphNode] -> ModuleGraph
163 mkModuleGraph' = foldr (flip extendMG') emptyMG
164
165 -- | This function filters out all the instantiation nodes from each SCC of a
166 -- topological sort. Use this with care, as the resulting "strongly connected components"
167 -- may not really be strongly connected in a direct way, as instantiations have been
168 -- removed. It would probably be best to eliminate uses of this function where possible.
169 filterToposortToModules
170 :: [SCC ModuleGraphNode] -> [SCC ModSummary]
171 filterToposortToModules = mapMaybe $ mapMaybeSCC $ \case
172 InstantiationNode _ -> Nothing
173 ModuleNode (ExtendedModSummary node _) -> Just node
174 where
175 -- This higher order function is somewhat bogus,
176 -- as the definition of "strongly connected component"
177 -- is not necessarily respected.
178 mapMaybeSCC :: (a -> Maybe b) -> SCC a -> Maybe (SCC b)
179 mapMaybeSCC f = \case
180 AcyclicSCC a -> AcyclicSCC <$> f a
181 CyclicSCC as -> case mapMaybe f as of
182 [] -> Nothing
183 [a] -> Just $ AcyclicSCC a
184 as -> Just $ CyclicSCC as
185
186 showModMsg :: DynFlags -> Bool -> ModuleGraphNode -> SDoc
187 showModMsg _ _ (InstantiationNode indef_unit) =
188 ppr $ instUnitInstanceOf indef_unit
189 showModMsg dflags recomp (ModuleNode (ExtendedModSummary mod_summary _)) =
190 if gopt Opt_HideSourcePaths dflags
191 then text mod_str
192 else hsep $
193 [ text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' ')
194 , char '('
195 , text (op $ msHsFilePath mod_summary) <> char ','
196 , message, char ')' ]
197
198 where
199 op = normalise
200 mod = moduleName (ms_mod mod_summary)
201 mod_str = showPpr dflags mod ++ hscSourceString (ms_hsc_src mod_summary)
202 dyn_file = op $ msDynObjFilePath mod_summary
203 obj_file = op $ msObjFilePath mod_summary
204 message = case backend dflags of
205 Interpreter | recomp -> text "interpreted"
206 NoBackend -> text "nothing"
207 _ ->
208 if gopt Opt_BuildDynamicToo dflags
209 then text obj_file <> comma <+> text dyn_file
210 else text obj_file
211