Comments only

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

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index c30fdd9..d82bea9 100644 (file)
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -21,6 +21,7 @@ import IfaceEnv               ( ifaceExportNames )
 import LoadIface       ( loadSrcInterface, loadSysInterface )
 import TcRnMonad hiding (LIE)
 
+import HeaderInfo       ( mkPrelImports )
 import PrelNames
 import Module
 import Name
@@ -60,7 +61,7 @@ rnImports imports
          -- warning for {- SOURCE -} ones that are unnecessary
     = do this_mod <- getModule
          implicit_prelude <- doptM Opt_ImplicitPrelude
-         let prel_imports      = mkPrelImports this_mod implicit_prelude imports
+         let prel_imports      = mkPrelImports (moduleName this_mod) implicit_prelude imports
              (source, ordinary) = partition is_source_import imports
              is_source_import (L _ (ImportDecl _ _ is_boot _ _ _)) = is_boot
 
@@ -84,36 +85,6 @@ rnImports imports
                    imp_avails1 `plusImportAvails` imp_avails2,
                   hpc_usage1 || hpc_usage2)
 
-mkPrelImports :: Module -> Bool -> [LImportDecl RdrName] -> [LImportDecl RdrName]
--- Consruct the implicit declaration "import Prelude" (or not)
---
--- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
--- because the former doesn't even look at Prelude.hi for instance 
--- declarations, whereas the latter does.
-mkPrelImports this_mod implicit_prelude import_decls
-  | this_mod == pRELUDE
-   || explicit_prelude_import
-   || not implicit_prelude
-  = []
-  | otherwise = [preludeImportDecl]
-  where
-      explicit_prelude_import
-       = notNull [ () | L _ (ImportDecl mod Nothing _ _ _ _) <- import_decls, 
-                  unLoc mod == pRELUDE_NAME ]
-
-      preludeImportDecl :: LImportDecl RdrName
-      preludeImportDecl
-        = L loc $
-         ImportDecl (L loc pRELUDE_NAME)
-               Nothing {- no specific package -}
-              False {- Not a boot interface -}
-              False    {- Not qualified -}
-              Nothing  {- No "as" -}
-              Nothing  {- No import list -}
-
-      loc = mkGeneralSrcSpan (fsLit "Implicit import declaration")         
-
-
 rnImportDecl  :: Module
              -> LImportDecl RdrName
              -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)
@@ -580,10 +551,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 +693,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]
@@ -1304,20 +1275,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"
@@ -1386,6 +1357,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,
@@ -1475,11 +1451,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