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.
import qualified GHC
import GHC ( Session, ModSummary(..) )
import DynFlags ( DynFlags( verbosity, opt_dep ), getOpts )
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 )
import HscTypes ( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
import Packages ( PackageIdH(..) )
import SysTools ( newTempName )
import Util ( global, consIORef )
import Outputable
import Panic
import Util ( global, consIORef )
import Outputable
import Panic
import CmdLineParser
import DATA_IOREF ( IORef, readIORef, writeIORef )
import CmdLineParser
import DATA_IOREF ( IORef, readIORef, writeIORef )
; writeDependency hdl obj_files src_file
-- Emit a dependency for each import
; 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
import SrcLoc ( srcLocSpan, mkSrcLoc )
import FastString ( mkFastString )
import Bag ( listToBag, emptyBag )
import SrcLoc ( srcLocSpan, mkSrcLoc )
import FastString ( mkFastString )
import Bag ( listToBag, emptyBag )
+import SrcLoc ( Located(..) )
import EXCEPTION
import DATA_IOREF ( readIORef, writeIORef, IORef )
import EXCEPTION
import DATA_IOREF ( readIORef, writeIORef, IORef )
; return (Nothing, mkModule m) }
other -> do { buf <- hGetStringBuffer input_fn
; 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.
; return (Just buf, mod_name) }
-- Build a ModLocation to pass to hscMain.
import Name ( Name, nameModule )
import NameEnv ( nameEnvElts )
import InstEnv ( Instance )
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 )
import DriverPipeline
import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
import GetImports ( getImports )
import FiniteMap
import Panic
import Digraph
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 )
import qualified ErrUtils
import Util
import StringBuffer ( StringBuffer, hGetStringBuffer )
linkableTime l >= ms_hs_date ms
ms_allimps :: ModSummary -> [Module]
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
-- -----------------------------------------------------------------------------
-- Prune the HomePackageTable
-- 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)),
-- 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
| s <- summaries
, not (isBootSummary s && drop_hs_boot_nodes) ]
-- Drop the hi-boot ones if told to do so
else do
throwDyn (CmdLineError ("can't find file: " ++ file))
getRootSummary (Target (TargetModule modl) maybe_buf)
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
case maybe_summary of
Nothing -> packageModErr modl
Just s -> return s
+ rootLoc = mkGeneralSrcSpan FSLIT("<command line>")
+
-- 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
-- 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
[ expectJust "checkDup" (ml_hs_file (ms_location summ'))
| summ' <- summaries, ms_mod summ' == modl ]
[ 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
-- Work list: process these modules
-> NodeMap ModSummary
-- Visited set
-- The result includes the worklist, except
-- for those mentioned in the visited set
loop [] done = return (nodeMapElts done)
-- 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
| 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
; 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
-- (msDeps s) returns the dependencies of the ModSummary s.
-- A wrinkle is that for a {-# SOURCE #-} import we return
-- *both* the hs-boot file
-- 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
-- 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
-----------------------------------------------------------------------------
-- Summarising modules
(dflags', hspp_fn, buf)
<- preprocessFile dflags 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
-- Make a ModLocation for this file
location <- mkHomeModLocation dflags mod file
summariseModule
:: HscEnv
-> NodeMap ModSummary -- Map of old summaries
summariseModule
:: HscEnv
-> NodeMap ModSummary -- Map of old summaries
- -> Maybe FilePath -- Importing module (for error messages)
-> IsBootInterface -- True <=> a {-# SOURCE #-} import
-> 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
-> 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
| wanted_mod `elem` excl_mods
= return Nothing
-- Drop external-pkg
| isJust (ml_hs_file location) -> just_found location
-- Home package
-- 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
-- Not found
where
dflags = hsc_dflags hsc_env
-- It might have been deleted since the Finder last found it
maybe_t <- modificationTimeIfExists src_fn
case maybe_t of
-- 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
Just t -> new_summary location' src_fn Nothing t
-- 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
-- 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
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
<+> quotes (ppr mod_name))))
-- Find the object timestamp, and return the summary
-- Error messages
-----------------------------------------------------------------------------
-- 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
-- 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 $
= 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
= throwDyn $ CmdLineError $ showSDoc $
= 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) <+>
packageModErr mod
= throwDyn (CmdLineError (showSDoc (text "module" <+>
quotes (ppr mod) <+>
import Module ( Module, mkModule )
import PrelNames ( gHC_PRIM )
import StringBuffer ( StringBuffer, hGetStringBuffer )
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
import FastString ( mkFastString )
import DynFlags ( DynFlags )
import ErrUtils
-- 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 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
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
getImports dflags buf filename = do
let loc = mkSrcLoc (mkFastString filename) 1 0
case unP parseHeader (mkPState buf loc dflags) of
case rdr_module of
L _ (HsModule mod _ imps _ _) ->
let
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
(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)
-- GHC.Prim doesn't exist physically, so don't go looking for it.
in
return (source_imps, ordinary_imps, mod_name)
isSourceIdecl (ImportDecl _ s _ _ _) = s
isSourceIdecl (ImportDecl _ s _ _ _) = s
-getImpMod (ImportDecl (L _ mod) _ _ _ _) = mod
+getImpMod (ImportDecl located_mod _ _ _ _) = located_mod
import CoreSyn ( CoreRule )
import Maybes ( orElse, fromJust, expectJust )
import Outputable
import CoreSyn ( CoreRule )
import Maybes ( orElse, fromJust, expectJust )
import Outputable
-import SrcLoc ( SrcSpan )
+import SrcLoc ( SrcSpan, Located )
import UniqSupply ( UniqSupply )
import FastString ( FastString )
import UniqSupply ( UniqSupply )
import FastString ( FastString )
ms_location :: ModLocation, -- Location
ms_hs_date :: ClockTime, -- Timestamp of source file
ms_obj_date :: Maybe ClockTime, -- Timestamp of object, maybe
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.
ms_hspp_file :: Maybe FilePath, -- Filename of preprocessed source,
-- once we have preprocessed it.
ms_hspp_buf :: Maybe StringBuffer -- The actual preprocessed source, maybe.