From 25ed0cf7d4c2fbf9e455405f0a8525e0ae27b4e7 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Tue, 2 Dec 2008 13:37:36 +0000 Subject: [PATCH] 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. --- compiler/iface/MkIface.lhs | 5 +++-- compiler/main/DriverMkDepend.hs | 32 +++++++++++++++++--------------- compiler/main/GHC.hs | 29 +++++++++++++++++++---------- compiler/main/HeaderInfo.hs | 24 ++++++------------------ compiler/main/HscTypes.lhs | 5 +++-- 5 files changed, 48 insertions(+), 47 deletions(-) diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 97449b7..4976e1f 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -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 diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs index 5b63392..adfcbbd 100644 --- a/compiler/main/DriverMkDepend.hs +++ b/compiler/main/DriverMkDepend.hs @@ -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)) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 3f72101..48f6501 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -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 diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index d79c3ee..9184909 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -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 -------------------------------------------------------------- diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index e79acf4..9197df5 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -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 -- 1.7.10.4