2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
8 -----------------------------------------------------------------------------
10 -- Makefile Dependency Generation
12 -- (c) The University of Glasgow 2005
14 -----------------------------------------------------------------------------
16 module DriverMkDepend (
20 #include "HsVersions.h"
23 import GHC ( Session, ModSummary(..) )
26 import HscTypes ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
27 import SysTools ( newTempName )
28 import qualified SysTools
30 import Digraph ( SCC(..) )
31 import Finder ( findImportedModule, FindResult(..) )
32 import Util ( global, consIORef )
40 import ErrUtils ( debugTraceMsg, putMsg )
42 import Data.IORef ( IORef, readIORef, writeIORef )
43 import Control.Exception
44 import System.Exit ( ExitCode(..), exitWith )
45 import System.Directory
46 import System.FilePath
48 import SYSTEM_IO_ERROR ( isEOFError )
49 import Control.Monad ( when )
50 import Data.Maybe ( isJust )
52 -----------------------------------------------------------------
56 -----------------------------------------------------------------
58 doMkDependHS :: Session -> [FilePath] -> IO ()
59 doMkDependHS session srcs
60 = do { -- Initialisation
61 dflags <- GHC.getSessionDynFlags session
62 ; files <- beginMkDependHS dflags
64 -- Do the downsweep to find all the modules
65 ; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
66 ; GHC.setTargets session targets
67 ; excl_mods <- readIORef v_Dep_exclude_mods
68 ; r <- GHC.depanal session excl_mods True {- Allow dup roots -}
70 Nothing -> exitWith (ExitFailure 1)
71 Just mod_summaries -> do {
73 -- Sort into dependency order
74 -- There should be no cycles
75 let sorted = GHC.topSortModuleGraph False mod_summaries Nothing
77 -- Print out the dependencies if wanted
78 ; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
80 -- Prcess them one by one, dumping results into makefile
81 -- and complaining about cycles
82 ; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted
84 -- If -ddump-mod-cycles, show cycles in the module graph
85 ; dumpModCycles dflags mod_summaries
88 ; endMkDependHS dflags files }}
90 -----------------------------------------------------------------
93 -- Create a temporary file,
95 -- slurp through it, etc
97 -----------------------------------------------------------------
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
105 beginMkDependHS :: DynFlags -> IO MkDepFiles
107 beginMkDependHS dflags = do
108 -- slurp in the mkdependHS-style options
109 let flags = getOpts dflags opt_dep
110 _ <- processArgs dep_opts flags
112 -- open a new temp file in which to stuff the dependency info
114 tmp_file <- newTempName dflags "dep"
115 tmp_hdl <- openFile tmp_file WriteMode
118 makefile <- readIORef v_Dep_makefile
119 exists <- doesFileExist makefile
124 makefile_hdl <- openFile makefile ReadMode
126 -- slurp through until we get the magic start string,
127 -- copying the contents into dep_makefile
129 l <- hGetLine makefile_hdl
130 if (l == depStartMarker)
132 else do hPutStrLn tmp_hdl l; slurp
134 -- slurp through until we get the magic end marker,
135 -- throwing away the contents
137 l <- hGetLine makefile_hdl
138 if (l == depEndMarker)
142 catchJust ioErrors slurp
143 (\e -> if isEOFError e then return () else ioError e)
144 catchJust ioErrors chuck
145 (\e -> if isEOFError e then return () else ioError e)
147 return (Just makefile_hdl)
150 -- write the magic marker into the tmp file
151 hPutStrLn tmp_hdl depStartMarker
153 return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
154 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl})
157 -----------------------------------------------------------------
161 -----------------------------------------------------------------
163 processDeps :: Session
165 -> Handle -- Write dependencies to here
168 -- Write suitable dependencies to handle
172 -- If the dependency is on something other than a .hi file:
173 -- this.o this.p_o ... : dep
175 -- this.o ... : dep.hi
176 -- this.p_o ... : dep.p_hi
178 -- (where .o is $osuf, and the other suffixes come from
179 -- the cmdline -s options).
181 -- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
183 processDeps session excl_mods hdl (CyclicSCC nodes)
184 = -- There shouldn't be any cycles; report them
185 throwDyn (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
187 processDeps session excl_mods hdl (AcyclicSCC node)
188 = do { extra_suffixes <- readIORef v_Dep_suffixes
189 ; hsc_env <- GHC.sessionHscEnv session
190 ; include_pkg_deps <- readIORef v_Dep_include_pkg_deps
191 ; let src_file = msHsFilePath node
192 obj_file = msObjFilePath node
193 obj_files = insertSuffixes obj_file extra_suffixes
195 do_imp is_boot imp_mod
196 = do { mb_hi <- findDependency hsc_env src_file imp_mod
197 is_boot include_pkg_deps
199 Nothing -> return () ;
201 { let hi_files = insertSuffixes hi_file extra_suffixes
202 write_dep (obj,hi) = writeDependency hdl [obj] hi
204 -- Add one dependency for each suffix;
207 ; mapM_ write_dep (obj_files `zip` hi_files) }}}
210 -- Emit std dependency of the object(s) on the source file
211 -- Something like A.o : A.hs
212 ; writeDependency hdl obj_files src_file
214 -- Emit a dependency for each import
217 ; mapM_ (do_imp True)
218 (filter (`notElem` excl_mods) (map unLoc (ms_srcimps node)))
221 ; mapM_ (do_imp False)
222 (filter (`notElem` excl_mods) (map unLoc (ms_imps node)))
226 findDependency :: HscEnv
227 -> FilePath -- Importing module: used only for error msg
228 -> ModuleName -- Imported module
229 -> IsBootInterface -- Source import
230 -> Bool -- Record dependency on package modules
231 -> IO (Maybe FilePath) -- Interface file file
232 findDependency hsc_env src imp is_boot include_pkg_deps
233 = do { -- Find the module; this will be fast because
234 -- we've done it once during downsweep
235 r <- findImportedModule hsc_env imp Nothing
238 -- Home package: just depend on the .hi or hi-boot file
239 | isJust (ml_hs_file loc)
240 -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
242 -- Not in this package: we don't need a dependency
246 _ -> panic "findDependency"
249 -----------------------------
250 writeDependency :: Handle -> [FilePath] -> FilePath -> IO ()
251 -- (writeDependency h [t1,t2] dep) writes to handle h the dependency
253 writeDependency hdl targets dep
254 = hPutStrLn hdl (unwords (map forOutput targets) ++ " : " ++ forOutput dep)
255 where forOutput = escapeSpaces . reslash Forwards . normalise
257 -----------------------------
259 :: FilePath -- Original filename; e.g. "foo.o"
260 -> [String] -- Extra suffices e.g. ["x","y"]
261 -> [FilePath] -- Zapped filenames e.g. ["foo.o", "foo.x_o", "foo.y_o"]
262 -- Note that that the extra bit gets inserted *before* the old suffix
263 -- We assume the old suffix contains no dots, so we can strip it with removeSuffix
265 -- NOTE: we used to have this comment
266 -- In order to construct hi files with alternate suffixes, we
267 -- now have to find the "basename" of the hi file. This is
268 -- difficult because we can't just split the hi filename
269 -- at the last dot - the hisuf might have dots in it. So we
270 -- check whether the hi filename ends in hisuf, and if it does,
271 -- we strip off hisuf, otherwise we strip everything after the
273 -- But I'm not sure we care about hisufs with dots in them.
274 -- Lots of other things will break first!
276 insertSuffixes file_name extras
277 = file_name : [ basename <.> (extra ++ "_" ++ suffix) | extra <- extras ]
279 (basename, suffix) = case splitExtension file_name of
280 -- Drop the "." from the extension
281 (b, s) -> (b, drop 1 s)
284 -----------------------------------------------------------------
287 -- Complete the makefile, close the tmp file etc
289 -----------------------------------------------------------------
291 endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
294 (MkDep { mkd_make_file = makefile, mkd_make_hdl = makefile_hdl,
295 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl })
297 -- write the magic marker into the tmp file
298 hPutStrLn tmp_hdl depEndMarker
304 -- slurp the rest of the original makefile and copy it into the output
310 catchJust ioErrors slurp
311 (\e -> if isEOFError e then return () else ioError e)
315 hClose tmp_hdl -- make sure it's flushed
317 -- Create a backup of the original makefile
318 when (isJust makefile_hdl)
319 (SysTools.copy dflags ("Backing up " ++ makefile)
320 makefile (makefile++".bak"))
322 -- Copy the new makefile in place
323 SysTools.copy dflags "Installing new makefile" tmp_file makefile
326 -----------------------------------------------------------------
328 -----------------------------------------------------------------
330 dumpModCycles :: DynFlags -> [ModSummary] -> IO ()
331 dumpModCycles dflags mod_summaries
332 | not (dopt Opt_D_dump_mod_cycles dflags)
336 = putMsg dflags (ptext (sLit "No module cycles"))
339 = putMsg dflags (hang (ptext (sLit "Module cycles found:")) 2 pp_cycles)
342 cycles :: [[ModSummary]]
343 cycles = [ c | CyclicSCC c <- GHC.topSortModuleGraph True mod_summaries Nothing ]
345 pp_cycles = vcat [ (ptext (sLit "---------- Cycle") <+> int n <+> ptext (sLit "----------"))
346 $$ pprCycle c $$ text ""
347 | (n,c) <- [1..] `zip` cycles ]
349 pprCycle :: [ModSummary] -> SDoc
350 -- Print a cycle, but show only the imports within the cycle
351 pprCycle summaries = pp_group (CyclicSCC summaries)
353 cycle_mods :: [ModuleName] -- The modules in this cycle
354 cycle_mods = map (moduleName . ms_mod) summaries
356 pp_group (AcyclicSCC ms) = pp_ms ms
357 pp_group (CyclicSCC mss)
358 = ASSERT( not (null boot_only) )
359 -- The boot-only list must be non-empty, else there would
360 -- be an infinite chain of non-boot imoprts, and we've
361 -- already checked for that in processModDeps
362 pp_ms loop_breaker $$ vcat (map pp_group groups)
364 (boot_only, others) = partition is_boot_only mss
365 is_boot_only ms = not (any in_group (ms_imps ms))
366 in_group (L _ m) = m `elem` group_mods
367 group_mods = map (moduleName . ms_mod) mss
369 loop_breaker = head boot_only
370 all_others = tail boot_only ++ others
371 groups = GHC.topSortModuleGraph True all_others Nothing
373 pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
374 <+> (pp_imps empty (ms_imps summary) $$
375 pp_imps (ptext (sLit "{-# SOURCE #-}")) (ms_srcimps summary))
377 mod_str = moduleNameString (moduleName (ms_mod summary))
379 pp_imps :: SDoc -> [Located ModuleName] -> SDoc
380 pp_imps what [] = empty
382 = case [m | L _ m <- lms, m `elem` cycle_mods] of
384 ms -> what <+> ptext (sLit "imports") <+>
387 -----------------------------------------------------------------
391 -----------------------------------------------------------------
394 GLOBAL_VAR(v_Dep_makefile, "Makefile", String);
395 GLOBAL_VAR(v_Dep_include_pkg_deps, False, Bool);
396 GLOBAL_VAR(v_Dep_exclude_mods, [], [ModuleName]);
397 GLOBAL_VAR(v_Dep_suffixes, [], [String]);
398 GLOBAL_VAR(v_Dep_warnings, True, Bool);
400 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
401 depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"
403 -- for compatibility with the old mkDependHS, we accept options of the form
404 -- -optdep-f -optdep.depend, etc.
406 [ ( "s", SepArg (consIORef v_Dep_suffixes) )
407 , ( "f", SepArg (writeIORef v_Dep_makefile) )
408 , ( "w", NoArg (writeIORef v_Dep_warnings False) )
410 , ( "-include-prelude", NoArg (writeIORef v_Dep_include_pkg_deps True) )
411 -- -include-prelude is the old name for -include-pkg-deps, kept around
412 -- for backward compatibility, but undocumented
414 , ( "-include-pkg-deps", NoArg (writeIORef v_Dep_include_pkg_deps True) )
415 , ( "-exclude-module=", Prefix (consIORef v_Dep_exclude_mods . mkModuleName) )
416 , ( "x", Prefix (consIORef v_Dep_exclude_mods . mkModuleName) )