X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverMkDepend.hs;h=80d906c4a7c0e8b0c91ca2e94029238f877658aa;hb=d35356e840b98f614212fcfedb8cf46ad89b4861;hp=42972ead2488c595560f9deda1f7382cd2935137;hpb=6720aae478aeffab9d93b33b76e8718130cd4a7b;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs
index 42972ea..80d906c 100644
--- a/ghc/compiler/main/DriverMkDepend.hs
+++ b/ghc/compiler/main/DriverMkDepend.hs
@@ -15,32 +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
-
 -----------------------------------------------------------------
 --
 --		The main function
@@ -54,27 +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
-	; 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 session (mkd_tmp_hdl files)) sorted
+	; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted
 
 		-- Tidy up
-	; endMkDependHS dflags files }
+	; endMkDependHS dflags files }}
 
 -----------------------------------------------------------------
 --
@@ -150,6 +153,7 @@ beginMkDependHS dflags = do
 -----------------------------------------------------------------
 
 processDeps :: Session
+	    -> [Module]
 	    -> Handle		-- Write dependencies to here
 	    -> SCC ModSummary
 	    -> IO ()
@@ -168,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
@@ -200,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)))
 	}
 
 
@@ -256,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