[project @ 2001-02-26 15:50:21 by simonmar]

- message wibbles

- in one-shot mode, make sure the interface file follows the module rather
  than the filename of the source.

ghc/compiler/compMan/CompManager.lhs

@@ -703,15 +703,6 @@ upsweep_mod ghci_mode dflags oldUI threaded1 summary1 reachable_from_here
         let mod_name = name_of_summary summary1
 	let verb = verbosity dflags
 
-        when (verb == 1) $
-	   if (ghci_mode == Batch)
-		then hPutStr stderr (progName ++ ": module " 
-                       	++ moduleNameUserString mod_name
-			++ ": ")
-		else hPutStr stderr ("Compiling "
-		       	++ moduleNameUserString mod_name
-		 	++ " ... ")
-
         let (CmThreaded pcs1 hst1 hit1) = threaded1
         let old_iface = lookupUFM hit1 mod_name
 

ghc/compiler/main/DriverPipeline.hs

 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.50 2001/02/05 17:52:49 rrt Exp $
+-- $Id: DriverPipeline.hs,v 1.51 2001/02/26 15:50:21 simonmar Exp $
 --
 -- GHC Driver
 --
@@ -36,6 +36,7 @@ import DriverPhases
 import DriverFlags
 import HscMain
 import TmpFiles
+import Finder
 import HscTypes
 import Outputable
 import Module
@@ -461,13 +462,12 @@ run_phase Hsc basename suff input_fn output_fn
 				  then return True
 				  else return False
 
-   -- build a ModuleLocation to pass to hscMain.
-        let location = ModuleLocation {
-                          ml_hs_file   = Nothing,
-                          ml_hspp_file = Just input_fn,
-                          ml_hi_file   = Just hifile,
-                          ml_obj_file  = Just o_file
-                       }
+	 -- build a ModuleLocation to pass to hscMain.
+        modsrc <- readFile input_fn
+        let (srcimps,imps,mod_name) = getImports modsrc
+
+	Just (mod, location)
+	   <- mkHomeModuleLocn mod_name basename (basename ++ '.':suff)
 
   -- get the DynFlags
         dyn_flags <- readIORef v_DynFlags
@@ -476,8 +476,9 @@ run_phase Hsc basename suff input_fn output_fn
         pcs <- initPersistentCompilerState
 	result <- hscMain OneShot
                           dyn_flags{ hscOutName = output_fn }
+			  mod
+			  location{ ml_hspp_file=Just input_fn }
 			  source_unchanged
-			  location
 			  Nothing	 -- no iface
 			  emptyModuleEnv -- HomeSymbolTable
 			  emptyModuleEnv -- HomeIfaceTable
@@ -882,8 +883,8 @@ compile ghci_mode summary source_unchanged old_iface hst hit pcs = do
 
    -- run the compiler
    hsc_result <- hscMain ghci_mode dyn_flags{ hscOutName = output_fn } 
-			 source_unchanged
-                         location old_iface hst hit pcs
+			 (ms_mod summary) location
+			 source_unchanged old_iface hst hit pcs
 
    case hsc_result of
       HscFail pcs -> return (CompErrs pcs)

ghc/compiler/main/Finder.lhs

@@ -95,11 +95,15 @@ maybeHomeModule mod_name = do
        lhs = basename ++ ".lhs"
 
    case lookupFM home_map hs of {
+	  -- special case to avoid getting "./foo.hs" all the time
+	Just "."  -> mkHomeModuleLocn mod_name basename hs;
 	Just path -> mkHomeModuleLocn mod_name 
 			(path ++ '/':basename) (path ++ '/':hs);
 	Nothing ->
 
    case lookupFM home_map lhs of {
+	  -- special case to avoid getting "./foo.hs" all the time
+	Just "."  -> mkHomeModuleLocn mod_name basename lhs;
 	Just path ->  mkHomeModuleLocn mod_name
 			(path ++ '/':basename) (path ++ '/':lhs);
 	Nothing -> do

ghc/compiler/main/HscMain.lhs

@@ -45,7 +45,8 @@ import CodeOutput	( codeOutput )
 
 import Id		( Id, idName, idFlavour, modifyIdInfo )
 import IdInfo		( setFlavourInfo, makeConstantFlavour )
-import Module		( ModuleName, moduleName, mkHomeModule )
+import Module		( ModuleName, moduleName, mkHomeModule, 
+			  moduleUserString )
 import CmdLineOpts
 import ErrUtils		( dumpIfSet_dyn, showPass )
 import Util		( unJust )
@@ -105,15 +106,16 @@ data HscResult
 hscMain
   :: GhciMode
   -> DynFlags
-  -> Bool			-- source unchanged?
+  -> Module
   -> ModuleLocation		-- location info
+  -> Bool			-- source unchanged?
   -> Maybe ModIface		-- old interface, if available
   -> HomeSymbolTable		-- for home module ModDetails
   -> HomeIfaceTable
   -> PersistentCompilerState    -- IN: persistent compiler state
   -> IO HscResult
 
-hscMain ghci_mode dflags source_unchanged location maybe_old_iface hst hit pcs
+hscMain ghci_mode dflags mod location source_unchanged maybe_old_iface hst hit pcs
  = do {
       showPass dflags ("Checking old interface for hs = " 
 			++ show (ml_hs_file location)
@@ -132,13 +134,13 @@ hscMain ghci_mode dflags source_unchanged location maybe_old_iface hst hit pcs
           what_next | recomp_reqd || no_old_iface = hscRecomp 
                     | otherwise                   = hscNoRecomp
       ;
-      what_next ghci_mode dflags location maybe_checked_iface
+      what_next ghci_mode dflags mod location maybe_checked_iface
                 hst hit pcs_ch
       }}
 
 
 -- we definitely expect to have the old interface available
-hscNoRecomp ghci_mode dflags location (Just old_iface) hst hit pcs_ch
+hscNoRecomp ghci_mode dflags mod location (Just old_iface) hst hit pcs_ch
  | ghci_mode == OneShot
  = do {
       hPutStrLn stderr "compilation IS NOT required";
@@ -148,8 +150,7 @@ hscNoRecomp ghci_mode dflags location (Just old_iface) hst hit pcs_ch
  | otherwise
  = do {
       when (verbosity dflags >= 1) $
-      	  hPutStrLn stderr ("Skipping  " ++ 
-			(unJust "hscNoRecomp" (ml_hs_file location)));
+		hPutStrLn stderr ("Skipping  " ++ compMsg mod location);
 
       -- CLOSURE
       (pcs_cl, closure_errs, cl_hs_decls) 
@@ -172,12 +173,16 @@ hscNoRecomp ghci_mode dflags location (Just old_iface) hst hit pcs_ch
       return (HscNoRecomp pcs_tc new_details old_iface)
       }}}}
 
+compMsg mod location =
+    mod_str ++ take (12 - length mod_str) (repeat ' ')
+    ++ " (" ++ unJust "hscRecomp" (ml_hs_file location) ++ ")"
+ where mod_str = moduleUserString mod
+
 
-hscRecomp ghci_mode dflags location maybe_checked_iface hst hit pcs_ch
+hscRecomp ghci_mode dflags mod location maybe_checked_iface hst hit pcs_ch
  = do	{
       	; when (verbosity dflags >= 1) $
-		hPutStrLn stderr ("Compiling " ++ 
-			(unJust "hscRecomp" (ml_hs_file location)))
+		hPutStrLn stderr ("Compiling " ++ compMsg mod location);
 
       	  -- what target are we shooting for?
       	; let toInterp = dopt_HscLang dflags == HscInterpreted