From: simonpj Date: Thu, 9 Jan 2003 16:15:52 +0000 (+0000) Subject: [project @ 2003-01-09 16:15:51 by simonpj] X-Git-Tag: Approx_11550_changesets_converted~1275 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=ba58028475f0607b880ea3cad9cb646f90011092;p=ghc-hetmet.git [project @ 2003-01-09 16:15:51 by simonpj] -------------------------- Fix export-calculation bug -------------------------- Ross points out that in module M where import List as M sort = "foo" there is no conflict in the export list. GHC used to treat this like module M( module M ) where ... which is wrong, wrong, wrong. Now fixed. Test in modules/mod200.hs Some other small tidying up (notably in GRE.gre_parent). --- diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 4214c69..89a854c 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -857,18 +857,24 @@ emptyGlobalRdrEnv = emptyRdrEnv data GlobalRdrElt = GRE { gre_name :: Name, - gre_parent :: Name, -- Name of the "parent" structure - -- * the tycon of a data con - -- * the class of a class op - -- For others it's just the same as gre_name - gre_prov :: Provenance, -- Why it's in scope - gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated + gre_parent :: Maybe Name, -- Name of the "parent" structure, for + -- * the tycon of a data con + -- * the class of a class op + -- For others it's Nothing + -- Invariant: gre_name g /= gre_parent g + -- when the latter is a Just + + gre_prov :: Provenance, -- Why it's in scope + gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated } instance Outputable GlobalRdrElt where ppr gre = ppr (gre_name gre) <+> - parens (hsep [text "parent:" <+> ppr (gre_parent gre) <> comma, - pprNameProvenance gre]) + parens (pp_parent (gre_parent gre) <+> pprNameProvenance gre) + where + pp_parent (Just p) = text "parent:" <+> ppr p <> comma + pp_parent Nothing = empty + pprGlobalRdrEnv env = vcat (map pp (rdrEnvToList env)) where diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index a75353b..10fe8f6 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -890,7 +890,9 @@ mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails deprecs where occ = nameOccName name elt = GRE {gre_name = name, - gre_parent = parent, + gre_parent = if name == parent + then Nothing + else Just parent, gre_prov = mk_provenance name, gre_deprec = lookupDeprec deprecs name} @@ -986,44 +988,41 @@ warnUnusedLocals names = warnUnusedBinds [(n,LocalDef) | n<-names] warnUnusedBinds :: [(Name,Provenance)] -> TcRn m () warnUnusedBinds names - = mappM_ warnUnusedGroup groups + = mappM_ warnUnusedGroup groups where -- Group by provenance - groups = equivClasses cmp names + groups = equivClasses cmp (filter reportable names) (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2 + reportable (name,_) = case occNameUserString (nameOccName name) of + ('_' : _) -> False + zz_other -> True + -- Haskell 98 encourages compilers to suppress warnings about + -- unused names in a pattern if they start with "_". + ------------------------- warnUnusedGroup :: [(Name,Provenance)] -> TcRn m () warnUnusedGroup names - | null filtered_names = returnM () - | not is_local = returnM () - | otherwise = addSrcLoc def_loc $ - addWarn $ - sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))] + addWarn $ + sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) names)))] where - filtered_names = filter reportable names - (name1, prov1) = head filtered_names - (is_local, def_loc, msg) - = case prov1 of - LocalDef -> (True, getSrcLoc name1, text "Defined but not used") - - NonLocalDef (UserImport mod loc _) - -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used") - - reportable (name,_) = case occNameUserString (nameOccName name) of - ('_' : _) -> False - zz_other -> True - -- Haskell 98 encourages compilers to suppress warnings about - -- unused names in a pattern if they start with "_". + (name1, prov1) = head names + loc1 = getSrcLoc name1 + (def_loc, msg) = case prov1 of + LocalDef -> (loc1, unused_msg) + NonLocalDef (UserImport mod loc _) -> (loc, imp_from mod) + + unused_msg = text "Defined but not used" + imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used" \end{code} \begin{code} addNameClashErrRn rdr_name (np1:nps) = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name), - ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)]) + ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)]) where msg1 = ptext SLIT("either") <+> mk_ref np1 msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps] diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 21c3546..a3e83b4 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -40,10 +40,11 @@ import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv, Deprecations(..), ModIface(..), Dependencies(..), GlobalRdrElt(..), unQualInScope, isLocalGRE, pprNameProvenance ) -import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, lookupRdrEnv, +import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, lookupRdrEnv, rdrEnvToList, emptyRdrEnv, foldRdrEnv, rdrEnvElts, mkRdrUnqual, isQual ) import Outputable -import Maybe ( isJust, isNothing, catMaybes ) +import Maybe ( isJust, isNothing, catMaybes, fromMaybe ) +import Maybes ( orElse, expectJust ) import ListSetOps ( removeDups ) import Util ( sortLt, notNull ) import List ( partition, insert ) @@ -531,21 +532,36 @@ exportsFromAvail :: Maybe [RdrNameIE] -> TcRn m Avails -- Complains if two distinct exports have same OccName -- Warns about identical exports. -- Complains about exports items not in scope -exportsFromAvail Nothing + +exportsFromAvail exports + = do { TcGblEnv { tcg_rdr_env = rdr_env, + tcg_imports = imports } <- getGblEnv ; + exports_from_avail exports rdr_env imports } + +exports_from_avail Nothing rdr_env + (ImportAvails { imp_env = entity_avail_env }) = do { this_mod <- getModule ; if moduleName this_mod == mAIN_Name then return [] - -- Export nothing; Main.$main is automatically exported - else - exportsFromAvail (Just [IEModuleContents (moduleName this_mod)]) - -- but for all other modules export everything. + -- Export nothing; Main.$main is automatically exported + 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 + | (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) + ] } -exportsFromAvail (Just exports) - = do { TcGblEnv { tcg_imports = imports } <- getGblEnv ; - exports_from_avail exports imports } - -exports_from_avail export_items +exports_from_avail (Just export_items) rdr_env (ImportAvails { imp_qual = mod_avail_env, imp_env = entity_avail_env }) = foldlM exports_from_item emptyExportAccum @@ -567,11 +583,10 @@ exports_from_avail export_items returnM acc Just avail_env - -> getGlobalRdrEnv `thenM` \ global_env -> - let + -> let mod_avails = [ filtered_avail | avail <- availEnvElts avail_env, - let mb_avail = filter_unqual global_env avail, + let mb_avail = filter_unqual rdr_env avail, isJust mb_avail, let Just filtered_avail = mb_avail] @@ -588,16 +603,16 @@ exports_from_avail export_items exports_from_item acc@(mods, occs, avails) ie = lookupGRE (ieName ie) `thenM` \ mb_gre -> case mb_gre of { - Nothing -> addErr (unknownNameErr (ieName ie)) `thenM_` - returnM acc ; - Just gre -> + Nothing -> addErr (unknownNameErr (ieName ie)) `thenM_` + returnM acc ; + Just gre -> -- Get the AvailInfo for the parent of the specified name - case lookupAvailEnv entity_avail_env (gre_parent gre) of { - Nothing -> pprPanic "exportsFromAvail" - ((ppr (ieName ie)) <+> ppr gre) ; - Just avail -> - + let + parent = gre_parent gre `orElse` gre_name gre + avail = expectJust "exportsFromAvail2" + (lookupAvailEnv entity_avail_env parent) + in -- Filter out the bits we want case filterAvail ie avail of { Nothing -> -- Not enough availability @@ -610,7 +625,7 @@ exports_from_avail export_items warnIf (not (ok_item ie avail)) (dodgyExportWarn ie) `thenM_` check_occs ie occs export_avail `thenM` \ occs' -> returnM (mods, occs', addAvail avails export_avail) - }}} + }} ------------------------------- @@ -688,9 +703,11 @@ reportUnusedNames gbl_env used_names -- if C was brought into scope by T(..) or T(C) really_used_names :: NameSet really_used_names = used_names `unionNameSets` - mkNameSet [ gre_parent gre - | gre <- defined_names, - gre_name gre `elemNameSet` used_names] + mkNameSet [ parent + | GRE{ gre_name = name, + gre_parent = Just parent } + <- defined_names, + name `elemNameSet` used_names] -- Collect the defined names from the in-scope environment -- Look for the qualified ones only, else get duplicates @@ -752,9 +769,9 @@ reportUnusedNames gbl_env used_names = acc -- n is the name of the thing, p is the name of its parent - mk_avail n p | n/=p = AvailTC p [p,n] - | isTcOcc (nameOccName p) = AvailTC n [n] - | otherwise = Avail n + mk_avail n (Just p) = AvailTC p [p,n] + mk_avail n Nothing | isTcOcc (nameOccName n) = AvailTC n [n] + | otherwise = Avail n add_inst_mod m acc | m `elemFM` acc = acc -- We import something already