From 436d7d6786f82883b898c694f69df23111d06a0f Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 26 Feb 2001 15:50:21 +0000 Subject: [PATCH] [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 | 9 --------- ghc/compiler/main/DriverPipeline.hs | 23 ++++++++++++----------- ghc/compiler/main/Finder.lhs | 4 ++++ ghc/compiler/main/HscMain.lhs | 25 +++++++++++++++---------- 4 files changed, 31 insertions(+), 30 deletions(-) diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index 73c5bf3..9f44254 100644 --- 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 --- 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 --- 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 --- 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 -- 1.7.10.4