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 ( Session, ModSummary(..) )
22 import HscTypes ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
23 import SysTools ( newTempName )
24 import qualified SysTools
26 import Digraph ( SCC(..) )
27 import Finder ( findImportedModule, FindResult(..) )
34 import ErrUtils ( debugTraceMsg, putMsg )
36 import System.Exit ( ExitCode(..), exitWith )
37 import System.Directory
38 import System.FilePath
40 import System.IO.Error ( isEOFError )
41 import Control.Monad ( when )
42 import Data.Maybe ( isJust )
44 -----------------------------------------------------------------
48 -----------------------------------------------------------------
50 doMkDependHS :: Session -> [FilePath] -> IO ()
51 doMkDependHS session srcs
52 = do { -- Initialisation
53 dflags <- GHC.getSessionDynFlags session
54 ; files <- beginMkDependHS dflags
56 -- Do the downsweep to find all the modules
57 ; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
58 ; GHC.setTargets session targets
59 ; let excl_mods = depExcludeMods dflags
60 ; r <- GHC.depanal session excl_mods True {- Allow dup roots -}
62 Nothing -> exitWith (ExitFailure 1)
63 Just mod_summaries -> do {
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 ; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
72 -- Prcess them one by one, dumping results into makefile
73 -- and complaining about cycles
74 ; mapM (processDeps dflags session excl_mods (mkd_tmp_hdl files)) sorted
76 -- If -ddump-mod-cycles, show cycles in the module graph
77 ; dumpModCycles dflags mod_summaries
80 ; endMkDependHS dflags files }}
82 -----------------------------------------------------------------
85 -- Create a temporary file,
87 -- slurp through it, etc
89 -----------------------------------------------------------------
92 = MkDep { mkd_make_file :: FilePath, -- Name of the makefile
93 mkd_make_hdl :: Maybe Handle, -- Handle for the open makefile
94 mkd_tmp_file :: FilePath, -- Name of the temporary file
95 mkd_tmp_hdl :: Handle } -- Handle of the open temporary file
97 beginMkDependHS :: DynFlags -> IO MkDepFiles
98 beginMkDependHS dflags = do
99 -- open a new temp file in which to stuff the dependency info
101 tmp_file <- newTempName dflags "dep"
102 tmp_hdl <- openFile tmp_file WriteMode
105 let makefile = depMakefile dflags
106 exists <- doesFileExist makefile
111 makefile_hdl <- openFile makefile ReadMode
113 -- slurp through until we get the magic start string,
114 -- copying the contents into dep_makefile
116 l <- hGetLine makefile_hdl
117 if (l == depStartMarker)
119 else do hPutStrLn tmp_hdl l; slurp
121 -- slurp through until we get the magic end marker,
122 -- throwing away the contents
124 l <- hGetLine makefile_hdl
125 if (l == depEndMarker)
129 catchJust ioErrors slurp
130 (\e -> if isEOFError e then return () else ioError e)
131 catchJust ioErrors chuck
132 (\e -> if isEOFError e then return () else ioError e)
134 return (Just makefile_hdl)
137 -- write the magic marker into the tmp file
138 hPutStrLn tmp_hdl depStartMarker
140 return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
141 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl})
144 -----------------------------------------------------------------
148 -----------------------------------------------------------------
150 processDeps :: DynFlags
153 -> Handle -- Write dependencies to here
156 -- Write suitable dependencies to handle
160 -- If the dependency is on something other than a .hi file:
161 -- this.o this.p_o ... : dep
163 -- this.o ... : dep.hi
164 -- this.p_o ... : dep.p_hi
166 -- (where .o is $osuf, and the other suffixes come from
167 -- the cmdline -s options).
169 -- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
171 processDeps _ _ _ _ (CyclicSCC nodes)
172 = -- There shouldn't be any cycles; report them
173 ghcError (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
175 processDeps dflags session excl_mods hdl (AcyclicSCC node)
176 = do { hsc_env <- GHC.sessionHscEnv session
177 ; let extra_suffixes = depSuffixes dflags
178 include_pkg_deps = depIncludePkgDeps dflags
179 src_file = msHsFilePath node
180 obj_file = msObjFilePath node
181 obj_files = insertSuffixes obj_file extra_suffixes
183 do_imp is_boot imp_mod
184 = do { mb_hi <- findDependency hsc_env src_file imp_mod
185 is_boot include_pkg_deps
187 Nothing -> return () ;
189 { let hi_files = insertSuffixes hi_file extra_suffixes
190 write_dep (obj,hi) = writeDependency hdl [obj] hi
192 -- Add one dependency for each suffix;
195 ; mapM_ write_dep (obj_files `zip` hi_files) }}}
198 -- Emit std dependency of the object(s) on the source file
199 -- Something like A.o : A.hs
200 ; writeDependency hdl obj_files src_file
202 -- Emit a dependency for each import
205 ; mapM_ (do_imp True)
206 (filter (`notElem` excl_mods) (map unLoc (ms_srcimps node)))
209 ; mapM_ (do_imp False)
210 (filter (`notElem` excl_mods) (map unLoc (ms_imps node)))
214 findDependency :: HscEnv
215 -> FilePath -- Importing module: used only for error msg
216 -> ModuleName -- Imported module
217 -> IsBootInterface -- Source import
218 -> Bool -- Record dependency on package modules
219 -> IO (Maybe FilePath) -- Interface file file
220 findDependency hsc_env _ imp is_boot _include_pkg_deps
221 = do { -- Find the module; this will be fast because
222 -- we've done it once during downsweep
223 r <- findImportedModule hsc_env imp Nothing
226 -- Home package: just depend on the .hi or hi-boot file
227 | isJust (ml_hs_file loc)
228 -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
230 -- Not in this package: we don't need a dependency
234 _ -> panic "findDependency"
237 -----------------------------
238 writeDependency :: Handle -> [FilePath] -> FilePath -> IO ()
239 -- (writeDependency h [t1,t2] dep) writes to handle h the dependency
241 writeDependency hdl targets dep
242 = hPutStrLn hdl (unwords (map forOutput targets) ++ " : " ++ forOutput dep)
243 where forOutput = escapeSpaces . reslash Forwards . normalise
245 -----------------------------
247 :: FilePath -- Original filename; e.g. "foo.o"
248 -> [String] -- Extra suffices e.g. ["x","y"]
249 -> [FilePath] -- Zapped filenames e.g. ["foo.o", "foo.x_o", "foo.y_o"]
250 -- Note that that the extra bit gets inserted *before* the old suffix
251 -- We assume the old suffix contains no dots, so we can strip it with removeSuffix
253 -- NOTE: we used to have this comment
254 -- In order to construct hi files with alternate suffixes, we
255 -- now have to find the "basename" of the hi file. This is
256 -- difficult because we can't just split the hi filename
257 -- at the last dot - the hisuf might have dots in it. So we
258 -- check whether the hi filename ends in hisuf, and if it does,
259 -- we strip off hisuf, otherwise we strip everything after the
261 -- But I'm not sure we care about hisufs with dots in them.
262 -- Lots of other things will break first!
264 insertSuffixes file_name extras
265 = file_name : [ basename <.> (extra ++ "_" ++ suffix) | extra <- extras ]
267 (basename, suffix) = case splitExtension file_name of
268 -- Drop the "." from the extension
269 (b, s) -> (b, drop 1 s)
272 -----------------------------------------------------------------
275 -- Complete the makefile, close the tmp file etc
277 -----------------------------------------------------------------
279 endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
282 (MkDep { mkd_make_file = makefile, mkd_make_hdl = makefile_hdl,
283 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl })
285 -- write the magic marker into the tmp file
286 hPutStrLn tmp_hdl depEndMarker
292 -- slurp the rest of the original makefile and copy it into the output
298 catchJust ioErrors slurp
299 (\e -> if isEOFError e then return () else ioError e)
303 hClose tmp_hdl -- make sure it's flushed
305 -- Create a backup of the original makefile
306 when (isJust makefile_hdl)
307 (SysTools.copy dflags ("Backing up " ++ makefile)
308 makefile (makefile++".bak"))
310 -- Copy the new makefile in place
311 SysTools.copy dflags "Installing new makefile" tmp_file makefile
314 -----------------------------------------------------------------
316 -----------------------------------------------------------------
318 dumpModCycles :: DynFlags -> [ModSummary] -> IO ()
319 dumpModCycles dflags mod_summaries
320 | not (dopt Opt_D_dump_mod_cycles dflags)
324 = putMsg dflags (ptext (sLit "No module cycles"))
327 = putMsg dflags (hang (ptext (sLit "Module cycles found:")) 2 pp_cycles)
330 cycles :: [[ModSummary]]
331 cycles = [ c | CyclicSCC c <- GHC.topSortModuleGraph True mod_summaries Nothing ]
333 pp_cycles = vcat [ (ptext (sLit "---------- Cycle") <+> int n <+> ptext (sLit "----------"))
334 $$ pprCycle c $$ text ""
335 | (n,c) <- [1..] `zip` cycles ]
337 pprCycle :: [ModSummary] -> SDoc
338 -- Print a cycle, but show only the imports within the cycle
339 pprCycle summaries = pp_group (CyclicSCC summaries)
341 cycle_mods :: [ModuleName] -- The modules in this cycle
342 cycle_mods = map (moduleName . ms_mod) summaries
344 pp_group (AcyclicSCC ms) = pp_ms ms
345 pp_group (CyclicSCC mss)
346 = ASSERT( not (null boot_only) )
347 -- The boot-only list must be non-empty, else there would
348 -- be an infinite chain of non-boot imoprts, and we've
349 -- already checked for that in processModDeps
350 pp_ms loop_breaker $$ vcat (map pp_group groups)
352 (boot_only, others) = partition is_boot_only mss
353 is_boot_only ms = not (any in_group (ms_imps ms))
354 in_group (L _ m) = m `elem` group_mods
355 group_mods = map (moduleName . ms_mod) mss
357 loop_breaker = head boot_only
358 all_others = tail boot_only ++ others
359 groups = GHC.topSortModuleGraph True all_others Nothing
361 pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
362 <+> (pp_imps empty (ms_imps summary) $$
363 pp_imps (ptext (sLit "{-# SOURCE #-}")) (ms_srcimps summary))
365 mod_str = moduleNameString (moduleName (ms_mod summary))
367 pp_imps :: SDoc -> [Located ModuleName] -> SDoc
370 = case [m | L _ m <- lms, m `elem` cycle_mods] of
372 ms -> what <+> ptext (sLit "imports") <+>
375 -----------------------------------------------------------------
379 -----------------------------------------------------------------
381 depStartMarker, depEndMarker :: String
382 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
383 depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"