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