X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnEnv.lhs;h=da3ed88df1da2d0cd8935aaefb658931721883bd;hb=9066f9344a5fc1f2968671364466b8d89671b337;hp=6ff21b0dbdbfbea3624afed573cb1910a06e7fad;hpb=d7296ca17db960b28846969d42da325eef294a71;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 6ff21b0..da3ed88 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -10,23 +10,25 @@ module RnEnv where -- Export everything import {-# SOURCE #-} RnHiFiles -import HscTypes ( ModIface(..) ) import HsSyn -import RdrHsSyn ( RdrNameIE ) +import RdrHsSyn ( RdrNameIE, RdrNameHsType, extractHsTyRdrTyVars ) import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig, - mkRdrUnqual, mkRdrQual, qualifyRdrName, lookupRdrEnv, foldRdrEnv + mkRdrUnqual, mkRdrQual, + lookupRdrEnv, foldRdrEnv, rdrEnvToList, elemRdrEnv, + unqualifyRdrName ) import HsTypes ( hsTyVarName, replaceTyVarName ) import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv, ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), AvailEnv, AvailInfo, Avails, GenAvailInfo(..), NameSupply(..), + ModIface(..), Deprecations(..), lookupDeprec, extendLocalRdrEnv ) import RnMonad -import Name ( Name, - getSrcLoc, - mkLocalName, mkGlobalName, +import Name ( Name, + getSrcLoc, nameIsLocalOrFrom, + mkLocalName, mkGlobalName, nameModule, mkIPName, nameOccName, nameModule_maybe, setNameModuleAndLoc ) @@ -35,14 +37,13 @@ import NameSet import OccName ( OccName, occNameUserString, occNameFlavour ) import Module ( ModuleName, moduleName, mkVanillaModule, mkSysModuleNameFS, moduleNameFS, WhereFrom(..) ) -import PrelNames ( mkUnboundName, syntaxList, SyntaxMap, vanillaSyntaxMap, +import PrelNames ( mkUnboundName, derivingOccurrences, mAIN_Name, pREL_MAIN_Name, - ioTyConName, integerTyConName, doubleTyConName, intTyConName, + ioTyConName, intTyConName, boolTyConName, funTyConName, unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name, eqStringName, printName, - hasKey, fractionalClassKey, numClassKey, bindIOName, returnIOName, failIOName ) import TysWiredIn ( unitTyCon ) -- A little odd @@ -52,9 +53,10 @@ import SrcLoc ( SrcLoc, noSrcLoc ) import Outputable import ListSetOps ( removeDups, equivClasses ) import Util ( sortLt ) +import BasicTypes ( mapIPName ) import List ( nub ) import UniqFM ( lookupWithDefaultUFM ) -import Maybes ( orElse ) +import Maybe ( mapMaybe ) import CmdLineOpts import FastString ( FastString ) \end{code} @@ -80,7 +82,7 @@ newTopBinder mod rdr_name loc -- 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) + qualNameErr (text "In its declaration") (rdr_name,loc) else returnRn () ) `thenRn_` @@ -161,21 +163,24 @@ newGlobalName mod_name occ name = mkGlobalName uniq mod occ noSrcLoc new_cache = addToFM cache key name -newIPName rdr_name +newIPName rdr_name_ip = getNameSupplyRn `thenRn` \ name_supply -> let ipcache = nsIPs name_supply in case lookupFM ipcache key of - Just name -> returnRn name - Nothing -> setNameSupplyRn (name_supply {nsUniqs = us', nsIPs = new_ipcache}) `thenRn_` - returnRn name + Just name_ip -> returnRn name_ip + Nothing -> setNameSupplyRn new_ns `thenRn_` + returnRn name_ip where (us', us1) = splitUniqSupply (nsUniqs name_supply) uniq = uniqFromSupply us1 - name = mkIPName uniq key - new_ipcache = addToFM ipcache key name - where key = (rdrNameOcc rdr_name) + name_ip = mapIPName mk_name rdr_name_ip + mk_name rdr_name = mkIPName uniq (rdrNameOcc rdr_name) + new_ipcache = addToFM ipcache key name_ip + new_ns = name_supply {nsUniqs = us', nsIPs = new_ipcache} + where + key = rdr_name_ip -- Ensures that ?x and %x get distinct Names \end{code} %********************************************************* @@ -194,16 +199,38 @@ lookupBndrRn rdr_name Nothing -> lookupTopBndrRn rdr_name lookupTopBndrRn rdr_name +-- Look up a top-level local binder. We may be looking up an unqualified 'f', +-- and there may be several imported 'f's too, which must not confuse us. +-- So we have to filter out the non-local ones. +-- A separate function (importsFromLocalDecls) reports duplicate top level +-- decls, so here it's safe just to choose an arbitrary one. + + | isOrig rdr_name + -- This is here just to catch the PrelBase defn of (say) [] and similar + -- The parser reads the special syntax and returns an Orig RdrName + -- But the global_env contains only Qual RdrNames, so we won't + -- find it there; instead just get the name via the Orig route + = lookupOrigName rdr_name + + | otherwise = getModeRn `thenRn` \ mode -> if isInterfaceMode mode then lookupIfaceName rdr_name - else -- Source mode, so look up a *qualified* version - -- of the name, so that we get the right one even - -- if there are many with the same occ name - -- There must *be* a binding - getModuleRn `thenRn` \ mod -> - getGlobalNameEnv `thenRn` \ global_env -> - lookupSrcName global_env (qualifyRdrName (moduleName mod) rdr_name) + else + getModuleRn `thenRn` \ mod -> + getGlobalNameEnv `thenRn` \ global_env -> + case lookup_local mod global_env rdr_name of + Just name -> returnRn name + Nothing -> failWithRn (mkUnboundName rdr_name) + (unknownNameErr rdr_name) + where + lookup_local mod global_env rdr_name + = case lookupRdrEnv global_env rdr_name of + Nothing -> Nothing + Just gres -> case [n | GRE n _ _ <- gres, nameIsLocalOrFrom mod n] of + [] -> Nothing + (n:ns) -> Just n + -- lookupSigOccRn is used for type signatures and pragmas -- Is this valid? @@ -218,6 +245,33 @@ lookupTopBndrRn rdr_name lookupSigOccRn :: RdrName -> RnMS Name lookupSigOccRn = lookupBndrRn +-- lookupInstDeclBndr is used for the binders in an +-- instance declaration. Here we use the class name to +-- disambiguate. + +lookupInstDeclBndr :: Name -> RdrName -> RnMS Name + -- We use the selector name as the binder +lookupInstDeclBndr cls_name rdr_name + | isOrig rdr_name -- Occurs in derived instances, where we just + -- refer diectly to the right method + = lookupOrigName rdr_name + + | otherwise + = getGlobalAvails `thenRn` \ avail_env -> + case lookupNameEnv avail_env cls_name of + -- The class itself isn't in scope, so cls_name is unboundName + -- e.g. import Prelude hiding( Ord ) + -- instance Ord T where ... + -- The program is wrong, but that should not cause a crash. + Nothing -> returnRn (mkUnboundName rdr_name) + Just (AvailTC _ ns) -> case [n | n <- ns, nameOccName n == occ] of + (n:ns)-> ASSERT( null ns ) returnRn n + [] -> failWithRn (mkUnboundName rdr_name) + (unknownNameErr rdr_name) + other -> pprPanic "lookupInstDeclBndr" (ppr cls_name) + where + occ = rdrNameOcc rdr_name + -- lookupOccRn looks up an occurrence of a RdrName lookupOccRn :: RdrName -> RnMS Name lookupOccRn rdr_name @@ -266,7 +320,7 @@ lookupQualifiedName rdr_name mod = rdrNameModule rdr_name occ = rdrNameOcc rdr_name in - loadInterface (ppr rdr_name) mod ImportBySystem `thenRn` \ iface -> + loadInterface (ppr rdr_name) mod ImportByUser `thenRn` \ iface -> case [ name | (_,avails) <- mi_exports iface, avail <- avails, name <- availNames avail, @@ -370,8 +424,12 @@ getImplicitModuleFVs mod_name decls -- Compiling a module || mod_name == pREL_MAIN_Name = unitFV ioTyConName | otherwise = emptyFVs + -- deriv_classes is now a list of HsTypes, so a "normal" one + -- appears as a (HsClassP c []). The non-normal ones for the new + -- newtype-deriving extension, and they don't require any + -- implicit names, so we can silently filter them out. deriv_occs = [occ | TyClD (TyData {tcdDerivs = Just deriv_classes}) <- decls, - cls <- deriv_classes, + HsClassP cls [] <- deriv_classes, occ <- lookupWithDefaultUFM derivingOccurrences [] cls ] -- ubiquitous_names are loaded regardless, because @@ -388,53 +446,47 @@ ubiquitousNames -- free var at every function application!) \end{code} -\begin{code} -implicitGates :: Name -> FreeVars --- If we load class Num, add Integer to the gates --- This takes account of the fact that Integer might be needed for --- defaulting, but we don't want to load Integer (and all its baggage) --- if there's no numeric stuff needed. --- Similarly for class Fractional and Double --- --- NB: If we load (say) Floating, we'll end up loading Fractional too, --- since Fractional is a superclass of Floating -implicitGates cls | cls `hasKey` numClassKey = unitFV integerTyConName - | cls `hasKey` fractionalClassKey = unitFV doubleTyConName - | otherwise = emptyFVs -\end{code} +%************************************************************************ +%* * +\subsection{Re-bindable desugaring names} +%* * +%************************************************************************ -\begin{code} -rnSyntaxNames :: GlobalRdrEnv -> FreeVars -> RnMG (FreeVars, SyntaxMap) --- Look up the re-bindable syntactic sugar names --- Any errors arising from these lookups may surprise the --- programmer, since they aren't explicitly mentioned, and --- the src line will be unhelpful (ToDo) +Haskell 98 says that when you say "3" you get the "fromInteger" from the +Standard Prelude, regardless of what is in scope. However, to experiment +with having a language that is less coupled to the standard prelude, we're +trying a non-standard extension that instead gives you whatever "Prelude.fromInteger" +happens to be in scope. Then you can + import Prelude () + import MyPrelude as Prelude +to get the desired effect. + +At the moment this just happens for + * fromInteger, fromRational on literals (in expressions and patterns) + * negate (in expressions) + * minus (arising from n+k patterns) + +We store the relevant Name in the HsSyn tree, in + * HsIntegral/HsFractional + * NegApp + * NPlusKPatIn +respectively. Initially, we just store the "standard" name (PrelNames.fromIntegralName, +fromRationalName etc), but the renamer changes this to the appropriate user +name if Opt_NoImplicitPrelude is on. That is what lookupSyntaxName does. -rnSyntaxNames gbl_env source_fvs +\begin{code} +lookupSyntaxName :: Name -- The standard name + -> RnMS Name -- Possibly a non-standard name +lookupSyntaxName std_name = doptRn Opt_NoImplicitPrelude `thenRn` \ no_prelude -> if not no_prelude then - returnRn (source_fvs, vanillaSyntaxMap) + returnRn std_name -- Normal case else - - -- There's a -fno-implicit-prelude flag, - -- so build the re-mapping function let - reqd_syntax_list = filter is_reqd syntaxList - is_reqd (n,_) = n `elemNameSet` source_fvs - lookup (n,rn) = lookupSrcName gbl_env rn `thenRn` \ rn' -> - returnRn (n,rn') + rdr_name = mkRdrUnqual (nameOccName std_name) + -- Get the similarly named thing from the local environment in - mapRn lookup reqd_syntax_list `thenRn` \ rn_syntax_list -> - let - -- Delete the proxies and add the actuals - proxies = map fst rn_syntax_list - actuals = map snd rn_syntax_list - new_source_fvs = (proxies `delFVs` source_fvs) `plusFV` mkFVs actuals - - syntax_env = mkNameEnv rn_syntax_list - syntax_map n = lookupNameEnv syntax_env n `orElse` n - in - returnRn (new_source_fvs, syntax_map) + lookupOccRn rdr_name \end{code} @@ -450,9 +502,8 @@ newLocalsRn :: [(RdrName,SrcLoc)] newLocalsRn rdr_names_w_loc = getNameSupplyRn `thenRn` \ name_supply -> let - n = length rdr_names_w_loc (us', us1) = splitUniqSupply (nsUniqs name_supply) - uniqs = uniqsFromSupply n us1 + uniqs = uniqsFromSupply us1 names = [ mkLocalName uniq (rdrNameOcc rdr_name) loc | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs ] @@ -467,32 +518,34 @@ bindLocatedLocalsRn :: SDoc -- Documentation string for error message -> RnMS a bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope = getModeRn `thenRn` \ mode -> - getLocalNameEnv `thenRn` \ name_env -> + getLocalNameEnv `thenRn` \ local_env -> + getGlobalNameEnv `thenRn` \ global_env -> -- Check for duplicate names checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_` - doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow -> - -- Warn about shadowing, but only in source modules + let + check_shadow (rdr_name,loc) + | rdr_name `elemRdrEnv` local_env + || rdr_name `elemRdrEnv` global_env + = pushSrcLocRn loc $ addWarnRn (shadowedNameWarn rdr_name) + | otherwise + = returnRn () + in + (case mode of - SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc - other -> returnRn () + SourceMode -> ifOptRn Opt_WarnNameShadowing $ + mapRn_ check_shadow rdr_names_w_loc + other -> returnRn () ) `thenRn_` - + newLocalsRn rdr_names_w_loc `thenRn` \ names -> let - new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names) + new_local_env = addListToRdrEnv local_env (map fst rdr_names_w_loc `zip` names) in setLocalNameEnv new_local_env (enclosed_scope names) - where - check_shadow name_env (rdr_name,loc) - = case lookupRdrEnv name_env rdr_name of - Nothing -> returnRn () - Just name -> pushSrcLocRn loc $ - addWarnRn (shadowedNameWarn rdr_name) - bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a -- A specialised variant when renaming stuff from interface -- files (of which there is a lot) @@ -562,47 +615,36 @@ 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 -> [HsTyVarBndr RdrName] - -> ([Name] -> [HsTyVarBndr Name] -> RnMS a) - -> RnMS a -bindTyVars2Rn doc_str tyvar_names enclosed_scope = getSrcLocRn `thenRn` \ loc -> let 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 -> [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) + enclosed_scope (zipWith replaceTyVarName tyvar_names names) -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 -> - enclosed_scope names tyvars `thenRn` \ (thing, fvs) -> - returnRn (thing, delListFromNameSet fvs names) +bindPatSigTyVars :: [RdrNameHsType] + -> RnMS (a, FreeVars) + -> RnMS (a, FreeVars) + -- Find the type variables in the pattern type + -- signatures that must be brought into scope -bindNakedTyVarsFVRn :: SDoc -> [RdrName] - -> ([Name] -> RnMS (a, FreeVars)) - -> RnMS (a, FreeVars) -bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope - = getSrcLocRn `thenRn` \ loc -> +bindPatSigTyVars tys enclosed_scope + = getLocalNameEnv `thenRn` \ name_env -> + getSrcLocRn `thenRn` \ loc -> let - located_tyvars = [(tv, loc) | tv <- tyvar_names] + forall_tyvars = nub [ tv | ty <- tys, + tv <- extractHsTyRdrTyVars ty, + not (tv `elemFM` name_env) + ] + -- The 'nub' is important. For example: + -- f (x :: t) (y :: t) = .... + -- We don't want to complain about binding t twice! + + located_tyvars = [(tv, loc) | tv <- forall_tyvars] + doc_sig = text "In a pattern type-signature" in - bindLocatedLocalsRn doc_str located_tyvars $ \ names -> - enclosed_scope names `thenRn` \ (thing, fvs) -> + bindLocatedLocalsRn doc_sig located_tyvars $ \ names -> + enclosed_scope `thenRn` \ (thing, fvs) -> returnRn (thing, delListFromNameSet fvs names) @@ -636,16 +678,12 @@ 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 - -> Bool -- True <=> want qualified import - -> [AvailInfo] -- What's to be hidden (but only the unqualified - -- version is hidden) -> (Name -> Provenance) - -> Avails -- Whats imported and how + -> Avails -- Whats imported -> Deprecations -> GlobalRdrEnv -mkGlobalRdrEnv this_mod unqual_imp qual_imp hides - mk_provenance avails deprecs +mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails deprecs = gbl_env2 where -- Make the name environment. We're talking about a @@ -653,31 +691,33 @@ mkGlobalRdrEnv this_mod unqual_imp qual_imp hides -- In practice there only ever will be if it's the module -- being compiled. - -- Add the things that are available + -- Add qualified names for the things that are available + -- (Qualified names are always imported) gbl_env1 = foldl add_avail emptyRdrEnv avails - -- Delete things that are hidden - gbl_env2 = foldl del_avail gbl_env1 hides + -- Add unqualified names + gbl_env2 | unqual_imp = foldl add_unqual gbl_env1 (rdrEnvToList gbl_env1) + | otherwise = gbl_env1 + + add_unqual env (qual_name, elts) + = foldl add_one env elts + where + add_one env elt = addOneToGlobalRdrEnv env unqual_name elt + unqual_name = unqualifyRdrName qual_name + -- The qualified import should only have added one + -- binding for each qualified name! But if there's an error in + -- the module (multiple bindings for the same name) we may get + -- duplicates. So the simple thing is to do the fold. add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv add_avail env avail = foldl add_name env (availNames avail) - add_name env name - | qual_imp && unqual_imp = env3 - | unqual_imp = env2 - | qual_imp = env1 - | otherwise = env + add_name env name -- Add qualified name only + = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt where - env1 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt - env2 = addOneToGlobalRdrEnv env (mkRdrUnqual occ) elt - env3 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) elt occ = nameOccName name elt = GRE name (mk_provenance name) (lookupDeprec deprecs 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 @@ -686,7 +726,7 @@ mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv mkIfaceGlobalRdrEnv m_avails = foldl add emptyRdrEnv m_avails where - add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True False [] + add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True (\n -> LocalDef) avails NoDeprecs) -- The NoDeprecs is a bit of a hack I suppose \end{code} @@ -740,8 +780,12 @@ in error messages. \begin{code} unQualInScope :: GlobalRdrEnv -> Name -> Bool --- True if 'f' is in scope, and has only one binding +-- True if 'f' is in scope, and has only one binding, +-- and the thing it is bound to is the name we are looking for -- (i.e. false if A.f and B.f are both in scope as unqualified 'f') +-- +-- This fn is only efficient if the shared +-- partial application is used a lot. unQualInScope env = (`elemNameSet` unqual_names) where @@ -769,7 +813,6 @@ plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2]) 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 @@ -867,6 +910,21 @@ sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) n1 `lt` n2 = nameOccName n1 < nameOccName n2 \end{code} +\begin{code} +pruneAvails :: (Name -> Bool) -- Keep if this is True + -> [AvailInfo] + -> [AvailInfo] +pruneAvails keep avails + = mapMaybe del avails + where + del :: AvailInfo -> Maybe AvailInfo -- Nothing => nothing left! + del (Avail n) | keep n = Just (Avail n) + | otherwise = Nothing + del (AvailTC n ns) | null ns' = Nothing + | otherwise = Just (AvailTC n ns') + where + ns' = filter keep ns +\end{code} %************************************************************************ %* * @@ -893,9 +951,7 @@ mapFvRn f xs = mapRn f xs `thenRn` \ stuff -> \begin{code} warnUnusedModules :: [ModuleName] -> RnM d () warnUnusedModules mods - = doptRn Opt_WarnUnusedImports `thenRn` \ warn -> - if warn then mapRn_ (addWarnRn . unused_mod) mods - else returnRn () + = ifOptRn Opt_WarnUnusedImports (mapRn_ (addWarnRn . unused_mod) mods) where unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+> text "is imported, but nothing from it is used", @@ -904,19 +960,14 @@ warnUnusedModules mods warnUnusedImports :: [(Name,Provenance)] -> RnM d () warnUnusedImports names - = doptRn Opt_WarnUnusedImports `thenRn` \ warn -> - if warn then warnUnusedBinds names else returnRn () + = ifOptRn Opt_WarnUnusedImports (warnUnusedBinds names) warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d () warnUnusedLocalBinds names - = doptRn Opt_WarnUnusedBinds `thenRn` \ warn -> - if warn then warnUnusedBinds [(n,LocalDef) | n<-names] - else returnRn () + = ifOptRn Opt_WarnUnusedBinds (warnUnusedBinds [(n,LocalDef) | n<-names]) warnUnusedMatches names - = doptRn Opt_WarnUnusedMatches `thenRn` \ warn -> - if warn then warnUnusedGroup [(n,LocalDef) | n<-names] - else returnRn () + = ifOptRn Opt_WarnUnusedMatches (warnUnusedGroup [(n,LocalDef) | n<-names]) ------------------------- @@ -977,22 +1028,20 @@ unknownNameErr name qualNameErr descriptor (name,loc) = pushSrcLocRn loc $ - addErrRn (hsep [ ptext SLIT("Invalid use of qualified name"), - quotes (ppr name), - ptext SLIT("in"), + addErrRn (vcat [ ptext SLIT("Invalid use of qualified name") <+> quotes (ppr name), descriptor]) dupNamesErr descriptor ((name,loc) : dup_things) = pushSrcLocRn loc $ addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name)) $$ - (ptext SLIT("in") <+> descriptor)) + descriptor) warnDeprec :: Name -> DeprecTxt -> RnM d () warnDeprec name txt - = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs -> - if not warn_drs then returnRn () else + = ifOptRn Opt_WarnDeprecations $ addWarnRn (sep [ text (occNameFlavour (nameOccName name)) <+> quotes (ppr name) <+> text "is deprecated:", nest 4 (ppr txt) ]) \end{code} +