From: simonpj Date: Wed, 20 Oct 2004 13:34:27 +0000 (+0000) Subject: [project @ 2004-10-20 13:34:04 by simonpj] X-Git-Tag: Initial_conversion_from_CVS_complete~1488 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=f4c9d2b23bd63b48566e0ca3b13c8bdfc4cd0c0b [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. --- diff --git a/ghc/compiler/deSugar/Desugar.lhs b/ghc/compiler/deSugar/Desugar.lhs index 02f60ed..1a5d7e8 100644 --- a/ghc/compiler/deSugar/Desugar.lhs +++ b/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, diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs index 4ca0852..316aa0a 100644 --- a/ghc/compiler/iface/LoadIface.lhs +++ b/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 diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs index 355b78b..abfc67d 100644 --- a/ghc/compiler/iface/MkIface.lhs +++ b/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 diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 8b5013e..4dfcc13 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/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 diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs index 1439531..1738105 100644 --- a/ghc/compiler/rename/RnSource.lhs +++ b/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) }}} diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs index 1e5743a..02b586a 100644 --- a/ghc/compiler/typecheck/TcRnDriver.lhs +++ b/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