-----------------------------------------------------------------------------
--- $Id: DriverMkDepend.hs,v 1.40 2005/02/04 15:43:32 simonpj Exp $
--
--- GHC Driver
+-- Makefile Dependency Generation
--
--- (c) Simon Marlow 2000
+-- (c) The University of Glasgow 2005
--
-----------------------------------------------------------------------------
#include "HsVersions.h"
-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 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, moduleUserString, addBootSuffix_maybe )
+import Module ( Module, ModLocation(..), mkModule,
+ addBootSuffix_maybe )
import Digraph ( SCC(..) )
import Finder ( findModule, FindResult(..) )
-import Util ( global )
+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
-
-----------------------------------------------------------------
--
-- The main function
--
-----------------------------------------------------------------
-doMkDependHS :: DynFlags -> [FilePath] -> IO ()
-doMkDependHS dflags srcs
+doMkDependHS :: Session -> [FilePath] -> IO ()
+doMkDependHS session srcs
= do { -- Initialisation
- files <- beginMkDependHS
+ 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
- ; mod_summaries <- cmDownsweep dflags srcs [] excl_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 = cmTopSort False mod_summaries
+ let sorted = GHC.topSortModuleGraph False mod_summaries Nothing
-- Print out the dependencies if wanted
- ; if verbosity dflags >= 2 then
- hPutStrLn stderr (showSDoc (text "Module dependencies" $$ ppr sorted))
- else return ()
-
+ ; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
+
-- Prcess them one by one, dumping results into makefile
-- and complaining about cycles
- ; mapM (processDeps dflags (mkd_tmp_hdl files)) sorted
+ ; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted
-- Tidy up
- ; endMkDependHS dflags files }
+ ; endMkDependHS dflags files }}
-----------------------------------------------------------------
--
mkd_tmp_file :: FilePath, -- Name of the temporary file
mkd_tmp_hdl :: Handle } -- Handle of the open temporary file
-beginMkDependHS :: IO MkDepFiles
+beginMkDependHS :: DynFlags -> IO MkDepFiles
-beginMkDependHS = do
+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.
- tmp_file <- newTempName "dep"
+ tmp_file <- newTempName dflags "dep"
tmp_hdl <- openFile tmp_file WriteMode
-- open the makefile
--
-----------------------------------------------------------------
-processDeps :: DynFlags
+processDeps :: Session
+ -> [Module]
-> Handle -- Write dependencies to here
-> SCC ModSummary
-> IO ()
--
-- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
-processDeps dflags hdl (CyclicSCC nodes)
+processDeps session excl_mods hdl (CyclicSCC nodes)
= -- There shouldn't be any cycles; report them
- throwDyn (ProgramError (showSDoc $ cyclicModuleErr nodes))
+ throwDyn (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
-processDeps dflags hdl (AcyclicSCC node)
+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 dflags src_file imp_mod
+ = do { mb_hi <- findDependency hsc_env src_file imp_mod
is_boot include_pkg_deps
; case mb_hi of {
Nothing -> return () ;
; 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
+
+ -- 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 :: DynFlags
+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 dflags src imp is_boot include_pkg_deps
+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 dflags imp True {-explicit-}
+ r <- findModule hsc_env imp True {-explicit-}
; case r of
Found loc pkg
-- Not in this package: we don't need a dependency
| 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 ""))
+ _ -> panic "findDependency"
}
-----------------------------
-- Lots of other things will break first!
insertSuffixes file_name extras
- = file_name : [ basename ++ "." ++ extra ++ "_" ++ suffix | extra <- extras ]
+ = file_name : [ basename `joinFileExt` (extra ++ "_" ++ suffix) | extra <- extras ]
where
(basename, suffix) = splitFilename file_name
endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
endMkDependHS dflags
- (MkDep { mkd_make_file = make_file, 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
- {
+ (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 original makefile and copy it into the output
- let slurp = do
+ let slurp = do
l <- hGetLine hdl
hPutStrLn tmp_hdl l
slurp
- ; catchJust ioErrors slurp
+ catchJust ioErrors slurp
(\e -> if isEOFError e then return () else ioError e)
- ; hClose hdl
+ hClose hdl
- ; hClose tmp_hdl -- make sure it's flushed
+ hClose tmp_hdl -- make sure it's flushed
- -- Create a backup of the original makefile
- ; when (isJust makefile_hdl)
- (SysTools.copy dflags ("Backing up " ++ make_file)
- make_file (make_file++".bak"))
+ -- 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 make_file
- }}}
+ -- Copy the new makefile in place
+ SysTools.copy dflags "Installing new makefile" tmp_file makefile
-----------------------------------------------------------------
-- 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) )
+ [ ( "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) )
- , ( "-exclude-module=", Prefix (add v_Dep_exclude_mods . mkModule) )
- , ( "x", Prefix (add v_Dep_exclude_mods . mkModule) )
+ , ( "-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