-----------------------------------------------------------------------------
--- $Id: DriverMkDepend.hs,v 1.27 2003/01/08 15:28:05 simonmar Exp $
+-- $Id: DriverMkDepend.hs,v 1.42 2005/02/22 16:29:42 simonpj Exp $
--
-- GHC Driver
--
--
-----------------------------------------------------------------------------
-module DriverMkDepend where
+module DriverMkDepend (
+ doMkDependHS
+ ) where
#include "HsVersions.h"
-import DriverState
-import DriverUtil ( add, softGetDirectoryContents, replaceFilenameSuffix )
-import DriverFlags
+import CompManager ( cmDownsweep, cmTopSort, cyclicModuleErr )
+import CmdLineOpts ( DynFlags( verbosity ) )
+import DriverState ( getStaticOpts, v_Opt_dep )
+import DriverUtil ( escapeSpaces, splitFilename, add )
+import DriverFlags ( processArgs, OptKind(..) )
+import HscTypes ( IsBootInterface, ModSummary(..), msObjFilePath, msHsFilePath )
+import Packages ( PackageIdH(..) )
import SysTools ( newTempName )
import qualified SysTools
-import Module ( ModuleName, ModLocation(..),
- moduleNameUserString, isHomeModule )
-import Finder ( findModule, hiBootExt, hiBootVerExt )
+import Module ( Module, ModLocation(..), mkModule, moduleUserString, addBootSuffix_maybe )
+import Digraph ( SCC(..) )
+import Finder ( findModule, FindResult(..) )
import Util ( global )
+import Outputable
import Panic
import DATA_IOREF ( IORef, readIORef, writeIORef )
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"
+-----------------------------------------------------------------
+--
+-- The main function
+--
+-----------------------------------------------------------------
+
+doMkDependHS :: DynFlags -> [FilePath] -> IO ()
+doMkDependHS dflags srcs
+ = do { -- Initialisation
+ files <- beginMkDependHS
+
+ -- Do the downsweep to find all the modules
+ ; excl_mods <- readIORef v_Dep_exclude_mods
+ ; mod_summaries <- cmDownsweep dflags srcs [] excl_mods
+
+ -- Sort into dependency order
+ -- There should be no cycles
+ ; let sorted = cmTopSort False mod_summaries
+
+ -- Print out the dependencies if wanted
+ ; if verbosity dflags >= 2 then
+ 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
+--
+-----------------------------------------------------------------
--- 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) )
- ]
+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 :: IO ()
+beginMkDependHS :: IO MkDepFiles
+
beginMkDependHS = do
-
-- slurp in the mkdependHS-style options
flags <- getStaticOpts v_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 "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 (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
+ mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl})
- return ()
+-----------------------------------------------------------------
+--
+-- 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)
+ = do { extra_suffixes <- readIORef v_Dep_suffixes
+ ; 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 dflags 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
+ ; 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
+ -> Bool -- Record dependency on package modules
+ -> IO (Maybe FilePath) -- Interface file file
+findDependency dflags 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 dflags 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
-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
+ -- Home package: just depend on the .hi or hi-boot file
+ | otherwise
+ -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
+
+ _ -> throwDyn (ProgramError
+ (src ++ ": " ++ "can't locate import `" ++ (moduleUserString imp) ++ "'"
+ ++ if is_boot then " (SOURCE import)" else ""))
+ }
+
+-----------------------------
+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 ++ "." ++ extra ++ "_" ++ suffix | extra <- extras ]
+ where
+ (basename, suffix) = splitFilename file_name
+
+
+-----------------------------------------------------------------
+--
+-- endMkDependHs
+-- Complete the makefile, close the tmp file etc
+--
+-----------------------------------------------------------------
- -- write the magic marker into the tmp file
+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 (add 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 (add v_Dep_exclude_mods . mkModule) )
+ , ( "x", Prefix (add v_Dep_exclude_mods . mkModule) )
+ ]
projects / ghc-hetmet.git / blobdiff