X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnEnv.lhs;h=9a7e56d9875f59d14387bd76543d147086b7c17d;hb=5a763550bf31ce446812d89f4967b601f122d344;hp=d4ff3036081541bf844b58a4fa2242cfbac303b7;hpb=d2cca44eae15bbbd3b86889448e796bc785dfa52;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index d4ff303..9a7e56d 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -10,26 +10,25 @@ module RnEnv where -- Export everything import HsSyn import RdrHsSyn ( RdrNameIE ) -import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, - mkRdrUnqual, qualifyRdrName +import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig, + mkRdrUnqual, mkRdrQual, qualifyRdrName, lookupRdrEnv, foldRdrEnv ) import HsTypes ( hsTyVarName, replaceTyVarName ) import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv, ImportReason(..), GlobalRdrEnv, AvailEnv, - AvailInfo, Avails, GenAvailInfo(..), RdrAvailInfo ) + AvailInfo, Avails, GenAvailInfo(..), NameSupply(..) ) import RnMonad import Name ( Name, NamedThing(..), getSrcLoc, - mkLocalName, mkImportedLocalName, mkGlobalName, - mkIPName, nameOccName, nameModule, - extendNameEnv_C, plusNameEnv_C, nameEnvElts, + mkLocalName, mkGlobalName, + mkIPName, nameOccName, nameModule_maybe, setNameModuleAndLoc ) +import Name ( extendNameEnv_C, plusNameEnv_C, nameEnvElts ) import NameSet import OccName ( OccName, occNameUserString, occNameFlavour ) -import Module ( ModuleName, moduleName, mkVanillaModule ) +import Module ( ModuleName, moduleName, mkVanillaModule, mkSysModuleNameFS, moduleNameFS ) import FiniteMap -import Unique ( Unique ) import UniqSupply import SrcLoc ( SrcLoc, noSrcLoc ) import Outputable @@ -38,6 +37,7 @@ import Util ( sortLt ) import List ( nub ) import PrelNames ( mkUnboundName ) import CmdLineOpts +import FastString ( FastString ) \end{code} %********************************************************* @@ -48,14 +48,30 @@ import CmdLineOpts \begin{code} newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d Name + -- newTopBinder puts into the cache the binder with the + -- module information set correctly. When the decl is later renamed, + -- the binding site will thereby get the correct module. + -- There maybe occurrences that don't have the correct Module, but + -- by the typechecker will propagate the binding definition to all + -- the occurrences, so that doesn't matter + newTopBinder mod rdr_name loc = -- First check the cache - traceRn (text "newTopBinder" <+> ppr mod <+> ppr loc) `thenRn_` + -- traceRn (text "newTopBinder" <+> ppr mod <+> ppr loc) `thenRn_` + + -- There should never be a qualified name in a binding position (except in instance decls) + -- The parser doesn't check this because the same parser parses instance decls + (if isQual rdr_name then + qualNameErr (text "its declaration") (rdr_name,loc) + else + returnRn () + ) `thenRn_` - getNameSupplyRn `thenRn` \ (us, cache, ipcache) -> + getNameSupplyRn `thenRn` \ name_supply -> let occ = rdrNameOcc rdr_name key = (moduleName mod, occ) + cache = nsNames name_supply in case lookupFM cache key of @@ -70,7 +86,7 @@ newTopBinder mod rdr_name loc new_name = setNameModuleAndLoc name mod loc new_cache = addToFM cache key new_name in - setNameSupplyRn (us, new_cache, ipcache) `thenRn_` + setNameSupplyRn (name_supply {nsNames = new_cache}) `thenRn_` traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_` returnRn new_name @@ -79,12 +95,12 @@ newTopBinder mod rdr_name loc -- Even for locally-defined names we use implicitImportProvenance; -- updateProvenances will set it to rights Nothing -> let - (us', us1) = splitUniqSupply us + (us', us1) = splitUniqSupply (nsUniqs name_supply) uniq = uniqFromSupply us1 new_name = mkGlobalName uniq mod occ loc new_cache = addToFM cache key new_name in - setNameSupplyRn (us', new_cache, ipcache) `thenRn_` + setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_` traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_` returnRn new_name @@ -108,32 +124,36 @@ newGlobalName :: ModuleName -> OccName -> RnM d Name -- (but since it affects DLL-ery it does matter that we get it right -- in the end). newGlobalName mod_name occ - = getNameSupplyRn `thenRn` \ (us, cache, ipcache) -> + = getNameSupplyRn `thenRn` \ name_supply -> let key = (mod_name, occ) + cache = nsNames name_supply in case lookupFM cache key of - Just name -> traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_` + Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_` returnRn name - Nothing -> setNameSupplyRn (us', new_cache, ipcache) `thenRn_` - traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_` + Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache}) `thenRn_` + -- traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_` returnRn name where - (us', us1) = splitUniqSupply us + (us', us1) = splitUniqSupply (nsUniqs name_supply) uniq = uniqFromSupply us1 mod = mkVanillaModule mod_name name = mkGlobalName uniq mod occ noSrcLoc new_cache = addToFM cache key name newIPName rdr_name - = getNameSupplyRn `thenRn` \ (us, cache, ipcache) -> + = getNameSupplyRn `thenRn` \ name_supply -> + let + ipcache = nsIPs name_supply + in case lookupFM ipcache key of Just name -> returnRn name - Nothing -> setNameSupplyRn (us', cache, new_ipcache) `thenRn_` + Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsIPs = new_ipcache}) `thenRn_` returnRn name where - (us', us1) = splitUniqSupply us + (us', us1) = splitUniqSupply (nsUniqs name_supply) uniq = uniqFromSupply us1 name = mkIPName uniq key new_ipcache = addToFM ipcache key name @@ -158,8 +178,7 @@ lookupBndrRn rdr_name lookupTopBndrRn rdr_name = getModeRn `thenRn` \ mode -> case mode of - InterfaceMode -> -- Look in the global name cache - lookupOrigName rdr_name + InterfaceMode -> lookupIfaceName rdr_name SourceMode -> -- Source mode, so look up a *qualified* version -- of the name, so that we get the right one even @@ -167,17 +186,7 @@ lookupTopBndrRn rdr_name -- There must *be* a binding getModuleRn `thenRn` \ mod -> getGlobalNameEnv `thenRn` \ global_env -> - case lookupRdrEnv global_env (qualifyRdrName (moduleName mod) rdr_name) of - Just ((name,_):rest) -> ASSERT( null rest ) - returnRn name - Nothing -> -- Almost always this case is a compiler bug. - -- But consider a type signature that doesn't have - -- a corresponding binder: - -- module M where { f :: Int->Int } - -- We use lookupSigOccRn, which uses lookupBndrRn (for good reasons) - -- and we don't want to panic. So we report an out-of-scope error - failWithRn (mkUnboundName rdr_name) - (unknownNameErr rdr_name) + lookupSrcName global_env (qualifyRdrName (moduleName mod) rdr_name) -- lookupSigOccRn is used for type signatures and pragmas -- Is this valid? @@ -204,27 +213,48 @@ lookupOccRn rdr_name -- environment. It's used only for -- record field names -- class op names in class and instance decls + lookupGlobalOccRn rdr_name - = getModeRn `thenRn` \ mode -> - case mode of { - -- When processing interface files, the global env - -- is always empty, so go straight to the name cache - InterfaceMode -> lookupOrigName rdr_name ; - - SourceMode -> - - getGlobalNameEnv `thenRn` \ global_env -> - case lookupRdrEnv global_env rdr_name of - Just [(name,_)] -> returnRn name - Just stuff@((name,_):_) - -> addNameClashErrRn rdr_name stuff `thenRn_` - returnRn name - Nothing -> -- Not found when processing source code; so fail - failWithRn (mkUnboundName rdr_name) - (unknownNameErr rdr_name) - } + = getModeRn `thenRn` \ mode -> + case mode of + SourceMode -> getGlobalNameEnv `thenRn` \ global_env -> + lookupSrcName global_env rdr_name + + InterfaceMode -> lookupIfaceName rdr_name + +lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name +-- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad +lookupSrcName global_env rdr_name + | isOrig rdr_name -- Can occur in source code too + = lookupOrigName rdr_name + + | otherwise + = case lookupRdrEnv global_env rdr_name of + Just [(name,_)] -> returnRn name + Just stuff@((name,_):_) -> addNameClashErrRn rdr_name stuff `thenRn_` + returnRn name + Nothing -> failWithRn (mkUnboundName rdr_name) + (unknownNameErr rdr_name) + +lookupOrigName :: RdrName -> RnM d Name +lookupOrigName rdr_name + = ASSERT( isOrig rdr_name ) + newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name) + +lookupIfaceUnqual :: RdrName -> RnM d Name +lookupIfaceUnqual rdr_name + = ASSERT( isUnqual rdr_name ) + -- An Unqual is allowed; interface files contain + -- unqualified names for locally-defined things, such as + -- constructors of a data type. + getModuleRn `thenRn ` \ mod -> + newGlobalName (moduleName mod) (rdrNameOcc rdr_name) + +lookupIfaceName :: RdrName -> RnM d Name +lookupIfaceName rdr_name + | isUnqual rdr_name = lookupIfaceUnqual rdr_name + | otherwise = lookupOrigName rdr_name \end{code} -% @lookupOrigName@ takes an RdrName representing an {\em original} name, and adds it to the occurrence pool so that it'll be loaded @@ -240,24 +270,8 @@ calls it at all I think). \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}} -For List and Tuple types it's important to get the correct -@isLocallyDefined@ flag, which is used in turn when deciding -whether there are any instance decls in this module are ``special''. -The name cache should have the correct provenance, though. \begin{code} -lookupOrigName :: RdrName -> RnM d Name -lookupOrigName rdr_name - | isQual rdr_name - = newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name) - - | otherwise - = -- An Unqual is allowed; interface files contain - -- unqualified names for locally-defined things, such as - -- constructors of a data type. - getModuleRn `thenRn ` \ mod -> - newGlobalName (moduleName mod) (rdrNameOcc rdr_name) - lookupOrigNames :: [RdrName] -> RnM d NameSet lookupOrigNames rdr_names = mapRn lookupOrigName rdr_names `thenRn` \ names -> @@ -286,20 +300,19 @@ lookupSysBinder rdr_name %********************************************************* \begin{code} -newLocalsRn :: (Unique -> OccName -> SrcLoc -> Name) - -> [(RdrName,SrcLoc)] +newLocalsRn :: [(RdrName,SrcLoc)] -> RnMS [Name] -newLocalsRn mk_name rdr_names_w_loc - = getNameSupplyRn `thenRn` \ (us, cache, ipcache) -> +newLocalsRn rdr_names_w_loc + = getNameSupplyRn `thenRn` \ name_supply -> let n = length rdr_names_w_loc - (us', us1) = splitUniqSupply us + (us', us1) = splitUniqSupply (nsUniqs name_supply) uniqs = uniqsFromSupply n us1 - names = [ mk_name uniq (rdrNameOcc rdr_name) loc + names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs ] in - setNameSupplyRn (us', cache, ipcache) `thenRn_` + setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_` returnRn names @@ -314,7 +327,7 @@ bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope -- Check for duplicate names checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_` - doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow -> + doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow -> -- Warn about shadowing, but only in source modules (case mode of @@ -322,14 +335,7 @@ bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope other -> returnRn () ) `thenRn_` - let - mk_name = case mode of - SourceMode -> mkLocalName - InterfaceMode -> mkImportedLocalName - -- Keep track of whether the name originally came from - -- an interface file. - in - newLocalsRn mk_name rdr_names_w_loc `thenRn` \ names -> + newLocalsRn rdr_names_w_loc `thenRn` \ names -> let new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names) in @@ -342,34 +348,32 @@ bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope Just name -> pushSrcLocRn loc $ addWarnRn (shadowedNameWarn rdr_name) -bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars)) - -> RnMS (a, FreeVars) +bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a -- A specialised variant when renaming stuff from interface -- files (of which there is a lot) -- * one at a time -- * no checks for shadowing -- * always imported -- * deal with free vars -bindCoreLocalFVRn rdr_name enclosed_scope +bindCoreLocalRn rdr_name enclosed_scope = getSrcLocRn `thenRn` \ loc -> getLocalNameEnv `thenRn` \ name_env -> - getNameSupplyRn `thenRn` \ (us, cache, ipcache) -> + getNameSupplyRn `thenRn` \ name_supply -> let - (us', us1) = splitUniqSupply us + (us', us1) = splitUniqSupply (nsUniqs name_supply) uniq = uniqFromSupply us1 - name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc + name = mkLocalName uniq (rdrNameOcc rdr_name) loc in - setNameSupplyRn (us', cache, ipcache) `thenRn_` + setNameSupplyRn (name_supply {nsUniqs = us'}) `thenRn_` let new_name_env = extendRdrEnv name_env rdr_name name in - setLocalNameEnv new_name_env (enclosed_scope name) `thenRn` \ (result, fvs) -> - returnRn (result, delFromNameSet fvs name) + setLocalNameEnv new_name_env (enclosed_scope name) -bindCoreLocalsFVRn [] thing_inside = thing_inside [] -bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' -> - bindCoreLocalsFVRn bs $ \ names' -> - thing_inside (name':names') +bindCoreLocalsRn [] thing_inside = thing_inside [] +bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b $ \ name' -> + bindCoreLocalsRn bs $ \ names' -> + thing_inside (name':names') bindLocalNames names enclosed_scope = getLocalNameEnv `thenRn` \ name_env -> @@ -378,6 +382,12 @@ bindLocalNames names enclosed_scope where pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names] +bindLocalNamesFV names enclosed_scope + = bindLocalNames names $ + enclosed_scope `thenRn` \ (thing, fvs) -> + returnRn (thing, delListFromNameSet fvs names) + + ------------------------------------- bindLocalRn doc rdr_name enclosed_scope = getSrcLocRn `thenRn` \ loc -> @@ -399,12 +409,8 @@ bindLocalsFVRn doc rdr_names enclosed_scope returnRn (thing, delListFromNameSet fvs names) ------------------------------------- -bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars) -bindUVarRn = bindLocalRn - -------------------------------------- extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars) - -- This tiresome function is used only in rnDecl on InstDecl + -- This tiresome function is used only in rnSourceDecl on InstDecl extendTyVarEnvFVRn tyvars enclosed_scope = bindLocalNames tyvars enclosed_scope `thenRn` \ (thing, fvs) -> returnRn (thing, delListFromNameSet fvs tyvars) @@ -468,7 +474,7 @@ checkDupOrQualNames doc_str rdr_names_w_loc mapRn_ (qualNameErr doc_str) quals `thenRn_` checkDupNames doc_str rdr_names_w_loc where - quals = filter (isQual.fst) rdr_names_w_loc + quals = filter (isQual . fst) rdr_names_w_loc checkDupNames doc_str rdr_names_w_loc = -- Check for duplicated names in a binding group @@ -485,6 +491,56 @@ checkDupNames doc_str rdr_names_w_loc %************************************************************************ \begin{code} +mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change) + -> Bool -- True <=> want unqualified import + -> [AvailInfo] -- What's to be hidden (but only the unqualified + -- version is hidden) + -> (Name -> Provenance) + -> Avails -- Whats imported and how + -> GlobalRdrEnv + +mkGlobalRdrEnv this_mod unqual_imp hides mk_provenance avails + = gbl_env2 + where + -- Make the name environment. We're talking about a + -- single module here, so there must be no name clashes. + -- In practice there only ever will be if it's the module + -- being compiled. + + -- Add the things that are available + gbl_env1 = foldl add_avail emptyRdrEnv avails + + -- Delete things that are hidden + gbl_env2 = foldl del_avail gbl_env1 hides + + add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv + add_avail env avail = foldl add_name env (availNames avail) + + add_name env name + | unqual_imp = env2 + | otherwise = env1 + where + env1 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) (name,prov) + env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) (name,prov) + occ = nameOccName name + prov = mk_provenance name + + del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names + where + rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail) + +mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv +-- Used to construct a GlobalRdrEnv for an interface that we've +-- read from a .hi file. We can't construct the original top-level +-- environment because we don't have enough info, but we compromise +-- by making an environment from its exports +mkIfaceGlobalRdrEnv m_avails + = foldl add emptyRdrEnv m_avails + where + add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True [] (\n -> LocalDef) avails) +\end{code} + +\begin{code} plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv plusGlobalRdrEnv env1 env2 = plusFM_C combine_globals env1 env2 @@ -534,11 +590,12 @@ in error messages. \begin{code} unQualInScope :: GlobalRdrEnv -> Name -> Bool unQualInScope env - = lookup + = (`elemNameSet` unqual_names) where - lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of - Just [(name',_)] -> name == name' - other -> False + unqual_names :: NameSet + unqual_names = foldRdrEnv add emptyNameSet env + add rdr_name [(name,_)] unquals | isUnqual rdr_name = addOneToNameSet unquals name + add _ _ unquals = unquals \end{code} @@ -553,7 +610,7 @@ plusAvail (Avail n1) (Avail n2) = Avail n1 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]) +plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2]) #endif addAvail :: AvailEnv -> AvailInfo -> AvailEnv @@ -583,18 +640,6 @@ 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; @@ -631,26 +676,42 @@ filterAvail (IEThingAll _) avail@(AvailTC _ _) = Just avail filterAvail ie avail = Nothing ------------------------------------- -sortAvails :: Avails -> Avails -sortAvails avails = sortLt lt avails +groupAvails :: Module -> Avails -> [(ModuleName, Avails)] + -- Group by module and sort by occurrence + -- This keeps the list in canonical order +groupAvails this_mod avails + = [ (mkSysModuleNameFS fs, sortLt lt avails) + | (fs,avails) <- fmToList groupFM + ] where - a1 `lt` a2 = mod1 < mod2 || - (mod1 == mod2 && occ1 < occ2) - where - name1 = availName a1 - name2 = availName a2 - mod1 = nameModule name1 - mod2 = nameModule name2 - occ1 = nameOccName name1 - occ2 = nameOccName name2 - -------------------------------------- -pprAvail :: AvailInfo -> SDoc -pprAvail (AvailTC n ns) = ppr n <> case filter (/= n) ns of - [] -> empty - ns' -> parens (hsep (punctuate comma (map ppr ns'))) + groupFM :: FiniteMap FastString Avails + -- Deliberately use the FastString so we + -- get a canonical ordering + groupFM = foldl add emptyFM avails -pprAvail (Avail n) = ppr n + add env avail = addToFM_C combine env mod_fs [avail'] + where + mod_fs = moduleNameFS (moduleName avail_mod) + avail_mod = case nameModule_maybe (availName avail) of + Just m -> m + Nothing -> this_mod + combine old _ = avail':old + avail' = sortAvail avail + + a1 `lt` a2 = occ1 < occ2 + where + occ1 = nameOccName (availName a1) + occ2 = nameOccName (availName a2) + +sortAvail :: AvailInfo -> AvailInfo +-- Sort the sub-names into canonical order. +-- The canonical order has the "main name" at the beginning +-- (if it's there at all) +sortAvail (Avail n) = Avail n +sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns)) + | otherwise = AvailTC n ( sortLt lt ns) + where + n1 `lt` n2 = nameOccName n1 < nameOccName n2 \end{code} @@ -661,25 +722,6 @@ pprAvail (Avail n) = ppr n %************************************************************************ \begin{code} -type FreeVars = NameSet - -plusFV :: FreeVars -> FreeVars -> FreeVars -addOneFV :: FreeVars -> Name -> FreeVars -unitFV :: Name -> FreeVars -emptyFVs :: FreeVars -plusFVs :: [FreeVars] -> FreeVars -mkFVs :: [Name] -> FreeVars - -isEmptyFVs = isEmptyNameSet -emptyFVs = emptyNameSet -plusFVs = unionManyNameSets -plusFV = unionNameSets -mkFVs = mkNameSet - --- No point in adding implicitly imported names to the free-var set -addOneFV s n = addOneToNameSet s n -unitFV n = unitNameSet n - -- A useful utility mapFvRn f xs = mapRn f xs `thenRn` \ stuff -> let @@ -751,7 +793,7 @@ warnUnusedGroup names = case prov1 of LocalDef -> (True, getSrcLoc name1, text "Defined but not used") - NonLocalDef (UserImport mod loc _) _ + NonLocalDef (UserImport mod loc _) -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used") reportable (name,_) = case occNameUserString (nameOccName name) of