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