[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.

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index 73c5bf3..9f44254 100644 (file)
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/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
 

diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index d81b6af..c0e5896 100644 (file)
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $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)

diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs
index ed3cdf8..b3f776d 100644 (file)
--- a/ghc/compiler/main/Finder.lhs
+++ b/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

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index e42f092..e60fbbe 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/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