X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcRnDriver.lhs;h=cbcd892d81090b3b94b1b50de4bcfd2a154e42b0;hb=d191be5da8d2934a5c50bdbc605784d6a9043b6f;hp=03b2e46baabb74149650051495eb9266f941f94f;hpb=550421384b8364cdaf3135f7859c9f7d7ee1fff1;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index 03b2e46..cbcd892 100644
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -22,9 +22,10 @@ import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
 import CmdLineOpts	( DynFlag(..), opt_PprStyle_Debug, dopt )
 import DriverState	( v_MainModIs, v_MainFunIs )
 import HsSyn
-import RdrHsSyn		( findSplice, main_RDR_Unqual )
+import RdrHsSyn		( findSplice )
 
-import PrelNames	( runIOName, rootMainName, mAIN_Name )
+import PrelNames	( runIOName, rootMainName, mAIN_Name,
+			  main_RDR_Unqual )
 import RdrName		( RdrName, mkRdrUnqual, emptyGlobalRdrEnv, 
 			  plusGlobalRdrEnv )
 import TcHsSyn		( zonkTopDecls )
@@ -43,20 +44,20 @@ 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 Id		( mkLocalId, isLocalId, idName, idType, setIdLocalExported )
+import Id		( mkExportedLocalId, isLocalId, idName, idType )
 import Var		( Var )
 import Module           ( mkHomeModule, mkModuleName, moduleName, moduleEnvElts )
 import OccName		( mkVarOcc )
 import Name		( Name, isExternalName, getSrcLoc, getOccName )
 import NameSet
 import TyCon		( tyConHasGenerics )
-import SrcLoc		( srcLocSpan, Located(..), noLoc, unLoc )
+import SrcLoc		( srcLocSpan, Located(..), noLoc )
 import Outputable
 import HscTypes		( ModGuts(..), HscEnv(..),
 			  GhciMode(..), noDependencies,
@@ -93,7 +94,7 @@ import Id		( Id, isImplicitId )
 import MkId		( unsafeCoerceId )
 import TysWiredIn	( mkListTy, unitTy )
 import IdInfo		( GlobalIdDetails(..) )
-import SrcLoc		( interactiveSrcLoc )
+import SrcLoc		( interactiveSrcLoc, unLoc )
 import Var		( setGlobalIdDetails )
 import Name		( nameOccName, nameModuleName )
 import NameEnv		( delListFromNameEnv )
@@ -104,12 +105,13 @@ import HscTypes		( InteractiveContext(..),
 			  TyThing(..), availNames, icPrintUnqual,
 			  ModIface(..), ModDetails(..) )
 import BasicTypes	( RecFlag(..), Fixity )
+import Bag		( unitBag )
 import Panic		( ghcError, GhcException(..) )
 #endif
 
 import FastString	( mkFastString )
 import Util		( sortLt )
-import Bag		( unionBags, snocBag, unitBag )
+import Bag		( unionBags, snocBag )
 
 import Maybe		( isJust )
 \end{code}
@@ -162,6 +164,13 @@ 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 ;
 
@@ -806,8 +815,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) }
 
@@ -931,7 +939,7 @@ check_main ghci_mode tcg_env main_mod main_fn
 	; (main_expr, ty) <- addSrcSpan (srcLocSpan (getSrcLoc main_name)) $
 			     tcInferRho rhs
 
-	; let { root_main_id = setIdLocalExported (mkLocalId rootMainName ty) ;
+	; let { root_main_id = mkExportedLocalId rootMainName ty ;
 	        main_bind    = noLoc (VarBind root_main_id main_expr) }
 
 	; return (tcg_env { tcg_binds = tcg_binds tcg_env