Commit f4c9d2b2 authored by simonpj's avatar simonpj
Browse files

[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.
parent ca23a049
......@@ -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,
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
}}}
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment