[project @ 2000-11-14 10:46:39 by simonpj]

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

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index ad60177..5affac9 100644 (file)
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -19,7 +19,7 @@ import RnHsSyn                ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDe
 
 import CmdLineOpts     ( DynFlags, DynFlag(..) )
 import RnMonad
-import RnNames         ( getGlobalNames )
+import RnNames         ( getGlobalNames, exportsFromAvail )
 import RnSource                ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
 import RnIfaces                ( slurpImpDecls, mkImportInfo, 
                          getInterfaceExports, closeDecls,
@@ -62,7 +62,7 @@ import Outputable
 import IO              ( openFile, IOMode(..) )
 import HscTypes                ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable, 
                          ModIface(..), WhatsImported(..), 
-                         VersionInfo(..), ImportVersion, 
+                         VersionInfo(..), ImportVersion, IsExported,
                          IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
                          GlobalRdrEnv, pprGlobalRdrEnv,
                          AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
@@ -85,7 +85,7 @@ renameModule :: DynFlags
             -> HomeIfaceTable -> HomeSymbolTable
             -> PersistentCompilerState 
             -> Module -> RdrNameHsModule 
-            -> IO (PersistentCompilerState, Maybe (PrintUnqualified, ModIface, [RenamedHsDecl]))
+            -> IO (PersistentCompilerState, Maybe (PrintUnqualified, IsExported, ModIface, [RenamedHsDecl]))
        -- Nothing => some error occurred in the renamer
 
 renameModule dflags hit hst old_pcs this_module rdr_module
@@ -95,10 +95,9 @@ renameModule dflags hit hst old_pcs this_module rdr_module
        ; (new_pcs, msgs, maybe_rn_stuff) <- initRn dflags hit hst old_pcs this_module 
                                                    (rename this_module rdr_module)
 
-       ; let print_unqualified :: Name -> Bool -- Is this chap in scope unqualified?
-             print_unqualified = case maybe_rn_stuff of
-                                   Just (unqual, _, _) -> unqual
-                                   Nothing             -> alwaysQualify
+       ; let print_unqualified = case maybe_rn_stuff of
+                                   Just (unqual, _, _, _) -> unqual
+                                   Nothing                -> alwaysQualify
 
 
                -- Print errors from renaming
@@ -113,13 +112,12 @@ renameModule dflags hit hst old_pcs this_module rdr_module
 \end{code}
 
 \begin{code}
-rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, ModIface, [RenamedHsDecl]))
-rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
+rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, IsExported, ModIface, [RenamedHsDecl]))
+rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
   = pushSrcLocRn loc           $
 
        -- FIND THE GLOBAL NAME ENVIRONMENT
-    getGlobalNames this_module contents        `thenRn` \ (gbl_env, local_gbl_env, 
-                                                           export_avails, global_avail_env) ->
+    getGlobalNames this_module contents        `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
 
        -- Exit if we've found any errors
     checkErrsRn                                `thenRn` \ no_errs_so_far ->
@@ -129,6 +127,9 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
        returnRn Nothing 
     else
        
+       -- PROCESS EXPORT LIST 
+    exportsFromAvail mod_name exports all_avails gbl_env       `thenRn` \ export_avails ->
+       
     traceRn (text "Local top-level environment" $$ 
             nest 4 (pprGlobalRdrEnv local_gbl_env))    `thenRn_`
 
@@ -183,7 +184,7 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
 
        mod_iface = ModIface {  mi_module   = this_module,
                                mi_version  = initialVersionInfo,
-                               mi_usages = my_usages,
+                               mi_usages   = my_usages,
                                mi_boot     = False,
                                mi_orphan   = is_orphan,
                                mi_exports  = my_exports,
@@ -194,6 +195,8 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
                    }
 
        print_unqualified = unQualInScope gbl_env
+       is_exported name  = name `elemNameSet` exported_names
+       exported_names    = availsToNameSet export_avails
     in
 
        -- REPORT UNUSED NAMES, AND DEBUG DUMP 
@@ -201,7 +204,7 @@ rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
                      imports global_avail_env
                      source_fvs export_avails rn_imp_decls     `thenRn_`
 
-    returnRn (Just (print_unqualified, mod_iface, final_decls))
+    returnRn (Just (print_unqualified, is_exported, mod_iface, final_decls))
   where
     mod_name = moduleName this_module
 \end{code}
@@ -676,7 +679,7 @@ warnDeprecations this_mod export_avails my_deprecs used_names
        | nameIsLocalOrFrom this_mod n
        = lookupDeprec my_deprecs n 
        | otherwise
-       = case lookupIface hit pit this_mod n of
+       = case lookupIface hit pit n of
                Just iface -> lookupDeprec (mi_deprecs iface) n
                Nothing    -> pprPanic "warnDeprecations:" (ppr n)