From 39262efa1c066d97547ac72d8bd16a145ac3f359 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 9 Dec 1999 12:31:02 +0000
Subject: [PATCH] [project @ 1999-12-09 12:30:56 by simonpj] A bunch of small
changes in the way that usage information is generated to stuff into
interface files. I'm not certain anything was really wrong before, but it's
tidier now, and there are slightly fewer dependencies generated. Main
differences are in RnIfaces.getImportVersions
I also made the check for orphan rules a bit cleverer
(Rename.isOrphanDecl) so that we get fewer spurious orphan modules.
Simon
---
ghc/compiler/main/CmdLineOpts.lhs | 2 +-
ghc/compiler/main/MkIface.lhs | 2 +-
ghc/compiler/rename/Rename.lhs | 25 +++--
ghc/compiler/rename/RnIfaces.lhs | 163 ++++++++++++++++++------------
ghc/compiler/rename/RnMonad.lhs | 11 +-
ghc/compiler/rename/RnNames.lhs | 16 +--
6 files changed, 133 insertions(+), 86 deletions(-)
diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index e3a5f2267263..2d105bd8b37a 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -313,7 +313,7 @@ opt_D_dump_ds = opt_D_dump_most || lookUp SLIT("-ddump-ds")
opt_D_dump_flatC = opt_D_dump_all || lookUp SLIT("-ddump-flatC")
opt_D_dump_foreign = opt_D_dump_most || lookUp SLIT("-ddump-foreign-stubs")
opt_D_dump_inlinings = opt_D_dump_all || lookUp SLIT("-ddump-inlinings")
-opt_D_dump_occur_anal = opt_D_dump_most || lookUp SLIT("-ddump-occur-anal")
+opt_D_dump_occur_anal = opt_D_dump_all || lookUp SLIT("-ddump-occur-anal")
opt_D_dump_parsed = opt_D_dump_most || lookUp SLIT("-ddump-parsed")
opt_D_dump_realC = opt_D_dump_all || lookUp SLIT("-ddump-realC")
opt_D_dump_rn = opt_D_dump_most || lookUp SLIT("-ddump-rn")
diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 0f1bfe87638c..224e31ee4da4 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -91,7 +91,7 @@ endIface :: Maybe Handle -> IO ()
\end{code}
\begin{code}
-startIface mod (has_orphans, import_usages, ExportEnv avails fixities)
+startIface mod (has_orphans, import_usages, ExportEnv avails fixities _)
= case opt_ProduceHi of
Nothing -> return Nothing ; -- not producing any .hi file
diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 730f02db38df..e1381ba88d98 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -89,7 +89,7 @@ renameModule us this_mod@(HsModule mod_name vers exports imports local_decls loc
\begin{code}
-rename this_mod@(HsModule mod_name vers exports imports local_decls loc)
+rename this_mod@(HsModule mod_name vers _ imports local_decls loc)
= -- FIND THE GLOBAL NAME ENVIRONMENT
getGlobalNames this_mod `thenRn` \ maybe_stuff ->
@@ -130,8 +130,8 @@ rename this_mod@(HsModule mod_name vers exports imports local_decls loc)
else
-- GENERATE THE VERSION/USAGE INFO
- getImportVersions mod_name exports `thenRn` \ my_usages ->
- getNameSupplyRn `thenRn` \ name_supply ->
+ getImportVersions mod_name export_env `thenRn` \ my_usages ->
+ getNameSupplyRn `thenRn` \ name_supply ->
-- REPORT UNUSED NAMES
reportUnusedNames gbl_env global_avail_env
@@ -211,9 +211,20 @@ isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
isOrphanDecl (RuleD (RuleDecl _ _ _ lhs _ _))
= check lhs
where
- check (HsVar v) = not (isLocallyDefined v)
- check (HsApp f a) = check f && check a
- check other = True
+ -- At the moment we just check for common LHS forms
+ -- Expand as necessary. Getting it wrong just means
+ -- more orphans than necessary
+ check (HsVar v) = not (isLocallyDefined v)
+ check (HsApp f a) = check f && check a
+ check (HsLit _) = False
+ check (OpApp l o _ r) = check l && check o && check r
+ check (NegApp e _) = check e
+ check (HsPar e) = check e
+ check (SectionL e o) = check e && check o
+ check (SectionR o e) = check e && check o
+
+ check other = True -- Safe fall through
+
isOrphanDecl other = False
\end{code}
@@ -479,7 +490,7 @@ getInstDeclGates other = emptyFVs
%*********************************************************
\begin{code}
-reportUnusedNames gbl_env avail_env (ExportEnv export_avails _) mentioned_names
+reportUnusedNames gbl_env avail_env (ExportEnv export_avails _ _) mentioned_names
= let
used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 55091bb42788..149bf149d524 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -40,7 +40,7 @@ import RnMonad
import RnHsSyn ( RenamedHsDecl )
import ParseIface ( parseIface, IfaceStuff(..) )
-import FiniteMap ( FiniteMap, sizeFM, emptyFM, delFromFM,
+import FiniteMap ( FiniteMap, sizeFM, emptyFM, delFromFM, listToFM,
lookupFM, addToFM, addToFM_C, addListToFM,
fmToList, elemFM, foldFM
)
@@ -630,13 +630,13 @@ lookupFixity name
%* *
%*********************************************************
-getImportVersions figures out
-what the ``usage information'' for this moudule is;
-that is, what it must record in its interface file as the things it uses.
-It records:
+getImportVersions figures out what the ``usage information'' for this
+moudule is; that is, what it must record in its interface file as the
+things it uses. It records:
+
\begin{itemize}
-\item anything reachable from its body code
-\item any module exported with a @module Foo@.
+\item anything reachable from its body code
+\item any module exported with a @module Foo@.
\end{itemize}
%
Why the latter? Because if @Foo@ changes then this module's export list
@@ -650,92 +650,121 @@ What about this?
import B( f ) | f = h 3
g = ... | h = ...
\end{verbatim}
-Should we record @B.f@ in @A@'s usages? In fact we don't. Certainly, if
-anything about @B.f@ changes than anyone who imports @A@ should be recompiled;
-they'll get an early exit if they don't use @B.f@. However, even if @B.f@
-doesn't change at all, @B.h@ may do so, and this change may not be reflected
-in @f@'s version number. So there are two things going on when compiling module @A@:
+
+Should we record @B.f@ in @A@'s usages? In fact we don't. Certainly,
+if anything about @B.f@ changes than anyone who imports @A@ should be
+recompiled; they'll get an early exit if they don't use @B.f@.
+However, even if @B.f@ doesn't change at all, @B.h@ may do so, and
+this change may not be reflected in @f@'s version number. So there
+are two things going on when compiling module @A@:
+
\begin{enumerate}
-\item Are @A.o@ and @A.hi@ correct? Then we can bale out early.
-\item Should modules that import @A@ be recompiled?
+\item Are @A.o@ and @A.hi@ correct? Then we can bale out early.
+\item Should modules that import @A@ be recompiled?
\end{enumerate}
+
For (1) it is slightly harmful to record @B.f@ in @A@'s usages,
-because a change in @B.f@'s version will provoke full recompilation of @A@,
-producing an identical @A.o@,
-and @A.hi@ differing only in its usage-version of @B.f@
-(and this usage-version info isn't used by any importer).
-
-For (2), because of the tricky @B.h@ question above,
-we ensure that @A.hi@ is touched
-(even if identical to its previous version)
-if A's recompilation was triggered by an imported @.hi@ file date change.
+because a change in @B.f@'s version will provoke full recompilation of
+@A@, producing an identical @A.o@, and @A.hi@ differing only in its
+usage-version of @B.f@ (and this usage-version info isn't used by any
+importer).
+
+For (2), because of the tricky @B.h@ question above, we ensure that
+@A.hi@ is touched (even if identical to its previous version) if A's
+recompilation was triggered by an imported @.hi@ file date change.
Given that, there's no need to record @B.f@ in @A@'s usages.
-On the other hand, if @A@ exports @module B@,
-then we {\em do} count @module B@ among @A@'s usages,
-because we must recompile @A@ to ensure that @A.hi@ changes appropriately.
+On the other hand, if @A@ exports @module B@, then we {\em do} count
+@module B@ among @A@'s usages, because we must recompile @A@ to ensure
+that @A.hi@ changes appropriately.
+
+HOWEVER, we *do* record the usage
+ import B <n> :: ;
+in A.hi, to record the fact that A does import B. This is used to decide
+to look to look for B.hi rather than B.hi-boot when compiling a module that
+imports A. This line says that A imports B, but uses nothing in it.
+So we'll get an early bale-out when compiling A if B's version changes.
\begin{code}
getImportVersions :: ModuleName -- Name of this module
- -> Maybe [IE any] -- Export list for this module
+ -> ExportEnv -- Info about exports
-> RnMG (VersionInfo Name) -- Version info for these names
-getImportVersions this_mod exports
+getImportVersions this_mod (ExportEnv export_avails _ export_all_mods)
= getIfacesRn `thenRn` \ ifaces ->
let
mod_map = iImpModInfo ifaces
imp_names = iVSlurp ifaces
+ export_mods :: FiniteMap ModuleName () -- Set of home modules for
+ -- things in the export list
+ export_mods = listToFM [(moduleName (nameModule (availName a)), ()) | a <- export_avails]
+
-- mv_map groups together all the things imported from a particular module.
- mv_map1, mv_map2 :: FiniteMap ModuleName (WhatsImported Name)
-
- -- mv_map1 records all the modules that have a "module M"
- -- in this module's export list with an "Everything"
- mv_map1 = foldr add_mod emptyFM export_mods
-
- -- mv_map2 adds the version numbers of things exported individually
- mv_map2 = foldr add_mv mv_map1 imp_names
+ mv_map :: FiniteMap ModuleName [(Name,Version)]
+ mv_map = foldr add_mv emptyFM imp_names
-- Build the result list by adding info for each module.
- -- For (a) library modules
- -- (b) source-imported modules
- -- we do something special. We don't want to record detailed usage information.
- -- Indeed we don't want to record them at all unless they contain orphans,
- -- which we must never lose track of.
- mk_version_info mod_name (version, has_orphans, cts) so_far
- | lib_or_source_imported && not has_orphans
- = so_far -- Don't record any usage info for this module
+ -- For (a) a library module, we don't record it at all unless it contains orphans
+ -- (We must never lose track of orphans.)
+ --
+ -- (b) a source-imported module, don't record the dependency at all
+ --
+ -- (b) may seem a bit strange. The idea is that the usages in a .hi file records
+ -- *all* the module's dependencies other than the loop-breakers. We use
+ -- this info in findAndReadInterface to decide whether to look for a .hi file or
+ -- a .hi-boot file.
+ --
+ -- This means we won't track version changes, or orphans, from .hi-boot files.
+ -- The former is potentially rather bad news. It could be fixed by recording
+ -- whether something is a boot file along with the usage info for it, but
+ -- I can't be bothered just now.
+
+ mk_version_info mod_name (version, has_orphans, Nothing) so_far
+ = ASSERT( not has_orphans ) -- If has_orphans is true we will have opened it
+ so_far -- We didn't even read this module's interface
+ -- so don't record dependency on it.
+
+ mk_version_info mod_name (version, has_orphans, Just (mod, boot_import, _)) so_far
+ | boot_import -- Don't record any usage info for this module
+ || (is_lib_module && not has_orphans)
+ = so_far
- | lib_or_source_imported -- Has orphans; record the module but not
- -- detailed version information for the imports
- = (mod_name, version, has_orphans, Specifically []) : so_far
-
- | otherwise
- = (mod_name, version, has_orphans, whats_imported) : so_far
+ | is_lib_module -- Record the module but not
+ || mod_name `elem` export_all_mods -- detailed version information for the imports
+ = go_for_it Everything
+
+ | otherwise
+ = case lookupFM mv_map mod_name of
+ Just whats_imported
+ -> go_for_it (Specifically whats_imported)
+
+ Nothing -- This happens if you have
+ -- import Foo
+ -- but don't actually *use* anything from Foo
+ | has_orphans -- Check for (a) orphans (we must never forget them)
+ || mod_name `elemFM` export_mods -- or (b) something from the module is exported
+ -> -- ...in which case record an empty dependency list
+ go_for_it (Specifically [])
+
+ | otherwise -> so_far -- No point in recording any dependency
where
- whats_imported = case lookupFM mv_map2 mod_name of
- Just wi -> wi
- Nothing -> Specifically []
+ is_lib_module = isLibModule mod
+ go_for_it exports = (mod_name, version, has_orphans, exports) : so_far
- lib_or_source_imported = case cts of
- Just (mod, boot_import, _) -> isLibModule mod || boot_import
- Nothing -> False
in
+ -- A module shouldn't load its own interface
+ -- This seems like a convenient place to check
+ WARN( maybeToBool (lookupFM mod_map this_mod),
+ ptext SLIT("Wierd:") <+> ppr this_mod <+> ptext SLIT("loads its own interface") )
+
returnRn (foldFM mk_version_info [] mod_map)
where
- export_mods = case exports of
- Nothing -> []
- Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
-
add_mv v@(name, version) mv_map
- = addToFM_C add_item mv_map mod (Specifically [v])
- where
+ = addToFM_C add_item mv_map mod [v]
+ where
mod = moduleName (nameModule name)
-
- add_item Everything _ = Everything
- add_item (Specifically xs) _ = Specifically (v:xs)
-
- add_mod mod mv_map = addToFM mv_map mod Everything
+ add_item vs _ = (v:vs)
\end{code}
\begin{code}
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index c96b6fa3a416..99cc7168269e 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -218,7 +218,10 @@ type RnNameSupply
--------------------------------
-data ExportEnv = ExportEnv Avails Fixities
+data ExportEnv = ExportEnv Avails Fixities [ModuleName]
+ -- The list of modules is the modules exported
+ -- with 'module M' in the export list
+
type Avails = [AvailInfo]
type Fixities = [(Name, Fixity)]
@@ -287,7 +290,7 @@ type InterfaceDetails = (WhetherHasOrphans,
-- needed by Main to fish out the fixities assoc list.
getIfaceFixities :: InterfaceDetails -> Fixities
-getIfaceFixities (_, _, ExportEnv _ fs) = fs
+getIfaceFixities (_, _, ExportEnv _ fs _) = fs
type RdrNamePragma = () -- Fudge for now
@@ -453,7 +456,9 @@ renameSourceCode mod_name name_supply m
let
rn_down = RnDown { rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
rn_errs = errs_var, rn_hi_maps = himaps,
- rn_mod = mod_name }
+ rn_mod = mod_name,
+ rn_ifaces = panic "rnameSourceCode: rn_ifaces" -- Not required
+ }
s_down = SDown { rn_mode = InterfaceMode,
-- So that we can refer to PrelBase.True etc
rn_genv = emptyRdrEnv, rn_lenv = emptyRdrEnv,
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index fa5b376210af..d98dc2aca9d1 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -142,8 +142,7 @@ getGlobalNames (HsModule this_mod _ exports imports decls mod_loc)
isQual rdr_name]) `thenRn_`
-- PROCESS EXPORT LISTS
- exportsFromAvail this_mod exports all_avails gbl_env
- `thenRn` \ exported_avails ->
+ exportsFromAvail this_mod exports all_avails gbl_env `thenRn` \ exported_avails ->
-- DONE
returnRn (gbl_env, exported_avails, Just all_avails)
@@ -164,14 +163,17 @@ getGlobalNames (HsModule this_mod _ exports imports decls mod_loc)
| FixitySig name fixity _ <- nameEnvElts local_fixity_env,
isLocallyDefined name
]
- in
- traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts local_fixity_env))) `thenRn_`
- --- TIDY UP
- let
- export_env = ExportEnv exported_avails exported_fixities
+ -- CONSTRUCT RESULTS
+ export_mods = case exports of
+ Nothing -> []
+ Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
+
+ export_env = ExportEnv exported_avails exported_fixities export_mods
(_, global_avail_env) = all_avails
in
+ traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts local_fixity_env))) `thenRn_`
+
returnRn (Just (export_env, gbl_env, local_fixity_env, global_avail_env))
}
where
--
GitLab