X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnEnv.lhs;h=15a46bfd9d51c985c4c2c263f3afa23003c230d6;hb=6a562dd51c1d264ce74a9f6fdf020e21ce34d143;hp=b4bb690fff4490659f78dee519ab0d623a9dcd30;hpb=266fadd93461d4317967df08cd641e965cd8769a;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index b4bb690..15a46bf 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -16,36 +16,32 @@ import RnHsSyn ( RenamedHsType ) import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, mkRdrUnqual, qualifyRdrName ) -import HsTypes ( getTyVarName, replaceTyVarName ) +import HsTypes ( hsTyVarName, hsTyVarNames, replaceTyVarName ) import RnMonad import Name ( Name, Provenance(..), ExportFlag(..), NamedThing(..), ImportReason(..), getSrcLoc, - mkLocalName, mkImportedLocalName, mkGlobalName, - mkIPName, isSystemName, + mkLocalName, mkImportedLocalName, mkGlobalName, mkUnboundName, + mkIPName, isWiredInName, hasBetterProv, nameOccName, setNameModule, nameModule, - pprOccName, isLocallyDefined, nameUnique, nameOccName, - occNameUserString, - setNameProvenance, getNameProvenance, pprNameProvenance + pprOccName, isLocallyDefined, nameUnique, + setNameProvenance, getNameProvenance, pprNameProvenance, + extendNameEnv_C, plusNameEnv_C, nameEnvElts ) import NameSet import OccName ( OccName, mkDFunOcc, occNameUserString, occNameString, occNameFlavour ) -import TysWiredIn ( tupleTyCon, unboxedTupleTyCon, listTyCon ) +import TysWiredIn ( listTyCon ) import Type ( funTyCon ) -import Module ( ModuleName, mkThisModule, mkVanillaModule, moduleName ) -import TyCon ( TyCon ) +import Module ( ModuleName, mkThisModule, moduleName, mkVanillaModule, pprModuleName ) import FiniteMap -import Unique ( Unique, Uniquable(..) ) -import UniqFM ( emptyUFM, listToUFM, plusUFM_C ) import UniqSupply import SrcLoc ( SrcLoc, noSrcLoc ) import Outputable -import Util ( removeDups, equivClasses, thenCmp ) +import Util ( removeDups, equivClasses, thenCmp, sortLt ) import List ( nub ) -import Maybes ( mapMaybe ) \end{code} @@ -57,43 +53,124 @@ import Maybes ( mapMaybe ) %********************************************************* \begin{code} -newImportedGlobalName mod_name occ mod +implicitImportProvenance = NonLocalDef ImplicitImport False + +newTopBinder :: Module -> OccName -> RnM d Name +newTopBinder mod occ + = -- First check the cache + traceRn (text "newTopBinder" <+> ppr mod <+> ppr occ) `thenRn_` + + getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> + let + key = (moduleName mod, occ) + in + case lookupFM cache key of + + -- A hit in the cache! We are at the binding site of the name, which is + -- the time we know all about the Name's host Module (in particular, which + -- package it comes from), so update the Module in the name. + -- But otherwise *leave the Provenance alone*: + -- + -- * For imported names, the Provenance may already be correct. + -- e.g. We imported Prelude.hi, and set the provenance of PrelShow.Show + -- to 'UserImport from Prelude'. Note that we havn't yet opened PrelShow.hi + -- Later we find we really need PrelShow.Show, so we open PrelShow.hi, and + -- that's when we find the binding occurrence of Show. + -- + -- * For locally defined names, we do a setProvenance on the Name + -- right after newTopBinder, and then use updateProveances to finally + -- set the provenances in the cache correctly. + -- + -- NB: for wired-in names it's important not to + -- forget that they are wired in even when compiling that module + -- (else we spit out redundant defns into the interface file) + + Just name -> let + new_name = setNameModule name mod + new_cache = addToFM cache key new_name + in + setNameSupplyRn (us, inst_ns, new_cache, ipcache) `thenRn_` + traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_` + returnRn new_name + + -- Miss in the cache! + -- Build a completely new Name, and put it in the cache + -- Even for locally-defined names we use implicitImportProvenance; + -- updateProvenances will set it to rights + Nothing -> let + (us', us1) = splitUniqSupply us + uniq = uniqFromSupply us1 + new_name = mkGlobalName uniq mod occ implicitImportProvenance + new_cache = addToFM cache key new_name + in + setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_` + traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_` + returnRn new_name + + +mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name + -- Used for *occurrences*. We make a place-holder Name, really just + -- to agree on its unique, which gets overwritten when we read in + -- the binding occurence later (newImportedBinder) + -- The place-holder Name doesn't have the right Provenance, and its + -- Module won't have the right Package either + -- + -- This means that a renamed program may have incorrect info + -- on implicitly-imported occurrences, but the correct info on the + -- *binding* declaration. It's the type checker that propagates the + -- correct information to all the occurrences. + -- Since implicitly-imported names never occur in error messages, + -- it doesn't matter that we get the correct info in place till later, + -- (but since it affects DLL-ery it does matter that we get it right + -- in the end). +mkImportedGlobalName mod_name occ = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> let key = (mod_name, occ) in case lookupFM cache key of - Just name -> returnRn name - Nothing -> setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_` + Just name -> traceRn (text "mkImportedGlobalName: hit" <+> ppr name) `thenRn_` + returnRn name + Nothing -> setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_` + traceRn (text "mkImportedGlobalName: new" <+> ppr name) `thenRn_` returnRn name where (us', us1) = splitUniqSupply us uniq = uniqFromSupply us1 - name = mkGlobalName uniq mod occ (NonLocalDef ImplicitImport False) + mod = mkVanillaModule mod_name + name = mkGlobalName uniq mod occ implicitImportProvenance new_cache = addToFM cache key name updateProvenances :: [Name] -> RnM d () +-- Update the provenances of everything that is in scope. +-- We must be careful not to disturb the Module package info +-- already in the cache. Why not? Consider +-- module A module M( f ) +-- import M( f ) import N( f) +-- import N +-- So f is defined in N, and M re-exports it. +-- When processing module A: +-- 1. We read M.hi first, and make a vanilla name N.f +-- (without reading N.hi). The package info says +-- for lack of anything better. +-- 2. Now we read N, which update the cache to record +-- the correct package for N.f. +-- 3. Finally we update provenances (once we've read all imports). +-- Step 3 must not destroy package info recorded in Step 2. + updateProvenances names = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> - setNameSupplyRn (us, inst_ns, update cache names, ipcache) + setNameSupplyRn (us, inst_ns, foldr update cache names, ipcache) where - update cache [] = cache - update cache (name:names) = WARN( not (key `elemFM` cache), ppr name ) - update (addToFM cache key name) names - where - key = (moduleName (nameModule name), nameOccName name) - -newImportedBinder :: Module -> RdrName -> RnM d Name -newImportedBinder mod rdr_name - = ASSERT2( isUnqual rdr_name, ppr rdr_name ) - newImportedGlobalName (moduleName mod) (rdrNameOcc rdr_name) mod - --- Make an imported global name, checking first to see if it's in the cache -mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name -mkImportedGlobalName mod_name occ - = lookupModuleRn mod_name `thenRn` \ mod -> - newImportedGlobalName mod_name occ mod --(mkVanillaModule mod_name) - + update name cache = addToFM_C update_prov cache key name + where + key = (moduleName (nameModule name), nameOccName name) + + update_prov name_in_cache name_with_prov + = setNameProvenance name_in_cache (getNameProvenance name_with_prov) + + +mkImportedGlobalFromRdrName :: RdrName -> RnM d Name mkImportedGlobalFromRdrName rdr_name | isQual rdr_name = mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name) @@ -106,49 +183,6 @@ mkImportedGlobalFromRdrName rdr_name mkImportedGlobalName mod_name (rdrNameOcc rdr_name) -newLocalTopBinder :: Module -> OccName - -> (Name -> ExportFlag) -> SrcLoc - -> RnM d Name -newLocalTopBinder mod occ rec_exp_fn loc - = -- First check the cache - getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> - let - key = (moduleName mod,occ) - mk_prov name = LocalDef loc (rec_exp_fn name) - -- We must set the provenance of the thing in the cache - -- correctly, particularly whether or not it is locally defined. - -- - -- Since newLocallyDefinedGlobalName is used only - -- at binding occurrences, we may as well get the provenance - -- dead right first time; hence the rec_exp_fn passed in - in - case lookupFM cache key of - - -- A hit in the cache! - -- Overwrite whatever provenance is in the cache already; - -- this updates WiredIn things and known-key things, - -- which are there from the start, to LocalDef. - -- - -- It also means that if there are two defns for the same thing - -- in a module, then each gets a separate SrcLoc - Just name -> let - new_name = setNameProvenance name (mk_prov new_name) - new_cache = addToFM cache key new_name - in - setNameSupplyRn (us, inst_ns, new_cache, ipcache) `thenRn_` - returnRn new_name - - -- Miss in the cache! - -- Build a new original name, and put it in the cache - Nothing -> let - (us', us1) = splitUniqSupply us - uniq = uniqFromSupply us1 - new_name = mkGlobalName uniq mod occ (mk_prov new_name) - new_cache = addToFM cache key new_name - in - setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_` - returnRn new_name - getIPName rdr_name = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> case lookupFM ipcache key of @@ -169,13 +203,16 @@ getIPName rdr_name %* * %********************************************************* -@newImplicitBinder@ is used for (a) dfuns -(b) default methods, defined in this module. +@newImplicitBinder@ is used for + (a) dfuns (RnSource.rnDecl on InstDecls) + (b) default methods (RnSource.rnDecl on ClassDecls) +when these dfuns/default methods are defined in the module being compiled \begin{code} newImplicitBinder occ src_loc = getModuleRn `thenRn` \ mod_name -> - newLocalTopBinder (mkThisModule mod_name) occ (\_ -> Exported) src_loc + newTopBinder (mkThisModule mod_name) occ `thenRn` \ name -> + returnRn (setNameProvenance name (LocalDef src_loc Exported)) \end{code} Make a name for the dict fun for an instance decl @@ -192,16 +229,15 @@ newDFunName key@(cl_occ, tycon_occ) loc \begin{code} getDFunKey :: RenamedHsType -> (OccName, OccName) -- Used to manufacture DFun names -getDFunKey (HsForAllTy _ _ ty) = getDFunKey ty -getDFunKey (MonoFunTy _ ty) = getDFunKey ty -getDFunKey (MonoDictTy cls (ty:_)) = (nameOccName cls, get_tycon_key ty) - -get_tycon_key (MonoTyVar tv) = nameOccName (getName tv) -get_tycon_key (MonoTyApp ty _) = get_tycon_key ty -get_tycon_key (MonoTupleTy tys True) = getOccName (tupleTyCon (length tys)) -get_tycon_key (MonoTupleTy tys False) = getOccName (unboxedTupleTyCon (length tys)) -get_tycon_key (MonoListTy _) = getOccName listTyCon -get_tycon_key (MonoFunTy _ _) = getOccName funTyCon +getDFunKey (HsForAllTy _ _ ty) = getDFunKey ty +getDFunKey (HsFunTy _ ty) = getDFunKey ty +getDFunKey (HsPredTy (HsPClass cls (ty:_))) = (nameOccName cls, get_tycon_key ty) + +get_tycon_key (HsTyVar tv) = getOccName tv +get_tycon_key (HsAppTy ty _) = get_tycon_key ty +get_tycon_key (HsTupleTy (HsTupCon n _) tys) = getOccName n +get_tycon_key (HsListTy _) = getOccName listTyCon +get_tycon_key (HsFunTy _ _) = getOccName funTyCon \end{code} @@ -220,16 +256,16 @@ bindLocatedLocalsRn :: SDoc -- Documentation string for error message bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_` + getModeRn `thenRn` \ mode -> getLocalNameEnv `thenRn` \ name_env -> - (if opt_WarnNameShadowing - then - mapRn_ (check_shadow name_env) rdr_names_w_loc - else - returnRn () + + -- Warn about shadowing, but only in source modules + (case mode of + SourceMode | opt_WarnNameShadowing -> mapRn_ (check_shadow name_env) rdr_names_w_loc + other -> returnRn () ) `thenRn_` getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> - getModeRn `thenRn` \ mode -> let n = length rdr_names_w_loc (us', us1) = splitUniqSupply us @@ -286,6 +322,13 @@ bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' -> bindCoreLocalsFVRn bs $ \ names' -> thing_inside (name':names') +bindLocalNames names enclosed_scope + = getLocalNameEnv `thenRn` \ name_env -> + setLocalNameEnv (addListToRdrEnv name_env pairs) + enclosed_scope + where + pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names] + ------------------------------------- bindLocalRn doc rdr_name enclosed_scope = getSrcLocRn `thenRn` \ loc -> @@ -311,48 +354,43 @@ bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVa bindUVarRn = bindLocalRn ------------------------------------- -extendTyVarEnvFVRn :: [HsTyVar Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars) +extendTyVarEnvFVRn :: [HsTyVarBndr Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars) -- This tiresome function is used only in rnDecl on InstDecl extendTyVarEnvFVRn tyvars enclosed_scope - = getLocalNameEnv `thenRn` \ env -> - let - tyvar_names = map getTyVarName tyvars - new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name) - | name <- tyvar_names - ] - in - setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) -> + = bindLocalNames tyvar_names enclosed_scope `thenRn` \ (thing, fvs) -> returnRn (thing, delListFromNameSet fvs tyvar_names) + where + tyvar_names = hsTyVarNames tyvars -bindTyVarsRn :: SDoc -> [HsTyVar RdrName] - -> ([HsTyVar Name] -> RnMS a) +bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName] + -> ([HsTyVarBndr Name] -> RnMS a) -> RnMS a bindTyVarsRn doc_str tyvar_names enclosed_scope = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars -> enclosed_scope tyvars -- Gruesome name: return Names as well as HsTyVars -bindTyVars2Rn :: SDoc -> [HsTyVar RdrName] - -> ([Name] -> [HsTyVar Name] -> RnMS a) +bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName] + -> ([Name] -> [HsTyVarBndr Name] -> RnMS a) -> RnMS a bindTyVars2Rn doc_str tyvar_names enclosed_scope = getSrcLocRn `thenRn` \ loc -> let - located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names] + located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names] in bindLocatedLocalsRn doc_str located_tyvars $ \ names -> enclosed_scope names (zipWith replaceTyVarName tyvar_names names) -bindTyVarsFVRn :: SDoc -> [HsTyVar RdrName] - -> ([HsTyVar Name] -> RnMS (a, FreeVars)) +bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName] + -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars) bindTyVarsFVRn doc_str rdr_names enclosed_scope = bindTyVars2Rn doc_str rdr_names $ \ names tyvars -> enclosed_scope tyvars `thenRn` \ (thing, fvs) -> returnRn (thing, delListFromNameSet fvs names) -bindTyVarsFV2Rn :: SDoc -> [HsTyVar RdrName] - -> ([Name] -> [HsTyVar Name] -> RnMS (a, FreeVars)) +bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName] + -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars) bindTyVarsFV2Rn doc_str rdr_names enclosed_scope = bindTyVars2Rn doc_str rdr_names $ \ names tyvars -> @@ -391,7 +429,8 @@ Looking up a name in the RnEnv. \begin{code} lookupBndrRn rdr_name - = getNameEnvs `thenRn` \ (global_env, local_env) -> + = traceRn (text "lookupBndrRn" <+> ppr rdr_name) `thenRn_` + getNameEnvs `thenRn` \ (global_env, local_env) -> -- Try local env case lookupRdrEnv local_env rdr_name of { @@ -401,7 +440,9 @@ lookupBndrRn rdr_name getModeRn `thenRn` \ mode -> case mode of InterfaceMode -> -- Look in the global name cache - mkImportedGlobalFromRdrName rdr_name + mkImportedGlobalFromRdrName rdr_name `thenRn` \ n -> + traceRn (text "lookupBndrRn result:" <+> ppr n) `thenRn_` + returnRn n SourceMode -> -- Source mode, so look up a *qualified* version -- of the name, so that we get the right one even @@ -414,10 +455,7 @@ lookupBndrRn rdr_name Nothing -> pprPanic "lookupBndrRn" (ppr mod <+> ppr rdr_name) } --- Just like lookupRn except that we record the occurrence too --- Perhaps surprisingly, even wired-in names are recorded. --- Why? So that we know which wired-in names are referred to when --- deciding which instance declarations to import. +-- lookupOccRn looks up an occurrence of a RdrName lookupOccRn :: RdrName -> RnMS Name lookupOccRn rdr_name = getNameEnvs `thenRn` \ (global_env, local_env) -> @@ -432,6 +470,20 @@ lookupGlobalOccRn rdr_name = getNameEnvs `thenRn` \ (global_env, local_env) -> lookup_global_occ global_env rdr_name +-- lookupSigOccRn is used for type signatures and pragmas +-- Is this valid? +-- module A +-- import M( f ) +-- f :: Int -> Int +-- f x = x +-- It's clear that the 'f' in the signature must refer to A.f +-- The Haskell98 report does not stipulate this, but it will! +-- So we must treat the 'f' in the signature in the same way +-- as the binding occurrence of 'f', using lookupBndrRn +lookupSigOccRn :: RdrName -> RnMS Name +lookupSigOccRn = lookupBndrRn + + -- Look in both local and global env lookup_occ global_env local_env rdr_name = case lookupRdrEnv local_env rdr_name of @@ -477,6 +529,11 @@ The name cache should have the correct provenance, though. \begin{code} lookupImplicitOccRn :: RdrName -> RnM d Name lookupImplicitOccRn rdr_name = mkImportedGlobalFromRdrName rdr_name + +lookupImplicitOccsRn :: [RdrName] -> RnM d NameSet +lookupImplicitOccsRn rdr_names + = mapRn lookupImplicitOccRn rdr_names `thenRn` \ names -> + returnRn (mkNameSet names) \end{code} @unQualInScope@ returns a function that takes a @Name@ and tells whether @@ -521,19 +578,9 @@ combine_globals ns_old ns_new -- ns_new is often short add n ns | any (is_duplicate n) ns_old = map choose ns -- Eliminate duplicates | otherwise = n:ns where - choose n' | n==n' && better_provenance n n' = n - | otherwise = n' - --- Choose --- a local thing over an imported thing --- a user-imported thing over a non-user-imported thing --- an explicitly-imported thing over an implicitly imported thing -better_provenance n1 n2 - = case (getNameProvenance n1, getNameProvenance n2) of - (LocalDef _ _, _ ) -> True - (NonLocalDef (UserImport _ _ True) _, _ ) -> True - (NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True - other -> False + choose m | n==m && n `hasBetterProv` m = n + | otherwise = m + is_duplicate :: Name -> Name -> Bool is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False @@ -553,70 +600,52 @@ will still have different provenances. -\subsubsection{ExportAvails}% ================ - -\begin{code} -mkEmptyExportAvails :: ModuleName -> ExportAvails -mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM) - -mkExportAvails :: ModuleName -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails -mkExportAvails mod_name unqual_imp name_env avails - = (mod_avail_env, entity_avail_env) - where - mod_avail_env = unitFM mod_name unqual_avails - - -- unqual_avails is the Avails that are visible in *unqualfied* form - -- (1.4 Report, Section 5.1.1) - -- For example, in - -- import T hiding( f ) - -- we delete f from avails - - unqual_avails | not unqual_imp = [] -- Short cut when no unqualified imports - | otherwise = mapMaybe prune avails - - prune (Avail n) | unqual_in_scope n = Just (Avail n) - prune (Avail n) | otherwise = Nothing - prune (AvailTC n ns) | null uqs = Nothing - | otherwise = Just (AvailTC n uqs) - where - uqs = filter unqual_in_scope ns - - unqual_in_scope n = unQualInScope name_env n - - entity_avail_env = listToUFM [ (name,avail) | avail <- avails, - name <- availNames avail] - -plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails -plusExportAvails (m1, e1) (m2, e2) - = (plusFM_C (++) m1 m2, plusUFM_C plusAvail e1 e2) - -- ToDo: wasteful: we do this once for each constructor! -\end{code} - - \subsubsection{AvailInfo}% ================ \begin{code} plusAvail (Avail n1) (Avail n2) = Avail n1 -plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n1 (nub (ns1 ++ ns2)) +plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2)) -- Added SOF 4/97 #ifdef DEBUG plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2]) #endif +addAvail :: AvailEnv -> AvailInfo -> AvailEnv +addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail + +emptyAvailEnv = emptyNameEnv +unitAvailEnv :: AvailInfo -> AvailEnv +unitAvailEnv a = unitNameEnv (availName a) a + +plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv +plusAvailEnv = plusNameEnv_C plusAvail + +availEnvElts = nameEnvElts + addAvailToNameSet :: NameSet -> AvailInfo -> NameSet addAvailToNameSet names avail = addListToNameSet names (availNames avail) availsToNameSet :: [AvailInfo] -> NameSet availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails -availName :: AvailInfo -> Name +availName :: GenAvailInfo name -> name availName (Avail n) = n availName (AvailTC n _) = n -availNames :: AvailInfo -> [Name] +availNames :: GenAvailInfo name -> [name] availNames (Avail n) = [n] availNames (AvailTC n ns) = ns +addSysAvails :: AvailInfo -> [Name] -> AvailInfo +addSysAvails avail [] = avail +addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns) + +rdrAvailInfo :: AvailInfo -> RdrAvailInfo +-- Used when building the avails we are going to put in an interface file +-- We sort the components to reduce needless wobbling of interfaces +rdrAvailInfo (Avail n) = Avail (nameOccName n) +rdrAvailInfo (AvailTC n ns) = AvailTC (nameOccName n) (sortLt (<) (map nameOccName ns)) + filterAvail :: RdrNameIE -- Wanted -> AvailInfo -- Available -> Maybe AvailInfo -- Resulting available; @@ -652,20 +681,12 @@ filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail filterAvail ie avail = Nothing +pprAvail :: AvailInfo -> SDoc +pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of + [] -> empty + ns' -> parens (hsep (punctuate comma (map ppr ns'))) --- In interfaces, pprAvail gets given the OccName of the "host" thing -pprAvail avail = getPprStyle $ \ sty -> - if ifaceStyle sty then - ppr_avail (pprOccName . nameOccName) avail - else - ppr_avail ppr avail - -ppr_avail pp_name (AvailTC n ns) = hsep [ - pp_name n, - parens $ hsep $ punctuate comma $ - map pp_name ns - ] -ppr_avail pp_name (Avail n) = pp_name n +pprAvail (Avail n) = ppr n \end{code} @@ -713,8 +734,17 @@ mapFvRn f xs = mapRn f xs `thenRn` \ stuff -> \begin{code} -warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d () +warnUnusedModules :: [ModuleName] -> RnM d () +warnUnusedModules mods + | not opt_WarnUnusedImports = returnRn () + | otherwise = mapRn_ (addWarnRn . unused_mod) mods + where + unused_mod m = vcat [ptext SLIT("Module") <+> quotes (pprModuleName m) <+> + text "is imported, but nothing from it is used", + parens (ptext SLIT("except perhaps to re-export instances visible in") <+> + quotes (pprModuleName m))] +warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d () warnUnusedImports names | not opt_WarnUnusedImports = returnRn () -- Don't force names unless necessary