X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcRnDriver.lhs;h=8df2efcbf3518a5573b4cf42cf3aa8f6f6c2b544;hb=29da2cf3011c292bc4261601aff85afb13e24d54;hp=d0e45d502e64a2ca527ede8b093113e9a8527b99;hpb=f714e6b642fd614a9971717045ae47c3d871275e;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index d0e45d5..8df2efc 100644
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -44,12 +44,12 @@ import TcSimplify	( tcSimplifyTop )
 import TcTyClsDecls	( tcTyAndClassDecls )
 import LoadIface	( loadOrphanModules )
 import RnNames		( importsFromLocalDecls, rnImports, exportsFromAvail, 
-			  reportUnusedNames )
+			  reportUnusedNames, reportDeprecations )
 import RnEnv		( lookupSrcOcc_maybe )
 import RnSource		( rnSrcDecls, rnTyClDecls, checkModDeprec )
 import PprCore		( pprIdRules, pprCoreBindings )
 import CoreSyn		( IdCoreRule, bindersOfBinds )
-import ErrUtils		( mkDumpDoc, showPass )
+import ErrUtils		( Messages, mkDumpDoc, showPass )
 import Id		( mkExportedLocalId, isLocalId, idName, idType )
 import Var		( Var )
 import Module           ( mkHomeModule, mkModuleName, moduleName, moduleEnvElts )
@@ -95,7 +95,7 @@ import MkId		( unsafeCoerceId )
 import TysWiredIn	( mkListTy, unitTy )
 import IdInfo		( GlobalIdDetails(..) )
 import SrcLoc		( interactiveSrcLoc, unLoc )
-import Var		( setGlobalIdDetails )
+import Var		( globaliseId )
 import Name		( nameOccName, nameModuleName )
 import NameEnv		( delListFromNameEnv )
 import PrelNames	( iNTERACTIVE, ioTyConName, printName, monadNames, itName, returnIOName )
@@ -128,7 +128,7 @@ import Maybe		( isJust )
 \begin{code}
 tcRnModule :: HscEnv 
 	   -> Located (HsModule RdrName)
-	   -> IO (Maybe TcGblEnv)
+	   -> IO (Messages, Maybe TcGblEnv)
 
 tcRnModule hsc_env (L loc (HsModule maybe_mod exports 
 				import_decls local_decls mod_deprec))
@@ -164,9 +164,17 @@ tcRnModule hsc_env (L loc (HsModule maybe_mod exports
 
 	traceRn (text "rn3") ;
 
+		-- Report the use of any deprecated things
+		-- We do this before processsing the export list so
+		-- that we don't bleat about re-exporting a deprecated
+		-- thing (especially via 'module Foo' export item)
+		-- Only uses in the body of the module are complained about
+	reportDeprecations tcg_env ;
+
 		-- Process the export list
-	export_avails <- exportsFromAvail (isJust maybe_mod) exports ;
+	exports <- exportsFromAvail (isJust maybe_mod) exports ;
 
+{- 	Jan 04: I don't think this is necessary any more; usage info is derived from tcg_dus
 		-- Get any supporting decls for the exports that have not already
 		-- been sucked in for the declarations in the body of the module.
 		-- (This can happen if something is imported only to be re-exported.)
@@ -177,15 +185,15 @@ tcRnModule hsc_env (L loc (HsModule maybe_mod exports
 		-- We don't need the results, but sucking them in may side-effect
 		-- the ExternalPackageState, apart from recording usage
 	mappM (tcLookupGlobal . availName) export_avails ;
+-}
 
 		-- Check whether the entire module is deprecated
 		-- This happens only once per module
 	let { mod_deprecs = checkModDeprec mod_deprec } ;
 
 		-- Add exports and deprecations to envt
-	let { export_fvs = availsToNameSet export_avails ;
-	      final_env  = tcg_env { tcg_exports = export_avails,
-				     tcg_dus = tcg_dus tcg_env `plusDU` usesOnly export_fvs,
+	let { final_env  = tcg_env { tcg_exports = exports,
+				     tcg_dus = tcg_dus tcg_env `plusDU` usesOnly exports,
 				     tcg_deprecs = tcg_deprecs tcg_env `plusDeprecs` 
 						   mod_deprecs }
 		-- A module deprecation over-rides the earlier ones
@@ -237,8 +245,7 @@ tcRnStmt hsc_env ictxt rdr_stmt
 	    	-- important: otherwise when we come to compile an expression
 	    	-- using these ids later, the byte code generator will consider
 	    	-- the occurrences to be free rather than global.
-	global_ids     = map globaliseId bound_ids ;
-	globaliseId id = setGlobalIdDetails id VanillaGlobal ;
+	global_ids     = map (globaliseId VanillaGlobal) bound_ids ;
     
 		-- Update the interactive context
 	rn_env   = ic_rn_local_env ictxt ;
@@ -463,7 +470,8 @@ tcRnThing hsc_env ictxt rdr_name
 
 toIfaceDecl :: InteractiveContext -> TyThing -> IfaceDecl
 toIfaceDecl ictxt thing
-  = tyThingToIfaceDecl True {- Discard IdInfo -} ext_nm thing
+  = tyThingToIfaceDecl True {- Discard IdInfo -} emptyNameSet {- Show data cons -} 
+		       ext_nm thing
   where
     unqual = icPrintUnqual ictxt
     ext_nm n | unqual n  = LocalTop (nameOccName n)	-- What a hack
@@ -491,7 +499,7 @@ setInteractiveContext icxt thing_inside
 \begin{code}
 tcRnExtCore :: HscEnv 
 	    -> HsExtCore RdrName
-	    -> IO (Maybe ModGuts)
+	    -> IO (Messages, Maybe ModGuts)
 	-- Nothing => some error occurred 
 
 tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
@@ -529,7 +537,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 	-- Wrap up
    let {
 	bndrs 	   = bindersOfBinds core_binds ;
-	my_exports = map (Avail . idName) bndrs ;
+	my_exports = mkNameSet (map idName bndrs) ;
 		-- ToDo: export the data types also?
 
 	final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
@@ -808,8 +816,7 @@ getModuleExports :: ModuleName -> TcM GlobalRdrEnv
 getModuleExports mod 
   = do	{ iface <- load_iface mod
 	; avails <- exportsToAvails (mi_exports iface)
-	; let { gres = [ GRE  { gre_name = name, gre_prov = vanillaProv mod,
-				gre_deprec = mi_dep_fn iface name }
+	; let { gres =  [ GRE  { gre_name = name, gre_prov = vanillaProv mod }
 			| avail <- avails, name <- availNames avail ] }
 	; returnM (mkGlobalRdrEnv gres) }