cmInit, -- :: GhciMode -> IO CmState
cmDepAnal, -- :: CmState -> [FilePath] -> IO ModuleGraph
+ cmDownsweep,
cmTopSort, -- :: Bool -> ModuleGraph -> [SCC ModSummary]
cyclicModuleErr, -- :: [ModSummary] -> String -- Used by DriverMkDepend
hPutStrLn stderr (showSDoc (hcat [
text "Chasing modules from: ",
hcat (punctuate comma (map text rootnames))]))
- downsweep dflags rootnames (cm_mg cmstate)
+ cmDownsweep dflags rootnames (cm_mg cmstate) []
where
hsc_env = cm_hsc cmstate
dflags = hsc_dflags hsc_env
-- We pass in the previous collection of summaries, which is used as a
-- cache to avoid recalculating a module summary if the source is
-- unchanged.
-
-downsweep :: DynFlags -> [FilePath] -> [ModSummary] -> IO [ModSummary]
-downsweep dflags roots old_summaries
+--
+-- The returned list of [ModSummary] nodes has one node for each home-package
+-- module. The imports of these nodes are all there, including the imports
+-- of non-home-package modules.
+
+cmDownsweep :: DynFlags
+ -> [FilePath] -- Roots
+ -> [ModSummary] -- Old summaries
+ -> [Module] -- Ignore dependencies on these; treat them as
+ -- if they were package modules
+ -> IO [ModSummary]
+cmDownsweep dflags roots old_summaries excl_mods
= do rootSummaries <- mapM getRootSummary roots
checkDuplicates rootSummaries
loop (concatMap msImports rootSummaries)
exists <- doesFileExist lhs_file
if exists then summariseFile dflags lhs_file else do
let mod_name = mkModule file
- maybe_summary <- summarise dflags emptyNodeMap Nothing False mod_name
+ maybe_summary <- summarise dflags emptyNodeMap Nothing False
+ mod_name excl_mods
case maybe_summary of
Nothing -> packageModErr mod_name
Just s -> return s
loop ((cur_path, wanted_mod, is_boot) : ss) done
| key `elemFM` done = loop ss done
| otherwise = do { mb_s <- summarise dflags old_summary_map
- (Just cur_path) is_boot wanted_mod
+ (Just cur_path) is_boot
+ wanted_mod excl_mods
; case mb_s of
Nothing -> loop ss done
Just s -> loop (msImports s ++ ss)
-- to findModule will find it, even if it's not on any search path
addHomeModuleToFinder mod location
- src_timestamp
- <- case ml_hs_file location of
- Nothing -> noHsFileErr Nothing mod
- Just src_fn -> getModificationTime src_fn
-
+ src_timestamp <- getModificationTime file
return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
ms_location = location,
ms_hspp_file = Just hspp_fn,
-> Maybe FilePath -- Importing module (for error messages)
-> IsBootInterface -- True <=> a {-# SOURCE #-} import
-> Module -- Imported module to be summarised
+ -> [Module] -- Modules to exclude
-> IO (Maybe ModSummary) -- Its new summary
-summarise dflags old_summary_map cur_mod is_boot wanted_mod
+summarise dflags old_summary_map cur_mod is_boot wanted_mod excl_mods
+ | wanted_mod `elem` excl_mods
+ = return Nothing
+
+ | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
+ = do { -- Find its new timestamp; all the
+ -- ModSummaries in the old map have valid ml_hs_files
+ let location = ms_location old_summary
+ src_fn = fromJust (ml_hs_file location)
+
+ ; src_timestamp <- getModificationTime src_fn
+
+ -- return the cached summary if the source didn't change
+ ; if ms_hs_date old_summary == src_timestamp
+ then return (Just old_summary)
+ else new_summary location
+ }
+
+ | otherwise
= do { found <- findModule dflags wanted_mod True {-explicit-}
; case found of
Found location pkg
- | isHomePackage pkg
- -> do { summary <- do_summary location
- ; return (Just summary) }
- | otherwise
- -> return Nothing -- Drop an external-package modules
-
- err -> noModError dflags cur_mod wanted_mod err
+ | not (isHomePackage pkg) -> return Nothing -- Drop external-pkg
+ | isJust (ml_hs_file location) -> new_summary location -- Home package
+ err -> noModError dflags cur_mod wanted_mod err -- Not found
}
where
hsc_src = if is_boot then HsBootFile else HsSrcFile
- do_summary location
+ new_summary location
= do { -- Adjust location to point to the hs-boot source file,
-- hi file, object file, when is_boot says so
- let location' | is_boot = addBootSuffixLocn location
- | otherwise = location
-
- -- Find the source file to summarise
- ; src_fn <- case ml_hs_file location' of
- Nothing -> noHsFileErr cur_mod wanted_mod
- Just src_fn -> return src_fn
-
- -- In the case of hs-boot files, check that it exists
- -- The Finder was dealing only with the main source file
- ; if is_boot then do
- { exists <- doesFileExist src_fn
- ; if exists then return ()
- else noHsBootFileErr cur_mod src_fn }
- else return ()
-
- -- Find its timestamp
- ; src_timestamp <- getModificationTime src_fn
-
- -- return the cached summary if the source didn't change
- ; case lookupFM old_summary_map (wanted_mod, hsc_src) of {
- Just s | ms_hs_date s == src_timestamp -> return s;
- _ -> do
-
- -- Preprocess the source file
- { (dflags', hspp_fn) <- preprocess dflags src_fn
- -- The dflags' contains the OPTIONS pragmas
-
+ let location' | is_boot = addBootSuffixLocn location
+ | otherwise = location
+ src_fn = fromJust (ml_hs_file location')
+
+ -- Check that it exists
+ -- It might have been deleted since the Finder last found it
+ ; exists <- doesFileExist src_fn
+ ; if exists then return () else noHsFileErr cur_mod src_fn
+
+ -- Preprocess the source file and get its imports
+ -- The dflags' contains the OPTIONS pragmas
+ ; (dflags', hspp_fn) <- preprocess dflags src_fn
; buf <- hGetStringBuffer hspp_fn
; (srcimps, the_imps, mod_name) <- getImports dflags' buf hspp_fn
<> text ": file name does not match module name"
<+> quotes (ppr mod_name))))
- ; return (ModSummary { ms_mod = wanted_mod,
- ms_hsc_src = hsc_src,
- ms_location = location',
- ms_hspp_file = Just hspp_fn,
- ms_hspp_buf = Just buf,
- ms_srcimps = srcimps,
- ms_imps = the_imps,
- ms_hs_date = src_timestamp })
- }}}
+ -- Find its timestamp, and return the summary
+ ; src_timestamp <- getModificationTime src_fn
+ ; return (Just ( ModSummary { ms_mod = wanted_mod,
+ ms_hsc_src = hsc_src,
+ ms_location = location',
+ ms_hspp_file = Just hspp_fn,
+ ms_hspp_buf = Just buf,
+ ms_srcimps = srcimps,
+ ms_imps = the_imps,
+ ms_hs_date = src_timestamp }))
+ }
-----------------------------------------------------------------------------
vcat [cantFindError dflags wanted_mod err,
nest 2 (parens (pp_where cur_mod))]
-noHsFileErr :: Maybe FilePath -> Module -> IO a
--- Complain about not being able to find an imported module
-noHsFileErr cur_mod mod
- = throwDyn $ CmdLineError $ showSDoc $
- vcat [text "No source file for module" <+> quotes (ppr mod),
- nest 2 (parens (pp_where cur_mod))]
-
-noHsBootFileErr cur_mod path
+noHsFileErr cur_mod path
= throwDyn $ CmdLineError $ showSDoc $
vcat [text "Can't find" <+> text path,
nest 2 (parens (pp_where cur_mod))]
-----------------------------------------------------------------------------
--- $Id: DriverMkDepend.hs,v 1.39 2005/02/02 13:40:34 simonpj Exp $
+-- $Id: DriverMkDepend.hs,v 1.40 2005/02/04 15:43:32 simonpj Exp $
--
-- GHC Driver
--
#include "HsVersions.h"
-import CompManager ( cmInit, cmDepAnal, cmTopSort, cyclicModuleErr )
+import CompManager ( cmDownsweep, cmTopSort, cyclicModuleErr )
import CmdLineOpts ( DynFlags( verbosity ) )
import DriverState ( getStaticOpts, v_Opt_dep )
import DriverUtil ( escapeSpaces, splitFilename, add )
import DriverFlags ( processArgs, OptKind(..) )
-import HscTypes ( IsBootInterface, ModSummary(..), GhciMode(..),
- msObjFilePath, msHsFilePath )
+import HscTypes ( IsBootInterface, ModSummary(..), msObjFilePath, msHsFilePath )
import Packages ( PackageIdH(..) )
import SysTools ( newTempName )
import qualified SysTools
-import Module ( Module, ModLocation(..), moduleUserString, addBootSuffix_maybe )
+import Module ( Module, ModLocation(..), mkModule, moduleUserString, addBootSuffix_maybe )
import Digraph ( SCC(..) )
import Finder ( findModule, FindResult(..) )
import Util ( global )
doMkDependHS :: DynFlags -> [FilePath] -> IO ()
doMkDependHS dflags srcs
= do { -- Initialisation
- cm_state <- cmInit Batch dflags
- ; files <- beginMkDependHS
+ files <- beginMkDependHS
-- Do the downsweep to find all the modules
- ; mod_summaries <- cmDepAnal cm_state srcs
+ ; excl_mods <- readIORef v_Dep_exclude_mods
+ ; mod_summaries <- cmDownsweep dflags srcs [] excl_mods
-- Sort into dependency order
-- There should be no cycles
throwDyn (ProgramError (showSDoc $ cyclicModuleErr nodes))
processDeps dflags hdl (AcyclicSCC node)
- = do { extra_suffixes <- readIORef v_Dep_suffixes
+ = do { extra_suffixes <- readIORef v_Dep_suffixes
+ ; include_pkg_deps <- readIORef v_Dep_include_pkg_deps
; let src_file = msHsFilePath node
obj_file = msObjFilePath node
obj_files = insertSuffixes obj_file extra_suffixes
do_imp is_boot imp_mod
- = do { mb_hi <- findDependency dflags src_file imp_mod is_boot
+ = do { mb_hi <- findDependency dflags src_file imp_mod
+ is_boot include_pkg_deps
; case mb_hi of {
Nothing -> return () ;
Just hi_file -> do
-> FilePath -- Importing module: used only for error msg
-> Module -- Imported module
-> IsBootInterface -- Source import
+ -> Bool -- Record dependency on package modules
-> IO (Maybe FilePath) -- Interface file file
-findDependency dflags src imp is_boot
- = do { excl_mods <- readIORef v_Dep_exclude_mods
- ; include_prelude <- readIORef v_Dep_include_prelude
-
- -- Deal with the excluded modules
- ; let imp_mod = moduleUserString imp
- ; if imp_mod `elem` excl_mods
- then return Nothing
- else do
- { -- Find the module; this will be fast because
+findDependency dflags src imp is_boot include_pkg_deps
+ = do { -- Find the module; this will be fast because
-- we've done it once during downsweep
r <- findModule dflags imp True {-explicit-}
; case r of
Found loc pkg
-- Not in this package: we don't need a dependency
- | ExtPackage _ <- pkg, not include_prelude
+ | ExtPackage _ <- pkg, not include_pkg_deps
-> return Nothing
-- Home package: just depend on the .hi or hi-boot file
-> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
_ -> throwDyn (ProgramError
- (src ++ ": " ++ "can't locate import `" ++ imp_mod ++ "'"
+ (src ++ ": " ++ "can't locate import `" ++ (moduleUserString imp) ++ "'"
++ if is_boot then " (SOURCE import)" else ""))
- }}
+ }
-----------------------------
writeDependency :: Handle -> [FilePath] -> FilePath -> IO ()
-- Flags
GLOBAL_VAR(v_Dep_makefile, "Makefile", String);
-GLOBAL_VAR(v_Dep_include_prelude, False, Bool);
-GLOBAL_VAR(v_Dep_exclude_mods, ["GHC.Prim"], [String]);
+GLOBAL_VAR(v_Dep_include_pkg_deps, False, Bool);
+GLOBAL_VAR(v_Dep_exclude_mods, [], [Module]);
GLOBAL_VAR(v_Dep_suffixes, [], [String]);
GLOBAL_VAR(v_Dep_warnings, True, Bool);
[ ( "s", SepArg (add v_Dep_suffixes) )
, ( "f", SepArg (writeIORef v_Dep_makefile) )
, ( "w", NoArg (writeIORef v_Dep_warnings False) )
- , ( "-include-prelude", NoArg (writeIORef v_Dep_include_prelude True) )
- , ( "-exclude-module=", Prefix (add v_Dep_exclude_mods) )
- , ( "x", Prefix (add v_Dep_exclude_mods) )
+ , ( "-include-prelude", NoArg (writeIORef v_Dep_include_pkg_deps True) )
+ , ( "-exclude-module=", Prefix (add v_Dep_exclude_mods . mkModule) )
+ , ( "x", Prefix (add v_Dep_exclude_mods . mkModule) )
]
projects / ghc-hetmet.git / commitdiff