1 -----------------------------------------------------------------------------
2 -- $Id: DriverMkDepend.hs,v 1.42 2005/02/22 16:29:42 simonpj Exp $
6 -- (c) Simon Marlow 2000
8 -----------------------------------------------------------------------------
10 module DriverMkDepend (
14 #include "HsVersions.h"
16 import CompManager ( cmDownsweep, 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(..), msObjFilePath, msHsFilePath )
22 import Packages ( PackageIdH(..) )
23 import SysTools ( newTempName )
24 import qualified SysTools
25 import Module ( Module, ModLocation(..), mkModule, moduleUserString, addBootSuffix_maybe )
26 import Digraph ( SCC(..) )
27 import Finder ( findModule, FindResult(..) )
28 import Util ( global )
32 import DATA_IOREF ( IORef, readIORef, writeIORef )
38 import Maybe ( isJust )
40 #if __GLASGOW_HASKELL__ <= 408
41 import Panic ( catchJust, ioErrors )
44 -----------------------------------------------------------------
48 -----------------------------------------------------------------
50 doMkDependHS :: DynFlags -> [FilePath] -> IO ()
51 doMkDependHS dflags srcs
52 = do { -- Initialisation
53 files <- beginMkDependHS
55 -- Do the downsweep to find all the modules
56 ; excl_mods <- readIORef v_Dep_exclude_mods
57 ; mod_summaries <- cmDownsweep dflags srcs [] excl_mods
59 -- Sort into dependency order
60 -- There should be no cycles
61 ; let sorted = cmTopSort False mod_summaries
63 -- Print out the dependencies if wanted
64 ; if verbosity dflags >= 2 then
65 hPutStrLn stderr (showSDoc (text "Module dependencies" $$ ppr sorted))
68 -- Prcess them one by one, dumping results into makefile
69 -- and complaining about cycles
70 ; mapM (processDeps dflags (mkd_tmp_hdl files)) sorted
73 ; endMkDependHS dflags files }
75 -----------------------------------------------------------------
78 -- Create a temporary file,
80 -- slurp through it, etc
82 -----------------------------------------------------------------
85 = MkDep { mkd_make_file :: FilePath, -- Name of the makefile
86 mkd_make_hdl :: Maybe Handle, -- Handle for the open makefile
87 mkd_tmp_file :: FilePath, -- Name of the temporary file
88 mkd_tmp_hdl :: Handle } -- Handle of the open temporary file
90 beginMkDependHS :: IO MkDepFiles
93 -- slurp in the mkdependHS-style options
94 flags <- getStaticOpts v_Opt_dep
95 _ <- processArgs dep_opts flags []
97 -- open a new temp file in which to stuff the dependency info
99 tmp_file <- newTempName "dep"
100 tmp_hdl <- openFile tmp_file WriteMode
103 makefile <- readIORef v_Dep_makefile
104 exists <- doesFileExist makefile
109 makefile_hdl <- openFile makefile ReadMode
111 -- slurp through until we get the magic start string,
112 -- copying the contents into dep_makefile
114 l <- hGetLine makefile_hdl
115 if (l == depStartMarker)
117 else do hPutStrLn tmp_hdl l; slurp
119 -- slurp through until we get the magic end marker,
120 -- throwing away the contents
122 l <- hGetLine makefile_hdl
123 if (l == depEndMarker)
127 catchJust ioErrors slurp
128 (\e -> if isEOFError e then return () else ioError e)
129 catchJust ioErrors chuck
130 (\e -> if isEOFError e then return () else ioError e)
132 return (Just makefile_hdl)
135 -- write the magic marker into the tmp file
136 hPutStrLn tmp_hdl depStartMarker
138 return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
139 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl})
142 -----------------------------------------------------------------
146 -----------------------------------------------------------------
148 processDeps :: DynFlags
149 -> Handle -- Write dependencies to here
152 -- Write suitable dependencies to handle
156 -- If the dependency is on something other than a .hi file:
157 -- this.o this.p_o ... : dep
159 -- this.o ... : dep.hi
160 -- this.p_o ... : dep.p_hi
162 -- (where .o is $osuf, and the other suffixes come from
163 -- the cmdline -s options).
165 -- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
167 processDeps dflags hdl (CyclicSCC nodes)
168 = -- There shouldn't be any cycles; report them
169 throwDyn (ProgramError (showSDoc $ cyclicModuleErr nodes))
171 processDeps dflags hdl (AcyclicSCC node)
172 = do { extra_suffixes <- readIORef v_Dep_suffixes
173 ; include_pkg_deps <- readIORef v_Dep_include_pkg_deps
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
180 is_boot include_pkg_deps
182 Nothing -> return () ;
184 { let hi_files = insertSuffixes hi_file extra_suffixes
185 write_dep (obj,hi) = writeDependency hdl [obj] hi
187 -- Add one dependency for each suffix;
190 ; mapM_ write_dep (obj_files `zip` hi_files) }}}
193 -- Emit std dependency of the object(s) on the source file
194 -- Something like A.o : A.hs
195 ; writeDependency hdl obj_files src_file
197 -- Emit a dependency for each import
198 ; mapM_ (do_imp True) (ms_srcimps node) -- SOURCE imports
199 ; mapM_ (do_imp False) (ms_imps node) -- regular imports
203 findDependency :: DynFlags
204 -> FilePath -- Importing module: used only for error msg
205 -> Module -- Imported module
206 -> IsBootInterface -- Source import
207 -> Bool -- Record dependency on package modules
208 -> IO (Maybe FilePath) -- Interface file file
209 findDependency dflags src imp is_boot include_pkg_deps
210 = do { -- Find the module; this will be fast because
211 -- we've done it once during downsweep
212 r <- findModule dflags imp True {-explicit-}
215 -- Not in this package: we don't need a dependency
216 | ExtPackage _ <- pkg, not include_pkg_deps
219 -- Home package: just depend on the .hi or hi-boot file
221 -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
223 _ -> throwDyn (ProgramError
224 (src ++ ": " ++ "can't locate import `" ++ (moduleUserString imp) ++ "'"
225 ++ if is_boot then " (SOURCE import)" else ""))
228 -----------------------------
229 writeDependency :: Handle -> [FilePath] -> FilePath -> IO ()
230 -- (writeDependency h [t1,t2] dep) writes to handle h the dependency
232 writeDependency hdl targets dep
233 = hPutStrLn hdl (unwords (map escapeSpaces targets) ++ " : "
236 -----------------------------
238 :: FilePath -- Original filename; e.g. "foo.o"
239 -> [String] -- Extra suffices e.g. ["x","y"]
240 -> [FilePath] -- Zapped filenames e.g. ["foo.o", "foo.x_o", "foo.y_o"]
241 -- Note that that the extra bit gets inserted *before* the old suffix
242 -- We assume the old suffix contains no dots, so we can strip it with removeSuffix
244 -- NOTE: we used to have this comment
245 -- In order to construct hi files with alternate suffixes, we
246 -- now have to find the "basename" of the hi file. This is
247 -- difficult because we can't just split the hi filename
248 -- at the last dot - the hisuf might have dots in it. So we
249 -- check whether the hi filename ends in hisuf, and if it does,
250 -- we strip off hisuf, otherwise we strip everything after the
252 -- But I'm not sure we care about hisufs with dots in them.
253 -- Lots of other things will break first!
255 insertSuffixes file_name extras
256 = file_name : [ basename ++ "." ++ extra ++ "_" ++ suffix | extra <- extras ]
258 (basename, suffix) = splitFilename file_name
261 -----------------------------------------------------------------
264 -- Complete the makefile, close the tmp file etc
266 -----------------------------------------------------------------
268 endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
271 (MkDep { mkd_make_file = makefile, mkd_make_hdl = makefile_hdl,
272 mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl })
274 -- write the magic marker into the tmp file
275 hPutStrLn tmp_hdl depEndMarker
281 -- slurp the rest of the original makefile and copy it into the output
287 catchJust ioErrors slurp
288 (\e -> if isEOFError e then return () else ioError e)
292 hClose tmp_hdl -- make sure it's flushed
294 -- Create a backup of the original makefile
295 when (isJust makefile_hdl)
296 (SysTools.copy dflags ("Backing up " ++ makefile)
297 makefile (makefile++".bak"))
299 -- Copy the new makefile in place
300 SysTools.copy dflags "Installing new makefile" tmp_file makefile
303 -----------------------------------------------------------------
307 -----------------------------------------------------------------
310 GLOBAL_VAR(v_Dep_makefile, "Makefile", String);
311 GLOBAL_VAR(v_Dep_include_pkg_deps, False, Bool);
312 GLOBAL_VAR(v_Dep_exclude_mods, [], [Module]);
313 GLOBAL_VAR(v_Dep_suffixes, [], [String]);
314 GLOBAL_VAR(v_Dep_warnings, True, Bool);
316 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
317 depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"
319 -- for compatibility with the old mkDependHS, we accept options of the form
320 -- -optdep-f -optdep.depend, etc.
322 [ ( "s", SepArg (add v_Dep_suffixes) )
323 , ( "f", SepArg (writeIORef v_Dep_makefile) )
324 , ( "w", NoArg (writeIORef v_Dep_warnings False) )
325 , ( "-include-prelude", NoArg (writeIORef v_Dep_include_pkg_deps True) )
326 , ( "-include-pkg-deps", NoArg (writeIORef v_Dep_include_pkg_deps True) )
327 , ( "-exclude-module=", Prefix (add v_Dep_exclude_mods . mkModule) )
328 , ( "x", Prefix (add v_Dep_exclude_mods . mkModule) )