... 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.
import InstEnv
import FamInstEnv
import TcRnMonad
import InstEnv
import FamInstEnv
import TcRnMonad
import HscTypes
import Finder
import DynFlags
import HscTypes
import Finder
import DynFlags
orM = foldr f (return False)
where f m rest = do b <- m; if b then return True else rest
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
case find_res of
Found _ mod
| pkg == this_pkg
import qualified GHC
import GHC ( ModSummary(..), GhcMonad )
import qualified GHC
import GHC ( ModSummary(..), GhcMonad )
+import HsSyn ( ImportDecl(..) )
import PrelNames
import DynFlags
import Util
import PrelNames
import DynFlags
import Util
obj_file = msObjFilePath node
obj_files = insertSuffixes obj_file extra_suffixes
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 () ;
is_boot include_pkg_deps
; case mb_hi of {
Nothing -> return () ;
-- Emit a dependency for each import
-- 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)) $
; when (dopt Opt_ImplicitPrelude (ms_hspp_opts node)) $
- do_imp False pRELUDE_NAME
+ do_imp False Nothing pRELUDE_NAME
}
findDependency :: HscEnv
}
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
-> 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
= 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
; case r of
Found loc _
-- Home package: just depend on the .hi or hi-boot file
pp_ms loop_breaker $$ vcat (map pp_group groups)
where
(boot_only, others) = partition is_boot_only mss
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
in_group (L _ m) = m `elem` group_mods
group_mods = map (moduleName . ms_mod) mss
groups = GHC.topSortModuleGraph True all_others Nothing
pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
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))
where
mod_str = moduleNameString (moduleName (ms_mod summary))
scc_mods = map ms_mod_name scc
home_module m = m `elem` all_home_mods && m `notElem` scc_mods
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
-- all imports outside the current SCC, but in the home pkg
stable_obj_imps = map (`elem` stable_obj) scc_allimps
linkableTime l >= ms_hs_date ms
_other -> False
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
-- -----------------------------------------------------------------------------
-- | Prune the HomePackageTable
| (s, key) <- numbered_summaries
-- Drop the hi-boot ones if told to do so
, not (isBootSummary s && drop_hs_boot_nodes)
| (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 []
(-- see [boot-edges] below
if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile
then []
logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
where check ms =
let mods_in_this_cycle = map ms_mod_name ms in
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) =
warn :: Located ModuleName -> WarnMsg
warn (L loc mod) =
-- Remember, this pass isn't doing the topological sort. It's
-- just gathering the list of all relevant ModSummaries
msDeps s =
-- 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
-----------------------------------------------------------------------------
-- Summarising modules
import HscTypes
import Parser ( parseHeader )
import Lexer
import HscTypes
import Parser ( parseHeader )
import Lexer
-- reporting parse error locations.
-> FilePath -- ^ The original source filename (used for locations
-- in the function result)
-- 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
-- ^ The source imports, normal imports, and the module name.
getImports dflags buf filename source_filename = do
let loc = mkSrcLoc (mkFastString filename) 1 0
let
main_loc = mkSrcLoc (mkFastString source_filename) 1 0
mod = mb_mod `orElse` L (srcLocSpan main_loc) mAIN_NAME
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
-- 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
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
--------------------------------------------------------------
--------------------------------------------------------------
-- Get options
--------------------------------------------------------------
import {-# SOURCE #-} InteractiveEval ( Resume )
#endif
import {-# SOURCE #-} InteractiveEval ( Resume )
#endif
import RdrName
import Name
import NameEnv
import RdrName
import Name
import NameEnv
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_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
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