never executed always true always false
1
2
3 -----------------------------------------------------------------------------
4 --
5 -- Makefile Dependency Generation
6 --
7 -- (c) The University of Glasgow 2005
8 --
9 -----------------------------------------------------------------------------
10
11 module GHC.Driver.MakeFile
12 ( doMkDependHS
13 )
14 where
15
16 import GHC.Prelude
17
18 import qualified GHC
19 import GHC.Driver.Config.Finder
20 import GHC.Driver.Monad
21 import GHC.Driver.Session
22 import GHC.Driver.Ppr
23 import GHC.Utils.Misc
24 import GHC.Driver.Env
25 import GHC.Driver.Errors.Types
26 import qualified GHC.SysTools as SysTools
27 import GHC.Data.Graph.Directed ( SCC(..) )
28 import GHC.Utils.Outputable
29 import GHC.Utils.Panic
30 import GHC.Utils.Panic.Plain
31 import GHC.Types.SourceError
32 import GHC.Types.SrcLoc
33 import GHC.Types.PkgQual
34 import Data.List (partition)
35 import GHC.Utils.TmpFs
36
37 import GHC.Iface.Load (cannotFindModule)
38
39 import GHC.Unit.Module
40 import GHC.Unit.Module.ModSummary
41 import GHC.Unit.Module.Graph
42 import GHC.Unit.Finder
43
44 import GHC.Utils.Exception
45 import GHC.Utils.Error
46 import GHC.Utils.Logger
47
48 import System.Directory
49 import System.FilePath
50 import System.IO
51 import System.IO.Error ( isEOFError )
52 import Control.Monad ( when, forM_ )
53 import Data.Maybe ( isJust )
54 import Data.IORef
55 import qualified Data.Set as Set
56
57 -----------------------------------------------------------------
58 --
59 -- The main function
60 --
61 -----------------------------------------------------------------
62
63 doMkDependHS :: GhcMonad m => [FilePath] -> m ()
64 doMkDependHS srcs = do
65 logger <- getLogger
66
67 -- Initialisation
68 dflags0 <- GHC.getSessionDynFlags
69
70 -- We kludge things a bit for dependency generation. Rather than
71 -- generating dependencies for each way separately, we generate
72 -- them once and then duplicate them for each way's osuf/hisuf.
73 -- We therefore do the initial dependency generation with an empty
74 -- way and .o/.hi extensions, regardless of any flags that might
75 -- be specified.
76 let dflags1 = dflags0
77 { targetWays_ = Set.empty
78 , hiSuf_ = "hi"
79 , objectSuf_ = "o"
80 }
81 GHC.setSessionDynFlags dflags1
82
83 -- If no suffix is provided, use the default -- the empty one
84 let dflags = if null (depSuffixes dflags1)
85 then dflags1 { depSuffixes = [""] }
86 else dflags1
87
88 tmpfs <- hsc_tmpfs <$> getSession
89 files <- liftIO $ beginMkDependHS logger tmpfs dflags
90
91 -- Do the downsweep to find all the modules
92 targets <- mapM (\s -> GHC.guessTarget s Nothing Nothing) srcs
93 GHC.setTargets targets
94 let excl_mods = depExcludeMods dflags
95 module_graph <- GHC.depanal excl_mods True {- Allow dup roots -}
96
97 -- Sort into dependency order
98 -- There should be no cycles
99 let sorted = GHC.topSortModuleGraph False module_graph Nothing
100
101 -- Print out the dependencies if wanted
102 liftIO $ debugTraceMsg logger 2 (text "Module dependencies" $$ ppr sorted)
103
104 -- Process them one by one, dumping results into makefile
105 -- and complaining about cycles
106 hsc_env <- getSession
107 root <- liftIO getCurrentDirectory
108 mapM_ (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files)) sorted
109
110 -- If -ddump-mod-cycles, show cycles in the module graph
111 liftIO $ dumpModCycles logger module_graph
112
113 -- Tidy up
114 liftIO $ endMkDependHS logger files
115
116 -- Unconditional exiting is a bad idea. If an error occurs we'll get an
117 --exception; if that is not caught it's fine, but at least we have a
118 --chance to find out exactly what went wrong. Uncomment the following
119 --line if you disagree.
120
121 --`GHC.ghcCatch` \_ -> io $ exitWith (ExitFailure 1)
122
123 -----------------------------------------------------------------
124 --
125 -- beginMkDependHs
126 -- Create a temporary file,
127 -- find the Makefile,
128 -- slurp through it, etc
129 --
130 -----------------------------------------------------------------
131
132 data MkDepFiles
133 = MkDep { mkd_make_file :: FilePath, -- Name of the makefile
134 mkd_make_hdl :: Maybe Handle, -- Handle for the open makefile
135 mkd_tmp_file :: FilePath, -- Name of the temporary file
136 mkd_tmp_hdl :: Handle } -- Handle of the open temporary file
137
138 beginMkDependHS :: Logger -> TmpFs -> DynFlags -> IO MkDepFiles
139 beginMkDependHS logger tmpfs dflags = do
140 -- open a new temp file in which to stuff the dependency info
141 -- as we go along.
142 tmp_file <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "dep"
143 tmp_hdl <- openFile tmp_file WriteMode
144
145 -- open the makefile
146 let makefile = depMakefile dflags
147 exists <- doesFileExist makefile
148 mb_make_hdl <-
149 if not exists
150 then return Nothing
151 else do
152 makefile_hdl <- openFile makefile ReadMode
153
154 -- slurp through until we get the magic start string,
155 -- copying the contents into dep_makefile
156 let slurp = do
157 l <- hGetLine makefile_hdl
158 if (l == depStartMarker)
159 then return ()
160 else do hPutStrLn tmp_hdl l; slurp
161
162 -- slurp through until we get the magic end marker,
163 -- throwing away the contents
164 let chuck = do
165 l <- hGetLine makefile_hdl
166 if (l == depEndMarker)
167 then return ()
168 else chuck
169
170 catchIO slurp
171 (\e -> if isEOFError e then return () else ioError e)
172 catchIO chuck
173 (\e -> if isEOFError e then return () else ioError e)
174
175 return (Just makefile_hdl)
176
177
178 -- write the magic marker into the tmp file
179 hPutStrLn tmp_hdl depStartMarker
180
181 return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
182 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl})
183
184
185 -----------------------------------------------------------------
186 --
187 -- processDeps
188 --
189 -----------------------------------------------------------------
190
191 processDeps :: DynFlags
192 -> HscEnv
193 -> [ModuleName]
194 -> FilePath
195 -> Handle -- Write dependencies to here
196 -> SCC ModuleGraphNode
197 -> IO ()
198 -- Write suitable dependencies to handle
199 -- Always:
200 -- this.o : this.hs
201 --
202 -- If the dependency is on something other than a .hi file:
203 -- this.o this.p_o ... : dep
204 -- otherwise
205 -- this.o ... : dep.hi
206 -- this.p_o ... : dep.p_hi
207 -- ...
208 -- (where .o is $osuf, and the other suffixes come from
209 -- the cmdline -s options).
210 --
211 -- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
212
213 processDeps dflags _ _ _ _ (CyclicSCC nodes)
214 = -- There shouldn't be any cycles; report them
215 throwGhcExceptionIO $ ProgramError $
216 showSDoc dflags $ GHC.cyclicModuleErr nodes
217
218 processDeps dflags _ _ _ _ (AcyclicSCC (InstantiationNode node))
219 = -- There shouldn't be any backpack instantiations; report them as well
220 throwGhcExceptionIO $ ProgramError $
221 showSDoc dflags $
222 vcat [ text "Unexpected backpack instantiation in dependency graph while constructing Makefile:"
223 , nest 2 $ ppr node ]
224
225 processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode (ExtendedModSummary node _)))
226 = do { let extra_suffixes = depSuffixes dflags
227 include_pkg_deps = depIncludePkgDeps dflags
228 src_file = msHsFilePath node
229 obj_file = msObjFilePath node
230 obj_files = insertSuffixes obj_file extra_suffixes
231
232 do_imp loc is_boot pkg_qual imp_mod
233 = do { mb_hi <- findDependency hsc_env loc pkg_qual imp_mod
234 is_boot include_pkg_deps
235 ; case mb_hi of {
236 Nothing -> return () ;
237 Just hi_file -> do
238 { let hi_files = insertSuffixes hi_file extra_suffixes
239 write_dep (obj,hi) = writeDependency root hdl [obj] hi
240
241 -- Add one dependency for each suffix;
242 -- e.g. A.o : B.hi
243 -- A.x_o : B.x_hi
244 ; mapM_ write_dep (obj_files `zip` hi_files) }}}
245
246
247 -- Emit std dependency of the object(s) on the source file
248 -- Something like A.o : A.hs
249 ; writeDependency root hdl obj_files src_file
250
251 -- add dependency between objects and their corresponding .hi-boot
252 -- files if the module has a corresponding .hs-boot file (#14482)
253 ; when (isBootSummary node == IsBoot) $ do
254 let hi_boot = msHiFilePath node
255 let obj = removeBootSuffix (msObjFilePath node)
256 forM_ extra_suffixes $ \suff -> do
257 let way_obj = insertSuffixes obj [suff]
258 let way_hi_boot = insertSuffixes hi_boot [suff]
259 mapM_ (writeDependency root hdl way_obj) way_hi_boot
260
261 -- Emit a dependency for each CPP import
262 ; when (depIncludeCppDeps dflags) $ do
263 -- CPP deps are descovered in the module parsing phase by parsing
264 -- comment lines left by the preprocessor.
265 -- Note that GHC.parseModule may throw an exception if the module
266 -- fails to parse, which may not be desirable (see #16616).
267 { session <- Session <$> newIORef hsc_env
268 ; parsedMod <- reflectGhc (GHC.parseModule node) session
269 ; mapM_ (writeDependency root hdl obj_files)
270 (GHC.pm_extra_src_files parsedMod)
271 }
272
273 -- Emit a dependency for each import
274
275 ; let do_imps is_boot idecls = sequence_
276 [ do_imp loc is_boot mb_pkg mod
277 | (mb_pkg, L loc mod) <- idecls,
278 mod `notElem` excl_mods ]
279
280 ; do_imps IsBoot (ms_srcimps node)
281 ; do_imps NotBoot (ms_imps node)
282 }
283
284
285 findDependency :: HscEnv
286 -> SrcSpan
287 -> PkgQual -- package qualifier, if any
288 -> ModuleName -- Imported module
289 -> IsBootInterface -- Source import
290 -> Bool -- Record dependency on package modules
291 -> IO (Maybe FilePath) -- Interface file
292 findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
293 let fc = hsc_FC hsc_env
294 let home_unit = hsc_home_unit hsc_env
295 let units = hsc_units hsc_env
296 let dflags = hsc_dflags hsc_env
297 let fopts = initFinderOpts dflags
298 -- Find the module; this will be fast because
299 -- we've done it once during downsweep
300 r <- findImportedModule fc fopts units home_unit imp pkg
301 case r of
302 Found loc _
303 -- Home package: just depend on the .hi or hi-boot file
304 | isJust (ml_hs_file loc) || include_pkg_deps
305 -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
306
307 -- Not in this package: we don't need a dependency
308 | otherwise
309 -> return Nothing
310
311 fail ->
312 throwOneError $
313 mkPlainErrorMsgEnvelope srcloc $
314 GhcDriverMessage $ DriverUnknownMessage $ mkPlainError noHints $
315 cannotFindModule hsc_env imp fail
316
317 -----------------------------
318 writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
319 -- (writeDependency r h [t1,t2] dep) writes to handle h the dependency
320 -- t1 t2 : dep
321 writeDependency root hdl targets dep
322 = do let -- We need to avoid making deps on
323 -- c:/foo/...
324 -- on cygwin as make gets confused by the :
325 -- Making relative deps avoids some instances of this.
326 dep' = makeRelative root dep
327 forOutput = escapeSpaces . reslash Forwards . normalise
328 output = unwords (map forOutput targets) ++ " : " ++ forOutput dep'
329 hPutStrLn hdl output
330
331 -----------------------------
332 insertSuffixes
333 :: FilePath -- Original filename; e.g. "foo.o"
334 -> [String] -- Suffix prefixes e.g. ["x_", "y_"]
335 -> [FilePath] -- Zapped filenames e.g. ["foo.x_o", "foo.y_o"]
336 -- Note that the extra bit gets inserted *before* the old suffix
337 -- We assume the old suffix contains no dots, so we know where to
338 -- split it
339 insertSuffixes file_name extras
340 = [ basename <.> (extra ++ suffix) | extra <- extras ]
341 where
342 (basename, suffix) = case splitExtension file_name of
343 -- Drop the "." from the extension
344 (b, s) -> (b, drop 1 s)
345
346
347 -----------------------------------------------------------------
348 --
349 -- endMkDependHs
350 -- Complete the makefile, close the tmp file etc
351 --
352 -----------------------------------------------------------------
353
354 endMkDependHS :: Logger -> MkDepFiles -> IO ()
355
356 endMkDependHS logger
357 (MkDep { mkd_make_file = makefile, mkd_make_hdl = makefile_hdl,
358 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl })
359 = do
360 -- write the magic marker into the tmp file
361 hPutStrLn tmp_hdl depEndMarker
362
363 case makefile_hdl of
364 Nothing -> return ()
365 Just hdl -> do
366 -- slurp the rest of the original makefile and copy it into the output
367 SysTools.copyHandle hdl tmp_hdl
368 hClose hdl
369
370 hClose tmp_hdl -- make sure it's flushed
371
372 -- Create a backup of the original makefile
373 when (isJust makefile_hdl) $ do
374 showPass logger ("Backing up " ++ makefile)
375 SysTools.copyFile makefile (makefile++".bak")
376
377 -- Copy the new makefile in place
378 showPass logger "Installing new makefile"
379 SysTools.copyFile tmp_file makefile
380
381
382 -----------------------------------------------------------------
383 -- Module cycles
384 -----------------------------------------------------------------
385
386 dumpModCycles :: Logger -> ModuleGraph -> IO ()
387 dumpModCycles logger module_graph
388 | not (logHasDumpFlag logger Opt_D_dump_mod_cycles)
389 = return ()
390
391 | null cycles
392 = putMsg logger (text "No module cycles")
393
394 | otherwise
395 = putMsg logger (hang (text "Module cycles found:") 2 pp_cycles)
396 where
397 topoSort = filterToposortToModules $
398 GHC.topSortModuleGraph True module_graph Nothing
399
400 cycles :: [[ModSummary]]
401 cycles =
402 [ c | CyclicSCC c <- topoSort ]
403
404 pp_cycles = vcat [ (text "---------- Cycle" <+> int n <+> text "----------")
405 $$ pprCycle c $$ blankLine
406 | (n,c) <- [1..] `zip` cycles ]
407
408 pprCycle :: [ModSummary] -> SDoc
409 -- Print a cycle, but show only the imports within the cycle
410 pprCycle summaries = pp_group (CyclicSCC summaries)
411 where
412 cycle_mods :: [ModuleName] -- The modules in this cycle
413 cycle_mods = map (moduleName . ms_mod) summaries
414
415 pp_group (AcyclicSCC ms) = pp_ms ms
416 pp_group (CyclicSCC mss)
417 = assert (not (null boot_only)) $
418 -- The boot-only list must be non-empty, else there would
419 -- be an infinite chain of non-boot imports, and we've
420 -- already checked for that in processModDeps
421 pp_ms loop_breaker $$ vcat (map pp_group groups)
422 where
423 (boot_only, others) = partition is_boot_only mss
424 is_boot_only ms = not (any in_group (map snd (ms_imps ms)))
425 in_group (L _ m) = m `elem` group_mods
426 group_mods = map (moduleName . ms_mod) mss
427
428 loop_breaker = head boot_only
429 all_others = tail boot_only ++ others
430 groups = filterToposortToModules $
431 GHC.topSortModuleGraph True (mkModuleGraph $ extendModSummaryNoDeps <$> all_others) Nothing
432
433 pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
434 <+> (pp_imps empty (map snd (ms_imps summary)) $$
435 pp_imps (text "{-# SOURCE #-}") (map snd (ms_srcimps summary)))
436 where
437 mod_str = moduleNameString (moduleName (ms_mod summary))
438
439 pp_imps :: SDoc -> [Located ModuleName] -> SDoc
440 pp_imps _ [] = empty
441 pp_imps what lms
442 = case [m | L _ m <- lms, m `elem` cycle_mods] of
443 [] -> empty
444 ms -> what <+> text "imports" <+>
445 pprWithCommas ppr ms
446
447 -----------------------------------------------------------------
448 --
449 -- Flags
450 --
451 -----------------------------------------------------------------
452
453 depStartMarker, depEndMarker :: String
454 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
455 depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"