[project @ 2004-10-20 13:34:04 by simonpj]

---------------------------------
	Fix a bug in usage recording
	---------------------------------

As a result of the new stuff on hi-boot-file consistency checking, I
accidentally caused Foo.hi to record a usage line for module Foo, and
this in turn caused rather nasty bad things to happen.  In particular,
there were occasional crashes of form

ghc-6.3: panic! (the `impossible' happened, GHC version 6.3.20041017):
        forkM Constructor Var.TcTyVar{d r1B9}

At least I think that's why the crash happened.

Anyway, it was certainly a bug, and this commit fixes it.  The main
payload of this fix is in Desugar.lhs;  the rest is comments and
tidying.

ghc/compiler/deSugar/Desugar.lhs

@@ -92,18 +92,24 @@ deSugar hsc_env
 		  (printDump (ppr_ds_rules ds_rules))
 
 	; dfun_uses <- readIORef dfun_uses_var		-- What dfuns are used
+	; th_used   <- readIORef th_var
 	; let used_names = allUses dus `unionNameSets` dfun_uses
-	; usages <- mkUsageInfo hsc_env imports used_names
+	      pkgs | th_used   = insertList thPackage (imp_dep_pkgs imports)
+	      	   | otherwise = imp_dep_pkgs imports
 
-	; th_used <- readIORef th_var
-	; let 
-	     pkgs | th_used   = insertList thPackage (imp_dep_pkgs imports)
-		  | otherwise = imp_dep_pkgs imports
-
-	     mods = moduleEnvElts (delModuleEnv (imp_dep_mods imports) mod)
+	      dep_mods = moduleEnvElts (delModuleEnv (imp_dep_mods imports) mod)
 		-- M.hi-boot can be in the imp_dep_mods, but we must remove
 		-- it before recording the modules on which this one depends!
+		-- (We want to retain M.hi-boot in imp_dep_mods so that 
+		--  loadHiBootInterface can see if M's direct imports depend 
+		--  on M.hi-boot, and hence that we should do the hi-boot consistency 
+		--  check.)
+
+	      dir_imp_mods = imp_mods imports
 
+	; usages <- mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
+
+	; let 
 		-- ModuleNames don't compare lexicographically usually, 
 		-- but we want them to do so here.
 	     le_mod :: ModuleName -> ModuleName -> Bool	 
@@ -111,7 +117,7 @@ deSugar hsc_env
 	     le_dep_mod :: (ModuleName, IsBootInterface) -> (ModuleName, IsBootInterface) -> Bool	 
 	     le_dep_mod (m1,_) (m2,_) = m1 `le_mod` m2
 
-	     deps = Deps { dep_mods  = sortLe le_dep_mod mods,
+	     deps = Deps { dep_mods  = sortLe le_dep_mod dep_mods,
 			   dep_pkgs  = sortLe (<=)   pkgs,	
 			   dep_orphs = sortLe le_mod (imp_orphs imports) }
 		-- sort to get into canonical order
@@ -121,7 +127,7 @@ deSugar hsc_env
 		mg_exports  = exports,
 		mg_deps	    = deps,
 		mg_usages   = usages,
-		mg_dir_imps = [m | (m,_,_) <- moduleEnvElts (imp_mods imports)],
+		mg_dir_imps = [m | (m,_,_) <- moduleEnvElts dir_imp_mods],
 	        mg_rdr_env  = rdr_env,
 		mg_fix_env  = fix_env,
 		mg_deprecs  = deprecs,

ghc/compiler/iface/LoadIface.lhs

@@ -108,7 +108,7 @@ loadHiBootInterface
   = do 	{ eps <- getEps
 	; mod <- getModule
 
-	; traceIf (text "loadBootIface" <+> ppr mod)
+	; traceIf (text "loadHiBootInterface" <+> ppr mod)
 
 	-- We're read all the direct imports by now, so eps_is_boot will
 	-- record if any of our imports mention us by way of hi-boot file

ghc/compiler/iface/MkIface.lhs

@@ -225,6 +225,7 @@ import BinIface		( writeBinIface, v_IgnoreHiWay )
 import Unique		( Unique, Uniquable(..) )
 import ErrUtils		( dumpIfSet_dyn, showPass )
 import Digraph		( stronglyConnComp, SCC(..) )
+import SrcLoc		( SrcSpan )
 import FiniteMap
 import FastString
 
@@ -663,20 +664,22 @@ bump_unless False v = bumpVersion v
 
 
 \begin{code}
-mkUsageInfo :: HscEnv -> ImportAvails -> NameSet -> IO [Usage]
-mkUsageInfo hsc_env
-	    (ImportAvails { imp_mods = dir_imp_mods,
-			    imp_dep_mods = dep_mods })
-	    used_names
+mkUsageInfo :: HscEnv 
+	    -> ModuleEnv (Module, Maybe Bool, SrcSpan)
+	    -> [(ModuleName, IsBootInterface)]
+	    -> NameSet -> IO [Usage]
+mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
   = do	{ eps <- hscEPS hsc_env
-	; return (mk_usage_info (eps_PIT eps) (hsc_HPT hsc_env) 
-				dir_imp_mods dep_mods used_names) }
+	; let usages = mk_usage_info (eps_PIT eps) (hsc_HPT hsc_env) 
+				     dir_imp_mods dep_mods used_names
+	; usages `seqList`  return usages }
+	 -- seq the list of Usages returned: occasionally these
+	 -- don't get evaluated for a while and we can end up hanging on to
+	 -- the entire collection of Ifaces.
 
 mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names
-  = -- seq the list of Usages returned: occasionally these
-    -- don't get evaluated for a while and we can end up hanging on to
-    -- the entire collection of Ifaces.
-    usages `seqList` usages
+  = mapCatMaybes mkUsage dep_mods
+	-- ToDo: do we need to sort into canonical order?
   where
     used_names = mkNameSet $			-- Eliminate duplicates
 		 [ nameParent n			-- Just record usage on the 'main' names
@@ -695,9 +698,6 @@ mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names
     		     mod = nameModule name
     		     add_item occs _ = occ:occs
     
-    usages = mapCatMaybes mkUsage (moduleEnvElts dep_mods)
-	-- ToDo: do we need to sort into canonical order?
-
     import_all mod = case lookupModuleEnv dir_imp_mods mod of
     			Just (_,imp_all,_) -> isNothing imp_all
     			Nothing		   -> False

ghc/compiler/rename/RnNames.lhs

@@ -200,10 +200,13 @@ importsFromImportDecl this_mod
 	(dependent_mods, dependent_pkgs) 
 	   | isHomeModule imp_mod 
 	   = 	-- Imported module is from the home package
-		-- Take its dependent modules and
-		--	(a) remove this_mod (might be there as a hi-boot)
-		--	(b) add imp_mod itself
+		-- Take its dependent modules and add imp_mod itself
 		-- Take its dependent packages unchanged
+		-- NB: (dep_mods deps) might include a hi-boot file for the module being
+		--	compiled, CM. Do *not* filter this out (as we used to), because when 
+		--	we've finished dealing with the direct imports we want to know if any 
+		--	of them depended on CM.hi-boot, in which case we should do the hi-boot
+		--	consistency check.  See LoadIface.loadHiBootInterface
 	     ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)
 
 	   | otherwise	

ghc/compiler/rename/RnSource.lhs

@@ -121,9 +121,14 @@ rnSrcDecls (HsGroup { hs_valds  = [HsBindGroup binds sigs _],
 	   other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, 
 				src_fvs4, src_fvs5] ;
 	   src_dus = bind_dus `plusDU` usesOnly other_fvs 
+		-- Note: src_dus will contain *uses* for locally-defined types
+		-- and classes, but no *defs* for them.  (Because rnTyClDecl 
+		-- returns only the uses.)  This is a little 
+		-- surprising but it doesn't actually matter at all.
 	} ;
 
 	traceRn (text "finish rnSrc" <+> ppr rn_group) ;
+	traceRn (text "finish Dus" <+> ppr src_dus ) ;
 	tcg_env <- getGblEnv ;
 	return (tcg_env `addTcgDUs` src_dus, rn_group)
     }}}

ghc/compiler/typecheck/TcRnDriver.lhs

@@ -424,6 +424,8 @@ the hi-boot interface as our checklist.
 checkHiBootIface :: TypeEnv -> [Name] -> TcM ()
 -- Compare the hi-boot file for this module (if there is one)
 -- with the type environment we've just come up with
+-- In the common case where there is no hi-boot file, the list
+-- of boot_names is empty.
 checkHiBootIface env boot_names
   = mapM_ (check_one env) boot_names