DriverMkDepend.hs 10.3 KB
Newer Older
1 2
-----------------------------------------------------------------------------
--
3
-- Makefile Dependency Generation
4
--
5
-- (c) The University of Glasgow 2005
6 7 8
--
-----------------------------------------------------------------------------

9
module DriverMkDepend (
10
	doMkDependHS
11
  ) where
12 13 14

#include "HsVersions.h"

15
import CompManager	( cmDownsweep, cmTopSort, cyclicModuleErr )
16 17 18 19
import DynFlags		( DynFlags( verbosity, opt_dep ), getOpts )
import Util		( escapeSpaces, splitFilename )
import HscTypes		( IsBootInterface, ModSummary(..), msObjFilePath,
			   msHsFilePath )
20
import Packages		( PackageIdH(..) )
21 22
import SysTools		( newTempName )
import qualified SysTools
23 24
import Module		( Module, ModLocation(..), mkModule, moduleUserString,
			  addBootSuffix_maybe )
25 26
import Digraph		( SCC(..) )
import Finder		( findModule, FindResult(..) )
27
import Util             ( global, consIORef )
28
import Outputable
29
import Panic
30
import CmdLineParser
31

32
import DATA_IOREF	( IORef, readIORef, writeIORef )
33
import EXCEPTION
34 35 36

import Directory
import IO
sof's avatar
sof committed
37 38
import Monad            ( when )
import Maybe            ( isJust )
39

40
#if __GLASGOW_HASKELL__ <= 408
41
import Panic		( catchJust, ioErrors )
42 43
#endif

44 45 46 47 48 49 50 51 52
-----------------------------------------------------------------
--
--		The main function
--
-----------------------------------------------------------------

doMkDependHS :: DynFlags -> [FilePath] -> IO ()
doMkDependHS dflags srcs
  = do	{ 	-- Initialisation
53
	  files <- beginMkDependHS dflags
54 55

		-- Do the downsweep to find all the modules
56 57
	; excl_mods <- readIORef v_Dep_exclude_mods
	; mod_summaries <- cmDownsweep dflags srcs [] excl_mods
58 59 60 61 62 63

		-- Sort into dependency order
		-- There should be no cycles
	; let sorted = cmTopSort False mod_summaries

		-- Print out the dependencies if wanted
64
	; if verbosity dflags >= 2 then
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
		hPutStrLn stderr (showSDoc (text "Module dependencies" $$ ppr sorted))
	  else return ()
		
		-- Prcess them one by one, dumping results into makefile
		-- and complaining about cycles
	; mapM (processDeps dflags (mkd_tmp_hdl files)) sorted

		-- Tidy up
	; endMkDependHS dflags files }

-----------------------------------------------------------------
--
--		beginMkDependHs
--	Create a temporary file, 
--	find the Makefile, 
--	slurp through it, etc
--
-----------------------------------------------------------------
83

84 85 86 87 88
data MkDepFiles 
  = MkDep { mkd_make_file :: FilePath,		-- Name of the makefile
	    mkd_make_hdl  :: Maybe Handle, 	-- Handle for the open makefile 
	    mkd_tmp_file  :: FilePath,		-- Name of the temporary file
	    mkd_tmp_hdl   :: Handle }		-- Handle of the open temporary file
89

90
beginMkDependHS :: DynFlags -> IO MkDepFiles
91
	
92
beginMkDependHS dflags = do
93
  	-- slurp in the mkdependHS-style options
94 95
  let flags = getOpts dflags opt_dep
  _ <- processArgs dep_opts flags
96 97 98

     	-- open a new temp file in which to stuff the dependency info
     	-- as we go along.
99
  tmp_file <- newTempName dflags "dep"
100
  tmp_hdl <- openFile tmp_file WriteMode
101 102

  	-- open the makefile
103
  makefile <- readIORef v_Dep_makefile
104
  exists <- doesFileExist makefile
105 106 107
  mb_make_hdl <- 
	if not exists
	then return Nothing
108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
	else do
  	   makefile_hdl <- openFile makefile ReadMode

		-- slurp through until we get the magic start string,
		-- copying the contents into dep_makefile
  	   let slurp = do
		l <- hGetLine makefile_hdl
		if (l == depStartMarker)
			then return ()
			else do hPutStrLn tmp_hdl l; slurp
	 
		-- slurp through until we get the magic end marker,
		-- throwing away the contents
  	   let chuck = do
		l <- hGetLine makefile_hdl
		if (l == depEndMarker)
			then return ()
			else chuck
	 
	   catchJust ioErrors slurp 
		(\e -> if isEOFError e then return () else ioError e)
	   catchJust ioErrors chuck
		(\e -> if isEOFError e then return () else ioError e)

132 133
	   return (Just makefile_hdl)

134 135 136 137

	-- write the magic marker into the tmp file
  hPutStrLn tmp_hdl depStartMarker

138 139
  return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl, 
		  mkd_tmp_file  = tmp_file, mkd_tmp_hdl  = tmp_hdl})
140

141

142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171
-----------------------------------------------------------------
--
--		processDeps
--
-----------------------------------------------------------------

processDeps :: DynFlags
	    -> Handle		-- Write dependencies to here
	    -> SCC ModSummary
	    -> IO ()
-- Write suitable dependencies to handle
-- Always:
-- 			this.o : this.hs
--
-- If the dependency is on something other than a .hi file:
--   			this.o this.p_o ... : dep
-- otherwise
--   			this.o ...   : dep.hi
--   			this.p_o ... : dep.p_hi
--   			...
-- (where .o is $osuf, and the other suffixes come from
-- the cmdline -s options).
--
-- For {-# SOURCE #-} imports the "hi" will be "hi-boot".

processDeps dflags hdl (CyclicSCC nodes)
  =	-- There shouldn't be any cycles; report them	
    throwDyn (ProgramError (showSDoc $ cyclicModuleErr nodes))

processDeps dflags hdl (AcyclicSCC node)
172 173
  = do	{ extra_suffixes   <- readIORef v_Dep_suffixes
	; include_pkg_deps <- readIORef v_Dep_include_pkg_deps
174 175 176 177 178
	; let src_file  = msHsFilePath node
	      obj_file  = msObjFilePath node
	      obj_files = insertSuffixes obj_file extra_suffixes

	      do_imp is_boot imp_mod
179 180
		= do { mb_hi <- findDependency dflags src_file imp_mod 
					       is_boot include_pkg_deps
181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206
		     ; case mb_hi of {
			   Nothing      -> return () ;
			   Just hi_file -> do
		     { let hi_files = insertSuffixes hi_file extra_suffixes
			   write_dep (obj,hi) = writeDependency hdl [obj] hi

			-- Add one dependency for each suffix; 
			-- e.g.		A.o   : B.hi
			--		A.x_o : B.x_hi
		     ; mapM_ write_dep (obj_files `zip` hi_files) }}}

	     
	  	-- Emit std dependency of the object(s) on the source file
		-- Something like 	A.o : A.hs
	; writeDependency hdl obj_files src_file

		-- Emit a dependency for each import
	; mapM_ (do_imp True)  (ms_srcimps node)	-- SOURCE imports
	; mapM_ (do_imp False) (ms_imps node)		-- regular imports
	}


findDependency	:: DynFlags
		-> FilePath 		-- Importing module: used only for error msg
		-> Module		-- Imported module
		-> IsBootInterface	-- Source import
207
		-> Bool			-- Record dependency on package modules
208
		-> IO (Maybe FilePath)	-- Interface file file
209 210
findDependency dflags src imp is_boot include_pkg_deps
  = do	{ 	-- Find the module; this will be fast because
211 212 213 214 215
		-- we've done it once during downsweep
	  r <- findModule dflags imp True {-explicit-}
	; case r of 
	    Found loc pkg
		-- Not in this package: we don't need a dependency
216
		| ExtPackage _ <- pkg, not include_pkg_deps
217
		-> return Nothing
218

219 220 221 222 223
		-- Home package: just depend on the .hi or hi-boot file
		| otherwise
		-> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))

	    _ -> throwDyn (ProgramError 
224
		 (src ++ ": " ++ "can't locate import `" ++ (moduleUserString imp) ++ "'"
225
		  ++ if is_boot then " (SOURCE import)" else ""))
226
	}
227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244

-----------------------------
writeDependency :: Handle -> [FilePath] -> FilePath -> IO ()
-- (writeDependency h [t1,t2] dep) writes to handle h the dependency
--	t1 t2 : dep
writeDependency hdl targets dep
  = hPutStrLn hdl (unwords (map escapeSpaces targets) ++ " : "
		   ++ escapeSpaces dep)

-----------------------------
insertSuffixes	
	:: FilePath 	-- Original filename;	e.g. "foo.o"
	-> [String]	-- Extra suffices	e.g. ["x","y"]
	-> [FilePath]	-- Zapped filenames	e.g. ["foo.o", "foo.x_o", "foo.y_o"]
	-- Note that that the extra bit gets inserted *before* the old suffix
	-- We assume the old suffix contains no dots, so we can strip it with removeSuffix

	-- NOTE: we used to have this comment
245 246 247 248 249 250 251
		-- In order to construct hi files with alternate suffixes, we
		-- now have to find the "basename" of the hi file.  This is
		-- difficult because we can't just split the hi filename
		-- at the last dot - the hisuf might have dots in it.  So we
		-- check whether the hi filename ends in hisuf, and if it does,
		-- we strip off hisuf, otherwise we strip everything after the
		-- last dot.
252 253
	-- But I'm not sure we care about hisufs with dots in them. 
	-- Lots of other things will break first!
254

255 256 257 258 259 260 261 262 263 264 265 266
insertSuffixes file_name extras
  = file_name : [ basename ++ "." ++ extra ++ "_" ++ suffix | extra <- extras ]
  where
    (basename, suffix) = splitFilename file_name


-----------------------------------------------------------------
--
--		endMkDependHs
--	Complete the makefile, close the tmp file etc
--
-----------------------------------------------------------------
267

268
endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
269

270
endMkDependHS dflags 
271 272 273 274 275 276 277 278 279 280
   (MkDep { mkd_make_file = makefile, mkd_make_hdl =  makefile_hdl,
            mkd_tmp_file  = tmp_file, mkd_tmp_hdl  =  tmp_hdl }) 
  = do
  -- write the magic marker into the tmp file
  hPutStrLn tmp_hdl depEndMarker

  case makefile_hdl of
     Nothing  -> return ()
     Just hdl -> do

rrt's avatar
rrt committed
281
	  -- slurp the rest of the original makefile and copy it into the output
282
  	let slurp = do
283 284 285 286
		l <- hGetLine hdl
		hPutStrLn tmp_hdl l
		slurp
	 
287
  	catchJust ioErrors slurp 
288 289
		(\e -> if isEOFError e then return () else ioError e)

290
	hClose hdl
291

292
  hClose tmp_hdl  -- make sure it's flushed
293

294 295 296 297
	-- Create a backup of the original makefile
  when (isJust makefile_hdl)
       (SysTools.copy dflags ("Backing up " ++ makefile) 
	  makefile (makefile++".bak"))
298

299 300
  	-- Copy the new makefile in place
  SysTools.copy dflags "Installing new makefile" tmp_file makefile
301 302


303 304 305 306 307 308 309 310
-----------------------------------------------------------------
--
--		Flags
--
-----------------------------------------------------------------

	-- Flags
GLOBAL_VAR(v_Dep_makefile, 		"Makefile", String);
311 312
GLOBAL_VAR(v_Dep_include_pkg_deps, 	False, Bool);
GLOBAL_VAR(v_Dep_exclude_mods,          [], [Module]);
313 314
GLOBAL_VAR(v_Dep_suffixes,		[], [String]);
GLOBAL_VAR(v_Dep_warnings,		True, Bool);
315

316 317
depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
depEndMarker   = "# DO NOT DELETE: End of Haskell dependencies"
318

319 320 321
-- for compatibility with the old mkDependHS, we accept options of the form
-- -optdep-f -optdep.depend, etc.
dep_opts = 
322
   [ (  "s", 			SepArg (consIORef v_Dep_suffixes) )
323 324
   , (  "f", 			SepArg (writeIORef v_Dep_makefile) )
   , (  "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 328
   , (  "-exclude-module=",     Prefix (consIORef v_Dep_exclude_mods . mkModule) )
   , (  "x",                    Prefix (consIORef v_Dep_exclude_mods . mkModule) )
329
   ]