From 8d6afe743a98a77c08f917438d012d95857c278d Mon Sep 17 00:00:00 2001 From: simonmar Date: Tue, 17 May 2005 12:00:04 +0000 Subject: [PATCH] [project @ 2005-05-17 12:00:04 by simonmar] Improve source locations on error messages from the downsweep. We now keep track of SrcSpans from import declarations, so we can report a proper source location for unknown imports (this improves on the previous hacky solution of keeping track of the filename that contained the original import declaration). ModSummary now contains (Located Module) for each import instead of Module. --- ghc/compiler/main/DriverMkDepend.hs | 7 ++-- ghc/compiler/main/DriverPipeline.hs | 3 +- ghc/compiler/main/GHC.hs | 69 +++++++++++++++-------------------- ghc/compiler/main/GetImports.hs | 17 +++++---- ghc/compiler/main/HscTypes.lhs | 6 +-- 5 files changed, 49 insertions(+), 53 deletions(-) diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs index 7580ccc..36990cb 100644 --- a/ghc/compiler/main/DriverMkDepend.hs +++ b/ghc/compiler/main/DriverMkDepend.hs @@ -15,7 +15,7 @@ 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 ) @@ -27,6 +27,7 @@ import Finder ( findModule, FindResult(..) ) import Util ( global, consIORef ) import Outputable import Panic +import SrcLoc ( unLoc ) import CmdLineParser import DATA_IOREF ( IORef, readIORef, writeIORef ) @@ -199,8 +200,8 @@ 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 + ; mapM_ (do_imp True . unLoc) (ms_srcimps node) -- SOURCE imports + ; mapM_ (do_imp False . unLoc) (ms_imps node) -- regular imports } diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 910d491..c63b1a7 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -54,6 +54,7 @@ import ParserCoreUtils ( getCoreModuleName ) import SrcLoc ( srcLocSpan, mkSrcLoc ) import FastString ( mkFastString ) import Bag ( listToBag, emptyBag ) +import SrcLoc ( Located(..) ) import EXCEPTION import DATA_IOREF ( readIORef, writeIORef, IORef ) @@ -621,7 +622,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma ; return (Nothing, mkModule m) } other -> do { buf <- hGetStringBuffer input_fn - ; (_,_,mod_name) <- getImports dflags buf input_fn + ; (_,_,L _ mod_name) <- getImports dflags buf input_fn ; return (Just buf, mod_name) } -- Build a ModLocation to pass to hscMain. diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs index 3b9e6a3..36558f4 100644 --- a/ghc/compiler/main/GHC.hs +++ b/ghc/compiler/main/GHC.hs @@ -172,7 +172,7 @@ import DataCon ( DataCon ) import Name ( Name, nameModule ) import NameEnv ( nameEnvElts ) import InstEnv ( Instance ) -import SrcLoc ( Located(..) ) +import SrcLoc ( Located(..), mkGeneralSrcSpan, SrcSpan, unLoc ) import DriverPipeline import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase ) import GetImports ( getImports ) @@ -187,7 +187,7 @@ import Module import FiniteMap import Panic import Digraph -import ErrUtils ( showPass, Messages, putMsg, debugTraceMsg ) +import ErrUtils ( showPass, Messages, putMsg, debugTraceMsg, mkLocMessage ) import qualified ErrUtils import Util import StringBuffer ( StringBuffer, hGetStringBuffer ) @@ -843,7 +843,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs linkableTime l >= ms_hs_date ms ms_allimps :: ModSummary -> [Module] -ms_allimps ms = ms_srcimps ms ++ ms_imps ms +ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms) -- ----------------------------------------------------------------------------- -- Prune the HomePackageTable @@ -1143,8 +1143,8 @@ moduleGraphNodes drop_hs_boot_nodes summaries = (nodes, lookup_key) -- We use integers as the keys for the SCC algorithm nodes :: [(ModSummary, Int, [Int])] nodes = [(s, expectJust "topSort" (lookup_key (ms_hsc_src s) (ms_mod s)), - out_edge_keys hs_boot_key (ms_srcimps s) ++ - out_edge_keys HsSrcFile (ms_imps s) ) + out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++ + out_edge_keys HsSrcFile (map unLoc (ms_imps s)) ) | s <- summaries , not (isBootSummary s && drop_hs_boot_nodes) ] -- Drop the hi-boot ones if told to do so @@ -1236,12 +1236,14 @@ downsweep hsc_env old_summaries excl_mods else do throwDyn (CmdLineError ("can't find file: " ++ file)) getRootSummary (Target (TargetModule modl) maybe_buf) - = do maybe_summary <- summariseModule hsc_env old_summary_map Nothing False - modl maybe_buf excl_mods + = do maybe_summary <- summariseModule hsc_env old_summary_map False + (L rootLoc modl) maybe_buf excl_mods case maybe_summary of Nothing -> packageModErr modl Just s -> return s + rootLoc = mkGeneralSrcSpan FSLIT("") + -- 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 @@ -1258,7 +1260,7 @@ downsweep hsc_env old_summaries excl_mods [ expectJust "checkDup" (ml_hs_file (ms_location summ')) | summ' <- summaries, ms_mod summ' == modl ] - loop :: [(FilePath,Module,IsBootInterface)] + loop :: [(Located Module,IsBootInterface)] -- Work list: process these modules -> NodeMap ModSummary -- Visited set @@ -1266,21 +1268,18 @@ downsweep hsc_env old_summaries excl_mods -- The result includes the worklist, except -- for those mentioned in the visited set loop [] done = return (nodeMapElts done) - loop ((cur_path, wanted_mod, is_boot) : ss) done + loop ((wanted_mod, is_boot) : ss) done | key `elemFM` done = loop ss done | otherwise = do { mb_s <- summariseModule hsc_env old_summary_map - (Just cur_path) is_boot - wanted_mod Nothing excl_mods + is_boot wanted_mod Nothing excl_mods ; case mb_s of Nothing -> loop ss done Just s -> loop (msDeps s ++ ss) (addToFM done key s) } where - key = (wanted_mod, if is_boot then HsBootFile else HsSrcFile) + key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile) -msDeps :: ModSummary -> [(FilePath, -- Importing module - Module, -- Imported module - IsBootInterface)] -- {-# SOURCE #-} import or not +msDeps :: ModSummary -> [(Located Module, IsBootInterface)] -- (msDeps s) returns the dependencies of the ModSummary s. -- A wrinkle is that for a {-# SOURCE #-} import we return -- *both* the hs-boot file @@ -1289,11 +1288,9 @@ msDeps :: ModSummary -> [(FilePath, -- Importing module -- modules always contains B.hs if it contains B.hs-boot. -- Remember, this pass isn't doing the topological sort. It's -- just gathering the list of all relevant ModSummaries -msDeps s = concat [ [(f, m, True), (f,m,False)] | m <- ms_srcimps s] - ++ [(f,m,False) | m <- ms_imps s] - where - f = msHsFilePath s -- Keep the importing module for error reporting - +msDeps s = + concat [ [(m,True), (m,False)] | m <- ms_srcimps s ] + ++ [ (m,False) | m <- ms_imps s ] ----------------------------------------------------------------------------- -- Summarising modules @@ -1345,7 +1342,7 @@ summariseFile hsc_env old_summaries file mb_phase maybe_buf (dflags', hspp_fn, buf) <- preprocessFile dflags file mb_phase maybe_buf - (srcimps,the_imps,mod) <- getImports dflags' buf hspp_fn + (srcimps,the_imps, L _ mod) <- getImports dflags' buf hspp_fn -- Make a ModLocation for this file location <- mkHomeModLocation dflags mod file @@ -1379,14 +1376,13 @@ findSummaryBySourceFile summaries file summariseModule :: HscEnv -> NodeMap ModSummary -- Map of old summaries - -> Maybe FilePath -- Importing module (for error messages) -> IsBootInterface -- True <=> a {-# SOURCE #-} import - -> Module -- Imported module to be summarised + -> Located Module -- Imported module to be summarised -> Maybe (StringBuffer, ClockTime) -> [Module] -- Modules to exclude -> IO (Maybe ModSummary) -- Its new summary -summariseModule hsc_env old_summary_map cur_mod is_boot wanted_mod maybe_buf excl_mods +summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf excl_mods | wanted_mod `elem` excl_mods = return Nothing @@ -1417,7 +1413,7 @@ summariseModule hsc_env old_summary_map cur_mod is_boot wanted_mod maybe_buf exc -- Drop external-pkg | isJust (ml_hs_file location) -> just_found location -- Home package - err -> noModError dflags cur_mod wanted_mod err + err -> noModError dflags loc wanted_mod err -- Not found where dflags = hsc_dflags hsc_env @@ -1435,7 +1431,7 @@ summariseModule hsc_env old_summary_map cur_mod is_boot wanted_mod maybe_buf exc -- It might have been deleted since the Finder last found it maybe_t <- modificationTimeIfExists src_fn case maybe_t of - Nothing -> noHsFileErr cur_mod src_fn + Nothing -> noHsFileErr loc src_fn Just t -> new_summary location' src_fn Nothing t @@ -1444,12 +1440,12 @@ summariseModule hsc_env old_summary_map cur_mod is_boot wanted_mod maybe_buf exc -- Preprocess the source file and get its imports -- The dflags' contains the OPTIONS pragmas (dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf - (srcimps, the_imps, mod_name) <- getImports dflags' buf hspp_fn + (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn when (mod_name /= wanted_mod) $ throwDyn (ProgramError - (showSDoc (text src_fn - <> text ": file name does not match module name" + (showSDoc (mkLocMessage mod_loc $ + text "file name does not match module name" <+> quotes (ppr mod_name)))) -- Find the object timestamp, and return the summary @@ -1506,21 +1502,16 @@ preprocessFile dflags src_fn mb_phase (Just (buf, time)) -- Error messages ----------------------------------------------------------------------------- -noModError :: DynFlags -> Maybe FilePath -> Module -> FindResult -> IO ab +noModError :: DynFlags -> SrcSpan -> Module -> FindResult -> IO ab -- ToDo: we don't have a proper line number for this error -noModError dflags cur_mod wanted_mod err +noModError dflags loc wanted_mod err = throwDyn $ ProgramError $ showSDoc $ - vcat [cantFindError dflags wanted_mod err, - nest 2 (parens (pp_where cur_mod))] + mkLocMessage loc $ cantFindError dflags wanted_mod err -noHsFileErr cur_mod path +noHsFileErr loc path = throwDyn $ CmdLineError $ showSDoc $ - vcat [text "Can't find" <+> text path, - nest 2 (parens (pp_where cur_mod))] + mkLocMessage loc $ text "Can't find" <+> text path -pp_where Nothing = text "one of the roots of the dependency analysis" -pp_where (Just p) = text "imported from" <+> text p - packageModErr mod = throwDyn (CmdLineError (showSDoc (text "module" <+> quotes (ppr mod) <+> diff --git a/ghc/compiler/main/GetImports.hs b/ghc/compiler/main/GetImports.hs index c165b4a..77ca4b5 100644 --- a/ghc/compiler/main/GetImports.hs +++ b/ghc/compiler/main/GetImports.hs @@ -17,7 +17,7 @@ import HsSyn ( ImportDecl(..), HsModule(..) ) import Module ( Module, mkModule ) import PrelNames ( gHC_PRIM ) import StringBuffer ( StringBuffer, hGetStringBuffer ) -import SrcLoc ( Located(..), mkSrcLoc, unLoc ) +import SrcLoc ( Located(..), mkSrcLoc, unLoc, noSrcSpan ) import FastString ( mkFastString ) import DynFlags ( DynFlags ) import ErrUtils @@ -32,12 +32,14 @@ import List -- getImportsFromFile is careful to close the file afterwards, otherwise -- we can end up with a large number of open handles before the garbage -- collector gets around to closing them. -getImportsFromFile :: DynFlags -> FilePath -> IO ([Module], [Module], Module) +getImportsFromFile :: DynFlags -> FilePath + -> IO ([Located Module], [Located Module], Located Module) getImportsFromFile dflags filename = do buf <- hGetStringBuffer filename getImports dflags buf filename -getImports :: DynFlags -> StringBuffer -> FilePath -> IO ([Module], [Module], Module) +getImports :: DynFlags -> StringBuffer -> FilePath + -> IO ([Located Module], [Located Module], Located Module) getImports dflags buf filename = do let loc = mkSrcLoc (mkFastString filename) 1 0 case unP parseHeader (mkPState buf loc dflags) of @@ -46,11 +48,12 @@ getImports dflags buf filename = do case rdr_module of L _ (HsModule mod _ imps _ _) -> let - mod_name | Just (L _ m) <- mod = m - | otherwise = mkModule "Main" + mod_name | Just located_mod <- mod = located_mod + | otherwise = L noSrcSpan (mkModule "Main") (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps) source_imps = map getImpMod src_idecls - ordinary_imps = filter (/= gHC_PRIM) (map getImpMod ord_idecls) + ordinary_imps = filter ((/= gHC_PRIM) . unLoc) + (map getImpMod ord_idecls) -- GHC.Prim doesn't exist physically, so don't go looking for it. in return (source_imps, ordinary_imps, mod_name) @@ -60,4 +63,4 @@ parseError span err = throwDyn (ProgramError err_doc) isSourceIdecl (ImportDecl _ s _ _ _) = s -getImpMod (ImportDecl (L _ mod) _ _ _ _) = mod +getImpMod (ImportDecl located_mod _ _ _ _) = located_mod diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index ce54d8d..d2d63ca 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -96,7 +96,7 @@ import FiniteMap ( FiniteMap ) import CoreSyn ( CoreRule ) import Maybes ( orElse, fromJust, expectJust ) import Outputable -import SrcLoc ( SrcSpan ) +import SrcLoc ( SrcSpan, Located ) import UniqSupply ( UniqSupply ) import FastString ( FastString ) @@ -938,8 +938,8 @@ data ModSummary ms_location :: ModLocation, -- Location ms_hs_date :: ClockTime, -- Timestamp of source file ms_obj_date :: Maybe ClockTime, -- Timestamp of object, maybe - ms_srcimps :: [Module], -- Source imports - ms_imps :: [Module], -- Non-source imports + ms_srcimps :: [Located Module], -- Source imports + ms_imps :: [Located Module], -- Non-source imports ms_hspp_file :: Maybe FilePath, -- Filename of preprocessed source, -- once we have preprocessed it. ms_hspp_buf :: Maybe StringBuffer -- The actual preprocessed source, maybe. -- 1.7.10.4