Tweak missing-import-list warning

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

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index d82bea9..39ec541 100644 (file)
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -6,7 +6,8 @@
 \begin{code}
 module RnNames (
        rnImports, getLocalNonValBinders,
-       rnExports, extendGlobalRdrEnvRn,
+       rnExports, extendGlobalRdrEnvRn, 
+        gresFromAvails,
        reportUnusedNames, finishWarnings,
     ) where
 
@@ -69,10 +70,11 @@ rnImports imports
             when (notNull prel_imports) $ addWarn (implicitPreludeWarn)
           )
 
-         stuff1 <- mapM (rnImportDecl this_mod) (prel_imports ++ ordinary)
-         stuff2 <- mapM (rnImportDecl this_mod) source
-         let (decls, rdr_env, imp_avails,hpc_usage) = combine (stuff1 ++ stuff2)
-         return (decls, rdr_env, imp_avails,hpc_usage) 
+         stuff1 <- mapM (rnImportDecl this_mod True)  prel_imports
+         stuff2 <- mapM (rnImportDecl this_mod False) ordinary
+         stuff3 <- mapM (rnImportDecl this_mod False) source
+         let (decls, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2 ++ stuff3)
+         return (decls, rdr_env, imp_avails, hpc_usage)
 
     where
    combine :: [(LImportDecl Name,  GlobalRdrEnv, ImportAvails,AnyHpcUsage)]
@@ -85,11 +87,11 @@ rnImports imports
                    imp_avails1 `plusImportAvails` imp_avails2,
                   hpc_usage1 || hpc_usage2)
 
-rnImportDecl  :: Module
+rnImportDecl  :: Module -> Bool
              -> LImportDecl RdrName
              -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)
 
-rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
+rnImportDecl this_mod implicit_prelude (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
                                          qual_only as_mod imp_details))
   = setSrcSpan loc $ do
 
@@ -103,6 +105,11 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
        imp_mod_name = unLoc loc_imp_mod_name
        doc = ppr imp_mod_name <+> ptext (sLit "is directly imported")
 
+    case imp_details of
+        Just _ -> return ()
+        Nothing -> unless implicit_prelude $
+            ifOptM Opt_WarnMissingImportList (addWarn (missingImportListWarn imp_mod_name))
+
     iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg
 
        -- Compiler sanity check: if the import didn't say
@@ -394,8 +401,7 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
   = do {   -- separate out the family instance declarations
           let (tyinst_decls1, tycl_decls_noinsts) 
                            = partition (isFamInstDecl . unLoc) tycl_decls
-              tyinst_decls = tyinst_decls1 ++ 
-                             concatMap (instDeclATs . unLoc) inst_decls 
+              tyinst_decls = tyinst_decls1 ++ instDeclATs inst_decls
 
             -- process all type/class decls except family instances
         ; tc_names  <- mapM new_tc tycl_decls_noinsts
@@ -411,7 +417,6 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
        ; val_names <- mapM new_simple val_bndrs
        ; return (val_names ++ tc_names ++ ti_names) }
   where
-    mod        = tcg_mod gbl_env
     is_hs_boot = isHsBoot (tcg_src gbl_env) ;
 
     for_hs_bndrs :: [Located RdrName]
@@ -425,23 +430,23 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
 
     new_simple :: Located RdrName -> RnM (GenAvailInfo Name)
     new_simple rdr_name = do
-        nm <- newTopSrcBinder mod rdr_name
+        nm <- newTopSrcBinder rdr_name
         return (Avail nm)
 
     new_tc tc_decl              -- NOT for type/data instances
-       = do { main_name <- newTopSrcBinder mod main_rdr
-            ; sub_names <- mapM (newTopSrcBinder mod) sub_rdrs
+       = do { main_name <- newTopSrcBinder main_rdr
+            ; sub_names <- mapM newTopSrcBinder sub_rdrs
             ; return (AvailTC main_name (main_name : sub_names)) }
       where
-       (main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
+       (main_rdr : sub_rdrs) = hsTyClDeclBinders tc_decl
 
     new_ti tc_name_env ti_decl  -- ONLY for type/data instances
        = do { main_name <- lookupFamInstDeclBndr tc_name_env main_rdr
-            ; sub_names <- mapM (newTopSrcBinder mod) sub_rdrs
+            ; sub_names <- mapM newTopSrcBinder sub_rdrs
             ; return (AvailTC main_name sub_names) }
                        -- main_name is not bound here!
       where
-       (main_rdr : sub_rdrs) = tyClDeclNames (unLoc ti_decl)
+       (main_rdr : sub_rdrs) = hsTyClDeclBinders ti_decl
 
 get_local_binders _ g = pprPanic "get_local_binders" (ppr g)
 \end{code}
@@ -1448,6 +1453,10 @@ nullModuleExport :: ModuleName -> SDoc
 nullModuleExport mod
   = ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing")
 
+missingImportListWarn :: ModuleName -> SDoc
+missingImportListWarn mod
+  = ptext (sLit "The module") <+> quotes (ppr mod) <+> ptext (sLit "is missing an import list")
+
 moduleWarn :: ModuleName -> WarningTxt -> SDoc
 moduleWarn mod (WarningTxt txt)
   = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"),