diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index e3a5f2267263a8209d40f1a72bbb0fc111fbc47e..2d105bd8b37a95f78e51d02b13bbc06f215b6aed 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 0f1bfe87638c4cad2cea888c3395f6cb6e7b1c44..224e31ee4da468d65611ffee5faec29dc38df13a 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 730f02db38df56340cef4311ef7817dfb39a0bc3..e1381ba88d9836df3aba5411707918068bdd3826 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 55091bb4278815bfd57cd59626d5327eb2164774..149bf149d5248713e01e4f9ab8f4bd9db2cedb03 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 c96b6fa3a41619e40ee4f2331c6002c211159fd9..99cc7168269eb1e38ed831b575a09a3e2dbe4083 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 fa5b376210af71988698b08ce3dfe36c6e0e3bcb..d98dc2aca9d1b3a6477c4ae4e1b5674d74db472a 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