Use addToUFM_Acc where appropriate

[ghc-hetmet.git] / compiler / rename / RnNames.lhs

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 1052db6..55fcea2 100644 (file)
--- 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}
 
 
@@ -722,7 +722,7 @@ gresFromIE decl_spec (L loc ie, avail)
 mkChildEnv :: [GlobalRdrElt] -> NameEnv [Name]
 mkChildEnv gres = foldr add emptyNameEnv gres
     where
-       add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_C (++) env p [n]
+       add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_Acc (:) singleton env p n
        add _                                            env = env
 
 findChildren :: NameEnv [Name] -> Name -> [Name]
@@ -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