1 -----------------------------------------------------------------------------
2 -- $Id: DriverMkDepend.hs,v 1.38 2005/01/27 14:38:29 simonmar Exp $
6 -- (c) Simon Marlow 2000
8 -----------------------------------------------------------------------------
10 module DriverMkDepend (
14 #include "HsVersions.h"
16 import CompManager ( cmInit, cmDepAnal, cmTopSort, cyclicModuleErr )
17 import CmdLineOpts ( DynFlags( verbosity ) )
18 import DriverState ( getStaticOpts, v_Opt_dep )
19 import DriverUtil ( escapeSpaces, splitFilename, add )
20 import DriverFlags ( processArgs, OptKind(..) )
21 import HscTypes ( IsBootInterface, ModSummary(..), GhciMode(..),
22 msObjFilePath, msHsFilePath )
23 import Packages ( PackageIdH(..) )
24 import SysTools ( newTempName )
25 import qualified SysTools
26 import Module ( Module, ModLocation(..), moduleUserString, addBootSuffix_maybe )
27 import Digraph ( SCC(..) )
28 import Finder ( findModule, FindResult(..) )
29 import Util ( global )
33 import DATA_IOREF ( IORef, readIORef, writeIORef )
39 import Maybe ( isJust )
41 #if __GLASGOW_HASKELL__ <= 408
42 import Panic ( catchJust, ioErrors )
45 -----------------------------------------------------------------
49 -----------------------------------------------------------------
51 doMkDependHS :: DynFlags -> [FilePath] -> IO ()
52 doMkDependHS dflags srcs
53 = do { -- Initialisation
54 cm_state <- cmInit Batch dflags
55 ; files <- beginMkDependHS
57 -- Do the downsweep to find all the modules
58 ; mod_summaries <- cmDepAnal cm_state srcs
60 -- Sort into dependency order
61 -- There should be no cycles
62 ; let sorted = cmTopSort False mod_summaries
64 -- Print out the dependencies if wanted
65 ; if verbosity dflags >= 3 then
66 hPutStrLn stderr (showSDoc (text "Module dependencies" $$ ppr sorted))
69 -- Prcess them one by one, dumping results into makefile
70 -- and complaining about cycles
71 ; mapM (processDeps dflags (mkd_tmp_hdl files)) sorted
74 ; endMkDependHS dflags files }
76 -----------------------------------------------------------------
79 -- Create a temporary file,
81 -- slurp through it, etc
83 -----------------------------------------------------------------
86 = MkDep { mkd_make_file :: FilePath, -- Name of the makefile
87 mkd_make_hdl :: Maybe Handle, -- Handle for the open makefile
88 mkd_tmp_file :: FilePath, -- Name of the temporary file
89 mkd_tmp_hdl :: Handle } -- Handle of the open temporary file
91 beginMkDependHS :: IO MkDepFiles
94 -- slurp in the mkdependHS-style options
95 flags <- getStaticOpts v_Opt_dep
96 _ <- processArgs dep_opts flags []
98 -- open a new temp file in which to stuff the dependency info
100 tmp_file <- newTempName "dep"
101 tmp_hdl <- openFile tmp_file WriteMode
104 makefile <- readIORef v_Dep_makefile
105 exists <- doesFileExist makefile
110 makefile_hdl <- openFile makefile ReadMode
112 -- slurp through until we get the magic start string,
113 -- copying the contents into dep_makefile
115 l <- hGetLine makefile_hdl
116 if (l == depStartMarker)
118 else do hPutStrLn tmp_hdl l; slurp
120 -- slurp through until we get the magic end marker,
121 -- throwing away the contents
123 l <- hGetLine makefile_hdl
124 if (l == depEndMarker)
128 catchJust ioErrors slurp
129 (\e -> if isEOFError e then return () else ioError e)
130 catchJust ioErrors chuck
131 (\e -> if isEOFError e then return () else ioError e)
133 return (Just makefile_hdl)
136 -- write the magic marker into the tmp file
137 hPutStrLn tmp_hdl depStartMarker
139 return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
140 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl})
143 -----------------------------------------------------------------
147 -----------------------------------------------------------------
149 processDeps :: DynFlags
150 -> Handle -- Write dependencies to here
153 -- Write suitable dependencies to handle
157 -- If the dependency is on something other than a .hi file:
158 -- this.o this.p_o ... : dep
160 -- this.o ... : dep.hi
161 -- this.p_o ... : dep.p_hi
163 -- (where .o is $osuf, and the other suffixes come from
164 -- the cmdline -s options).
166 -- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
168 processDeps dflags hdl (CyclicSCC nodes)
169 = -- There shouldn't be any cycles; report them
170 throwDyn (ProgramError (showSDoc $ cyclicModuleErr nodes))
172 processDeps dflags hdl (AcyclicSCC node)
173 = do { extra_suffixes <- readIORef v_Dep_suffixes
174 ; let src_file = msHsFilePath node
175 obj_file = msObjFilePath node
176 obj_files = insertSuffixes obj_file extra_suffixes
178 do_imp is_boot imp_mod
179 = do { mb_hi <- findDependency dflags src_file imp_mod is_boot
181 Nothing -> return () ;
183 { let hi_files = insertSuffixes hi_file extra_suffixes
184 write_dep (obj,hi) = writeDependency hdl [obj] hi
186 -- Add one dependency for each suffix;
189 ; mapM_ write_dep (obj_files `zip` hi_files) }}}
192 -- Emit std dependency of the object(s) on the source file
193 -- Something like A.o : A.hs
194 ; writeDependency hdl obj_files src_file
196 -- Emit a dependency for each import
197 ; mapM_ (do_imp True) (ms_srcimps node) -- SOURCE imports
198 ; mapM_ (do_imp False) (ms_imps node) -- regular imports
202 findDependency :: DynFlags
203 -> FilePath -- Importing module: used only for error msg
204 -> Module -- Imported module
205 -> IsBootInterface -- Source import
206 -> IO (Maybe FilePath) -- Interface file file
207 findDependency dflags src imp is_boot
208 = do { excl_mods <- readIORef v_Dep_exclude_mods
209 ; include_prelude <- readIORef v_Dep_include_prelude
211 -- Deal with the excluded modules
212 ; let imp_mod = moduleUserString imp
213 ; if imp_mod `elem` excl_mods
216 { -- Find the module; this will be fast because
217 -- we've done it once during downsweep
218 r <- findModule dflags imp True {-explicit-}
221 -- Not in this package: we don't need a dependency
222 | ExtPackage _ <- pkg, not include_prelude
225 -- Home package: just depend on the .hi or hi-boot file
227 -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
229 _ -> throwDyn (ProgramError
230 (src ++ ": " ++ "can't locate import `" ++ imp_mod ++ "'"
231 ++ if is_boot then " (SOURCE import)" else ""))
234 -----------------------------
235 writeDependency :: Handle -> [FilePath] -> FilePath -> IO ()
236 -- (writeDependency h [t1,t2] dep) writes to handle h the dependency
238 writeDependency hdl targets dep
239 = hPutStrLn hdl (unwords (map escapeSpaces targets) ++ " : "
242 -----------------------------
244 :: FilePath -- Original filename; e.g. "foo.o"
245 -> [String] -- Extra suffices e.g. ["x","y"]
246 -> [FilePath] -- Zapped filenames e.g. ["foo.o", "foo.x_o", "foo.y_o"]
247 -- Note that that the extra bit gets inserted *before* the old suffix
248 -- We assume the old suffix contains no dots, so we can strip it with removeSuffix
250 -- NOTE: we used to have this comment
251 -- In order to construct hi files with alternate suffixes, we
252 -- now have to find the "basename" of the hi file. This is
253 -- difficult because we can't just split the hi filename
254 -- at the last dot - the hisuf might have dots in it. So we
255 -- check whether the hi filename ends in hisuf, and if it does,
256 -- we strip off hisuf, otherwise we strip everything after the
258 -- But I'm not sure we care about hisufs with dots in them.
259 -- Lots of other things will break first!
261 insertSuffixes file_name extras
262 = file_name : [ basename ++ "." ++ extra ++ "_" ++ suffix | extra <- extras ]
264 (basename, suffix) = splitFilename file_name
267 -----------------------------------------------------------------
270 -- Complete the makefile, close the tmp file etc
272 -----------------------------------------------------------------
274 endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
277 (MkDep { mkd_make_file = make_file, mkd_make_hdl = makefile_hdl,
278 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl })
279 = do { -- write the magic marker into the tmp file
280 hPutStrLn tmp_hdl depEndMarker
282 ; case makefile_hdl of {
283 Nothing -> return ();
286 -- slurp the rest of the original makefile and copy it into the output
292 ; catchJust ioErrors slurp
293 (\e -> if isEOFError e then return () else ioError e)
297 ; hClose tmp_hdl -- make sure it's flushed
299 -- Create a backup of the original makefile
300 ; when (isJust makefile_hdl)
301 (SysTools.copy dflags ("Backing up " ++ make_file)
302 make_file (make_file++".bak"))
304 -- Copy the new makefile in place
305 ; SysTools.copy dflags "Installing new makefile" tmp_file make_file
309 -----------------------------------------------------------------
313 -----------------------------------------------------------------
316 GLOBAL_VAR(v_Dep_makefile, "Makefile", String);
317 GLOBAL_VAR(v_Dep_include_prelude, False, Bool);
318 GLOBAL_VAR(v_Dep_exclude_mods, ["GHC.Prim"], [String]);
319 GLOBAL_VAR(v_Dep_suffixes, [], [String]);
320 GLOBAL_VAR(v_Dep_warnings, True, Bool);
322 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
323 depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"
325 -- for compatibility with the old mkDependHS, we accept options of the form
326 -- -optdep-f -optdep.depend, etc.
328 [ ( "s", SepArg (add v_Dep_suffixes) )
329 , ( "f", SepArg (writeIORef v_Dep_makefile) )
330 , ( "w", NoArg (writeIORef v_Dep_warnings False) )
331 , ( "-include-prelude", NoArg (writeIORef v_Dep_include_prelude True) )
332 , ( "-exclude-module=", Prefix (add v_Dep_exclude_mods) )
333 , ( "x", Prefix (add v_Dep_exclude_mods) )