From 00eefb90925f224c1e22963df2a00d70fe934d5f Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Fri, 28 May 1999 08:07:54 +0000
Subject: [PATCH] [project @ 1999-05-28 08:07:52 by simonpj] Make the renamer
 so that the class ops on the LEFT HAND SIDE of the bindings of an instance
 decl count as free variables of that declaration.  E.g.

	instance Foo [a] where
	  op x  = ...
	  bop y = ...

Here, 'op' and 'bop' are now counted as free variables of
the decl.

This is vital, because the class decl for Foo might be imported,
and look like this:

	class Foo a where
	  op  :: a -> S
	  bop :: T -> a

and these might happen to be the only mentions of S and T
in the program.  Then we need to treat S and T as instance
gates for the purpose of hauling in further instance decls,
and the Right Way to do that is to announce that 'op' and
'bop' have been mentioned.

I also removed the (now obselete) rn_omit field in the
monad.
---
 ghc/compiler/rename/Rename.lhs  | 1156 ++++++++++++-------------
 ghc/compiler/rename/RnBinds.lhs | 1204 +++++++++++++-------------
 ghc/compiler/rename/RnMonad.lhs | 1409 +++++++++++++++----------------
 ghc/compiler/rename/RnNames.lhs | 1392 +++++++++++++++---------------
 4 files changed, 2579 insertions(+), 2582 deletions(-)

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index c0b52db23cb4..377e4baf06f4 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -1,578 +1,578 @@
-%
-% (c) The GRASP Project, Glasgow University, 1992-1998
-%
-\section[Rename]{Renaming and dependency analysis passes}
-
-\begin{code}
-module Rename ( renameModule ) where
-
-#include "HsVersions.h"
-
-import HsSyn
-import RdrHsSyn		( RdrNameHsModule )
-import RnHsSyn		( RenamedHsModule, RenamedHsDecl, 
-			  extractHsTyNames, extractHsCtxtTyNames
-			)
-
-import CmdLineOpts	( opt_HiMap, opt_D_dump_rn_trace,
-			  opt_D_dump_rn, opt_D_dump_rn_stats,
-			  opt_WarnUnusedBinds, opt_WarnUnusedImports
-		        )
-import RnMonad
-import RnNames		( getGlobalNames )
-import RnSource		( rnSourceDecls, rnDecl )
-import RnIfaces		( getImportedInstDecls, importDecl, getImportVersions,
-			  getImportedRules, loadHomeInterface, getSlurped
-			)
-import RnEnv		( availName, availNames, availsToNameSet, 
-			  warnUnusedTopNames, mapFvRn,
-			  FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs
-			)
-import Module           ( Module, ModuleName, pprModule, mkSearchPath, mkThisModule )
-import Name		( Name, isLocallyDefined,
-			  NamedThing(..), ImportReason(..), Provenance(..),
-			  pprOccName, nameOccName,
-			  getNameProvenance, occNameUserString, 
-			  maybeWiredInTyConName, maybeWiredInIdName, isWiredInName
-			)
-import Id		( idType )
-import DataCon		( dataConTyCon, dataConType )
-import TyCon		( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
-import RdrName		( RdrName )
-import NameSet
-import PrelMods		( mAIN_Name, pREL_MAIN_Name )
-import TysWiredIn	( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
-import PrelInfo		( ioTyCon_NAME, thinAirIdNames )
-import Type		( namesOfType, funTyCon )
-import ErrUtils		( pprBagOfErrors, pprBagOfWarnings,
-			  doIfSet, dumpIfSet, ghcExit
-			)
-import BasicTypes	( NewOrData(..) )
-import Bag		( isEmptyBag, bagToList )
-import FiniteMap	( fmToList, delListFromFM, addToFM, sizeFM, eltsFM )
-import UniqSupply	( UniqSupply )
-import Util		( equivClasses )
-import Maybes		( maybeToBool )
-import Outputable
-\end{code}
-
-
-
-\begin{code}
-renameModule :: UniqSupply
-	     -> RdrNameHsModule
-	     -> IO (Maybe 
-	              ( Module
-		      , RenamedHsModule   -- Output, after renaming
-		      , InterfaceDetails  -- Interface; for interface file generation
-		      , RnNameSupply      -- Final env; for renaming derivings
-		      , [ModuleName]	  -- Imported modules; for profiling
-		      ))
-
-renameModule us this_mod@(HsModule mod_name vers exports imports local_decls loc)
-  = 	-- Initialise the renamer monad
-    initRn mod_name us (mkSearchPath opt_HiMap) loc
-	   (rename this_mod)				>>=
-	\ (maybe_rn_stuff, rn_errs_bag, rn_warns_bag) ->
-
-	-- Check for warnings
-    doIfSet (not (isEmptyBag rn_warns_bag))
-	    (printErrs (pprBagOfWarnings rn_warns_bag))	>>
-
-	-- Check for errors; exit if so
-    doIfSet (not (isEmptyBag rn_errs_bag))
-	    (printErrs (pprBagOfErrors rn_errs_bag)	 >>
-	     ghcExit 1
-	    )						 >>
-
-	-- Dump output, if any
-    (case maybe_rn_stuff of
-	Nothing  -> return ()
-	Just results@(_, rn_mod, _, _, _)
-		 -> dumpIfSet opt_D_dump_rn "Renamer:"
-			      (ppr rn_mod)
-    )							>>
-
-	-- Return results
-    return maybe_rn_stuff
-\end{code}
-
-
-\begin{code}
-rename this_mod@(HsModule mod_name vers exports imports local_decls loc)
-  =  	-- FIND THE GLOBAL NAME ENVIRONMENT
-    getGlobalNames this_mod			`thenRn` \ maybe_stuff ->
-
-	-- CHECK FOR EARLY EXIT
-    if not (maybeToBool maybe_stuff) then
-	-- Everything is up to date; no need to recompile further
-	rnStats []		`thenRn_`
-	returnRn Nothing
-    else
-    let
-  	Just (export_env, gbl_env, fixity_env, global_avail_env) = maybe_stuff
-    in
-
-	-- RENAME THE SOURCE
-    initRnMS gbl_env fixity_env SourceMode (
-	rnSourceDecls local_decls
-    )					`thenRn` \ (rn_local_decls, source_fvs) ->
-
-	-- SLURP IN ALL THE NEEDED DECLARATIONS
-    let
-	real_source_fvs = implicitFVs mod_name `plusFV` source_fvs
-		-- It's important to do the "plus" this way round, so that
-		-- when compiling the prelude, locally-defined (), Bool, etc
-		-- override the implicit ones. 
-    in
-    slurpImpDecls real_source_fvs	`thenRn` \ rn_imp_decls ->
-
-	-- EXIT IF ERRORS FOUND
-    checkErrsRn				`thenRn` \ no_errs_so_far ->
-    if not no_errs_so_far then
-	-- Found errors already, so exit now
-	rnStats []		`thenRn_`
-	returnRn Nothing
-    else
-
-	-- GENERATE THE VERSION/USAGE INFO
-    getImportVersions mod_name exports			`thenRn` \ my_usages ->
-    getNameSupplyRn					`thenRn` \ name_supply ->
-
-	-- REPORT UNUSED NAMES
-    reportUnusedNames gbl_env global_avail_env
-		      export_env
-		      source_fvs			`thenRn_`
-
-	-- RETURN THE RENAMED MODULE
-    let
-	has_orphans        = any isOrphanDecl rn_local_decls
-	direct_import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
-	rn_all_decls	   = rn_imp_decls ++ rn_local_decls 
-	renamed_module = HsModule mod_name vers 
-				  trashed_exports trashed_imports
-				  rn_all_decls
-			          loc
-    in
-    rnStats rn_imp_decls	`thenRn_`
-    returnRn (Just (mkThisModule mod_name,
-		    renamed_module, 
-		    (has_orphans, my_usages, export_env),
-		    name_supply,
-		    direct_import_mods))
-  where
-    trashed_exports  = {-trace "rnSource:trashed_exports"-} Nothing
-    trashed_imports  = {-trace "rnSource:trashed_imports"-} []
-\end{code}
-
-@implicitFVs@ forces the renamer to slurp in some things which aren't
-mentioned explicitly, but which might be needed by the type checker.
-
-\begin{code}
-implicitFVs mod_name
-  = implicit_main		`plusFV` 
-    mkNameSet default_tys	`plusFV`
-    mkNameSet thinAirIdNames
-  where
-	-- Add occurrences for Int, Double, and (), because they
-	-- are the types to which ambigious type variables may be defaulted by
-	-- the type checker; so they won't always appear explicitly.
-	-- [The () one is a GHC extension for defaulting CCall results.]
-	-- ALSO: funTyCon, since it occurs implicitly everywhere!
-	--  	 (we don't want to be bothered with making funTyCon a
-	--	  free var at every function application!)
-    default_tys = [getName intTyCon, getName doubleTyCon,
-		   getName unitTyCon, getName funTyCon, getName boolTyCon]
-
-	-- Add occurrences for IO or PrimIO
-    implicit_main |  mod_name == mAIN_Name
-		  || mod_name == pREL_MAIN_Name = unitFV ioTyCon_NAME
-		  |  otherwise 		        = emptyFVs
-\end{code}
-
-\begin{code}
-isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
-  = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames inst_ty))
-isOrphanDecl (RuleD (RuleDecl _ _ _ lhs _ _))
-  = check lhs
-  where
-    check (HsVar v)   = not (isLocallyDefined v)
-    check (HsApp f a) = check f && check a
-    check other	      = True
-isOrphanDecl other = False
-\end{code}
-
-
-%*********************************************************
-%*						 	 *
-\subsection{Slurping declarations}
-%*							 *
-%*********************************************************
-
-\begin{code}
--------------------------------------------------------
-slurpImpDecls source_fvs
-  = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
-
-	-- The current slurped-set records all local things
-    getSlurped					`thenRn` \ source_binders ->
-    slurpSourceRefs source_binders source_fvs	`thenRn` \ (decls1, needed1, inst_gates) ->
-
-	-- Now we can get the instance decls
-    slurpInstDecls decls1 needed1 inst_gates	`thenRn` \ (decls2, needed2) ->
-
-	-- And finally get everything else
-    closeDecls	 decls2 needed2
-
--------------------------------------------------------
-slurpSourceRefs :: NameSet			-- Variables defined in source
-		-> FreeVars			-- Variables referenced in source
-		-> RnMG ([RenamedHsDecl],
-			 FreeVars,		-- Un-satisfied needs
-			 FreeVars)		-- "Gates"
--- The declaration (and hence home module) of each gate has
--- already been loaded
-
-slurpSourceRefs source_binders source_fvs
-  = go [] 				-- Accumulating decls
-       emptyFVs 			-- Unsatisfied needs
-       source_fvs			-- Accumulating gates
-       (nameSetToList source_fvs)	-- Gates whose defn hasn't been loaded yet
-  where
-    go decls fvs gates []
-	= returnRn (decls, fvs, gates)
-
-    go decls fvs gates (wanted_name:refs) 
-	| isWiredInName wanted_name
- 	= load_home wanted_name		`thenRn_`
-	  go decls fvs (gates `plusFV` getWiredInGates wanted_name) refs
-
-	| otherwise
-	= importDecl wanted_name 		`thenRn` \ maybe_decl ->
-	  case maybe_decl of
-		-- No declaration... (already slurped, or local)
-	    Nothing   -> go decls fvs gates refs
-	    Just decl -> rnIfaceDecl decl		`thenRn` \ (new_decl, fvs1) ->
-			 let
-			    new_gates = getGates source_fvs new_decl
-			 in
-			 go (new_decl : decls)
-			    (fvs1 `plusFV` fvs)
-			    (gates `plusFV` new_gates)
-			    (nameSetToList new_gates ++ refs)
-
-	-- When we find a wired-in name we must load its
-	-- home module so that we find any instance decls therein
-    load_home name 
-	| name `elemNameSet` source_binders = returnRn ()
-		-- When compiling the prelude, a wired-in thing may
-		-- be defined in this module, in which case we don't
-		-- want to load its home module!
-		-- Using 'isLocallyDefined' doesn't work because some of
-		-- the free variables returned are simply 'listTyCon_Name',
-		-- with a system provenance.  We could look them up every time
-		-- but that seems a waste.
-	| otherwise			      = loadHomeInterface doc name	`thenRn_`
-						returnRn ()
-        where
-	  doc = ptext SLIT("need home module for wired in thing") <+> ppr name
-
--------------------------------------------------------
--- slurpInstDecls imports appropriate instance decls.
--- It has to incorporate a loop, because consider
---	instance Foo a => Baz (Maybe a) where ...
--- It may be that Baz and Maybe are used in the source module,
--- but not Foo; so we need to chase Foo too.
-
-slurpInstDecls decls needed gates
-  | isEmptyFVs gates
-  = returnRn (decls, needed)
-
-  | otherwise
-  = getImportedInstDecls gates				`thenRn` \ inst_decls ->
-    rnInstDecls decls needed emptyFVs inst_decls	`thenRn` \ (decls1, needed1, gates1) ->
-    slurpInstDecls decls1 needed1 gates1
-  where
-    rnInstDecls decls fvs gates []
-	= returnRn (decls, fvs, gates)
-    rnInstDecls decls fvs gates (d:ds) 
-	= rnIfaceDecl d		`thenRn` \ (new_decl, fvs1) ->
-	  rnInstDecls (new_decl:decls) 
-		      (fvs1 `plusFV` fvs)
-		      (gates `plusFV` getInstDeclGates new_decl)
-		      ds
-    
-
--------------------------------------------------------
--- closeDecls keeps going until the free-var set is empty
-closeDecls decls needed
-  | not (isEmptyFVs needed)
-  = slurpDecls decls needed	`thenRn` \ (decls1, needed1) ->
-    closeDecls decls1 needed1
-
-  | otherwise
-  = getImportedRules 			`thenRn` \ rule_decls ->
-    case rule_decls of
-	[]    -> returnRn decls	-- No new rules, so we are done
-	other -> rnIfaceDecls decls emptyFVs rule_decls 	`thenRn` \ (decls1, needed1) ->
-		 closeDecls decls1 needed1
-		 
-
--------------------------------------------------------
-rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
-	     -> [(Module, RdrNameHsDecl)]
-	     -> RnM d ([RenamedHsDecl], FreeVars)
-rnIfaceDecls decls fvs []     = returnRn (decls, fvs)
-rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d		`thenRn` \ (new_decl, fvs1) ->
-				rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
-
-rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)	
-			
-
--------------------------------------------------------
--- Augment decls with any decls needed by needed.
--- Return also free vars of the new decls (only)
-slurpDecls decls needed
-  = go decls emptyFVs (nameSetToList needed) 
-  where
-    go decls fvs []         = returnRn (decls, fvs)
-    go decls fvs (ref:refs) = slurpDecl decls fvs ref	`thenRn` \ (decls1, fvs1) ->
-			      go decls1 fvs1 refs
-
--------------------------------------------------------
-slurpDecl decls fvs wanted_name
-  = importDecl wanted_name 		`thenRn` \ maybe_decl ->
-    case maybe_decl of
-	-- No declaration... (wired in thing)
-	Nothing -> returnRn (decls, fvs)
-
-	-- Found a declaration... rename it
-	Just decl -> rnIfaceDecl decl		`thenRn` \ (new_decl, fvs1) ->
-		     returnRn (new_decl:decls, fvs1 `plusFV` fvs)
-\end{code}
-
-
-%*********************************************************
-%*						 	 *
-\subsection{Extracting the 'gates'}
-%*							 *
-%*********************************************************
-
-When we import a declaration like
-
-	data T = T1 Wibble | T2 Wobble
-
-we don't want to treat Wibble and Wobble as gates *unless* T1, T2
-respectively are mentioned by the user program.  If only T is mentioned
-we want only T to be a gate; that way we don't suck in useless instance
-decls for (say) Eq Wibble, when they can't possibly be useful.
-
-@getGates@ takes a newly imported (and renamed) decl, and the free
-vars of the source program, and extracts from the decl the gate names.
-
-\begin{code}
-getGates source_fvs (SigD (IfaceSig _ ty _ _))
-  = extractHsTyNames ty
-
-getGates source_fvs (TyClD (ClassDecl ctxt cls tvs sigs _ _ _ _ _ _))
-  = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
-		       (map getTyVarName tvs)
-    `addOneToNameSet` cls
-  where
-    get (ClassOpSig n _ ty _) 
-	| n `elemNameSet` source_fvs = extractHsTyNames ty
-	| otherwise		     = emptyFVs
-
-getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
-  = delListFromNameSet (extractHsTyNames ty)
-		       (map getTyVarName tvs)
-	-- A type synonym type constructor isn't a "gate" for instance decls
-
-getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _))
-  = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
-		       (map getTyVarName tvs)
-    `addOneToNameSet` tycon
-  where
-    get (ConDecl n tvs ctxt details _)
-	| n `elemNameSet` source_fvs
-		-- If the constructor is method, get fvs from all its fields
-	= delListFromNameSet (get_details details `plusFV` 
-		  	      extractHsCtxtTyNames ctxt)
-			     (map getTyVarName tvs)
-    get (ConDecl n tvs ctxt (RecCon fields) _)
-		-- Even if the constructor isn't mentioned, the fields
-		-- might be, as selectors.  They can't mention existentially
-		-- bound tyvars (typechecker checks for that) so no need for 
-		-- the deleteListFromNameSet part
-	= foldr (plusFV . get_field) emptyFVs fields
-	
-    get other_con = emptyFVs
-
-    get_details (VanillaCon tys) = plusFVs (map get_bang tys)
-    get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
-    get_details (RecCon fields)  = plusFVs [get_bang t | (_, t) <- fields]
-    get_details (NewCon t _)	 = extractHsTyNames t
-
-    get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
-		     | otherwise			 = emptyFVs
-
-    get_bang (Banged   t) = extractHsTyNames t
-    get_bang (Unbanged t) = extractHsTyNames t
-    get_bang (Unpacked t) = extractHsTyNames t
-
-getGates source_fvs other_decl = emptyFVs
-\end{code}
-
-getWiredInGates is just like getGates, but it sees a wired-in Name
-rather than a declaration.
-
-\begin{code}
-getWiredInGates :: Name -> FreeVars
-getWiredInGates name 	-- No classes are wired in
-  | is_id	         = getWiredInGates_s (namesOfType (idType the_id))
-  | isSynTyCon the_tycon = getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
-  | otherwise 	         = unitFV name
-  where
-    maybe_wired_in_id    = maybeWiredInIdName name
-    is_id		 = maybeToBool maybe_wired_in_id
-    maybe_wired_in_tycon = maybeWiredInTyConName name
-    Just the_id 	 = maybe_wired_in_id
-    Just the_tycon	 = maybe_wired_in_tycon
-    (tyvars,ty) 	 = getSynTyConDefn the_tycon
-
-getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
-\end{code}
-
-\begin{code}
-getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
-getInstDeclGates other				    = emptyFVs
-\end{code}
-
-
-%*********************************************************
-%*						 	 *
-\subsection{Unused names}
-%*							 *
-%*********************************************************
-
-\begin{code}
-reportUnusedNames gbl_env avail_env (ExportEnv export_avails _) mentioned_names
-  | not (opt_WarnUnusedBinds || opt_WarnUnusedImports)
-  = returnRn ()
-
-  | otherwise
-  = let
-	used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
-
-	-- Now, a use of C implies a use of T,
-	-- if C was brought into scope by T(..) or T(C)
-	really_used_names = used_names `unionNameSets`
-			    mkNameSet [ availName avail	
-				      | sub_name <- nameSetToList used_names,
-					let avail = case lookupNameEnv avail_env sub_name of
-							Just avail -> avail
-							Nothing -> pprTrace "r.u.n" (ppr sub_name) $
-								   Avail sub_name
-				      ]
-
-	defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
-	defined_but_not_used = nameSetToList (defined_names `minusNameSet` really_used_names)
-
-	-- Filter out the ones only defined implicitly
-	bad_guys = filter reportableUnusedName defined_but_not_used
-    in
-    warnUnusedTopNames bad_guys	`thenRn_`
-    returnRn ()
-
-reportableUnusedName :: Name -> Bool
-reportableUnusedName name
-  = explicitlyImported (getNameProvenance name) &&
-    not (startsWithUnderscore (occNameUserString (nameOccName name)))
-  where
-    explicitlyImported (LocalDef _ _) 		             = True	-- Report unused defns of local vars
-    explicitlyImported (NonLocalDef (UserImport _ _ expl) _) = expl 	-- Report unused explicit imports
-    explicitlyImported other			             = False	-- Don't report others
-   
-	-- Haskell 98 encourages compilers to suppress warnings about
-	-- unused names in a pattern if they start with "_".
-    startsWithUnderscore ('_' : _) = True	-- Suppress warnings for names starting
-    startsWithUnderscore other     = False	-- with an underscore
-
-rnStats :: [RenamedHsDecl] -> RnMG ()
-rnStats imp_decls
-        | opt_D_dump_rn_trace || 
-	  opt_D_dump_rn_stats ||
-	  opt_D_dump_rn 
- 	= getRnStats imp_decls		`thenRn` \ msg ->
-	  ioToRnM (printErrs msg)	`thenRn_`
-	  returnRn ()
-
-	| otherwise = returnRn ()
-\end{code}
-
-
-
-%*********************************************************
-%*							*
-\subsection{Statistics}
-%*							*
-%*********************************************************
-
-\begin{code}
-getRnStats :: [RenamedHsDecl] -> RnMG SDoc
-getRnStats imported_decls
-  = getIfacesRn 		`thenRn` \ ifaces ->
-    let
-	n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)]
-
-	decls_read     = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
-					-- Data, newtype, and class decls are in the decls_fm
-					-- under multiple names; the tycon/class, and each
-					-- constructor/class op too.
-					-- The 'True' selects just the 'main' decl
-				 not (isLocallyDefined (availName avail))
-			     ]
-
-	(cd_rd, dd_rd, nd_rd, sd_rd, vd_rd,     _) = count_decls decls_read
-	(cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
-
-	unslurped_insts       = iInsts ifaces
-	inst_decls_unslurped  = length (bagToList unslurped_insts)
-	inst_decls_read	      = id_sp + inst_decls_unslurped
-
-	stats = vcat 
-		[int n_mods <+> text "interfaces read",
-		 hsep [ int cd_sp, text "class decls imported, out of", 
-		        int cd_rd, text "read"],
-		 hsep [ int dd_sp, text "data decls imported, out of",  
-			int dd_rd, text "read"],
-		 hsep [ int nd_sp, text "newtype decls imported, out of",  
-		        int nd_rd, text "read"],
-		 hsep [int sd_sp, text "type synonym decls imported, out of",  
-		        int sd_rd, text "read"],
-		 hsep [int vd_sp, text "value signatures imported, out of",  
-		        int vd_rd, text "read"],
-		 hsep [int id_sp, text "instance decls imported, out of",  
-		        int inst_decls_read, text "read"],
-		 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName) 
-					   [d | TyClD d <- imported_decls, isClassDecl d]),
-		 text "cls dcls read"  <+> fsep (map (ppr . tyClDeclName) 
-					   [d | TyClD d <- decls_read, isClassDecl d])]
-    in
-    returnRn (hcat [text "Renamer stats: ", stats])
-
-count_decls decls
-  = (class_decls, 
-     data_decls, 
-     newtype_decls,
-     syn_decls, 
-     val_decls, 
-     inst_decls)
-  where
-    tycl_decls = [d | TyClD d <- decls]
-    (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
-
-    val_decls     = length [() | SigD _	  <- decls]
-    inst_decls    = length [() | InstD _  <- decls]
-\end{code}    
-
+%
+% (c) The GRASP Project, Glasgow University, 1992-1998
+%
+\section[Rename]{Renaming and dependency analysis passes}
+
+\begin{code}
+module Rename ( renameModule ) where
+
+#include "HsVersions.h"
+
+import HsSyn
+import RdrHsSyn		( RdrNameHsModule )
+import RnHsSyn		( RenamedHsModule, RenamedHsDecl, 
+			  extractHsTyNames, extractHsCtxtTyNames
+			)
+
+import CmdLineOpts	( opt_HiMap, opt_D_dump_rn_trace,
+			  opt_D_dump_rn, opt_D_dump_rn_stats,
+			  opt_WarnUnusedBinds, opt_WarnUnusedImports
+		        )
+import RnMonad
+import RnNames		( getGlobalNames )
+import RnSource		( rnSourceDecls, rnDecl )
+import RnIfaces		( getImportedInstDecls, importDecl, getImportVersions,
+			  getImportedRules, loadHomeInterface, getSlurped
+			)
+import RnEnv		( availName, availNames, availsToNameSet, 
+			  warnUnusedTopNames, mapFvRn,
+			  FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs
+			)
+import Module           ( Module, ModuleName, pprModule, mkSearchPath, mkThisModule )
+import Name		( Name, isLocallyDefined,
+			  NamedThing(..), ImportReason(..), Provenance(..),
+			  pprOccName, nameOccName,
+			  getNameProvenance, occNameUserString, 
+			  maybeWiredInTyConName, maybeWiredInIdName, isWiredInName
+			)
+import Id		( idType )
+import DataCon		( dataConTyCon, dataConType )
+import TyCon		( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
+import RdrName		( RdrName )
+import NameSet
+import PrelMods		( mAIN_Name, pREL_MAIN_Name )
+import TysWiredIn	( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
+import PrelInfo		( ioTyCon_NAME, thinAirIdNames )
+import Type		( namesOfType, funTyCon )
+import ErrUtils		( pprBagOfErrors, pprBagOfWarnings,
+			  doIfSet, dumpIfSet, ghcExit
+			)
+import BasicTypes	( NewOrData(..) )
+import Bag		( isEmptyBag, bagToList )
+import FiniteMap	( fmToList, delListFromFM, addToFM, sizeFM, eltsFM )
+import UniqSupply	( UniqSupply )
+import Util		( equivClasses )
+import Maybes		( maybeToBool )
+import Outputable
+\end{code}
+
+
+
+\begin{code}
+renameModule :: UniqSupply
+	     -> RdrNameHsModule
+	     -> IO (Maybe 
+	              ( Module
+		      , RenamedHsModule   -- Output, after renaming
+		      , InterfaceDetails  -- Interface; for interface file generation
+		      , RnNameSupply      -- Final env; for renaming derivings
+		      , [ModuleName]	  -- Imported modules; for profiling
+		      ))
+
+renameModule us this_mod@(HsModule mod_name vers exports imports local_decls loc)
+  = 	-- Initialise the renamer monad
+    initRn mod_name us (mkSearchPath opt_HiMap) loc
+	   (rename this_mod)				>>=
+	\ (maybe_rn_stuff, rn_errs_bag, rn_warns_bag) ->
+
+	-- Check for warnings
+    doIfSet (not (isEmptyBag rn_warns_bag))
+	    (printErrs (pprBagOfWarnings rn_warns_bag))	>>
+
+	-- Check for errors; exit if so
+    doIfSet (not (isEmptyBag rn_errs_bag))
+	    (printErrs (pprBagOfErrors rn_errs_bag)	 >>
+	     ghcExit 1
+	    )						 >>
+
+	-- Dump output, if any
+    (case maybe_rn_stuff of
+	Nothing  -> return ()
+	Just results@(_, rn_mod, _, _, _)
+		 -> dumpIfSet opt_D_dump_rn "Renamer:"
+			      (ppr rn_mod)
+    )							>>
+
+	-- Return results
+    return maybe_rn_stuff
+\end{code}
+
+
+\begin{code}
+rename this_mod@(HsModule mod_name vers exports imports local_decls loc)
+  =  	-- FIND THE GLOBAL NAME ENVIRONMENT
+    getGlobalNames this_mod			`thenRn` \ maybe_stuff ->
+
+	-- CHECK FOR EARLY EXIT
+    if not (maybeToBool maybe_stuff) then
+	-- Everything is up to date; no need to recompile further
+	rnStats []		`thenRn_`
+	returnRn Nothing
+    else
+    let
+  	Just (export_env, gbl_env, fixity_env, global_avail_env) = maybe_stuff
+    in
+
+	-- RENAME THE SOURCE
+    initRnMS gbl_env fixity_env SourceMode (
+	rnSourceDecls local_decls
+    )					`thenRn` \ (rn_local_decls, source_fvs) ->
+
+	-- SLURP IN ALL THE NEEDED DECLARATIONS
+    let
+	real_source_fvs = implicitFVs mod_name `plusFV` source_fvs
+		-- It's important to do the "plus" this way round, so that
+		-- when compiling the prelude, locally-defined (), Bool, etc
+		-- override the implicit ones. 
+    in
+    slurpImpDecls real_source_fvs	`thenRn` \ rn_imp_decls ->
+
+	-- EXIT IF ERRORS FOUND
+    checkErrsRn				`thenRn` \ no_errs_so_far ->
+    if not no_errs_so_far then
+	-- Found errors already, so exit now
+	rnStats []		`thenRn_`
+	returnRn Nothing
+    else
+
+	-- GENERATE THE VERSION/USAGE INFO
+    getImportVersions mod_name exports			`thenRn` \ my_usages ->
+    getNameSupplyRn					`thenRn` \ name_supply ->
+
+	-- REPORT UNUSED NAMES
+    reportUnusedNames gbl_env global_avail_env
+		      export_env
+		      source_fvs			`thenRn_`
+
+	-- RETURN THE RENAMED MODULE
+    let
+	has_orphans        = any isOrphanDecl rn_local_decls
+	direct_import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
+	rn_all_decls	   = rn_imp_decls ++ rn_local_decls 
+	renamed_module = HsModule mod_name vers 
+				  trashed_exports trashed_imports
+				  rn_all_decls
+			          loc
+    in
+    rnStats rn_imp_decls	`thenRn_`
+    returnRn (Just (mkThisModule mod_name,
+		    renamed_module, 
+		    (has_orphans, my_usages, export_env),
+		    name_supply,
+		    direct_import_mods))
+  where
+    trashed_exports  = {-trace "rnSource:trashed_exports"-} Nothing
+    trashed_imports  = {-trace "rnSource:trashed_imports"-} []
+\end{code}
+
+@implicitFVs@ forces the renamer to slurp in some things which aren't
+mentioned explicitly, but which might be needed by the type checker.
+
+\begin{code}
+implicitFVs mod_name
+  = implicit_main		`plusFV` 
+    mkNameSet default_tys	`plusFV`
+    mkNameSet thinAirIdNames
+  where
+	-- Add occurrences for Int, Double, and (), because they
+	-- are the types to which ambigious type variables may be defaulted by
+	-- the type checker; so they won't always appear explicitly.
+	-- [The () one is a GHC extension for defaulting CCall results.]
+	-- ALSO: funTyCon, since it occurs implicitly everywhere!
+	--  	 (we don't want to be bothered with making funTyCon a
+	--	  free var at every function application!)
+    default_tys = [getName intTyCon, getName doubleTyCon,
+		   getName unitTyCon, getName funTyCon, getName boolTyCon]
+
+	-- Add occurrences for IO or PrimIO
+    implicit_main |  mod_name == mAIN_Name
+		  || mod_name == pREL_MAIN_Name = unitFV ioTyCon_NAME
+		  |  otherwise 		        = emptyFVs
+\end{code}
+
+\begin{code}
+isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
+  = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames inst_ty))
+isOrphanDecl (RuleD (RuleDecl _ _ _ lhs _ _))
+  = check lhs
+  where
+    check (HsVar v)   = not (isLocallyDefined v)
+    check (HsApp f a) = check f && check a
+    check other	      = True
+isOrphanDecl other = False
+\end{code}
+
+
+%*********************************************************
+%*						 	 *
+\subsection{Slurping declarations}
+%*							 *
+%*********************************************************
+
+\begin{code}
+-------------------------------------------------------
+slurpImpDecls source_fvs
+  = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
+
+	-- The current slurped-set records all local things
+    getSlurped					`thenRn` \ source_binders ->
+    slurpSourceRefs source_binders source_fvs	`thenRn` \ (decls1, needed1, inst_gates) ->
+
+	-- Now we can get the instance decls
+    slurpInstDecls decls1 needed1 inst_gates	`thenRn` \ (decls2, needed2) ->
+
+	-- And finally get everything else
+    closeDecls	 decls2 needed2
+
+-------------------------------------------------------
+slurpSourceRefs :: NameSet			-- Variables defined in source
+		-> FreeVars			-- Variables referenced in source
+		-> RnMG ([RenamedHsDecl],
+			 FreeVars,		-- Un-satisfied needs
+			 FreeVars)		-- "Gates"
+-- The declaration (and hence home module) of each gate has
+-- already been loaded
+
+slurpSourceRefs source_binders source_fvs
+  = go [] 				-- Accumulating decls
+       emptyFVs 			-- Unsatisfied needs
+       source_fvs			-- Accumulating gates
+       (nameSetToList source_fvs)	-- Gates whose defn hasn't been loaded yet
+  where
+    go decls fvs gates []
+	= returnRn (decls, fvs, gates)
+
+    go decls fvs gates (wanted_name:refs) 
+	| isWiredInName wanted_name
+ 	= load_home wanted_name		`thenRn_`
+	  go decls fvs (gates `plusFV` getWiredInGates wanted_name) refs
+
+	| otherwise
+	= importDecl wanted_name 		`thenRn` \ maybe_decl ->
+	  case maybe_decl of
+		-- No declaration... (already slurped, or local)
+	    Nothing   -> go decls fvs gates refs
+	    Just decl -> rnIfaceDecl decl		`thenRn` \ (new_decl, fvs1) ->
+			 let
+			    new_gates = getGates source_fvs new_decl
+			 in
+			 go (new_decl : decls)
+			    (fvs1 `plusFV` fvs)
+			    (gates `plusFV` new_gates)
+			    (nameSetToList new_gates ++ refs)
+
+	-- When we find a wired-in name we must load its
+	-- home module so that we find any instance decls therein
+    load_home name 
+	| name `elemNameSet` source_binders = returnRn ()
+		-- When compiling the prelude, a wired-in thing may
+		-- be defined in this module, in which case we don't
+		-- want to load its home module!
+		-- Using 'isLocallyDefined' doesn't work because some of
+		-- the free variables returned are simply 'listTyCon_Name',
+		-- with a system provenance.  We could look them up every time
+		-- but that seems a waste.
+	| otherwise			      = loadHomeInterface doc name	`thenRn_`
+						returnRn ()
+        where
+	  doc = ptext SLIT("need home module for wired in thing") <+> ppr name
+
+-------------------------------------------------------
+-- slurpInstDecls imports appropriate instance decls.
+-- It has to incorporate a loop, because consider
+--	instance Foo a => Baz (Maybe a) where ...
+-- It may be that Baz and Maybe are used in the source module,
+-- but not Foo; so we need to chase Foo too.
+
+slurpInstDecls decls needed gates
+  | isEmptyFVs gates
+  = returnRn (decls, needed)
+
+  | otherwise
+  = getImportedInstDecls gates				`thenRn` \ inst_decls ->
+    rnInstDecls decls needed emptyFVs inst_decls	`thenRn` \ (decls1, needed1, gates1) ->
+    slurpInstDecls decls1 needed1 gates1
+  where
+    rnInstDecls decls fvs gates []
+	= returnRn (decls, fvs, gates)
+    rnInstDecls decls fvs gates (d:ds) 
+	= rnIfaceDecl d		`thenRn` \ (new_decl, fvs1) ->
+	  rnInstDecls (new_decl:decls) 
+		      (fvs1 `plusFV` fvs)
+		      (gates `plusFV` getInstDeclGates new_decl)
+		      ds
+    
+
+-------------------------------------------------------
+-- closeDecls keeps going until the free-var set is empty
+closeDecls decls needed
+  | not (isEmptyFVs needed)
+  = slurpDecls decls needed	`thenRn` \ (decls1, needed1) ->
+    closeDecls decls1 needed1
+
+  | otherwise
+  = getImportedRules 			`thenRn` \ rule_decls ->
+    case rule_decls of
+	[]    -> returnRn decls	-- No new rules, so we are done
+	other -> rnIfaceDecls decls emptyFVs rule_decls 	`thenRn` \ (decls1, needed1) ->
+		 closeDecls decls1 needed1
+		 
+
+-------------------------------------------------------
+rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
+	     -> [(Module, RdrNameHsDecl)]
+	     -> RnM d ([RenamedHsDecl], FreeVars)
+rnIfaceDecls decls fvs []     = returnRn (decls, fvs)
+rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d		`thenRn` \ (new_decl, fvs1) ->
+				rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
+
+rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)	
+			
+
+-------------------------------------------------------
+-- Augment decls with any decls needed by needed.
+-- Return also free vars of the new decls (only)
+slurpDecls decls needed
+  = go decls emptyFVs (nameSetToList needed) 
+  where
+    go decls fvs []         = returnRn (decls, fvs)
+    go decls fvs (ref:refs) = slurpDecl decls fvs ref	`thenRn` \ (decls1, fvs1) ->
+			      go decls1 fvs1 refs
+
+-------------------------------------------------------
+slurpDecl decls fvs wanted_name
+  = importDecl wanted_name 		`thenRn` \ maybe_decl ->
+    case maybe_decl of
+	-- No declaration... (wired in thing)
+	Nothing -> returnRn (decls, fvs)
+
+	-- Found a declaration... rename it
+	Just decl -> rnIfaceDecl decl		`thenRn` \ (new_decl, fvs1) ->
+		     returnRn (new_decl:decls, fvs1 `plusFV` fvs)
+\end{code}
+
+
+%*********************************************************
+%*						 	 *
+\subsection{Extracting the 'gates'}
+%*							 *
+%*********************************************************
+
+When we import a declaration like
+
+	data T = T1 Wibble | T2 Wobble
+
+we don't want to treat Wibble and Wobble as gates *unless* T1, T2
+respectively are mentioned by the user program.  If only T is mentioned
+we want only T to be a gate; that way we don't suck in useless instance
+decls for (say) Eq Wibble, when they can't possibly be useful.
+
+@getGates@ takes a newly imported (and renamed) decl, and the free
+vars of the source program, and extracts from the decl the gate names.
+
+\begin{code}
+getGates source_fvs (SigD (IfaceSig _ ty _ _))
+  = extractHsTyNames ty
+
+getGates source_fvs (TyClD (ClassDecl ctxt cls tvs sigs _ _ _ _ _ _))
+  = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
+		       (map getTyVarName tvs)
+    `addOneToNameSet` cls
+  where
+    get (ClassOpSig n _ ty _) 
+	| n `elemNameSet` source_fvs = extractHsTyNames ty
+	| otherwise		     = emptyFVs
+
+getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
+  = delListFromNameSet (extractHsTyNames ty)
+		       (map getTyVarName tvs)
+	-- A type synonym type constructor isn't a "gate" for instance decls
+
+getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _))
+  = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
+		       (map getTyVarName tvs)
+    `addOneToNameSet` tycon
+  where
+    get (ConDecl n tvs ctxt details _)
+	| n `elemNameSet` source_fvs
+		-- If the constructor is method, get fvs from all its fields
+	= delListFromNameSet (get_details details `plusFV` 
+		  	      extractHsCtxtTyNames ctxt)
+			     (map getTyVarName tvs)
+    get (ConDecl n tvs ctxt (RecCon fields) _)
+		-- Even if the constructor isn't mentioned, the fields
+		-- might be, as selectors.  They can't mention existentially
+		-- bound tyvars (typechecker checks for that) so no need for 
+		-- the deleteListFromNameSet part
+	= foldr (plusFV . get_field) emptyFVs fields
+	
+    get other_con = emptyFVs
+
+    get_details (VanillaCon tys) = plusFVs (map get_bang tys)
+    get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
+    get_details (RecCon fields)  = plusFVs [get_bang t | (_, t) <- fields]
+    get_details (NewCon t _)	 = extractHsTyNames t
+
+    get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
+		     | otherwise			 = emptyFVs
+
+    get_bang (Banged   t) = extractHsTyNames t
+    get_bang (Unbanged t) = extractHsTyNames t
+    get_bang (Unpacked t) = extractHsTyNames t
+
+getGates source_fvs other_decl = emptyFVs
+\end{code}
+
+getWiredInGates is just like getGates, but it sees a wired-in Name
+rather than a declaration.
+
+\begin{code}
+getWiredInGates :: Name -> FreeVars
+getWiredInGates name 	-- No classes are wired in
+  | is_id	         = getWiredInGates_s (namesOfType (idType the_id))
+  | isSynTyCon the_tycon = getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
+  | otherwise 	         = unitFV name
+  where
+    maybe_wired_in_id    = maybeWiredInIdName name
+    is_id		 = maybeToBool maybe_wired_in_id
+    maybe_wired_in_tycon = maybeWiredInTyConName name
+    Just the_id 	 = maybe_wired_in_id
+    Just the_tycon	 = maybe_wired_in_tycon
+    (tyvars,ty) 	 = getSynTyConDefn the_tycon
+
+getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
+\end{code}
+
+\begin{code}
+getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
+getInstDeclGates other				    = emptyFVs
+\end{code}
+
+
+%*********************************************************
+%*						 	 *
+\subsection{Unused names}
+%*							 *
+%*********************************************************
+
+\begin{code}
+reportUnusedNames gbl_env avail_env (ExportEnv export_avails _) mentioned_names
+  | not (opt_WarnUnusedBinds || opt_WarnUnusedImports)
+  = returnRn ()
+
+  | otherwise
+  = let
+	used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
+
+	-- Now, a use of C implies a use of T,
+	-- if C was brought into scope by T(..) or T(C)
+	really_used_names = used_names `unionNameSets`
+			    mkNameSet [ availName avail	
+				      | sub_name <- nameSetToList used_names,
+					let avail = case lookupNameEnv avail_env sub_name of
+							Just avail -> avail
+							Nothing -> pprTrace "r.u.n" (ppr sub_name) $
+								   Avail sub_name
+				      ]
+
+	defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
+	defined_but_not_used = nameSetToList (defined_names `minusNameSet` really_used_names)
+
+	-- Filter out the ones only defined implicitly
+	bad_guys = filter reportableUnusedName defined_but_not_used
+    in
+    warnUnusedTopNames bad_guys	`thenRn_`
+    returnRn ()
+
+reportableUnusedName :: Name -> Bool
+reportableUnusedName name
+  = explicitlyImported (getNameProvenance name) &&
+    not (startsWithUnderscore (occNameUserString (nameOccName name)))
+  where
+    explicitlyImported (LocalDef _ _) 		             = True	-- Report unused defns of local vars
+    explicitlyImported (NonLocalDef (UserImport _ _ expl) _) = expl 	-- Report unused explicit imports
+    explicitlyImported other			             = False	-- Don't report others
+   
+	-- Haskell 98 encourages compilers to suppress warnings about
+	-- unused names in a pattern if they start with "_".
+    startsWithUnderscore ('_' : _) = True	-- Suppress warnings for names starting
+    startsWithUnderscore other     = False	-- with an underscore
+
+rnStats :: [RenamedHsDecl] -> RnMG ()
+rnStats imp_decls
+        | opt_D_dump_rn_trace || 
+	  opt_D_dump_rn_stats ||
+	  opt_D_dump_rn 
+ 	= getRnStats imp_decls		`thenRn` \ msg ->
+	  ioToRnM (printErrs msg)	`thenRn_`
+	  returnRn ()
+
+	| otherwise = returnRn ()
+\end{code}
+
+
+
+%*********************************************************
+%*							*
+\subsection{Statistics}
+%*							*
+%*********************************************************
+
+\begin{code}
+getRnStats :: [RenamedHsDecl] -> RnMG SDoc
+getRnStats imported_decls
+  = getIfacesRn 		`thenRn` \ ifaces ->
+    let
+	n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)]
+
+	decls_read     = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
+					-- Data, newtype, and class decls are in the decls_fm
+					-- under multiple names; the tycon/class, and each
+					-- constructor/class op too.
+					-- The 'True' selects just the 'main' decl
+				 not (isLocallyDefined (availName avail))
+			     ]
+
+	(cd_rd, dd_rd, nd_rd, sd_rd, vd_rd,     _) = count_decls decls_read
+	(cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
+
+	unslurped_insts       = iInsts ifaces
+	inst_decls_unslurped  = length (bagToList unslurped_insts)
+	inst_decls_read	      = id_sp + inst_decls_unslurped
+
+	stats = vcat 
+		[int n_mods <+> text "interfaces read",
+		 hsep [ int cd_sp, text "class decls imported, out of", 
+		        int cd_rd, text "read"],
+		 hsep [ int dd_sp, text "data decls imported, out of",  
+			int dd_rd, text "read"],
+		 hsep [ int nd_sp, text "newtype decls imported, out of",  
+		        int nd_rd, text "read"],
+		 hsep [int sd_sp, text "type synonym decls imported, out of",  
+		        int sd_rd, text "read"],
+		 hsep [int vd_sp, text "value signatures imported, out of",  
+		        int vd_rd, text "read"],
+		 hsep [int id_sp, text "instance decls imported, out of",  
+		        int inst_decls_read, text "read"],
+		 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName) 
+					   [d | TyClD d <- imported_decls, isClassDecl d]),
+		 text "cls dcls read"  <+> fsep (map (ppr . tyClDeclName) 
+					   [d | TyClD d <- decls_read, isClassDecl d])]
+    in
+    returnRn (hcat [text "Renamer stats: ", stats])
+
+count_decls decls
+  = (class_decls, 
+     data_decls, 
+     newtype_decls,
+     syn_decls, 
+     val_decls, 
+     inst_decls)
+  where
+    tycl_decls = [d | TyClD d <- decls]
+    (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
+
+    val_decls     = length [() | SigD _	  <- decls]
+    inst_decls    = length [() | InstD _  <- decls]
+\end{code}    
+
diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
index b6f6d2cc2f29..b55f6feb8cce 100644
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -1,597 +1,607 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[RnBinds]{Renaming and dependency analysis of bindings}
-
-This module does renaming and dependency analysis on value bindings in
-the abstract syntax.  It does {\em not} do cycle-checks on class or
-type-synonym declarations; those cannot be done at this stage because
-they may be affected by renaming (which isn't fully worked out yet).
-
-\begin{code}
-module RnBinds (
-	rnTopBinds, rnTopMonoBinds,
-	rnMethodBinds, renameSigs,
-	rnBinds,
-	unknownSigErr
-   ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} RnSource ( rnHsSigType )
-
-import HsSyn
-import HsBinds		( sigsForMe )
-import RdrHsSyn
-import RnHsSyn
-import RnMonad
-import RnExpr		( rnMatch, rnGRHSs, rnPat, checkPrecMatch )
-import RnEnv		( bindLocatedLocalsRn, lookupBndrRn, lookupGlobalOccRn,
-			  warnUnusedLocalBinds, mapFvRn, 
-			  FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV,
-			  unknownNameErr
-			)
-import CmdLineOpts	( opt_WarnMissingSigs )
-import Digraph		( stronglyConnComp, SCC(..) )
-import Name		( OccName, Name, nameOccName )
-import NameSet
-import RdrName		( RdrName, rdrNameOcc  )
-import BasicTypes	( RecFlag(..), TopLevelFlag(..) )
-import Util		( thenCmp, removeDups )
-import List		( partition )
-import ListSetOps	( minusList )
-import Bag		( bagToList )
-import FiniteMap	( lookupFM, listToFM )
-import Maybe		( isJust )
-import Outputable
-\end{code}
-
--- ToDo: Put the annotations into the monad, so that they arrive in the proper
--- place and can be used when complaining.
-
-The code tree received by the function @rnBinds@ contains definitions
-in where-clauses which are all apparently mutually recursive, but which may
-not really depend upon each other. For example, in the top level program
-\begin{verbatim}
-f x = y where a = x
-	      y = x
-\end{verbatim}
-the definitions of @a@ and @y@ do not depend on each other at all.
-Unfortunately, the typechecker cannot always check such definitions.
-\footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
-definitions. In Proceedings of the International Symposium on Programming,
-Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
-However, the typechecker usually can check definitions in which only the
-strongly connected components have been collected into recursive bindings.
-This is precisely what the function @rnBinds@ does.
-
-ToDo: deal with case where a single monobinds binds the same variable
-twice.
-
-The vertag tag is a unique @Int@; the tags only need to be unique
-within one @MonoBinds@, so that unique-Int plumbing is done explicitly
-(heavy monad machinery not needed).
-
-\begin{code}
-type VertexTag	= Int
-type Cycle	= [VertexTag]
-type Edge	= (VertexTag, VertexTag)
-\end{code}
-
-%************************************************************************
-%*									*
-%* naming conventions							*
-%*									*
-%************************************************************************
-
-\subsection[name-conventions]{Name conventions}
-
-The basic algorithm involves walking over the tree and returning a tuple
-containing the new tree plus its free variables. Some functions, such
-as those walking polymorphic bindings (HsBinds) and qualifier lists in
-list comprehensions (@Quals@), return the variables bound in local
-environments. These are then used to calculate the free variables of the
-expression evaluated in these environments.
-
-Conventions for variable names are as follows:
-\begin{itemize}
-\item
-new code is given a prime to distinguish it from the old.
-
-\item
-a set of variables defined in @Exp@ is written @dvExp@
-
-\item
-a set of variables free in @Exp@ is written @fvExp@
-\end{itemize}
-
-%************************************************************************
-%*									*
-%* analysing polymorphic bindings (HsBinds, Bind, MonoBinds)		*
-%*									*
-%************************************************************************
-
-\subsubsection[dep-HsBinds]{Polymorphic bindings}
-
-Non-recursive expressions are reconstructed without any changes at top
-level, although their component expressions may have to be altered.
-However, non-recursive expressions are currently not expected as
-\Haskell{} programs, and this code should not be executed.
-
-Monomorphic bindings contain information that is returned in a tuple
-(a @FlatMonoBindsInfo@) containing:
-
-\begin{enumerate}
-\item
-a unique @Int@ that serves as the ``vertex tag'' for this binding.
-
-\item
-the name of a function or the names in a pattern. These are a set
-referred to as @dvLhs@, the defined variables of the left hand side.
-
-\item
-the free variables of the body. These are referred to as @fvBody@.
-
-\item
-the definition's actual code. This is referred to as just @code@.
-\end{enumerate}
-
-The function @nonRecDvFv@ returns two sets of variables. The first is
-the set of variables defined in the set of monomorphic bindings, while the
-second is the set of free variables in those bindings.
-
-The set of variables defined in a non-recursive binding is just the
-union of all of them, as @union@ removes duplicates. However, the
-free variables in each successive set of cumulative bindings is the
-union of those in the previous set plus those of the newest binding after
-the defined variables of the previous set have been removed.
-
-@rnMethodBinds@ deals only with the declarations in class and
-instance declarations.	It expects only to see @FunMonoBind@s, and
-it expects the global environment to contain bindings for the binders
-(which are all class operations).
-
-%************************************************************************
-%*									*
-%* 		Top-level bindings
-%*									*
-%************************************************************************
-
-@rnTopBinds@ assumes that the environment already
-contains bindings for the binders of this particular binding.
-
-\begin{code}
-rnTopBinds    :: RdrNameHsBinds -> RnMS (RenamedHsBinds, FreeVars)
-
-rnTopBinds EmptyBinds		       	  = returnRn (EmptyBinds, emptyFVs)
-rnTopBinds (MonoBind bind sigs _) 	  = rnTopMonoBinds bind sigs
-  -- The parser doesn't produce other forms
-
-
-rnTopMonoBinds EmptyMonoBinds sigs 
-  = returnRn (EmptyBinds, emptyFVs)
-
-rnTopMonoBinds mbinds sigs
- =  mapRn lookupBndrRn binder_rdr_names	`thenRn` \ binder_names ->
-    let
-	binder_set    = mkNameSet binder_names
-	binder_occ_fm = listToFM [(nameOccName x,x) | x <- binder_names]
-    in
-    renameSigs opt_WarnMissingSigs binder_set
-	       (lookupSigOccRn binder_occ_fm) sigs	`thenRn` \ (siglist, sig_fvs) ->
-    rn_mono_binds siglist mbinds			`thenRn` \ (final_binds, bind_fvs) ->
-    returnRn (final_binds, bind_fvs `plusFV` sig_fvs)
-  where
-    binder_rdr_names = map fst (bagToList (collectMonoBinders mbinds))
-
--- the names appearing in the sigs have to be bound by 
--- this group's binders.
-lookupSigOccRn binder_occ_fm rdr_name
-  = case lookupFM binder_occ_fm (rdrNameOcc rdr_name) of
-	Nothing -> failWithRn (mkUnboundName rdr_name)
-			      (unknownNameErr rdr_name)
-	Just x  -> returnRn x
-\end{code}
-
-%************************************************************************
-%*									*
-%* 		Nested binds
-%*									*
-%************************************************************************
-
-@rnMonoBinds@
-	- collects up the binders for this declaration group,
-	- checks that they form a set
-	- extends the environment to bind them to new local names
-	- calls @rnMonoBinds@ to do the real work
-
-\begin{code}
-rnBinds	      :: RdrNameHsBinds 
-	      -> (RenamedHsBinds -> RnMS (result, FreeVars))
-	      -> RnMS (result, FreeVars)
-
-rnBinds EmptyBinds	       thing_inside = thing_inside EmptyBinds
-rnBinds (MonoBind bind sigs _) thing_inside = rnMonoBinds bind sigs thing_inside
-  -- the parser doesn't produce other forms
-
-
-rnMonoBinds :: RdrNameMonoBinds 
-            -> [RdrNameSig]
-	    -> (RenamedHsBinds -> RnMS (result, FreeVars))
-	    -> RnMS (result, FreeVars)
-
-rnMonoBinds EmptyMonoBinds sigs thing_inside = thing_inside EmptyBinds
-
-rnMonoBinds mbinds sigs	thing_inside -- Non-empty monobinds
-  =	-- Extract all the binders in this group,
-	-- and extend current scope, inventing new names for the new binders
-	-- This also checks that the names form a set
-    bindLocatedLocalsRn (text "a binding group") mbinders_w_srclocs		$ \ new_mbinders ->
-    let
-	binder_set  = mkNameSet new_mbinders
-
-	   -- Weed out the fixity declarations that do not
-	   -- apply to any of the binders in this group.
-	(sigs_for_me, fixes_not_for_me) = partition forLocalBind sigs
-
-	forLocalBind (FixSig sig@(FixitySig name _ _ )) =
-	    isJust (lookupFM binder_occ_fm (rdrNameOcc name))
-	forLocalBind _ = True
-
-	binder_occ_fm = listToFM [(nameOccName x,x) | x <- new_mbinders]
-
-    in
-       -- Report the fixity declarations in this group that 
-       -- don't refer to any of the group's binders.
-       --
-    mapRn_ (unknownSigErr) fixes_not_for_me     `thenRn_`
-    renameSigs False binder_set
-	       (lookupSigOccRn binder_occ_fm) sigs_for_me   `thenRn` \ (siglist, sig_fvs) ->
-    let
-	fixity_sigs = [(name,sig) | FixSig sig@(FixitySig name _ _) <- siglist ]
-    in
-       -- Install the fixity declarations that do apply here and go.
-    extendFixityEnv fixity_sigs (
-      rn_mono_binds siglist mbinds
-    )	 				   `thenRn` \ (binds, bind_fvs) ->
-
-	-- Now do the "thing inside", and deal with the free-variable calculations
-    thing_inside binds					`thenRn` \ (result,result_fvs) ->
-    let
-	all_fvs        = result_fvs `plusFV` bind_fvs `plusFV` sig_fvs
-	unused_binders = nameSetToList (binder_set `minusNameSet` all_fvs)
-    in
-    warnUnusedLocalBinds unused_binders	`thenRn_`
-    returnRn (result, delListFromNameSet all_fvs new_mbinders)
-  where
-    mbinders_w_srclocs = bagToList (collectMonoBinders mbinds)
-\end{code}
-
-
-%************************************************************************
-%*									*
-%* 		MonoBinds -- the main work is done here
-%*									*
-%************************************************************************
-
-@rn_mono_binds@ is used by *both* top-level and nested bindings.  It
-assumes that all variables bound in this group are already in scope.
-This is done *either* by pass 3 (for the top-level bindings), *or* by
-@rnMonoBinds@ (for the nested ones).
-
-\begin{code}
-rn_mono_binds :: [RenamedSig]	        -- Signatures attached to this group
-	      -> RdrNameMonoBinds	
-	      -> RnMS (RenamedHsBinds, 	-- 
-		         FreeVars)	-- Free variables
-
-rn_mono_binds siglist mbinds
-  =
-	 -- Rename the bindings, returning a MonoBindsInfo
-	 -- which is a list of indivisible vertices so far as
-	 -- the strongly-connected-components (SCC) analysis is concerned
-    flattenMonoBinds siglist mbinds		`thenRn` \ mbinds_info ->
-
-	 -- Do the SCC analysis
-    let 
-        edges	    = mkEdges (mbinds_info `zip` [(0::Int)..])
-	scc_result  = stronglyConnComp edges
-	final_binds = foldr1 ThenBinds (map reconstructCycle scc_result)
-
-	 -- Deal with bound and free-var calculation
-	rhs_fvs = plusFVs [fvs | (_,fvs,_,_) <- mbinds_info]
-    in
-    returnRn (final_binds, rhs_fvs)
-\end{code}
-
-@flattenMonoBinds@ is ever-so-slightly magical in that it sticks
-unique ``vertex tags'' on its output; minor plumbing required.
-
-Sigh - need to pass along the signatures for the group of bindings,
-in case any of them 
-
-\begin{code}
-flattenMonoBinds :: [RenamedSig]		-- Signatures
-		 -> RdrNameMonoBinds
-		 -> RnMS [FlatMonoBindsInfo]
-
-flattenMonoBinds sigs EmptyMonoBinds = returnRn []
-
-flattenMonoBinds sigs (AndMonoBinds bs1 bs2)
-  = flattenMonoBinds sigs bs1	`thenRn` \ flat1 ->
-    flattenMonoBinds sigs bs2	`thenRn` \ flat2 ->
-    returnRn (flat1 ++ flat2)
-
-flattenMonoBinds sigs (PatMonoBind pat grhss locn)
-  = pushSrcLocRn locn		 	$
-    rnPat pat				`thenRn` \ (pat', pat_fvs) ->
-
-	 -- Find which things are bound in this group
-    let
-	names_bound_here = mkNameSet (collectPatBinders pat')
-	sigs_for_me      = sigsForMe (`elemNameSet` names_bound_here) sigs
-    in
-    rnGRHSs grhss			`thenRn` \ (grhss', fvs) ->
-    returnRn 
-	[(names_bound_here,
-	  fvs `plusFV` pat_fvs,
-	  PatMonoBind pat' grhss' locn,
-	  sigs_for_me
-	 )]
-
-flattenMonoBinds sigs (FunMonoBind name inf matches locn)
-  = pushSrcLocRn locn				 	$
-    lookupBndrRn name					`thenRn` \ new_name ->
-    let
-	sigs_for_me = sigsForMe (new_name ==) sigs
-    in
-    mapFvRn rnMatch matches				`thenRn` \ (new_matches, fvs) ->
-    mapRn_ (checkPrecMatch inf new_name) new_matches	`thenRn_`
-    returnRn
-      [(unitNameSet new_name,
-	fvs,
-	FunMonoBind new_name inf new_matches locn,
-	sigs_for_me
-	)]
-\end{code}
-
-
-@rnMethodBinds@ is used for the method bindings of a class and an instance
-declaration.   like @rnMonoBinds@ but without dependency analysis.
-
-\begin{code}
-rnMethodBinds :: RdrNameMonoBinds -> RnMS (RenamedMonoBinds, FreeVars)
-
-rnMethodBinds EmptyMonoBinds = returnRn (EmptyMonoBinds, emptyFVs)
-
-rnMethodBinds (AndMonoBinds mb1 mb2)
-  = rnMethodBinds mb1	`thenRn` \ (mb1', fvs1) ->
-    rnMethodBinds mb2	`thenRn` \ (mb2', fvs2) ->
-    returnRn (mb1' `AndMonoBinds` mb2', fvs1 `plusFV` fvs2)
-
-rnMethodBinds (FunMonoBind name inf matches locn)
-  = pushSrcLocRn locn				   	$
-
-    lookupGlobalOccRn name				`thenRn` \ sel_name -> 
-	-- We use the selector name as the binder
-
-    mapFvRn rnMatch matches				`thenRn` \ (new_matches, fvs) ->
-    mapRn_ (checkPrecMatch inf sel_name) new_matches	`thenRn_`
-    returnRn (FunMonoBind sel_name inf new_matches locn, fvs)
-
-rnMethodBinds (PatMonoBind (VarPatIn name) grhss locn)
-  = pushSrcLocRn locn			$
-    lookupGlobalOccRn name		`thenRn` \ sel_name -> 
-    rnGRHSs grhss			`thenRn` \ (grhss', fvs) ->
-    returnRn (PatMonoBind (VarPatIn sel_name) grhss' locn, fvs)
-
--- Can't handle method pattern-bindings which bind multiple methods.
-rnMethodBinds mbind@(PatMonoBind other_pat _ locn)
-  = pushSrcLocRn locn	$
-    failWithRn (EmptyMonoBinds, emptyFVs) (methodBindErr mbind)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[reconstruct-deps]{Reconstructing dependencies}
-%*									*
-%************************************************************************
-
-This @MonoBinds@- and @ClassDecls@-specific code is segregated here,
-as the two cases are similar.
-
-\begin{code}
-reconstructCycle :: SCC FlatMonoBindsInfo
-		 -> RenamedHsBinds
-
-reconstructCycle (AcyclicSCC (_, _, binds, sigs))
-  = MonoBind binds sigs NonRecursive
-
-reconstructCycle (CyclicSCC cycle)
-  = MonoBind this_gp_binds this_gp_sigs Recursive
-  where
-    this_gp_binds      = foldr1 AndMonoBinds [binds | (_, _, binds, _) <- cycle]
-    this_gp_sigs       = foldr1 (++)	     [sigs  | (_, _, _, sigs) <- cycle]
-\end{code}
-
-%************************************************************************
-%*									*
-%*	Manipulating FlatMonoBindInfo					*
-%*									*
-%************************************************************************
-
-During analysis a @MonoBinds@ is flattened to a @FlatMonoBindsInfo@.
-The @RenamedMonoBinds@ is always an empty bind, a pattern binding or
-a function binding, and has itself been dependency-analysed and
-renamed.
-
-\begin{code}
-type FlatMonoBindsInfo
-  = (NameSet,			-- Set of names defined in this vertex
-     NameSet,			-- Set of names used in this vertex
-     RenamedMonoBinds,
-     [RenamedSig])		-- Signatures, if any, for this vertex
-
-mkEdges :: [(FlatMonoBindsInfo, VertexTag)] -> [(FlatMonoBindsInfo, VertexTag, [VertexTag])]
-
-mkEdges flat_info
-  = [ (info, tag, dest_vertices (nameSetToList names_used))
-    | (info@(names_defined, names_used, mbind, sigs), tag) <- flat_info
-    ]
-  where
- 	 -- An edge (v,v') indicates that v depends on v'
-    dest_vertices src_mentions = [ target_vertex
-			         | ((names_defined, _, _, _), target_vertex) <- flat_info,
-				   mentioned_name <- src_mentions,
-				   mentioned_name `elemNameSet` names_defined
-			         ]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
-%*									*
-%************************************************************************
-
-@renameSigs@ checks for: (a)~more than one sig for one thing;
-(b)~signatures given for things not bound here; (c)~with suitably
-flaggery, that all top-level things have type signatures.
-
-At the moment we don't gather free-var info from the types in
-signatures.  We'd only need this if we wanted to report unused tyvars.
-
-\begin{code}
-renameSigs ::  Bool			-- True => warn if (required) type signatures are missing.
-	    -> NameSet			-- Set of names bound in this group
-	    -> (RdrName -> RnMS Name)
-	    -> [RdrNameSig]
-	    -> RnMS ([RenamedSig], FreeVars)		 -- List of Sig constructors
-
-renameSigs sigs_required binders lookup_occ_nm sigs
-  =	 -- Rename the signatures
-    mapFvRn (renameSig lookup_occ_nm) sigs   	`thenRn` \ (sigs', fvs) ->
-
-	-- Check for (a) duplicate signatures
-	--	     (b) signatures for things not in this group
-	--	     (c) optionally, bindings with no signature
-    let
-	(goodies, dups) = removeDups cmp_sig (sigsForMe (not . isUnboundName) sigs')
-	not_this_group  = sigsForMe (not . (`elemNameSet` binders)) goodies
-	type_sig_vars	= [n | Sig n _ _     <- goodies]
-	un_sigd_binders | sigs_required = nameSetToList binders `minusList` type_sig_vars
-			| otherwise	= []
-    in
-    mapRn_ dupSigDeclErr dups 				`thenRn_`
-    mapRn_ unknownSigErr not_this_group			`thenRn_`
-    mapRn_ (addWarnRn.missingSigWarn) un_sigd_binders	`thenRn_`
-    returnRn (sigs', fvs)	
-		-- bad ones and all:
-		-- we need bindings of *some* sort for every name
-
--- We use lookupOccRn in the signatures, which is a little bit unsatisfactory
--- because this won't work for:
---	instance Foo T where
---	  {-# INLINE op #-}
---	  Baz.op = ...
--- We'll just rename the INLINE prag to refer to whatever other 'op'
--- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
--- Doesn't seem worth much trouble to sort this.
-
-renameSig lookup_occ_nm (Sig v ty src_loc)
-  = pushSrcLocRn src_loc $
-    lookup_occ_nm v				`thenRn` \ new_v ->
-    rnHsSigType (quotes (ppr v)) ty		`thenRn` \ (new_ty,fvs) ->
-    returnRn (Sig new_v new_ty src_loc, fvs `addOneFV` new_v)
-
-renameSig _ (SpecInstSig ty src_loc)
-  = pushSrcLocRn src_loc $
-    rnHsSigType (text "A SPECIALISE instance pragma") ty	`thenRn` \ (new_ty, fvs) ->
-    returnRn (SpecInstSig new_ty src_loc, fvs)
-
-renameSig lookup_occ_nm (SpecSig v ty src_loc)
-  = pushSrcLocRn src_loc $
-    lookup_occ_nm v			`thenRn` \ new_v ->
-    rnHsSigType (quotes (ppr v)) ty	`thenRn` \ (new_ty,fvs) ->
-    returnRn (SpecSig new_v new_ty src_loc, fvs `addOneFV` new_v)
-
-renameSig lookup_occ_nm (InlineSig v src_loc)
-  = pushSrcLocRn src_loc $
-    lookup_occ_nm v		`thenRn` \ new_v ->
-    returnRn (InlineSig new_v src_loc, unitFV new_v)
-
-renameSig lookup_occ_nm (FixSig (FixitySig v fix src_loc))
-  = pushSrcLocRn src_loc $
-    lookup_occ_nm v		`thenRn` \ new_v ->
-    returnRn (FixSig (FixitySig new_v fix src_loc), unitFV new_v)
-
-renameSig lookup_occ_nm (NoInlineSig v src_loc)
-  = pushSrcLocRn src_loc $
-    lookup_occ_nm v		`thenRn` \ new_v ->
-    returnRn (NoInlineSig new_v src_loc, unitFV new_v)
-\end{code}
-
-Checking for distinct signatures; oh, so boring
-
-\begin{code}
-cmp_sig :: RenamedSig -> RenamedSig -> Ordering
-cmp_sig (Sig n1 _ _)	     (Sig n2 _ _)    	  = n1 `compare` n2
-cmp_sig (InlineSig n1 _)     (InlineSig n2 _) 	  = n1 `compare` n2
-cmp_sig (NoInlineSig n1 _)   (NoInlineSig n2 _)	  = n1 `compare` n2
-cmp_sig (SpecInstSig ty1 _)  (SpecInstSig ty2 _)  = cmpHsType compare ty1 ty2
-cmp_sig (SpecSig n1 ty1 _)   (SpecSig n2 ty2 _) 
-  = -- may have many specialisations for one value;
-    -- but not ones that are exactly the same...
-	thenCmp (n1 `compare` n2) (cmpHsType compare ty1 ty2)
-
-cmp_sig other_1 other_2					-- Tags *must* be different
-  | (sig_tag other_1) _LT_ (sig_tag other_2) = LT 
-  | otherwise				     = GT
-
-sig_tag (Sig n1 _ _)    	   = (ILIT(1) :: FAST_INT)
-sig_tag (SpecSig n1 _ _)    	   = ILIT(2)
-sig_tag (InlineSig n1 _)  	   = ILIT(3)
-sig_tag (NoInlineSig n1 _)  	   = ILIT(4)
-sig_tag (SpecInstSig _ _)	   = ILIT(5)
-sig_tag (FixSig _)		   = ILIT(6)
-sig_tag _			   = panic# "tag(RnBinds)"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Error messages}
-%*									*
-%************************************************************************
-
-\begin{code}
-dupSigDeclErr (sig:sigs)
-  = pushSrcLocRn loc $
-    addErrRn (sep [ptext SLIT("Duplicate") <+> ptext what_it_is <> colon,
-		   ppr sig])
-  where
-    (what_it_is, loc) = sig_doc sig
-
-unknownSigErr sig
-  = pushSrcLocRn loc $
-    addErrRn (sep [ptext SLIT("Misplaced"),
-		   ptext what_it_is <> colon,
-		   ppr sig])
-  where
-    (what_it_is, loc) = sig_doc sig
-
-sig_doc (Sig        _ _ loc) 	     = (SLIT("type signature"),loc)
-sig_doc (ClassOpSig _ _ _ loc) 	     = (SLIT("class-method type signature"), loc)
-sig_doc (SpecSig    _ _ loc) 	     = (SLIT("SPECIALISE pragma"),loc)
-sig_doc (InlineSig  _     loc) 	     = (SLIT("INLINE pragma"),loc)
-sig_doc (NoInlineSig  _   loc) 	     = (SLIT("NOINLINE pragma"),loc)
-sig_doc (SpecInstSig _ loc)	     = (SLIT("SPECIALISE instance pragma"),loc)
-sig_doc (FixSig (FixitySig _ _ loc)) = (SLIT("fixity declaration"), loc)
-
-missingSigWarn var
-  = sep [ptext SLIT("definition but no type signature for"), quotes (ppr var)]
-
-methodBindErr mbind
- =  hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))
-       4 (ppr mbind)
-\end{code}
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[RnBinds]{Renaming and dependency analysis of bindings}
+
+This module does renaming and dependency analysis on value bindings in
+the abstract syntax.  It does {\em not} do cycle-checks on class or
+type-synonym declarations; those cannot be done at this stage because
+they may be affected by renaming (which isn't fully worked out yet).
+
+\begin{code}
+module RnBinds (
+	rnTopBinds, rnTopMonoBinds,
+	rnMethodBinds, renameSigs,
+	rnBinds,
+	unknownSigErr
+   ) where
+
+#include "HsVersions.h"
+
+import {-# SOURCE #-} RnSource ( rnHsSigType )
+
+import HsSyn
+import HsBinds		( sigsForMe )
+import RdrHsSyn
+import RnHsSyn
+import RnMonad
+import RnExpr		( rnMatch, rnGRHSs, rnPat, checkPrecMatch )
+import RnEnv		( bindLocatedLocalsRn, lookupBndrRn, lookupGlobalOccRn,
+			  warnUnusedLocalBinds, mapFvRn, 
+			  FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV,
+			  unknownNameErr
+			)
+import CmdLineOpts	( opt_WarnMissingSigs )
+import Digraph		( stronglyConnComp, SCC(..) )
+import Name		( OccName, Name, nameOccName )
+import NameSet
+import RdrName		( RdrName, rdrNameOcc  )
+import BasicTypes	( RecFlag(..), TopLevelFlag(..) )
+import Util		( thenCmp, removeDups )
+import List		( partition )
+import ListSetOps	( minusList )
+import Bag		( bagToList )
+import FiniteMap	( lookupFM, listToFM )
+import Maybe		( isJust )
+import Outputable
+\end{code}
+
+-- ToDo: Put the annotations into the monad, so that they arrive in the proper
+-- place and can be used when complaining.
+
+The code tree received by the function @rnBinds@ contains definitions
+in where-clauses which are all apparently mutually recursive, but which may
+not really depend upon each other. For example, in the top level program
+\begin{verbatim}
+f x = y where a = x
+	      y = x
+\end{verbatim}
+the definitions of @a@ and @y@ do not depend on each other at all.
+Unfortunately, the typechecker cannot always check such definitions.
+\footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
+definitions. In Proceedings of the International Symposium on Programming,
+Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
+However, the typechecker usually can check definitions in which only the
+strongly connected components have been collected into recursive bindings.
+This is precisely what the function @rnBinds@ does.
+
+ToDo: deal with case where a single monobinds binds the same variable
+twice.
+
+The vertag tag is a unique @Int@; the tags only need to be unique
+within one @MonoBinds@, so that unique-Int plumbing is done explicitly
+(heavy monad machinery not needed).
+
+\begin{code}
+type VertexTag	= Int
+type Cycle	= [VertexTag]
+type Edge	= (VertexTag, VertexTag)
+\end{code}
+
+%************************************************************************
+%*									*
+%* naming conventions							*
+%*									*
+%************************************************************************
+
+\subsection[name-conventions]{Name conventions}
+
+The basic algorithm involves walking over the tree and returning a tuple
+containing the new tree plus its free variables. Some functions, such
+as those walking polymorphic bindings (HsBinds) and qualifier lists in
+list comprehensions (@Quals@), return the variables bound in local
+environments. These are then used to calculate the free variables of the
+expression evaluated in these environments.
+
+Conventions for variable names are as follows:
+\begin{itemize}
+\item
+new code is given a prime to distinguish it from the old.
+
+\item
+a set of variables defined in @Exp@ is written @dvExp@
+
+\item
+a set of variables free in @Exp@ is written @fvExp@
+\end{itemize}
+
+%************************************************************************
+%*									*
+%* analysing polymorphic bindings (HsBinds, Bind, MonoBinds)		*
+%*									*
+%************************************************************************
+
+\subsubsection[dep-HsBinds]{Polymorphic bindings}
+
+Non-recursive expressions are reconstructed without any changes at top
+level, although their component expressions may have to be altered.
+However, non-recursive expressions are currently not expected as
+\Haskell{} programs, and this code should not be executed.
+
+Monomorphic bindings contain information that is returned in a tuple
+(a @FlatMonoBindsInfo@) containing:
+
+\begin{enumerate}
+\item
+a unique @Int@ that serves as the ``vertex tag'' for this binding.
+
+\item
+the name of a function or the names in a pattern. These are a set
+referred to as @dvLhs@, the defined variables of the left hand side.
+
+\item
+the free variables of the body. These are referred to as @fvBody@.
+
+\item
+the definition's actual code. This is referred to as just @code@.
+\end{enumerate}
+
+The function @nonRecDvFv@ returns two sets of variables. The first is
+the set of variables defined in the set of monomorphic bindings, while the
+second is the set of free variables in those bindings.
+
+The set of variables defined in a non-recursive binding is just the
+union of all of them, as @union@ removes duplicates. However, the
+free variables in each successive set of cumulative bindings is the
+union of those in the previous set plus those of the newest binding after
+the defined variables of the previous set have been removed.
+
+@rnMethodBinds@ deals only with the declarations in class and
+instance declarations.	It expects only to see @FunMonoBind@s, and
+it expects the global environment to contain bindings for the binders
+(which are all class operations).
+
+%************************************************************************
+%*									*
+%* 		Top-level bindings
+%*									*
+%************************************************************************
+
+@rnTopBinds@ assumes that the environment already
+contains bindings for the binders of this particular binding.
+
+\begin{code}
+rnTopBinds    :: RdrNameHsBinds -> RnMS (RenamedHsBinds, FreeVars)
+
+rnTopBinds EmptyBinds		       	  = returnRn (EmptyBinds, emptyFVs)
+rnTopBinds (MonoBind bind sigs _) 	  = rnTopMonoBinds bind sigs
+  -- The parser doesn't produce other forms
+
+
+rnTopMonoBinds EmptyMonoBinds sigs 
+  = returnRn (EmptyBinds, emptyFVs)
+
+rnTopMonoBinds mbinds sigs
+ =  mapRn lookupBndrRn binder_rdr_names	`thenRn` \ binder_names ->
+    let
+	binder_set    = mkNameSet binder_names
+	binder_occ_fm = listToFM [(nameOccName x,x) | x <- binder_names]
+    in
+    renameSigs opt_WarnMissingSigs binder_set
+	       (lookupSigOccRn binder_occ_fm) sigs	`thenRn` \ (siglist, sig_fvs) ->
+    rn_mono_binds siglist mbinds			`thenRn` \ (final_binds, bind_fvs) ->
+    returnRn (final_binds, bind_fvs `plusFV` sig_fvs)
+  where
+    binder_rdr_names = map fst (bagToList (collectMonoBinders mbinds))
+
+-- the names appearing in the sigs have to be bound by 
+-- this group's binders.
+lookupSigOccRn binder_occ_fm rdr_name
+  = case lookupFM binder_occ_fm (rdrNameOcc rdr_name) of
+	Nothing -> failWithRn (mkUnboundName rdr_name)
+			      (unknownNameErr rdr_name)
+	Just x  -> returnRn x
+\end{code}
+
+%************************************************************************
+%*									*
+%* 		Nested binds
+%*									*
+%************************************************************************
+
+@rnMonoBinds@
+	- collects up the binders for this declaration group,
+	- checks that they form a set
+	- extends the environment to bind them to new local names
+	- calls @rnMonoBinds@ to do the real work
+
+\begin{code}
+rnBinds	      :: RdrNameHsBinds 
+	      -> (RenamedHsBinds -> RnMS (result, FreeVars))
+	      -> RnMS (result, FreeVars)
+
+rnBinds EmptyBinds	       thing_inside = thing_inside EmptyBinds
+rnBinds (MonoBind bind sigs _) thing_inside = rnMonoBinds bind sigs thing_inside
+  -- the parser doesn't produce other forms
+
+
+rnMonoBinds :: RdrNameMonoBinds 
+            -> [RdrNameSig]
+	    -> (RenamedHsBinds -> RnMS (result, FreeVars))
+	    -> RnMS (result, FreeVars)
+
+rnMonoBinds EmptyMonoBinds sigs thing_inside = thing_inside EmptyBinds
+
+rnMonoBinds mbinds sigs	thing_inside -- Non-empty monobinds
+  =	-- Extract all the binders in this group,
+	-- and extend current scope, inventing new names for the new binders
+	-- This also checks that the names form a set
+    bindLocatedLocalsRn (text "a binding group") mbinders_w_srclocs		$ \ new_mbinders ->
+    let
+	binder_set  = mkNameSet new_mbinders
+
+	   -- Weed out the fixity declarations that do not
+	   -- apply to any of the binders in this group.
+	(sigs_for_me, fixes_not_for_me) = partition forLocalBind sigs
+
+	forLocalBind (FixSig sig@(FixitySig name _ _ )) =
+	    isJust (lookupFM binder_occ_fm (rdrNameOcc name))
+	forLocalBind _ = True
+
+	binder_occ_fm = listToFM [(nameOccName x,x) | x <- new_mbinders]
+
+    in
+       -- Report the fixity declarations in this group that 
+       -- don't refer to any of the group's binders.
+       --
+    mapRn_ (unknownSigErr) fixes_not_for_me     `thenRn_`
+    renameSigs False binder_set
+	       (lookupSigOccRn binder_occ_fm) sigs_for_me   `thenRn` \ (siglist, sig_fvs) ->
+    let
+	fixity_sigs = [(name,sig) | FixSig sig@(FixitySig name _ _) <- siglist ]
+    in
+       -- Install the fixity declarations that do apply here and go.
+    extendFixityEnv fixity_sigs (
+      rn_mono_binds siglist mbinds
+    )	 				   `thenRn` \ (binds, bind_fvs) ->
+
+	-- Now do the "thing inside", and deal with the free-variable calculations
+    thing_inside binds					`thenRn` \ (result,result_fvs) ->
+    let
+	all_fvs        = result_fvs `plusFV` bind_fvs `plusFV` sig_fvs
+	unused_binders = nameSetToList (binder_set `minusNameSet` all_fvs)
+    in
+    warnUnusedLocalBinds unused_binders	`thenRn_`
+    returnRn (result, delListFromNameSet all_fvs new_mbinders)
+  where
+    mbinders_w_srclocs = bagToList (collectMonoBinders mbinds)
+\end{code}
+
+
+%************************************************************************
+%*									*
+%* 		MonoBinds -- the main work is done here
+%*									*
+%************************************************************************
+
+@rn_mono_binds@ is used by *both* top-level and nested bindings.  It
+assumes that all variables bound in this group are already in scope.
+This is done *either* by pass 3 (for the top-level bindings), *or* by
+@rnMonoBinds@ (for the nested ones).
+
+\begin{code}
+rn_mono_binds :: [RenamedSig]	        -- Signatures attached to this group
+	      -> RdrNameMonoBinds	
+	      -> RnMS (RenamedHsBinds, 	-- 
+		         FreeVars)	-- Free variables
+
+rn_mono_binds siglist mbinds
+  =
+	 -- Rename the bindings, returning a MonoBindsInfo
+	 -- which is a list of indivisible vertices so far as
+	 -- the strongly-connected-components (SCC) analysis is concerned
+    flattenMonoBinds siglist mbinds		`thenRn` \ mbinds_info ->
+
+	 -- Do the SCC analysis
+    let 
+        edges	    = mkEdges (mbinds_info `zip` [(0::Int)..])
+	scc_result  = stronglyConnComp edges
+	final_binds = foldr1 ThenBinds (map reconstructCycle scc_result)
+
+	 -- Deal with bound and free-var calculation
+	rhs_fvs = plusFVs [fvs | (_,fvs,_,_) <- mbinds_info]
+    in
+    returnRn (final_binds, rhs_fvs)
+\end{code}
+
+@flattenMonoBinds@ is ever-so-slightly magical in that it sticks
+unique ``vertex tags'' on its output; minor plumbing required.
+
+Sigh - need to pass along the signatures for the group of bindings,
+in case any of them 
+
+\begin{code}
+flattenMonoBinds :: [RenamedSig]		-- Signatures
+		 -> RdrNameMonoBinds
+		 -> RnMS [FlatMonoBindsInfo]
+
+flattenMonoBinds sigs EmptyMonoBinds = returnRn []
+
+flattenMonoBinds sigs (AndMonoBinds bs1 bs2)
+  = flattenMonoBinds sigs bs1	`thenRn` \ flat1 ->
+    flattenMonoBinds sigs bs2	`thenRn` \ flat2 ->
+    returnRn (flat1 ++ flat2)
+
+flattenMonoBinds sigs (PatMonoBind pat grhss locn)
+  = pushSrcLocRn locn		 	$
+    rnPat pat				`thenRn` \ (pat', pat_fvs) ->
+
+	 -- Find which things are bound in this group
+    let
+	names_bound_here = mkNameSet (collectPatBinders pat')
+	sigs_for_me      = sigsForMe (`elemNameSet` names_bound_here) sigs
+    in
+    rnGRHSs grhss			`thenRn` \ (grhss', fvs) ->
+    returnRn 
+	[(names_bound_here,
+	  fvs `plusFV` pat_fvs,
+	  PatMonoBind pat' grhss' locn,
+	  sigs_for_me
+	 )]
+
+flattenMonoBinds sigs (FunMonoBind name inf matches locn)
+  = pushSrcLocRn locn				 	$
+    lookupBndrRn name					`thenRn` \ new_name ->
+    let
+	sigs_for_me = sigsForMe (new_name ==) sigs
+    in
+    mapFvRn rnMatch matches				`thenRn` \ (new_matches, fvs) ->
+    mapRn_ (checkPrecMatch inf new_name) new_matches	`thenRn_`
+    returnRn
+      [(unitNameSet new_name,
+	fvs,
+	FunMonoBind new_name inf new_matches locn,
+	sigs_for_me
+	)]
+\end{code}
+
+
+@rnMethodBinds@ is used for the method bindings of a class and an instance
+declaration.   like @rnMonoBinds@ but without dependency analysis.
+
+NOTA BENE: we record each *binder* of a method-bind group as a free variable.
+That's crucial when dealing with an instance decl:
+	instance Foo (T a) where
+	   op x = ...
+This might be the *sole* occurrence of 'op' for an imported class Foo,
+and unless op occurs we won't treat the type signature of op in the class
+decl for Foo as a source of instance-decl gates.  But we should!  Indeed,
+in many ways the op in an instance decl is just like an occurrence, not
+a binder.
+
+\begin{code}
+rnMethodBinds :: RdrNameMonoBinds -> RnMS (RenamedMonoBinds, FreeVars)
+
+rnMethodBinds EmptyMonoBinds = returnRn (EmptyMonoBinds, emptyFVs)
+
+rnMethodBinds (AndMonoBinds mb1 mb2)
+  = rnMethodBinds mb1	`thenRn` \ (mb1', fvs1) ->
+    rnMethodBinds mb2	`thenRn` \ (mb2', fvs2) ->
+    returnRn (mb1' `AndMonoBinds` mb2', fvs1 `plusFV` fvs2)
+
+rnMethodBinds (FunMonoBind name inf matches locn)
+  = pushSrcLocRn locn				   	$
+
+    lookupGlobalOccRn name				`thenRn` \ sel_name -> 
+	-- We use the selector name as the binder
+
+    mapFvRn rnMatch matches				`thenRn` \ (new_matches, fvs) ->
+    mapRn_ (checkPrecMatch inf sel_name) new_matches	`thenRn_`
+    returnRn (FunMonoBind sel_name inf new_matches locn, fvs `addOneFV` sel_name)
+
+rnMethodBinds (PatMonoBind (VarPatIn name) grhss locn)
+  = pushSrcLocRn locn			$
+    lookupGlobalOccRn name		`thenRn` \ sel_name -> 
+    rnGRHSs grhss			`thenRn` \ (grhss', fvs) ->
+    returnRn (PatMonoBind (VarPatIn sel_name) grhss' locn, fvs `addOneFV` sel_name)
+
+-- Can't handle method pattern-bindings which bind multiple methods.
+rnMethodBinds mbind@(PatMonoBind other_pat _ locn)
+  = pushSrcLocRn locn	$
+    failWithRn (EmptyMonoBinds, emptyFVs) (methodBindErr mbind)
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection[reconstruct-deps]{Reconstructing dependencies}
+%*									*
+%************************************************************************
+
+This @MonoBinds@- and @ClassDecls@-specific code is segregated here,
+as the two cases are similar.
+
+\begin{code}
+reconstructCycle :: SCC FlatMonoBindsInfo
+		 -> RenamedHsBinds
+
+reconstructCycle (AcyclicSCC (_, _, binds, sigs))
+  = MonoBind binds sigs NonRecursive
+
+reconstructCycle (CyclicSCC cycle)
+  = MonoBind this_gp_binds this_gp_sigs Recursive
+  where
+    this_gp_binds      = foldr1 AndMonoBinds [binds | (_, _, binds, _) <- cycle]
+    this_gp_sigs       = foldr1 (++)	     [sigs  | (_, _, _, sigs) <- cycle]
+\end{code}
+
+%************************************************************************
+%*									*
+%*	Manipulating FlatMonoBindInfo					*
+%*									*
+%************************************************************************
+
+During analysis a @MonoBinds@ is flattened to a @FlatMonoBindsInfo@.
+The @RenamedMonoBinds@ is always an empty bind, a pattern binding or
+a function binding, and has itself been dependency-analysed and
+renamed.
+
+\begin{code}
+type FlatMonoBindsInfo
+  = (NameSet,			-- Set of names defined in this vertex
+     NameSet,			-- Set of names used in this vertex
+     RenamedMonoBinds,
+     [RenamedSig])		-- Signatures, if any, for this vertex
+
+mkEdges :: [(FlatMonoBindsInfo, VertexTag)] -> [(FlatMonoBindsInfo, VertexTag, [VertexTag])]
+
+mkEdges flat_info
+  = [ (info, tag, dest_vertices (nameSetToList names_used))
+    | (info@(names_defined, names_used, mbind, sigs), tag) <- flat_info
+    ]
+  where
+ 	 -- An edge (v,v') indicates that v depends on v'
+    dest_vertices src_mentions = [ target_vertex
+			         | ((names_defined, _, _, _), target_vertex) <- flat_info,
+				   mentioned_name <- src_mentions,
+				   mentioned_name `elemNameSet` names_defined
+			         ]
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
+%*									*
+%************************************************************************
+
+@renameSigs@ checks for: (a)~more than one sig for one thing;
+(b)~signatures given for things not bound here; (c)~with suitably
+flaggery, that all top-level things have type signatures.
+
+At the moment we don't gather free-var info from the types in
+signatures.  We'd only need this if we wanted to report unused tyvars.
+
+\begin{code}
+renameSigs ::  Bool			-- True => warn if (required) type signatures are missing.
+	    -> NameSet			-- Set of names bound in this group
+	    -> (RdrName -> RnMS Name)
+	    -> [RdrNameSig]
+	    -> RnMS ([RenamedSig], FreeVars)		 -- List of Sig constructors
+
+renameSigs sigs_required binders lookup_occ_nm sigs
+  =	 -- Rename the signatures
+    mapFvRn (renameSig lookup_occ_nm) sigs   	`thenRn` \ (sigs', fvs) ->
+
+	-- Check for (a) duplicate signatures
+	--	     (b) signatures for things not in this group
+	--	     (c) optionally, bindings with no signature
+    let
+	(goodies, dups) = removeDups cmp_sig (sigsForMe (not . isUnboundName) sigs')
+	not_this_group  = sigsForMe (not . (`elemNameSet` binders)) goodies
+	type_sig_vars	= [n | Sig n _ _     <- goodies]
+	un_sigd_binders | sigs_required = nameSetToList binders `minusList` type_sig_vars
+			| otherwise	= []
+    in
+    mapRn_ dupSigDeclErr dups 				`thenRn_`
+    mapRn_ unknownSigErr not_this_group			`thenRn_`
+    mapRn_ (addWarnRn.missingSigWarn) un_sigd_binders	`thenRn_`
+    returnRn (sigs', fvs)	
+		-- bad ones and all:
+		-- we need bindings of *some* sort for every name
+
+-- We use lookupOccRn in the signatures, which is a little bit unsatisfactory
+-- because this won't work for:
+--	instance Foo T where
+--	  {-# INLINE op #-}
+--	  Baz.op = ...
+-- We'll just rename the INLINE prag to refer to whatever other 'op'
+-- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
+-- Doesn't seem worth much trouble to sort this.
+
+renameSig lookup_occ_nm (Sig v ty src_loc)
+  = pushSrcLocRn src_loc $
+    lookup_occ_nm v				`thenRn` \ new_v ->
+    rnHsSigType (quotes (ppr v)) ty		`thenRn` \ (new_ty,fvs) ->
+    returnRn (Sig new_v new_ty src_loc, fvs `addOneFV` new_v)
+
+renameSig _ (SpecInstSig ty src_loc)
+  = pushSrcLocRn src_loc $
+    rnHsSigType (text "A SPECIALISE instance pragma") ty	`thenRn` \ (new_ty, fvs) ->
+    returnRn (SpecInstSig new_ty src_loc, fvs)
+
+renameSig lookup_occ_nm (SpecSig v ty src_loc)
+  = pushSrcLocRn src_loc $
+    lookup_occ_nm v			`thenRn` \ new_v ->
+    rnHsSigType (quotes (ppr v)) ty	`thenRn` \ (new_ty,fvs) ->
+    returnRn (SpecSig new_v new_ty src_loc, fvs `addOneFV` new_v)
+
+renameSig lookup_occ_nm (InlineSig v src_loc)
+  = pushSrcLocRn src_loc $
+    lookup_occ_nm v		`thenRn` \ new_v ->
+    returnRn (InlineSig new_v src_loc, unitFV new_v)
+
+renameSig lookup_occ_nm (FixSig (FixitySig v fix src_loc))
+  = pushSrcLocRn src_loc $
+    lookup_occ_nm v		`thenRn` \ new_v ->
+    returnRn (FixSig (FixitySig new_v fix src_loc), unitFV new_v)
+
+renameSig lookup_occ_nm (NoInlineSig v src_loc)
+  = pushSrcLocRn src_loc $
+    lookup_occ_nm v		`thenRn` \ new_v ->
+    returnRn (NoInlineSig new_v src_loc, unitFV new_v)
+\end{code}
+
+Checking for distinct signatures; oh, so boring
+
+\begin{code}
+cmp_sig :: RenamedSig -> RenamedSig -> Ordering
+cmp_sig (Sig n1 _ _)	     (Sig n2 _ _)    	  = n1 `compare` n2
+cmp_sig (InlineSig n1 _)     (InlineSig n2 _) 	  = n1 `compare` n2
+cmp_sig (NoInlineSig n1 _)   (NoInlineSig n2 _)	  = n1 `compare` n2
+cmp_sig (SpecInstSig ty1 _)  (SpecInstSig ty2 _)  = cmpHsType compare ty1 ty2
+cmp_sig (SpecSig n1 ty1 _)   (SpecSig n2 ty2 _) 
+  = -- may have many specialisations for one value;
+    -- but not ones that are exactly the same...
+	thenCmp (n1 `compare` n2) (cmpHsType compare ty1 ty2)
+
+cmp_sig other_1 other_2					-- Tags *must* be different
+  | (sig_tag other_1) _LT_ (sig_tag other_2) = LT 
+  | otherwise				     = GT
+
+sig_tag (Sig n1 _ _)    	   = (ILIT(1) :: FAST_INT)
+sig_tag (SpecSig n1 _ _)    	   = ILIT(2)
+sig_tag (InlineSig n1 _)  	   = ILIT(3)
+sig_tag (NoInlineSig n1 _)  	   = ILIT(4)
+sig_tag (SpecInstSig _ _)	   = ILIT(5)
+sig_tag (FixSig _)		   = ILIT(6)
+sig_tag _			   = panic# "tag(RnBinds)"
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{Error messages}
+%*									*
+%************************************************************************
+
+\begin{code}
+dupSigDeclErr (sig:sigs)
+  = pushSrcLocRn loc $
+    addErrRn (sep [ptext SLIT("Duplicate") <+> ptext what_it_is <> colon,
+		   ppr sig])
+  where
+    (what_it_is, loc) = sig_doc sig
+
+unknownSigErr sig
+  = pushSrcLocRn loc $
+    addErrRn (sep [ptext SLIT("Misplaced"),
+		   ptext what_it_is <> colon,
+		   ppr sig])
+  where
+    (what_it_is, loc) = sig_doc sig
+
+sig_doc (Sig        _ _ loc) 	     = (SLIT("type signature"),loc)
+sig_doc (ClassOpSig _ _ _ loc) 	     = (SLIT("class-method type signature"), loc)
+sig_doc (SpecSig    _ _ loc) 	     = (SLIT("SPECIALISE pragma"),loc)
+sig_doc (InlineSig  _     loc) 	     = (SLIT("INLINE pragma"),loc)
+sig_doc (NoInlineSig  _   loc) 	     = (SLIT("NOINLINE pragma"),loc)
+sig_doc (SpecInstSig _ loc)	     = (SLIT("SPECIALISE instance pragma"),loc)
+sig_doc (FixSig (FixitySig _ _ loc)) = (SLIT("fixity declaration"), loc)
+
+missingSigWarn var
+  = sep [ptext SLIT("definition but no type signature for"), quotes (ppr var)]
+
+methodBindErr mbind
+ =  hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))
+       4 (ppr mbind)
+\end{code}
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 687451c5384c..b303525674d1 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -1,709 +1,700 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[RnMonad]{The monad used by the renamer}
-
-\begin{code}
-module RnMonad(
-	module RnMonad,
-	Module,
-	FiniteMap,
-	Bag,
-	Name,
-	RdrNameHsDecl,
-	RdrNameInstDecl,
-	Version,
-	NameSet,
-	OccName,
-	Fixity
-    ) where
-
-#include "HsVersions.h"
-
-import PrelIOBase	( fixIO )	-- Should be in GlaExts
-import IOExts		( IORef, newIORef, readIORef, writeIORef, unsafePerformIO )
-	
-import HsSyn		
-import RdrHsSyn
-import RnHsSyn		( RenamedFixitySig )
-import BasicTypes	( Version )
-import SrcLoc		( noSrcLoc )
-import ErrUtils		( addShortErrLocLine, addShortWarnLocLine,
-			  pprBagOfErrors, ErrMsg, WarnMsg, Message
-			)
-import Name		( Name, OccName, NamedThing(..),
-			  isLocallyDefinedName, nameModule, nameOccName,
-			  decode, mkLocalName
-			)
-import Module		( Module, ModuleName, ModuleHiMap, SearchPath, WhereFrom,
-			  mkModuleHiMaps, moduleName
-			)
-import NameSet		
-import RdrName		( RdrName, dummyRdrVarName, rdrNameOcc )
-import CmdLineOpts	( opt_D_dump_rn_trace, opt_IgnoreIfacePragmas )
-import PrelInfo		( builtinNames )
-import TysWiredIn	( boolTyCon )
-import SrcLoc		( SrcLoc, mkGeneratedSrcLoc )
-import Unique		( Unique, getUnique, unboundKey )
-import UniqFM		( UniqFM )
-import FiniteMap	( FiniteMap, emptyFM, bagToFM, lookupFM, addToFM, addListToFM, 
-			  addListToFM_C, addToFM_C, eltsFM, fmToList
-			)
-import Bag		( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
-import Maybes		( mapMaybe )
-import UniqSet
-import UniqFM
-import UniqSupply
-import Util
-import Outputable
-
-infixr 9 `thenRn`, `thenRn_`
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Somewhat magical interface to other monads}
-%*									*
-%************************************************************************
-
-\begin{code}
-ioToRnM :: IO r -> RnM d (Either IOError r)
-ioToRnM io rn_down g_down = (io >>= \ ok -> return (Right ok)) 
-			    `catch` 
-			    (\ err -> return (Left err))
-	    
-traceRn :: SDoc -> RnM d ()
-traceRn msg | opt_D_dump_rn_trace = putDocRn msg
-	    | otherwise		  = returnRn ()
-
-putDocRn :: SDoc -> RnM d ()
-putDocRn msg = ioToRnM (printErrs msg)	`thenRn_`
-	       returnRn ()
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Data types}
-%*									*
-%************************************************************************
-
-===================================================
-		MONAD TYPES
-===================================================
-
-\begin{code}
-type RnM d r = RnDown -> d -> IO r
-type RnMS r  = RnM SDown r		-- Renaming source
-type RnMG r  = RnM ()    r		-- Getting global names etc
-
-	-- Common part
-data RnDown = RnDown {
-		  rn_mod     :: ModuleName,
-		  rn_loc     :: SrcLoc,
-		  rn_omit    :: Name -> Bool, 			-- True <=> omit qualifier when printing
-		  rn_ns      :: IORef RnNameSupply,
-		  rn_errs    :: IORef (Bag WarnMsg, Bag ErrMsg),
-	  	  rn_ifaces  :: IORef Ifaces,
-		  rn_hi_maps :: (ModuleHiMap,	-- for .hi files
-				 ModuleHiMap)	-- for .hi-boot files
-		}
-
-	-- For renaming source code
-data SDown = SDown {
-		  rn_mode :: RnMode,
-
-		  rn_genv :: GlobalRdrEnv,	-- Global envt; the fixity component gets extended
-						--   with local fixity decls
-
-		  rn_lenv :: LocalRdrEnv,	-- Local name envt
-					--   Does *not* includes global name envt; may shadow it
-					--   Includes both ordinary variables and type variables;
-					--   they are kept distinct because tyvar have a different
-					--   occurrence contructor (Name.TvOcc)
-					-- We still need the unsullied global name env so that
-					--   we can look up record field names
-
-		  rn_fixenv :: FixityEnv	-- Local fixities
-						-- The global ones are held in the
-						-- rn_ifaces field
-		}
-
-data RnMode	= SourceMode			-- Renaming source code
-		| InterfaceMode			-- Renaming interface declarations.  
-\end{code}
-
-===================================================
-		ENVIRONMENTS
-===================================================
-
-\begin{code}
---------------------------------
-type RdrNameEnv a = FiniteMap RdrName a
-type GlobalRdrEnv = RdrNameEnv [Name]	-- The list is because there may be name clashes
-					-- These only get reported on lookup,
-					-- not on construction
-type LocalRdrEnv  = RdrNameEnv Name
-
-emptyRdrEnv  :: RdrNameEnv a
-lookupRdrEnv :: RdrNameEnv a -> RdrName -> Maybe a
-addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
-extendRdrEnv	:: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
-
-emptyRdrEnv  = emptyFM
-lookupRdrEnv = lookupFM
-addListToRdrEnv = addListToFM
-rdrEnvElts	= eltsFM
-extendRdrEnv    = addToFM
-rdrEnvToList    = fmToList
-
---------------------------------
-type NameEnv a = UniqFM a	-- Domain is Name
-
-emptyNameEnv   :: NameEnv a
-nameEnvElts    :: NameEnv a -> [a]
-addToNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
-addToNameEnv   :: NameEnv a -> Name -> a -> NameEnv a
-plusNameEnv    :: NameEnv a -> NameEnv a -> NameEnv a
-extendNameEnv  :: NameEnv a -> [(Name,a)] -> NameEnv a
-lookupNameEnv  :: NameEnv a -> Name -> Maybe a
-delFromNameEnv :: NameEnv a -> Name -> NameEnv a
-elemNameEnv    :: Name -> NameEnv a -> Bool
-
-emptyNameEnv   = emptyUFM
-nameEnvElts    = eltsUFM
-addToNameEnv_C = addToUFM_C
-addToNameEnv   = addToUFM
-plusNameEnv    = plusUFM
-extendNameEnv  = addListToUFM
-lookupNameEnv  = lookupUFM
-delFromNameEnv = delFromUFM
-elemNameEnv    = elemUFM
-
---------------------------------
-type FixityEnv = NameEnv RenamedFixitySig
-	-- We keep the whole fixity sig so that we
-	-- can report line-number info when there is a duplicate
-	-- fixity declaration
-\end{code}
-
-\begin{code}
---------------------------------
-type RnNameSupply
- = ( UniqSupply
-
-   , FiniteMap (OccName, OccName) Int
-	-- This is used as a name supply for dictionary functions
-	-- From the inst decl we derive a (class, tycon) pair;
-	-- this map then gives a unique int for each inst decl with that
-	-- (class, tycon) pair.  (In Haskell 98 there can only be one,
-	-- but not so in more extended versions.)
-	--	
-	-- We could just use one Int for all the instance decls, but this
-	-- way the uniques change less when you add an instance decl,	
-	-- hence less recompilation
-
-   , FiniteMap (ModuleName, OccName) Name
-	-- Ensures that one (module,occname) pair gets one unique
-   )
-
-
---------------------------------
-data ExportEnv	  = ExportEnv Avails Fixities
-type Avails	  = [AvailInfo]
-type Fixities	  = [(Name, Fixity)]
-
-type ExportAvails = (FiniteMap ModuleName Avails,	-- Used to figure out "module M" export specifiers
-							-- Includes avails only from *unqualified* imports
-							-- (see 1.4 Report Section 5.1.1)
-
-		     NameEnv AvailInfo)		-- Used to figure out all other export specifiers.
-						-- Maps a Name to the AvailInfo that contains it
-
-
-data GenAvailInfo name	= Avail name		-- An ordinary identifier
-			| AvailTC name 		-- The name of the type or class
-				  [name]	-- The available pieces of type/class. NB: If the type or
-						-- class is itself to be in scope, it must be in this list.
-						-- Thus, typically: AvailTC Eq [Eq, ==, /=]
-type AvailInfo    = GenAvailInfo Name
-type RdrAvailInfo = GenAvailInfo OccName
-\end{code}
-
-===================================================
-		INTERFACE FILE STUFF
-===================================================
-
-\begin{code}
-type ExportItem		 = (ModuleName, [RdrAvailInfo])
-type VersionInfo name    = [ImportVersion name]
-
-type ImportVersion name  = (ModuleName, Version, WhetherHasOrphans, WhatsImported name)
-
-type WhetherHasOrphans   = Bool
-	-- An "orphan" is 
-	-- 	* an instance decl in a module other than the defn module for 
-	--		one of the tycons or classes in the instance head
-	--	* a transformation rule in a module other than the one defining
-	--		the function in the head of the rule.
-
-data WhatsImported name  = Everything 
-			 | Specifically [LocalVersion name]	-- List guaranteed non-empty
-
-    -- ("M", hif, ver, Everything) means there was a "module M" in 
-    -- this module's export list, so we just have to go by M's version, "ver",
-    -- not the list of LocalVersions.
-
-
-type LocalVersion name   = (name, Version)
-
-data ParsedIface
-  = ParsedIface {
-      pi_mod	   :: Version,		 		-- Module version number
-      pi_orphan    :: WhetherHasOrphans,		-- Whether this module has orphans
-      pi_usages	   :: [ImportVersion OccName],		-- Usages
-      pi_exports   :: [ExportItem],			-- Exports
-      pi_decls	   :: [(Version, RdrNameHsDecl)],	-- Local definitions
-      pi_insts	   :: [RdrNameInstDecl],		-- Local instance declarations
-      pi_rules	   :: [RdrNameRuleDecl]			-- Rules
-    }
-
-type InterfaceDetails = (WhetherHasOrphans,
-			 VersionInfo Name,	-- Version information for what this module imports
-			 ExportEnv)		-- What modules this one depends on
-
-
--- needed by Main to fish out the fixities assoc list.
-getIfaceFixities :: InterfaceDetails -> Fixities
-getIfaceFixities (_, _, ExportEnv _ fs) = fs
-
-
-type RdrNamePragma = ()				-- Fudge for now
--------------------
-
-data Ifaces = Ifaces {
-		iImpModInfo :: ImportedModuleInfo,
-				-- Modules this one depends on: that is, the union 
-				-- of the modules its direct imports depend on.
-
-		iDecls :: DeclsMap,	-- A single, global map of Names to decls
-
-		iFixes :: FixityEnv,	-- A single, global map of Names to fixities
-
-		iSlurp :: NameSet,	-- All the names (whether "big" or "small", whether wired-in or not,
-					-- whether locally defined or not) that have been slurped in so far.
-
-		iVSlurp :: [(Name,Version)],	-- All the (a) non-wired-in (b) "big" (c) non-locally-defined 
-						-- names that have been slurped in so far, with their versions. 
-						-- This is used to generate the "usage" information for this module.
-						-- Subset of the previous field.
-
-		iInsts :: Bag GatedDecl,
-				-- The as-yet un-slurped instance decls; this bag is depleted when we
-				-- slurp an instance decl so that we don't slurp the same one twice.
-				-- Each is 'gated' by the names that must be available before
-				-- this instance decl is needed.
-
-		iRules :: Bag GatedDecl
-				-- Ditto transformation rules
-	}
-
-type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
-
-type ImportedModuleInfo 
-     = FiniteMap ModuleName (Version, Bool, Maybe (Module, Bool, Avails))
-		-- Suppose the domain element is module 'A'
-		--
-		-- The first Bool is True if A contains 
-		-- 'orphan' rules or instance decls
-
-		-- The second Bool is true if the interface file actually
-		-- read was an .hi-boot file
-
-		-- Nothing => A's interface not yet read, but this module has
-		-- 	      imported a module, B, that itself depends on A
-		--
-		-- Just xx => A's interface has been read.  The Module in 
-		--		the Just has the correct Dll flag
-
-		-- This set is used to decide whether to look for
-		-- A.hi or A.hi-boot when importing A.f.
-		-- Basically, we look for A.hi if A is in the map, and A.hi-boot
-		-- otherwise
-
-type DeclsMap = NameEnv (Version, AvailInfo, Bool, (Module, RdrNameHsDecl))
-		-- A DeclsMap contains a binding for each Name in the declaration
-		-- including the constructors of a type decl etc.
-		-- The Bool is True just for the 'main' Name.
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Main monad code}
-%*									*
-%************************************************************************
-
-\begin{code}
-initRn :: ModuleName -> UniqSupply -> SearchPath -> SrcLoc
-       -> RnMG r
-       -> IO (r, Bag ErrMsg, Bag WarnMsg)
-
-initRn mod us dirs loc do_rn = do
-  himaps    <- mkModuleHiMaps dirs
-  names_var <- newIORef (us, emptyFM, builtins)
-  errs_var  <- newIORef (emptyBag,emptyBag)
-  iface_var <- newIORef emptyIfaces 
-  let
-        rn_down = RnDown { rn_loc = loc, rn_omit = \n -> False, rn_ns = names_var, 
-			   rn_errs = errs_var, 
-			   rn_hi_maps = himaps, 
-		  	   rn_ifaces = iface_var,
-			   rn_mod = mod }
-
-	-- do the business
-  res <- do_rn rn_down ()
-
-	-- grab errors and return
-  (warns, errs) <- readIORef errs_var
-
-  return (res, errs, warns)
-
-
-initRnMS :: GlobalRdrEnv -> FixityEnv -> RnMode -> RnMS r -> RnM d r
-initRnMS rn_env fixity_env mode thing_inside rn_down g_down
-  = let
-	s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv, 
-			 rn_fixenv = fixity_env, rn_mode = mode }
-    in
-    thing_inside rn_down s_down
-
-initIfaceRnMS :: Module -> RnMS r -> RnM d r
-initIfaceRnMS mod thing_inside 
-  = initRnMS emptyRdrEnv emptyNameEnv InterfaceMode $
-    setModuleRn (moduleName mod) thing_inside
-
-emptyIfaces :: Ifaces
-emptyIfaces = Ifaces { iImpModInfo = emptyFM,
-		       iDecls = emptyNameEnv,
-		       iFixes = emptyNameEnv,
-		       iSlurp = unitNameSet (mkUnboundName dummyRdrVarName),
-			-- Pretend that the dummy unbound name has already been
-			-- slurped.  This is what's returned for an out-of-scope name,
-			-- and we don't want thereby to try to suck it in!
-		       iVSlurp = [],
-		       iInsts = emptyBag,
-		       iRules = emptyBag
-	      }
-
--- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
--- during compiler debugging.
-mkUnboundName :: RdrName -> Name
-mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
-
-isUnboundName :: Name -> Bool
-isUnboundName name = getUnique name == unboundKey
-
-builtins :: FiniteMap (ModuleName,OccName) Name
-builtins = 
-   bagToFM (
-   mapBag (\ name ->  ((moduleName (nameModule name), nameOccName name), name))
- 	  builtinNames)
-\end{code}
-
-@renameSourceCode@ is used to rename stuff "out-of-line"; that is, not as part of
-the main renamer.  Sole examples: derived definitions, which are only generated
-in the type checker.
-
-The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than
-once you must either split it, or install a fresh unique supply.
-
-\begin{code}
-renameSourceCode :: ModuleName
-		 -> RnNameSupply
-	         -> RnMS r
-	         -> r
-
-renameSourceCode mod_name name_supply m
-  = unsafePerformIO (
-	-- It's not really unsafe!  When renaming source code we
-	-- only do any I/O if we need to read in a fixity declaration;
-	-- and that doesn't happen in pragmas etc
-
-	newIORef name_supply		>>= \ names_var ->
-	newIORef (emptyBag,emptyBag)	>>= \ errs_var ->
-    	let
-	    rn_down = RnDown { rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
-			       rn_errs = errs_var,
-			       rn_mod = mod_name }
-	    s_down = SDown { rn_mode = InterfaceMode,	-- So that we can refer to PrelBase.True etc
-			     rn_genv = emptyRdrEnv, rn_lenv = emptyRdrEnv,
-			     rn_fixenv = emptyNameEnv }
-	in
-	m rn_down s_down			>>= \ result ->
-	
-	readIORef errs_var			>>= \ (warns,errs) ->
-
-	(if not (isEmptyBag errs) then
-		pprTrace "Urk! renameSourceCode found errors" (display errs) 
-#ifdef DEBUG
-	 else if not (isEmptyBag warns) then
-		pprTrace "Note: renameSourceCode found warnings" (display warns)
-#endif
-	 else
-		id) $
-
-	return result
-    )
-  where
-    display errs = pprBagOfErrors errs
-
-{-# INLINE thenRn #-}
-{-# INLINE thenRn_ #-}
-{-# INLINE returnRn #-}
-{-# INLINE andRn #-}
-
-returnRn :: a -> RnM d a
-thenRn   :: RnM d a -> (a -> RnM d b) -> RnM d b
-thenRn_  :: RnM d a -> RnM d b -> RnM d b
-andRn    :: (a -> a -> a) -> RnM d a -> RnM d a -> RnM d a
-mapRn    :: (a -> RnM d b) -> [a] -> RnM d [b]
-mapRn_   :: (a -> RnM d b) -> [a] -> RnM d ()
-mapMaybeRn :: (a -> RnM d (Maybe b)) -> [a] -> RnM d [b]
-sequenceRn :: [RnM d a] -> RnM d [a]
-foldlRn :: (b  -> a -> RnM d b) -> b -> [a] -> RnM d b
-mapAndUnzipRn :: (a -> RnM d (b,c)) -> [a] -> RnM d ([b],[c])
-fixRn    :: (a -> RnM d a) -> RnM d a
-
-returnRn v gdown ldown  = return v
-thenRn m k gdown ldown  = m gdown ldown >>= \ r -> k r gdown ldown
-thenRn_ m k gdown ldown = m gdown ldown >> k gdown ldown
-fixRn m gdown ldown = fixIO (\r -> m r gdown ldown)
-andRn combiner m1 m2 gdown ldown
-  = m1 gdown ldown >>= \ res1 ->
-    m2 gdown ldown >>= \ res2 ->
-    return (combiner res1 res2)
-
-sequenceRn []     = returnRn []
-sequenceRn (m:ms) =  m			`thenRn` \ r ->
-		     sequenceRn ms 	`thenRn` \ rs ->
-		     returnRn (r:rs)
-
-mapRn f []     = returnRn []
-mapRn f (x:xs)
-  = f x		`thenRn` \ r ->
-    mapRn f xs 	`thenRn` \ rs ->
-    returnRn (r:rs)
-
-mapRn_ f []     = returnRn ()
-mapRn_ f (x:xs) = 
-    f x		`thenRn_`
-    mapRn_ f xs
-
-foldlRn k z [] = returnRn z
-foldlRn k z (x:xs) = k z x	`thenRn` \ z' ->
-		     foldlRn k z' xs
-
-mapAndUnzipRn f [] = returnRn ([],[])
-mapAndUnzipRn f (x:xs)
-  = f x		    	`thenRn` \ (r1,  r2)  ->
-    mapAndUnzipRn f xs	`thenRn` \ (rs1, rs2) ->
-    returnRn (r1:rs1, r2:rs2)
-
-mapAndUnzip3Rn f [] = returnRn ([],[],[])
-mapAndUnzip3Rn f (x:xs)
-  = f x		    	`thenRn` \ (r1,  r2,  r3)  ->
-    mapAndUnzip3Rn f xs	`thenRn` \ (rs1, rs2, rs3) ->
-    returnRn (r1:rs1, r2:rs2, r3:rs3)
-
-mapMaybeRn f []     = returnRn []
-mapMaybeRn f (x:xs) = f x		`thenRn` \ maybe_r ->
-		      mapMaybeRn f xs 	`thenRn` \ rs ->
-		      case maybe_r of
-			Nothing -> returnRn rs
-			Just r  -> returnRn (r:rs)
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Boring plumbing for common part}
-%*									*
-%************************************************************************
-
-
-================  Errors and warnings =====================
-
-\begin{code}
-failWithRn :: a -> Message -> RnM d a
-failWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
-  = readIORef  errs_var  					>>=  \ (warns,errs) ->
-    writeIORef errs_var (warns, errs `snocBag` err)		>> 
-    return res
-  where
-    err = addShortErrLocLine loc msg
-
-warnWithRn :: a -> Message -> RnM d a
-warnWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
-  = readIORef  errs_var  				 	>>=  \ (warns,errs) ->
-    writeIORef errs_var (warns `snocBag` warn, errs)	>> 
-    return res
-  where
-    warn = addShortWarnLocLine loc msg
-
-addErrRn :: Message -> RnM d ()
-addErrRn err = failWithRn () err
-
-checkRn :: Bool -> Message -> RnM d ()	-- Check that a condition is true
-checkRn False err = addErrRn err
-checkRn True  err = returnRn ()
-
-warnCheckRn :: Bool -> Message -> RnM d ()	-- Check that a condition is true
-warnCheckRn False err = addWarnRn err
-warnCheckRn True  err = returnRn ()
-
-addWarnRn :: Message -> RnM d ()
-addWarnRn warn = warnWithRn () warn
-
-checkErrsRn :: RnM d Bool		-- True <=> no errors so far
-checkErrsRn (RnDown {rn_errs = errs_var}) l_down
-  = readIORef  errs_var  				 	>>=  \ (warns,errs) ->
-    return (isEmptyBag errs)
-\end{code}
-
-
-================  Source location =====================
-
-\begin{code}
-pushSrcLocRn :: SrcLoc -> RnM d a -> RnM d a
-pushSrcLocRn loc' m down l_down
-  = m (down {rn_loc = loc'}) l_down
-
-getSrcLocRn :: RnM d SrcLoc
-getSrcLocRn down l_down
-  = return (rn_loc down)
-\end{code}
-
-================  Name supply =====================
-
-\begin{code}
-getNameSupplyRn :: RnM d RnNameSupply
-getNameSupplyRn rn_down l_down
-  = readIORef (rn_ns rn_down)
-
-setNameSupplyRn :: RnNameSupply -> RnM d ()
-setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
-  = writeIORef names_var names'
-
--- See comments with RnNameSupply above.
-newInstUniq :: (OccName, OccName) -> RnM d Int
-newInstUniq key (RnDown {rn_ns = names_var}) l_down
-  = readIORef names_var				>>= \ (us, mapInst, cache) ->
-    let
-	uniq = case lookupFM mapInst key of
-		   Just x  -> x+1
-		   Nothing -> 0
-	mapInst' = addToFM mapInst key uniq
-    in
-    writeIORef names_var (us, mapInst', cache)	>>
-    return uniq
-
-getUniqRn :: RnM d Unique
-getUniqRn (RnDown {rn_ns = names_var}) l_down
- = readIORef names_var >>= \ (us, mapInst, cache) ->
-   let
-     (us1,us') = splitUniqSupply us
-   in
-   writeIORef names_var (us', mapInst, cache)  >>
-   return (uniqFromSupply us1)
-\end{code}
-
-================  Module =====================
-
-\begin{code}
-getModuleRn :: RnM d ModuleName
-getModuleRn (RnDown {rn_mod = mod_name}) l_down
-  = return mod_name
-
-setModuleRn :: ModuleName -> RnM d a -> RnM d a
-setModuleRn new_mod enclosed_thing rn_down l_down
-  = enclosed_thing (rn_down {rn_mod = new_mod}) l_down
-\end{code}
-
-\begin{code}
-setOmitQualFn :: (Name -> Bool) -> RnM d a -> RnM d a
-setOmitQualFn fn m g_down l_down = m (g_down { rn_omit = fn }) l_down
-
-getOmitQualFn :: RnM d (Name -> Bool)
-getOmitQualFn (RnDown {rn_omit = omit_fn}) l_down
-  = return omit_fn
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Plumbing for rename-source part}
-%*									*
-%************************************************************************
-
-================  RnEnv  =====================
-
-\begin{code}
-getNameEnvs :: RnMS (GlobalRdrEnv, LocalRdrEnv)
-getNameEnvs rn_down (SDown {rn_genv = global_env, rn_lenv = local_env})
-  = return (global_env, local_env)
-
-getLocalNameEnv :: RnMS LocalRdrEnv
-getLocalNameEnv rn_down (SDown {rn_lenv = local_env})
-  = return local_env
-
-setLocalNameEnv :: LocalRdrEnv -> RnMS a -> RnMS a
-setLocalNameEnv local_env' m rn_down l_down
-  = m rn_down (l_down {rn_lenv = local_env'})
-
-getFixityEnv :: RnMS FixityEnv
-getFixityEnv rn_down (SDown {rn_fixenv = fixity_env})
-  = return fixity_env
-
-extendFixityEnv :: [(Name, RenamedFixitySig)] -> RnMS a -> RnMS a
-extendFixityEnv fixes enclosed_scope
-	        rn_down l_down@(SDown {rn_fixenv = fixity_env})
-  = let
-	new_fixity_env = extendNameEnv fixity_env fixes
-    in
-    enclosed_scope rn_down (l_down {rn_fixenv = new_fixity_env})
-\end{code}
-
-================  Mode  =====================
-
-\begin{code}
-getModeRn :: RnMS RnMode
-getModeRn rn_down (SDown {rn_mode = mode})
-  = return mode
-
-setModeRn :: RnMode -> RnMS a -> RnMS a
-setModeRn new_mode thing_inside rn_down l_down
-  = thing_inside rn_down (l_down {rn_mode = new_mode})
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Plumbing for rename-globals part}
-%*									*
-%************************************************************************
-
-\begin{code}
-getIfacesRn :: RnM d Ifaces
-getIfacesRn (RnDown {rn_ifaces = iface_var}) _
-  = readIORef iface_var
-
-setIfacesRn :: Ifaces -> RnM d ()
-setIfacesRn ifaces (RnDown {rn_ifaces = iface_var}) _
-  = writeIORef iface_var ifaces
-
-getHiMaps :: RnM d (ModuleHiMap, ModuleHiMap)
-getHiMaps (RnDown {rn_hi_maps = himaps}) _ 
-  = return himaps
-\end{code}
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[RnMonad]{The monad used by the renamer}
+
+\begin{code}
+module RnMonad(
+	module RnMonad,
+	Module,
+	FiniteMap,
+	Bag,
+	Name,
+	RdrNameHsDecl,
+	RdrNameInstDecl,
+	Version,
+	NameSet,
+	OccName,
+	Fixity
+    ) where
+
+#include "HsVersions.h"
+
+import PrelIOBase	( fixIO )	-- Should be in GlaExts
+import IOExts		( IORef, newIORef, readIORef, writeIORef, unsafePerformIO )
+	
+import HsSyn		
+import RdrHsSyn
+import RnHsSyn		( RenamedFixitySig )
+import BasicTypes	( Version )
+import SrcLoc		( noSrcLoc )
+import ErrUtils		( addShortErrLocLine, addShortWarnLocLine,
+			  pprBagOfErrors, ErrMsg, WarnMsg, Message
+			)
+import Name		( Name, OccName, NamedThing(..),
+			  isLocallyDefinedName, nameModule, nameOccName,
+			  decode, mkLocalName
+			)
+import Module		( Module, ModuleName, ModuleHiMap, SearchPath, WhereFrom,
+			  mkModuleHiMaps, moduleName
+			)
+import NameSet		
+import RdrName		( RdrName, dummyRdrVarName, rdrNameOcc )
+import CmdLineOpts	( opt_D_dump_rn_trace, opt_IgnoreIfacePragmas )
+import PrelInfo		( builtinNames )
+import TysWiredIn	( boolTyCon )
+import SrcLoc		( SrcLoc, mkGeneratedSrcLoc )
+import Unique		( Unique, getUnique, unboundKey )
+import UniqFM		( UniqFM )
+import FiniteMap	( FiniteMap, emptyFM, bagToFM, lookupFM, addToFM, addListToFM, 
+			  addListToFM_C, addToFM_C, eltsFM, fmToList
+			)
+import Bag		( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
+import Maybes		( mapMaybe )
+import UniqSet
+import UniqFM
+import UniqSupply
+import Util
+import Outputable
+
+infixr 9 `thenRn`, `thenRn_`
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Somewhat magical interface to other monads}
+%*									*
+%************************************************************************
+
+\begin{code}
+ioToRnM :: IO r -> RnM d (Either IOError r)
+ioToRnM io rn_down g_down = (io >>= \ ok -> return (Right ok)) 
+			    `catch` 
+			    (\ err -> return (Left err))
+	    
+traceRn :: SDoc -> RnM d ()
+traceRn msg | opt_D_dump_rn_trace = putDocRn msg
+	    | otherwise		  = returnRn ()
+
+putDocRn :: SDoc -> RnM d ()
+putDocRn msg = ioToRnM (printErrs msg)	`thenRn_`
+	       returnRn ()
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Data types}
+%*									*
+%************************************************************************
+
+===================================================
+		MONAD TYPES
+===================================================
+
+\begin{code}
+type RnM d r = RnDown -> d -> IO r
+type RnMS r  = RnM SDown r		-- Renaming source
+type RnMG r  = RnM ()    r		-- Getting global names etc
+
+	-- Common part
+data RnDown = RnDown {
+		  rn_mod     :: ModuleName,
+		  rn_loc     :: SrcLoc,
+		  rn_ns      :: IORef RnNameSupply,
+		  rn_errs    :: IORef (Bag WarnMsg, Bag ErrMsg),
+	  	  rn_ifaces  :: IORef Ifaces,
+		  rn_hi_maps :: (ModuleHiMap,	-- for .hi files
+				 ModuleHiMap)	-- for .hi-boot files
+		}
+
+	-- For renaming source code
+data SDown = SDown {
+		  rn_mode :: RnMode,
+
+		  rn_genv :: GlobalRdrEnv,	-- Global envt; the fixity component gets extended
+						--   with local fixity decls
+
+		  rn_lenv :: LocalRdrEnv,	-- Local name envt
+					--   Does *not* includes global name envt; may shadow it
+					--   Includes both ordinary variables and type variables;
+					--   they are kept distinct because tyvar have a different
+					--   occurrence contructor (Name.TvOcc)
+					-- We still need the unsullied global name env so that
+					--   we can look up record field names
+
+		  rn_fixenv :: FixityEnv	-- Local fixities
+						-- The global ones are held in the
+						-- rn_ifaces field
+		}
+
+data RnMode	= SourceMode			-- Renaming source code
+		| InterfaceMode			-- Renaming interface declarations.  
+\end{code}
+
+===================================================
+		ENVIRONMENTS
+===================================================
+
+\begin{code}
+--------------------------------
+type RdrNameEnv a = FiniteMap RdrName a
+type GlobalRdrEnv = RdrNameEnv [Name]	-- The list is because there may be name clashes
+					-- These only get reported on lookup,
+					-- not on construction
+type LocalRdrEnv  = RdrNameEnv Name
+
+emptyRdrEnv  :: RdrNameEnv a
+lookupRdrEnv :: RdrNameEnv a -> RdrName -> Maybe a
+addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
+extendRdrEnv	:: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
+
+emptyRdrEnv  = emptyFM
+lookupRdrEnv = lookupFM
+addListToRdrEnv = addListToFM
+rdrEnvElts	= eltsFM
+extendRdrEnv    = addToFM
+rdrEnvToList    = fmToList
+
+--------------------------------
+type NameEnv a = UniqFM a	-- Domain is Name
+
+emptyNameEnv   :: NameEnv a
+nameEnvElts    :: NameEnv a -> [a]
+addToNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
+addToNameEnv   :: NameEnv a -> Name -> a -> NameEnv a
+plusNameEnv    :: NameEnv a -> NameEnv a -> NameEnv a
+extendNameEnv  :: NameEnv a -> [(Name,a)] -> NameEnv a
+lookupNameEnv  :: NameEnv a -> Name -> Maybe a
+delFromNameEnv :: NameEnv a -> Name -> NameEnv a
+elemNameEnv    :: Name -> NameEnv a -> Bool
+
+emptyNameEnv   = emptyUFM
+nameEnvElts    = eltsUFM
+addToNameEnv_C = addToUFM_C
+addToNameEnv   = addToUFM
+plusNameEnv    = plusUFM
+extendNameEnv  = addListToUFM
+lookupNameEnv  = lookupUFM
+delFromNameEnv = delFromUFM
+elemNameEnv    = elemUFM
+
+--------------------------------
+type FixityEnv = NameEnv RenamedFixitySig
+	-- We keep the whole fixity sig so that we
+	-- can report line-number info when there is a duplicate
+	-- fixity declaration
+\end{code}
+
+\begin{code}
+--------------------------------
+type RnNameSupply
+ = ( UniqSupply
+
+   , FiniteMap (OccName, OccName) Int
+	-- This is used as a name supply for dictionary functions
+	-- From the inst decl we derive a (class, tycon) pair;
+	-- this map then gives a unique int for each inst decl with that
+	-- (class, tycon) pair.  (In Haskell 98 there can only be one,
+	-- but not so in more extended versions.)
+	--	
+	-- We could just use one Int for all the instance decls, but this
+	-- way the uniques change less when you add an instance decl,	
+	-- hence less recompilation
+
+   , FiniteMap (ModuleName, OccName) Name
+	-- Ensures that one (module,occname) pair gets one unique
+   )
+
+
+--------------------------------
+data ExportEnv	  = ExportEnv Avails Fixities
+type Avails	  = [AvailInfo]
+type Fixities	  = [(Name, Fixity)]
+
+type ExportAvails = (FiniteMap ModuleName Avails,	-- Used to figure out "module M" export specifiers
+							-- Includes avails only from *unqualified* imports
+							-- (see 1.4 Report Section 5.1.1)
+
+		     NameEnv AvailInfo)		-- Used to figure out all other export specifiers.
+						-- Maps a Name to the AvailInfo that contains it
+
+
+data GenAvailInfo name	= Avail name		-- An ordinary identifier
+			| AvailTC name 		-- The name of the type or class
+				  [name]	-- The available pieces of type/class. NB: If the type or
+						-- class is itself to be in scope, it must be in this list.
+						-- Thus, typically: AvailTC Eq [Eq, ==, /=]
+type AvailInfo    = GenAvailInfo Name
+type RdrAvailInfo = GenAvailInfo OccName
+\end{code}
+
+===================================================
+		INTERFACE FILE STUFF
+===================================================
+
+\begin{code}
+type ExportItem		 = (ModuleName, [RdrAvailInfo])
+type VersionInfo name    = [ImportVersion name]
+
+type ImportVersion name  = (ModuleName, Version, WhetherHasOrphans, WhatsImported name)
+
+type WhetherHasOrphans   = Bool
+	-- An "orphan" is 
+	-- 	* an instance decl in a module other than the defn module for 
+	--		one of the tycons or classes in the instance head
+	--	* a transformation rule in a module other than the one defining
+	--		the function in the head of the rule.
+
+data WhatsImported name  = Everything 
+			 | Specifically [LocalVersion name]	-- List guaranteed non-empty
+
+    -- ("M", hif, ver, Everything) means there was a "module M" in 
+    -- this module's export list, so we just have to go by M's version, "ver",
+    -- not the list of LocalVersions.
+
+
+type LocalVersion name   = (name, Version)
+
+data ParsedIface
+  = ParsedIface {
+      pi_mod	   :: Version,		 		-- Module version number
+      pi_orphan    :: WhetherHasOrphans,		-- Whether this module has orphans
+      pi_usages	   :: [ImportVersion OccName],		-- Usages
+      pi_exports   :: [ExportItem],			-- Exports
+      pi_decls	   :: [(Version, RdrNameHsDecl)],	-- Local definitions
+      pi_insts	   :: [RdrNameInstDecl],		-- Local instance declarations
+      pi_rules	   :: [RdrNameRuleDecl]			-- Rules
+    }
+
+type InterfaceDetails = (WhetherHasOrphans,
+			 VersionInfo Name,	-- Version information for what this module imports
+			 ExportEnv)		-- What modules this one depends on
+
+
+-- needed by Main to fish out the fixities assoc list.
+getIfaceFixities :: InterfaceDetails -> Fixities
+getIfaceFixities (_, _, ExportEnv _ fs) = fs
+
+
+type RdrNamePragma = ()				-- Fudge for now
+-------------------
+
+data Ifaces = Ifaces {
+		iImpModInfo :: ImportedModuleInfo,
+				-- Modules this one depends on: that is, the union 
+				-- of the modules its direct imports depend on.
+
+		iDecls :: DeclsMap,	-- A single, global map of Names to decls
+
+		iFixes :: FixityEnv,	-- A single, global map of Names to fixities
+
+		iSlurp :: NameSet,	-- All the names (whether "big" or "small", whether wired-in or not,
+					-- whether locally defined or not) that have been slurped in so far.
+
+		iVSlurp :: [(Name,Version)],	-- All the (a) non-wired-in (b) "big" (c) non-locally-defined 
+						-- names that have been slurped in so far, with their versions. 
+						-- This is used to generate the "usage" information for this module.
+						-- Subset of the previous field.
+
+		iInsts :: Bag GatedDecl,
+				-- The as-yet un-slurped instance decls; this bag is depleted when we
+				-- slurp an instance decl so that we don't slurp the same one twice.
+				-- Each is 'gated' by the names that must be available before
+				-- this instance decl is needed.
+
+		iRules :: Bag GatedDecl
+				-- Ditto transformation rules
+	}
+
+type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
+
+type ImportedModuleInfo 
+     = FiniteMap ModuleName (Version, Bool, Maybe (Module, Bool, Avails))
+		-- Suppose the domain element is module 'A'
+		--
+		-- The first Bool is True if A contains 
+		-- 'orphan' rules or instance decls
+
+		-- The second Bool is true if the interface file actually
+		-- read was an .hi-boot file
+
+		-- Nothing => A's interface not yet read, but this module has
+		-- 	      imported a module, B, that itself depends on A
+		--
+		-- Just xx => A's interface has been read.  The Module in 
+		--		the Just has the correct Dll flag
+
+		-- This set is used to decide whether to look for
+		-- A.hi or A.hi-boot when importing A.f.
+		-- Basically, we look for A.hi if A is in the map, and A.hi-boot
+		-- otherwise
+
+type DeclsMap = NameEnv (Version, AvailInfo, Bool, (Module, RdrNameHsDecl))
+		-- A DeclsMap contains a binding for each Name in the declaration
+		-- including the constructors of a type decl etc.
+		-- The Bool is True just for the 'main' Name.
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Main monad code}
+%*									*
+%************************************************************************
+
+\begin{code}
+initRn :: ModuleName -> UniqSupply -> SearchPath -> SrcLoc
+       -> RnMG r
+       -> IO (r, Bag ErrMsg, Bag WarnMsg)
+
+initRn mod us dirs loc do_rn = do
+  himaps    <- mkModuleHiMaps dirs
+  names_var <- newIORef (us, emptyFM, builtins)
+  errs_var  <- newIORef (emptyBag,emptyBag)
+  iface_var <- newIORef emptyIfaces 
+  let
+        rn_down = RnDown { rn_loc = loc, rn_ns = names_var, 
+			   rn_errs = errs_var, 
+			   rn_hi_maps = himaps, 
+		  	   rn_ifaces = iface_var,
+			   rn_mod = mod }
+
+	-- do the business
+  res <- do_rn rn_down ()
+
+	-- grab errors and return
+  (warns, errs) <- readIORef errs_var
+
+  return (res, errs, warns)
+
+
+initRnMS :: GlobalRdrEnv -> FixityEnv -> RnMode -> RnMS r -> RnM d r
+initRnMS rn_env fixity_env mode thing_inside rn_down g_down
+  = let
+	s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv, 
+			 rn_fixenv = fixity_env, rn_mode = mode }
+    in
+    thing_inside rn_down s_down
+
+initIfaceRnMS :: Module -> RnMS r -> RnM d r
+initIfaceRnMS mod thing_inside 
+  = initRnMS emptyRdrEnv emptyNameEnv InterfaceMode $
+    setModuleRn (moduleName mod) thing_inside
+
+emptyIfaces :: Ifaces
+emptyIfaces = Ifaces { iImpModInfo = emptyFM,
+		       iDecls = emptyNameEnv,
+		       iFixes = emptyNameEnv,
+		       iSlurp = unitNameSet (mkUnboundName dummyRdrVarName),
+			-- Pretend that the dummy unbound name has already been
+			-- slurped.  This is what's returned for an out-of-scope name,
+			-- and we don't want thereby to try to suck it in!
+		       iVSlurp = [],
+		       iInsts = emptyBag,
+		       iRules = emptyBag
+	      }
+
+-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
+-- during compiler debugging.
+mkUnboundName :: RdrName -> Name
+mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
+
+isUnboundName :: Name -> Bool
+isUnboundName name = getUnique name == unboundKey
+
+builtins :: FiniteMap (ModuleName,OccName) Name
+builtins = 
+   bagToFM (
+   mapBag (\ name ->  ((moduleName (nameModule name), nameOccName name), name))
+ 	  builtinNames)
+\end{code}
+
+@renameSourceCode@ is used to rename stuff "out-of-line"; that is, not as part of
+the main renamer.  Sole examples: derived definitions, which are only generated
+in the type checker.
+
+The @RnNameSupply@ includes a @UniqueSupply@, so if you call it more than
+once you must either split it, or install a fresh unique supply.
+
+\begin{code}
+renameSourceCode :: ModuleName
+		 -> RnNameSupply
+	         -> RnMS r
+	         -> r
+
+renameSourceCode mod_name name_supply m
+  = unsafePerformIO (
+	-- It's not really unsafe!  When renaming source code we
+	-- only do any I/O if we need to read in a fixity declaration;
+	-- and that doesn't happen in pragmas etc
+
+	newIORef name_supply		>>= \ names_var ->
+	newIORef (emptyBag,emptyBag)	>>= \ errs_var ->
+    	let
+	    rn_down = RnDown { rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
+			       rn_errs = errs_var,
+			       rn_mod = mod_name }
+	    s_down = SDown { rn_mode = InterfaceMode,	-- So that we can refer to PrelBase.True etc
+			     rn_genv = emptyRdrEnv, rn_lenv = emptyRdrEnv,
+			     rn_fixenv = emptyNameEnv }
+	in
+	m rn_down s_down			>>= \ result ->
+	
+	readIORef errs_var			>>= \ (warns,errs) ->
+
+	(if not (isEmptyBag errs) then
+		pprTrace "Urk! renameSourceCode found errors" (display errs) 
+#ifdef DEBUG
+	 else if not (isEmptyBag warns) then
+		pprTrace "Note: renameSourceCode found warnings" (display warns)
+#endif
+	 else
+		id) $
+
+	return result
+    )
+  where
+    display errs = pprBagOfErrors errs
+
+{-# INLINE thenRn #-}
+{-# INLINE thenRn_ #-}
+{-# INLINE returnRn #-}
+{-# INLINE andRn #-}
+
+returnRn :: a -> RnM d a
+thenRn   :: RnM d a -> (a -> RnM d b) -> RnM d b
+thenRn_  :: RnM d a -> RnM d b -> RnM d b
+andRn    :: (a -> a -> a) -> RnM d a -> RnM d a -> RnM d a
+mapRn    :: (a -> RnM d b) -> [a] -> RnM d [b]
+mapRn_   :: (a -> RnM d b) -> [a] -> RnM d ()
+mapMaybeRn :: (a -> RnM d (Maybe b)) -> [a] -> RnM d [b]
+sequenceRn :: [RnM d a] -> RnM d [a]
+foldlRn :: (b  -> a -> RnM d b) -> b -> [a] -> RnM d b
+mapAndUnzipRn :: (a -> RnM d (b,c)) -> [a] -> RnM d ([b],[c])
+fixRn    :: (a -> RnM d a) -> RnM d a
+
+returnRn v gdown ldown  = return v
+thenRn m k gdown ldown  = m gdown ldown >>= \ r -> k r gdown ldown
+thenRn_ m k gdown ldown = m gdown ldown >> k gdown ldown
+fixRn m gdown ldown = fixIO (\r -> m r gdown ldown)
+andRn combiner m1 m2 gdown ldown
+  = m1 gdown ldown >>= \ res1 ->
+    m2 gdown ldown >>= \ res2 ->
+    return (combiner res1 res2)
+
+sequenceRn []     = returnRn []
+sequenceRn (m:ms) =  m			`thenRn` \ r ->
+		     sequenceRn ms 	`thenRn` \ rs ->
+		     returnRn (r:rs)
+
+mapRn f []     = returnRn []
+mapRn f (x:xs)
+  = f x		`thenRn` \ r ->
+    mapRn f xs 	`thenRn` \ rs ->
+    returnRn (r:rs)
+
+mapRn_ f []     = returnRn ()
+mapRn_ f (x:xs) = 
+    f x		`thenRn_`
+    mapRn_ f xs
+
+foldlRn k z [] = returnRn z
+foldlRn k z (x:xs) = k z x	`thenRn` \ z' ->
+		     foldlRn k z' xs
+
+mapAndUnzipRn f [] = returnRn ([],[])
+mapAndUnzipRn f (x:xs)
+  = f x		    	`thenRn` \ (r1,  r2)  ->
+    mapAndUnzipRn f xs	`thenRn` \ (rs1, rs2) ->
+    returnRn (r1:rs1, r2:rs2)
+
+mapAndUnzip3Rn f [] = returnRn ([],[],[])
+mapAndUnzip3Rn f (x:xs)
+  = f x		    	`thenRn` \ (r1,  r2,  r3)  ->
+    mapAndUnzip3Rn f xs	`thenRn` \ (rs1, rs2, rs3) ->
+    returnRn (r1:rs1, r2:rs2, r3:rs3)
+
+mapMaybeRn f []     = returnRn []
+mapMaybeRn f (x:xs) = f x		`thenRn` \ maybe_r ->
+		      mapMaybeRn f xs 	`thenRn` \ rs ->
+		      case maybe_r of
+			Nothing -> returnRn rs
+			Just r  -> returnRn (r:rs)
+\end{code}
+
+
+
+%************************************************************************
+%*									*
+\subsection{Boring plumbing for common part}
+%*									*
+%************************************************************************
+
+
+================  Errors and warnings =====================
+
+\begin{code}
+failWithRn :: a -> Message -> RnM d a
+failWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
+  = readIORef  errs_var  					>>=  \ (warns,errs) ->
+    writeIORef errs_var (warns, errs `snocBag` err)		>> 
+    return res
+  where
+    err = addShortErrLocLine loc msg
+
+warnWithRn :: a -> Message -> RnM d a
+warnWithRn res msg (RnDown {rn_errs = errs_var, rn_loc = loc}) l_down
+  = readIORef  errs_var  				 	>>=  \ (warns,errs) ->
+    writeIORef errs_var (warns `snocBag` warn, errs)	>> 
+    return res
+  where
+    warn = addShortWarnLocLine loc msg
+
+addErrRn :: Message -> RnM d ()
+addErrRn err = failWithRn () err
+
+checkRn :: Bool -> Message -> RnM d ()	-- Check that a condition is true
+checkRn False err = addErrRn err
+checkRn True  err = returnRn ()
+
+warnCheckRn :: Bool -> Message -> RnM d ()	-- Check that a condition is true
+warnCheckRn False err = addWarnRn err
+warnCheckRn True  err = returnRn ()
+
+addWarnRn :: Message -> RnM d ()
+addWarnRn warn = warnWithRn () warn
+
+checkErrsRn :: RnM d Bool		-- True <=> no errors so far
+checkErrsRn (RnDown {rn_errs = errs_var}) l_down
+  = readIORef  errs_var  				 	>>=  \ (warns,errs) ->
+    return (isEmptyBag errs)
+\end{code}
+
+
+================  Source location =====================
+
+\begin{code}
+pushSrcLocRn :: SrcLoc -> RnM d a -> RnM d a
+pushSrcLocRn loc' m down l_down
+  = m (down {rn_loc = loc'}) l_down
+
+getSrcLocRn :: RnM d SrcLoc
+getSrcLocRn down l_down
+  = return (rn_loc down)
+\end{code}
+
+================  Name supply =====================
+
+\begin{code}
+getNameSupplyRn :: RnM d RnNameSupply
+getNameSupplyRn rn_down l_down
+  = readIORef (rn_ns rn_down)
+
+setNameSupplyRn :: RnNameSupply -> RnM d ()
+setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
+  = writeIORef names_var names'
+
+-- See comments with RnNameSupply above.
+newInstUniq :: (OccName, OccName) -> RnM d Int
+newInstUniq key (RnDown {rn_ns = names_var}) l_down
+  = readIORef names_var				>>= \ (us, mapInst, cache) ->
+    let
+	uniq = case lookupFM mapInst key of
+		   Just x  -> x+1
+		   Nothing -> 0
+	mapInst' = addToFM mapInst key uniq
+    in
+    writeIORef names_var (us, mapInst', cache)	>>
+    return uniq
+
+getUniqRn :: RnM d Unique
+getUniqRn (RnDown {rn_ns = names_var}) l_down
+ = readIORef names_var >>= \ (us, mapInst, cache) ->
+   let
+     (us1,us') = splitUniqSupply us
+   in
+   writeIORef names_var (us', mapInst, cache)  >>
+   return (uniqFromSupply us1)
+\end{code}
+
+================  Module =====================
+
+\begin{code}
+getModuleRn :: RnM d ModuleName
+getModuleRn (RnDown {rn_mod = mod_name}) l_down
+  = return mod_name
+
+setModuleRn :: ModuleName -> RnM d a -> RnM d a
+setModuleRn new_mod enclosed_thing rn_down l_down
+  = enclosed_thing (rn_down {rn_mod = new_mod}) l_down
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Plumbing for rename-source part}
+%*									*
+%************************************************************************
+
+================  RnEnv  =====================
+
+\begin{code}
+getNameEnvs :: RnMS (GlobalRdrEnv, LocalRdrEnv)
+getNameEnvs rn_down (SDown {rn_genv = global_env, rn_lenv = local_env})
+  = return (global_env, local_env)
+
+getLocalNameEnv :: RnMS LocalRdrEnv
+getLocalNameEnv rn_down (SDown {rn_lenv = local_env})
+  = return local_env
+
+setLocalNameEnv :: LocalRdrEnv -> RnMS a -> RnMS a
+setLocalNameEnv local_env' m rn_down l_down
+  = m rn_down (l_down {rn_lenv = local_env'})
+
+getFixityEnv :: RnMS FixityEnv
+getFixityEnv rn_down (SDown {rn_fixenv = fixity_env})
+  = return fixity_env
+
+extendFixityEnv :: [(Name, RenamedFixitySig)] -> RnMS a -> RnMS a
+extendFixityEnv fixes enclosed_scope
+	        rn_down l_down@(SDown {rn_fixenv = fixity_env})
+  = let
+	new_fixity_env = extendNameEnv fixity_env fixes
+    in
+    enclosed_scope rn_down (l_down {rn_fixenv = new_fixity_env})
+\end{code}
+
+================  Mode  =====================
+
+\begin{code}
+getModeRn :: RnMS RnMode
+getModeRn rn_down (SDown {rn_mode = mode})
+  = return mode
+
+setModeRn :: RnMode -> RnMS a -> RnMS a
+setModeRn new_mode thing_inside rn_down l_down
+  = thing_inside rn_down (l_down {rn_mode = new_mode})
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Plumbing for rename-globals part}
+%*									*
+%************************************************************************
+
+\begin{code}
+getIfacesRn :: RnM d Ifaces
+getIfacesRn (RnDown {rn_ifaces = iface_var}) _
+  = readIORef iface_var
+
+setIfacesRn :: Ifaces -> RnM d ()
+setIfacesRn ifaces (RnDown {rn_ifaces = iface_var}) _
+  = writeIORef iface_var ifaces
+
+getHiMaps :: RnM d (ModuleHiMap, ModuleHiMap)
+getHiMaps (RnDown {rn_hi_maps = himaps}) _ 
+  = return himaps
+\end{code}
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 0b7691f7bb0e..633735bd1c07 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -1,698 +1,694 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[RnNames]{Extracting imported and top-level names in scope}
-
-\begin{code}
-module RnNames (
-	getGlobalNames
-    ) where
-
-#include "HsVersions.h"
-
-import CmdLineOpts    ( opt_NoImplicitPrelude, opt_WarnDuplicateExports, 
-			opt_SourceUnchanged, opt_WarnUnusedBinds
-		      )
-
-import HsSyn	( HsModule(..), HsDecl(..), TyClDecl(..),
-		  IE(..), ieName, 
-		  ForeignDecl(..), ForKind(..), isDynamic,
-		  FixitySig(..), Sig(..), ImportDecl(..),
-		  collectTopBinders
-		)
-import RdrHsSyn	( RdrNameIE, RdrNameImportDecl,
-		  RdrNameHsModule, RdrNameHsDecl
-		)
-import RnIfaces	( getInterfaceExports, getDeclBinders,
-		  recordSlurp, checkUpToDate
-		)
-import RnEnv
-import RnMonad
-
-import FiniteMap
-import PrelMods
-import PrelInfo ( main_RDR )
-import UniqFM	( lookupUFM )
-import Bag	( bagToList )
-import Maybes	( maybeToBool )
-import Module	( ModuleName, mkThisModule, pprModuleName, WhereFrom(..) )
-import NameSet
-import Name	( Name, ExportFlag(..), ImportReason(..), Provenance(..),
-		  isLocallyDefined, setNameProvenance,
-		  nameOccName, getSrcLoc, pprProvenance, getNameProvenance
-		)
-import RdrName	( RdrName, rdrNameOcc, mkRdrQual, mkRdrUnqual, isQual )
-import SrcLoc	( SrcLoc )
-import NameSet	( elemNameSet, emptyNameSet )
-import Outputable
-import Unique	( getUnique )
-import Util	( removeDups, equivClassesByUniq, sortLt )
-import List	( partition )
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Get global names}
-%*									*
-%************************************************************************
-
-\begin{code}
-getGlobalNames :: RdrNameHsModule
-	       -> RnMG (Maybe (ExportEnv, 
-			       GlobalRdrEnv,
-			       FixityEnv,		-- Fixities for local decls only
-			       NameEnv AvailInfo	-- Maps a name to its parent AvailInfo
-							-- Just for in-scope things only
-			       ))
-			-- Nothing => no need to recompile
-
-getGlobalNames (HsModule this_mod _ exports imports decls mod_loc)
-  = 	-- These two fix-loops are to get the right
-	-- provenance information into a Name
-    fixRn (\ ~(rec_gbl_env, rec_exported_avails, _) ->
-
---       fixRn (\ ~(rec_rn_env, _) ->
-	let
-	   rec_unqual_fn :: Name -> Bool	-- Is this chap in scope unqualified?
-	   rec_unqual_fn = unQualInScope rec_gbl_env
-
-	   rec_exp_fn :: Name -> ExportFlag
-	   rec_exp_fn = mk_export_fn (availsToNameSet rec_exported_avails)
-	in
---	setOmitQualFn rec_unqual_fn		$
-	setModuleRn this_mod			$
-
-		-- PROCESS LOCAL DECLS
-		-- Do these *first* so that the correct provenance gets
-		-- into the global name cache.
-	importsFromLocalDecls this_mod rec_exp_fn decls	`thenRn` \ (local_gbl_env, local_mod_avails) ->
-
-		-- PROCESS IMPORT DECLS
-		-- Do the non {- SOURCE -} ones first, so that we get a helpful
-		-- warning for {- SOURCE -} ones that are unnecessary
-	let
-	  (source, ordinary) = partition is_source_import all_imports
-	  is_source_import (ImportDecl _ ImportByUserSource _ _ _ _) = True
-	  is_source_import other				     = False
-	in
-	mapAndUnzipRn (importsFromImportDecl rec_unqual_fn) ordinary	`thenRn` \ (imp_gbl_envs1, imp_avails_s1) ->
-	mapAndUnzipRn (importsFromImportDecl rec_unqual_fn) source	`thenRn` \ (imp_gbl_envs2, imp_avails_s2) ->
-
-		-- COMBINE RESULTS
-		-- We put the local env second, so that a local provenance
-		-- "wins", even if a module imports itself.
-	let
-	    gbl_env :: GlobalRdrEnv
-	    imp_gbl_env = foldr plusGlobalRdrEnv emptyRdrEnv (imp_gbl_envs2 ++ imp_gbl_envs1)
-	    gbl_env     = imp_gbl_env `plusGlobalRdrEnv` local_gbl_env
-
-	    all_avails :: ExportAvails
-	    all_avails = foldr plusExportAvails local_mod_avails (imp_avails_s2 ++ imp_avails_s1)
-	in
---	returnRn (gbl_env, all_avails)
---      )							`thenRn` \ (gbl_env, all_avails) ->
-
-	-- TRY FOR EARLY EXIT
-	-- We can't go for an early exit before this because we have to check
-	-- for name clashes.  Consider:
-	--
-	--	module A where		module B where
-	--  	   import B		   h = True
-	--   	   f = h
-	--
-	-- Suppose I've compiled everything up, and then I add a
-	-- new definition to module B, that defines "f".
-	--
-	-- Then I must detect the name clash in A before going for an early
-	-- exit.  The early-exit code checks what's actually needed from B
-	-- to compile A, and of course that doesn't include B.f.  That's
-	-- why we wait till after the plusEnv stuff to do the early-exit.
-      checkEarlyExit this_mod			`thenRn` \ up_to_date ->
-      if up_to_date then
-	returnRn (gbl_env, junk_exp_fn, Nothing)
-      else
- 
-	-- RECORD BETTER PROVENANCES IN THE CACHE
- 	-- The names in the envirnoment have better provenances (e.g. imported on line x)
-	-- than the names in the name cache.  We update the latter now, so that we
-	-- we start renaming declarations we'll get the good names
-	-- The isQual is because the qualified name is always in scope
-      updateProvenances (concat [names | (rdr_name, names) <- rdrEnvToList imp_gbl_env, 
-					  isQual rdr_name])	`thenRn_`
-
-	-- PROCESS EXPORT LISTS
-      exportsFromAvail this_mod exports all_avails gbl_env 	`thenRn` \ exported_avails ->
-
-	-- DONE
-      returnRn (gbl_env, exported_avails, Just all_avails)
-    )		`thenRn` \ (gbl_env, exported_avails, maybe_stuff) ->
-
-    case maybe_stuff of {
-	Nothing -> returnRn Nothing ;
-	Just all_avails ->
-
-   traceRn (text "updateProv" <+> fsep (map ppr (rdrEnvElts gbl_env)))	`thenRn_`
-    
-	-- DEAL WITH FIXITIES
-   fixitiesFromLocalDecls gbl_env decls		`thenRn` \ local_fixity_env ->
-   let
-	-- Export only those fixities that are for names that are
-	--	(a) defined in this module
-	--	(b) exported
-	exported_fixities :: [(Name,Fixity)]
-	exported_fixities = [(name,fixity) | FixitySig name fixity _ <- nameEnvElts local_fixity_env,
-					     isLocallyDefined name
-			    ]
-   in
-   traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts local_fixity_env)))	`thenRn_`
-
-	--- TIDY UP 
-   let
-	export_env	      = ExportEnv exported_avails exported_fixities
-	(_, global_avail_env) = all_avails
-   in
-   returnRn (Just (export_env, gbl_env, local_fixity_env, global_avail_env))
-   }
-  where
-    junk_exp_fn = error "RnNames:export_fn"
-
-    all_imports = prel_imports ++ imports
-
-	-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
-	-- because the former doesn't even look at Prelude.hi for instance declarations,
-	-- whereas the latter does.
-    prel_imports | this_mod == pRELUDE_Name ||
-		   explicit_prelude_import ||
-		   opt_NoImplicitPrelude
-		 = []
-
-		 | otherwise		   = [ImportDecl pRELUDE_Name
-							 ImportByUser
-							 False		{- Not qualified -}
-							 Nothing	{- No "as" -}
-							 Nothing	{- No import list -}
-							 mod_loc]
-    
-    explicit_prelude_import
-      = not (null [ () | (ImportDecl mod _ _ _ _ _) <- imports, mod == pRELUDE_Name ])
-\end{code}
-	
-\begin{code}
-checkEarlyExit mod
-  = checkErrsRn				`thenRn` \ no_errs_so_far ->
-    if not no_errs_so_far then
-	-- Found errors already, so exit now
-	returnRn True
-    else
-
-    traceRn (text "Considering whether compilation is required...")	`thenRn_`
-    if not opt_SourceUnchanged then
-	-- Source code changed and no errors yet... carry on 
-	traceRn (nest 4 (text "source file changed or recompilation check turned off"))	`thenRn_` 
-	returnRn False
-    else
-
-	-- Unchanged source, and no errors yet; see if usage info
-	-- up to date, and exit if so
-    checkUpToDate mod						`thenRn` \ up_to_date ->
-    putDocRn (text "Compilation" <+> 
-	      text (if up_to_date then "IS NOT" else "IS") <+>
-	      text "required")					`thenRn_`
-    returnRn up_to_date
-\end{code}
-	
-\begin{code}
-importsFromImportDecl :: (Name -> Bool)		-- OK to omit qualifier
-		      -> RdrNameImportDecl
-		      -> RnMG (GlobalRdrEnv, 
-			       ExportAvails) 
-
-importsFromImportDecl is_unqual (ImportDecl imp_mod_name from qual_only as_mod import_spec iloc)
-  = pushSrcLocRn iloc $
-    getInterfaceExports imp_mod_name from	`thenRn` \ (imp_mod, avails) ->
-
-    if null avails then
-	-- If there's an error in getInterfaceExports, (e.g. interface
-	-- file not found) we get lots of spurious errors from 'filterImports'
-	returnRn (emptyRdrEnv, mkEmptyExportAvails imp_mod_name)
-    else
-
-    filterImports imp_mod_name import_spec avails	`thenRn` \ (filtered_avails, hides, explicits) ->
-
-	-- We 'improve' the provenance by setting
-	--	(a) the import-reason field, so that the Name says how it came into scope
-	--		including whether it's explicitly imported
-	--	(b) the print-unqualified field
-	-- But don't fiddle with wired-in things or we get in a twist
-    let
-	improve_prov name = setNameProvenance name (NonLocalDef (UserImport imp_mod iloc (is_explicit name)) 
-							        (is_unqual name))
-	is_explicit name  = name `elemNameSet` explicits
-    in
-    qualifyImports imp_mod_name
-		   (not qual_only)	-- Maybe want unqualified names
-		   as_mod hides
-		   filtered_avails improve_prov		`thenRn` \ (rdr_name_env, mod_avails) ->
-
-    returnRn (rdr_name_env, mod_avails)
-\end{code}
-
-
-\begin{code}
-importsFromLocalDecls mod_name rec_exp_fn decls
-  = mapRn (getLocalDeclBinders newLocalName) decls	`thenRn` \ avails_s ->
-
-    let
-	avails = concat avails_s
-
-	all_names :: [Name]	-- All the defns; no dups eliminated
-	all_names = [name | avail <- avails, name <- availNames avail]
-
-	dups :: [[Name]]
-	dups = filter non_singleton (equivClassesByUniq getUnique all_names)
-	     where
-		non_singleton (x1:x2:xs) = True
-		non_singleton other      = False
-    in
-	-- Check for duplicate definitions
-    mapRn_ (addErrRn . dupDeclErr) dups		`thenRn_` 
-
-	-- Record that locally-defined things are available
-    mapRn_ (recordSlurp Nothing) avails		`thenRn_`
-
-	-- Build the environment
-    qualifyImports mod_name 
-		   True		-- Want unqualified names
-		   Nothing	-- no 'as M'
-		   []		-- Hide nothing
-		   avails
-		   (\n -> n)
-
-  where
-    newLocalName rdr_name loc = newLocalTopBinder mod (rdrNameOcc rdr_name)
-						  rec_exp_fn loc
-    mod = mkThisModule mod_name
-
-getLocalDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)	-- New-name function
-		    -> RdrNameHsDecl
-		    -> RnMG Avails
-getLocalDeclBinders new_name (ValD binds)
-  = mapRn do_one (bagToList (collectTopBinders binds))
-  where
-    do_one (rdr_name, loc) = new_name rdr_name loc	`thenRn` \ name ->
-			     returnRn (Avail name)
-
-    -- foreign declarations
-getLocalDeclBinders new_name (ForD (ForeignDecl nm kind _ dyn _ loc))
-  | binds_haskell_name kind dyn
-  = new_name nm loc		    `thenRn` \ name ->
-    returnRn [Avail name]
-
-  | otherwise
-  = returnRn []
-
-getLocalDeclBinders new_name decl
-  = getDeclBinders new_name decl	`thenRn` \ maybe_avail ->
-    case maybe_avail of
-	Nothing    -> returnRn []		-- Instance decls and suchlike
-	Just avail -> returnRn [avail]
-
-binds_haskell_name (FoImport _) _   = True
-binds_haskell_name FoLabel      _   = True
-binds_haskell_name FoExport  ext_nm = isDynamic ext_nm
-
-fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
-fixitiesFromLocalDecls gbl_env decls
-  = foldlRn getFixities emptyNameEnv decls
-  where
-    getFixities :: FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
-    getFixities acc (FixD fix)
-      = fix_decl acc fix
-
-    getFixities acc (TyClD (ClassDecl _ _ _ sigs _ _ _ _ _ _))
-      = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
-		-- Get fixities from class decl sigs too.
-    getFixities acc other_decl
-      = returnRn acc
-
-    fix_decl acc sig@(FixitySig rdr_name fixity loc)
-	= 	-- Check for fixity decl for something not declared
-	  case lookupRdrEnv gbl_env rdr_name of {
-	    Nothing | opt_WarnUnusedBinds 
-		    -> pushSrcLocRn loc (addWarnRn (unusedFixityDecl rdr_name fixity))	`thenRn_`
-		       returnRn acc 
-		    | otherwise -> returnRn acc ;
-	
-	    Just (name:_) ->
-
-		-- Check for duplicate fixity decl
-	  case lookupNameEnv acc name of {
-	    Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')	`thenRn_`
-					 returnRn acc ;
-
-	    Nothing -> returnRn (addToNameEnv acc name (FixitySig name fixity loc))
-	  }}
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Filtering imports}
-%*									*
-%************************************************************************
-
-@filterImports@ takes the @ExportEnv@ telling what the imported module makes
-available, and filters it through the import spec (if any).
-
-\begin{code}
-filterImports :: ModuleName			-- The module being imported
-	      -> Maybe (Bool, [RdrNameIE])	-- Import spec; True => hiding
-	      -> [AvailInfo]			-- What's available
-	      -> RnMG ([AvailInfo],		-- What's actually imported
-		       [AvailInfo],		-- What's to be hidden (the unqualified version, that is)
-		       NameSet)			-- What was imported explicitly
-
-	-- Complains if import spec mentions things that the module doesn't export
-        -- Warns/informs if import spec contains duplicates.
-filterImports mod Nothing imports
-  = returnRn (imports, [], emptyNameSet)
-
-filterImports mod (Just (want_hiding, import_items)) avails
-  = mapMaybeRn check_item import_items		`thenRn` \ avails_w_explicits ->
-    let
-	(item_avails, explicits_s) = unzip avails_w_explicits
-	explicits		   = foldl addListToNameSet emptyNameSet explicits_s
-    in
-    if want_hiding 
-    then	
-	-- All imported; item_avails to be hidden
-	returnRn (avails, item_avails, emptyNameSet)
-    else
-	-- Just item_avails imported; nothing to be hidden
-	returnRn (item_avails, [], explicits)
-  where
-    import_fm :: FiniteMap OccName AvailInfo
-    import_fm = listToFM [ (nameOccName name, avail) 
-			 | avail <- avails,
-			   name  <- availNames avail]
-	-- Even though availNames returns data constructors too,
-	-- they won't make any difference because naked entities like T
-	-- in an import list map to TcOccs, not VarOccs.
-
-    check_item item@(IEModuleContents _)
-      = addErrRn (badImportItemErr mod item)	`thenRn_`
-	returnRn Nothing
-
-    check_item item
-      | not (maybeToBool maybe_in_import_avails) ||
-	not (maybeToBool maybe_filtered_avail)
-      = addErrRn (badImportItemErr mod item)	`thenRn_`
-	returnRn Nothing
-
-      | dodgy_import = addWarnRn (dodgyImportWarn mod item)	`thenRn_`
-		       returnRn (Just (filtered_avail, explicits))
-
-      | otherwise    = returnRn (Just (filtered_avail, explicits))
-		
-      where
- 	wanted_occ	       = rdrNameOcc (ieName item)
-	maybe_in_import_avails = lookupFM import_fm wanted_occ
-
-	Just avail	       = maybe_in_import_avails
-	maybe_filtered_avail   = filterAvail item avail
-	Just filtered_avail    = maybe_filtered_avail
-	explicits	       | dot_dot   = [availName filtered_avail]
-			       | otherwise = availNames filtered_avail
-
-	dot_dot = case item of 
-		    IEThingAll _    -> True
-		    other	    -> False
-
-	dodgy_import = case (item, avail) of
-			  (IEThingAll _, AvailTC _ [n]) -> True
-				-- This occurs when you import T(..), but
-				-- only export T abstractly.  The single [n]
-				-- in the AvailTC is the type or class itself
-					
-			  other -> False
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Qualifiying imports}
-%*									*
-%************************************************************************
-
-@qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
-of an import decl, and deals with producing an @RnEnv@ with the 
-right qualified names.  It also turns the @Names@ in the @ExportEnv@ into
-fully fledged @Names@.
-
-\begin{code}
-qualifyImports :: ModuleName		-- Imported module
-	       -> Bool			-- True <=> want unqualified import
-	       -> Maybe ModuleName	-- Optional "as M" part 
-	       -> [AvailInfo]		-- What's to be hidden
-	       -> Avails		-- Whats imported and how
-	       -> (Name -> Name) 	-- Improves the provenance on imported things
-	       -> RnMG (GlobalRdrEnv, ExportAvails)
-	-- NB: the Names in ExportAvails don't have the improve-provenance
-	--     function applied to them
-	-- We could fix that, but I don't think it matters
-
-qualifyImports this_mod unqual_imp as_mod hides
-	       avails improve_prov
-  = 
- 	-- Make the name environment.  We're talking about a 
-	-- single module here, so there must be no name clashes.
-	-- In practice there only ever will be if it's the module
-	-- being compiled.
-    let
-	-- Add the things that are available
-	name_env1 = foldl add_avail emptyRdrEnv avails
-
-	-- Delete things that are hidden
-	name_env2 = foldl del_avail name_env1 hides
-
-	-- Create the export-availability info
-	export_avails = mkExportAvails qual_mod unqual_imp name_env2 avails
-    in
-    returnRn (name_env2, export_avails)
-
-  where
-    qual_mod = case as_mod of
-		  Nothing  	    -> this_mod
-		  Just another_name -> another_name
-
-    add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
-    add_avail env avail = foldl add_name env (availNames avail)
-
-    add_name env name
-	| unqual_imp = env2
-	| otherwise  = env1
-	where
-	  env1 = addOneToGlobalRdrEnv env  (mkRdrQual qual_mod occ) better_name
-	  env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) 	    better_name
-	  occ         = nameOccName name
-	  better_name = improve_prov name
-
-    del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
-			where
-			  rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Export list processing
-%*									*
-%************************************************************************
-
-Processing the export list.
-
-You might think that we should record things that appear in the export list as
-``occurrences'' (using addOccurrenceName), but you'd be wrong.  We do check (here)
-that they are in scope, but there is no need to slurp in their actual declaration
-(which is what addOccurrenceName forces).  Indeed, doing so would big trouble when
-compiling PrelBase, because it re-exports GHC, which includes takeMVar#, whose type
-includes ConcBase.StateAndSynchVar#, and so on...
-
-\begin{code}
-type ExportAccum	-- The type of the accumulating parameter of
-			-- the main worker function in exportsFromAvail
-     = ([ModuleName], 		-- 'module M's seen so far
-	ExportOccMap,		-- Tracks exported occurrence names
-	NameEnv AvailInfo)	-- The accumulated exported stuff, kept in an env
-				--   so we can common-up related AvailInfos
-
-type ExportOccMap = FiniteMap OccName (Name, RdrNameIE)
-	-- Tracks what a particular exported OccName
-	--   in an export list refers to, and which item
-	--   it came from.  It's illegal to export two distinct things
-	--   that have the same occurrence name
-
-
-exportsFromAvail :: ModuleName
-		 -> Maybe [RdrNameIE]	-- Export spec
-		 -> ExportAvails
-		 -> GlobalRdrEnv 
-		 -> RnMG Avails
-	-- Complains if two distinct exports have same OccName
-        -- Warns about identical exports.
-	-- Complains about exports items not in scope
-exportsFromAvail this_mod Nothing export_avails global_name_env
-  = exportsFromAvail this_mod true_exports export_avails global_name_env
-  where
-    true_exports = Just $ if this_mod == mAIN_Name
-                          then [IEVar main_RDR]
-                               -- export Main.main *only* unless otherwise specified,
-                          else [IEModuleContents this_mod]
-                               -- but for all other modules export everything.
-
-exportsFromAvail this_mod (Just export_items) 
-		 (mod_avail_env, entity_avail_env)
-	         global_name_env
-  = foldlRn exports_from_item
-	    ([], emptyFM, emptyNameEnv) export_items	`thenRn` \ (_, _, export_avail_map) ->
-    let
-	export_avails :: [AvailInfo]
-	export_avails   = nameEnvElts export_avail_map
-    in
-    returnRn export_avails
-
-  where
-    exports_from_item :: ExportAccum -> RdrNameIE -> RnMG ExportAccum
-
-    exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
-	| mod `elem` mods 	-- Duplicate export of M
-	= warnCheckRn opt_WarnDuplicateExports
-		      (dupModuleExport mod)	`thenRn_`
-	  returnRn acc
-
-	| otherwise
-	= case lookupFM mod_avail_env mod of
-		Nothing	        -> failWithRn acc (modExportErr mod)
-		Just mod_avails -> foldlRn (check_occs ie) occs mod_avails	`thenRn` \ occs' ->
-				   let
-					avails' = foldl add_avail avails mod_avails
-				   in
-				   returnRn (mod:mods, occs', avails')
-
-    exports_from_item acc@(mods, occs, avails) ie
-	| not (maybeToBool maybe_in_scope) 
-	= failWithRn acc (unknownNameErr (ieName ie))
-
-	| not (null dup_names)
-	= addNameClashErrRn rdr_name (name:dup_names)	`thenRn_`
-	  returnRn acc
-
-#ifdef DEBUG
-	-- I can't see why this should ever happen; if the thing is in scope
-	-- at all it ought to have some availability
-	| not (maybeToBool maybe_avail)
-	= pprTrace "exportsFromAvail: curious Nothing:" (ppr name)
-	  returnRn acc
-#endif
-
-	| not enough_avail
-	= failWithRn acc (exportItemErr ie)
-
-	| otherwise	-- Phew!  It's OK!  Now to check the occurrence stuff!
-	= check_occs ie occs export_avail	`thenRn` \ occs' ->
-	  returnRn (mods, occs', add_avail avails export_avail)
-
-       where
-	  rdr_name	  = ieName ie
-          maybe_in_scope  = lookupFM global_name_env rdr_name
-	  Just (name:dup_names) = maybe_in_scope
-	  maybe_avail        = lookupUFM entity_avail_env name
-	  Just avail         = maybe_avail
- 	  maybe_export_avail = filterAvail ie avail
-	  enough_avail	     = maybeToBool maybe_export_avail
-	  Just export_avail  = maybe_export_avail
-
-add_avail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
-
-check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> RnMG ExportOccMap
-check_occs ie occs avail 
-  = foldlRn check occs (availNames avail)
-  where
-    check occs name
-      = case lookupFM occs name_occ of
-	  Nothing	    -> returnRn (addToFM occs name_occ (name, ie))
-	  Just (name', ie') 
-	    | name == name' -> 	-- Duplicate export
-				warnCheckRn opt_WarnDuplicateExports
-					    (dupExportWarn name_occ ie ie')	`thenRn_`
-				returnRn occs
-
-	    | otherwise	    ->	-- Same occ name but different names: an error
-				failWithRn occs (exportClashErr name_occ ie ie')
-      where
-	name_occ = nameOccName name
-	
-mk_export_fn :: NameSet -> (Name -> ExportFlag)
-mk_export_fn exported_names
-  = \name -> if name `elemNameSet` exported_names
-	     then Exported
-	     else NotExported
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Errors}
-%*									*
-%************************************************************************
-
-\begin{code}
-badImportItemErr mod ie
-  = sep [ptext SLIT("Module"), quotes (pprModuleName mod), 
-	 ptext SLIT("does not export"), quotes (ppr ie)]
-
-dodgyImportWarn mod (IEThingAll tc)
-  = sep [ptext SLIT("Module") <+> quotes (pprModuleName mod) <+> ptext SLIT("exports") <+> quotes (ppr tc), 
-	 ptext SLIT("with no constructors/class operations;"),
-	 ptext SLIT("yet it is imported with a (..)")]
-
-modExportErr mod
-  = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (pprModuleName mod)]
-
-exportItemErr export_item
-  = sep [ ptext SLIT("Bad export item"), quotes (ppr export_item)]
-
-exportClashErr occ_name ie1 ie2
-  = hsep [ptext SLIT("The export items"), quotes (ppr ie1), ptext SLIT("and"), quotes (ppr ie2),
-	  ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)]
-
-dupDeclErr (n:ns)
-  = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
-	  nest 4 (vcat (map pp sorted_ns))]
-  where
-    sorted_ns = sortLt occ'ed_before (n:ns)
-
-    occ'ed_before a b = LT == compare (getSrcLoc a) (getSrcLoc b)
-
-    pp n      = pprProvenance (getNameProvenance n)
-
-dupExportWarn occ_name ie1 ie2
-  = hsep [quotes (ppr occ_name), 
-          ptext SLIT("is exported by"), quotes (ppr ie1),
-          ptext SLIT("and"),            quotes (ppr ie2)]
-
-dupModuleExport mod
-  = hsep [ptext SLIT("Duplicate"),
-	  quotes (ptext SLIT("Module") <+> pprModuleName mod), 
-          ptext SLIT("in export list")]
-
-unusedFixityDecl rdr_name fixity
-  = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
-
-dupFixityDecl rdr_name loc1 loc2
-  = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
-	  ptext SLIT("at ") <+> ppr loc1,
-	  ptext SLIT("and") <+> ppr loc2]
-
-\end{code}
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[RnNames]{Extracting imported and top-level names in scope}
+
+\begin{code}
+module RnNames (
+	getGlobalNames
+    ) where
+
+#include "HsVersions.h"
+
+import CmdLineOpts    ( opt_NoImplicitPrelude, opt_WarnDuplicateExports, 
+			opt_SourceUnchanged, opt_WarnUnusedBinds
+		      )
+
+import HsSyn	( HsModule(..), HsDecl(..), TyClDecl(..),
+		  IE(..), ieName, 
+		  ForeignDecl(..), ForKind(..), isDynamic,
+		  FixitySig(..), Sig(..), ImportDecl(..),
+		  collectTopBinders
+		)
+import RdrHsSyn	( RdrNameIE, RdrNameImportDecl,
+		  RdrNameHsModule, RdrNameHsDecl
+		)
+import RnIfaces	( getInterfaceExports, getDeclBinders,
+		  recordSlurp, checkUpToDate
+		)
+import RnEnv
+import RnMonad
+
+import FiniteMap
+import PrelMods
+import PrelInfo ( main_RDR )
+import UniqFM	( lookupUFM )
+import Bag	( bagToList )
+import Maybes	( maybeToBool )
+import Module	( ModuleName, mkThisModule, pprModuleName, WhereFrom(..) )
+import NameSet
+import Name	( Name, ExportFlag(..), ImportReason(..), Provenance(..),
+		  isLocallyDefined, setNameProvenance,
+		  nameOccName, getSrcLoc, pprProvenance, getNameProvenance
+		)
+import RdrName	( RdrName, rdrNameOcc, mkRdrQual, mkRdrUnqual, isQual )
+import SrcLoc	( SrcLoc )
+import NameSet	( elemNameSet, emptyNameSet )
+import Outputable
+import Unique	( getUnique )
+import Util	( removeDups, equivClassesByUniq, sortLt )
+import List	( partition )
+\end{code}
+
+
+
+%************************************************************************
+%*									*
+\subsection{Get global names}
+%*									*
+%************************************************************************
+
+\begin{code}
+getGlobalNames :: RdrNameHsModule
+	       -> RnMG (Maybe (ExportEnv, 
+			       GlobalRdrEnv,
+			       FixityEnv,		-- Fixities for local decls only
+			       NameEnv AvailInfo	-- Maps a name to its parent AvailInfo
+							-- Just for in-scope things only
+			       ))
+			-- Nothing => no need to recompile
+
+getGlobalNames (HsModule this_mod _ exports imports decls mod_loc)
+  = 	-- These two fix-loops are to get the right
+	-- provenance information into a Name
+    fixRn (\ ~(rec_gbl_env, rec_exported_avails, _) ->
+
+	let
+	   rec_unqual_fn :: Name -> Bool	-- Is this chap in scope unqualified?
+	   rec_unqual_fn = unQualInScope rec_gbl_env
+
+	   rec_exp_fn :: Name -> ExportFlag
+	   rec_exp_fn = mk_export_fn (availsToNameSet rec_exported_avails)
+	in
+	setModuleRn this_mod			$
+
+		-- PROCESS LOCAL DECLS
+		-- Do these *first* so that the correct provenance gets
+		-- into the global name cache.
+	importsFromLocalDecls this_mod rec_exp_fn decls	`thenRn` \ (local_gbl_env, local_mod_avails) ->
+
+		-- PROCESS IMPORT DECLS
+		-- Do the non {- SOURCE -} ones first, so that we get a helpful
+		-- warning for {- SOURCE -} ones that are unnecessary
+	let
+	  (source, ordinary) = partition is_source_import all_imports
+	  is_source_import (ImportDecl _ ImportByUserSource _ _ _ _) = True
+	  is_source_import other				     = False
+	in
+	mapAndUnzipRn (importsFromImportDecl rec_unqual_fn) ordinary	`thenRn` \ (imp_gbl_envs1, imp_avails_s1) ->
+	mapAndUnzipRn (importsFromImportDecl rec_unqual_fn) source	`thenRn` \ (imp_gbl_envs2, imp_avails_s2) ->
+
+		-- COMBINE RESULTS
+		-- We put the local env second, so that a local provenance
+		-- "wins", even if a module imports itself.
+	let
+	    gbl_env :: GlobalRdrEnv
+	    imp_gbl_env = foldr plusGlobalRdrEnv emptyRdrEnv (imp_gbl_envs2 ++ imp_gbl_envs1)
+	    gbl_env     = imp_gbl_env `plusGlobalRdrEnv` local_gbl_env
+
+	    all_avails :: ExportAvails
+	    all_avails = foldr plusExportAvails local_mod_avails (imp_avails_s2 ++ imp_avails_s1)
+	in
+
+	-- TRY FOR EARLY EXIT
+	-- We can't go for an early exit before this because we have to check
+	-- for name clashes.  Consider:
+	--
+	--	module A where		module B where
+	--  	   import B		   h = True
+	--   	   f = h
+	--
+	-- Suppose I've compiled everything up, and then I add a
+	-- new definition to module B, that defines "f".
+	--
+	-- Then I must detect the name clash in A before going for an early
+	-- exit.  The early-exit code checks what's actually needed from B
+	-- to compile A, and of course that doesn't include B.f.  That's
+	-- why we wait till after the plusEnv stuff to do the early-exit.
+      checkEarlyExit this_mod			`thenRn` \ up_to_date ->
+      if up_to_date then
+	returnRn (gbl_env, junk_exp_fn, Nothing)
+      else
+ 
+	-- RECORD BETTER PROVENANCES IN THE CACHE
+ 	-- The names in the envirnoment have better provenances (e.g. imported on line x)
+	-- than the names in the name cache.  We update the latter now, so that we
+	-- we start renaming declarations we'll get the good names
+	-- The isQual is because the qualified name is always in scope
+      updateProvenances (concat [names | (rdr_name, names) <- rdrEnvToList imp_gbl_env, 
+					  isQual rdr_name])	`thenRn_`
+
+	-- PROCESS EXPORT LISTS
+      exportsFromAvail this_mod exports all_avails gbl_env 	`thenRn` \ exported_avails ->
+
+	-- DONE
+      returnRn (gbl_env, exported_avails, Just all_avails)
+    )		`thenRn` \ (gbl_env, exported_avails, maybe_stuff) ->
+
+    case maybe_stuff of {
+	Nothing -> returnRn Nothing ;
+	Just all_avails ->
+
+   traceRn (text "updateProv" <+> fsep (map ppr (rdrEnvElts gbl_env)))	`thenRn_`
+    
+	-- DEAL WITH FIXITIES
+   fixitiesFromLocalDecls gbl_env decls		`thenRn` \ local_fixity_env ->
+   let
+	-- Export only those fixities that are for names that are
+	--	(a) defined in this module
+	--	(b) exported
+	exported_fixities :: [(Name,Fixity)]
+	exported_fixities = [(name,fixity) | FixitySig name fixity _ <- nameEnvElts local_fixity_env,
+					     isLocallyDefined name
+			    ]
+   in
+   traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts local_fixity_env)))	`thenRn_`
+
+	--- TIDY UP 
+   let
+	export_env	      = ExportEnv exported_avails exported_fixities
+	(_, global_avail_env) = all_avails
+   in
+   returnRn (Just (export_env, gbl_env, local_fixity_env, global_avail_env))
+   }
+  where
+    junk_exp_fn = error "RnNames:export_fn"
+
+    all_imports = prel_imports ++ imports
+
+	-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
+	-- because the former doesn't even look at Prelude.hi for instance declarations,
+	-- whereas the latter does.
+    prel_imports | this_mod == pRELUDE_Name ||
+		   explicit_prelude_import ||
+		   opt_NoImplicitPrelude
+		 = []
+
+		 | otherwise		   = [ImportDecl pRELUDE_Name
+							 ImportByUser
+							 False		{- Not qualified -}
+							 Nothing	{- No "as" -}
+							 Nothing	{- No import list -}
+							 mod_loc]
+    
+    explicit_prelude_import
+      = not (null [ () | (ImportDecl mod _ _ _ _ _) <- imports, mod == pRELUDE_Name ])
+\end{code}
+	
+\begin{code}
+checkEarlyExit mod
+  = checkErrsRn				`thenRn` \ no_errs_so_far ->
+    if not no_errs_so_far then
+	-- Found errors already, so exit now
+	returnRn True
+    else
+
+    traceRn (text "Considering whether compilation is required...")	`thenRn_`
+    if not opt_SourceUnchanged then
+	-- Source code changed and no errors yet... carry on 
+	traceRn (nest 4 (text "source file changed or recompilation check turned off"))	`thenRn_` 
+	returnRn False
+    else
+
+	-- Unchanged source, and no errors yet; see if usage info
+	-- up to date, and exit if so
+    checkUpToDate mod						`thenRn` \ up_to_date ->
+    putDocRn (text "Compilation" <+> 
+	      text (if up_to_date then "IS NOT" else "IS") <+>
+	      text "required")					`thenRn_`
+    returnRn up_to_date
+\end{code}
+	
+\begin{code}
+importsFromImportDecl :: (Name -> Bool)		-- OK to omit qualifier
+		      -> RdrNameImportDecl
+		      -> RnMG (GlobalRdrEnv, 
+			       ExportAvails) 
+
+importsFromImportDecl is_unqual (ImportDecl imp_mod_name from qual_only as_mod import_spec iloc)
+  = pushSrcLocRn iloc $
+    getInterfaceExports imp_mod_name from	`thenRn` \ (imp_mod, avails) ->
+
+    if null avails then
+	-- If there's an error in getInterfaceExports, (e.g. interface
+	-- file not found) we get lots of spurious errors from 'filterImports'
+	returnRn (emptyRdrEnv, mkEmptyExportAvails imp_mod_name)
+    else
+
+    filterImports imp_mod_name import_spec avails	`thenRn` \ (filtered_avails, hides, explicits) ->
+
+	-- We 'improve' the provenance by setting
+	--	(a) the import-reason field, so that the Name says how it came into scope
+	--		including whether it's explicitly imported
+	--	(b) the print-unqualified field
+	-- But don't fiddle with wired-in things or we get in a twist
+    let
+	improve_prov name = setNameProvenance name (NonLocalDef (UserImport imp_mod iloc (is_explicit name)) 
+							        (is_unqual name))
+	is_explicit name  = name `elemNameSet` explicits
+    in
+    qualifyImports imp_mod_name
+		   (not qual_only)	-- Maybe want unqualified names
+		   as_mod hides
+		   filtered_avails improve_prov		`thenRn` \ (rdr_name_env, mod_avails) ->
+
+    returnRn (rdr_name_env, mod_avails)
+\end{code}
+
+
+\begin{code}
+importsFromLocalDecls mod_name rec_exp_fn decls
+  = mapRn (getLocalDeclBinders newLocalName) decls	`thenRn` \ avails_s ->
+
+    let
+	avails = concat avails_s
+
+	all_names :: [Name]	-- All the defns; no dups eliminated
+	all_names = [name | avail <- avails, name <- availNames avail]
+
+	dups :: [[Name]]
+	dups = filter non_singleton (equivClassesByUniq getUnique all_names)
+	     where
+		non_singleton (x1:x2:xs) = True
+		non_singleton other      = False
+    in
+	-- Check for duplicate definitions
+    mapRn_ (addErrRn . dupDeclErr) dups		`thenRn_` 
+
+	-- Record that locally-defined things are available
+    mapRn_ (recordSlurp Nothing) avails		`thenRn_`
+
+	-- Build the environment
+    qualifyImports mod_name 
+		   True		-- Want unqualified names
+		   Nothing	-- no 'as M'
+		   []		-- Hide nothing
+		   avails
+		   (\n -> n)
+
+  where
+    newLocalName rdr_name loc = newLocalTopBinder mod (rdrNameOcc rdr_name)
+						  rec_exp_fn loc
+    mod = mkThisModule mod_name
+
+getLocalDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)	-- New-name function
+		    -> RdrNameHsDecl
+		    -> RnMG Avails
+getLocalDeclBinders new_name (ValD binds)
+  = mapRn do_one (bagToList (collectTopBinders binds))
+  where
+    do_one (rdr_name, loc) = new_name rdr_name loc	`thenRn` \ name ->
+			     returnRn (Avail name)
+
+    -- foreign declarations
+getLocalDeclBinders new_name (ForD (ForeignDecl nm kind _ dyn _ loc))
+  | binds_haskell_name kind dyn
+  = new_name nm loc		    `thenRn` \ name ->
+    returnRn [Avail name]
+
+  | otherwise
+  = returnRn []
+
+getLocalDeclBinders new_name decl
+  = getDeclBinders new_name decl	`thenRn` \ maybe_avail ->
+    case maybe_avail of
+	Nothing    -> returnRn []		-- Instance decls and suchlike
+	Just avail -> returnRn [avail]
+
+binds_haskell_name (FoImport _) _   = True
+binds_haskell_name FoLabel      _   = True
+binds_haskell_name FoExport  ext_nm = isDynamic ext_nm
+
+fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
+fixitiesFromLocalDecls gbl_env decls
+  = foldlRn getFixities emptyNameEnv decls
+  where
+    getFixities :: FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
+    getFixities acc (FixD fix)
+      = fix_decl acc fix
+
+    getFixities acc (TyClD (ClassDecl _ _ _ sigs _ _ _ _ _ _))
+      = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
+		-- Get fixities from class decl sigs too.
+    getFixities acc other_decl
+      = returnRn acc
+
+    fix_decl acc sig@(FixitySig rdr_name fixity loc)
+	= 	-- Check for fixity decl for something not declared
+	  case lookupRdrEnv gbl_env rdr_name of {
+	    Nothing | opt_WarnUnusedBinds 
+		    -> pushSrcLocRn loc (addWarnRn (unusedFixityDecl rdr_name fixity))	`thenRn_`
+		       returnRn acc 
+		    | otherwise -> returnRn acc ;
+	
+	    Just (name:_) ->
+
+		-- Check for duplicate fixity decl
+	  case lookupNameEnv acc name of {
+	    Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')	`thenRn_`
+					 returnRn acc ;
+
+	    Nothing -> returnRn (addToNameEnv acc name (FixitySig name fixity loc))
+	  }}
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{Filtering imports}
+%*									*
+%************************************************************************
+
+@filterImports@ takes the @ExportEnv@ telling what the imported module makes
+available, and filters it through the import spec (if any).
+
+\begin{code}
+filterImports :: ModuleName			-- The module being imported
+	      -> Maybe (Bool, [RdrNameIE])	-- Import spec; True => hiding
+	      -> [AvailInfo]			-- What's available
+	      -> RnMG ([AvailInfo],		-- What's actually imported
+		       [AvailInfo],		-- What's to be hidden (the unqualified version, that is)
+		       NameSet)			-- What was imported explicitly
+
+	-- Complains if import spec mentions things that the module doesn't export
+        -- Warns/informs if import spec contains duplicates.
+filterImports mod Nothing imports
+  = returnRn (imports, [], emptyNameSet)
+
+filterImports mod (Just (want_hiding, import_items)) avails
+  = mapMaybeRn check_item import_items		`thenRn` \ avails_w_explicits ->
+    let
+	(item_avails, explicits_s) = unzip avails_w_explicits
+	explicits		   = foldl addListToNameSet emptyNameSet explicits_s
+    in
+    if want_hiding 
+    then	
+	-- All imported; item_avails to be hidden
+	returnRn (avails, item_avails, emptyNameSet)
+    else
+	-- Just item_avails imported; nothing to be hidden
+	returnRn (item_avails, [], explicits)
+  where
+    import_fm :: FiniteMap OccName AvailInfo
+    import_fm = listToFM [ (nameOccName name, avail) 
+			 | avail <- avails,
+			   name  <- availNames avail]
+	-- Even though availNames returns data constructors too,
+	-- they won't make any difference because naked entities like T
+	-- in an import list map to TcOccs, not VarOccs.
+
+    check_item item@(IEModuleContents _)
+      = addErrRn (badImportItemErr mod item)	`thenRn_`
+	returnRn Nothing
+
+    check_item item
+      | not (maybeToBool maybe_in_import_avails) ||
+	not (maybeToBool maybe_filtered_avail)
+      = addErrRn (badImportItemErr mod item)	`thenRn_`
+	returnRn Nothing
+
+      | dodgy_import = addWarnRn (dodgyImportWarn mod item)	`thenRn_`
+		       returnRn (Just (filtered_avail, explicits))
+
+      | otherwise    = returnRn (Just (filtered_avail, explicits))
+		
+      where
+ 	wanted_occ	       = rdrNameOcc (ieName item)
+	maybe_in_import_avails = lookupFM import_fm wanted_occ
+
+	Just avail	       = maybe_in_import_avails
+	maybe_filtered_avail   = filterAvail item avail
+	Just filtered_avail    = maybe_filtered_avail
+	explicits	       | dot_dot   = [availName filtered_avail]
+			       | otherwise = availNames filtered_avail
+
+	dot_dot = case item of 
+		    IEThingAll _    -> True
+		    other	    -> False
+
+	dodgy_import = case (item, avail) of
+			  (IEThingAll _, AvailTC _ [n]) -> True
+				-- This occurs when you import T(..), but
+				-- only export T abstractly.  The single [n]
+				-- in the AvailTC is the type or class itself
+					
+			  other -> False
+\end{code}
+
+
+
+%************************************************************************
+%*									*
+\subsection{Qualifiying imports}
+%*									*
+%************************************************************************
+
+@qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
+of an import decl, and deals with producing an @RnEnv@ with the 
+right qualified names.  It also turns the @Names@ in the @ExportEnv@ into
+fully fledged @Names@.
+
+\begin{code}
+qualifyImports :: ModuleName		-- Imported module
+	       -> Bool			-- True <=> want unqualified import
+	       -> Maybe ModuleName	-- Optional "as M" part 
+	       -> [AvailInfo]		-- What's to be hidden
+	       -> Avails		-- Whats imported and how
+	       -> (Name -> Name) 	-- Improves the provenance on imported things
+	       -> RnMG (GlobalRdrEnv, ExportAvails)
+	-- NB: the Names in ExportAvails don't have the improve-provenance
+	--     function applied to them
+	-- We could fix that, but I don't think it matters
+
+qualifyImports this_mod unqual_imp as_mod hides
+	       avails improve_prov
+  = 
+ 	-- Make the name environment.  We're talking about a 
+	-- single module here, so there must be no name clashes.
+	-- In practice there only ever will be if it's the module
+	-- being compiled.
+    let
+	-- Add the things that are available
+	name_env1 = foldl add_avail emptyRdrEnv avails
+
+	-- Delete things that are hidden
+	name_env2 = foldl del_avail name_env1 hides
+
+	-- Create the export-availability info
+	export_avails = mkExportAvails qual_mod unqual_imp name_env2 avails
+    in
+    returnRn (name_env2, export_avails)
+
+  where
+    qual_mod = case as_mod of
+		  Nothing  	    -> this_mod
+		  Just another_name -> another_name
+
+    add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
+    add_avail env avail = foldl add_name env (availNames avail)
+
+    add_name env name
+	| unqual_imp = env2
+	| otherwise  = env1
+	where
+	  env1 = addOneToGlobalRdrEnv env  (mkRdrQual qual_mod occ) better_name
+	  env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) 	    better_name
+	  occ         = nameOccName name
+	  better_name = improve_prov name
+
+    del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
+			where
+			  rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Export list processing
+%*									*
+%************************************************************************
+
+Processing the export list.
+
+You might think that we should record things that appear in the export list as
+``occurrences'' (using addOccurrenceName), but you'd be wrong.  We do check (here)
+that they are in scope, but there is no need to slurp in their actual declaration
+(which is what addOccurrenceName forces).  Indeed, doing so would big trouble when
+compiling PrelBase, because it re-exports GHC, which includes takeMVar#, whose type
+includes ConcBase.StateAndSynchVar#, and so on...
+
+\begin{code}
+type ExportAccum	-- The type of the accumulating parameter of
+			-- the main worker function in exportsFromAvail
+     = ([ModuleName], 		-- 'module M's seen so far
+	ExportOccMap,		-- Tracks exported occurrence names
+	NameEnv AvailInfo)	-- The accumulated exported stuff, kept in an env
+				--   so we can common-up related AvailInfos
+
+type ExportOccMap = FiniteMap OccName (Name, RdrNameIE)
+	-- Tracks what a particular exported OccName
+	--   in an export list refers to, and which item
+	--   it came from.  It's illegal to export two distinct things
+	--   that have the same occurrence name
+
+
+exportsFromAvail :: ModuleName
+		 -> Maybe [RdrNameIE]	-- Export spec
+		 -> ExportAvails
+		 -> GlobalRdrEnv 
+		 -> RnMG Avails
+	-- Complains if two distinct exports have same OccName
+        -- Warns about identical exports.
+	-- Complains about exports items not in scope
+exportsFromAvail this_mod Nothing export_avails global_name_env
+  = exportsFromAvail this_mod true_exports export_avails global_name_env
+  where
+    true_exports = Just $ if this_mod == mAIN_Name
+                          then [IEVar main_RDR]
+                               -- export Main.main *only* unless otherwise specified,
+                          else [IEModuleContents this_mod]
+                               -- but for all other modules export everything.
+
+exportsFromAvail this_mod (Just export_items) 
+		 (mod_avail_env, entity_avail_env)
+	         global_name_env
+  = foldlRn exports_from_item
+	    ([], emptyFM, emptyNameEnv) export_items	`thenRn` \ (_, _, export_avail_map) ->
+    let
+	export_avails :: [AvailInfo]
+	export_avails   = nameEnvElts export_avail_map
+    in
+    returnRn export_avails
+
+  where
+    exports_from_item :: ExportAccum -> RdrNameIE -> RnMG ExportAccum
+
+    exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
+	| mod `elem` mods 	-- Duplicate export of M
+	= warnCheckRn opt_WarnDuplicateExports
+		      (dupModuleExport mod)	`thenRn_`
+	  returnRn acc
+
+	| otherwise
+	= case lookupFM mod_avail_env mod of
+		Nothing	        -> failWithRn acc (modExportErr mod)
+		Just mod_avails -> foldlRn (check_occs ie) occs mod_avails	`thenRn` \ occs' ->
+				   let
+					avails' = foldl add_avail avails mod_avails
+				   in
+				   returnRn (mod:mods, occs', avails')
+
+    exports_from_item acc@(mods, occs, avails) ie
+	| not (maybeToBool maybe_in_scope) 
+	= failWithRn acc (unknownNameErr (ieName ie))
+
+	| not (null dup_names)
+	= addNameClashErrRn rdr_name (name:dup_names)	`thenRn_`
+	  returnRn acc
+
+#ifdef DEBUG
+	-- I can't see why this should ever happen; if the thing is in scope
+	-- at all it ought to have some availability
+	| not (maybeToBool maybe_avail)
+	= pprTrace "exportsFromAvail: curious Nothing:" (ppr name)
+	  returnRn acc
+#endif
+
+	| not enough_avail
+	= failWithRn acc (exportItemErr ie)
+
+	| otherwise	-- Phew!  It's OK!  Now to check the occurrence stuff!
+	= check_occs ie occs export_avail	`thenRn` \ occs' ->
+	  returnRn (mods, occs', add_avail avails export_avail)
+
+       where
+	  rdr_name	  = ieName ie
+          maybe_in_scope  = lookupFM global_name_env rdr_name
+	  Just (name:dup_names) = maybe_in_scope
+	  maybe_avail        = lookupUFM entity_avail_env name
+	  Just avail         = maybe_avail
+ 	  maybe_export_avail = filterAvail ie avail
+	  enough_avail	     = maybeToBool maybe_export_avail
+	  Just export_avail  = maybe_export_avail
+
+add_avail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
+
+check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> RnMG ExportOccMap
+check_occs ie occs avail 
+  = foldlRn check occs (availNames avail)
+  where
+    check occs name
+      = case lookupFM occs name_occ of
+	  Nothing	    -> returnRn (addToFM occs name_occ (name, ie))
+	  Just (name', ie') 
+	    | name == name' -> 	-- Duplicate export
+				warnCheckRn opt_WarnDuplicateExports
+					    (dupExportWarn name_occ ie ie')	`thenRn_`
+				returnRn occs
+
+	    | otherwise	    ->	-- Same occ name but different names: an error
+				failWithRn occs (exportClashErr name_occ ie ie')
+      where
+	name_occ = nameOccName name
+	
+mk_export_fn :: NameSet -> (Name -> ExportFlag)
+mk_export_fn exported_names
+  = \name -> if name `elemNameSet` exported_names
+	     then Exported
+	     else NotExported
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{Errors}
+%*									*
+%************************************************************************
+
+\begin{code}
+badImportItemErr mod ie
+  = sep [ptext SLIT("Module"), quotes (pprModuleName mod), 
+	 ptext SLIT("does not export"), quotes (ppr ie)]
+
+dodgyImportWarn mod (IEThingAll tc)
+  = sep [ptext SLIT("Module") <+> quotes (pprModuleName mod) <+> ptext SLIT("exports") <+> quotes (ppr tc), 
+	 ptext SLIT("with no constructors/class operations;"),
+	 ptext SLIT("yet it is imported with a (..)")]
+
+modExportErr mod
+  = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (pprModuleName mod)]
+
+exportItemErr export_item
+  = sep [ ptext SLIT("Bad export item"), quotes (ppr export_item)]
+
+exportClashErr occ_name ie1 ie2
+  = hsep [ptext SLIT("The export items"), quotes (ppr ie1), ptext SLIT("and"), quotes (ppr ie2),
+	  ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)]
+
+dupDeclErr (n:ns)
+  = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
+	  nest 4 (vcat (map pp sorted_ns))]
+  where
+    sorted_ns = sortLt occ'ed_before (n:ns)
+
+    occ'ed_before a b = LT == compare (getSrcLoc a) (getSrcLoc b)
+
+    pp n      = pprProvenance (getNameProvenance n)
+
+dupExportWarn occ_name ie1 ie2
+  = hsep [quotes (ppr occ_name), 
+          ptext SLIT("is exported by"), quotes (ppr ie1),
+          ptext SLIT("and"),            quotes (ppr ie2)]
+
+dupModuleExport mod
+  = hsep [ptext SLIT("Duplicate"),
+	  quotes (ptext SLIT("Module") <+> pprModuleName mod), 
+          ptext SLIT("in export list")]
+
+unusedFixityDecl rdr_name fixity
+  = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
+
+dupFixityDecl rdr_name loc1 loc2
+  = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
+	  ptext SLIT("at ") <+> ppr loc1,
+	  ptext SLIT("and") <+> ppr loc2]
+
+\end{code}
-- 
GitLab