-----------------------------------------------------------------------------
--- $Id: DriverMkDepend.hs,v 1.11 2001/05/28 03:31:19 sof 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 DriverState
-import DriverUtil
-import DriverFlags
-import TmpFiles
-import Module
-import Config
-import Util
+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 ( 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
-import IOExts
-import Exception
+#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
-import Maybe
-
--------------------------------------------------------------------------------
--- mkdependHS
-
- -- flags
-GLOBAL_VAR(v_Dep_makefile, "Makefile", String);
-GLOBAL_VAR(v_Dep_include_prelude, False, Bool);
-GLOBAL_VAR(v_Dep_ignore_dirs, [], [String]);
-GLOBAL_VAR(v_Dep_exclude_mods, [], [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])]);
+import Monad ( when )
+import Maybe ( isJust )
-depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
-depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"
+-----------------------------------------------------------------
+--
+-- 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
+--
+-----------------------------------------------------------------
--- 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) ),
- ( "X", Prefix (addToDirList v_Dep_ignore_dirs) ),
- ( "-exclude-directory=", Prefix (addToDirList v_Dep_ignore_dirs) )
--- ( "-exclude-module=", Prefix (add v_Dep_exclude_mods) )
--- ( "x", Prefix (add v_Dep_exclude_mods) )
-
- ]
-
-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)
-
- -- ignore packages unless --include-prelude is on
- include_prelude <- readIORef v_Dep_include_prelude
- when (not include_prelude) $
- mapM_ (add v_Dep_ignore_dirs) pkg_import_dirs
+ return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
+ mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl})
- return ()
+-----------------------------------------------------------------
+--
+-- 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 :: 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
+endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
- -- write the magic marker into the tmp file
+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
Nothing -> return ()
Just hdl -> do
- -- slurp the rest of the orignal makefile and copy it into the output
+ -- slurp the rest of the original makefile and copy it into the output
let slurp = do
l <- hGetLine hdl
hPutStrLn tmp_hdl l
hClose tmp_hdl -- make sure it's flushed
- -- create a backup of the original makefile
- when (isJust makefile_hdl) $
- runSomething ("Backing up " ++ makefile)
- (unwords [ cCP, dosifyPath makefile, dosifyPath $ makefile++".bak" ])
-
- -- copy the new makefile in place
- runSomething "Installing new makefile"
- (unwords [ cCP, dosifyPath tmp_file, dosifyPath makefile ])
-
-
-findDependency :: Bool -> FilePath -> ModuleName -> IO (Maybe (String, Bool))
-findDependency is_source src imp = do
- dir_contents <- readIORef v_Dep_dir_contents
- ignore_dirs <- readIORef v_Dep_ignore_dirs
- excl_mods <- readIORef v_Dep_exclude_mods
- hisuf <- readIORef v_Hi_suf
-
- let
- imp_mod = moduleNameUserString imp
- imp_hi = imp_mod ++ '.':hisuf
- imp_hiboot = imp_mod ++ ".hi-boot"
- imp_hiboot_v = imp_mod ++ ".hi-boot-" ++ cHscIfaceFileVersion
- imp_hs = imp_mod ++ ".hs"
- imp_lhs = imp_mod ++ ".lhs"
-
- deps | is_source = [ imp_hiboot_v, imp_hiboot, imp_hs, imp_lhs ]
- | otherwise = [ imp_hi, imp_hs, imp_lhs ]
-
- search [] = throwDyn (ProgramError (src ++ ": " ++ "can't find one of the following: " ++
- unwords (map (\d -> '`': d ++ "'") deps)))
- search ((dir, contents) : dirs)
- | null present = search dirs
- | otherwise =
- if dir `elem` ignore_dirs
- then return Nothing
- else if is_source
- then if dep /= imp_hiboot_v
- then return (Just (dir++'/':imp_hiboot, False))
- else return (Just (dir++'/':dep, False))
- else return (Just (dir++'/':imp_hi, not is_source))
- where
- present = filter (`elem` contents) deps
- dep = head present
-
- -- in
- if imp_mod `elem` excl_mods then
- return Nothing
- else
- search dir_contents
+ -- Create a backup of the original makefile
+ when (isJust makefile_hdl)
+ (SysTools.copy dflags ("Backing up " ++ makefile)
+ makefile (makefile++".bak"))
+
+ -- Copy the new makefile in place
+ SysTools.copy dflags "Installing new makefile" tmp_file makefile
+
+
+-----------------------------------------------------------------
+--
+-- 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