Commit 25ed0cf7 authored by Simon Marlow's avatar Simon Marlow

Put full ImportDecls in ModSummary instead of just ModuleNames

... and use it to make ghc -M generate correct cross-package
dependencies when using package-qualified imports (needed for the new
build system).  Since we're already parsing the ImportDecl from the
source file, there seems no good reason not to keep it in the
ModSummary, it might be useful for other things too.
parent 95a05693
......@@ -67,6 +67,7 @@ import TcType
import InstEnv
import FamInstEnv
import TcRnMonad
import HsSyn
import HscTypes
import Finder
import DynFlags
......@@ -1115,8 +1116,8 @@ checkDependencies hsc_env summary iface
orM = foldr f (return False)
where f m rest = do b <- m; if b then return True else rest
dep_missing (L _ mod) = do
find_res <- liftIO $ findImportedModule hsc_env mod Nothing
dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
find_res <- liftIO $ findImportedModule hsc_env mod pkg
case find_res of
Found _ mod
| pkg == this_pkg
......
......@@ -17,6 +17,7 @@ module DriverMkDepend (
import qualified GHC
import GHC ( ModSummary(..), GhcMonad )
import HsSyn ( ImportDecl(..) )
import PrelNames
import DynFlags
import Util
......@@ -186,8 +187,8 @@ processDeps dflags hsc_env excl_mods hdl (AcyclicSCC node)
obj_file = msObjFilePath node
obj_files = insertSuffixes obj_file extra_suffixes
do_imp is_boot imp_mod
= do { mb_hi <- findDependency hsc_env src_file imp_mod
do_imp is_boot pkg_qual imp_mod
= do { mb_hi <- findDependency hsc_env pkg_qual imp_mod
is_boot include_pkg_deps
; case mb_hi of {
Nothing -> return () ;
......@@ -207,29 +208,30 @@ processDeps dflags hsc_env excl_mods hdl (AcyclicSCC node)
-- Emit a dependency for each import
-- SOURCE imports
; mapM_ (do_imp True)
(filter (`notElem` excl_mods) (map unLoc (ms_srcimps node)))
; let do_imps is_boot idecls = sequence_
[ do_imp is_boot (ideclPkgQual i) mod
| L _ i <- idecls,
let mod = unLoc (ideclName i),
mod `notElem` excl_mods ]
-- regular imports
; mapM_ (do_imp False)
(filter (`notElem` excl_mods) (map unLoc (ms_imps node)))
; do_imps True (ms_srcimps node)
; do_imps False (ms_imps node)
; when (dopt Opt_ImplicitPrelude (ms_hspp_opts node)) $
do_imp False pRELUDE_NAME
do_imp False Nothing pRELUDE_NAME
}
findDependency :: HscEnv
-> FilePath -- Importing module: used only for error msg
-> Maybe FastString -- package qualifier, if any
-> ModuleName -- Imported module
-> IsBootInterface -- Source import
-> Bool -- Record dependency on package modules
-> IO (Maybe FilePath) -- Interface file file
findDependency hsc_env _ imp is_boot include_pkg_deps
findDependency hsc_env pkg imp is_boot include_pkg_deps
= do { -- Find the module; this will be fast because
-- we've done it once during downsweep
r <- findImportedModule hsc_env imp Nothing
r <- findImportedModule hsc_env imp pkg
; case r of
Found loc _
-- Home package: just depend on the .hi or hi-boot file
......@@ -359,7 +361,7 @@ pprCycle summaries = pp_group (CyclicSCC summaries)
pp_ms loop_breaker $$ vcat (map pp_group groups)
where
(boot_only, others) = partition is_boot_only mss
is_boot_only ms = not (any in_group (ms_imps ms))
is_boot_only ms = not (any in_group (map (ideclName.unLoc) (ms_imps ms)))
in_group (L _ m) = m `elem` group_mods
group_mods = map (moduleName . ms_mod) mss
......@@ -368,8 +370,8 @@ pprCycle summaries = pp_group (CyclicSCC summaries)
groups = GHC.topSortModuleGraph True all_others Nothing
pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
<+> (pp_imps empty (ms_imps summary) $$
pp_imps (ptext (sLit "{-# SOURCE #-}")) (ms_srcimps summary))
<+> (pp_imps empty (map (ideclName.unLoc) (ms_imps summary)) $$
pp_imps (ptext (sLit "{-# SOURCE #-}")) (map (ideclName.unLoc) (ms_srcimps summary)))
where
mod_str = moduleNameString (moduleName (ms_mod summary))
......
......@@ -1333,7 +1333,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
scc_mods = map ms_mod_name scc
home_module m = m `elem` all_home_mods && m `notElem` scc_mods
scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
-- all imports outside the current SCC, but in the home pkg
stable_obj_imps = map (`elem` stable_obj) scc_allimps
......@@ -1370,9 +1370,6 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
linkableTime l >= ms_hs_date ms
_other -> False
ms_allimps :: ModSummary -> [ModuleName]
ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
-- -----------------------------------------------------------------------------
-- | Prune the HomePackageTable
......@@ -1816,8 +1813,8 @@ moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, l
| (s, key) <- numbered_summaries
-- Drop the hi-boot ones if told to do so
, not (isBootSummary s && drop_hs_boot_nodes)
, let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
out_edge_keys HsSrcFile (map unLoc (ms_imps s)) ++
, let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
out_edge_keys HsSrcFile (map unLoc (ms_home_imps s)) ++
(-- see [boot-edges] below
if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
then []
......@@ -1864,8 +1861,8 @@ warnUnnecessarySourceImports sccs =
logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
where check ms =
let mods_in_this_cycle = map ms_mod_name ms in
[ warn i | m <- ms, i <- ms_srcimps m,
unLoc i `notElem` mods_in_this_cycle ]
[ warn i | m <- ms, i <- ms_home_srcimps m,
unLoc i `notElem` mods_in_this_cycle ]
warn :: Located ModuleName -> WarnMsg
warn (L loc mod) =
......@@ -1987,8 +1984,20 @@ msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
-- Remember, this pass isn't doing the topological sort. It's
-- just gathering the list of all relevant ModSummaries
msDeps s =
concat [ [(m,True), (m,False)] | m <- ms_srcimps s ]
++ [ (m,False) | m <- ms_imps s ]
concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ]
++ [ (m,False) | m <- ms_home_imps s ]
home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
home_imps imps = [ ideclName i | L _ i <- imps, isNothing (ideclPkgQual i) ]
ms_home_allimps :: ModSummary -> [ModuleName]
ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
ms_home_srcimps :: ModSummary -> [Located ModuleName]
ms_home_srcimps = home_imps . ms_srcimps
ms_home_imps :: ModSummary -> [Located ModuleName]
ms_home_imps = home_imps . ms_imps
-----------------------------------------------------------------------------
-- Summarising modules
......
......@@ -15,6 +15,7 @@ module HeaderInfo ( getImports
#include "HsVersions.h"
import RdrName
import HscTypes
import Parser ( parseHeader )
import Lexer
......@@ -51,7 +52,7 @@ getImports :: GhcMonad m =>
-- reporting parse error locations.
-> FilePath -- ^ The original source filename (used for locations
-- in the function result)
-> m ([Located ModuleName], [Located ModuleName], Located ModuleName)
-> m ([Located (ImportDecl RdrName)], [Located (ImportDecl RdrName)], Located ModuleName)
-- ^ The source imports, normal imports, and the module name.
getImports dflags buf filename source_filename = do
let loc = mkSrcLoc (mkFastString filename) 1 0
......@@ -68,29 +69,16 @@ getImports dflags buf filename source_filename = do
let
main_loc = mkSrcLoc (mkFastString source_filename) 1 0
mod = mb_mod `orElse` L (srcLocSpan main_loc) mAIN_NAME
imps' = filter isHomeImp (map unLoc imps)
(src_idecls, ord_idecls) = partition isSourceIdecl imps'
source_imps = map getImpMod src_idecls
ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc)
(map getImpMod ord_idecls)
(src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps
ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc)
ord_idecls
-- GHC.Prim doesn't exist physically, so don't go looking for it.
in
return (source_imps, ordinary_imps, mod)
return (src_idecls, ordinary_imps, mod)
parseError :: GhcMonad m => SrcSpan -> Message -> m a
parseError span err = throwOneError $ mkPlainErrMsg span err
-- we aren't interested in package imports here, filter them out
isHomeImp :: ImportDecl name -> Bool
isHomeImp (ImportDecl _ (Just p) _ _ _ _) = p == fsLit "this"
isHomeImp (ImportDecl _ Nothing _ _ _ _) = True
isSourceIdecl :: ImportDecl name -> Bool
isSourceIdecl (ImportDecl _ _ s _ _ _) = s
getImpMod :: ImportDecl name -> Located ModuleName
getImpMod (ImportDecl located_mod _ _ _ _ _) = located_mod
--------------------------------------------------------------
-- Get options
--------------------------------------------------------------
......
......@@ -111,6 +111,7 @@ import ByteCodeAsm ( CompiledByteCode )
import {-# SOURCE #-} InteractiveEval ( Resume )
#endif
import HsSyn
import RdrName
import Name
import NameEnv
......@@ -1873,8 +1874,8 @@ data ModSummary
ms_location :: ModLocation, -- ^ Location of the various files belonging to the module
ms_hs_date :: ClockTime, -- ^ Timestamp of source file
ms_obj_date :: Maybe ClockTime, -- ^ Timestamp of object, if we have one
ms_srcimps :: [Located ModuleName], -- ^ Source imports of the module
ms_imps :: [Located ModuleName], -- ^ Non-source imports of the module
ms_srcimps :: [Located (ImportDecl RdrName)], -- ^ Source imports of the module
ms_imps :: [Located (ImportDecl RdrName)], -- ^ Non-source imports of the module
ms_hspp_file :: FilePath, -- ^ Filename of preprocessed source file
ms_hspp_opts :: DynFlags, -- ^ Cached flags from @OPTIONS@, @INCLUDE@
-- and @LANGUAGE@ pragmas in the modules source code
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment