X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverMkDepend.hs;h=80d906c4a7c0e8b0c91ca2e94029238f877658aa;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=bd0be6f4509d3a56b1fa362e0c2a2e3e12cd6e0a;hpb=bdfa0107143179ddd8e539306442eefeb1913d48;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs index bd0be6f..80d906c 100644 --- a/ghc/compiler/main/DriverMkDepend.hs +++ b/ghc/compiler/main/DriverMkDepend.hs @@ -15,33 +15,35 @@ module DriverMkDepend ( import qualified GHC import GHC ( Session, ModSummary(..) ) import DynFlags ( DynFlags( verbosity, opt_dep ), getOpts ) -import Util ( escapeSpaces, splitFilename ) +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, +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 -import ErrUtils ( debugTraceMsg ) - ----------------------------------------------------------------- -- -- The main function @@ -55,25 +57,27 @@ doMkDependHS session srcs ; files <- beginMkDependHS dflags -- Do the downsweep to find all the modules - ; targets <- mapM GHC.guessTarget srcs + ; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs ; GHC.setTargets session targets ; excl_mods <- readIORef v_Dep_exclude_mods - ; GHC.depanal session excl_mods - ; mod_summaries <- GHC.getModuleGraph session + ; 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 + let sorted = GHC.topSortModuleGraph False mod_summaries Nothing -- Print out the dependencies if wanted - ; debugTraceMsg dflags 2 (showSDoc (text "Module dependencies" $$ ppr sorted)) - + ; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted) + -- Prcess them one by one, dumping results into makefile -- and complaining about cycles - ; mapM (processDeps session (mkd_tmp_hdl files)) sorted + ; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted -- Tidy up - ; endMkDependHS dflags files } + ; endMkDependHS dflags files }} ----------------------------------------------------------------- -- @@ -149,6 +153,7 @@ beginMkDependHS dflags = do ----------------------------------------------------------------- processDeps :: Session + -> [Module] -> Handle -- Write dependencies to here -> SCC ModSummary -> IO () @@ -167,11 +172,11 @@ processDeps :: Session -- -- For {-# SOURCE #-} imports the "hi" will be "hi-boot". -processDeps session hdl (CyclicSCC nodes) +processDeps session excl_mods hdl (CyclicSCC nodes) = -- There shouldn't be any cycles; report them throwDyn (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes)) -processDeps session 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 @@ -199,8 +204,14 @@ processDeps session hdl (AcyclicSCC node) ; 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))) } @@ -255,7 +266,7 @@ insertSuffixes -- 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