[project @ 2006-01-06 16:30:17 by simonmar]

[ghc-hetmet.git] / ghc / compiler / main / DriverMkDepend.hs

diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs
index 42972ea..80d906c 100644 (file)
--- 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