1 {-# OPTIONS -fno-cse #-}
2 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
4 -----------------------------------------------------------------------------
6 -- Makefile Dependency Generation
8 -- (c) The University of Glasgow 2005
10 -----------------------------------------------------------------------------
12 module DriverMkDepend (
16 #include "HsVersions.h"
19 import GHC ( ModSummary(..), GhcMonad )
20 import HsSyn ( ImportDecl(..) )
25 import SysTools ( newTempName )
26 import qualified SysTools
28 import Digraph ( SCC(..) )
38 import MonadUtils ( liftIO )
40 import System.Directory
41 import System.FilePath
43 import System.IO.Error ( isEOFError )
44 import Control.Monad ( when )
45 import Data.Maybe ( isJust )
47 -----------------------------------------------------------------
51 -----------------------------------------------------------------
53 doMkDependHS :: GhcMonad m => [FilePath] -> m ()
54 doMkDependHS srcs = do
56 dflags <- GHC.getSessionDynFlags
57 files <- liftIO $ beginMkDependHS dflags
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 -}
65 -- Sort into dependency order
66 -- There should be no cycles
67 let sorted = GHC.topSortModuleGraph False mod_summaries Nothing
69 -- Print out the dependencies if wanted
70 liftIO $ debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
72 -- Prcess them one by one, dumping results into makefile
73 -- and complaining about cycles
75 root <- liftIO getCurrentDirectory
76 mapM (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files)) sorted
78 -- If -ddump-mod-cycles, show cycles in the module graph
79 liftIO $ dumpModCycles dflags mod_summaries
82 liftIO $ endMkDependHS dflags files
84 -- Unconditional exiting is a bad idea. If an error occurs we'll get an
85 --exception; if that is not caught it's fine, but at least we have a
86 --chance to find out exactly what went wrong. Uncomment the following
87 --line if you disagree.
89 --`GHC.ghcCatch` \_ -> io $ exitWith (ExitFailure 1)
91 -----------------------------------------------------------------
94 -- Create a temporary file,
96 -- slurp through it, etc
98 -----------------------------------------------------------------
101 = MkDep { mkd_make_file :: FilePath, -- Name of the makefile
102 mkd_make_hdl :: Maybe Handle, -- Handle for the open makefile
103 mkd_tmp_file :: FilePath, -- Name of the temporary file
104 mkd_tmp_hdl :: Handle } -- Handle of the open temporary file
106 beginMkDependHS :: DynFlags -> IO MkDepFiles
107 beginMkDependHS dflags = do
108 -- open a new temp file in which to stuff the dependency info
110 tmp_file <- newTempName dflags "dep"
111 tmp_hdl <- openFile tmp_file WriteMode
114 let makefile = depMakefile dflags
115 exists <- doesFileExist makefile
120 makefile_hdl <- openFile makefile ReadMode
122 -- slurp through until we get the magic start string,
123 -- copying the contents into dep_makefile
125 l <- hGetLine makefile_hdl
126 if (l == depStartMarker)
128 else do hPutStrLn tmp_hdl l; slurp
130 -- slurp through until we get the magic end marker,
131 -- throwing away the contents
133 l <- hGetLine makefile_hdl
134 if (l == depEndMarker)
139 (\e -> if isEOFError e then return () else ioError e)
141 (\e -> if isEOFError e then return () else ioError e)
143 return (Just makefile_hdl)
146 -- write the magic marker into the tmp file
147 hPutStrLn tmp_hdl depStartMarker
149 return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
150 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl})
153 -----------------------------------------------------------------
157 -----------------------------------------------------------------
159 processDeps :: DynFlags
163 -> Handle -- Write dependencies to here
166 -- Write suitable dependencies to handle
170 -- If the dependency is on something other than a .hi file:
171 -- this.o this.p_o ... : dep
173 -- this.o ... : dep.hi
174 -- this.p_o ... : dep.p_hi
176 -- (where .o is $osuf, and the other suffixes come from
177 -- the cmdline -s options).
179 -- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
181 processDeps _ _ _ _ _ (CyclicSCC nodes)
182 = -- There shouldn't be any cycles; report them
183 ghcError (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
185 processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC node)
186 = do { let extra_suffixes = depSuffixes dflags
187 include_pkg_deps = depIncludePkgDeps dflags
188 src_file = msHsFilePath node
189 obj_file = msObjFilePath node
190 obj_files = insertSuffixes obj_file extra_suffixes
192 do_imp loc is_boot pkg_qual imp_mod
193 = do { mb_hi <- findDependency hsc_env loc pkg_qual imp_mod
194 is_boot include_pkg_deps
196 Nothing -> return () ;
198 { let hi_files = insertSuffixes hi_file extra_suffixes
199 write_dep (obj,hi) = writeDependency root hdl [obj] hi
201 -- Add one dependency for each suffix;
204 ; mapM_ write_dep (obj_files `zip` hi_files) }}}
207 -- Emit std dependency of the object(s) on the source file
208 -- Something like A.o : A.hs
209 ; writeDependency root hdl obj_files src_file
211 -- Emit a dependency for each import
213 ; let do_imps is_boot idecls = sequence_
214 [ do_imp loc is_boot (ideclPkgQual i) mod
216 let mod = unLoc (ideclName i),
217 mod `notElem` excl_mods ]
219 ; do_imps True (ms_srcimps node)
220 ; do_imps False (ms_imps node)
222 ; when (dopt Opt_ImplicitPrelude (ms_hspp_opts node)) $
223 do_imp noSrcSpan False Nothing pRELUDE_NAME
227 findDependency :: HscEnv
229 -> Maybe FastString -- package qualifier, if any
230 -> ModuleName -- Imported module
231 -> IsBootInterface -- Source import
232 -> Bool -- Record dependency on package modules
233 -> IO (Maybe FilePath) -- Interface file file
234 findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps
235 = do { -- Find the module; this will be fast because
236 -- we've done it once during downsweep
237 r <- findImportedModule hsc_env imp pkg
240 -- Home package: just depend on the .hi or hi-boot file
241 | isJust (ml_hs_file loc) || include_pkg_deps
242 -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
244 -- Not in this package: we don't need a dependency
248 fail -> throwOneError $ mkPlainErrMsg srcloc $
249 cannotFindModule (hsc_dflags hsc_env) imp fail
252 -----------------------------
253 writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
254 -- (writeDependency r h [t1,t2] dep) writes to handle h the dependency
256 writeDependency root hdl targets dep
257 = do let -- We need to avoid making deps on
259 -- on cygwin as make gets confused by the :
260 -- Making relative deps avoids some instances of this.
261 dep' = makeRelative root dep
262 forOutput = escapeSpaces . reslash Forwards . normalise
263 output = unwords (map forOutput targets) ++ " : " ++ forOutput dep'
266 -----------------------------
268 :: FilePath -- Original filename; e.g. "foo.o"
269 -> [String] -- Extra suffices e.g. ["x","y"]
270 -> [FilePath] -- Zapped filenames e.g. ["foo.o", "foo.x_o", "foo.y_o"]
271 -- Note that that the extra bit gets inserted *before* the old suffix
272 -- We assume the old suffix contains no dots, so we can strip it with removeSuffix
274 -- NOTE: we used to have this comment
275 -- In order to construct hi files with alternate suffixes, we
276 -- now have to find the "basename" of the hi file. This is
277 -- difficult because we can't just split the hi filename
278 -- at the last dot - the hisuf might have dots in it. So we
279 -- check whether the hi filename ends in hisuf, and if it does,
280 -- we strip off hisuf, otherwise we strip everything after the
282 -- But I'm not sure we care about hisufs with dots in them.
283 -- Lots of other things will break first!
285 insertSuffixes file_name extras
286 = file_name : [ basename <.> (extra ++ "_" ++ suffix) | extra <- extras ]
288 (basename, suffix) = case splitExtension file_name of
289 -- Drop the "." from the extension
290 (b, s) -> (b, drop 1 s)
293 -----------------------------------------------------------------
296 -- Complete the makefile, close the tmp file etc
298 -----------------------------------------------------------------
300 endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
303 (MkDep { mkd_make_file = makefile, mkd_make_hdl = makefile_hdl,
304 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl })
306 -- write the magic marker into the tmp file
307 hPutStrLn tmp_hdl depEndMarker
313 -- slurp the rest of the original makefile and copy it into the output
320 (\e -> if isEOFError e then return () else ioError e)
324 hClose tmp_hdl -- make sure it's flushed
326 -- Create a backup of the original makefile
327 when (isJust makefile_hdl)
328 (SysTools.copy dflags ("Backing up " ++ makefile)
329 makefile (makefile++".bak"))
331 -- Copy the new makefile in place
332 SysTools.copy dflags "Installing new makefile" tmp_file makefile
335 -----------------------------------------------------------------
337 -----------------------------------------------------------------
339 dumpModCycles :: DynFlags -> [ModSummary] -> IO ()
340 dumpModCycles dflags mod_summaries
341 | not (dopt Opt_D_dump_mod_cycles dflags)
345 = putMsg dflags (ptext (sLit "No module cycles"))
348 = putMsg dflags (hang (ptext (sLit "Module cycles found:")) 2 pp_cycles)
351 cycles :: [[ModSummary]]
352 cycles = [ c | CyclicSCC c <- GHC.topSortModuleGraph True mod_summaries Nothing ]
354 pp_cycles = vcat [ (ptext (sLit "---------- Cycle") <+> int n <+> ptext (sLit "----------"))
355 $$ pprCycle c $$ text ""
356 | (n,c) <- [1..] `zip` cycles ]
358 pprCycle :: [ModSummary] -> SDoc
359 -- Print a cycle, but show only the imports within the cycle
360 pprCycle summaries = pp_group (CyclicSCC summaries)
362 cycle_mods :: [ModuleName] -- The modules in this cycle
363 cycle_mods = map (moduleName . ms_mod) summaries
365 pp_group (AcyclicSCC ms) = pp_ms ms
366 pp_group (CyclicSCC mss)
367 = ASSERT( not (null boot_only) )
368 -- The boot-only list must be non-empty, else there would
369 -- be an infinite chain of non-boot imoprts, and we've
370 -- already checked for that in processModDeps
371 pp_ms loop_breaker $$ vcat (map pp_group groups)
373 (boot_only, others) = partition is_boot_only mss
374 is_boot_only ms = not (any in_group (map (ideclName.unLoc) (ms_imps ms)))
375 in_group (L _ m) = m `elem` group_mods
376 group_mods = map (moduleName . ms_mod) mss
378 loop_breaker = head boot_only
379 all_others = tail boot_only ++ others
380 groups = GHC.topSortModuleGraph True all_others Nothing
382 pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
383 <+> (pp_imps empty (map (ideclName.unLoc) (ms_imps summary)) $$
384 pp_imps (ptext (sLit "{-# SOURCE #-}")) (map (ideclName.unLoc) (ms_srcimps summary)))
386 mod_str = moduleNameString (moduleName (ms_mod summary))
388 pp_imps :: SDoc -> [Located ModuleName] -> SDoc
391 = case [m | L _ m <- lms, m `elem` cycle_mods] of
393 ms -> what <+> ptext (sLit "imports") <+>
396 -----------------------------------------------------------------
400 -----------------------------------------------------------------
402 depStartMarker, depEndMarker :: String
403 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
404 depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"