X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=7d367c783b82241b568c7c5ad956f65a42d42ffe;hp=1052db68480412999232a51b8aae25de6a230e1b;hb=dafabe653da4e6cf5aea6b5281c8f77de8d0964a;hpb=651dd121a65827884eea23605026d16e26d4301c

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 1052db6..7d367c7 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}
 
 
@@ -580,10 +580,10 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
     lookup_ie opt_typeFamilies ie 
       = let bad_ie = Failed (badImportItemErr iface decl_spec ie)
 
-            lookup_name rdrName = 
-                case lookupOccEnv occ_env (rdrNameOcc rdrName) of
-                   Nothing -> bad_ie
-                   Just n  -> return n
+            lookup_name rdr 
+	      | isQual rdr = Failed (qualImportItemErr rdr)
+              | Just nm <- lookupOccEnv occ_env (rdrNameOcc rdr) = return nm
+              | otherwise                                        = bad_ie
         in
         case ie of
          IEVar n -> do
@@ -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)
@@ -1301,20 +1304,20 @@ isImpAll _other				= False
 
 \begin{code}
 warnUnusedImport :: ImportDeclUsage -> RnM ()
-warnUnusedImport (L loc decl, used, unused) 
-  | Just (False,[]) <- ideclHiding decl 
-		= return ()	       -- Do not warn for 'import M()'
+warnUnusedImport (L loc decl, used, unused)
+  | Just (False,[]) <- ideclHiding decl
+                = return ()            -- Do not warn for 'import M()'
   | null used   = addWarnAt loc msg1   -- Nothing used; drop entire decl
-  | null unused = return () 	       -- Everything imported is used; nop
+  | null unused = return ()            -- Everything imported is used; nop
   | otherwise   = addWarnAt loc msg2   -- Some imports are unused
   where
     msg1 = vcat [pp_herald <+> quotes pp_mod <+> pp_not_used,
-		 nest 2 (ptext (sLit "except perhaps to import instances from")
-				   <+> quotes pp_mod),
-		 ptext (sLit "To import instances alone, use:") 
-				   <+> ptext (sLit "import") <+> pp_mod <> parens empty ]
+                 nest 2 (ptext (sLit "except perhaps to import instances from")
+                                   <+> quotes pp_mod),
+                 ptext (sLit "To import instances alone, use:")
+                                   <+> ptext (sLit "import") <+> pp_mod <> parens empty ]
     msg2 = sep [pp_herald <+> quotes (pprWithCommas ppr unused),
-		    text "from module" <+> quotes pp_mod <+> pp_not_used]
+                    text "from module" <+> quotes pp_mod <+> pp_not_used]
     pp_herald   = text "The import of"
     pp_mod      = ppr (unLoc (ideclName decl))
     pp_not_used = text "is redundant"
@@ -1383,6 +1386,11 @@ printMinimalImports imports_w_usage
 %************************************************************************
 
 \begin{code}
+qualImportItemErr :: RdrName -> SDoc
+qualImportItemErr rdr
+  = hang (ptext (sLit "Illegal qualified name in import item:"))
+       2 (ppr rdr)
+
 badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
 badImportItemErr iface decl_spec ie
   = sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import,
@@ -1472,11 +1480,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