X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=803744957f28a0367961a5fab78cb497be3c4e89;hb=623e6139a5a3834bb1eb0582763c464549f7b918;hp=1052db68480412999232a51b8aae25de6a230e1b;hpb=651dd121a65827884eea23605026d16e26d4301c;p=ghc-hetmet.git diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 1052db6..8037449 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -38,8 +38,8 @@ import FastString import ListSetOps import Data.List ( partition, (\\), delete ) import qualified Data.Set as Set -import IO ( openFile, IOMode(..) ) -import Monad ( when, mplus ) +import System.IO +import Control.Monad \end{code} @@ -893,6 +893,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod | otherwise = do { implicit_prelude <- doptM Opt_ImplicitPrelude + ; warnDodgyExports <- doptM Opt_WarnDodgyExports ; let { exportValid = (mod `elem` imported_modules) || (moduleName this_mod == mod) ; gres = filter (isModuleExported implicit_prelude mod) @@ -901,7 +902,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod } ; checkErr exportValid (moduleNotImported mod) - ; warnIf (exportValid && null gres) (nullModuleExport mod) + ; warnIf (warnDodgyExports && exportValid && null gres) (nullModuleExport mod) ; addUsedRdrNames (concat [ [mkRdrQual mod occ, mkRdrUnqual occ] | occ <- map nameOccName names ]) @@ -955,12 +956,14 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod Nothing -> mkRdrUnqual Just (modName, _) -> mkRdrQual modName addUsedRdrNames $ map (mkKidRdrName . nameOccName) kids - when (null kids) - (if (isTyConName name) then addWarn (dodgyExportWarn name) - -- This occurs when you export T(..), but - -- only import T abstractly, or T is a synonym. - else addErr (exportItemErr ie)) - + warnDodgyExports <- doptM Opt_WarnDodgyExports + when (null kids) $ + if isTyConName name + then when warnDodgyExports $ addWarn (dodgyExportWarn name) + else -- This occurs when you export T(..), but + -- only import T abstractly, or T is a synonym. + addErr (exportItemErr ie) + return (IEThingAll name, AvailTC name (name:kids)) lookup_ie ie@(IEThingWith rdr sub_rdrs) @@ -1472,11 +1475,11 @@ nullModuleExport mod moduleWarn :: ModuleName -> WarningTxt -> SDoc moduleWarn mod (WarningTxt txt) = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"), - nest 4 (ppr txt) ] + nest 2 (vcat (map ppr txt)) ] moduleWarn mod (DeprecatedTxt txt) = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <+> ptext (sLit "is deprecated:"), - nest 4 (ppr txt) ] + nest 2 (vcat (map ppr txt)) ] implicitPreludeWarn :: SDoc implicitPreludeWarn