-----------------------------------------------------------------------------
--- $Id: DriverMkDepend.hs,v 1.30 2003/07/18 13:18:07 simonmar Exp $
--
--- GHC Driver
+-- Makefile Dependency Generation
--
--- (c) Simon Marlow 2000
+-- (c) The University of Glasgow 2005
--
-----------------------------------------------------------------------------
-module DriverMkDepend where
+module DriverMkDepend (
+ doMkDependHS
+ ) where
#include "HsVersions.h"
-import GetImports ( getImports )
-import DriverState
-import DriverUtil
-import DriverFlags
+import qualified GHC
+import GHC ( Session, ModSummary(..) )
+import DynFlags ( DynFlags( verbosity, opt_dep ), getOpts )
+import Util ( escapeSpaces, splitFilename, joinFileExt )
+import HscTypes ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
+import Packages ( PackageIdH(..) )
import SysTools ( newTempName )
import qualified SysTools
-import Module ( ModuleName, ModLocation(..),
- moduleNameUserString, isHomeModule )
-import Finder ( findModule, hiBootExt, hiBootVerExt,
- mkHomeModLocation )
-import Util ( global )
+import Module ( Module, ModLocation(..), mkModule,
+ addBootSuffix_maybe )
+import Digraph ( SCC(..) )
+import Finder ( findModule, FindResult(..) )
+import Util ( global, consIORef )
+import Outputable
import Panic
+import SrcLoc ( unLoc )
+import CmdLineParser
+
+#if __GLASGOW_HASKELL__ <= 408
+import Panic ( catchJust, ioErrors )
+#endif
+import ErrUtils ( debugTraceMsg, printErrorsAndWarnings )
import DATA_IOREF ( IORef, readIORef, writeIORef )
import EXCEPTION
+import System ( ExitCode(..), exitWith )
import Directory
import IO
import Monad ( when )
import Maybe ( isJust )
-#if __GLASGOW_HASKELL__ <= 408
-import Panic ( catchJust, ioErrors )
-#endif
-
--------------------------------------------------------------------------------
--- mkdependHS
-
- -- flags
-GLOBAL_VAR(v_Dep_makefile, "Makefile", String);
-GLOBAL_VAR(v_Dep_include_prelude, False, Bool);
-GLOBAL_VAR(v_Dep_exclude_mods, ["GHC.Prim"], [String]);
-GLOBAL_VAR(v_Dep_suffixes, [], [String]);
-GLOBAL_VAR(v_Dep_warnings, True, Bool);
-
- -- global vars
-GLOBAL_VAR(v_Dep_makefile_hdl, error "dep_makefile_hdl", Maybe Handle);
-GLOBAL_VAR(v_Dep_tmp_file, error "dep_tmp_file", String);
-GLOBAL_VAR(v_Dep_tmp_hdl, error "dep_tmp_hdl", Handle);
-GLOBAL_VAR(v_Dep_dir_contents, error "dep_dir_contents", [(String,[String])]);
-
-depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
-depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"
-
--- for compatibility with the old mkDependHS, we accept options of the form
--- -optdep-f -optdep.depend, etc.
-dep_opts =
- [ ( "s", SepArg (add v_Dep_suffixes) )
- , ( "f", SepArg (writeIORef v_Dep_makefile) )
- , ( "w", NoArg (writeIORef v_Dep_warnings False) )
- , ( "-include-prelude", NoArg (writeIORef v_Dep_include_prelude True) )
- , ( "-exclude-module=", Prefix (add v_Dep_exclude_mods) )
- , ( "x", Prefix (add v_Dep_exclude_mods) )
- ]
+-----------------------------------------------------------------
+--
+-- The main function
+--
+-----------------------------------------------------------------
+
+doMkDependHS :: Session -> [FilePath] -> IO ()
+doMkDependHS session srcs
+ = do { -- Initialisation
+ dflags <- GHC.getSessionDynFlags session
+ ; files <- beginMkDependHS dflags
+
+ -- Do the downsweep to find all the modules
+ ; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
+ ; GHC.setTargets session targets
+ ; excl_mods <- readIORef v_Dep_exclude_mods
+ ; r <- GHC.depanal session excl_mods True {- Allow dup roots -}
+ ; case r of
+ Nothing -> exitWith (ExitFailure 1)
+ Just mod_summaries -> do {
+
+ -- Sort into dependency order
+ -- There should be no cycles
+ let sorted = GHC.topSortModuleGraph False mod_summaries Nothing
+
+ -- Print out the dependencies if wanted
+ ; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
+
+ -- Prcess them one by one, dumping results into makefile
+ -- and complaining about cycles
+ ; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted
+
+ -- Tidy up
+ ; endMkDependHS dflags files }}
+
+-----------------------------------------------------------------
+--
+-- beginMkDependHs
+-- Create a temporary file,
+-- find the Makefile,
+-- slurp through it, etc
+--
+-----------------------------------------------------------------
-beginMkDependHS :: IO ()
-beginMkDependHS = do
+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
+beginMkDependHS :: DynFlags -> IO MkDepFiles
+
+beginMkDependHS dflags = do
-- slurp in the mkdependHS-style options
- flags <- getStaticOpts v_Opt_dep
- _ <- processArgs dep_opts flags []
+ let flags = getOpts dflags opt_dep
+ _ <- processArgs dep_opts flags
-- open a new temp file in which to stuff the dependency info
-- as we go along.
- dep_file <- newTempName "dep"
- writeIORef v_Dep_tmp_file dep_file
- tmp_hdl <- openFile dep_file WriteMode
- writeIORef v_Dep_tmp_hdl tmp_hdl
+ tmp_file <- newTempName dflags "dep"
+ tmp_hdl <- openFile tmp_file WriteMode
-- open the makefile
makefile <- readIORef v_Dep_makefile
exists <- doesFileExist makefile
- if not exists
- then do
- writeIORef v_Dep_makefile_hdl Nothing
- return ()
-
+ mb_make_hdl <-
+ if not exists
+ then return Nothing
else do
makefile_hdl <- openFile makefile ReadMode
- writeIORef v_Dep_makefile_hdl (Just makefile_hdl)
-- slurp through until we get the magic start string,
-- copying the contents into dep_makefile
catchJust ioErrors chuck
(\e -> if isEOFError e then return () else ioError e)
+ return (Just makefile_hdl)
+
-- write the magic marker into the tmp file
hPutStrLn tmp_hdl depStartMarker
- -- cache the contents of all the import directories, for future
- -- reference.
- import_dirs <- readIORef v_Import_paths
- pkg_import_dirs <- getPackageImportPath
- import_dir_contents <- mapM softGetDirectoryContents import_dirs
- pkg_import_dir_contents <- mapM softGetDirectoryContents pkg_import_dirs
- writeIORef v_Dep_dir_contents
- (zip import_dirs import_dir_contents ++
- zip pkg_import_dirs pkg_import_dir_contents)
-
- return ()
-
-
-doMkDependHSPhase basename suff input_fn
- = do src <- readFile input_fn
- let (import_sources, import_normals, mod_name) = getImports src
- let orig_fn = basename ++ '.':suff
- (_, location') <- mkHomeModLocation mod_name orig_fn
-
- -- take -ohi into account if present
- ohi <- readIORef v_Output_hi
- let location | Just fn <- ohi = location'{ ml_hi_file = fn }
- | otherwise = location'
-
- deps_sources <- mapM (findDependency True orig_fn) import_sources
- deps_normals <- mapM (findDependency False orig_fn) import_normals
- let deps = deps_sources ++ deps_normals
-
- osuf <- readIORef v_Object_suf
- extra_suffixes <- readIORef v_Dep_suffixes
- let suffixes = map (++ ('_':osuf)) extra_suffixes
- obj_file = ml_obj_file location
- objs = obj_file : map (replaceFilenameSuffix obj_file) suffixes
-
- -- Handle for file that accumulates dependencies
- hdl <- readIORef v_Dep_tmp_hdl
-
- -- std dependency of the object(s) on the source file
- hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++
- escapeSpaces (basename ++ '.':suff))
-
- let genDep (dep, False {- not an hi file -}) =
- hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++
- escapeSpaces dep)
- genDep (dep, True {- is an hi file -}) = do
- hisuf <- readIORef v_Hi_suf
- let dep_base = remove_suffix '.' dep
- deps = (dep_base ++ hisuf)
- : map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
- -- length objs should be == length deps
- sequence_ (zipWith (\o d -> hPutStrLn hdl (escapeSpaces o ++ " : " ++ escapeSpaces d)) objs deps)
-
- sequence_ (map genDep [ d | Just d <- deps ])
- return location
-
--- add the lines to dep_makefile:
- -- always:
- -- this.o : this.hs
-
- -- if the dependency is on something other than a .hi file:
- -- this.o this.p_o ... : dep
- -- otherwise
- -- if the import is {-# SOURCE #-}
- -- this.o this.p_o ... : dep.hi-boot[-$vers]
-
- -- else
- -- this.o ... : dep.hi
- -- this.p_o ... : dep.p_hi
- -- ...
-
- -- (where .o is $osuf, and the other suffixes come from
- -- the cmdline -s options).
-
-
-
-endMkDependHS :: IO ()
-endMkDependHS = do
- makefile <- readIORef v_Dep_makefile
- makefile_hdl <- readIORef v_Dep_makefile_hdl
- tmp_file <- readIORef v_Dep_tmp_file
- tmp_hdl <- readIORef v_Dep_tmp_hdl
+ return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
+ mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl})
- -- write the magic marker into the tmp file
+
+-----------------------------------------------------------------
+--
+-- processDeps
+--
+-----------------------------------------------------------------
+
+processDeps :: Session
+ -> [Module]
+ -> 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 session excl_mods hdl (CyclicSCC nodes)
+ = -- There shouldn't be any cycles; report them
+ throwDyn (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
+
+processDeps session excl_mods hdl (AcyclicSCC node)
+ = do { extra_suffixes <- readIORef v_Dep_suffixes
+ ; hsc_env <- GHC.sessionHscEnv session
+ ; include_pkg_deps <- readIORef v_Dep_include_pkg_deps
+ ; let src_file = msHsFilePath node
+ obj_file = msObjFilePath node
+ obj_files = insertSuffixes obj_file extra_suffixes
+
+ do_imp is_boot imp_mod
+ = do { mb_hi <- findDependency hsc_env src_file imp_mod
+ is_boot include_pkg_deps
+ ; 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
+
+ -- SOURCE imports
+ ; mapM_ (do_imp True)
+ (filter (`notElem` excl_mods) (map unLoc (ms_srcimps node)))
+
+ -- regular imports
+ ; mapM_ (do_imp False)
+ (filter (`notElem` excl_mods) (map unLoc (ms_imps node)))
+ }
+
+
+findDependency :: HscEnv
+ -> FilePath -- Importing module: used only for error msg
+ -> Module -- Imported module
+ -> IsBootInterface -- Source import
+ -> Bool -- Record dependency on package modules
+ -> IO (Maybe FilePath) -- Interface file file
+findDependency hsc_env src imp is_boot include_pkg_deps
+ = do { -- Find the module; this will be fast because
+ -- we've done it once during downsweep
+ r <- findModule hsc_env imp True {-explicit-}
+ ; case r of
+ Found loc pkg
+ -- Not in this package: we don't need a dependency
+ | ExtPackage _ <- pkg, not include_pkg_deps
+ -> return Nothing
+
+ -- Home package: just depend on the .hi or hi-boot file
+ | otherwise
+ -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
+
+ _ -> panic "findDependency"
+ }
+
+-----------------------------
+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
+ -- 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.
+ -- But I'm not sure we care about hisufs with dots in them.
+ -- Lots of other things will break first!
+
+insertSuffixes file_name extras
+ = file_name : [ basename `joinFileExt` (extra ++ "_" ++ suffix) | extra <- extras ]
+ where
+ (basename, suffix) = splitFilename file_name
+
+
+-----------------------------------------------------------------
+--
+-- endMkDependHs
+-- Complete the makefile, close the tmp file etc
+--
+-----------------------------------------------------------------
+
+endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
+
+endMkDependHS dflags
+ (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
-- Create a backup of the original makefile
when (isJust makefile_hdl)
- (SysTools.copy ("Backing up " ++ makefile) makefile (makefile++".bak"))
+ (SysTools.copy dflags ("Backing up " ++ makefile)
+ makefile (makefile++".bak"))
-- Copy the new makefile in place
- SysTools.copy "Installing new makefile" tmp_file makefile
-
-
-findDependency :: Bool -> FilePath -> ModuleName -> IO (Maybe (String, Bool))
-findDependency is_source src imp = do
- excl_mods <- readIORef v_Dep_exclude_mods
- include_prelude <- readIORef v_Dep_include_prelude
- let imp_mod = moduleNameUserString imp
- if imp_mod `elem` excl_mods
- then return Nothing
- else do
- r <- findModule imp
- case r of
- Right (mod,loc)
- -- not in this package: we don't need a dependency
- | not (isHomeModule mod) && not include_prelude
- -> return Nothing
+ SysTools.copy dflags "Installing new makefile" tmp_file makefile
- -- normal import: just depend on the .hi file
- | not is_source
- -> return (Just (ml_hi_file loc, not is_source))
- -- if it's a source import, we want to generate a dependency
- -- on the .hi-boot file, not the .hi file
- | otherwise
- -> let hi_file = ml_hi_file loc
- boot_hi_file = replaceFilenameSuffix hi_file hiBootExt
- boot_ver_hi_file = replaceFilenameSuffix hi_file hiBootVerExt
- in do
- b <- doesFileExist boot_ver_hi_file
- if b
- then return (Just (boot_ver_hi_file, not is_source))
- else do
- b <- doesFileExist boot_hi_file
- if b
- then return (Just (boot_hi_file, not is_source))
- else return (Just (hi_file, not is_source))
-
- Left _ -> throwDyn (ProgramError
- (src ++ ": " ++ "can't locate import `" ++ imp_mod ++ "'" ++
- if is_source then " (SOURCE import)" else ""))
+-----------------------------------------------------------------
+--
+-- Flags
+--
+-----------------------------------------------------------------
+
+ -- Flags
+GLOBAL_VAR(v_Dep_makefile, "Makefile", String);
+GLOBAL_VAR(v_Dep_include_pkg_deps, False, Bool);
+GLOBAL_VAR(v_Dep_exclude_mods, [], [Module]);
+GLOBAL_VAR(v_Dep_suffixes, [], [String]);
+GLOBAL_VAR(v_Dep_warnings, True, Bool);
+
+depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
+depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"
+
+-- for compatibility with the old mkDependHS, we accept options of the form
+-- -optdep-f -optdep.depend, etc.
+dep_opts =
+ [ ( "s", SepArg (consIORef v_Dep_suffixes) )
+ , ( "f", SepArg (writeIORef v_Dep_makefile) )
+ , ( "w", NoArg (writeIORef v_Dep_warnings False) )
+ , ( "-include-prelude", NoArg (writeIORef v_Dep_include_pkg_deps True) )
+ , ( "-include-pkg-deps", NoArg (writeIORef v_Dep_include_pkg_deps True) )
+ , ( "-exclude-module=", Prefix (consIORef v_Dep_exclude_mods . mkModule) )
+ , ( "x", Prefix (consIORef v_Dep_exclude_mods . mkModule) )
+ ]
projects / ghc-hetmet.git / blobdiff