diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 9683ef2c886364e931d679b018047f0ffb5fc430..011d4fcdaec1515bb3d488c9bd3f27bcce248842 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -658,7 +658,7 @@ 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@
-(which isn't used by any importer).
+(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
@@ -691,19 +691,30 @@ getImportVersions this_mod exports
 		-- mv_map2 adds the version numbers of things exported individually
 	mv_map2 = foldr add_mv mv_map1 imp_names
 
-	-- Build the result list by adding info for each module, 
-	-- *omitting*	(a) library modules
-	--		(b) source-imported modules
+	-- 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
-	   | omit cts  = so_far	-- Don't record usage info for this module
-	   | otherwise = (mod_name, version, has_orphans, whats_imported) : so_far
+	   | lib_or_source_imported && not has_orphans
+	   = so_far	-- Don't record any usage info for this module
+	   
+	   | 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
 	   where
 	     whats_imported = case lookupFM mv_map2 mod_name of
 				Just wi -> wi
 				Nothing -> Specifically []
 
- 	omit (Just (mod, boot_import, _)) = isLibModule mod || boot_import
-	omit Nothing			  = False
+	     lib_or_source_imported = case cts of
+					Just (mod, boot_import, _) -> isLibModule mod || boot_import
+					Nothing			   -> False
     in
     returnRn (foldFM mk_version_info [] mod_map)
   where
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 944acb4b3ea0d8bc7514309c0bbb4c0d207df99f..e44f8bedb747e7743373296a486b9764ed15fbfa 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -294,7 +294,9 @@ type RdrNamePragma = ()				-- Fudge for now
 data Ifaces = Ifaces {
 		iImpModInfo :: ImportedModuleInfo,
 				-- Modules this one depends on: that is, the union 
-				-- of the modules its direct imports depend on.
+				-- of the modules its *direct* imports depend on.
+				-- NB: The direct imports have .hi files that enumerate *all* the
+				-- dependencies (direct or not) of the imported module.
 
 		iDecls :: DeclsMap,	-- A single, global map of Names to decls