Refactor TcRnDriver, and check exports on hi-boot files

This patch refactors TcRnDriver to make the top-level structure
easier to understand.  

The change was driven by Trac #924, and this patch fixes that bug.
When comparing a module against its hs-boot file, we must ensure that
the module exports everything that the hs-boot file exports.

3 files changed, 63 insertions, 44 deletions

diff --git a/compiler/rename/RnHsDoc.hs b/compiler/rename/RnHsDoc.hs
index f3d36907f4..9fb9348eb0 100644
--- a/compiler/rename/RnHsDoc.hs
+++ b/compiler/rename/RnHsDoc.hs
@@ -1,17 +1,29 @@
-module RnHsDoc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc, rnMbHsDoc ) where
+module RnHsDoc ( rnHaddock, rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where
 
+import TcRnTypes
 import TcRnMonad   ( RnM )
 import RnEnv       ( dataTcOccs, lookupGreRn_maybe )
-import HsDoc       ( HsDoc(..) )
+import HsSyn
 
-import RdrName     ( RdrName, isRdrDataCon, isRdrTc, gre_name )
+import RdrName     ( RdrName, gre_name )
 import Name        ( Name )
 import SrcLoc      ( Located(..) )
 import Outputable  ( ppr, defaultUserStyle )
 
-import Data.List   ( (\\) )
-import Debug.Trace ( trace )
 
+rnHaddock :: HaddockModInfo RdrName -> Maybe (HsDoc RdrName)
+	  -> TcGblEnv -> RnM TcGblEnv
+rnHaddock module_info maybe_doc tcg_env
+  = do	{ rn_module_doc <- rnMbHsDoc maybe_doc ;
+
+		-- Rename the Haddock module info 
+	; rn_description <- rnMbHsDoc (hmi_description module_info)
+	; let { rn_module_info = module_info { hmi_description = rn_description } }
+
+	; return (tcg_env { tcg_doc = rn_module_doc, 
+			    tcg_hmi = rn_module_info }) }
+
+rnMbHsDoc :: Maybe (HsDoc RdrName) -> RnM (Maybe (HsDoc Name))
 rnMbHsDoc mb_doc = case mb_doc of
   Just doc -> do
     doc' <- rnHsDoc doc
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 0c0982767b..6c35ef11a2 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -8,7 +8,7 @@ module RnNames (
 	rnImports, importsFromLocalDecls,
 	rnExports,
 	getLocalDeclBinders, extendRdrEnvRn,
-	reportUnusedNames, reportDeprecations
+	reportUnusedNames, finishDeprecations
     ) where
 
 #include "HsVersions.h"
@@ -688,41 +688,44 @@ type ExportOccMap = OccEnv (Name, IE RdrName)
 	--   it came from.  It's illegal to export two distinct things
 	--   that have the same occurrence name
 
-rnExports :: Bool    -- False => no 'module M(..) where' header at all
+rnExports :: Bool	-- False => no 'module M(..) where' header at all
           -> Maybe [LIE RdrName]        -- Nothing => no explicit export list
-          -> RnM (Maybe [LIE Name], [AvailInfo])
+	  -> TcGblEnv
+          -> RnM TcGblEnv
 
 	-- Complains if two distinct exports have same OccName
         -- Warns about identical exports.
 	-- Complains about exports items not in scope
 
-rnExports explicit_mod exports
- = do TcGblEnv { tcg_mod     = this_mod,
-                 tcg_rdr_env = rdr_env, 
-                 tcg_imports = imports } <- getGblEnv
-
+rnExports explicit_mod exports 
+	  tcg_env@(TcGblEnv { tcg_mod     = this_mod,
+          	      	      tcg_rdr_env = rdr_env, 
+                     	      tcg_imports = imports })
+ = do 	{  
 	-- If the module header is omitted altogether, then behave
 	-- as if the user had written "module Main(main) where..."
 	-- EXCEPT in interactive mode, when we behave as if he had
 	-- written "module Main where ..."
 	-- Reason: don't want to complain about 'main' not in scope
 	--	   in interactive mode
-      ghc_mode <- getGhcMode
-      real_exports <- 
-          case () of
-            () | explicit_mod
-                   -> return exports
-               | ghc_mode == Interactive
-                   -> return Nothing
-               | otherwise
-                   -> do mainName <- lookupGlobalOccRn main_RDR_Unqual
-                         return (Just ([noLoc (IEVar main_RDR_Unqual)]))
-		-- ToDo: the 'noLoc' here is unhelpful if 'main' turns
-		-- out to be out of scope
-
-      (exp_spec, avails) <- exports_from_avail real_exports rdr_env imports this_mod
-
-      return (exp_spec, nubAvails avails)     -- Combine families
+	; ghc_mode <- getGhcMode
+	; let real_exports 
+          	 | explicit_mod 	   = exports
+          	 | ghc_mode == Interactive = Nothing
+          	 | otherwise = Just ([noLoc (IEVar main_RDR_Unqual)])
+	  		-- ToDo: the 'noLoc' here is unhelpful if 'main' 
+	  		--       turns out to be out of scope
+
+	; (rn_exports, avails) <- exports_from_avail real_exports rdr_env imports this_mod
+	; let final_avails = nubAvails avails	     -- Combine families
+	
+	; return (tcg_env { tcg_exports    = final_avails,
+                            tcg_rn_exports = case tcg_rn_exports tcg_env of
+						Nothing -> Nothing
+						Just _  -> rn_exports,
+			    tcg_dus = tcg_dus tcg_env `plusDU` 
+				      usesOnly (availsToNameSet final_avails) }) }
+
 
 exports_from_avail :: Maybe [LIE RdrName]
                          -- Nothing => no explicit export list
@@ -904,13 +907,23 @@ check_occs ie occs names
 %*********************************************************
 
 \begin{code}
-reportDeprecations :: DynFlags -> TcGblEnv -> RnM ()
-reportDeprecations dflags tcg_env
-  = ifOptM Opt_WarnDeprecations	$
-    do	{ (eps,hpt) <- getEpsAndHpt
+finishDeprecations :: DynFlags -> Maybe DeprecTxt 
+		   -> TcGblEnv -> RnM TcGblEnv
+-- (a) Report usasge of deprecated imports
+-- (b) If the whole module is deprecated, update tcg_deprecs
+-- 		All this happens only once per module
+finishDeprecations dflags mod_deprec tcg_env
+  = do	{ (eps,hpt) <- getEpsAndHpt
+	; ifOptM Opt_WarnDeprecations	$
+	  mapM_ (check hpt (eps_PIT eps)) all_gres
 		-- By this time, typechecking is complete, 
 		-- so the PIT is fully populated
-	; mapM_ (check hpt (eps_PIT eps)) all_gres }
+
+	-- Deal with a module deprecation; it overrides all existing deprecs
+	; let new_deprecs = case mod_deprec of
+				Just txt -> DeprecAll txt
+				Nothing  -> tcg_deprecs tcg_env
+	; return (tcg_env { tcg_deprecs = new_deprecs }) }
   where
     used_names = allUses (tcg_dus tcg_env) 
 	-- Report on all deprecated uses; hence allUses
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 75af8fdfd0..ca237ddfe1 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -6,7 +6,7 @@
 \begin{code}
 module RnSource ( 
 	rnSrcDecls, addTcgDUs, 
-	rnTyClDecls, checkModDeprec,
+	rnTyClDecls, 
 	rnSplice, checkTH
     ) where
 
@@ -23,7 +23,7 @@ import RnTypes		( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
 import RnBinds		( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn )
 import RnEnv		( lookupLocalDataTcNames,
 			  lookupLocatedTopBndrRn, lookupLocatedOccRn,
-			  lookupOccRn, lookupTopBndrRn, newLocalsRn, 
+			  lookupOccRn, newLocalsRn, 
 			  bindLocatedLocalsFV, bindPatSigTyVarsFV,
 			  bindTyVarsRn, extendTyVarEnvFVRn,
 			  bindLocalNames, checkDupNames, mapFvRn
@@ -31,8 +31,7 @@ import RnEnv		( lookupLocalDataTcNames,
 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
 import TcRnMonad
 
-import HscTypes		( FixityEnv, FixItem(..),
-			  Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
+import HscTypes		( FixityEnv, FixItem(..), Deprecations, Deprecs(..), plusDeprecs )
 import Class		( FunDep )
 import Name		( Name, nameOccName )
 import NameSet
@@ -42,7 +41,7 @@ import Outputable
 import SrcLoc		( Located(..), unLoc, noLoc )
 import DynFlags	( DynFlag(..) )
 import Maybes		( seqMaybe )
-import Maybe            ( isNothing, isJust )
+import Maybe            ( isNothing )
 import Monad		( liftM, when )
 import BasicTypes       ( Boxity(..) )
 \end{code}
@@ -254,11 +253,6 @@ rnSrcDeprecDecls decls
    rn_deprec (Deprecation rdr_name txt)
      = lookupLocalDataTcNames rdr_name	`thenM` \ names ->
        returnM [(name, (nameOccName name, txt)) | name <- names]
-
-checkModDeprec :: Maybe DeprecTxt -> Deprecations
--- Check for a module deprecation; done once at top level
-checkModDeprec Nothing    = NoDeprecs
-checkModDeprec (Just txt) = DeprecAll txt
 \end{code}
 
 %*********************************************************