Commit 6ac3317e authored by simonpj's avatar simonpj
Browse files

[project @ 2005-02-04 15:43:28 by simonpj]

Respect --exclude-module in ghc -M; some tidying up as well
parent 6df9942f
......@@ -13,6 +13,7 @@ module CompManager (
cmInit, -- :: GhciMode -> IO CmState
cmDepAnal, -- :: CmState -> [FilePath] -> IO ModuleGraph
cmDownsweep,
cmTopSort, -- :: Bool -> ModuleGraph -> [SCC ModSummary]
cyclicModuleErr, -- :: [ModSummary] -> String -- Used by DriverMkDepend
......@@ -507,7 +508,7 @@ cmDepAnal cmstate rootnames
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
......@@ -1111,9 +1112,18 @@ cmTopSort drop_hs_boot_nodes summaries
-- 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)
......@@ -1134,7 +1144,8 @@ downsweep dflags roots old_summaries
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
......@@ -1166,7 +1177,8 @@ downsweep dflags roots old_summaries
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)
......@@ -1218,11 +1230,7 @@ summariseFile dflags file
-- 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,
......@@ -1236,54 +1244,53 @@ summarise :: DynFlags
-> 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
......@@ -1293,15 +1300,17 @@ summarise dflags old_summary_map cur_mod is_boot wanted_mod
<> 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 }))
}
-----------------------------------------------------------------------------
......@@ -1315,14 +1324,7 @@ noModError dflags cur_mod wanted_mod err
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
--
......@@ -13,17 +13,16 @@ module DriverMkDepend (
#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 )
......@@ -51,11 +50,11 @@ import Panic ( catchJust, ioErrors )
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
......@@ -170,13 +169,15 @@ processDeps dflags hdl (CyclicSCC nodes)
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
......@@ -203,23 +204,16 @@ findDependency :: DynFlags
-> 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
......@@ -227,9 +221,9 @@ findDependency dflags src imp is_boot
-> 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 ()
......@@ -314,8 +308,8 @@ endMkDependHS dflags
-- 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);
......@@ -328,7 +322,7 @@ dep_opts =
[ ( "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) )
]
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