2 -----------------------------------------------------------------------------
4 -- Makefile Dependency Generation
6 -- (c) The University of Glasgow 2005
8 -----------------------------------------------------------------------------
10 module DriverMkDepend (
14 #include "HsVersions.h"
17 import GHC ( Session, ModSummary(..) )
20 import HscTypes ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
21 import SysTools ( newTempName )
22 import qualified SysTools
24 import Digraph ( SCC(..) )
25 import Finder ( findImportedModule, FindResult(..) )
33 import ErrUtils ( debugTraceMsg, putMsg )
35 import Data.IORef ( IORef, readIORef, writeIORef )
36 import Control.Exception
37 import System.Exit ( ExitCode(..), exitWith )
38 import System.Directory
39 import System.FilePath
41 import SYSTEM_IO_ERROR ( isEOFError )
42 import Control.Monad ( when )
43 import Data.Maybe ( isJust )
45 -----------------------------------------------------------------
49 -----------------------------------------------------------------
51 doMkDependHS :: Session -> [FilePath] -> IO ()
52 doMkDependHS session srcs
53 = do { -- Initialisation
54 dflags <- GHC.getSessionDynFlags session
55 ; files <- beginMkDependHS dflags
57 -- Do the downsweep to find all the modules
58 ; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
59 ; GHC.setTargets session targets
60 ; excl_mods <- readIORef v_Dep_exclude_mods
61 ; r <- GHC.depanal session excl_mods True {- Allow dup roots -}
63 Nothing -> exitWith (ExitFailure 1)
64 Just mod_summaries -> do {
66 -- Sort into dependency order
67 -- There should be no cycles
68 let sorted = GHC.topSortModuleGraph False mod_summaries Nothing
70 -- Print out the dependencies if wanted
71 ; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
73 -- Prcess them one by one, dumping results into makefile
74 -- and complaining about cycles
75 ; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted
77 -- If -ddump-mod-cycles, show cycles in the module graph
78 ; dumpModCycles dflags mod_summaries
81 ; endMkDependHS dflags files }}
83 -----------------------------------------------------------------
86 -- Create a temporary file,
88 -- slurp through it, etc
90 -----------------------------------------------------------------
93 = MkDep { mkd_make_file :: FilePath, -- Name of the makefile
94 mkd_make_hdl :: Maybe Handle, -- Handle for the open makefile
95 mkd_tmp_file :: FilePath, -- Name of the temporary file
96 mkd_tmp_hdl :: Handle } -- Handle of the open temporary file
98 beginMkDependHS :: DynFlags -> IO MkDepFiles
99 beginMkDependHS dflags = do
100 -- slurp in the mkdependHS-style options
101 let flags = getOpts dflags opt_dep
102 _ <- processArgs dep_opts flags
104 -- open a new temp file in which to stuff the dependency info
106 tmp_file <- newTempName dflags "dep"
107 tmp_hdl <- openFile tmp_file WriteMode
110 makefile <- readIORef v_Dep_makefile
111 exists <- doesFileExist makefile
116 makefile_hdl <- openFile makefile ReadMode
118 -- slurp through until we get the magic start string,
119 -- copying the contents into dep_makefile
121 l <- hGetLine makefile_hdl
122 if (l == depStartMarker)
124 else do hPutStrLn tmp_hdl l; slurp
126 -- slurp through until we get the magic end marker,
127 -- throwing away the contents
129 l <- hGetLine makefile_hdl
130 if (l == depEndMarker)
134 catchJust ioErrors slurp
135 (\e -> if isEOFError e then return () else ioError e)
136 catchJust ioErrors chuck
137 (\e -> if isEOFError e then return () else ioError e)
139 return (Just makefile_hdl)
142 -- write the magic marker into the tmp file
143 hPutStrLn tmp_hdl depStartMarker
145 return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
146 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl})
149 -----------------------------------------------------------------
153 -----------------------------------------------------------------
155 processDeps :: Session
157 -> Handle -- Write dependencies to here
160 -- Write suitable dependencies to handle
164 -- If the dependency is on something other than a .hi file:
165 -- this.o this.p_o ... : dep
167 -- this.o ... : dep.hi
168 -- this.p_o ... : dep.p_hi
170 -- (where .o is $osuf, and the other suffixes come from
171 -- the cmdline -s options).
173 -- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
175 processDeps _ _ _ (CyclicSCC nodes)
176 = -- There shouldn't be any cycles; report them
177 throwDyn (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
179 processDeps session excl_mods hdl (AcyclicSCC node)
180 = do { extra_suffixes <- readIORef v_Dep_suffixes
181 ; hsc_env <- GHC.sessionHscEnv session
182 ; include_pkg_deps <- readIORef v_Dep_include_pkg_deps
183 ; let src_file = msHsFilePath node
184 obj_file = msObjFilePath node
185 obj_files = insertSuffixes obj_file extra_suffixes
187 do_imp is_boot imp_mod
188 = do { mb_hi <- findDependency hsc_env src_file imp_mod
189 is_boot include_pkg_deps
191 Nothing -> return () ;
193 { let hi_files = insertSuffixes hi_file extra_suffixes
194 write_dep (obj,hi) = writeDependency hdl [obj] hi
196 -- Add one dependency for each suffix;
199 ; mapM_ write_dep (obj_files `zip` hi_files) }}}
202 -- Emit std dependency of the object(s) on the source file
203 -- Something like A.o : A.hs
204 ; writeDependency hdl obj_files src_file
206 -- Emit a dependency for each import
209 ; mapM_ (do_imp True)
210 (filter (`notElem` excl_mods) (map unLoc (ms_srcimps node)))
213 ; mapM_ (do_imp False)
214 (filter (`notElem` excl_mods) (map unLoc (ms_imps node)))
218 findDependency :: HscEnv
219 -> FilePath -- Importing module: used only for error msg
220 -> ModuleName -- Imported module
221 -> IsBootInterface -- Source import
222 -> Bool -- Record dependency on package modules
223 -> IO (Maybe FilePath) -- Interface file file
224 findDependency hsc_env _ imp is_boot _include_pkg_deps
225 = do { -- Find the module; this will be fast because
226 -- we've done it once during downsweep
227 r <- findImportedModule hsc_env imp Nothing
230 -- Home package: just depend on the .hi or hi-boot file
231 | isJust (ml_hs_file loc)
232 -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
234 -- Not in this package: we don't need a dependency
238 _ -> panic "findDependency"
241 -----------------------------
242 writeDependency :: Handle -> [FilePath] -> FilePath -> IO ()
243 -- (writeDependency h [t1,t2] dep) writes to handle h the dependency
245 writeDependency hdl targets dep
246 = hPutStrLn hdl (unwords (map forOutput targets) ++ " : " ++ forOutput dep)
247 where forOutput = escapeSpaces . reslash Forwards . normalise
249 -----------------------------
251 :: FilePath -- Original filename; e.g. "foo.o"
252 -> [String] -- Extra suffices e.g. ["x","y"]
253 -> [FilePath] -- Zapped filenames e.g. ["foo.o", "foo.x_o", "foo.y_o"]
254 -- Note that that the extra bit gets inserted *before* the old suffix
255 -- We assume the old suffix contains no dots, so we can strip it with removeSuffix
257 -- NOTE: we used to have this comment
258 -- In order to construct hi files with alternate suffixes, we
259 -- now have to find the "basename" of the hi file. This is
260 -- difficult because we can't just split the hi filename
261 -- at the last dot - the hisuf might have dots in it. So we
262 -- check whether the hi filename ends in hisuf, and if it does,
263 -- we strip off hisuf, otherwise we strip everything after the
265 -- But I'm not sure we care about hisufs with dots in them.
266 -- Lots of other things will break first!
268 insertSuffixes file_name extras
269 = file_name : [ basename <.> (extra ++ "_" ++ suffix) | extra <- extras ]
271 (basename, suffix) = case splitExtension file_name of
272 -- Drop the "." from the extension
273 (b, s) -> (b, drop 1 s)
276 -----------------------------------------------------------------
279 -- Complete the makefile, close the tmp file etc
281 -----------------------------------------------------------------
283 endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
286 (MkDep { mkd_make_file = makefile, mkd_make_hdl = makefile_hdl,
287 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl })
289 -- write the magic marker into the tmp file
290 hPutStrLn tmp_hdl depEndMarker
296 -- slurp the rest of the original makefile and copy it into the output
302 catchJust ioErrors slurp
303 (\e -> if isEOFError e then return () else ioError e)
307 hClose tmp_hdl -- make sure it's flushed
309 -- Create a backup of the original makefile
310 when (isJust makefile_hdl)
311 (SysTools.copy dflags ("Backing up " ++ makefile)
312 makefile (makefile++".bak"))
314 -- Copy the new makefile in place
315 SysTools.copy dflags "Installing new makefile" tmp_file makefile
318 -----------------------------------------------------------------
320 -----------------------------------------------------------------
322 dumpModCycles :: DynFlags -> [ModSummary] -> IO ()
323 dumpModCycles dflags mod_summaries
324 | not (dopt Opt_D_dump_mod_cycles dflags)
328 = putMsg dflags (ptext (sLit "No module cycles"))
331 = putMsg dflags (hang (ptext (sLit "Module cycles found:")) 2 pp_cycles)
334 cycles :: [[ModSummary]]
335 cycles = [ c | CyclicSCC c <- GHC.topSortModuleGraph True mod_summaries Nothing ]
337 pp_cycles = vcat [ (ptext (sLit "---------- Cycle") <+> int n <+> ptext (sLit "----------"))
338 $$ pprCycle c $$ text ""
339 | (n,c) <- [1..] `zip` cycles ]
341 pprCycle :: [ModSummary] -> SDoc
342 -- Print a cycle, but show only the imports within the cycle
343 pprCycle summaries = pp_group (CyclicSCC summaries)
345 cycle_mods :: [ModuleName] -- The modules in this cycle
346 cycle_mods = map (moduleName . ms_mod) summaries
348 pp_group (AcyclicSCC ms) = pp_ms ms
349 pp_group (CyclicSCC mss)
350 = ASSERT( not (null boot_only) )
351 -- The boot-only list must be non-empty, else there would
352 -- be an infinite chain of non-boot imoprts, and we've
353 -- already checked for that in processModDeps
354 pp_ms loop_breaker $$ vcat (map pp_group groups)
356 (boot_only, others) = partition is_boot_only mss
357 is_boot_only ms = not (any in_group (ms_imps ms))
358 in_group (L _ m) = m `elem` group_mods
359 group_mods = map (moduleName . ms_mod) mss
361 loop_breaker = head boot_only
362 all_others = tail boot_only ++ others
363 groups = GHC.topSortModuleGraph True all_others Nothing
365 pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
366 <+> (pp_imps empty (ms_imps summary) $$
367 pp_imps (ptext (sLit "{-# SOURCE #-}")) (ms_srcimps summary))
369 mod_str = moduleNameString (moduleName (ms_mod summary))
371 pp_imps :: SDoc -> [Located ModuleName] -> SDoc
374 = case [m | L _ m <- lms, m `elem` cycle_mods] of
376 ms -> what <+> ptext (sLit "imports") <+>
379 -----------------------------------------------------------------
383 -----------------------------------------------------------------
386 GLOBAL_VAR(v_Dep_makefile, "Makefile", String);
387 GLOBAL_VAR(v_Dep_include_pkg_deps, False, Bool);
388 GLOBAL_VAR(v_Dep_exclude_mods, [], [ModuleName]);
389 GLOBAL_VAR(v_Dep_suffixes, [], [String]);
390 GLOBAL_VAR(v_Dep_warnings, True, Bool);
392 depStartMarker, depEndMarker :: String
393 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
394 depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"
396 -- for compatibility with the old mkDependHS, we accept options of the form
397 -- -optdep-f -optdep.depend, etc.
398 dep_opts :: [Flag IO]
400 [ Flag "s" (SepArg (consIORef v_Dep_suffixes))
402 , Flag "f" (SepArg (writeIORef v_Dep_makefile))
404 , Flag "w" (NoArg (writeIORef v_Dep_warnings False))
407 , Flag "-include-prelude" (NoArg (writeIORef v_Dep_include_pkg_deps True))
408 (Deprecated "Use --include-pkg-deps instead")
410 , Flag "-include-pkg-deps" (NoArg (writeIORef v_Dep_include_pkg_deps True))
412 , Flag "-exclude-module=" (Prefix (consIORef v_Dep_exclude_mods . mkModuleName))
414 , Flag "x" (Prefix (consIORef v_Dep_exclude_mods . mkModuleName))