X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnNames.lhs;h=12eb33ab3f4630be0144eef3d1b4efaede94abea;hb=e4abae1dd1edfca515e2bcf5e278869c4863f509;hp=04fc4b4fd1a175dcf8337a35137fb51a2aabcd04;hpb=42b63073fb5e71fcd539ab80289cf6cf2a5b9641;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 04fc4b4..12eb33a 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -6,7 +6,7 @@ \begin{code} module RnNames ( rnImports, importsFromLocalDecls, exportsFromAvail, - reportUnusedNames, mkModDeps, main_RDR_Unqual + reportUnusedNames, mkModDeps ) where #include "HsVersions.h" @@ -44,8 +44,8 @@ import OccName ( varName ) import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, lookupRdrEnv, rdrEnvToList, emptyRdrEnv, foldRdrEnv, rdrEnvElts, mkRdrUnqual, isQual, mkUnqual ) import Outputable -import Maybe ( isJust, isNothing, catMaybes, fromMaybe ) -import Maybes ( orElse, expectJust ) +import Maybe ( isJust, isNothing, catMaybes ) +import Maybes ( orElse ) import ListSetOps ( removeDups ) import Util ( sortLt, notNull ) import List ( partition, insert ) @@ -541,29 +541,18 @@ exportsFromAvail exports exports_from_avail Nothing rdr_env imports@(ImportAvails { imp_env = entity_avail_env }) - = do { this_mod <- getModule ; - if moduleName this_mod == mAIN_Name then - exports_from_avail (Just [IEVar main_RDR_Unqual]) rdr_env imports - -- Behave just as if we'd said module Main(main) - -- This is particularly important if we compile module Main, - -- but then use ghci to call it... we jolly well expect to - -- see 'main'! - else - -- Export all locally-defined things - -- We do this by filtering the global RdrEnv, - -- keeping only things that are (a) qualified, - -- (b) locally defined, (c) a 'main' name - -- Then we look up in the entity-avail-env - return [ avail + = -- Export all locally-defined things + -- We do this by filtering the global RdrEnv, + -- keeping only things that are (a) qualified, + -- (b) locally defined, (c) a 'main' name + -- Then we look up in the entity-avail-env + return [ lookupAvailEnv entity_avail_env name | (rdr_name, gres) <- rdrEnvToList rdr_env, isQual rdr_name, -- Avoid duplicates GRE { gre_name = name, gre_parent = Nothing, -- Main things only - gre_prov = LocalDef } <- gres, - let avail = expectJust "exportsFromAvail" - (lookupAvailEnv entity_avail_env name) + gre_prov = LocalDef } <- gres ] - } exports_from_avail (Just export_items) rdr_env (ImportAvails { imp_qual = mod_avail_env, @@ -614,8 +603,7 @@ exports_from_avail (Just export_items) rdr_env -- Get the AvailInfo for the parent of the specified name let parent = gre_parent gre `orElse` gre_name gre - avail = expectJust "exportsFromAvail2" - (lookupAvailEnv entity_avail_env parent) + avail = lookupAvailEnv entity_avail_env parent in -- Filter out the bits we want case filterAvail ie avail of { @@ -681,13 +669,6 @@ check_occs ie occs avail returnM occs } where name_occ = nameOccName name - ----------------------------- -main_RDR_Unqual :: RdrName -main_RDR_Unqual = mkUnqual varName FSLIT("main") - -- Don't get a RdrName from PrelNames.mainName, because - -- nameRdrNamegets an Orig RdrName, and we want a Qual or Unqual one. - -- An Unqual one will do just fine \end{code} %********************************************************* @@ -697,28 +678,15 @@ main_RDR_Unqual = mkUnqual varName FSLIT("main") %********************************************************* \begin{code} -reportUnusedNames :: TcGblEnv - -> NameSet -- Used in this module - -> TcRn m () -reportUnusedNames gbl_env used_names - = warnUnusedModules unused_imp_mods `thenM_` - warnUnusedTopBinds bad_locals `thenM_` - warnUnusedImports bad_imports `thenM_` +reportUnusedNames :: TcGblEnv -> DefUses -> TcRn m () +reportUnusedNames gbl_env dus + = warnUnusedModules unused_imp_mods `thenM_` + warnUnusedTopBinds bad_locals `thenM_` + warnUnusedImports bad_imports `thenM_` printMinimalImports minimal_imports where - direct_import_mods :: [ModuleName] - direct_import_mods = map (moduleName . fst) - (moduleEnvElts (imp_mods (tcg_imports gbl_env))) - - -- Now, a use of C implies a use of T, - -- if C was brought into scope by T(..) or T(C) - really_used_names :: NameSet - really_used_names = used_names `unionNameSets` - mkNameSet [ parent - | GRE{ gre_name = name, - gre_parent = Just parent } - <- defined_names, - name `elemNameSet` used_names] + used_names :: NameSet + used_names = findUses dus emptyNameSet -- Collect the defined names from the in-scope environment -- Look for the qualified ones only, else get duplicates @@ -728,8 +696,17 @@ reportUnusedNames gbl_env used_names | otherwise = acc defined_and_used, defined_but_not_used :: [GlobalRdrElt] - (defined_and_used, defined_but_not_used) = partition used defined_names - used gre = gre_name gre `elemNameSet` really_used_names + (defined_and_used, defined_but_not_used) = partition is_used defined_names + + is_used gre = n `elemNameSet` used_names || any (`elemNameSet` used_names) kids + -- The 'kids' part is because a use of C implies a use of T, + -- if C was brought into scope by T(..) or T(C) + where + n = gre_name gre + kids = case lookupAvailEnv_maybe avail_env n of + Just (AvailTC n ns) -> ns + other -> [] -- Ids, class ops and datacons + -- (The latter two give Nothing) -- Filter out the ones that are -- (a) defined in this module, and @@ -737,7 +714,6 @@ reportUnusedNames gbl_env used_names -- The latter have an Internal Name, so we can filter them out easily bad_locals :: [GlobalRdrElt] bad_locals = filter is_bad defined_but_not_used - is_bad :: GlobalRdrElt -> Bool is_bad gre = isLocalGRE gre && isExternalName (gre_name gre) @@ -790,6 +766,13 @@ reportUnusedNames gbl_env used_names -- Add an empty collection of imports for a module -- from which we have sucked only instance decls + imports = tcg_imports gbl_env + avail_env = imp_env imports + + direct_import_mods :: [ModuleName] + direct_import_mods = map (moduleName . fst) + (moduleEnvElts (imp_mods imports)) + -- unused_imp_mods are the directly-imported modules -- that are not mentioned in minimal_imports1 -- [Note: not 'minimal_imports', because that includes direcly-imported