[project @ 2002-08-29 15:44:11 by simonmar]
[ghc-hetmet.git] / ghc / compiler / compMan / CompManager.lhs
index 449801c..0c7ead9 100644 (file)
@@ -57,9 +57,6 @@ where
 
 #include "HsVersions.h"
 
-import MkIface --tmp
-import HsSyn   -- tmp
-
 import CmLink
 import CmTypes
 import DriverPipeline
@@ -109,8 +106,7 @@ import CForeign
 import Exception       ( Exception, try )
 #endif
 
--- lang
-import Exception       ( throwDyn )
+import EXCEPTION       ( throwDyn )
 
 -- std
 import Directory        ( getModificationTime, doesFileExist )
@@ -610,7 +606,7 @@ cmLoadModules cmstate1 dflags mg2unsorted
 
        -- clean up between compilations
        let cleanup = cleanTempFilesExcept verb 
-                         (ppFilesFromSummaries (flattenSCCs upsweep_these))
+                         (ppFilesFromSummaries (flattenSCCs mg2))
 
         (upsweep_complete_success, threaded3, modsUpswept, newLis)
            <- upsweep_mods ghci_mode dflags valid_linkables reachable_from 
@@ -1151,6 +1147,7 @@ topological_sort include_source_imports summaries
 downsweep :: [FilePath] -> [ModSummary] -> IO [ModSummary]
 downsweep roots old_summaries
    = do rootSummaries <- mapM getRootSummary roots
+       checkDuplicates rootSummaries
         all_summaries
            <- loop (concat (map (\ m -> zip (repeat (fromMaybe "<unknown>" (ml_hs_file (ms_location m))))
                                            (ms_imps m)) rootSummaries))
@@ -1179,6 +1176,22 @@ downsweep roots old_summaries
                 hs_file = file ++ ".hs"
                 lhs_file = file ++ ".lhs"
 
+       -- In a root module, the filename is allowed to diverge from the module
+       -- name, so we have to check that there aren't multiple root files
+       -- defining the same module (otherwise the duplicates will be silently
+       -- ignored, leading to confusing behaviour).
+       checkDuplicates :: [ModSummary] -> IO ()
+       checkDuplicates summaries = mapM_ check summaries
+         where check summ = 
+                 case dups of
+                       []     -> return ()
+                       [_one] -> return ()
+                       many   -> multiRootsErr modl many
+                  where modl = ms_mod summ
+                        dups = 
+                          [ fromJust (ml_hs_file (ms_location summ'))
+                          | summ' <- summaries, ms_mod summ' == modl ]
+
         getSummary :: (FilePath,ModuleName) -> IO (Maybe ModSummary)
         getSummary (currentMod,nm)
            = do found <- findModule nm
@@ -1290,4 +1303,10 @@ packageModErr mod
   = throwDyn (CmdLineError (showSDoc (text "module" <+>
                                   quotes (ppr mod) <+>
                                   text "is a package module")))
+
+multiRootsErr mod files
+  = throwDyn (ProgramError (showSDoc (
+       text "module" <+> quotes (ppr mod) <+> 
+       text "is defined in multiple files:" <+>
+       sep (map text files))))
 \end{code}