never executed always true always false
1 {-# LANGUAGE LambdaCase #-}
2 {-# LANGUAGE TupleSections #-}
3
4 -- | A ModSummary is a node in the compilation manager's dependency graph
5 -- (ModuleGraph)
6 module GHC.Unit.Module.ModSummary
7 ( ExtendedModSummary (..)
8 , extendModSummaryNoDeps
9 , ModSummary (..)
10 , ms_unitid
11 , ms_installed_mod
12 , ms_mod_name
13 , ms_imps
14 , ms_plugin_imps
15 , ms_mnwib
16 , ms_home_srcimps
17 , ms_home_imps
18 , msHiFilePath
19 , msDynHiFilePath
20 , msHsFilePath
21 , msObjFilePath
22 , msDynObjFilePath
23 , isBootSummary
24 , findTarget
25 )
26 where
27
28 import GHC.Prelude
29
30 import GHC.Hs
31
32 import GHC.Driver.Session
33
34 import GHC.Unit.Types
35 import GHC.Unit.Module
36
37 import GHC.Types.SourceFile ( HscSource(..), hscSourceString )
38 import GHC.Types.SrcLoc
39 import GHC.Types.Target
40 import GHC.Types.PkgQual
41
42 import GHC.Data.Maybe
43 import GHC.Data.StringBuffer ( StringBuffer )
44
45 import GHC.Utils.Fingerprint
46 import GHC.Utils.Outputable
47
48 import Data.Time
49
50 -- | Enrichment of 'ModSummary' with backpack dependencies
51 data ExtendedModSummary = ExtendedModSummary
52 { emsModSummary :: {-# UNPACK #-} !ModSummary
53 , emsInstantiatedUnits :: [InstantiatedUnit]
54 -- ^ Extra backpack deps
55 -- NB: This is sometimes left empty in situations where the instantiated units
56 -- would not be used. See call sites of 'extendModSummaryNoDeps'.
57 }
58
59 instance Outputable ExtendedModSummary where
60 ppr = \case
61 ExtendedModSummary ms bds -> ppr ms <+> ppr bds
62
63 extendModSummaryNoDeps :: ModSummary -> ExtendedModSummary
64 extendModSummaryNoDeps ms = ExtendedModSummary ms []
65
66 -- | Data for a module node in a 'ModuleGraph'. Module nodes of the module graph
67 -- are one of:
68 --
69 -- * A regular Haskell source module
70 -- * A hi-boot source module
71 --
72 data ModSummary
73 = ModSummary {
74 ms_mod :: Module,
75 -- ^ Identity of the module
76 ms_hsc_src :: HscSource,
77 -- ^ The module source either plain Haskell, hs-boot, or hsig
78 ms_location :: ModLocation,
79 -- ^ Location of the various files belonging to the module
80 ms_hs_hash :: Fingerprint,
81 -- ^ Content hash of source file
82 ms_obj_date :: Maybe UTCTime,
83 -- ^ Timestamp of object, if we have one
84 ms_dyn_obj_date :: !(Maybe UTCTime),
85 -- ^ Timestamp of dynamic object, if we have one
86 ms_iface_date :: Maybe UTCTime,
87 -- ^ Timestamp of hi file, if we have one
88 -- See Note [When source is considered modified] and #9243
89 ms_hie_date :: Maybe UTCTime,
90 -- ^ Timestamp of hie file, if we have one
91 ms_srcimps :: [(PkgQual, Located ModuleName)], -- FIXME: source imports are never from an external package, why do we allow PkgQual?
92 -- ^ Source imports of the module
93 ms_textual_imps :: [(PkgQual, Located ModuleName)],
94 -- ^ Non-source imports of the module from the module *text*
95 ms_ghc_prim_import :: !Bool,
96 -- ^ Whether the special module GHC.Prim was imported explicitliy
97 ms_parsed_mod :: Maybe HsParsedModule,
98 -- ^ The parsed, nonrenamed source, if we have it. This is also
99 -- used to support "inline module syntax" in Backpack files.
100 ms_hspp_file :: FilePath,
101 -- ^ Filename of preprocessed source file
102 ms_hspp_opts :: DynFlags,
103 -- ^ Cached flags from @OPTIONS@, @INCLUDE@ and @LANGUAGE@
104 -- pragmas in the modules source code
105 ms_hspp_buf :: Maybe StringBuffer
106 -- ^ The actual preprocessed source, if we have it
107 }
108
109 ms_unitid :: ModSummary -> UnitId
110 ms_unitid = toUnitId . moduleUnit . ms_mod
111
112 ms_installed_mod :: ModSummary -> InstalledModule
113 ms_installed_mod = fst . getModuleInstantiation . ms_mod
114
115 ms_mod_name :: ModSummary -> ModuleName
116 ms_mod_name = moduleName . ms_mod
117
118 -- | Textual imports, plus plugin imports but not SOURCE imports.
119 ms_imps :: ModSummary -> [(PkgQual, Located ModuleName)]
120 ms_imps ms = ms_textual_imps ms ++ ms_plugin_imps ms
121
122 -- | Plugin imports
123 ms_plugin_imps :: ModSummary -> [(PkgQual, Located ModuleName)]
124 ms_plugin_imps ms = map ((NoPkgQual,) . noLoc) (pluginModNames (ms_hspp_opts ms))
125
126 -- | All of the (possibly) home module imports from the given list that is to
127 -- say, each of these module names could be a home import if an appropriately
128 -- named file existed. (This is in contrast to package qualified imports, which
129 -- are guaranteed not to be home imports.)
130 home_imps :: [(PkgQual, Located ModuleName)] -> [Located ModuleName]
131 home_imps imps = fmap snd (filter (maybe_home . fst) imps)
132 where maybe_home NoPkgQual = True
133 maybe_home (ThisPkg _) = True
134 maybe_home (OtherPkg _) = False
135
136 -- | Like 'ms_home_imps', but for SOURCE imports.
137 ms_home_srcimps :: ModSummary -> [Located ModuleName]
138 ms_home_srcimps = home_imps . ms_srcimps
139
140 -- | All of the (possibly) home module imports from a
141 -- 'ModSummary'; that is to say, each of these module names
142 -- could be a home import if an appropriately named file
143 -- existed. (This is in contrast to package qualified
144 -- imports, which are guaranteed not to be home imports.)
145 ms_home_imps :: ModSummary -> [Located ModuleName]
146 ms_home_imps = home_imps . ms_imps
147
148 -- The ModLocation contains both the original source filename and the
149 -- filename of the cleaned-up source file after all preprocessing has been
150 -- done. The point is that the summariser will have to cpp/unlit/whatever
151 -- all files anyway, and there's no point in doing this twice -- just
152 -- park the result in a temp file, put the name of it in the location,
153 -- and let @compile@ read from that file on the way back up.
154
155 -- The ModLocation is stable over successive up-sweeps in GHCi, wheres
156 -- the ms_hs_hash and imports can, of course, change
157
158 msHsFilePath, msDynHiFilePath, msHiFilePath, msObjFilePath, msDynObjFilePath :: ModSummary -> FilePath
159 msHsFilePath ms = expectJust "msHsFilePath" (ml_hs_file (ms_location ms))
160 msHiFilePath ms = ml_hi_file (ms_location ms)
161 msDynHiFilePath ms = ml_dyn_hi_file (ms_location ms)
162 msObjFilePath ms = ml_obj_file (ms_location ms)
163 msDynObjFilePath ms = ml_dyn_obj_file (ms_location ms)
164
165 -- | Did this 'ModSummary' originate from a hs-boot file?
166 isBootSummary :: ModSummary -> IsBootInterface
167 isBootSummary ms = if ms_hsc_src ms == HsBootFile then IsBoot else NotBoot
168
169 ms_mnwib :: ModSummary -> ModuleNameWithIsBoot
170 ms_mnwib ms = GWIB (ms_mod_name ms) (isBootSummary ms)
171
172 instance Outputable ModSummary where
173 ppr ms
174 = sep [text "ModSummary {",
175 nest 3 (sep [text "ms_hs_hash = " <> text (show (ms_hs_hash ms)),
176 text "ms_mod =" <+> ppr (ms_mod ms)
177 <> text (hscSourceString (ms_hsc_src ms)) <> comma,
178 text "ms_textual_imps =" <+> ppr (ms_textual_imps ms),
179 text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
180 char '}'
181 ]
182
183 -- | Find the first target in the provided list which matches the specified
184 -- 'ModSummary'.
185 findTarget :: ModSummary -> [Target] -> Maybe Target
186 findTarget ms ts =
187 case filter (matches ms) ts of
188 [] -> Nothing
189 (t:_) -> Just t
190 where
191 summary `matches` Target { targetId = TargetModule m, targetUnitId = unitId }
192 = ms_mod_name summary == m && ms_unitid summary == unitId
193 summary `matches` Target { targetId = TargetFile f _, targetUnitId = unitid }
194 | Just f' <- ml_hs_file (ms_location summary)
195 = f == f' && ms_unitid summary == unitid
196 _ `matches` _
197 = False
198
199