[project @ 2001-03-01 14:26:00 by simonmar]

GHCi fixes:

  - expressions are now compiled in a pseudo-module "$Interactive",
    which avoids some problems with storage of demand-loaded declarations.

  - compilation manager now detects when it needs to read the interace
    for a module, even if it is already compiled.  GHCi never demand-loads
    interfaces now.

  - (from Simon PJ) fix a problem with the recompilation checker, which
    meant that modules were sometimes not recompiled when they should
    have been.

  - ByteCodeGen/Link: move linker related stuff into ByteCodeLink.

ghc/compiler/compMan/CmLink.lhs

@@ -20,6 +20,7 @@ module CmLink ( Linkable(..),  Unlinked(..),
 
 import Interpreter
 import DriverPipeline
+import ByteCodeLink	( linkIModules, linkIExpr )
 import CmTypes
 import CmStaticInfo	( GhciMode(..) )
 import Outputable	( SDoc )

ghc/compiler/compMan/CompManager.lhs

@@ -50,8 +50,7 @@ import VarEnv		( emptyTidyEnv )
 import HscTypes
 import HscMain		( initPersistentCompilerState )
 import Finder
-import UniqFM		( lookupUFM, addToUFM, delListFromUFM,
-			  UniqFM, listToUFM )
+import UniqFM
 import Unique		( Uniquable )
 import Digraph		( SCC(..), stronglyConnComp, flattenSCC )
 import DriverFlags	( getDynFlags )
@@ -233,7 +232,7 @@ cmTypeOfExpr cmstate dflags expr
        case names of
 	 [name] -> do maybe_tystr <- cmTypeOfName new_cmstate name
 		      return (new_cmstate, maybe_tystr)
-	 _other -> pprPanic "cmTypeOfExpr" (ppr names)
+	 _other -> return (new_cmstate, Nothing)
 #endif
 
 -----------------------------------------------------------------------------
@@ -347,9 +346,6 @@ cmLoadModule cmstate1 rootname
         let ghci_mode = gmode cmstate1 -- this never changes
 
         -- Do the downsweep to reestablish the module graph
-        -- then generate version 2's by retaining in HIT,HST,UI a
-        -- stable set S of modules, as defined below.
-
 	dflags <- getDynFlags
         let verb = verbosity dflags
 
@@ -387,8 +383,8 @@ cmLoadModule cmstate1 rootname
         -- 1.  All home imports of ms are either in ms or S
         -- 2.  A valid linkable exists for each module in ms
 
-        stable_mods
-           <- preUpsweep valid_linkables mg2unsorted_names [] mg2_with_srcimps
+        stable_mods <- preUpsweep valid_linkables hit1 
+		 		  mg2unsorted_names [] mg2_with_srcimps
 
         let stable_summaries
                = concatMap (findInSummaries mg2unsorted) stable_mods
@@ -585,10 +581,6 @@ getValidLinkable :: [Linkable] -> Bool -> [Linkable] -> ModSummary
 getValidLinkable old_linkables objects_allowed new_linkables summary 
   = do let mod_name = name_of_summary summary
 
-       -- we only look for objects on disk the first time around;
-       -- if the user compiles a module on the side during a GHCi session,
-       -- it won't be picked up until the next ":load".  This is what the
-       -- "null old_linkables" test below is.
        maybe_disk_linkable
           <- if (not objects_allowed)
 		then return Nothing
@@ -612,6 +604,10 @@ getValidLinkable old_linkables objects_allowed new_linkables summary
 		   Nothing    -> False
 		   Just l_disk -> linkableTime l == linkableTime l_disk
 
+    	   -- we only look for objects on disk the first time around;
+    	   -- if the user compiles a module on the side during a GHCi session,
+    	   -- it won't be picked up until the next ":load".  This is what the
+    	   -- "null old_linkables" test below is.
            linkable | null old_linkables = maybeToList maybe_disk_linkable
 		    | otherwise          = maybeToList maybe_old_linkable
 
@@ -647,14 +643,20 @@ maybe_getFileLinkable mod_name obj_fn
 -- Do a pre-upsweep without use of "compile", to establish a 
 -- (downward-closed) set of stable modules for which we won't call compile.
 
+-- a stable module:
+--	* has a valid linkable (see getValidLinkables above)
+--	* depends only on stable modules
+--	* has an interface in the HIT (interactive mode only)
+
 preUpsweep :: [Linkable]	-- new valid linkables
+	   -> HomeIfaceTable
            -> [ModuleName]      -- names of all mods encountered in downsweep
            -> [ModuleName]      -- accumulating stable modules
            -> [SCC ModSummary]  -- scc-ified mod graph, including src imps
            -> IO [ModuleName]	-- stable modules
 
-preUpsweep valid_lis all_home_mods stable []  = return stable
-preUpsweep valid_lis all_home_mods stable (scc0:sccs)
+preUpsweep valid_lis hit all_home_mods stable []  = return stable
+preUpsweep valid_lis hit all_home_mods stable (scc0:sccs)
    = do let scc = flattenSCC scc0
             scc_allhomeimps :: [ModuleName]
             scc_allhomeimps 
@@ -672,14 +674,15 @@ preUpsweep valid_lis all_home_mods stable (scc0:sccs)
    	      = isJust (findModuleLinkable_maybe valid_lis modname)
 	       where modname = name_of_summary new_summary
 
+	    has_interface summary = ms_mod summary `elemUFM` hit
+
 	    scc_is_stable = all_imports_in_scc_or_stable
 			  && all has_valid_linkable scc
+			  && all has_interface scc
 
         if scc_is_stable
-         then preUpsweep valid_lis all_home_mods (scc_names++stable) sccs
-         else preUpsweep valid_lis all_home_mods stable sccs
-
-   where 
+         then preUpsweep valid_lis hit all_home_mods (scc_names++stable) sccs
+         else preUpsweep valid_lis hit all_home_mods stable sccs
 
 
 -- Helper for preUpsweep.  Assuming that new_summary's imports are all

ghc/compiler/ghci/ByteCodeGen.lhs

@@ -6,8 +6,7 @@
 \begin{code}
 module ByteCodeGen ( UnlinkedBCO, UnlinkedBCOExpr, ItblEnv, ClosureEnv, HValue,
 		     filterNameMap,
-                     byteCodeGen, coreExprToBCOs, 
-		     linkIModules, linkIExpr
+                     byteCodeGen, coreExprToBCOs
 		   ) where
 
 #include "HsVersions.h"
@@ -44,7 +43,7 @@ import PprType		( pprType )
 import ByteCodeInstr	( BCInstr(..), ProtoBCO(..), nameOfProtoBCO, bciStackUse )
 import ByteCodeItbls	( ItblEnv, mkITbls )
 import ByteCodeLink	( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO,
-			  ClosureEnv, HValue, linkSomeBCOs, filterNameMap,
+			  ClosureEnv, HValue, filterNameMap,
 			  iNTERP_STACK_CHECK_THRESH )
 
 import List		( intersperse, sortBy )
@@ -122,27 +121,6 @@ coreExprToBCOs dflags expr
       root_bco <- assembleBCO root_proto_bco
 
       return (root_bco, auxiliary_bcos)
-
-
--- Linking stuff
-linkIModules :: ItblEnv    -- incoming global itbl env; returned updated
-	     -> ClosureEnv -- incoming global closure env; returned updated
-	     -> [([UnlinkedBCO], ItblEnv)]
-	     -> IO ([HValue], ItblEnv, ClosureEnv)
-linkIModules gie gce mods 
-   = do let (bcoss, ies) = unzip mods
-            bcos = concat bcoss
-            final_gie = foldr plusFM gie ies
-        (final_gce, linked_bcos) <- linkSomeBCOs True final_gie gce bcos
-        return (linked_bcos, final_gie, final_gce)
-
-
-linkIExpr :: ItblEnv -> ClosureEnv -> UnlinkedBCOExpr
-          -> IO HValue 	  -- IO BCO# really
-linkIExpr ie ce (root_ul_bco, aux_ul_bcos)
-   = do (aux_ce, _) <- linkSomeBCOs False ie ce aux_ul_bcos
-        (_, [root_bco]) <- linkSomeBCOs False ie aux_ce [root_ul_bco]
-        return root_bco
 \end{code}
 
 %************************************************************************

ghc/compiler/ghci/ByteCodeLink.lhs

@@ -5,7 +5,8 @@
 
 \begin{code}
 module ByteCodeLink ( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO,
-		      ClosureEnv, HValue, linkSomeBCOs, filterNameMap,
+		      ClosureEnv, HValue, filterNameMap,
+		      linkIModules, linkIExpr,
 		      iNTERP_STACK_CHECK_THRESH
 		   ) where
 
@@ -38,6 +39,7 @@ import MArray		( castSTUArray,
 			  newAddrArray, writeAddrArray )
 import Foreign		( Word16, Ptr(..) )
 import Addr 		( Word, Addr, nullAddr )
+import FiniteMap
 
 import PrelBase		( Int(..) )
 import PrelGHC		( BCO#, newBCO#, unsafeCoerce#, 
@@ -56,6 +58,25 @@ import PrelIOBase	( IO(..) )
 %************************************************************************
 
 \begin{code}
+-- Linking stuff
+linkIModules :: ItblEnv    -- incoming global itbl env; returned updated
+	     -> ClosureEnv -- incoming global closure env; returned updated
+	     -> [([UnlinkedBCO], ItblEnv)]
+	     -> IO ([HValue], ItblEnv, ClosureEnv)
+linkIModules gie gce mods 
+   = do let (bcoss, ies) = unzip mods
+            bcos = concat bcoss
+            final_gie = foldr plusFM gie ies
+        (final_gce, linked_bcos) <- linkSomeBCOs True final_gie gce bcos
+        return (linked_bcos, final_gie, final_gce)
+
+
+linkIExpr :: ItblEnv -> ClosureEnv -> UnlinkedBCOExpr
+          -> IO HValue 	  -- IO BCO# really
+linkIExpr ie ce (root_ul_bco, aux_ul_bcos)
+   = do (aux_ce, _) <- linkSomeBCOs False ie ce aux_ul_bcos
+        (_, [root_bco]) <- linkSomeBCOs False ie aux_ce [root_ul_bco]
+        return root_bco
 
 -- Link a bunch of BCOs and return them + updated closure env.
 linkSomeBCOs :: Bool 	-- False <=> add _all_ BCOs to returned closure env
@@ -74,7 +95,10 @@ linkSomeBCOs toplevs_only ie ce_in ul_bcos
             ce_top_additions = filter (isGlobalName.fst) ce_all_additions
             ce_additions     = if toplevs_only then ce_top_additions 
                                                else ce_all_additions
-            ce_out = addListToFM ce_in ce_additions
+            ce_out = -- make sure we're not inserting duplicate names into the 
+		     -- closure environment, which leads to trouble.
+		     ASSERT (all (not . (`elemFM` ce_in)) (map fst ce_additions))
+		     addListToFM ce_in ce_additions
         return (ce_out, hvals)
      where
         -- A lazier zip, in which no demand is propagated to the second

ghc/compiler/main/HscMain.lhs

@@ -31,7 +31,7 @@ import SrcLoc		( mkSrcLoc )
 import Rename		( checkOldIface, renameModule, closeIfaceDecls )
 import Rules		( emptyRuleBase )
 import PrelInfo		( wiredInThingEnv, wiredInThings )
-import PrelNames	( vanillaSyntaxMap, knownKeyNames )
+import PrelNames	( vanillaSyntaxMap, knownKeyNames, iNTERACTIVE )
 import MkIface		( completeIface, mkModDetailsFromIface, mkModDetails,
 			  writeIface, pprIface )
 import TcModule
@@ -452,9 +452,9 @@ A naked expression returns a singleton Name [it].
 hscStmt dflags hst hit pcs0 icontext stmt
    = let 
 	InteractiveContext { 
-	     ic_rn_env = rn_env, 
+	     ic_rn_env   = rn_env, 
 	     ic_type_env = type_env,
-	     ic_module   = this_mod } = icontext
+	     ic_module   = scope_mod } = icontext
      in
      do { maybe_stmt <- hscParseStmt dflags stmt
 	; case maybe_stmt of
@@ -463,20 +463,23 @@ hscStmt dflags hst hit pcs0 icontext stmt
 
 		-- Rename it
 	  (pcs1, print_unqual, maybe_renamed_stmt)
-		 <- renameStmt dflags hit hst pcs0 this_mod rn_env parsed_stmt
+		 <- renameStmt dflags hit hst pcs0 scope_mod 
+				iNTERACTIVE rn_env parsed_stmt
+
 	; case maybe_renamed_stmt of
 		Nothing -> return (pcs0, Nothing)
 		Just (bound_names, rn_stmt) -> do {
 
 		-- Typecheck it
-	  maybe_tc_return <- typecheckStmt dflags pcs1 hst type_env
-					   print_unqual this_mod bound_names rn_stmt
+	  maybe_tc_return 
+		<- typecheckStmt dflags pcs1 hst type_env
+				   print_unqual iNTERACTIVE bound_names rn_stmt
 	; case maybe_tc_return of {
 		Nothing -> return (pcs0, Nothing) ;
 		Just (pcs2, tc_expr, bound_ids) -> do {
 
 		-- Desugar it
-	  ds_expr <- deSugarExpr dflags pcs2 hst this_mod print_unqual tc_expr
+	  ds_expr <- deSugarExpr dflags pcs2 hst iNTERACTIVE print_unqual tc_expr
 	
 		-- Simplify it
 	; simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr

ghc/compiler/main/HscTypes.lhs

@@ -18,7 +18,7 @@ module HscTypes (
 
 	IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
 
-	VersionInfo(..), initialVersionInfo,
+	VersionInfo(..), initialVersionInfo, lookupVersion,
 
 	TyThing(..), isTyClThing, implicitTyThingIds,
 
@@ -74,7 +74,7 @@ import CoreSyn		( IdCoreRule )
 
 import FiniteMap	( FiniteMap )
 import Bag		( Bag )
-import Maybes		( seqMaybe )
+import Maybes		( seqMaybe, orElse )
 import Outputable
 import SrcLoc		( SrcLoc, isGoodSrcLoc )
 import Util		( thenCmp, sortLt )
@@ -339,13 +339,19 @@ data VersionInfo
 		-- The version of an Id changes if its fixity changes
 		-- Ditto data constructors, class operations, except that the version of
 		-- the parent class/tycon changes
+		--
+		-- If a name isn't in the map, it means 'initialVersion'
     }
 
 initialVersionInfo :: VersionInfo
 initialVersionInfo = VersionInfo { vers_module  = initialVersion,
 				   vers_exports = initialVersion,
 				   vers_rules   = initialVersion,
-				   vers_decls   = emptyNameEnv }
+				   vers_decls   = emptyNameEnv
+			}
+
+lookupVersion :: NameEnv Version -> Name -> Version
+lookupVersion env name = lookupNameEnv env name `orElse` initialVersion
 
 data Deprecations = NoDeprecs
 	 	  | DeprecAll DeprecTxt				-- Whole module deprecated

ghc/compiler/main/MkIface.lhs

@@ -6,7 +6,7 @@
 \begin{code}
 module MkIface ( 
 	mkModDetails, mkModDetailsFromIface, completeIface, 
-	writeIface, pprIface
+	writeIface, pprIface, pprUsage
   ) where
 
 #include "HsVersions.h"
@@ -25,7 +25,7 @@ import HscTypes		( VersionInfo(..), ModIface(..), ModDetails(..),
 			  TyThing(..), DFunId, TypeEnv, Avails,
 			  WhatsImported(..), GenAvailInfo(..), 
 			  ImportVersion, AvailInfo, Deprecations(..),
-			  extendTypeEnvList
+			  extendTypeEnvList, lookupVersion,
 			)
 
 import CmdLineOpts
@@ -54,6 +54,7 @@ import Type		( splitSigmaTy, tidyTopType, deNoteType )
 import SrcLoc		( noSrcLoc )
 import Outputable
 import Module		( ModuleName )
+import Maybes		( orElse )
 
 import IO		( IOMode(..), openFile, hClose )
 \end{code}
@@ -381,7 +382,8 @@ addVersionInfo (Just old_iface@(ModIface { mi_version  = old_version,
 	
   where
     final_iface = new_iface { mi_version = new_version }
-    new_version = VersionInfo { vers_module  = bumpVersion no_output_change (vers_module  old_version),
+    old_mod_vers = vers_module  old_version
+    new_version = VersionInfo { vers_module  = bumpVersion no_output_change old_mod_vers,
 				vers_exports = bumpVersion no_export_change (vers_exports old_version),
 				vers_rules   = bumpVersion no_rule_change   (vers_rules   old_version),
 				vers_decls   = tc_vers }
@@ -396,8 +398,7 @@ addVersionInfo (Just old_iface@(ModIface { mi_version  = old_version,
 	-- Fill in the version number on the new declarations by looking at the old declarations.
 	-- Set the flag if anything changes. 
 	-- Assumes that the decls are sorted by hsDeclName.
-    old_vers_decls = vers_decls old_version
-    (no_tc_change,  pp_tc_diffs,  tc_vers) = diffDecls old_vers_decls old_fixities new_fixities
+    (no_tc_change,  pp_tc_diffs,  tc_vers) = diffDecls old_version old_fixities new_fixities
 						       (dcl_tycl old_decls) (dcl_tycl new_decls)
     pp_diffs = vcat [pp_tc_diffs,
 		     pp_change no_export_change "Export list",
@@ -407,14 +408,15 @@ addVersionInfo (Just old_iface@(ModIface { mi_version  = old_version,
     pp_change True  what = empty
     pp_change False what = text what <+> ptext SLIT("changed")
 
-diffDecls :: NameEnv Version				-- Old version map
+diffDecls :: VersionInfo				-- Old version
 	  -> NameEnv Fixity -> NameEnv Fixity		-- Old and new fixities
 	  -> [RenamedTyClDecl] -> [RenamedTyClDecl]	-- Old and new decls
 	  -> (Bool,		-- True <=> no change
 	      SDoc,		-- Record of differences
-	      NameEnv Version)	-- New version
+	      NameEnv Version)	-- New version map
 
-diffDecls old_vers old_fixities new_fixities old new
+diffDecls (VersionInfo { vers_module = old_mod_vers, vers_decls = old_decls_vers })
+	  old_fixities new_fixities old new
   = diff True empty emptyNameEnv old new
   where
 	-- When seeing if two decls are the same, 
@@ -423,19 +425,26 @@ diffDecls old_vers old_fixities new_fixities old new
     same_fixity n = lookupNameEnv old_fixities n == lookupNameEnv new_fixities n
 
     diff ok_so_far pp new_vers []  []      = (ok_so_far, pp, new_vers)
-    diff ok_so_far pp new_vers (od:ods) [] = diff False (pp $$ only_old od) new_vers ods []
-    diff ok_so_far pp new_vers [] (nd:nds) = diff False (pp $$ only_new nd) new_vers [] nds
+    diff ok_so_far pp new_vers (od:ods) [] = diff False (pp $$ only_old od) new_vers	      ods []
+    diff ok_so_far pp new_vers [] (nd:nds) = diff False (pp $$ only_new nd) new_vers_with_new []  nds
+	where
+	  new_vers_with_new = extendNameEnv new_vers (tyClDeclName nd) (bumpVersion False old_mod_vers)
+		-- When adding a new item, start from the old module version
+		-- This way, if you have version 4 of f, then delete f, then add f again,
+		-- you'll get version 6 of f, which will (correctly) force recompilation of
+		-- clients
+
     diff ok_so_far pp new_vers (od:ods) (nd:nds)
 	= case od_name `compare` nd_name of
 		LT -> diff False (pp $$ only_old od) new_vers ods      (nd:nds)
 		GT -> diff False (pp $$ only_new nd) new_vers (od:ods) nds
-		EQ | od `eq_tc` nd -> diff ok_so_far pp 		   new_vers  ods nds
-		   | otherwise     -> diff False     (pp $$ changed od nd) new_vers' ods nds
+		EQ | od `eq_tc` nd -> diff ok_so_far pp 		   new_vers	      ods nds
+		   | otherwise     -> diff False     (pp $$ changed od nd) new_vers_with_diff ods nds
 	where
  	  od_name = tyClDeclName od
  	  nd_name = tyClDeclName nd
-	  new_vers' = extendNameEnv new_vers nd_name 
-				    (bumpVersion False (lookupNameEnv_NF old_vers od_name))
+	  new_vers_with_diff = extendNameEnv new_vers nd_name (bumpVersion False old_version)
+	  old_version = lookupVersion old_decls_vers od_name
 
     only_old d    = ptext SLIT("Only in old iface:") <+> ppr d
     only_new d    = ptext SLIT("Only in new iface:") <+> ppr d

ghc/compiler/rename/Rename.lhs

@@ -30,6 +30,7 @@ import RnIfaces		( slurpImpDecls, mkImportInfo, recordLocalSlurps,
 import RnHiFiles	( readIface, removeContext, loadInterface,
 			  loadExports, loadFixDecls, loadDeprecs,
 			)
+import MkIface		( pprUsage )
 import RnEnv		( availsToNameSet, mkIfaceGlobalRdrEnv,
 			  emptyAvailEnv, unitAvailEnv, availEnvElts, 
 			  plusAvailEnv, groupAvails, warnUnusedImports, 
@@ -97,7 +98,8 @@ renameModule dflags hit hst pcs this_module rdr_module
 renameStmt :: DynFlags
 	   -> HomeIfaceTable -> HomeSymbolTable
 	   -> PersistentCompilerState 
-	   -> Module			-- current context (module)
+	   -> Module			-- current context (scope to compile in)
+	   -> Module			-- current module
 	   -> LocalRdrEnv		-- current context (temp bindings)
 	   -> RdrNameStmt		-- parsed stmt
 	   -> IO ( PersistentCompilerState, 
@@ -105,13 +107,13 @@ renameStmt :: DynFlags
 		   Maybe ([Name], (SyntaxMap, RenamedStmt, [RenamedHsDecl]))
                  )
 
-renameStmt dflags hit hst pcs this_module local_env stmt
+renameStmt dflags hit hst pcs scope_module this_module local_env stmt
   = renameSource dflags hit hst pcs this_module $
 
 	-- Load the interface for the context module, so 
 	-- that we can get its top-level lexical environment
 	-- Bale out if we fail to do this
-    loadInterface doc (moduleName this_module) ImportByUser `thenRn` \ iface ->
+    loadInterface doc (moduleName scope_module) ImportByUser `thenRn` \ iface ->
     let rdr_env       = mi_globals iface
 	print_unqual  = unQualInScope rdr_env
     in 
@@ -245,6 +247,7 @@ rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec
 
 	-- GENERATE THE VERSION/USAGE INFO
     mkImportInfo mod_name imports 			`thenRn` \ my_usages ->
+    traceHiDiffsRn (vcat (map pprUsage my_usages)) `thenRn_`
 
 	-- BUILD THE MODULE INTERFACE
     let

ghc/compiler/rename/RnIfaces.lhs

@@ -38,8 +38,7 @@ import Id		( idType )
 import Type		( namesOfType )
 import TyCon		( isSynTyCon, getSynTyConDefn )
 import Name		( Name {-instance NamedThing-}, nameOccName,
-			  nameModule, isLocalName, isHomePackageName,
-			  NamedThing(..)
+			  nameModule, isLocalName, NamedThing(..)
 			 )
 import Name 		( elemNameEnv, delFromNameEnv )
 import Module		( Module, ModuleEnv, 
@@ -169,8 +168,7 @@ mkImportInfo this_mod imports
 	    
 		-- The sort is to put them into canonical order
 	    mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns, 
-	    		                  let v = lookupNameEnv version_env n `orElse` 
-	    			                  pprPanic "mk_whats_imported" (ppr n)
+	    		                  let v = lookupVersion version_env n
 		                 ]
 			 where
 			   lt_occ n1 n2 = nameOccName n1 < nameOccName n2
@@ -302,22 +300,26 @@ rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl)	`thenRn` \ dec
 
 
 \begin{code}
-recordSlurp ifaces@(Ifaces { iDecls = (decls_map, n_slurped),
-			     iSlurp = slurped_names, 
-			     iVSlurp = (imp_mods, imp_names) })
+recordDeclSlurp ifaces@(Ifaces { iDecls  = (decls_map, n_slurped),
+				 iSlurp  = slurped_names, 
+				 iVSlurp = vslurp })
 	    avail
   = ASSERT2( not (isLocalName (availName avail)), ppr avail )
-    ifaces { iDecls = (decls_map', n_slurped+1),
+    ifaces { iDecls = (new_decls_map, n_slurped+1),
 	     iSlurp  = new_slurped_names, 
-	     iVSlurp = new_vslurp }
+	     iVSlurp = updateVSlurp vslurp (availName avail) }
   where
-    decls_map' = foldl delFromNameEnv decls_map (availNames avail)
-    main_name  = availName avail
+    new_decls_map     = foldl delFromNameEnv decls_map (availNames avail)
     new_slurped_names = addAvailToNameSet slurped_names avail
-    new_vslurp | isHomePackageName main_name = (imp_mods, addOneToNameSet imp_names main_name)
-    	       | otherwise       	     = (extendModuleSet imp_mods mod, imp_names)
-    mod	       = nameModule main_name
 
+recordVSlurp ifaces name = ifaces { iVSlurp = updateVSlurp (iVSlurp ifaces) name }
+
+updateVSlurp (imp_mods, imp_names) main_name
+  | isHomeModule mod = (imp_mods,		      addOneToNameSet imp_names main_name)
+  | otherwise        = (extendModuleSet imp_mods mod, imp_names)
+  where
+    mod = nameModule main_name
+  
 recordLocalSlurps new_names
   = getIfacesRn 	`thenRn` \ ifaces ->
     setIfacesRn (ifaces { iSlurp  = iSlurp ifaces `unionNameSets` new_names })
@@ -569,17 +571,25 @@ importDecl name
 	returnRn AlreadySlurped	
     else
 
+
 	-- STEP 2: Check if it's already in the type environment
     getTypeEnvRn 			`thenRn` \ lookup ->
     case lookup name of {
-	Just ty_thing | name `elemNameEnv` wiredInThingEnv
-		      -> 	-- When we find a wired-in name we must load its home
-				-- module so that we find any instance decls lurking therein
-			 loadHomeInterface wi_doc name	`thenRn_`
-			 returnRn (InTypeEnv ty_thing)
-
-		      | otherwise
-		      -> returnRn (InTypeEnv ty_thing) ;
+	Just ty_thing 
+	   | name `elemNameEnv` wiredInThingEnv
+	   -> 	-- When we find a wired-in name we must load its home
+		-- module so that we find any instance decls lurking therein
+		loadHomeInterface wi_doc name	`thenRn_`
+		returnRn (InTypeEnv ty_thing)
+
+	   | otherwise
+ 	   ->	-- Record that we use this thing.  We must do this
+		--  regardless of whether we need to demand-slurp it in
+		--  or we already have it in the type environment.  Why?
+		--  because the slurp information is used to generate usage
+		--  information in the interface.
+		setIfacesRn (recordVSlurp ifaces (getName ty_thing))	`thenRn_`
+		returnRn (InTypeEnv ty_thing) ;
 
 	Nothing -> 
 
@@ -594,13 +604,11 @@ importDecl name
 	(decls_map, _) = iDecls ifaces
     in
     case lookupNameEnv decls_map name of
-      Just (avail,_,decl)
-	-> setIfacesRn (recordSlurp ifaces avail)	`thenRn_`
-	   returnRn (HereItIs decl)
+      Just (avail,_,decl) -> setIfacesRn (recordDeclSlurp ifaces avail)	`thenRn_`
+			     returnRn (HereItIs decl)
 
-      Nothing 
-	-> addErrRn (getDeclErr name)	`thenRn_` 
-	   returnRn AlreadySlurped
+      Nothing -> addErrRn (getDeclErr name)	`thenRn_` 
+		 returnRn AlreadySlurped
     }
   where
     wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
@@ -670,6 +678,7 @@ checkModUsage (mod_name, _, is_boot, whats_imported)
     	from    | is_boot   = ImportByUserSource
 	    	| otherwise = ImportByUser
     in
+    traceHiDiffsRn (text "Checking usages for module" <+> ppr mod_name) `thenRn_`
     tryLoadInterface doc_str mod_name from	`thenRn` \ (iface, maybe_err) ->
 
     case maybe_err of {
@@ -739,7 +748,7 @@ checkEntityUsage new_vers (name,old_vers)
 			  out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
 
 	Just new_vers 	-- It's there, but is it up to date?
-	  | new_vers == old_vers -> returnRn upToDate
+	  | new_vers == old_vers -> traceHiDiffsRn (text "Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenRn_` returnRn upToDate
 	  | otherwise	 	 -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
 
 up_to_date  msg = traceHiDiffsRn msg `thenRn_` returnRn upToDate

ghc/compiler/typecheck/TcModule.lhs

@@ -55,7 +55,7 @@ import Type		( funResultTy, splitForAllTys,
 			  liftedTypeKind, mkTyConApp, tidyType )
 import ErrUtils		( printErrorsAndWarnings, errorsFound, dumpIfSet_dyn, showPass )
 import Id		( Id, idType, idName, isLocalId, idUnfolding )
-import Module           ( Module, isHomeModule, moduleName )
+import Module           ( Module, moduleName )
 import Name		( Name, toRdrName, isGlobalName )
 import Name		( nameEnvElts, lookupNameEnv )
 import TyCon		( tyConGenInfo )
@@ -482,11 +482,8 @@ tcImports unf_env pcs hst get_fixity this_mod decls
          -- (on the GHCi command line, for example).  In this case, we
          -- want to treat everything we pulled in as an imported thing.
         imported_things
-    	  | isHomeModule this_mod
-    	  = filter (not . isLocalThing this_mod) all_things
-    	  | otherwise
-    	  = all_things
-    
+       	  = filter (not . isLocalThing this_mod) all_things
+        
         new_pte :: PackageTypeEnv
         new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things