[project @ 1996-04-07 15:41:24 by partain]

Sansom 1.3 changes through 960407

15 files changed, 3040 insertions, 2514 deletions

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 3b7cdf2c86..386dcbe9a2 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -8,115 +8,145 @@
 
 module Rename ( renameModule ) where
 
-import Ubiq{-uitous-}
+import PreludeGlaST	( thenPrimIO, returnPrimIO, fixPrimIO, newVar, MutableVar(..) )
+
+import Ubiq
 
 import HsSyn
-import RdrHsSyn		( ProtoNameHsModule(..) )
-import RnHsSyn		( RenamedHsModule(..) )
-
-import Bag		( isEmptyBag, unionBags )
-import CmdLineOpts	( opt_UseGetMentionedVars )
-import ErrUtils		( Error(..) )
-import Pretty		( Pretty(..){-ToDo:rm?-} )
-import RnMonad12	( initRn12 )
-import RnMonad4		( initRn4 )
-import RnPass1
-import RnPass2
-import RnPass3
-import RnPass4
-import RnUtils		( PreludeNameMappers(..), GlobalNameMappers(..) )
+import RdrHsSyn		( RdrNameHsModule(..), RdrNameImportDecl(..) )
+import RnHsSyn		( RnName, RenamedHsModule(..), isRnTyCon, isRnClass )
+
+import RnMonad
+import RnNames		( getGlobalNames, GlobalNameInfo(..) )
+import RnSource		( rnSource )
+import RnIfaces		( rnInterfaces, finalIfaceInfo, VersionInfo(..), ParsedIface )
+import RnUtils		( extendGlobalRnEnv, emptyRnEnv, multipleOccWarn )
+import MainMonad
+
+import Bag		( isEmptyBag, unionBags, bagToList, listToBag )
+import ErrUtils		( Error(..), Warning(..) )
+import FiniteMap	( emptyFM, eltsFM )
+import Name		( Name, RdrName(..) )
+import Outputable	( getOrigNameRdr, isLocallyDefined )
+import PrelInfo		( BuiltinNames(..), BuiltinKeys(..) )
+import UniqFM		( emptyUFM, lookupUFM, addListToUFM_C, eltsUFM )
 import UniqSupply	( splitUniqSupply )
-import Util		( panic )
-\end{code}
+import Util		( panic, assertPanic )
 
-Here's what the renamer does, basically:
-\begin{description}
-\item[@RnPass1@:]
-Flattens out the declarations from the interfaces which this module
-imports.  The result is a new module with no imports, but with more
-declarations.  (Obviously, the imported declarations have ``funny
-names'' [@ProtoNames@] to indicate their origin.)  Handles selective
-import, renaming, \& such.
-
-%--------------------------------------------------------------------
-\item[@RnPass2@:]
-Removes duplicate declarations.  Duplicates can arise when two
-imported interface have a signature (or whatever) for the same
-thing. We check that the two are consistent and then drop one.
-Considerable huff and puff to pick the one with the ``better''
-pragmatic information.
-
-%--------------------------------------------------------------------
-\item[@RnPass3@:]
-Find all the top-level-ish (i.e., global) entities, assign them
-@Uniques@, and make a \tr{ProtoName -> Name} mapping for them,
-in preparation for...
-
-%--------------------------------------------------------------------
-\item[@RnPass4@:]
-Actually prepare the ``renamed'' module.  In sticking @Names@ on
-everything, it will catch out-of-scope errors (and a couple of similar
-type-variable-use errors).  We also our initial dependency analysis of
-the program (required before typechecking).
-\end{description}
+findHiFiles :: PrimIO (FiniteMap Module FAST_STRING)
+findHiFiles = returnPrimIO emptyFM
+\end{code}
 
 \begin{code}
-renameModule :: PreludeNameMappers	-- lookup funs for deeply wired-in names
-	     -> ProtoNameHsModule	-- input
+renameModule :: BuiltinNames
+	     -> BuiltinKeys
 	     -> UniqSupply
-	     -> (RenamedHsModule,	-- output, after renaming
-		 Bag FAST_STRING,	-- Names of the imported modules
-					-- (profiling needs to know this)
-		 GlobalNameMappers,	-- final name funs; used later
-					-- to rename generated `deriving'
-					-- bindings.
-		 Bag Error		-- Errors, from passes 1-4
+	     -> RdrNameHsModule
+
+	     -> MainIO
+		(
+		 RenamedHsModule,  -- output, after renaming
+		 [Module],	   -- imported modules; for profiling
+
+	         VersionInfo,      -- version info; for usage
+		 [Module],	   -- instance modules; for iface
+
+		 Bag Error,
+		 Bag Warning
 		)
+\end{code}
 
--- Very space-leak sensitive
+ToDo: May want to arrange to return old interface for this module!
+ToDo: Return OrigName RnEnv to rename derivings etc with.
+ToDo: Builtin names which must be read.
+ToDo: Deal with instances (instance version, this module on instance list ???)
 
-renameModule gnfs@(val_pnf, tc_pnf)
-	     input@(HsModule mod_name _ _ _ _ _ _ _ _ _ _ _ _)
-	     uniqs
-  = let
-	use_mentioned_vars = opt_UseGetMentionedVars
-    in
-    case (initRn12 mod_name (rnModule1 gnfs use_mentioned_vars input))
-      of { ((mod1, imported_module_names), errs1) ->
+\begin{code}
+renameModule b_names b_keys us
+   	     input@(HsModule mod _ _ imports _ _ _ _ _ _ _ _ _ _)
+  = findHiFiles			`thenPrimIO` \ hi_files ->
+    newVar (emptyFM, hi_files)	`thenPrimIO` \ iface_var ->
 
-    case (initRn12 mod_name (rnModule2 mod1)) of { (mod2, errs2) ->
+    fixPrimIO ( \ (_, _, _, _, rec_occ_fm, rec_export_fn) ->
+    let
+	rec_occ_fn :: Name -> [RdrName]
+	rec_occ_fn n = case lookupUFM rec_occ_fm n of
+		         Nothing        -> []
+		         Just (rn,occs) -> occs
 
-    case (splitUniqSupply uniqs) of { (us1, us2) ->
+	global_name_info = (b_names, b_keys, rec_export_fn, rec_occ_fn)
+    in
+    getGlobalNames iface_var global_name_info us1 input
+		`thenPrimIO` \ (occ_env, imp_mods, imp_fixes, top_errs, top_warns) ->
 
-    case (initRn3 (rnModule3 gnfs imported_module_names mod2) us1)
-      of { (val_space, tc_space, v_gnf, tc_gnf, errs3) ->
+    if not (isEmptyBag top_errs) then
+	returnPrimIO (rn_panic, rn_panic, top_errs, top_warns, emptyUFM, rn_panic)
+    else
+
+    -- No top-level name errors so rename source ...
+    case initRn True mod occ_env us2
+		(rnSource imp_mods imp_fixes input) of {
+	((rn_module, export_fn, src_occs), src_errs, src_warns) ->
 
     let
-	final_name_funs = (v_gnf, tc_gnf)
+	occ_fm :: UniqFM (RnName, [RdrName])
+
+	occ_list = [ (rn,(rn,[occ])) | (rn,occ) <- bagToList src_occs]
+        occ_fm = addListToUFM_C insert_occ emptyUFM occ_list
 
-	errs_so_far = errs1 `unionBags` errs2 `unionBags` errs3
-		-- see note below about why we consult errs at this pt
+	insert_occ (rn,olds) (rn',[new]) = (rn, insert new olds)
+
+        insert new []         = [new]
+        insert new xxs@(x:xs) = case cmp new x of LT_  -> new : xxs
+			      			  EQ_  -> xxs
+			      			  GT__ -> x : insert new xs
+
+	occ_warns = map multipleOccWarn (filter multiple_occs (eltsUFM occ_fm))
+	multiple_occs (rn, (o1:o2:_)) = True
+	multiple_occs _               = False
     in
-    if not (isEmptyBag errs_so_far) then -- give up now
-	( panic "rename", imported_module_names, final_name_funs, errs_so_far )
+    returnPrimIO (rn_module, imp_mods,
+		  top_errs  `unionBags` src_errs,
+		  top_warns `unionBags` src_warns `unionBags` listToBag occ_warns,
+		  occ_fm, export_fn)
+
+    }) `thenPrimIO` \ (rn_module, imp_mods, errs_so_far, warns_so_far, occ_fm, _) ->
+
+    if not (isEmptyBag errs_so_far) then
+	returnMn (rn_panic, rn_panic, rn_panic, rn_panic,
+		  errs_so_far, warns_so_far)
     else
-	case (initRn4 final_name_funs (rnModule mod2) us2)
-	  of { (mod4, errs4) ->
 
-	( mod4, imported_module_names, final_name_funs, errs4 ) }
-    }}}}
-\end{code}
+    -- No errors renaming source so rename the interfaces ...
+    let
+        imports_used = [ rn | (rn,_) <- eltsUFM occ_fm, not (isLocallyDefined rn) ]
+	(import_tcs, import_vals) = partition (\ rn -> isRnTyCon rn || isRnClass rn) imports_used
+
+	(orig_env, orig_dups) = extendGlobalRnEnv emptyRnEnv (map pair_orig import_vals)
+						             (map pair_orig import_tcs)
+        pair_orig rn = (getOrigNameRdr rn, rn)
 
-Why stop if errors in the first three passes: Suppose you're compiling
-a module with a top-level definition named \tr{scaleFloat}.  Sadly,
-this is also a Prelude class-method name.  \tr{rnModule3} will have
-detected this error, but: it will also have picked (arbitrarily) one
-of the two definitions for its final ``value'' name-function.  If, by
-chance, it should have picked the class-method... when it comes to pin
-a Unique on the top-level (bogus) \tr{scaleFloat}, it will ask for the
-class-method's Unique (!); it doesn't have one, and you will get a
-panic.
-
-Another way to handle this would be for the duplicate detector to
-clobber duplicates with some ``safe'' value.  Then things would be
-fine in \tr{rnModule}.  Maybe some other time...
+	-- ToDo: Do we need top-level names from this module in orig_env ???
+    in
+    ASSERT (isEmptyBag orig_dups)
+    rnInterfaces iface_var orig_env us3 rn_module imports_used
+		`thenPrimIO` \ (rn_module_with_imports,
+				(implicit_val_fm, implicit_tc_fm),
+				iface_errs, iface_warns) ->
+    let
+        all_imports_used = imports_used ++ eltsFM implicit_tc_fm ++ eltsFM implicit_val_fm
+    in
+    finalIfaceInfo iface_var all_imports_used imp_mods
+		`thenPrimIO` \ (version_info, instance_mods) ->
+
+    returnMn (rn_module_with_imports, imp_mods, 
+	      version_info, instance_mods, 
+	      errs_so_far  `unionBags` iface_errs,
+	      warns_so_far `unionBags` iface_warns)
+
+  where
+    rn_panic = panic "renameModule: aborted with errors"
+
+    (us1, us') = splitUniqSupply us
+    (us2, us3) = splitUniqSupply us'
+\end{code}
diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
new file mode 100644
index 0000000000..d934449ca3
--- /dev/null
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -0,0 +1,688 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+%
+\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}
+#include "HsVersions.h"
+
+module RnBinds (
+	rnTopBinds,
+	rnMethodBinds,
+	rnBinds,
+	FreeVars(..),
+	DefinedVars(..)
+   ) where
+
+import Ubiq
+import RnLoop		-- break the RnPass4/RnExpr4/RnBinds4 loops
+
+import HsSyn
+import HsPragmas	( isNoGenPragmas, noGenPragmas )
+import RdrHsSyn
+import RnHsSyn
+import RnMonad
+import RnExpr		( rnMatch, rnGRHSsAndBinds, rnPat )
+
+import CmdLineOpts	( opt_SigsRequired )
+import Digraph		( stronglyConnComp )
+import ErrUtils		( addErrLoc, addShortErrLocLine )
+import Name		( RdrName )
+import Maybes		( catMaybes )
+import Pretty
+import UniqSet		( emptyUniqSet, unitUniqSet, mkUniqSet,
+			  unionUniqSets, unionManyUniqSets,
+			  elementOfUniqSet, uniqSetToList, UniqSet(..) )
+import Util		( thenCmp, isIn, removeDups, panic, panic#, assertPanic )
+\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.
+
+Sets of variable names are represented as sets explicitly, rather than lists.
+
+\begin{code}
+type DefinedVars = UniqSet RnName
+type FreeVars    = UniqSet RnName
+\end{code}
+
+i.e., binders.
+
+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).
+
+\begin{code}
+rnTopBinds    :: RdrNameHsBinds -> RnM_Fixes s RenamedHsBinds
+rnMethodBinds :: RnName{-class-} -> RdrNameMonoBinds -> RnM_Fixes s RenamedMonoBinds
+rnBinds	      :: RdrNameHsBinds -> RnM_Fixes s (RenamedHsBinds, FreeVars, [RnName])
+
+rnTopBinds EmptyBinds		       	   = returnRn EmptyBinds
+rnTopBinds (SingleBind (RecBind bind))    = rnTopMonoBinds bind []
+rnTopBinds (BindWith (RecBind bind) sigs) = rnTopMonoBinds bind sigs
+  -- the parser doesn't produce other forms
+
+-- ********************************************************************
+
+rnMethodBinds class_name EmptyMonoBinds = returnRn EmptyMonoBinds
+
+rnMethodBinds class_name (AndMonoBinds mb1 mb2)
+  = andRn AndMonoBinds (rnMethodBinds class_name mb1)
+			(rnMethodBinds class_name mb2)
+
+rnMethodBinds class_name (FunMonoBind occname matches locn)
+  = pushSrcLocRn locn			$
+    lookupClassOp class_name occname  	`thenRn` \ op_name ->
+    mapAndUnzipRn rnMatch matches	`thenRn` \ (new_matches, _) ->
+    returnRn (FunMonoBind op_name new_matches locn)
+
+rnMethodBinds class_name (PatMonoBind (VarPatIn occname) grhss_and_binds locn)
+  = pushSrcLocRn locn			$
+    lookupClassOp class_name occname	`thenRn` \ op_name ->
+    rnGRHSsAndBinds grhss_and_binds	`thenRn` \ (grhss_and_binds', _) ->
+    returnRn (PatMonoBind (VarPatIn op_name) grhss_and_binds' locn)
+
+-- Can't handle method pattern-bindings which bind multiple methods.
+rnMethodBinds _ mbind@(PatMonoBind other_pat _ locn)
+  = failButContinueRn EmptyMonoBinds (methodBindErr mbind locn)
+
+-- ********************************************************************
+
+rnBinds EmptyBinds			= returnRn (EmptyBinds,emptyUniqSet,[])
+rnBinds (SingleBind (RecBind bind))	= rnNestedMonoBinds bind []
+rnBinds (BindWith (RecBind bind) sigs) = rnNestedMonoBinds bind sigs
+  -- the parser doesn't produce other forms
+\end{code}
+
+@rnNestedMonoBinds@
+	- collects up the binders for this declaration group,
+	- checkes that they form a set
+	- extends the environment to bind them to new local names
+	- calls @rnMonoBinds@ to do the real work
+
+In contrast, @rnTopMonoBinds@ doesn't extend the environment, because that's
+already done in pass3.	All it does is call @rnMonoBinds@ and discards
+the free var info.
+
+\begin{code}
+rnTopMonoBinds :: RdrNameMonoBinds -> [RdrNameSig] -> RnM_Fixes s RenamedHsBinds
+
+rnTopMonoBinds EmptyMonoBinds sigs = returnRn EmptyBinds
+
+rnTopMonoBinds mbs sigs
+ = rnBindSigs True{-top-level-} (collectMonoBinders mbs) sigs `thenRn` \ siglist ->
+   rnMonoBinds mbs siglist `thenRn` \ (new_binds, fv_set) ->
+   returnRn new_binds
+
+
+rnNestedMonoBinds :: RdrNameMonoBinds -> [RdrNameSig]
+		  -> RnM_Fixes s (RenamedHsBinds, FreeVars, [RnName])
+
+rnNestedMonoBinds EmptyMonoBinds sigs
+  = returnRn (EmptyBinds, emptyUniqSet, [])
+
+rnNestedMonoBinds mbinds sigs	-- 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
+    let
+	mbinders_w_srclocs = collectMonoBindersAndLocs mbinds
+	mbinders    	   = map fst mbinders_w_srclocs
+    in
+    newLocalNames "variable"
+		  mbinders_w_srclocs	`thenRn` \ new_mbinders ->
+
+    extendSS2 new_mbinders (
+	 rnBindSigs False{-not top- level-} mbinders sigs `thenRn` \ siglist ->
+	 rnMonoBinds mbinds  siglist
+    )					`thenRn` \ (new_binds, fv_set) ->
+    returnRn (new_binds, fv_set, new_mbinders)
+\end{code}
+
+@rnMonoBinds@ 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 @rnNestedMonoBinds@ (for the nested ones).
+
+\begin{code}
+rnMonoBinds :: RdrNameMonoBinds
+	    -> [RenamedSig]	-- Signatures attached to this group
+	    -> RnM_Fixes s (RenamedHsBinds, FreeVars)
+
+rnMonoBinds mbinds siglist
+  =
+	 -- 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 0 siglist mbinds	`thenRn` \ (_, mbinds_info) ->
+
+	 -- Do the SCC analysis
+    let vertices = mkVertices mbinds_info
+	edges	= mkEdges vertices mbinds_info
+
+	scc_result = stronglyConnComp (==) edges vertices
+
+	 -- Deal with bound and free-var calculation
+	rhs_free_vars = foldr f emptyUniqSet mbinds_info
+
+	final_binds = reconstructRec scc_result edges mbinds_info
+
+	happy_answer = returnRn (final_binds, rhs_free_vars)
+    in
+    case (inline_sigs_in_recursive_binds final_binds) of
+      Nothing -> happy_answer
+      Just names_n_locns ->
+-- SLPJ: sometimes want recursive INLINE for worker wrapper style stuff
+-- 	addErrRn (inlineInRecursiveBindsErr names_n_locns) `thenRn_`
+	{-not so-}happy_answer
+  where
+    f :: (a,b, FreeVars, c,d) -> FreeVars -> FreeVars
+
+    f (_, _, fvs_body, _, _) fvs_sofar = fvs_sofar `unionUniqSets` fvs_body
+
+    inline_sigs_in_recursive_binds (BindWith (RecBind _) sigs)
+      = case [(n, locn) | (InlineSig n locn) <- sigs ] of
+	  []   -> Nothing
+	  sigh ->
+#if OMIT_DEFORESTER
+		Just sigh
+#else
+    		-- Allow INLINEd recursive functions if they are
+		-- designated DEFORESTable too.
+		case [(n, locn) | (DeforestSig n locn) <- sigs ] of
+	  		[]   -> Just sigh
+	  		sigh -> Nothing
+#endif
+
+    inline_sigs_in_recursive_binds (ThenBinds b1 b2)
+      = case (inline_sigs_in_recursive_binds b1) of
+	  Nothing -> inline_sigs_in_recursive_binds b2
+	  Just  x -> Just x -- NB: won't report error(s) in b2
+
+    inline_sigs_in_recursive_binds anything_else = Nothing
+\end{code}
+
+@flattenMonoBinds@ is ever-so-slightly magical in that it sticks
+unique ``vertex tags'' on its output; minor plumbing required.
+
+\begin{code}
+flattenMonoBinds :: Int				-- Next free vertex tag
+		 -> [RenamedSig]		-- Signatures
+		 -> RdrNameMonoBinds
+		 -> RnM_Fixes s (Int, FlatMonoBindsInfo)
+
+flattenMonoBinds uniq sigs EmptyMonoBinds = returnRn (uniq, [])
+
+flattenMonoBinds uniq sigs (AndMonoBinds mB1 mB2)
+  = flattenMonoBinds uniq sigs mB1	`thenRn` \ (uniq1, flat1) ->
+    flattenMonoBinds uniq1 sigs mB2	`thenRn` \ (uniq2, flat2) ->
+    returnRn (uniq2, flat1 ++ flat2)
+
+flattenMonoBinds uniq sigs (PatMonoBind pat grhss_and_binds locn)
+  = pushSrcLocRn locn		 	$
+    rnPat pat				`thenRn` \ pat' ->
+    rnGRHSsAndBinds grhss_and_binds	`thenRn` \ (grhss_and_binds', fvs) ->
+
+	 -- Find which things are bound in this group
+    let
+	names_bound_here = collectPatBinders pat'
+
+	sigs_etc_for_here = foldl (sig_for_here (\ n -> n `is_elem` names_bound_here))
+				  [] sigs
+
+	sigs_fvs = foldr sig_fv emptyUniqSet sigs_etc_for_here
+
+	is_elem = isIn "flattenMonoBinds"
+    in
+    returnRn (
+	uniq + 1,
+	[(uniq,
+	  mkUniqSet names_bound_here,
+	   fvs `unionUniqSets` sigs_fvs,
+	   PatMonoBind pat' grhss_and_binds' locn,
+	   sigs_etc_for_here
+	 )]
+    )
+
+flattenMonoBinds uniq sigs (FunMonoBind name matches locn)
+  = pushSrcLocRn locn			$
+    lookupValue name			`thenRn` \ name' ->
+    mapAndUnzipRn rnMatch matches	`thenRn` \ (new_matches, fv_lists) ->
+    let
+	fvs = unionManyUniqSets fv_lists
+
+	sigs_for_me = foldl (sig_for_here (\ n -> n == name')) [] sigs
+
+	sigs_fvs = foldr sig_fv emptyUniqSet sigs_for_me
+    in
+    returnRn (
+      uniq + 1,
+      [(uniq,
+	unitUniqSet name',
+	fvs `unionUniqSets` sigs_fvs,
+	FunMonoBind name' new_matches locn,
+	sigs_for_me
+	)]
+    )
+\end{code}
+
+Grab type-signatures/user-pragmas of interest:
+\begin{code}
+sig_for_here want_me acc s@(Sig n _ _ _)     | want_me n = s:acc
+sig_for_here want_me acc s@(InlineSig n _)   | want_me n = s:acc
+sig_for_here want_me acc s@(DeforestSig n _) | want_me n = s:acc
+sig_for_here want_me acc s@(SpecSig n _ _ _) | want_me n = s:acc
+sig_for_here want_me acc s@(MagicUnfoldingSig n _ _)
+					     | want_me n = s:acc
+sig_for_here want_me acc other_wise			 = acc
+
+-- If a SPECIALIZE pragma is of the "... = blah" form,
+-- then we'd better make sure "blah" is taken into
+-- acct in the dependency analysis (or we get an
+-- unexpected out-of-scope error)! WDP 95/07
+
+sig_fv (SpecSig _ _ (Just blah) _) acc = acc `unionUniqSets` unitUniqSet blah
+sig_fv _			   acc = acc
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection[reconstruct-deps]{Reconstructing dependencies}
+%*									*
+%************************************************************************
+
+This @MonoBinds@- and @ClassDecls@-specific code is segregated here,
+as the two cases are similar.
+
+\begin{code}
+reconstructRec	:: [Cycle]	-- Result of SCC analysis; at least one
+		-> [Edge]	-- Original edges
+		-> FlatMonoBindsInfo
+		-> RenamedHsBinds
+
+reconstructRec cycles edges mbi
+  = foldr1 ThenBinds (map (reconstructCycle mbi) cycles)
+  where
+    reconstructCycle :: FlatMonoBindsInfo -> Cycle -> RenamedHsBinds
+
+    reconstructCycle mbi2 cycle
+      = BIND [(binds,sigs) | (vertex, _, _, binds, sigs) <- mbi2, vertex `is_elem` cycle]
+		  _TO_ relevant_binds_and_sigs ->
+
+	BIND (unzip relevant_binds_and_sigs) _TO_ (binds, sig_lists) ->
+
+	BIND (foldr AndMonoBinds EmptyMonoBinds binds) _TO_ this_gp_binds ->
+	let
+	    this_gp_sigs	= foldr1 (++) sig_lists
+	    have_sigs		= not (null sig_lists)
+		-- ToDo: this might not be the right
+		-- thing to call this predicate;
+		-- e.g. "have_sigs [[], [], []]" ???????????
+	in
+	mk_binds this_gp_binds this_gp_sigs (isCyclic edges cycle) have_sigs
+	BEND BEND BEND
+      where
+	is_elem = isIn "reconstructRec"
+
+	mk_binds :: RenamedMonoBinds -> [RenamedSig]
+		 -> Bool -> Bool -> RenamedHsBinds
+
+	mk_binds bs ss True  False		= SingleBind (RecBind    bs)
+	mk_binds bs ss True  True{-have sigs-}	= BindWith   (RecBind    bs) ss
+	mk_binds bs ss False False		= SingleBind (NonRecBind bs)
+	mk_binds bs ss False True{-have sigs-}	= BindWith   (NonRecBind bs) ss
+
+	-- moved from Digraph, as this is the only use here
+	-- (avoid overloading cost).  We have to use elem
+	-- (not FiniteMaps or whatever), because there may be
+	-- many edges out of one vertex.  We give it its own
+	-- "elem" just for speed.
+
+	isCyclic es []  = panic "isCyclic: empty component"
+	isCyclic es [v] = (v,v) `elem` es
+	isCyclic es vs  = True
+
+	elem _ []	= False
+	elem x (y:ys)	= x==y || elem x ys
+\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
+  = [(VertexTag,		-- Identifies the vertex
+      UniqSet RnName,		-- Set of names defined in this vertex
+      UniqSet RnName,		-- Set of names used in this vertex
+      RenamedMonoBinds,		-- Binding for this vertex (always just one binding, either fun or pat)
+      [RenamedSig])		-- Signatures, if any, for this vertex
+    ]
+
+mkVertices :: FlatMonoBindsInfo -> [VertexTag]
+mkVertices info = [ vertex | (vertex,_,_,_,_) <- info]
+
+mkEdges :: [VertexTag] -> FlatMonoBindsInfo -> [Edge]
+
+mkEdges vertices flat_info
+ -- An edge (v,v') indicates that v depends on v'
+ = [ (source_vertex, target_vertex)
+   | (source_vertex, _, used_names, _, _) <- flat_info,
+     target_name   <- uniqSetToList used_names,
+     target_vertex <- vertices_defining target_name flat_info
+   ]
+   where
+   -- If each name only has one binding in this group, then
+   -- vertices_defining will always return the empty list, or a
+   -- singleton.  The case when there is more than one binding (an
+   -- error) needs more thought.
+
+   vertices_defining name flat_info2
+    = [ vertex |  (vertex, names_defined, _, _, _) <- flat_info2,
+		name `elementOfUniqSet` names_defined
+      ]
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
+%*									*
+%************************************************************************
+
+@rnBindSigs@ 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.
+
+\begin{code}
+rnBindSigs :: Bool		    	-- True <=> top-level binders
+	    -> [RdrName]	    	-- Binders for this decl group
+	    -> [RdrNameSig]
+	    -> RnM_Fixes s [RenamedSig] -- List of Sig constructors
+
+rnBindSigs is_toplev binder_occnames sigs
+  =
+	 -- Rename the signatures
+	 -- Will complain about sigs for variables not in this group
+    mapRn rename_sig sigs   	`thenRn` \ sigs_maybe ->
+    let
+	sigs' = catMaybes sigs_maybe
+
+	 -- Discard unbound ones we've already complained about, so we
+	 -- complain about duplicate ones.
+
+	(goodies, dups) = removeDups compare (filter not_unbound sigs')
+    in
+    mapRn (addErrRn . dupSigDeclErr) dups `thenRn_`
+
+    getSrcLocRn			`thenRn` \ locn ->
+
+    (if (is_toplev && opt_SigsRequired) then
+	let
+	    sig_frees = catMaybes (map (sig_free sigs) binder_occnames)
+	in
+	mapRn (addErrRn . missingSigErr locn) sig_frees
+     else
+	returnRn []
+    )				`thenRn_`
+
+    returnRn sigs' -- bad ones and all:
+		   -- we need bindings of *some* sort for every name
+  where
+    rename_sig (Sig v ty pragmas src_loc)
+      = pushSrcLocRn src_loc $
+	if not (v `elem` binder_occnames) then
+	   addErrRn (unknownSigDeclErr "type signature" v src_loc) `thenRn_`
+	   returnRn Nothing
+	else
+	   lookupValue v			`thenRn` \ new_v ->
+	   rnPolyType nullTyVarNamesEnv ty	`thenRn` \ new_ty ->
+
+	   ASSERT(isNoGenPragmas pragmas)
+	   returnRn (Just (Sig new_v new_ty noGenPragmas src_loc))
+
+    -- and now, the various flavours of value-modifying user-pragmas:
+
+    rename_sig (SpecSig v ty using src_loc)
+      = pushSrcLocRn src_loc $
+	if not (v `elem` binder_occnames) then
+	   addErrRn (unknownSigDeclErr "SPECIALIZE pragma" v src_loc) `thenRn_`
+	   returnRn Nothing
+	else
+	   lookupValue v			`thenRn` \ new_v ->
+	   rnPolyType nullTyVarNamesEnv ty	`thenRn` \ new_ty ->
+	   rn_using using			`thenRn` \ new_using ->
+	   returnRn (Just (SpecSig new_v new_ty new_using src_loc))
+      where
+	rn_using Nothing  = returnRn Nothing
+	rn_using (Just x) = lookupValue x `thenRn` \ new_x ->
+			    returnRn (Just new_x)
+
+    rename_sig (InlineSig v src_loc)
+      = pushSrcLocRn src_loc $
+	if not (v `elem` binder_occnames) then
+	   addErrRn (unknownSigDeclErr "INLINE pragma" v src_loc) `thenRn_`
+	   returnRn Nothing
+	else
+	   lookupValue v	`thenRn` \ new_v ->
+	   returnRn (Just (InlineSig new_v src_loc))
+
+    rename_sig (DeforestSig v src_loc)
+      = pushSrcLocRn src_loc $
+	if not (v `elem` binder_occnames) then
+	   addErrRn (unknownSigDeclErr "DEFOREST pragma" v src_loc) `thenRn_`
+	   returnRn Nothing
+	else
+	   lookupValue v        `thenRn` \ new_v ->
+	   returnRn (Just (DeforestSig new_v src_loc))
+
+    rename_sig (MagicUnfoldingSig v str src_loc)
+      = pushSrcLocRn src_loc $
+	if not (v `elem` binder_occnames) then
+	   addErrRn (unknownSigDeclErr "MAGIC_UNFOLDING pragma" v src_loc) `thenRn_`
+	   returnRn Nothing
+	else
+	   lookupValue v	`thenRn` \ new_v ->
+	   returnRn (Just (MagicUnfoldingSig new_v str src_loc))
+
+    not_unbound :: RenamedSig -> Bool
+
+    not_unbound (Sig n _ _ _)		  = not (isRnUnbound n)
+    not_unbound (SpecSig n _ _ _)	  = not (isRnUnbound n)
+    not_unbound (InlineSig n _)		  = not (isRnUnbound n)
+    not_unbound (DeforestSig n _)	  = not (isRnUnbound n)
+    not_unbound (MagicUnfoldingSig n _ _) = not (isRnUnbound n)
+
+    -------------------------------------
+    sig_free :: [RdrNameSig] -> RdrName -> Maybe RdrName
+	-- Return "Just x" if "x" has no type signature in
+	-- sigs.  Nothing, otherwise.
+
+    sig_free [] ny = Just ny
+    sig_free (Sig nx _ _ _ : rest) ny
+      = if (nx == ny) then Nothing else sig_free rest ny
+    sig_free (_ : rest) ny = sig_free rest ny
+
+    -------------------------------------
+    compare :: RenamedSig -> RenamedSig -> TAG_
+    compare (Sig n1 _ _ _)	       (Sig n2 _ _ _)    	  = n1 `cmp` n2
+    compare (InlineSig n1 _)  	       (InlineSig n2 _) 	  = n1 `cmp` n2
+    compare (MagicUnfoldingSig n1 _ _) (MagicUnfoldingSig n2 _ _) = n1 `cmp` n2
+    compare (SpecSig n1 ty1 _ _)       (SpecSig n2 ty2 _ _)
+      = -- may have many specialisations for one value;
+	-- but not ones that are exactly the same...
+	thenCmp (n1 `cmp` n2) (cmpPolyType cmp ty1 ty2)
+
+    compare other_1 other_2	-- tags *must* be different
+      = let tag1 = tag other_1
+	    tag2 = tag other_2
+	in
+	if tag1 _LT_ tag2 then LT_ else GT_
+
+    tag (Sig n1 _ _ _)    	   = (ILIT(1) :: FAST_INT)
+    tag (SpecSig n1 _ _ _)    	   = ILIT(2)
+    tag (InlineSig n1 _)  	   = ILIT(3)
+    tag (MagicUnfoldingSig n1 _ _) = ILIT(4)
+    tag (DeforestSig n1 _)         = ILIT(5)
+    tag _ = panic# "tag(RnBinds)"
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{Error messages}
+%*									*
+%************************************************************************
+
+\begin{code}
+dupSigDeclErr sigs
+  = let
+	undup_sigs = fst (removeDups cmp_sig sigs)
+    in
+    addErrLoc locn1
+	("more than one "++what_it_is++"\n\thas been given for these variables") ( \ sty ->
+    ppAboves (map (ppr sty) undup_sigs) )
+  where
+    (what_it_is, locn1)
+      = case (head sigs) of
+	  Sig        _ _ _ loc -> ("type signature",loc)
+	  ClassOpSig _ _ _ loc -> ("class-method type signature", loc)
+	  SpecSig    _ _ _ loc -> ("SPECIALIZE pragma",loc)
+	  InlineSig  _     loc -> ("INLINE pragma",loc)
+	  MagicUnfoldingSig _ _ loc -> ("MAGIC_UNFOLDING pragma",loc)
+
+    cmp_sig a b = get_name a `cmp` get_name b
+
+    get_name (Sig        n _ _ _) = n
+    get_name (ClassOpSig n _ _ _) = n
+    get_name (SpecSig    n _ _ _) = n
+    get_name (InlineSig  n     _) = n
+    get_name (MagicUnfoldingSig n _ _) = n
+
+------------------------
+methodBindErr mbind locn
+ = addErrLoc locn "Can't handle multiple methods defined by one pattern binding"
+	(\ sty -> ppr sty mbind)
+
+--------------------------
+missingSigErr locn var
+  = addShortErrLocLine locn ( \ sty ->
+    ppBesides [ppStr "a definition but no type signature for `",
+	       ppr sty var,
+	       ppStr "'."])
+
+--------------------------------
+unknownSigDeclErr flavor var locn
+  = addShortErrLocLine locn ( \ sty ->
+    ppBesides [ppStr flavor, ppStr " but no definition for `",
+	       ppr sty var,
+	       ppStr "'."])
+\end{code}
diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
new file mode 100644
index 0000000000..86ba6803bf
--- /dev/null
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -0,0 +1,517 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+%
+\section[RnExpr]{Renaming of expressions}
+
+Basically dependency analysis.
+
+Handles @Match@, @GRHSsAndBinds@, @HsExpr@, and @Qual@ datatypes.  In
+general, all of these functions return a renamed thing, and a set of
+free variables.
+
+\begin{code}
+#include "HsVersions.h"
+
+module RnExpr (
+	rnMatch, rnGRHSsAndBinds, rnPat
+   ) where
+
+import Ubiq
+import RnLoop		-- break the RnPass4/RnExpr4/RnBinds4 loops
+
+import HsSyn
+import RdrHsSyn
+import RnHsSyn
+import RnMonad
+
+import ErrUtils		( addErrLoc )
+import Name		( isLocallyDefinedName, Name, RdrName )
+import Outputable	( pprOp )
+import Pretty
+import UniqFM		( lookupUFM )
+import UniqSet		( emptyUniqSet, unitUniqSet,
+			  unionUniqSets, unionManyUniqSets,
+			  UniqSet(..) )
+import Util		( Ord3(..), panic )
+\end{code}
+
+
+*********************************************************
+*							*
+\subsection{Patterns}
+*							*
+*********************************************************
+
+\begin{code}
+rnPat :: RdrNamePat -> RnM_Fixes s RenamedPat
+
+rnPat WildPatIn = returnRn WildPatIn
+
+rnPat (VarPatIn name)
+  = lookupValue name	`thenRn` \ vname ->
+    returnRn (VarPatIn vname)
+
+rnPat (LitPatIn n) = returnRn (LitPatIn n)
+
+rnPat (LazyPatIn pat)
+  = rnPat pat		`thenRn` \ pat' ->
+    returnRn (LazyPatIn pat')
+
+rnPat (AsPatIn name pat)
+  = rnPat pat	`thenRn` \ pat' ->
+    lookupValue name	`thenRn` \ vname ->
+    returnRn (AsPatIn vname pat')
+
+rnPat (ConPatIn name pats)
+  = lookupValue name	`thenRn` \ name' ->
+    mapRn rnPat pats  	`thenRn` \ patslist ->
+    returnRn (ConPatIn name' patslist)
+
+rnPat (ConOpPatIn pat1 name pat2)
+  = lookupValue name	`thenRn` \ name' ->
+    rnPat pat1		`thenRn` \ pat1' ->
+    rnPat pat2		`thenRn` \ pat2' ->
+    precParsePat (ConOpPatIn pat1' name' pat2')
+
+rnPat neg@(NegPatIn pat)
+  = getSrcLocRn		`thenRn` \ src_loc ->
+    addErrIfRn (not (is_lit pat)) (negPatErr neg src_loc)
+			`thenRn_`
+    rnPat pat		`thenRn` \ pat' ->
+    returnRn (NegPatIn pat')
+  where
+    is_lit (LitPatIn _) = True
+    is_lit _            = False
+
+rnPat (ParPatIn pat)
+  = rnPat pat		`thenRn` \ pat' ->
+    returnRn (ParPatIn pat')
+
+rnPat (ListPatIn pats)
+  = mapRn rnPat pats 	`thenRn` \ patslist ->
+    returnRn (ListPatIn patslist)
+
+rnPat (TuplePatIn pats)
+  = mapRn rnPat pats 	`thenRn` \ patslist ->
+    returnRn (TuplePatIn patslist)
+
+rnPat (RecPatIn con rpats)
+  = panic "rnPat:RecPatIn"
+
+\end{code}
+
+************************************************************************
+*									*
+\subsection{Match}
+*									*
+************************************************************************
+
+\begin{code}
+rnMatch :: RdrNameMatch -> RnM_Fixes s (RenamedMatch, FreeVars)
+
+rnMatch match
+  = getSrcLocRn			`thenRn` \ src_loc ->
+    newLocalNames "variable in pattern"
+	 (binders `zip` repeat src_loc)	`thenRn` \ new_binders ->
+    extendSS2 new_binders (rnMatch_aux match)
+  where
+    binders = collect_binders match
+
+    collect_binders :: RdrNameMatch -> [RdrName]
+
+    collect_binders (GRHSMatch _) = []
+    collect_binders (PatMatch pat match)
+      = collectPatBinders pat ++ collect_binders match
+
+rnMatch_aux (PatMatch pat match)
+  = rnPat pat		`thenRn` \ pat' ->
+    rnMatch_aux match	`thenRn` \ (match', fvMatch) ->
+    returnRn (PatMatch pat' match', fvMatch)
+
+rnMatch_aux (GRHSMatch grhss_and_binds)
+  = rnGRHSsAndBinds grhss_and_binds `thenRn` \ (grhss_and_binds', fvs) ->
+    returnRn (GRHSMatch grhss_and_binds', fvs)
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection{Guarded right-hand sides (GRHSsAndBinds)}
+%*									*
+%************************************************************************
+
+\begin{code}
+rnGRHSsAndBinds :: RdrNameGRHSsAndBinds -> RnM_Fixes s (RenamedGRHSsAndBinds, FreeVars)
+
+rnGRHSsAndBinds (GRHSsAndBindsIn grhss binds)
+  = rnBinds binds			`thenRn` \ (binds', fvBinds, scope) ->
+    extendSS2 scope (rnGRHSs grhss)	`thenRn` \ (grhss', fvGRHS) ->
+    returnRn (GRHSsAndBindsIn grhss' binds', fvBinds `unionUniqSets` fvGRHS)
+  where
+    rnGRHSs [] = returnRn ([], emptyUniqSet)
+
+    rnGRHSs (grhs:grhss)
+      = rnGRHS  grhs   `thenRn` \ (grhs',  fvs) ->
+	rnGRHSs grhss  `thenRn` \ (grhss', fvss) ->
+	returnRn (grhs' : grhss', fvs `unionUniqSets` fvss)
+
+    rnGRHS (GRHS guard expr locn)
+      = pushSrcLocRn locn $		    
+	rnExpr guard	`thenRn` \ (guard', fvsg) ->
+	rnExpr expr	`thenRn` \ (expr',  fvse) ->
+	returnRn (GRHS guard' expr' locn, fvsg `unionUniqSets` fvse)
+
+    rnGRHS (OtherwiseGRHS expr locn)
+      = pushSrcLocRn locn $
+	rnExpr expr	`thenRn` \ (expr', fvs) ->
+	returnRn (OtherwiseGRHS expr' locn, fvs)
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection{Expressions}
+%*									*
+%************************************************************************
+
+\begin{code}
+rnExprs :: [RdrNameHsExpr] -> RnM_Fixes s ([RenamedHsExpr], FreeVars)
+
+rnExprs [] = returnRn ([], emptyUniqSet)
+
+rnExprs (expr:exprs)
+  = rnExpr expr 	`thenRn` \ (expr', fvExpr) ->
+    rnExprs exprs	`thenRn` \ (exprs', fvExprs) ->
+    returnRn (expr':exprs', fvExpr `unionUniqSets` fvExprs)
+\end{code}
+
+Variables. We look up the variable and return the resulting name.  The
+interesting question is what the free-variable set should be.  We
+don't want to return imported or prelude things as free vars.  So we
+look at the RnName returned from the lookup, and make it part of the
+free-var set iff if it's a LocallyDefined RnName.
+
+ToDo: what about RnClassOps ???
+\end{itemize}
+
+\begin{code}
+rnExpr :: RdrNameHsExpr -> RnM_Fixes s (RenamedHsExpr, FreeVars)
+
+rnExpr (HsVar v)
+  = lookupValue v	`thenRn` \ vname ->
+    returnRn (HsVar vname, fv_set vname)
+  where
+    fv_set vname@(RnName n)
+      | isLocallyDefinedName n = unitUniqSet vname
+      | otherwise	       = emptyUniqSet
+
+rnExpr (HsLit lit)
+  = returnRn (HsLit lit, emptyUniqSet)
+
+rnExpr (HsLam match)
+  = rnMatch match	`thenRn` \ (match', fvMatch) ->
+    returnRn (HsLam match', fvMatch)
+
+rnExpr (HsApp fun arg)
+  = rnExpr fun		`thenRn` \ (fun',fvFun) ->
+    rnExpr arg		`thenRn` \ (arg',fvArg) ->
+    returnRn (HsApp fun' arg', fvFun `unionUniqSets` fvArg)
+
+rnExpr (OpApp e1 op e2)
+  = rnExpr e1		`thenRn` \ (e1', fvs_e1) ->
+    rnExpr op		`thenRn` \ (op', fvs_op) ->
+    rnExpr e2		`thenRn` \ (e2', fvs_e2) ->
+    precParseExpr (OpApp e1' op' e2') `thenRn` \ exp ->
+    returnRn (exp, (fvs_op `unionUniqSets` fvs_e1) `unionUniqSets` fvs_e2)
+
+rnExpr (NegApp e)
+  = rnExpr e 		`thenRn` \ (e', fvs_e) ->
+    returnRn (NegApp e', fvs_e)
+
+rnExpr (HsPar e)
+  = rnExpr e 		`thenRn` \ (e', fvs_e) ->
+    returnRn (HsPar e', fvs_e)
+
+rnExpr (SectionL expr op)
+  = rnExpr expr	 	`thenRn` \ (expr', fvs_expr) ->
+    rnExpr op	 	`thenRn` \ (op', fvs_op) ->
+    returnRn (SectionL expr' op', fvs_op `unionUniqSets` fvs_expr)
+
+rnExpr (SectionR op expr)
+  = rnExpr op	 	`thenRn` \ (op',   fvs_op) ->
+    rnExpr expr	 	`thenRn` \ (expr', fvs_expr) ->
+    returnRn (SectionR op' expr', fvs_op `unionUniqSets` fvs_expr)
+
+rnExpr (CCall fun args may_gc is_casm fake_result_ty)
+  = rnExprs args	`thenRn` \ (args', fvs_args) ->
+    returnRn (CCall fun args' may_gc is_casm fake_result_ty, fvs_args)
+
+rnExpr (HsSCC label expr)
+  = rnExpr expr	 	`thenRn` \ (expr', fvs_expr) ->
+    returnRn (HsSCC label expr', fvs_expr)
+
+rnExpr (HsCase expr ms src_loc)
+  = pushSrcLocRn src_loc $
+    rnExpr expr		 	`thenRn` \ (new_expr, e_fvs) ->
+    mapAndUnzipRn rnMatch ms	`thenRn` \ (new_ms, ms_fvs) ->
+    returnRn (HsCase new_expr new_ms src_loc, unionManyUniqSets (e_fvs : ms_fvs))
+
+rnExpr (HsLet binds expr)
+  = rnBinds binds		`thenRn` \ (binds', fvBinds, new_binders) ->
+    extendSS2 new_binders (rnExpr expr) `thenRn` \ (expr',fvExpr) ->
+    returnRn (HsLet binds' expr', fvBinds `unionUniqSets` fvExpr)
+
+rnExpr (HsDo stmts src_loc)
+  = pushSrcLocRn src_loc $
+    rnStmts stmts		`thenRn` \ (stmts', fvStmts) ->
+    returnRn (HsDo stmts' src_loc, fvStmts)
+
+rnExpr (ListComp expr quals)
+  = rnQuals quals 		`thenRn` \ ((quals', qual_binders), fvQuals) ->
+    extendSS2 qual_binders (rnExpr expr) `thenRn` \ (expr', fvExpr) ->
+    returnRn (ListComp expr' quals', fvExpr `unionUniqSets` fvQuals)
+
+rnExpr (ExplicitList exps)
+  = rnExprs exps	 	`thenRn` \ (exps', fvs) ->
+    returnRn  (ExplicitList exps', fvs)
+
+rnExpr (ExplicitTuple exps)
+  = rnExprs exps	 	`thenRn` \ (exps', fvExps) ->
+    returnRn (ExplicitTuple exps', fvExps)
+
+rnExpr (RecordCon con rbinds)
+  = panic "rnExpr:RecordCon"
+rnExpr (RecordUpd exp rbinds)
+  = panic "rnExpr:RecordUpd"
+
+rnExpr (ExprWithTySig expr pty)
+  = rnExpr expr			 	`thenRn` \ (expr', fvExpr) ->
+    rnPolyType nullTyVarNamesEnv pty `thenRn` \ pty' ->
+    returnRn (ExprWithTySig expr' pty', fvExpr)
+
+rnExpr (HsIf p b1 b2 src_loc)
+  = pushSrcLocRn src_loc $
+    rnExpr p		`thenRn` \ (p', fvP) ->
+    rnExpr b1		`thenRn` \ (b1', fvB1) ->
+    rnExpr b2		`thenRn` \ (b2', fvB2) ->
+    returnRn (HsIf p' b1' b2' src_loc, unionManyUniqSets [fvP, fvB1, fvB2])
+
+rnExpr (ArithSeqIn seq)
+  = rn_seq seq 		`thenRn` \ (new_seq, fvs) ->
+    returnRn (ArithSeqIn new_seq, fvs)
+  where
+    rn_seq (From expr)
+     = rnExpr expr 	`thenRn` \ (expr', fvExpr) ->
+       returnRn (From expr', fvExpr)
+
+    rn_seq (FromThen expr1 expr2)
+     = rnExpr expr1 	`thenRn` \ (expr1', fvExpr1) ->
+       rnExpr expr2	`thenRn` \ (expr2', fvExpr2) ->
+       returnRn (FromThen expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
+
+    rn_seq (FromTo expr1 expr2)
+     = rnExpr expr1	`thenRn` \ (expr1', fvExpr1) ->
+       rnExpr expr2	`thenRn` \ (expr2', fvExpr2) ->
+       returnRn (FromTo expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
+
+    rn_seq (FromThenTo expr1 expr2 expr3)
+     = rnExpr expr1	`thenRn` \ (expr1', fvExpr1) ->
+       rnExpr expr2	`thenRn` \ (expr2', fvExpr2) ->
+       rnExpr expr3	`thenRn` \ (expr3', fvExpr3) ->
+       returnRn (FromThenTo expr1' expr2' expr3',
+		  unionManyUniqSets [fvExpr1, fvExpr2, fvExpr3])
+
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection{@Qual@s: in list comprehensions}
+%*									*
+%************************************************************************
+
+Note that although some bound vars may appear in the free var set for
+the first qual, these will eventually be removed by the caller. For
+example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
+@[q <- r, p <- q]@, the free var set for @q <- r@ will
+be @{r}@, and the free var set for the entire Quals will be @{r}@. This
+@r@ will be removed only when we finally return from examining all the
+Quals.
+
+\begin{code}
+rnQuals :: [RdrNameQual]
+	 -> RnM_Fixes s (([RenamedQual],	-- renamed qualifiers
+		         [RnName]),		-- qualifiers' binders
+		         FreeVars)		-- free variables
+
+rnQuals [qual] 				-- must be at least one qual
+  = rnQual qual `thenRn` \ ((new_qual, bs), fvs) ->
+    returnRn (([new_qual], bs), fvs)
+
+rnQuals (qual: quals)
+  = rnQual qual				`thenRn` \ ((qual',  bs1), fvQuals1) ->
+    extendSS2 bs1 (rnQuals quals)	`thenRn` \ ((quals', bs2), fvQuals2) ->
+    returnRn
+       ((qual' : quals', bs2 ++ bs1),	-- The ones on the right (bs2) shadow the
+					-- ones on the left (bs1)
+	fvQuals1 `unionUniqSets` fvQuals2)
+
+rnQual (GeneratorQual pat expr)
+  = rnExpr expr		 `thenRn` \ (expr', fvExpr) ->
+    let
+	binders = collectPatBinders pat
+    in
+    getSrcLocRn		 `thenRn` \ src_loc ->
+    newLocalNames "variable in list-comprehension-generator pattern"
+	 (binders `zip` repeat src_loc)	  `thenRn` \ new_binders ->
+    extendSS new_binders (rnPat pat) `thenRn` \ pat' ->
+
+    returnRn ((GeneratorQual pat' expr', new_binders), fvExpr)
+
+rnQual (FilterQual expr)
+  = rnExpr expr	 `thenRn` \ (expr', fvs) ->
+    returnRn ((FilterQual expr', []), fvs)
+
+rnQual (LetQual binds)
+  = rnBinds binds	`thenRn` \ (binds', binds_fvs, new_binders) ->
+    returnRn ((LetQual binds', new_binders), binds_fvs)
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsubsection{@Stmt@s: in @do@ expressions}
+%*									*
+%************************************************************************
+
+\begin{code}
+rnStmts :: [RdrNameStmt] -> RnM_Fixes s ([RenamedStmt], FreeVars)
+
+rnStmts [stmt@(ExprStmt _ _)]		-- last stmt must be ExprStmt
+  = rnStmt stmt				`thenRn` \ ((stmt',[]), fvStmt) ->
+    returnRn ([stmt'], fvStmt)
+
+rnStmts (stmt:stmts)
+  = rnStmt stmt				`thenRn` \ ((stmt',bs), fvStmt) ->
+    extendSS2 bs (rnStmts stmts)	`thenRn` \ (stmts',     fvStmts) ->
+    returnRn (stmt':stmts', fvStmt `unionUniqSets` fvStmts)
+
+
+rnStmt (BindStmt pat expr src_loc)
+  = pushSrcLocRn src_loc $
+    rnExpr expr		 		`thenRn` \ (expr', fvExpr) ->
+    let
+	binders = collectPatBinders pat
+    in
+    newLocalNames "variable in do binding"
+	 (binders `zip` repeat src_loc)	`thenRn` \ new_binders ->
+    extendSS new_binders (rnPat pat) 	`thenRn` \ pat' ->
+
+    returnRn ((BindStmt pat' expr' src_loc, new_binders), fvExpr)
+
+rnStmt (ExprStmt expr src_loc)
+  = 
+    rnExpr expr	 			`thenRn` \ (expr', fvs) ->
+    returnRn ((ExprStmt expr' src_loc, []), fvs)
+
+rnStmt (LetStmt binds)
+  = rnBinds binds	`thenRn` \ (binds', binds_fvs, new_binders) ->
+    returnRn ((LetStmt binds', new_binders), binds_fvs)
+
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection{Precedence Parsing}
+%*									*
+%************************************************************************
+
+\begin{code}
+precParseExpr :: RenamedHsExpr -> RnM_Fixes s RenamedHsExpr
+precParsePat  :: RenamedPat -> RnM_Fixes s RenamedPat
+
+precParseExpr exp@(OpApp (NegApp e1) (HsVar op) e2)
+  = lookupFixity op		`thenRn` \ (op_fix, op_prec) ->
+    if 6 < op_prec then		
+	-- negate precedence 6 wired in
+	-- (-x)*y  ==> -(x*y)
+	precParseExpr (OpApp e1 (HsVar op) e2) `thenRn` \ op_app ->
+	returnRn (NegApp op_app)
+    else
+	returnRn exp
+
+precParseExpr exp@(OpApp (OpApp e11 (HsVar op1) e12) (HsVar op) e2)
+  = lookupFixity op		 `thenRn` \ (op_fix, op_prec) ->
+    lookupFixity op1		 `thenRn` \ (op1_fix, op1_prec) ->
+    case cmp op1_prec op_prec of
+      LT_  -> rearrange
+      EQ_  -> case (op1_fix, op_fix) of
+		(INFIXR, INFIXR) -> rearrange
+		(INFIXL, INFIXL) -> returnRn exp
+		_ -> getSrcLocRn `thenRn` \ src_loc ->
+		     failButContinueRn exp
+		     (precParseErr (op1,op1_fix,op1_prec) (op,op_fix,op_prec) src_loc)
+      GT__ -> returnRn exp
+  where
+    rearrange = precParseExpr (OpApp e12 (HsVar op) e2) `thenRn` \ e2' ->
+	        returnRn (OpApp e11 (HsVar op1) e2')
+
+precParseExpr exp = returnRn exp
+
+
+precParsePat pat@(ConOpPatIn (NegPatIn e1) op e2)
+  = lookupFixity op		`thenRn` \ (op_fix, op_prec) ->
+    if 6 < op_prec then	
+	-- negate precedence 6 wired in
+	getSrcLocRn `thenRn` \ src_loc ->
+	failButContinueRn pat (precParseNegPatErr (op,op_fix,op_prec) src_loc)
+    else
+	returnRn pat
+
+precParsePat pat@(ConOpPatIn (ConOpPatIn p11 op1 p12) op p2)
+  = lookupFixity op		 `thenRn` \ (op_fix, op_prec) ->
+    lookupFixity op1		 `thenRn` \ (op1_fix, op1_prec) ->
+    case cmp op1_prec op_prec of
+      LT_  -> rearrange
+      EQ_  -> case (op1_fix, op_fix) of
+		(INFIXR, INFIXR) -> rearrange
+		(INFIXL, INFIXL) -> returnRn pat
+		_ -> getSrcLocRn `thenRn` \ src_loc ->
+		     failButContinueRn pat
+		       (precParseErr (op1,op1_fix,op1_prec) (op,op_fix,op_prec) src_loc)
+      GT__ -> returnRn pat
+  where
+    rearrange = precParsePat (ConOpPatIn p12 op p2) `thenRn` \ p2' ->
+	        returnRn (ConOpPatIn p11 op1 p2')
+
+precParsePat pat = returnRn pat
+
+
+data INFIX = INFIXL | INFIXR | INFIXN
+
+lookupFixity :: RnName -> RnM_Fixes s (INFIX, Int)
+lookupFixity op
+  = getExtraRn `thenRn` \ fixity_fm ->
+    case lookupUFM fixity_fm op of
+      Nothing           -> returnRn (INFIXL, 9)
+      Just (InfixL _ n) -> returnRn (INFIXL, n)
+      Just (InfixR _ n) -> returnRn (INFIXR, n)
+      Just (InfixN _ n) -> returnRn (INFIXN, n)
+\end{code}
+
+\begin{code}
+negPatErr pat src_loc
+  = addErrLoc src_loc "prefix `-' not applied to literal in pattern" ( \sty ->
+    ppr sty pat) 
+
+precParseNegPatErr op src_loc
+  = addErrLoc src_loc "precedence parsing error" (\ sty ->
+    ppBesides [ppStr "prefix `-' has lower precedence than ", pp_op sty op, ppStr " in pattern"])
+
+precParseErr op1 op2 src_loc
+  = addErrLoc src_loc "precedence parsing error" (\ sty -> 
+    ppBesides [ppStr "cannot mix ", pp_op sty op1, ppStr " and ", pp_op sty op2,
+	       ppStr " in the same infix expression"])
+
+pp_op sty (op, fix, prec) = ppBesides [pprOp sty op, ppLparen, pp_fix fix, ppSP, ppInt prec, ppRparen]
+pp_fix INFIXL = ppStr "infixl"
+pp_fix INFIXR = ppStr "infixr"
+pp_fix INFIXN = ppStr "infix"
+\end{code}
diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
index 278fc65897..9c8ab0dfdf 100644
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ b/ghc/compiler/rename/RnHsSyn.lhs
@@ -8,49 +8,150 @@
 
 module RnHsSyn where
 
-import Ubiq{-uitous-}
+import Ubiq
 
 import HsSyn
+
+import Name		( isLocalName, nameUnique, Name, RdrName )
+import Id		( GenId, Id(..) )
+import Outputable	( Outputable(..) )
+import PprType		( GenType, GenTyVar, TyCon )
+import PprStyle		( PprStyle(..) )
+import Pretty
+import TyCon		( TyCon )
+import TyVar		( GenTyVar )
+import Unique		( Unique )
+import Util		( panic, pprPanic )
+\end{code}
+
+\begin{code}
+data RnName
+  = WiredInId       Id
+  | WiredInTyCon    TyCon
+  | RnName          Name        -- funtions/binders/tyvars
+  | RnSyn           Name        -- type synonym
+  | RnData          Name [Name] -- data type   (with constrs)
+  | RnConstr        Name  Name  -- constructor (with data type)
+  | RnClass         Name [Name] -- class       (with class ops)
+  | RnClassOp       Name  Name  -- class op    (with class)
+  | RnImplicit      Name      	-- implicitly imported
+  | RnImplicitTyCon Name      	-- implicitly imported
+  | RnImplicitClass Name      	-- implicitly imported
+  | RnUnbound	    RdrName    	-- place holder
+
+mkRnName          = RnName
+mkRnImplicit      = RnImplicit
+mkRnImplicitTyCon = RnImplicitTyCon
+mkRnImplicitClass = RnImplicitClass
+mkRnUnbound       = RnUnbound
+
+isRnWired (WiredInId _)    = True
+isRnWired (WiredInTyCon _) = True
+isRnWired _ 	           = False
+
+isRnLocal (RnName n) = isLocalName n
+isRnLocal _ 	     = False
+
+
+isRnTyCon (WiredInTyCon _)    = True
+isRnTyCon (RnSyn _)    	      = True
+isRnTyCon (RnData _ _) 	      = True
+isRnTyCon (RnImplicitTyCon _) = True
+isRnTyCon _            	      = False
+
+isRnClass (RnClass _ _)       = True
+isRnClass (RnImplicitClass _) = True
+isRnClass _                   = False
+
+isRnClassOp cls (RnClassOp _ op_cls) = eqUniqsNamed cls op_cls
+isRnClassOp cls (RnImplicit _)	     = True	-- ho hummm ...
+isRnClassOp cls _		     = False
+
+isRnImplicit (RnImplicit _)      = True
+isRnImplicit (RnImplicitTyCon _) = True
+isRnImplicit (RnImplicitClass _) = True
+isRnImplicit _			 = False
+
+isRnUnbound (RnUnbound _) = True
+isRnUnbound _		  = False
+
+-- Very general NamedThing comparison, used when comparing
+-- Uniquable things with different types
+
+eqUniqsNamed  n1 n2 = uniqueOf n1  ==   uniqueOf n2
+cmpUniqsNamed n1 n2 = uniqueOf n1 `cmp` uniqueOf n2
+
+instance Eq RnName where
+    a == b = eqUniqsNamed a b
+
+instance Ord3 RnName where
+    a `cmp` b = cmpUniqsNamed a b
+
+instance Uniquable RnName where
+    uniqueOf = nameUnique . getName
+
+instance NamedThing RnName where
+    getName (WiredInId id)    = getName id
+    getName (WiredInTyCon tc) = getName tc
+    getName (RnName n)	      = n
+    getName (RnSyn n)	      = n
+    getName (RnData n _)      = n
+    getName (RnConstr n _)    = n
+    getName (RnClass n _)     = n
+    getName (RnClassOp n _)   = n
+    getName (RnImplicit n)    = n
+    getName (RnUnbound occ)   = pprPanic "getRnName:RnUnbound" (ppr PprDebug occ)
+
+instance Outputable RnName where
+#ifdef DEBUG
+    ppr sty@PprShowAll (RnData n cs)   = ppBesides [ppr sty n, ppStr "{-", ppr sty cs, ppStr "-}"]
+    ppr sty@PprShowAll (RnConstr n d)  = ppBesides [ppr sty n, ppStr "{-", ppr sty d, ppStr "-}"]
+    ppr sty@PprShowAll (RnClass n ops) = ppBesides [ppr sty n, ppStr "{-", ppr sty ops, ppStr "-}"]
+    ppr sty@PprShowAll (RnClassOp n c) = ppBesides [ppr sty n, ppStr "{-", ppr sty c, ppStr "-}"]
+#endif
+    ppr sty (WiredInId id)      = ppr sty id
+    ppr sty (WiredInTyCon tycon)= ppr sty tycon
+    ppr sty (RnUnbound occ)	= ppBeside (ppr sty occ) (ppPStr SLIT("{-UNBOUND-}"))
+    ppr sty rn_name		= ppr sty (getName rn_name)
 \end{code}
 
 \begin{code}
-type RenamedArithSeqInfo	= ArithSeqInfo		Fake Fake Name RenamedPat
-type RenamedBind		= Bind			Fake Fake Name RenamedPat
-type RenamedClassDecl		= ClassDecl		Fake Fake Name RenamedPat
-type RenamedClassOpPragmas	= ClassOpPragmas	Name
-type RenamedClassOpSig		= Sig			Name
-type RenamedClassPragmas	= ClassPragmas		Name
-type RenamedConDecl		= ConDecl		Name
-type RenamedContext		= Context 		Name
-type RenamedDataPragmas		= DataPragmas		Name
-type RenamedSpecDataSig		= SpecDataSig		Name
-type RenamedDefaultDecl		= DefaultDecl		Name
-type RenamedFixityDecl		= FixityDecl		Name
-type RenamedGRHS		= GRHS			Fake Fake Name RenamedPat
-type RenamedGRHSsAndBinds	= GRHSsAndBinds		Fake Fake Name RenamedPat
-type RenamedGenPragmas		= GenPragmas		Name
-type RenamedHsBinds		= HsBinds		Fake Fake Name RenamedPat
-type RenamedHsExpr		= HsExpr		Fake Fake Name RenamedPat
-type RenamedHsModule		= HsModule		Fake Fake Name RenamedPat
-type RenamedRecordBinds		= HsRecordBinds		Fake Fake Name RenamedPat
-type RenamedImportedInterface	= ImportedInterface	Fake Fake Name RenamedPat
-type RenamedInstDecl		= InstDecl		Fake Fake Name RenamedPat
-type RenamedInstancePragmas	= InstancePragmas	Name
-type RenamedInterface		= Interface		Fake Fake Name RenamedPat
-type RenamedMatch		= Match			Fake Fake Name RenamedPat
-type RenamedMonoBinds		= MonoBinds		Fake Fake Name RenamedPat
-type RenamedMonoType		= MonoType		Name
-type RenamedPat			= InPat			Name
-type RenamedPolyType		= PolyType		Name
-type RenamedQual		= Qual			Fake Fake Name RenamedPat
-type RenamedSig			= Sig			Name
-type RenamedSpecInstSig		= SpecInstSig 		Name
-type RenamedStmt		= Stmt			Fake Fake Name RenamedPat
-type RenamedTyDecl		= TyDecl		Name
+type RenamedArithSeqInfo	= ArithSeqInfo		Fake Fake RnName RenamedPat
+type RenamedBind		= Bind			Fake Fake RnName RenamedPat
+type RenamedClassDecl		= ClassDecl		Fake Fake RnName RenamedPat
+type RenamedClassOpSig		= Sig			RnName
+type RenamedConDecl		= ConDecl		RnName
+type RenamedContext		= Context 		RnName
+type RenamedSpecDataSig		= SpecDataSig		RnName
+type RenamedDefaultDecl		= DefaultDecl		RnName
+type RenamedFixityDecl		= FixityDecl		RnName
+type RenamedGRHS		= GRHS			Fake Fake RnName RenamedPat
+type RenamedGRHSsAndBinds	= GRHSsAndBinds		Fake Fake RnName RenamedPat
+type RenamedHsBinds		= HsBinds		Fake Fake RnName RenamedPat
+type RenamedHsExpr		= HsExpr		Fake Fake RnName RenamedPat
+type RenamedHsModule		= HsModule		Fake Fake RnName RenamedPat
+type RenamedInstDecl		= InstDecl		Fake Fake RnName RenamedPat
+type RenamedMatch		= Match			Fake Fake RnName RenamedPat
+type RenamedMonoBinds		= MonoBinds		Fake Fake RnName RenamedPat
+type RenamedMonoType		= MonoType		RnName
+type RenamedPat			= InPat			RnName
+type RenamedPolyType		= PolyType		RnName
+type RenamedRecordBinds		= HsRecordBinds		Fake Fake RnName RenamedPat
+type RenamedQual		= Qual			Fake Fake RnName RenamedPat
+type RenamedSig			= Sig			RnName
+type RenamedSpecInstSig		= SpecInstSig 		RnName
+type RenamedStmt		= Stmt			Fake Fake RnName RenamedPat
+type RenamedTyDecl		= TyDecl		RnName
+
+type RenamedClassOpPragmas	= ClassOpPragmas	RnName
+type RenamedClassPragmas	= ClassPragmas		RnName
+type RenamedDataPragmas		= DataPragmas		RnName
+type RenamedGenPragmas		= GenPragmas		RnName
+type RenamedInstancePragmas	= InstancePragmas	RnName
 \end{code}
 
 \begin{code}
-collectQualBinders :: [RenamedQual] -> [Name]
+collectQualBinders :: [RenamedQual] -> [RnName]
 
 collectQualBinders quals
   = concat (map collect quals)
@@ -59,3 +160,4 @@ collectQualBinders quals
     collect (FilterQual expr)	  = []
     collect (LetQual    binds)	  = collectTopLevelBinders binds
 \end{code}
+
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
new file mode 100644
index 0000000000..797f8aa895
--- /dev/null
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -0,0 +1,112 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+%
+\section[RnIfaces]{Cacheing and Renaming of Interfaces}
+
+\begin{code}
+#include "HsVersions.h"
+
+module RnIfaces (
+	cacheInterface,
+	readInterface,
+	rnInterfaces,
+	finalIfaceInfo,
+	IfaceCache(..),
+	VersionInfo(..),
+	ParsedIface(..)
+    ) where
+
+import PreludeGlaST	( returnPrimIO, thenPrimIO,
+			  readVar, writeVar, MutableVar(..) )
+
+import Ubiq
+
+import HsSyn
+import RdrHsSyn
+import RnHsSyn
+
+import RnMonad
+import RnUtils		( RnEnv(..) )
+
+import Bag		( emptyBag )
+import ErrUtils		( Error(..), Warning(..) )
+import FiniteMap	( emptyFM, lookupFM, addToFM )
+import Pretty
+import Maybes		( MaybeErr(..) )
+import Util		( panic )
+
+\end{code}
+
+
+\begin{code}
+type IfaceCache = MutableVar _RealWorld (FiniteMap Module ParsedIface,
+				         FiniteMap Module FAST_STRING)
+
+data ParsedIface = ParsedIface
+
+
+cacheInterface :: IfaceCache -> Module
+	       -> PrimIO (MaybeErr ParsedIface Error)
+
+cacheInterface iface_var mod
+  = readVar iface_var `thenPrimIO` \ (iface_fm, file_fm) ->
+    case lookupFM iface_fm mod of
+      Just iface -> returnPrimIO (Succeeded iface)
+      Nothing    ->
+      	case lookupFM file_fm mod of
+	  Nothing   -> returnPrimIO (Failed (noIfaceErr mod))
+	  Just file ->
+	    readInterface file mod `thenPrimIO` \ read_iface ->
+	    case read_iface of
+	      Failed err      -> returnPrimIO (Failed err)
+	      Succeeded iface ->
+		let
+		    iface_fm' = addToFM iface_fm mod iface
+		in
+		writeVar iface_var (iface_fm', file_fm) `thenPrimIO` \ _ ->
+		returnPrimIO (Succeeded iface)
+
+
+readInterface :: FAST_STRING -> Module
+	      -> PrimIO (MaybeErr ParsedIface Error)
+
+readInterface file mod = panic "readInterface"
+\end{code}
+
+
+\begin{code}
+rnInterfaces ::
+	   IfaceCache				-- iface cache
+	-> RnEnv				-- original name env
+	-> UniqSupply
+	-> RenamedHsModule			-- module to extend with iface decls
+	-> [RnName]				-- imported names required
+	-> PrimIO (RenamedHsModule,		-- extended module
+	           ImplicitEnv,			-- implicit names required
+		   Bag Error,
+		   Bag Warning)
+
+rnInterfaces iface_var occ_env us rn_module todo
+  = returnPrimIO (rn_module, (emptyFM, emptyFM), emptyBag, emptyBag)
+\end{code}
+
+
+\begin{code}
+finalIfaceInfo ::
+	   IfaceCache				-- iface cache
+	-> [RnName]				-- all imported names required
+	-> [Module]				-- directly imported modules
+	-> PrimIO (VersionInfo,			-- info about version numbers
+		   [Module])			-- special instance modules
+
+type VersionInfo = [(Module, Version, [(FAST_STRING, Version)])]
+
+finalIfaceInfo iface_var imps_reqd imp_mods
+  = returnPrimIO ([], [])
+\end{code}
+
+
+\begin{code}
+noIfaceErr mod sty
+  = ppCat [ppStr "Could not find interface for", ppPStr mod]
+\end{code}
diff --git a/ghc/compiler/rename/RnLoop.lhi b/ghc/compiler/rename/RnLoop.lhi
index 92b7d418b6..f228aee0b9 100644
--- a/ghc/compiler/rename/RnLoop.lhi
+++ b/ghc/compiler/rename/RnLoop.lhi
@@ -1,22 +1,18 @@
-Breaks the RnPass4/RnExpr4/RnBind4 loops.
+Breaks the RnSource/RnExpr/RnBinds loops.
 
 \begin{code}
 interface RnLoop where
 
-import Name		( Name )
-import RdrHsSyn		( ProtoNameHsBinds(..), ProtoNamePolyType(..), ProtoNameGenPragmas(..) )
-import RnHsSyn		( RenamedHsBinds(..), RenamedPolyType(..), RenamedGenPragmas(..) )
-import RnBinds4		( rnBinds, FreeVars(..) )
-import RnMonad4		( TyVarNamesEnv(..), Rn4M(..) )
-import RnPass4		( rnPolyType, rnGenPragmas )
+import RdrHsSyn		( RdrNameHsBinds(..), RdrNamePolyType(..) )
+import RnHsSyn		( RnName, RenamedHsBinds(..), RenamedPolyType(..) )
+import RnBinds		( rnBinds, FreeVars(..) )
+import RnMonad		( TyVarNamesEnv(..), RnM_Fixes(..) )
+import RnSource		( rnPolyType )
 import UniqSet		( UniqSet(..) )
 
-rnBinds :: ProtoNameHsBinds -> Rn4M (RenamedHsBinds, FreeVars, [Name])
-rnGenPragmas :: ProtoNameGenPragmas -> Rn4M RenamedGenPragmas
-rnPolyType :: Bool
-	    -> TyVarNamesEnv
-	    -> ProtoNamePolyType
-	    -> Rn4M RenamedPolyType
-
-type FreeVars = UniqSet Name
+rnBinds :: RdrNameHsBinds -> RnM_Fixes s (RenamedHsBinds, FreeVars, [RnName])
+rnPolyType :: TyVarNamesEnv
+	   -> RdrNamePolyType
+	   -> RnM_Fixes s RenamedPolyType
+type FreeVars = UniqSet RnName
 \end{code}
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
new file mode 100644
index 0000000000..49765f117f
--- /dev/null
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -0,0 +1,493 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+%
+\section[RnMonad]{The monad used by the renamer}
+
+\begin{code}
+#include "HsVersions.h"
+
+module RnMonad (
+	RnMonad(..), RnM(..), RnM_Fixes(..), RnDown, SST_R,
+	initRn, thenRn, thenRn_, andRn, returnRn,
+	mapRn, mapAndUnzipRn,
+
+	addErrRn, addErrIfRn, addWarnRn, addWarnIfRn,
+	failButContinueRn, warnAndContinueRn,
+	setExtraRn, getExtraRn,
+	getModuleRn, pushSrcLocRn, getSrcLocRn,
+	getSourceRn, getOccurrenceUpRn,
+	getImplicitUpRn, ImplicitEnv(..),
+	rnGetUnique, rnGetUniques,
+
+	newLocalNames,
+	lookupValue, lookupValueMaybe,
+	lookupTyCon, lookupClass, lookupClassOp,
+	extendSS2, extendSS,
+
+	TyVarNamesEnv(..), mkTyVarNamesEnv, domTyVarNamesEnv,
+	lookupTyVarName, nullTyVarNamesEnv, catTyVarNamesEnvs
+    ) where
+
+import Ubiq{-uitous-}
+
+import SST
+
+import HsSyn		( FixityDecl )
+import RnHsSyn		( RnName, mkRnName, mkRnUnbound, mkRnImplicit,
+			  mkRnImplicitTyCon, mkRnImplicitClass, 
+			  isRnLocal, isRnWired, isRnTyCon, isRnClass, isRnClassOp,
+			  RenamedFixityDecl(..) )
+import RnUtils		( RnEnv(..), extendLocalRnEnv,
+			  lookupRnEnv, lookupTcRnEnv,
+			  unknownNameErr, badClassOpErr, qualNameErr,
+			  dupNamesErr, shadowedNameWarn )
+
+import Bag		( Bag, emptyBag, isEmptyBag, snocBag )
+import CmdLineOpts	( opt_WarnNameShadowing )
+import ErrUtils		( Error(..), Warning(..) )
+import FiniteMap	( FiniteMap, emptyFM, lookupFM, addToFM )
+import Maybes		( assocMaybe )
+import Name		( Module(..), RdrName(..), isQual,
+			  Name, mkLocalName, mkImplicitName
+			)
+import Outputable	( getOccName )
+import PprStyle		( PprStyle )
+import Pretty		( Pretty(..), PrettyRep )
+import SrcLoc		( SrcLoc, mkUnknownSrcLoc )
+import UniqFM		( UniqFM, emptyUFM )
+import UniqSet		( UniqSet(..), mkUniqSet, minusUniqSet )
+import UniqSupply	( UniqSupply, getUnique, getUniques, splitUniqSupply )
+import Unique		( Unique )
+import Util
+
+infixr 9 `thenRn`, `thenRn_`
+\end{code}
+
+\begin{code}
+type RnM s r       = RnMonad () s r
+type RnM_Fixes s r = RnMonad (UniqFM RenamedFixityDecl) s r
+
+type RnMonad x s r = RnDown x s -> SST s r
+
+data RnDown x s
+  = RnDown
+	x
+	Module				-- Module name
+	SrcLoc				-- Source location
+	(RnMode s)			-- Source or Iface
+	RnEnv				-- Renaming environment
+	(MutableVar s UniqSupply)	-- Unique supply
+	(MutableVar s (Bag Warning, 	-- Warnings and Errors
+		       Bag Error))
+
+data RnMode s
+ = RnSource (MutableVar s (Bag (RnName, RdrName)))
+	-- Renaming source; returning occurences
+
+ | RnIface  (MutableVar s ImplicitEnv)
+	-- Renaming interface; creating and returning implicit names
+	-- One map for Values and one for TyCons/Classes.
+
+type ImplicitEnv = (FiniteMap RdrName RnName, FiniteMap RdrName RnName)
+
+
+-- With a builtin polymorphic type for _runSST the type for
+-- initTc should use  RnM s r  instead of  RnM _RealWorld r 
+
+initRn :: Bool		-- True => Source; False => Iface
+       -> Module
+       -> RnEnv
+       -> UniqSupply
+       -> RnM _RealWorld r
+       -> (r, Bag Error, Bag Warning)
+
+initRn source mod env us do_rn
+  = _runSST (
+	newMutVarSST emptyBag			`thenSST` \ occ_var ->
+	newMutVarSST (emptyFM,emptyFM)		`thenSST` \ imp_var ->
+	newMutVarSST us 			`thenSST` \ us_var ->
+      	newMutVarSST (emptyBag,emptyBag)	`thenSST` \ errs_var ->
+	let
+	    mode = if source then
+		       RnSource occ_var
+	           else
+		       RnIface imp_var
+
+	    rn_down = RnDown () mod mkUnknownSrcLoc mode env us_var errs_var
+	in
+	-- do the buisness
+    	do_rn rn_down 				`thenSST` \ res ->
+
+	-- grab errors and return
+	readMutVarSST errs_var 			`thenSST` \ (warns,errs) ->
+	returnSST (res, errs, warns)
+    )
+
+{-# INLINE thenRn #-}
+{-# INLINE thenRn_ #-}
+{-# INLINE returnRn #-}
+{-# INLINE andRn #-}
+
+returnRn :: a -> RnMonad x s a
+thenRn   :: RnMonad x s a -> (a -> RnMonad x s b) -> RnMonad x s b
+thenRn_  :: RnMonad x s a -> RnMonad x s b -> RnMonad x s b
+andRn    :: (a -> a -> a) -> RnMonad x s a -> RnMonad x s a -> RnMonad x s a
+mapRn    :: (a -> RnMonad x s b) -> [a] -> RnMonad x s [b]
+mapAndUnzipRn :: (a -> RnMonad x s (b,c)) -> [a] -> RnMonad x s ([b],[c])
+
+returnRn v down  = returnSST v
+thenRn m k down  = m down `thenSST` \ r -> k r down
+thenRn_ m k down = m down `thenSST_` k down
+
+andRn combiner m1 m2 down
+  = m1 down `thenSST` \ res1 ->
+    m2 down `thenSST` \ res2 ->
+    returnSST (combiner res1 res2)
+
+mapRn f []     = returnRn []
+mapRn f (x:xs)
+  = f x		`thenRn` \ r ->
+    mapRn f xs 	`thenRn` \ rs ->
+    returnRn (r:rs)
+
+mapAndUnzipRn f [] = returnRn ([],[])
+mapAndUnzipRn f (x:xs)
+  = f x		    	`thenRn` \ (r1,  r2)  ->
+    mapAndUnzipRn f xs	`thenRn` \ (rs1, rs2) ->
+    returnRn (r1:rs1, r2:rs2)
+\end{code}
+
+For errors and warnings ...
+\begin{code}
+failButContinueRn :: a -> Error -> RnMonad x s a
+failButContinueRn res err (RnDown _ _ _ _ _ _ errs_var)
+  = readMutVarSST  errs_var  				`thenSST`  \ (warns,errs) ->
+    writeMutVarSST errs_var (warns, errs `snocBag` err)	`thenSST_` 
+    returnSST res
+
+warnAndContinueRn :: a -> Warning -> RnMonad x s a
+warnAndContinueRn res warn (RnDown _ _ _ _ _ _ errs_var)
+  = readMutVarSST  errs_var  				 `thenSST`  \ (warns,errs) ->
+    writeMutVarSST errs_var (warns `snocBag` warn, errs) `thenSST_` 
+    returnSST res
+
+addErrRn :: Error -> RnMonad x s ()
+addErrRn err = failButContinueRn () err
+
+addErrIfRn :: Bool -> Error -> RnMonad x s ()
+addErrIfRn True err  = addErrRn err
+addErrIfRn False err = returnRn ()
+
+addWarnRn :: Warning -> RnMonad x s ()
+addWarnRn warn = warnAndContinueRn () warn
+
+addWarnIfRn :: Bool -> Warning -> RnMonad x s ()
+addWarnIfRn True warn  = addWarnRn warn
+addWarnIfRn False warn = returnRn ()
+\end{code}
+
+
+\begin{code}
+setExtraRn :: x -> RnMonad x s r -> RnMonad y s r
+setExtraRn x m (RnDown _ mod locn mode env us errs)
+  = m (RnDown x mod locn mode env us errs)
+
+getExtraRn :: RnMonad x s x
+getExtraRn (RnDown x _ _ _ _ _ _)
+  = returnSST x
+
+getModuleRn :: RnMonad x s Module
+getModuleRn (RnDown _ mod _ _ _ _ _)
+  = returnSST mod
+
+pushSrcLocRn :: SrcLoc -> RnMonad x s a -> RnMonad x s a
+pushSrcLocRn locn m (RnDown x mod _ mode env us errs)
+  = m (RnDown x mod locn mode env us errs)
+
+getSrcLocRn :: RnMonad x s SrcLoc
+getSrcLocRn (RnDown _ _ locn _ _ _ _)
+  = returnSST locn
+
+getSourceRn :: RnMonad x s Bool
+getSourceRn (RnDown _ _ _ (RnSource _) _ _ _) = returnSST True
+getSourceRn (RnDown _ _ _ (RnIface  _) _ _ _) = returnSST False
+
+getOccurrenceUpRn :: RnMonad x s (Bag (RnName, RdrName))
+getOccurrenceUpRn (RnDown _ _ _ (RnSource occ_var) _ _ _)
+  = readMutVarSST occ_var
+getOccurrenceUpRn (RnDown _ _ _ (RnIface _) _ _ _)
+  = panic "getOccurrenceUpRn:RnIface"
+
+getImplicitUpRn :: RnMonad x s (FiniteMap RdrName RnName, FiniteMap RdrName RnName)
+getImplicitUpRn (RnDown _ _ _ (RnIface imp_var) _ _ _)
+  = readMutVarSST imp_var
+getImplicitUpRn (RnDown _ _ _(RnSource _) _ _ _)
+  = panic "getImplicitUpRn:RnIface"
+\end{code}
+
+\begin{code}
+rnGetUnique :: RnMonad x s Unique
+rnGetUnique (RnDown _ _ _ _ _ us_var _)
+  = get_unique us_var
+
+rnGetUniques :: Int -> RnMonad x s [Unique]
+rnGetUniques n (RnDown _ _ _ _ _ us_var _)
+  = get_uniques n us_var
+
+
+get_unique us_var
+  = readMutVarSST us_var			`thenSST` \ uniq_supply ->
+    let
+      (new_uniq_supply, uniq_s) = splitUniqSupply uniq_supply
+      uniq			= getUnique uniq_s
+    in
+    writeMutVarSST us_var new_uniq_supply	`thenSST_`
+    returnSST uniq
+
+get_uniques n us_var
+  = readMutVarSST us_var			`thenSST` \ uniq_supply ->
+    let
+      (new_uniq_supply, uniq_s) = splitUniqSupply uniq_supply
+      uniqs			= getUniques n uniq_s
+    in
+    writeMutVarSST us_var new_uniq_supply	`thenSST_`
+    returnSST uniqs
+
+snoc_bag_var add bag_var
+  = readMutVarSST bag_var	`thenSST` \ bag ->
+    writeMutVarSST bag_var (bag `snocBag` add)
+
+\end{code}
+
+*********************************************************
+*							*
+\subsection{Making new names}
+*							*
+*********************************************************
+
+@newLocalNames@ takes a bunch of RdrNames, which are defined together
+in a group (eg a pattern or set of bindings), checks they are
+unqualified and distinct, and creates new Names for them.
+
+\begin{code}
+newLocalNames :: String 		-- Documentation string
+	      -> [(RdrName, SrcLoc)]
+	      -> RnMonad x s [RnName]
+
+newLocalNames str names_w_loc
+  = mapRn (addErrRn . qualNameErr str) quals `thenRn_`
+    mapRn (addErrRn . dupNamesErr str) dups  `thenRn_`
+    mkLocalNames these
+  where
+    quals         = filter (isQual.fst) names_w_loc
+    (these, dups) = removeDups cmp_fst names_w_loc
+    cmp_fst (a,_) (b,_) = cmp a b
+\end{code}
+
+\begin{code}
+mkLocalNames :: [(RdrName, SrcLoc)] -> RnMonad x s [RnName]
+mkLocalNames names_w_locs
+  = rnGetUniques (length names_w_locs) 	`thenRn` \ uniqs ->
+    returnRn (zipWithEqual new_local uniqs names_w_locs)
+  where
+    new_local uniq (Unqual str, srcloc)
+      = mkRnName (mkLocalName uniq str srcloc)
+\end{code}
+
+
+*********************************************************
+*							*
+\subsection{Looking up values}
+*							*
+*********************************************************
+
+Action to look up a value depends on the RnMode.
+\begin{description}
+\item[RnSource:]
+Lookup value in RnEnv, recording occurrence for non-local values found.
+If not found report error and return Unbound name.
+\item[RnIface:]
+Lookup value in RnEnv. If not found lookup in implicit name env.
+If not found create new implicit name, adding it to the implicit env.
+\end{description}
+
+\begin{code}
+lookupValue      :: RdrName -> RnMonad x s RnName
+lookupClassOp    :: RnName  -> RdrName -> RnMonad x s RnName
+
+lookupValue rdr
+  = lookup_val rdr (\ rn -> True) (unknownNameErr "value")
+
+lookupClassOp cls rdr
+  = lookup_val rdr (isRnClassOp cls) (badClassOpErr cls)
+
+
+lookup_val rdr check do_err down@(RnDown _ _ locn (RnSource occ_var) env _ _)
+  = case lookupRnEnv env rdr of
+	Just name | check name -> succ name
+		  | otherwise   -> fail
+	Nothing                -> fail
+
+  where
+    succ name = if isRnLocal name || isRnWired name then
+		    returnSST name
+		else
+		    snoc_bag_var (name,rdr) occ_var `thenSST_`
+		    returnSST name
+    fail = failButContinueRn (mkRnUnbound rdr) (do_err rdr locn) down
+
+lookup_val rdr check do_err down@(RnDown _ _ locn (RnIface imp_var) env us_var _)
+  = case lookupRnEnv env rdr of
+	Just name | check name -> returnSST name
+		  | otherwise  -> failButContinueRn (mkRnUnbound rdr) (do_err rdr locn) down
+	Nothing                -> lookup_or_create_implicit_val imp_var us_var rdr
+
+lookup_or_create_implicit_val imp_var us_var rdr
+  = readMutVarSST imp_var `thenSST` \ (implicit_val_fm, implicit_tc_fm)->
+    case lookupFM implicit_val_fm rdr of
+	Just implicit -> returnSST implicit
+	Nothing ->
+	    get_unique us_var			`thenSST` \ uniq -> 
+	    let
+		implicit   = mkRnImplicit (mkImplicitName uniq rdr)
+		new_val_fm = addToFM implicit_val_fm rdr implicit
+	    in
+	    writeMutVarSST imp_var (new_val_fm, implicit_tc_fm) `thenSST_`
+	    returnSST implicit
+
+
+lookupValueMaybe :: RdrName -> RnMonad x s (Maybe RnName)
+lookupValueMaybe rdr down@(RnDown _ _ _ (RnSource _) env _ _)
+  = returnSST (lookupRnEnv env rdr)
+\end{code}
+
+
+\begin{code}
+lookupTyCon   :: RdrName -> RnMonad x s RnName
+lookupClass   :: RdrName -> RnMonad x s RnName
+
+lookupTyCon rdr
+  = lookup_tc rdr isRnTyCon mkRnImplicitTyCon "type constructor"
+
+lookupClass rdr
+  = lookup_tc rdr isRnClass mkRnImplicitClass "class"
+
+
+lookup_tc rdr check mk_implicit err_str down@(RnDown _ _ locn (RnSource occ_var) env _ _)
+  = case lookupTcRnEnv env rdr of
+       Just name | check name -> succ name
+	         | otherwise  -> fail
+       Nothing                -> fail
+  where
+    succ name = snoc_bag_var (name,rdr) occ_var `thenSST_`
+		returnSST name
+    fail = failButContinueRn (mkRnUnbound rdr) (unknownNameErr err_str rdr locn) down
+
+lookup_tc rdr check mk_implicit err_str down@(RnDown _ _ locn (RnIface imp_var) env us_var _)
+  = case lookupTcRnEnv env rdr of
+	Just name | check name -> returnSST name
+		  | otherwise  -> fail
+	Nothing -> lookup_or_create_implicit_tc check mk_implicit fail imp_var us_var rdr
+  where
+    fail = failButContinueRn (mkRnUnbound rdr) (unknownNameErr err_str rdr locn) down
+
+lookup_or_create_implicit_tc check mk_implicit fail imp_var us_var rdr
+  = readMutVarSST imp_var `thenSST` \ (implicit_val_fm, implicit_tc_fm)->
+    case lookupFM implicit_tc_fm rdr of
+	Just implicit | check implicit -> returnSST implicit
+		      | otherwise      -> fail
+	Nothing ->
+	    get_unique us_var			`thenSST` \ uniq -> 
+	    let
+		implicit  = mk_implicit (mkImplicitName uniq rdr)
+		new_tc_fm = addToFM implicit_tc_fm rdr implicit
+	    in
+	    writeMutVarSST imp_var (implicit_val_fm, new_tc_fm) `thenSST_`
+	    returnSST implicit
+\end{code}
+
+
+@extendSS@ extends the scope; @extendSS2@ also removes the newly bound
+free vars from the result.
+
+\begin{code}
+extendSS :: [RnName] 				-- Newly bound names
+	 -> RnMonad x s a
+	 -> RnMonad x s a
+
+extendSS binders m down@(RnDown x mod locn mode env us errs)
+  = (mapRn (addErrRn . shadowedNameWarn locn) dups `thenRn_`
+     m) (RnDown x mod locn mode new_env us errs)
+  where
+    (new_env,dups) = extendLocalRnEnv opt_WarnNameShadowing env binders
+
+extendSS2 :: [RnName] 				-- Newly bound names
+	  -> RnMonad x s (a, UniqSet RnName)
+	  -> RnMonad x s (a, UniqSet RnName)
+
+extendSS2 binders m
+  = extendSS binders m `thenRn` \ (r, fvs) ->
+    returnRn (r, fvs `minusUniqSet` (mkUniqSet binders))
+\end{code}
+
+The free var set returned by @(extendSS binders m)@ is that returned
+by @m@, {\em minus} binders.
+
+
+*********************************************************
+*							*
+\subsection{TyVarNamesEnv}
+*							*
+*********************************************************
+
+\begin{code}
+type TyVarNamesEnv = [(RdrName, RnName)]
+
+nullTyVarNamesEnv :: TyVarNamesEnv
+nullTyVarNamesEnv = []
+
+catTyVarNamesEnvs :: TyVarNamesEnv -> TyVarNamesEnv -> TyVarNamesEnv
+catTyVarNamesEnvs e1 e2 = e1 ++ e2
+
+domTyVarNamesEnv :: TyVarNamesEnv -> [RdrName]
+domTyVarNamesEnv env = map fst env
+\end{code}
+
+@mkTyVarNamesEnv@ checks for duplicates, and complains if so.
+
+\begin{code}
+mkTyVarNamesEnv
+	:: SrcLoc
+	-> [RdrName]				-- The type variables
+	-> RnMonad x s (TyVarNamesEnv,[RnName])	-- Environment and renamed tyvars
+
+mkTyVarNamesEnv src_loc tyvars
+  = newLocalNames "type variable"
+	 (tyvars `zip` repeat src_loc) `thenRn`  \ rn_tyvars ->
+
+	 -- rn_tyvars may not be in the same order as tyvars, so we need some
+	 -- jiggery pokery to build the right tyvar env, and return the
+	 -- renamed tyvars in the original order.
+    let tv_occ_name_pairs 	= map tv_occ_name_pair rn_tyvars
+    	tv_env	    	    	= map (lookup_occ_name tv_occ_name_pairs) tyvars
+	rn_tyvars_in_orig_order	= map snd tv_env
+    in
+    returnRn (tv_env, rn_tyvars_in_orig_order)
+  where
+    tv_occ_name_pair :: RnName -> (RdrName, RnName)
+    tv_occ_name_pair rn_name = (getOccName rn_name, rn_name)
+
+    lookup_occ_name :: [(RdrName, RnName)] -> RdrName -> (RdrName, RnName)
+    lookup_occ_name pairs tyvar_occ
+      = (tyvar_occ, assoc "mkTyVarNamesEnv" pairs tyvar_occ)
+\end{code}
+
+\begin{code}
+lookupTyVarName :: TyVarNamesEnv -> RdrName -> RnMonad x s RnName
+lookupTyVarName env occ
+  = case (assocMaybe env occ) of
+      Just name -> returnRn name
+      Nothing   -> getSrcLocRn	`thenRn` \ loc ->
+		   failButContinueRn (mkRnUnbound occ)
+		       (unknownNameErr "type variable" occ loc)
+\end{code}
diff --git a/ghc/compiler/rename/RnMonad12.lhs b/ghc/compiler/rename/RnMonad12.lhs
deleted file mode 100644
index bfb7814657..0000000000
--- a/ghc/compiler/rename/RnMonad12.lhs
+++ /dev/null
@@ -1,97 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-%
-\section[RnMonad12]{The monad used by the renamer passes 1 and 2}
-
-\begin{code}
-#include "HsVersions.h"
-
-module RnMonad12 (
-	Rn12M(..),
-	initRn12, thenRn12, returnRn12,
-	mapRn12, zipWithRn12, foldrRn12,
-	addErrRn12, getModuleNameRn12, recoverQuietlyRn12
-
-	-- and to make the interface self-sufficient...
-    ) where
-
-import Ubiq{-uitous-}
-
-import Bag		( emptyBag, isEmptyBag, snocBag, Bag )
-import ErrUtils		( Error(..) )
-import Pretty		( Pretty(..) )
-
-infixr 9 `thenRn12`
-\end{code}
-
-In this monad, we pass down the name of the module we are working on,
-and we thread the collected errors.
-
-\begin{code}
-type Rn12M result
-  =  FAST_STRING{-module name-}
-  -> Bag Error
-  -> (result, Bag Error)
-
-{-# INLINE thenRn12 #-}
-{-# INLINE returnRn12 #-}
-
-initRn12 :: FAST_STRING{-module name-} -> Rn12M a -> (a, Bag Error)
-initRn12 mod action = action mod emptyBag
-
-thenRn12 :: Rn12M a -> (a -> Rn12M b) -> Rn12M b
-thenRn12 expr continuation mod errs_so_far
-  = case (expr mod errs_so_far) of
-     (res1, errs1) -> continuation res1 mod errs1
-
-returnRn12 :: a -> Rn12M a
-returnRn12 x mod errs_so_far = (x, errs_so_far)
-
-mapRn12 :: (a -> Rn12M b) -> [a] -> Rn12M [b]
-
-mapRn12 f []     = returnRn12 []
-mapRn12 f (x:xs)
-  = f x		 `thenRn12` \ r ->
-    mapRn12 f xs `thenRn12` \ rs ->
-    returnRn12 (r:rs)
-
-zipWithRn12 :: (a -> b -> Rn12M c) -> [a] -> [b] -> Rn12M [c]
-
-zipWithRn12 f []     [] = returnRn12 []
-zipWithRn12 f (x:xs) (y:ys)
-  = f x y	     	`thenRn12` \ r ->
-    zipWithRn12 f xs ys `thenRn12` \ rs ->
-    returnRn12 (r:rs)
--- NB: zipWithRn12 behaves like zipWithEqual
--- (requires equal-length lists)
-
-foldrRn12 :: (a -> b -> Rn12M b) -> b -> [a] -> Rn12M b
-
-foldrRn12 f z []     = returnRn12 z
-foldrRn12 f z (x:xs)
- = foldrRn12 f z xs  `thenRn12` \ rest ->
-   f x rest
-
-addErrRn12 :: Error -> Rn12M ()
-addErrRn12 err mod errs_so_far
- = ( (), errs_so_far `snocBag` err )
-
-getModuleNameRn12 :: Rn12M FAST_STRING
-getModuleNameRn12 mod errs_so_far = (mod, errs_so_far)
-\end{code}
-
-\begin{code}
-recoverQuietlyRn12 :: a -> Rn12M a -> Rn12M a
-
-recoverQuietlyRn12 use_this_if_err action mod errs_so_far
-  = let
-	(result, errs_out)
-	  = case (action mod emptyBag{-no errors-}) of { (res, errs) ->
-	    if isEmptyBag errs then
-		(res, errs_so_far)  -- retain incoming errs
-	    else
-		(use_this_if_err, errs_so_far)
-	    }
-    in
-    (result, errs_out)
-\end{code}
diff --git a/ghc/compiler/rename/RnMonad3.lhs b/ghc/compiler/rename/RnMonad3.lhs
deleted file mode 100644
index ca69b1d575..0000000000
--- a/ghc/compiler/rename/RnMonad3.lhs
+++ /dev/null
@@ -1,209 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-%
-\section[RnMonad3]{The monad used by the third renamer pass}
-
-\begin{code}
-#include "HsVersions.h"
-
-module RnMonad3 (
-	Rn3M(..),
-	initRn3, thenRn3, andRn3, returnRn3, mapRn3, fixRn3,
-
-	putInfoDownM3,
-
-	newFullNameM3, newInvisibleNameM3
-
-	-- for completeness
-    ) where
-
-import Ubiq{-uitous-}
-
-import FiniteMap	( emptyFM,  isEmptyFM,  lookupFM,
-			  emptySet, isEmptySet, elementOf
-			)
-import HsSyn		( IE )
-import NameTypes	-- lots of stuff
-import Outputable	( ExportFlag(..) )
-import ProtoName	( ProtoName(..) )
-import RdrHsSyn		( getExportees, ExportListInfo(..), ProtoNameIE(..) )
-import UniqSupply	( getUnique, splitUniqSupply )
-import Util		( panic )
-
-infixr 9 `thenRn3`
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Plain @RnPass3@ monadery}
-%*									*
-%************************************************************************
-
-\begin{code}
-type Rn3M result
-  =  ExportListInfo -> FAST_STRING{-ModuleName-} -> UniqSupply
-  -> result
-
-{-# INLINE andRn3 #-}
-{-# INLINE thenRn3 #-}
-{-# INLINE returnRn3 #-}
-
-initRn3 :: Rn3M a -> UniqSupply -> a
-
-initRn3 m us = m Nothing{-no export list-} (panic "initRn3: uninitialised module name") us
-
-thenRn3 :: Rn3M a -> (a -> Rn3M b) -> Rn3M b
-andRn3  :: (a -> a -> a) -> Rn3M a -> Rn3M a -> Rn3M a
-
-thenRn3 expr continuation exps mod_name uniqs
-  = case splitUniqSupply uniqs      of { (s1, s2) ->
-    case (expr exps mod_name s1)    of { res1 ->
-    continuation res1 exps mod_name s2 }}
-
-andRn3 combiner m1 m2 exps mod_name uniqs
-  = case splitUniqSupply uniqs      of { (s1, s2) ->
-    case (m1 exps mod_name s1)      of { res1 ->
-    case (m2 exps mod_name s2)	    of { res2 ->
-    combiner res1 res2 }}}
-
-returnRn3 :: a -> Rn3M a
-returnRn3 result exps mod_name uniqs = result
-
-mapRn3 :: (a -> Rn3M b) -> [a] -> Rn3M [b]
-
-mapRn3 f []     = returnRn3 []
-mapRn3 f (x:xs)
-  = f x		`thenRn3` \ r ->
-    mapRn3 f xs	`thenRn3` \ rs ->
-    returnRn3 (r:rs)
-
-fixRn3 :: (a -> Rn3M a) -> Rn3M a
-
-fixRn3 m exps mod_name us
-  = result
-  where
-    result = m result exps mod_name us
-
-putInfoDownM3 :: FAST_STRING{-ModuleName-} -> Maybe [ProtoNameIE] -> Rn3M a -> Rn3M a
-
-putInfoDownM3 mod_name exports cont _ _ uniqs
-  = cont (getExportees exports) mod_name uniqs
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[RnMonad3-new-names]{Making new names}
-%*									*
-%************************************************************************
-
-@newFullNameM3@ makes a new user-visible FullName (the usual);
-@newInvisibleNameM3@ is the odd case.  @new_name@ does all the work.
-
-\begin{code}
-newFullNameM3, newInvisibleNameM3
-	:: ProtoName		-- input
-	-> SrcLoc		-- where it started life
-	-> Bool			-- if it is "TyCon"ish (rather than "val"ish)
-	-> Maybe ExportFlag	-- Just flag => force the use of that exportness
-	-> Rn3M (Unique, FullName)
-
-newFullNameM3 pn src_loc is_tycon_ish frcd_exp exps mod_name uniqs
-  = new_name pn src_loc is_tycon_ish frcd_exp False{-visible-} exps mod_name uniqs
-
-newInvisibleNameM3 pn src_loc is_tycon_ish frcd_exp exps mod_name uniqs
-  = new_name pn src_loc is_tycon_ish frcd_exp True{-invisible-} exps mod_name uniqs
-\end{code}
-
-\begin{code}
-new_name pn src_loc is_tycon_ish frcd_export_flag want_invisible exps mod_name uniqs
-  = (uniq, name)
-  where
-    uniq = getUnique uniqs
-
-    mk_name = if want_invisible then mkPrivateFullName else mkFullName
-
-    name = case pn of
-
-	Unk s -> mk_name mod_name s
-		   (if fromPrelude mod_name
-		      && is_tycon_ish then -- & tycon/clas/datacon => Core
-		       HereInPreludeCore
-		    else
-		       ThisModule
-		   )
-		   (case frcd_export_flag of
-		      Just fl -> fl
-		      Nothing -> mk_export_flag True [mod_name] s exps)
-		   src_loc
-
-	Qunk m s -> mk_name mod_name s
-		      (if fromPrelude mod_name
-			 && is_tycon_ish then -- & tycon/clas/datacon => Core
-			  HereInPreludeCore
-		       else
-			  ThisModule
-		      )
-		      (case frcd_export_flag of
-			 Just fl -> fl
-			 Nothing -> mk_export_flag (_trace "mk_export_flag?" True) [m] s exps)
-		      src_loc
-
-	-- note: the assigning of prelude-ness is most dubious (ToDo)
-
-	Imp m d informant_mods l
-	  -> mk_name m d
-	       (if fromPrelude m then	-- as above
-		   if is_tycon_ish then
-		       ExportedByPreludeCore
-		   else
-		       OtherPrelude l
-		else if m == mod_name then -- pretty dang weird... (ToDo: anything?)
-		   ThisModule
-		else
-		   OtherModule l informant_mods -- for Other*, we save its occurrence name
-	       )
-	       (case frcd_export_flag of
-		  Just fl -> fl
-		  Nothing -> mk_export_flag (m==mod_name) informant_mods l exps)
-	       src_loc
-
-	Prel n	  -> panic "RnMonad3.new_name: prelude name"
-\end{code}
-
-In deciding the ``exportness'' of something, there are these cases to
-consider:
-\begin{description}
-\item[No explicit export list:]
-Everything defined in this module goes out.
-
-\item[Matches a non-\tr{M..} item in the export list:]
-Then it's exported as its @name_pr@ item suggests.
-
-\item[Matches a \tr{M..} item in the export list:]
-
-(Note: the module \tr{M} may be {\em this} module!)  It's exported if
-we got it from \tr{M}'s interface; {\em most emphatically not} the
-same thing as ``it originally came from \tr{M}''.
-
-\item[Otherwise:]
-It isn't exported.
-\end{description}
-
-\begin{code}
-mk_export_flag	:: Bool		-- True <=> originally from the module we're compiling
-		-> [FAST_STRING]-- modules that told us about this thing
-		-> FAST_STRING	-- name of the thing we're looking at
-		-> ExportListInfo
-		-> ExportFlag	-- result
-
-mk_export_flag this_module informant_mods thing Nothing{-no export list-}
-  = if this_module then ExportAll else NotExported
-
-mk_export_flag this_module informant_mods thing (Just (exports_alist, dotdot_modules))
-  | otherwise
-  = case (lookupFM exports_alist thing) of
-      Just how_to_export -> how_to_export
-      Nothing		 -> if (or [ im `elementOf` dotdot_modules | im <- informant_mods ])
-			    then ExportAll
-			    else NotExported
-\end{code}
diff --git a/ghc/compiler/rename/RnMonad4.lhs b/ghc/compiler/rename/RnMonad4.lhs
deleted file mode 100644
index a9e2e37099..0000000000
--- a/ghc/compiler/rename/RnMonad4.lhs
+++ /dev/null
@@ -1,501 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-%
-\section[RnMonad4]{The monad used by the fourth renamer pass}
-
-\begin{code}
-#include "HsVersions.h"
-
-module RnMonad4 (
-	Rn4M(..),
-	initRn4, thenRn4, thenRn4_, andRn4, returnRn4, mapRn4, mapAndUnzipRn4,
-	addErrRn4, failButContinueRn4, recoverQuietlyRn4,
-	pushSrcLocRn4,
-	getSrcLocRn4,
-	lookupValue, lookupValueEvenIfInvisible,
-	lookupClassOp, lookupFixityOp,
-	lookupTyCon, lookupTyConEvenIfInvisible,
-	lookupClass,
-	extendSS2, extendSS,
-	namesFromProtoNames,
-
-	TyVarNamesEnv(..), mkTyVarNamesEnv, domTyVarNamesEnv,
-	lookupTyVarName, nullTyVarNamesEnv, catTyVarNamesEnvs
-
-	-- for completeness
-    ) where
-
-import Ubiq{-uitous-}
-
-import Bag		( emptyBag, isEmptyBag, unionBags, snocBag, Bag )
-import CmdLineOpts	( opt_ShowPragmaNameErrs, opt_NameShadowingNotOK )
-import ErrUtils
-import FiniteMap	( emptyFM, addListToFM, addToFM, lookupFM )
-import Name		( invisibleName, isTyConName, isClassName,
-			  isClassOpName, isUnboundName, Name(..)
-			)
-import NameTypes	( mkShortName, ShortName{-instances-} )
-import Outputable	( pprNonOp )
-import Pretty
-import ProtoName	( eqProtoName, cmpByLocalName, ProtoName(..) )
-import RnUtils		( dupNamesErr, GlobalNameMappers(..) )
-import SrcLoc		( mkUnknownSrcLoc, SrcLoc{-instance-} )
-import UniqSet		( mkUniqSet, minusUniqSet, UniqSet(..) )
-import UniqSupply	( getUniques, splitUniqSupply )
-import Util		( assoc, removeDups, zipWithEqual, panic )
-
-infixr 9 `thenRn4`, `thenRn4_`
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[RnMonad4]{Plain @Rename@ monadery for pass~4}
-%*									*
-%************************************************************************
-
-\begin{code}
-type ScopeStack = FiniteMap FAST_STRING Name
-
-type Rn4M result
-  =  GlobalNameMappers
-  -> ScopeStack
-  -> Bag Error
-  -> UniqSupply
-  -> SrcLoc
-  -> (result, Bag Error)
-
-{-# INLINE andRn4 #-}
-{-# INLINE thenRn4 #-}
-{-# INLINE thenLazilyRn4 #-}
-{-# INLINE thenRn4_ #-}
-{-# INLINE returnRn4 #-}
-
-initRn4 :: GlobalNameMappers
-	-> Rn4M result
-	-> UniqSupply
-	-> (result, Bag Error)
-
-initRn4 gnfs renamer init_us
-  = renamer gnfs emptyFM emptyBag init_us mkUnknownSrcLoc
-
-thenRn4, thenLazilyRn4
-	 :: Rn4M a -> (a -> Rn4M b) -> Rn4M b
-thenRn4_ :: Rn4M a -> Rn4M b -> Rn4M b
-andRn4   :: (a -> a -> a) -> Rn4M a -> Rn4M a -> Rn4M a
-
-thenRn4 expr cont gnfs ss errs uniqs locn
-  = case (splitUniqSupply uniqs)    	   of { (s1, s2) ->
-    case (expr      gnfs ss errs  s1 locn) of { (res1, errs1) ->
-    case (cont res1 gnfs ss errs1 s2 locn) of { (res2, errs2) ->
-    (res2, errs2) }}}
-
-thenLazilyRn4 expr cont gnfs ss errs uniqs locn
-  = let
-	(s1, s2)      = splitUniqSupply uniqs
-	(res1, errs1) = expr      gnfs ss errs  s1 locn
-	(res2, errs2) = cont res1 gnfs ss errs1 s2 locn
-    in
-    (res2, errs2)
-
-thenRn4_ expr cont gnfs ss errs uniqs locn
-  = case (splitUniqSupply uniqs)      of { (s1, s2) ->
-    case (expr gnfs ss errs  s1 locn) of { (_,    errs1) ->
-    case (cont gnfs ss errs1 s2 locn) of { (res2, errs2) ->
-    (res2, errs2) }}}
-
-andRn4 combiner m1 m2 gnfs ss errs us locn
-  = case (splitUniqSupply us)	    of { (s1, s2) ->
-    case (m1 gnfs ss errs  s1 locn) of { (res1, errs1) ->
-    case (m2 gnfs ss errs1 s2 locn) of { (res2, errs2) ->
-    (combiner res1 res2, errs2) }}}
-
-returnRn4 :: a -> Rn4M a
-returnRn4 result gnfs ss errs_so_far uniqs locn
-   = (result, errs_so_far)
-
-failButContinueRn4 :: a -> Error -> Rn4M a
-failButContinueRn4 res err gnfs ss errs_so_far uniqs locn
-  = (res, errs_so_far `snocBag` err)
-
-addErrRn4 :: Error -> Rn4M ()
-addErrRn4 err gnfs ss errs_so_far uniqs locn
-  = ((), errs_so_far `snocBag` err)
-\end{code}
-
-When we're looking at interface pragmas, we want to be able to recover
-back to a ``I don't know anything pragmatic'' state if we encounter
-some problem.  @recoverQuietlyRn4@ is given a ``use-this-instead'' value,
-as well as the action to perform.  This code is intentionally very lazy,
-returning a triple immediately, no matter what.
-\begin{code}
-recoverQuietlyRn4 :: a -> Rn4M a -> Rn4M a
-
-recoverQuietlyRn4 use_this_if_err action gnfs ss errs_so_far uniqs locn
-  = let
-	(result, errs_out)
-    	  = case (action gnfs ss emptyBag{-leav out errs-} uniqs locn) of
-	      (result1, errs1) ->
-		if isEmptyBag errs1 then -- all's well! (but retain incoming errs)
-		    (result1, errs_so_far)
-		else -- give up; return *incoming* UniqueSupply...
-		    (use_this_if_err,
-		     if opt_ShowPragmaNameErrs
-		     then errs_so_far `unionBags` errs1
-		     else errs_so_far) -- toss errs, otherwise
-    in
-    (result, errs_out)
-\end{code}
-
-\begin{code}
-mapRn4 :: (a -> Rn4M b) -> [a] -> Rn4M [b]
-
-mapRn4 f []     = returnRn4 []
-mapRn4 f (x:xs)
-  = f x		`thenRn4` \ r ->
-    mapRn4 f xs `thenRn4` \ rs ->
-    returnRn4 (r:rs)
-
-mapAndUnzipRn4  :: (a -> Rn4M (b,c))   -> [a] -> Rn4M ([b],[c])
-
-mapAndUnzipRn4 f [] = returnRn4 ([],[])
-mapAndUnzipRn4 f (x:xs)
-  = f x		    	`thenRn4` \ (r1,  r2)  ->
-    mapAndUnzipRn4 f xs	`thenRn4` \ (rs1, rs2) ->
-    returnRn4 (r1:rs1, r2:rs2)
-\end{code}
-
-\begin{code}
-pushSrcLocRn4 :: SrcLoc -> Rn4M a -> Rn4M a
-pushSrcLocRn4 locn exp gnfs ss errs_so_far uniq_supply old_locn
-  = exp gnfs ss errs_so_far uniq_supply locn
-
-getSrcLocRn4 :: Rn4M SrcLoc
-
-getSrcLocRn4 gnfs ss errs_so_far uniq_supply locn
-  = returnRn4 locn gnfs ss errs_so_far uniq_supply locn
-\end{code}
-
-\begin{code}
-getNextUniquesFromRn4 :: Int -> Rn4M [Unique]
-getNextUniquesFromRn4 n gnfs ss errs_so_far us locn
-  = case (getUniques n us) of { next_uniques ->
-    (next_uniques, errs_so_far) }
-\end{code}
-
-*********************************************************
-*							*
-\subsection{Making new names}
-*							*
-*********************************************************
-
-@namesFromProtoNames@ takes a bunch of protonames, which are defined
-together in a group (eg a pattern or set of bindings), checks they
-are distinct, and creates new full names for them.
-
-\begin{code}
-namesFromProtoNames :: String 		-- Documentation string
-		    -> [(ProtoName, SrcLoc)]
-		    -> Rn4M [Name]
-
-namesFromProtoNames kind pnames_w_src_loc gnfs ss errs_so_far us locn
-  = (mapRn4 (addErrRn4 . dupNamesErr kind) dups `thenRn4_`
-    mkNewNames goodies
-    ) {-Rn4-} gnfs ss errs_so_far us locn
-  where
-    (goodies, dups) = removeDups cmp pnames_w_src_loc
-	-- We want to compare their local names rather than their
-	-- full protonames.  It probably doesn't matter here, but it
-	-- does in RnPass3.lhs!
-    cmp (a, _) (b, _) = cmpByLocalName a b
-\end{code}
-
-@mkNewNames@ assumes the names are unique.
-
-\begin{code}
-mkNewNames :: [(ProtoName, SrcLoc)] -> Rn4M [Name]
-mkNewNames pnames_w_locs
-  = getNextUniquesFromRn4 (length pnames_w_locs) `thenRn4` \ uniqs ->
-    returnRn4 (zipWithEqual new_short_name uniqs pnames_w_locs)
-  where
-    new_short_name uniq (Unk str, srcloc)   -- gotta be an Unk...
-      = Short uniq (mkShortName str srcloc)
-\end{code}
-
-
-*********************************************************
-*							*
-\subsection{Local scope extension and lookup}
-*							*
-*********************************************************
-
-If the input name is an @Imp@, @lookupValue@ looks it up in the GNF.
-If it is an @Unk@, it looks it up first in the local environment
-(scope stack), and if it isn't found there, then in the value GNF.  If
-it isn't found at all, @lookupValue@ adds an error message, and
-returns an @Unbound@ name.
-
-\begin{code}
-unboundName :: ProtoName -> Name
-unboundName pn
-   = Unbound (grab_string pn)
-   where
-     grab_string (Unk  s)      = s
-     grab_string (Qunk _ s)    = s
-     grab_string (Imp _ _ _ s) = s
-\end{code}
-
-@lookupValue@ looks up a non-invisible value;
-@lookupValueEvenIfInvisible@ gives a successful lookup even if the
-value is not visible to the user (e.g., came out of a pragma).
-@lookup_val@ is the help function to do the work.
-
-\begin{code}
-lookupValue v {-Rn4-} gnfs ss errs_so_far us locn
-  = (lookup_val v	`thenLazilyRn4` \ name ->
-    if invisibleName name
-    then failButContinueRn4 (unboundName v) (unknownNameErr "value" v mkUnknownSrcLoc)
-    else returnRn4 name
-    ) {-Rn4-} gnfs ss errs_so_far us locn
-
-lookupValueEvenIfInvisible v = lookup_val v
-
-lookup_val :: ProtoName -> Rn4M Name
-
-lookup_val pname@(Unk v) gnfs@(v_gnf, tc_gnf) ss a b locn
-  = case (lookupFM ss v) of
-      Just name -> returnRn4 name gnfs ss a b locn
-      Nothing   -> case (v_gnf pname) of
-		     Just name  -> returnRn4 name gnfs ss a b locn
-		     Nothing    -> failButContinueRn4 (unboundName pname)
-					   (unknownNameErr "value" pname locn)
-  					   gnfs ss a b locn
-
-lookup_val (Qunk _ _) _ _ _ _ _ = panic "RnMonad4:lookup_val:Qunk"
-
--- If it ain't an Unk it must be in the global name fun; that includes
--- prelude things.
-lookup_val pname gnfs@(v_gnf, tc_gnf) ss a b locn
-  = case (v_gnf pname) of
-	Just name  -> returnRn4 name gnfs ss a b locn
-	Nothing    -> failButContinueRn4 (unboundName pname)
-			      (unknownNameErr "value" pname locn)
-			      gnfs ss a b locn
-\end{code}
-
-Looking up the operators in a fixity decl is done differently.  We
-want to simply drop any fixity decls which refer to operators which
-aren't in scope.  Unfortunately, such fixity decls {\em will} appear
-because the parser collects *all* the fixity decls from {\em all} the
-imported interfaces (regardless of selective import), and dumps them
-together as the module fixity decls.  This is really a bug.  In
-particular:
-\begin{itemize}
-\item
-We won't complain about fixity decls for operators which aren't
-declared.
-\item
-We won't attach the right fixity to something which has been renamed.
-\end{itemize}
-
-We're not going to export Prelude-related fixities (ToDo: correctly),
-so we nuke those, too.
-
-\begin{code}
-lookupFixityOp (Prel _) gnfs@(v_gnf, tc_gnf) = returnRn4 Nothing       gnfs
-lookupFixityOp pname	gnfs@(v_gnf, tc_gnf) = returnRn4 (v_gnf pname) gnfs
-\end{code}
-
-\begin{code}
-lookupTyCon, lookupTyConEvenIfInvisible :: ProtoName -> Rn4M Name
--- The global name funs handle Prel things
-
-lookupTyCon tc {-Rn4-} gnfs ss errs_so_far us locn
-  = (lookup_tycon tc `thenLazilyRn4` \ name ->
-    if invisibleName name
-    then failButContinueRn4 (unboundName tc) (unknownNameErr "type constructor" tc mkUnknownSrcLoc)
-    else returnRn4 name
-    ) {-Rn4-} gnfs ss errs_so_far us locn
-
-lookupTyConEvenIfInvisible tc = lookup_tycon tc
-
-lookup_tycon (Prel name) gnfs ss a b locn = returnRn4 name gnfs ss a b locn
-
-lookup_tycon pname gnfs@(v_gnf, tc_gnf) ss a b locn
-  = case (tc_gnf pname) of
-     Just name | isTyConName name -> returnRn4 name gnfs ss a b locn
-     _   -> failButContinueRn4 (unboundName pname)
-		    (unknownNameErr "type constructor" pname locn)
-		    gnfs ss a b locn
-\end{code}
-
-\begin{code}
-lookupClass :: ProtoName -> Rn4M Name
-
-lookupClass pname gnfs@(v_gnf, tc_gnf) ss a b locn
-  = case (tc_gnf pname) of
-     Just name | isClassName name -> returnRn4 name gnfs ss a b locn
-     _   -> failButContinueRn4 (unboundName pname)
-		    (unknownNameErr "class" pname locn)
-		    gnfs ss a b locn
-\end{code}
-
-@lookupClassOp@ is used when looking up the lhs identifiers in a class
-or instance decl.  It checks that the name it finds really is a class
-op, and that its class matches that of the class or instance decl
-being looked at.
-
-\begin{code}
-lookupClassOp :: Name -> ProtoName -> Rn4M Name
-
-lookupClassOp class_name pname gnfs@(v_gnf, tc_gnf) ss a b locn
-  = case v_gnf pname of
-	 Just op_name |  isClassOpName class_name op_name
-		      || isUnboundName class_name -- avoid spurious errors
-		 -> returnRn4 op_name gnfs ss a b locn
-
-	 other   -> failButContinueRn4 (unboundName pname)
-			    (badClassOpErr class_name pname locn)
-			    gnfs ss a b locn
-\end{code}
-
-@extendSS@ extends the scope; @extendSS2@ also removes the newly bound
-free vars from the result.
-
-\begin{code}
-extendSS :: [Name] 				-- Newly bound names
-	 -> Rn4M a
-	 -> Rn4M a
-
-extendSS binders expr gnfs ss errs us locn
-  = case (extend binders ss gnfs ss errs us locn) of { (new_ss, new_errs) ->
-    expr gnfs new_ss new_errs us locn }
-  where
-    extend :: [Name] -> ScopeStack -> Rn4M ScopeStack
-
-    extend names ss
-      = if opt_NameShadowingNotOK then
-	    hard_way names ss
-	else -- ignore shadowing; blast 'em in
-	    returnRn4 (
-		addListToFM ss [ (getOccurrenceName x, n) | n@(Short _ x) <- names]
-	    )
-
-    hard_way [] ss = returnRn4 ss
-    hard_way (name@(Short _ sname):names) ss
-      = let
-	    str = getOccurrenceName sname
-	in
-	(case (lookupFM ss str) of
-	   Nothing -> returnRn4 (addToFM ss str name)
-	   Just  _ -> failButContinueRn4 ss (shadowedNameErr name locn)
-
-	)	`thenRn4` \ new_ss ->
-	hard_way names new_ss
-
-extendSS2 :: [Name] 				-- Newly bound names
-	 -> Rn4M (a, UniqSet Name)
-	 -> Rn4M (a, UniqSet Name)
-
-extendSS2 binders expr gnfs ss errs_so_far us locn
-  = case (extendSS binders expr gnfs ss errs_so_far us locn) of
-     ((e2, freevars), errs)
-       -> ((e2, freevars `minusUniqSet` (mkUniqSet binders)),
-	   errs)
-\end{code}
-
-The free var set returned by @(extendSS binders m)@ is that returned
-by @m@, {\em minus} binders.
-
-*********************************************************
-*							*
-\subsection{mkTyVarNamesEnv}
-*							*
-*********************************************************
-
-\begin{code}
-type TyVarNamesEnv = [(ProtoName, Name)]
-
-nullTyVarNamesEnv :: TyVarNamesEnv
-nullTyVarNamesEnv = []
-
-catTyVarNamesEnvs :: TyVarNamesEnv -> TyVarNamesEnv -> TyVarNamesEnv
-catTyVarNamesEnvs e1 e2 = e1 ++ e2
-
-domTyVarNamesEnv :: TyVarNamesEnv -> [ProtoName]
-domTyVarNamesEnv env = map fst env
-\end{code}
-
-@mkTyVarNamesEnv@ checks for duplicates, and complains if so.
-
-\begin{code}
-mkTyVarNamesEnv
-	:: SrcLoc
-	-> [ProtoName]			-- The type variables
-	-> Rn4M (TyVarNamesEnv,[Name])	-- Environment and renamed tyvars
-
-mkTyVarNamesEnv src_loc tyvars {-Rn4-} gnfs ss errs_so_far us locn
-  = (namesFromProtoNames "type variable"
-	 (tyvars `zip` repeat src_loc)	`thenRn4`  \ tyvars2 ->
-
-	 -- tyvars2 may not be in the same order as tyvars, so we need some
-	 -- jiggery pokery to build the right tyvar env, and return the
-	 -- renamed tyvars in the original order.
-    let tv_string_name_pairs 	= extend tyvars2 []
-    	tv_env	    	    	= map (lookup tv_string_name_pairs) tyvars
-	tyvars2_in_orig_order	= map snd tv_env
-    in
-    returnRn4  (tv_env, tyvars2_in_orig_order)
-    ) {-Rn4-} gnfs ss errs_so_far us locn
-  where
-    extend :: [Name] -> [(FAST_STRING, Name)] -> [(FAST_STRING, Name)]
-    extend [] ss = ss
-    extend (name@(Short _ sname):names) ss
-      = (getOccurrenceName sname, name) : extend names ss
-
-    lookup :: [(FAST_STRING, Name)] -> ProtoName -> (ProtoName, Name)
-    lookup pairs tyvar_pn
-      = (tyvar_pn, assoc "mkTyVarNamesEnv" pairs (getOccurrenceName tyvar_pn))
-\end{code}
-
-\begin{code}
-lookupTyVarName :: TyVarNamesEnv -> ProtoName -> Rn4M Name
-lookupTyVarName env pname {-Rn4-} gnfs ss errs_so_far us locn
-  = (case (assoc_maybe env pname) of
-     Just name -> returnRn4 name
-     Nothing   -> getSrcLocRn4	`thenRn4` \ loc ->
-		  failButContinueRn4 (unboundName pname)
-			  (unknownNameErr "type variable" pname loc)
-    ) {-Rn4-} gnfs ss errs_so_far us locn
-  where
-    assoc_maybe [] _ = Nothing
-    assoc_maybe ((tv,xxx) : tvs) key
-      = if tv `eqProtoName` key then Just xxx else assoc_maybe tvs key
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Error messages}
-%*									*
-%************************************************************************
-
-\begin{code}
-badClassOpErr clas op locn
-  = addErrLoc locn "" ( \ sty ->
-    ppBesides [ppChar '`', pprNonOp sty op, ppStr "' is not an operation of class `",
-	      ppr sty clas, ppStr "'."] )
-
-----------------------------
--- dupNamesErr: from RnUtils
-
----------------------------
-shadowedNameErr shadow locn
-  = addShortErrLocLine locn ( \ sty ->
-    ppBesides [ppStr "more than one value with the same name (shadowing): ",
-	ppr sty shadow] )
-
-------------------------------------------
-unknownNameErr descriptor undef_thing locn
-  = addShortErrLocLine locn ( \ sty ->
-    ppBesides [ppStr "undefined ", ppStr descriptor, ppStr ": ",
-	pprNonOp sty undef_thing] )
-\end{code}
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
new file mode 100644
index 0000000000..384f9f844a
--- /dev/null
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -0,0 +1,296 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+%
+\section[RnNames]{Extracting imported and top-level names in scope}
+
+\begin{code}
+#include "HsVersions.h"
+
+module RnNames (
+	getGlobalNames,
+	GlobalNameInfo(..)
+    ) where
+
+import PreludeGlaST	( returnPrimIO, thenPrimIO, MutableVar(..) )
+
+import Ubiq
+
+import HsSyn
+import RdrHsSyn
+import RnHsSyn
+
+import RnMonad
+import RnIfaces		( IfaceCache(..), cacheInterface, ParsedIface )
+import RnUtils		( RnEnv(..), emptyRnEnv, extendGlobalRnEnv, qualNameErr, dupNamesErr )
+
+import Bag		( emptyBag, unitBag, unionBags, unionManyBags, mapBag, listToBag, bagToList )
+import ErrUtils		( Error(..), Warning(..), addShortErrLocLine )
+import FiniteMap	( fmToList )
+import Name		( RdrName(..), isQual, mkTopLevName, mkImportedName, nameExportFlag, Name )
+import Outputable	( getLocalName, getSrcLoc, pprNonOp )
+import PrelInfo		( BuiltinNames(..), BuiltinKeys(..) )
+import PrelMods		( fromPrelude )
+import Pretty
+import SrcLoc		( SrcLoc )
+import UniqSupply	( splitUniqSupply )
+import Util		( equivClasses, panic )
+\end{code}
+
+
+\begin{code}
+type GlobalNameInfo = (BuiltinNames,
+		       BuiltinKeys,
+		       Name -> ExportFlag,
+		       Name -> [RdrName])
+
+type RnM_Info s r = RnMonad GlobalNameInfo s r
+
+getGlobalNames ::
+	   IfaceCache		
+	-> GlobalNameInfo	
+	-> UniqSupply
+	-> RdrNameHsModule
+	-> PrimIO (RnEnv,
+		   [Module],
+		   Bag RenamedFixityDecl,
+		   Bag Error,
+		   Bag Warning)
+
+getGlobalNames iface_var info us
+	       (HsModule mod _ _ imports _ ty_decls _ cls_decls _ _ _ binds _ _)
+  = case initRn True mod emptyRnEnv us1 
+		(setExtraRn info $
+		 getSourceNames ty_decls cls_decls binds)
+    of { ((src_vals, src_tcs), src_errs, src_warns) ->
+
+    getImportedNames iface_var info us2 imports	`thenPrimIO`
+	\ (imp_vals, imp_tcs, imp_mods, imp_fixes, imp_errs, imp_warns) ->
+
+    let
+        unqual_vals = mapBag (\rn -> (Unqual (getLocalName rn), rn)) src_vals
+        unqual_tcs  = mapBag (\rn -> (Unqual (getLocalName rn), rn)) src_tcs
+
+	all_vals = bagToList (unqual_vals `unionBags` imp_vals)
+	all_tcs  = bagToList (unqual_tcs  `unionBags` imp_tcs)
+
+        (all_env, dups) = extendGlobalRnEnv emptyRnEnv all_vals all_tcs
+
+	dup_errs = map dup_err (equivClasses cmp_rdr (bagToList dups))
+	cmp_rdr (rdr1,_,_) (rdr2,_,_) = cmp rdr1 rdr2
+	dup_err ((rdr,rn,rn'):rest) = globalDupNamesErr rdr (rn:rn': [rn|(_,_,rn)<-rest])
+
+	all_errs  = src_errs `unionBags` imp_errs `unionBags` listToBag dup_errs
+	all_warns = src_warns `unionBags` imp_warns
+    in
+    returnPrimIO (all_env, bagToList imp_mods, imp_fixes, all_errs, all_warns)
+    }
+  where
+    (us1, us2) = splitUniqSupply us
+\end{code}
+
+*********************************************************
+*							*
+\subsection{Top-level source names}
+*							*
+*********************************************************
+
+\begin{code}
+getSourceNames ::
+	   [RdrNameTyDecl]
+	-> [RdrNameClassDecl]
+	-> RdrNameHsBinds
+	-> RnM_Info s (Bag RnName,	-- values
+		       Bag RnName)	-- tycons/classes
+
+getSourceNames ty_decls cls_decls binds
+  = mapAndUnzipRn getTyDeclNames ty_decls   `thenRn` \ (tycon_s, constrs_s) ->
+    mapAndUnzipRn getClassNames cls_decls  `thenRn` \ (cls_s, cls_ops_s) ->
+    getTopBindsNames binds			   `thenRn` \ bind_names ->
+    returnRn (unionManyBags constrs_s `unionBags`
+	      unionManyBags cls_ops_s `unionBags` bind_names,
+	      listToBag tycon_s `unionBags` listToBag cls_s)
+
+
+getTyDeclNames :: RdrNameTyDecl
+	       -> RnM_Info s (RnName, Bag RnName)	-- tycon and constrs
+
+getTyDeclNames (TyData _ tycon _ condecls _ _ src_loc)
+  = newGlobalName src_loc Nothing tycon	`thenRn` \ tycon_name ->
+    mapRn (getConDeclName (Just (nameExportFlag tycon_name)))
+			       condecls	`thenRn` \ con_names ->
+    returnRn (RnData tycon_name con_names,
+	      listToBag (map (\ n -> RnConstr n tycon_name) con_names))
+
+getTyDeclNames (TyNew _ tycon _ condecls _ _ src_loc)
+  = newGlobalName src_loc Nothing tycon	`thenRn` \ tycon_name ->
+    mapRn (getConDeclName (Just (nameExportFlag tycon_name)))
+			       condecls	`thenRn` \ con_names ->
+    returnRn (RnData tycon_name con_names,
+	      listToBag (map (\ n -> RnConstr n tycon_name) con_names))
+
+getTyDeclNames (TySynonym tycon _ _ src_loc)
+  = newGlobalName src_loc Nothing tycon	`thenRn` \ tycon_name ->
+    returnRn (RnSyn tycon_name, emptyBag)
+
+getConDeclName exp (ConDecl con _ src_loc)
+  = newGlobalName src_loc exp con
+getConDeclName exp (ConOpDecl _ op _ src_loc)
+  = newGlobalName src_loc exp op
+getConDeclName exp (NewConDecl con _ src_loc)
+  = newGlobalName src_loc exp con
+getConDeclName exp (RecConDecl con fields src_loc)
+  = panic "getConDeclName:RecConDecl"
+    newGlobalName src_loc exp con
+
+
+getClassNames :: RdrNameClassDecl
+	      -> RnM_Info s (RnName, Bag RnName)	-- class and class ops
+
+getClassNames (ClassDecl _ cname _ sigs _ _ src_loc)
+  = newGlobalName src_loc Nothing cname	`thenRn` \ class_name ->
+    getClassOpNames (Just (nameExportFlag class_name))
+				  sigs	`thenRn` \ op_names ->
+    returnRn (RnClass class_name op_names,
+	      listToBag (map (\ n -> RnClassOp n class_name) op_names))
+
+getClassOpNames exp []
+  = returnRn []
+getClassOpNames exp (ClassOpSig op _ _ src_loc : sigs)
+  = newGlobalName src_loc exp op `thenRn` \ op_name ->
+    getClassOpNames exp sigs	 `thenRn` \ op_names ->
+    returnRn (op_name : op_names)
+getClassOpNames exp (_ : sigs)
+  = getClassOpNames exp sigs
+\end{code}
+
+*********************************************************
+*							*
+\subsection{Bindings}
+*							*
+*********************************************************
+
+\begin{code}
+getTopBindsNames :: RdrNameHsBinds
+		 -> RnM_Info s (Bag RnName)
+
+getTopBindsNames binds = doBinds binds
+
+doBinds EmptyBinds           = returnRn emptyBag
+doBinds (SingleBind bind)    = doBind bind
+doBinds (BindWith bind sigs) = doBind bind
+doBinds (ThenBinds binds1 binds2)
+  = andRn unionBags (doBinds binds1) (doBinds binds2)
+
+doBind EmptyBind          = returnRn emptyBag
+doBind (NonRecBind mbind) = doMBinds mbind
+doBind (RecBind mbind)    = doMBinds mbind
+
+doMBinds EmptyMonoBinds 			= returnRn emptyBag
+doMBinds (PatMonoBind pat grhss_and_binds locn) = doPat locn pat
+doMBinds (FunMonoBind p_name _ locn) 	        = doName locn p_name
+doMBinds (AndMonoBinds mbinds1 mbinds2)
+  = andRn unionBags (doMBinds mbinds1) (doMBinds mbinds2)
+
+doPats locn pats
+  = mapRn (doPat locn) pats	`thenRn` \ pats_s ->
+    returnRn (unionManyBags pats_s)
+
+doPat locn WildPatIn             = returnRn emptyBag
+doPat locn (LitPatIn _) 	 = returnRn emptyBag
+doPat locn (LazyPatIn pat)       = doPat locn pat
+doPat locn (VarPatIn var) 	 = doName locn var
+doPat locn (NegPatIn pat)	 = doPat locn pat
+doPat locn (ParPatIn pat)	 = doPat locn pat
+doPat locn (ListPatIn pats)      = doPats locn pats
+doPat locn (TuplePatIn pats)     = doPats locn pats
+doPat locn (ConPatIn name pats)  = doPats locn pats
+doPat locn (ConOpPatIn p1 op p2)
+  = andRn unionBags (doPat locn p1) (doPat locn p2)
+doPat locn (AsPatIn as_name pat)
+  = andRn unionBags (doName locn as_name) (doPat locn pat)
+doPat locn (RecPatIn name fields)
+  = mapRn (doField locn) fields `thenRn` \ fields_s ->
+    returnRn (unionManyBags fields_s)
+
+doField locn (field, _, True{-pun-}) = doName locn field
+doField locn (field, pat, _)	     = doPat locn pat
+
+doName locn rdr
+  = newGlobalName locn Nothing rdr `thenRn` \ name ->
+    returnRn (unitBag (RnName name))
+\end{code}
+
+*********************************************************
+*							*
+\subsection{Creating a new global name}
+*							*
+*********************************************************
+
+\begin{code}
+newGlobalName :: SrcLoc -> Maybe ExportFlag
+	      -> RdrName -> RnM_Info s Name
+
+newGlobalName locn maybe_exp rdr
+  = getExtraRn			`thenRn` \ (_,_,exp_fn,occ_fn) ->
+    getModuleRn  		`thenRn` \ mod ->
+    getSourceRn			`thenRn` \ source -> 
+    rnGetUnique 		`thenRn` \ u ->
+    let
+        src_unqual = getLocalName rdr
+
+	src_orig   = if fromPrelude mod
+	             then (Unqual src_unqual)
+	             else (Qual mod src_unqual)
+
+	exp = case maybe_exp of
+	       Just exp -> exp
+	       Nothing  -> exp_fn n
+
+	n = if source then
+	        mkTopLevName u src_orig locn exp (occ_fn n)
+	    else
+		mkImportedName u rdr locn exp (occ_fn n)
+    in
+    addErrIfRn (source && isQual rdr)
+	       (qualNameErr "name in definition" (rdr, locn)) `thenRn_`
+    returnRn n    
+\end{code}
+
+*********************************************************
+*							*
+\subsection{Imported names}
+*							*
+*********************************************************
+
+\begin{code}
+getImportedNames ::
+	   IfaceCache
+	-> GlobalNameInfo			-- builtin and knot name info
+	-> UniqSupply
+	-> [RdrNameImportDecl]			-- import declarations
+	-> PrimIO (Bag (RdrName,RnName),	-- imported values in scope
+		   Bag (RdrName,RnName),	-- imported tycons/classes in scope
+		   Bag Module,			-- directly imported modules
+		   Bag RenamedFixityDecl,	-- fixity info for imported names
+		   Bag Error,
+		   Bag Warning)
+
+getImportedNames iface_var info us imports 
+  = returnPrimIO (builtin_vals, builtin_tcs, emptyBag, emptyBag, emptyBag, emptyBag)
+  where
+    -- For now jsut add the builtin names ...
+    (b_names,_,_,_) = info
+    builtin_vals = listToBag [(Unqual s, rn) | (s,rn) <- fmToList b_names, not (isRnTyCon rn)]
+    builtin_tcs  = listToBag [(Unqual s, rn) | (s,rn) <- fmToList b_names, isRnTyCon rn]
+\end{code}
+
+
+\begin{code}
+globalDupNamesErr rdr rns sty
+  = ppHang (ppBesides [pprNonOp sty rdr, ppStr " multiply defined:"])
+	 4 (ppAboves (map pp_def rns))
+  where
+    pp_def rn = addShortErrLocLine (getSrcLoc rn) (\ sty -> ppr sty rn) sty
+
+    -- ToDo: print import src locs for imported names
+\end{code}
diff --git a/ghc/compiler/rename/RnPass2.lhs b/ghc/compiler/rename/RnPass2.lhs
deleted file mode 100644
index 3feb281dbd..0000000000
--- a/ghc/compiler/rename/RnPass2.lhs
+++ /dev/null
@@ -1,845 +0,0 @@
-%
-% (c) The GRASP Project, Glasgow University, 1992-1996
-%
-\section[RnPass2]{Second renaming pass: boil down to non-duplicated info}
-
-\begin{code}
-#include "HsVersions.h"
-
-module RnPass2 (
-	rnModule2
-
-	-- for completeness
-    ) where
-
-import Ubiq{-uitous-}
-
-import HsSyn
-import HsCore
-import HsPragmas
-import RdrHsSyn
-import RnMonad12
-
-import Bag		( Bag )
-import IdInfo		( DeforestInfo(..), Demand{-instances-}, UpdateInfo{-instance-} )
-import Outputable	( Outputable(..){-instances-} )
-import PprStyle		( PprStyle(..) )
-import Pretty		-- quite a bit of it
-import ProtoName	( cmpProtoName, eqProtoName, eqByLocalName,
-			  elemProtoNames, elemByLocalNames,
-			  ProtoName(..)
-			)
-import RnUtils		( dupNamesErr )
-import SrcLoc		( mkUnknownSrcLoc, SrcLoc{-instances-} )
-import Util		( isIn, equivClasses,
-			  panic, panic#, pprTrace, assertPanic
-			)
-\end{code}
-
-This pass removes duplicate declarations.  Duplicates can arise when
-two imported interface have a signature (or whatever) for the same
-thing.	We check that the two are consistent and then drop one.
-
-For preference, if one is declared in this module and the other is
-imported, we keep the former; in the case of an instance decl or type
-decl, the local version has a lot more information which we must not
-lose!
-
-Similarly, if one has interesting pragmas and one has not, we keep the
-former.
-
-The notion of ``duplicate'' includes an imported signature and a
-binding in this module.	 In this case, the signature is discarded.
-See note below about how this should be improved.
-
-ToDo: There are still known cases in which we blithely consider two
-declarations to be ``duplicates'' and we then select one of them, {\em
-without} actually checking that they contain the same information!
-[WDP 93/8/16] [Improved, at least WDP 93/08/26]
-
-\begin{code}
-rnModule2  :: ProtoNameHsModule -> Rn12M ProtoNameHsModule
-
-rnModule2 (HsModule mod_name exports imports fixes
-	    ty_decls absty_sigs class_decls inst_decls specinst_sigs
-	    defaults binds int_sigs src_loc)
-
-  = uniquefy mod_name cmpFix selFix fixes
-				`thenRn12` \ fixes ->
-
-    uniquefy mod_name cmpTys selTys ty_decls
-				`thenRn12` \ ty_decls ->
-
-    uniquefy mod_name cmpTySigs selTySigs absty_sigs
-				`thenRn12` \ absty_sigs ->
-
-    uniquefy mod_name cmpClassDecl selClass class_decls
-				`thenRn12` \ class_decls ->
-
-    uniquefy mod_name cmpInst selInst inst_decls
-				`thenRn12` \ inst_decls ->
-
-    uniquefy mod_name cmpSpecInstSigs selSpecInstSigs specinst_sigs
-				`thenRn12` \ specinst_sigs ->
-
-	-- From the imported signatures discard any which are for
-	-- variables bound in this module.
-	-- But, be wary of those that *clash* with those for this
-	-- module...
-	-- Note that we want to do this properly later (ToDo) because imported
-	-- signatures may differ from those declared in the module itself.
-
-    rm_sigs_for_here mod_name int_sigs
-				`thenRn12` \ non_here_int_sigs ->
-
-    uniquefy mod_name cmpSig selSig non_here_int_sigs
-				 `thenRn12` \ int_sigs ->
-    returnRn12
-	(HsModule mod_name
-		  exports   -- export and import lists are passed along
-		  imports   -- for checking in RnPass3; no other reason
-		  fixes
-		  ty_decls
-		  absty_sigs
-		  class_decls
-		  inst_decls
-		  specinst_sigs
-		  defaults
-		  binds
-		  int_sigs
-		  src_loc)
-  where
-    top_level_binders = collectTopLevelBinders binds
-
-    rm_sigs_for_here :: FAST_STRING -> [ProtoNameSig] -> Rn12M [ProtoNameSig]
-	-- NB: operates only on interface signatures, so don't
-	-- need to worry about user-pragmas, etc.
-
-    rm_sigs_for_here mod_name [] = returnRn12 []
-
-    rm_sigs_for_here mod_name (sig@(Sig name _ _ src_loc) : more_sigs)
-      = rm_sigs_for_here mod_name more_sigs `thenRn12` \ rest_sigs ->
-
-	if  not (name `elemByLocalNames` top_level_binders) then -- no name clash...
-	    returnRn12 (sig : rest_sigs)
-
-	else -- name clash...
-	    if	name `elemProtoNames` top_level_binders
-	     && name_for_this_module name then
-		-- the very same thing; just drop it
-		returnRn12 rest_sigs
-	    else
-		-- a different thing with the same name (due to renaming?)
-		-- ToDo: locations need improving
-		report_dup "(renamed?) variable"
-			name src_loc name mkUnknownSrcLoc
-			rest_sigs
-      where
-	 name_for_this_module (Imp m _ _ _) = m == mod_name
-	 name_for_this_module other	    = True
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[FixityDecls-RnPass2]{Functions for @FixityDecls@}
-%*									*
-%************************************************************************
-
-\begin{code}
-cmpFix :: ProtoNameFixityDecl -> ProtoNameFixityDecl -> TAG_
-
-cmpFix (InfixL n1 i1) (InfixL n2 i2) = n1 `cmpProtoName` n2
-cmpFix (InfixL n1 i1) other	     = LT_
-cmpFix (InfixR n1 i1) (InfixR n2 i2) = n1 `cmpProtoName` n2
-cmpFix (InfixR n1 i1) (InfixN n2 i2) = LT_
-cmpFix (InfixN n1 i1) (InfixN n2 i2) = n1 `cmpProtoName` n2
-cmpFix a	      b		     = GT_
-\end{code}
-
-We are pretty un-fussy about which FixityDecl we keep.
-
-\begin{code}
-selFix :: ProtoNameFixityDecl -> ProtoNameFixityDecl -> Rn12M ProtoNameFixityDecl
-selFix f1 f2 = returnRn12 f1
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TyDecls-RnPass2]{Functions for @TyDecls@}
-%*									*
-%************************************************************************
-
-\begin{code}
-cmpTys :: ProtoNameTyDecl -> ProtoNameTyDecl -> TAG_
-
-cmpTys (TyData _ n1 _ _ _ _ _) (TyData _ n2 _ _ _ _ _)  = cmpProtoName n1 n2
-cmpTys (TyNew  _ n1 _ _ _ _ _) (TyNew  _ n2 _ _ _ _ _)  = cmpProtoName n1 n2
-cmpTys (TySynonym n1 _ _ _)    (TySynonym n2 _ _ _)	= cmpProtoName n1 n2
-cmpTys a b
-  = let tag1 = tag a
-	tag2 = tag b
-    in
-    if tag1 _LT_ tag2 then LT_ else GT_
-  where
-    tag (TyData    _ _ _ _ _ _ _) = (ILIT(1) :: FAST_INT)
-    tag (TyNew     _ _ _ _ _ _ _) = ILIT(2)
-    tag (TySynonym _ _ _ _)	  = ILIT(3)
-\end{code}
-
-\begin{code}
-selTys :: ProtoNameTyDecl -> ProtoNameTyDecl
-       -> Rn12M ProtoNameTyDecl
-
--- Note: we could check these more closely.
--- NB: It would be a mistake to cross-check derivings,
--- because we don't preserve those in interfaces.
-
-selTys td1@(TyData c name1 tvs cons1 ds pragmas1 locn1)
-       td2@(TyData _ name2 _   cons2 _	pragmas2 locn2)
-  = selByBetterName "algebraic datatype"
-       name1 pragmas1 locn1 td1
-       name2 pragmas2 locn2 td2
-       (\ p -> TyData c name1 tvs cons1 ds p locn1)
-       chooser_TyData
-
-selTys td1@(TyNew c name1 tvs con1 ds pragmas1 locn1)
-       td2@(TyNew _ name2 _   con2 _  pragmas2 locn2)
-  = selByBetterName "algebraic newtype"
-       name1 pragmas1 locn1 td1
-       name2 pragmas2 locn2 td2
-       (\ p -> TyNew c name1 tvs con1 ds p locn1)
-       chooser_TyNew
-
-selTys ts1@(TySynonym name1 tvs expand1 locn1)
-       ts2@(TySynonym name2 _	expand2 locn2)
-  = selByBetterName "type synonym"
-	name1 bottom locn1 ts1
-	name2 bottom locn2 ts2
-	(\ p -> TySynonym name1 tvs expand1 locn1)
-	chooser_TySynonym
-  where
-    bottom = panic "RnPass2:selTys:TySynonym"
-\end{code}
-
-If only one is ``abstract'' (no condecls), we take the other.
-
-Next, we check that they don't have differing lists of data
-constructors (what a disaster if those get through...); then we do a
-similar thing using pragmatic info.
-
-\begin{code}
-chooser_TyNew  wout pragmas1 locn1 td1@(TyNew _ name1 _ con1 _ _ _)
-		    pragmas2 locn2 td2@(TyNew _ name2 _ con2 _ _ _)
-  = panic "RnPass2:chooser_TyNew"
-
-
-chooser_TyData wout pragmas1 locn1 td1@(TyData _ name1 _ cons1 _ _ _)
-		    pragmas2 locn2 td2@(TyData _ name2 _ cons2 _ _ _)
-  = let
-	td1_abstract = null cons1
-	td2_abstract = null cons2
-
-	choose_by_pragmas = sub_chooser pragmas1 pragmas2
-    in
-    if td1_abstract && td2_abstract then
-	choose_by_pragmas
-
-    else if td1_abstract then
-	returnRn12 td2
-
-    else if td2_abstract then
-	returnRn12 td1
-
-    else if not (eqConDecls cons1 cons2) then
-    	report_dup "algebraic datatype (mismatched data constuctors)"
-    		    name1 locn1 name2 locn2 td1
-    else
-	sub_chooser pragmas1 pragmas2
-  where
-    sub_chooser (DataPragmas [] []) b = returnRn12 (wout b)
-    sub_chooser a (DataPragmas [] []) = returnRn12 (wout a)
-    sub_chooser a@(DataPragmas cons1 specs1) (DataPragmas cons2 specs2)
-      = if not (eqConDecls cons1 cons2) then
-	    pprTrace "Mismatched info in DATA pragmas:\n"
-		     (ppAbove (ppr PprDebug cons1) (ppr PprDebug cons2)) (
-	    returnRn12 (wout (DataPragmas [] []))
-	    )
-	else if not (eq_data_specs specs1 specs2) then
-	    pprTrace "Mismatched specialisation info in DATA pragmas:\n"
-		     (ppAbove (ppr_data_specs specs1) (ppr_data_specs specs2)) (
-	    returnRn12 (wout (DataPragmas [] []))
-	    )
-	else
-	    returnRn12 (wout a)  -- same, pick one
-
-    -- ToDo: Should we use selByBetterName ???
-    -- ToDo: Report errors properly and recover quietly ???
-
-    -- ToDo: Should we merge specialisations ???
-
-    eq_data_specs [] [] = True
-    eq_data_specs (spec1:specs1) (spec2:specs2)
-      = eq_spec spec1 spec2 && eq_data_specs specs1 specs2
-    eq_data_specs _  _  = False
-
-    eq_spec spec1 spec2 = case cmp_spec spec1 spec2 of { EQ_ -> True; _ -> False}
-
-    ppr_data_specs specs
-      = ppBesides [ppStr "_SPECIALISE_ ", pp_the_list [
-	  ppCat [ppLbrack, ppInterleave ppComma (map pp_maybe ty_maybes), ppRbrack]
-	  | ty_maybes <- specs ]]
-
-    pp_the_list [p]    = p
-    pp_the_list (p:ps) = ppAbove (ppBeside p ppComma) (pp_the_list ps)
-
-    pp_maybe Nothing   = pp_NONE
-    pp_maybe (Just ty) = pprParendMonoType PprDebug ty
-
-    pp_NONE = ppStr "_N_"
-\end{code}
-
-Sort of similar deal on synonyms: this is the time to check that the
-expansions are really the same; otherwise, we use the pragmas.
-
-\begin{code}
-chooser_TySynonym wout _ locn1 ts1@(TySynonym name1 _ expand1 _)
-		       _ locn2 ts2@(TySynonym name2 _ expand2 _)
-  = if not (eqMonoType expand1 expand2) then
-    	report_dup "type synonym" name1 locn1 name2 locn2 ts1
-    else
-	returnRn12 ts1 -- same, just pick one
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[SpecDataSigs-RnPass2]{Functions for @SpecDataSigs@}
-%*									*
-%************************************************************************
-
-\begin{code}
-cmpTySigs :: ProtoNameSpecDataSig -> ProtoNameSpecDataSig -> TAG_
-
-cmpTySigs (SpecDataSig n1 ty1 _) (SpecDataSig n2 ty2 _)
-  = case cmpProtoName n1 n2 of
-	EQ_   -> LT_   -- multiple SPECIALIZE data pragmas allowed
-	other -> other
-
-selTySigs :: ProtoNameSpecDataSig
-	  -> ProtoNameSpecDataSig
-	  -> Rn12M ProtoNameSpecDataSig
-
-selTySigs s1@(SpecDataSig n1 ty1 locn1) s2@(SpecDataSig n2 ty2 locn2)
-  = selByBetterName "SPECIALIZE data user-pragma"
-	n1 bottom locn1 s1
-	n2 bottom locn2 s2
-	bottom bottom
-  where
-    bottom = panic "RnPass2:selTySigs:SpecDataSig"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[ClassDecl-RnPass2]{Functions for @ClassDecls@}
-%*									*
-%************************************************************************
-
-\begin{code}
-cmpClassDecl :: ProtoNameClassDecl -> ProtoNameClassDecl -> TAG_
-
-cmpClassDecl (ClassDecl _ n1 _ _ _ _ _) (ClassDecl _ n2 _ _ _ _ _)
-  = cmpProtoName n1 n2
-
-selClass  :: ProtoNameClassDecl -> ProtoNameClassDecl
-	  -> Rn12M ProtoNameClassDecl
-
-selClass cd1@(ClassDecl ctxt n1 tv sigs bs pragmas1 locn1)
-	 cd2@(ClassDecl _    n2 _  _	_  pragmas2 locn2)
-  = selByBetterName "class"
-	n1 pragmas1 locn1 cd1
-	n2 pragmas2 locn2 cd2
-	(\ p -> ClassDecl ctxt n1 tv sigs bs p locn1)
-	chooser_Class
-\end{code}
-
-\begin{code}
-chooser_Class wout NoClassPragmas   _ _ b		_ _ = returnRn12 (wout b)
-chooser_Class wout a		    _ _ NoClassPragmas	_ _ = returnRn12 (wout a)
-
-chooser_Class wout sd1@(SuperDictPragmas gs1) l1 _ sd2@(SuperDictPragmas gs2) l2 _
-  = if length gs1 /= length gs2 then	-- urgh
-       returnRn12 (wout NoClassPragmas)
-    else
-	recoverQuietlyRn12 [{-no gen prags-}] (
-	    zipWithRn12 choose_prag gs1 gs2
-	)			`thenRn12` \ new_gprags ->
-	returnRn12 (wout (
-	    if null new_gprags then
-		pprTrace "tossed all SuperDictPragmas (rename2):"
-			 (ppAbove (ppr PprDebug sd1) (ppr PprDebug sd2))
-		NoClassPragmas
-	    else
-		SuperDictPragmas new_gprags
-	))
-  where
-    choose_prag g1 g2 = selGenPragmas g1 l1 g2 l2
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[InstDecls-RnPass2]{Functions for @InstDecls@}
-%*									*
-%************************************************************************
-
-\begin{code}
-cmpInst :: ProtoNameInstDecl -> ProtoNameInstDecl -> TAG_
-
-cmpInst (InstDecl c1 ty1 _ _ _ _ _ _) (InstDecl c2 ty2 _ _ _ _ _ _)
-  = case cmpProtoName c1 c2 of
-      EQ_   -> cmpInstanceTypes ty1 ty2
-      other -> other
-\end{code}
-
-Select the instance declaration from the module (rather than an
-interface), if it exists.
-
-\begin{code}
-selInst :: ProtoNameInstDecl -> ProtoNameInstDecl
-	-> Rn12M ProtoNameInstDecl
-
-selInst i1@(InstDecl c ty bs from_here1 orig_mod1 uprags pragmas1 locn1)
-	i2@(InstDecl _ _  _  from_here2 orig_mod2 _      pragmas2 locn2)
-  = let
-	have_orig_mod1 = not (_NULL_ orig_mod1)
-	have_orig_mod2 = not (_NULL_ orig_mod2)
-
-	choose_no1 = returnRn12 i1
-	choose_no2 = returnRn12 i2
-    in
-	-- generally: try to keep the locally-defined instance decl
-
-    if from_here1 && from_here2 then
-	-- If they are both from this module, don't throw either away,
-	-- otherwise we silently discard erroneous duplicates
-	trace ("selInst: duplicate instance in this module (ToDo: msg!)")
-	choose_no1
-
-    else if from_here1 then
-	if ( have_orig_mod1 && have_orig_mod2 && orig_mod1 /= orig_mod2 ) then
-	    trace ("selInst: instance in this module also defined somewhere else! (ToDo: msg!)")
-	    choose_no1
-	else
-	    choose_no1
-
-    else if from_here2 then
-	if ( have_orig_mod1 && have_orig_mod2 && orig_mod1 /= orig_mod2 ) then
-	    trace ("selInst: instance in this module also defined somewhere else! (ToDo: msg!)")
-	    choose_no2
-	else
-	    choose_no2
-
-    else -- it's definitely an imported instance;
-	 -- first, a quick sanity check...
-	if ( have_orig_mod1 && have_orig_mod2 && orig_mod1 /= orig_mod2 ) then
-	    trace ("selInst: `same' instances coming in from two modules! (ToDo: msg!)")
-	    choose_no2 -- arbitrary
-	else
-	    panic "RnPass2: need original modules for imported instances"
-
-{- LATER ???
-	    -- now we *cheat*: so we can use the "informing module" stuff
-	    -- in "selByBetterName", we *make up* some ProtoNames for
-	    -- these instance decls
-	    let
-		ii = SLIT("!*INSTANCE*!")
-		n1 = Imp orig_mod1 ii [infor_mod1] ii
-		n2 = Imp orig_mod2 ii [infor_mod2] ii
-	    in
-	    selByBetterName "instance"
-		n1 pragmas1 locn1 i1
-		n2 pragmas2 locn2 i2
-		(\ p -> InstDecl c ty bs from_here1 orig_mod1 infor_mod1
-			[{-none-}] p locn1)
-		chooser_Inst
--}
-\end{code}
-
-\begin{code}
-chooser_Inst wout iprags1 loc1 i1 iprags2 loc2 i2
-  = chk_pragmas iprags1 iprags2
-  where
-	-- easy cases:
-    chk_pragmas NoInstancePragmas b = returnRn12 (wout b)
-    chk_pragmas a NoInstancePragmas = returnRn12 (wout a)
-
-	-- SimpleInstance pragmas meet: choose by GenPragmas
-    chk_pragmas (SimpleInstancePragma gprags1) (SimpleInstancePragma gprags2)
-      = recoverQuietlyRn12 NoGenPragmas (
-	    selGenPragmas gprags1 loc1 gprags2 loc2
-	)				`thenRn12` \ new_prags ->
-	returnRn12 (wout (
-	    case new_prags of
-	      NoGenPragmas -> NoInstancePragmas	-- bottled out
-	      _ -> SimpleInstancePragma new_prags
-	))
-
-	-- SimpleInstance pragma meets anything else... take the "else"
-    chk_pragmas (SimpleInstancePragma _) b = returnRn12 (wout b)
-    chk_pragmas a (SimpleInstancePragma _) = returnRn12 (wout a)
-
-    chk_pragmas (ConstantInstancePragma gp1 prs1) (ConstantInstancePragma gp2 prs2)
-      = recoverQuietlyRn12 NoGenPragmas (
-	    selGenPragmas gp1 loc1 gp2 loc2
-	)			`thenRn12` \ dfun_prags ->
-
-	recoverQuietlyRn12 [] (
-	    selNamePragmaPairs prs1 loc1 prs2 loc2
-	)			`thenRn12` \ new_pairs ->
-
-	returnRn12 (wout (
-	    if null new_pairs then -- bottled out
-		case dfun_prags of
-		  NoGenPragmas -> NoInstancePragmas -- doubly bottled out
-		  _ -> SimpleInstancePragma dfun_prags
-	    else
-		ConstantInstancePragma dfun_prags new_pairs
-	))
-
-	-- SpecialisedInstancePragmas: choose by gens, then specialisations
-    chk_pragmas a@(SpecialisedInstancePragma _ _) (SpecialisedInstancePragma _ _)
-      = trace "not checking two SpecialisedInstancePragma pragmas!" (returnRn12 (wout a))
-
-    chk_pragmas other1 other2  -- oops, bad mismatch
-      = pRAGMA_ERROR "instance pragmas" (wout other1) -- ToDo: msg
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[SpecInstSigs-RnPass2]{Functions for @AbstractTypeSigs@}
-%*									*
-%************************************************************************
-
-We don't make any effort to look for duplicate ``SPECIALIZE instance''
-pragmas. (Later??)
-
-We do this by make \tr{cmp*} always return \tr{LT_}---then there's
-nothing for \tr{sel*} to do!
-
-\begin{code}
-cmpSpecInstSigs
-    :: ProtoNameSpecInstSig -> ProtoNameSpecInstSig -> TAG_
-
-selSpecInstSigs :: ProtoNameSpecInstSig
-		-> ProtoNameSpecInstSig
-		-> Rn12M ProtoNameSpecInstSig
-
-cmpSpecInstSigs	a b = LT_
-selSpecInstSigs a b = panic "RnPass2:selSpecInstSigs"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Functions for SigDecls}
-%*									*
-%************************************************************************
-
-These \tr{*Sig} functions only operate on things from interfaces, so
-we don't have to worry about user-pragmas and other such junk.
-
-\begin{code}
-cmpSig :: ProtoNameSig -> ProtoNameSig -> TAG_
-
-cmpSig (Sig n1 _ _ _) (Sig n2 _ _ _) = cmpProtoName n1 n2
-
-cmpSig _ _ = panic# "cmpSig (rename2)"
-
-selSig :: ProtoNameSig -> ProtoNameSig -> Rn12M ProtoNameSig
-
-selSig s1@(Sig n1 ty pragmas1 locn1) s2@(Sig n2 _ pragmas2 locn2)
-  = selByBetterName "type signature"
-	n1 pragmas1 locn1 s1
-	n2 pragmas2 locn2 s2
-	(\ p -> Sig n1 ty p locn1) -- w/out its pragmas
-	chooser_Sig
-\end{code}
-
-\begin{code}
-chooser_Sig wout_prags g1 l1 s1@(Sig n1 ty1 _ _) g2 l2 s2@(Sig n2 ty2 _ _)
-  = case (cmpPolyType cmpProtoName ty1 ty2) of
-      EQ_ ->
-	recoverQuietlyRn12 NoGenPragmas (
-	    selGenPragmas g1 l1 g2 l2
-	)			`thenRn12` \ new_prags ->
-	returnRn12 (wout_prags new_prags)
-      _ -> report_dup "signature" n1 l1 n2 l2 s1
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Help functions: selecting based on pragmas}
-%*									*
-%************************************************************************
-
-\begin{code}
-selGenPragmas
-	:: ProtoNameGenPragmas -> SrcLoc
-	-> ProtoNameGenPragmas -> SrcLoc
-	-> Rn12M ProtoNameGenPragmas
-
-selGenPragmas NoGenPragmas _ b	          _ = returnRn12 b
-selGenPragmas a		   _ NoGenPragmas _ = returnRn12 a
-
-selGenPragmas g1@(GenPragmas arity1 upd1 def1 strict1 unfold1 specs1) locn1
-	      g2@(GenPragmas arity2 upd2 def2 strict2 unfold2 specs2) locn2
-
-  = sel_arity  arity1  arity2	`thenRn12` \ arity  ->
-    sel_upd    upd1    upd2	`thenRn12` \ upd    ->
-    sel_def    def1    def2     `thenRn12` \ def    ->
-    sel_strict strict1 strict2	`thenRn12` \ strict ->
-    sel_unfold unfold1 unfold2	`thenRn12` \ unfold ->
-    sel_specs  specs1  specs2	`thenRn12` \ specs  ->
-    returnRn12 (GenPragmas arity upd def strict unfold specs)
-  where
-    sel_arity Nothing     Nothing   = returnRn12 Nothing
-    sel_arity a@(Just a1) (Just a2) = if a1 == a2
-				      then returnRn12 a
-				      else pRAGMA_ERROR "arity pragmas" a
-    sel_arity a		  _	    = pRAGMA_ERROR "arity pragmas" a
-
-    -------
-    sel_upd Nothing   	Nothing   = returnRn12 Nothing
-    sel_upd a@(Just u1) (Just u2) = if u1 == u2
-				    then returnRn12 a
-				    else pRAGMA_ERROR "update pragmas" a
-    sel_upd a	    	_	  = pRAGMA_ERROR "update pragmas" a
-
-    -------
-    sel_def Don'tDeforest Don'tDeforest = returnRn12 Don'tDeforest
-    sel_def DoDeforest    DoDeforest    = returnRn12 DoDeforest
-    sel_def a             _             = pRAGMA_ERROR "deforest pragmas" a
-
-    ----------
-    sel_unfold NoImpUnfolding b	    	     = returnRn12 b
-    sel_unfold a	      NoImpUnfolding = returnRn12 a
-
-    sel_unfold a@(ImpUnfolding _ c1) (ImpUnfolding _ c2)
-      = if c1 `eqUfExpr` c2 -- very paranoid (and rightly so)
-	then returnRn12 a
-	else pprTrace "mismatched unfoldings:\n" (ppAbove (ppr PprDebug c1) (ppr PprDebug c2)) (
-	     returnRn12 NoImpUnfolding
-	     )
-
-    sel_unfold a@(ImpMagicUnfolding b) (ImpMagicUnfolding c)
-      = if b == c then returnRn12 a else pRAGMA_ERROR "magic unfolding" a
-
-    sel_unfold a _ = pRAGMA_ERROR "unfolding pragmas" a
-
-    ----------
-    sel_strict NoImpStrictness NoImpStrictness = returnRn12 NoImpStrictness
-
-    sel_strict a@(ImpStrictness b1 i1 g1) (ImpStrictness b2 i2 g2)
-      = if b1 /= b2 || i1 /= i2
-	then pRAGMA_ERROR "strictness pragmas" a
-	else recoverQuietlyRn12 NoGenPragmas (
-		selGenPragmas g1 locn1 g2 locn2
-	     )	`thenRn12` \ wrkr_prags ->
-	     returnRn12 (ImpStrictness b1 i1 wrkr_prags)
-
-    sel_strict a _ = pRAGMA_ERROR "strictness pragmas" a
-
-    ---------
-    sel_specs specs1 specs2
-      = selSpecialisations specs1 locn1 specs2 locn2
-\end{code}
-
-\begin{code}
-selNamePragmaPairs
-	:: [(ProtoName, ProtoNameGenPragmas)] -> SrcLoc
-	-> [(ProtoName, ProtoNameGenPragmas)] -> SrcLoc
-	-> Rn12M [(ProtoName, ProtoNameGenPragmas)]
-
-selNamePragmaPairs [] _ [] _ = returnRn12 []
-selNamePragmaPairs [] _ bs _ = returnRn12 bs
-selNamePragmaPairs as _ [] _ = returnRn12 as
-
-selNamePragmaPairs ((name1, prags1) : pairs1) loc1
-		   ((name2, prags2) : pairs2) loc2
-
-  = if not (name1 `eqProtoName` name2) then
-	-- msg of any kind??? ToDo
-	pRAGMA_ERROR "named pragmas" pairs1
-    else
-    	selGenPragmas prags1 loc1 prags2 loc2	    `thenRn12` \ new_prags ->
-    	selNamePragmaPairs pairs1 loc1 pairs2 loc2  `thenRn12` \ rest ->
-	returnRn12 ( (name1, new_prags) : rest )
-\end{code}
-
-For specialisations we merge the lists from each Sig. This allows the user to
-declare specialised prelude functions in their own PreludeSpec module.
-
-\begin{code}
-selSpecialisations
-	:: [([Maybe ProtoNameMonoType], Int, ProtoNameGenPragmas)] -> SrcLoc
-	-> [([Maybe ProtoNameMonoType], Int, ProtoNameGenPragmas)] -> SrcLoc
-	-> Rn12M [([Maybe ProtoNameMonoType], Int, ProtoNameGenPragmas)]
-
-selSpecialisations [] _ [] _ = returnRn12 []
-selSpecialisations [] _ bs _ = returnRn12 bs -- arguable ... ToDo?
-selSpecialisations as _ [] _ = returnRn12 as -- ditto
-
-selSpecialisations all_specs1@((spec1, dicts1, prags1) : rest_specs1) loc1
-		   all_specs2@((spec2, dicts2, prags2) : rest_specs2) loc2
-
-  = case (cmp_spec spec1 spec2) of
-	 LT_ -> selSpecialisations rest_specs1 loc1 all_specs2 loc2
-					`thenRn12` \ rest ->
-    		returnRn12 ( (spec1, dicts1, prags1) : rest )
-
-	 EQ_ -> ASSERT(dicts1 == dicts2)
-	       	recoverQuietlyRn12 NoGenPragmas (
-	    	    selGenPragmas prags1 loc1 prags2 loc2
-		)			`thenRn12` \ new_prags ->
-    	        selSpecialisations rest_specs1 loc1 rest_specs2 loc2
-					`thenRn12` \ rest ->
-    		returnRn12 ( (spec1, dicts1, new_prags) : rest )
-
-	 GT_ -> selSpecialisations all_specs1 loc1 rest_specs2 loc2
-					`thenRn12` \ rest ->
-    		returnRn12 ( (spec2, dicts2, prags2) : rest )
-
-cmp_spec [] []			   = EQ_
-cmp_spec (Nothing:xs) (Nothing:ys) = cmp_spec xs ys
-cmp_spec (Just t1:xs) (Just t2:ys) = case cmpMonoType cmpProtoName t1 t2 of
-					EQ_ -> cmp_spec xs ys
-					xxx -> xxx
-cmp_spec (Nothing:xs) (Just t2:ys) = LT_
-cmp_spec (Just t1:xs) (Nothing:ys) = GT_
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Help functions: @uniquefy@ and @selByBetterName@}
-%*									*
-%************************************************************************
-
-\begin{code}
-uniquefy :: FAST_STRING			-- Module name
-	 -> (a -> a -> TAG_)		-- Comparison function
-	 -> (a -> a -> Rn12M a)		-- Selection function
-	 -> [a]				-- Things to be processed
-	 -> Rn12M [a]			-- Processed things
-
-uniquefy mod cmp sel things
-  = mapRn12 (check_group_consistency sel) grouped_things
-  where
-    grouped_things = equivClasses cmp things
-
-    check_group_consistency :: (a -> a -> Rn12M a)	-- Selection function
-			    -> [a]			-- things to be compared
-			    -> Rn12M a
-
-    check_group_consistency sel [] = panic "RnPass2: runs produced an empty list"
-    check_group_consistency sel (thing:things) = foldrRn12 sel thing things
-\end{code}
-
-@selByBetterName@: There are two ways one thing can have a ``better
-name'' than another.
-
-First: Something with an @Unk@ name is declared in this module, so we
-keep that, rather than something from an interface (with an @Imp@
-name, probably).
-
-Second: If we have two non-@Unk@ names, but one ``informant module''
-is also the {\em original} module for the entity, then we choose that
-one.  I.e., if one interface says, ``I am the module that created this
-thing'' then we believe it and take that one.
-
-If we can't figure out which one to choose by the names, we use the
-info provided to select based on the pragmas.
-
-LATER: but surely we have to worry about different-by-original-name
-things which are same-by-local-name things---these should be reported
-as errors.
-
-\begin{code}
-selByBetterName :: String   -- class/datatype/synonym (for error msg)
-
-		-- 1st/2nd comparee name/pragmas + their things
-		-> ProtoName -> pragmas -> SrcLoc -> thing
-		-> ProtoName -> pragmas -> SrcLoc -> thing
-
-		-- a thing without its pragmas
-		-> (pragmas -> thing)
-
-		-- choose-by-pragma function
-		-> ((pragmas -> thing)		    -- thing minus its pragmas
-		    -> pragmas -> SrcLoc -> thing   -- comparee 1
-		    -> pragmas -> SrcLoc -> thing   -- comparee 2
-		    -> Rn12M thing )	    	    -- thing w/ its new pragmas
-
-		-> Rn12M thing		-- selected thing
-
-selByBetterName dup_msg
-		pn1 pragmas1 locn1 thing1
-		pn2 pragmas2 locn2 thing2
-		thing_wout_pragmas
-		chooser
-  = getModuleNameRn12	`thenRn12` \ mod_name ->
-    let
-	choose_thing1	= chk_eq (returnRn12 thing1)
-	choose_thing2   = chk_eq (returnRn12 thing2)
-	check_n_choose  = chk_eq (chooser thing_wout_pragmas
-					  pragmas1 locn1 thing1
-					  pragmas2 locn2 thing2)
-
-	dup_error = report_dup dup_msg pn1 locn1 pn2 locn2 thing1
-    in
-    case pn1 of
-      Unk _  -> case pn2 of
-		 Unk _	-> dup_error
-		 _	-> if orig_modules_clash mod_name pn2
-			    then dup_error
-			    else choose_thing1
-
-      Prel _ -> case pn2 of
-		 Unk _	-> if orig_modules_clash mod_name pn1
-			   then dup_error
-			   else choose_thing2
-		 _	-> check_n_choose
-
-      Imp om1 _ im1 _ -> -- we're gonna check `informant module' info...
-	case pn2 of
-	  Unk _		  -> if orig_modules_clash mod_name pn1
-			     then dup_error
-			     else choose_thing2
-	  Prel _	  -> check_n_choose
-	  Imp om2 _ im2 _
-	    -> let
-		   is_elem = isIn "selByBetterName"
-
-		   name1_claims_orig = om1 `is_elem` im1 && not (_NULL_ om1)
-		   name2_claims_orig = om2 `is_elem` im2 && not (_NULL_ om2)
-	       in
-	       if name1_claims_orig
-	       then if name2_claims_orig then check_n_choose else choose_thing1
-	       else if name2_claims_orig then choose_thing2  else check_n_choose
-  where
-    chk_eq if_OK
-      = if not (eqProtoName pn1 pn2) && eqByLocalName pn1 pn2
-	then report_dup dup_msg pn1 locn1 pn2 locn2 thing1
-	else if_OK
-
-    orig_modules_clash this_module pn
-      = case (getOrigName pn) of { (that_module, _) ->
-	not (this_module == that_module) }
-
-report_dup dup_msg pn1 locn1 pn2 locn2 thing
-  = addErrRn12 err_msg `thenRn12` \ _ ->
-    returnRn12 thing
-  where
-    err_msg = dupNamesErr dup_msg [(pn1,locn1), (pn2,locn2)]
-
-pRAGMA_ERROR :: String -> a -> Rn12M a
-pRAGMA_ERROR msg x
-  = addErrRn12 (\ sty -> ppStr ("PRAGMA ERROR:"++msg)) `thenRn12` \ _ ->
-    returnRn12 x
-\end{code}
diff --git a/ghc/compiler/rename/RnPass3.lhs b/ghc/compiler/rename/RnPass3.lhs
deleted file mode 100644
index ce905edec1..0000000000
--- a/ghc/compiler/rename/RnPass3.lhs
+++ /dev/null
@@ -1,620 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-%
-\section[RnPass3]{Third of the renaming passes}
-
-The business of this pass is to:
-\begin{itemize}
-\item	find all the things declared at top level,
-\item	assign uniques to them
-\item return an association list mapping their @ProtoName@s to
-	freshly-minted @Names@ for them.
-\end{itemize}
-
-No attempt is made to discover whether the same thing is declared
-twice: that is up to the caller to sort out.
-
-\begin{code}
-#include "HsVersions.h"
-
-module RnPass3 (
-	rnModule3,
-	initRn3, Rn3M(..)  -- re-exported from monad
-
-	-- for completeness
-    ) where
-
-import Ubiq{-uitous-}
-
-import RnMonad3
-import HsSyn
-import RdrHsSyn
-
-import Bag		( emptyBag, listToBag, unionBags, unionManyBags,
-			  unitBag, snocBag, elemBag, bagToList, Bag
-			)
-import ErrUtils
-import HsPragmas	( DataPragmas(..) )
-import Name		( Name(..) )
-import NameTypes	( fromPrelude, FullName{-instances-} )
-import Pretty
-import ProtoName	( cmpByLocalName, ProtoName(..) )
-import RnUtils		( mkGlobalNameFun,
-			  GlobalNameMappers(..), GlobalNameMapper(..),
-			  PreludeNameMappers(..), PreludeNameMapper(..),
-			  dupNamesErr
-			)
-import SrcLoc		( SrcLoc{-instance-} )
-import Util		( isIn, removeDups, cmpPString, panic )
-\end{code}
-
-*********************************************************
-*							*
-\subsection{Type declarations}
-*							*
-*********************************************************
-
-\begin{code}
-type BagAssoc 	    = Bag (ProtoName, Name)	-- Bag version
-type NameSpaceAssoc = [(ProtoName, Name)]	-- List version
-\end{code}
-
-
-*********************************************************
-*							*
-\subsection{Main function: @rnModule3@}
-*							*
-*********************************************************
-
-\begin{code}
-rnModule3 :: PreludeNameMappers
-	  -> Bag FAST_STRING	-- list of imported module names
-	  -> ProtoNameHsModule
-	  -> Rn3M ( NameSpaceAssoc, NameSpaceAssoc,
-		    GlobalNameMapper,  GlobalNameMapper,
-		    Bag Error )
-
-rnModule3 pnfs@(val_pnf, tc_pnf) imported_mod_names
-	  (HsModule mod_name exports imports _ ty_decls _ class_decls
-	    inst_decls _ _ binds sigs _)
-
-  = putInfoDownM3 {- ???pnfs -} mod_name exports (
-
-    doTyDecls3 ty_decls		`thenRn3` \ (constrs, tycons) ->
-    doClassDecls3 class_decls	`thenRn3` \ (ops, classes) ->
-    doBinds3 binds		`thenRn3` \ val_binds ->
-    doIntSigs3 sigs		`thenRn3` \ val_sigs ->
-
-    let val_namespace	= constrs `unionBags` ops `unionBags` val_binds
-				  `unionBags` val_sigs
-	tc_namespace	= tycons `unionBags` classes
-
-	(var_alist, var_dup_errs) = deal_with_dups "variable" val_pnf (bagToList val_namespace)
-	(tc_alist, tc_dup_errs)	  = deal_with_dups "type or class" tc_pnf (bagToList tc_namespace)
-	v_gnf  = mkGlobalNameFun mod_name val_pnf var_alist
-    	tc_gnf = mkGlobalNameFun mod_name tc_pnf  tc_alist
-    in
-
-    verifyExports v_gnf tc_gnf (imported_mod_names `snocBag` mod_name) exports
-					`thenRn3` \ export_errs ->
-    verifyImports v_gnf tc_gnf imports	`thenRn3` \ import_errs ->
-
-    returnRn3 ( var_alist, tc_alist,
-		v_gnf, tc_gnf,
-		var_dup_errs `unionBags` tc_dup_errs `unionBags`
-		export_errs  `unionBags` import_errs
-    ))
-  where
-    deal_with_dups :: String -> PreludeNameMapper -> NameSpaceAssoc
-		   -> (NameSpaceAssoc, Bag Error)
-
-    deal_with_dups kind_str pnf alist
-      = (goodies,
-	 listToBag (map mk_dup_err dup_lists) `unionBags`
-	 listToBag (map mk_prel_dup_err prel_dups)
-	)
-      where
-	goodies   :: [(ProtoName,Name)]		--NameSpaceAssoc
-	dup_lists :: [[(ProtoName, Name)]]
-
-	-- Find all the names which are defined twice.
-	-- By "name" here, we mean "string"; that is, we are looking
-	-- for places where two strings are bound to different Names
-	-- in the top-level scope of this module.
-
-	(singles, dup_lists) = removeDups cmp alist
-	-- We want to compare their *local* names; the removeDups thing
-	-- is checking for whether two objects have the same local name.
-	cmp (a, _) (b, _) = cmpByLocalName a b
-
-	-- Anything in alist with a Unk name is defined right here in
-	-- this module; hence, it should not be a prelude name.  We
-	-- need to check this separately, because the prelude is
-	-- imported only implicitly, via the PrelNameFuns argument
-
-	(goodies, prel_dups) = if fromPrelude mod_name then
-				 (singles, [])	-- Compiling the prelude, so ignore this check
-			       else
-				 partition local_def_of_prelude_thing singles
-
-	local_def_of_prelude_thing (Unk s, _)
-	  = case pnf s of
-	      Just _  -> False		-- Eek!  It's a prelude name
-	      Nothing -> True		-- It isn't; all is ok
-	local_def_of_prelude_thing other = True
-
-	mk_dup_err :: [(ProtoName, Name)] -> Error
-	mk_dup_err dups_of_name
-	  = let
-		dup_pnames_w_src_loc = [ (pn, getSrcLoc name) | (pn,name) <- dups_of_name ]
-	    in
-	    dupNamesErr kind_str dup_pnames_w_src_loc
-
-	-- This module defines a prelude thing
-	mk_prel_dup_err :: (ProtoName, Name) -> Error
-	mk_prel_dup_err (pn, name)
-	  = dupPreludeNameErr kind_str (pn, getSrcLoc name)
-\end{code}
-
-*********************************************************
-*							*
-\subsection{Type and class declarations}
-*							*
-*********************************************************
-
-\begin{code}
-doTyDecls3 :: [ProtoNameTyDecl] -> Rn3M (BagAssoc, BagAssoc)
-
-doTyDecls3 [] = returnRn3 (emptyBag, emptyBag)
-
-doTyDecls3 (tyd:tyds)
-  = andRn3 combiner (do_decl tyd) (doTyDecls3 tyds)
-  where
-    combiner (cons1, tycons1) (cons2, tycons2)
-      = (cons1 `unionBags` cons2, tycons1 `unionBags` tycons2)
-
-    do_decl (TyData context tycon tyvars condecls _ pragmas src_loc)
-      = newFullNameM3 tycon src_loc True{-tycon-ish-} Nothing
-					`thenRn3` \ (uniq, tycon_name) ->
-    	let
-	    exp_flag = getExportFlag tycon_name
-		-- we want to force all data cons to have the very
-		-- same export flag as their type constructor
-	in
-	doConDecls3 False{-not invisibles-} exp_flag condecls `thenRn3` \ data_cons ->
-	do_data_pragmas exp_flag pragmas		      `thenRn3` \ pragma_data_cons ->
-	returnRn3 (data_cons `unionBags` pragma_data_cons,
-		   unitBag (tycon, TyConName uniq tycon_name (length tyvars)
-					True -- indicates data/newtype tycon
-					[ c | (_,c) <- bagToList data_cons ]))
-
-    do_decl (TyNew context tycon tyvars condecl _ pragmas src_loc)
-      = newFullNameM3 tycon src_loc True{-tycon-ish-} Nothing
-					`thenRn3` \ (uniq, tycon_name) ->
-    	let
-	    exp_flag = getExportFlag tycon_name
-		-- we want to force all data cons to have the very
-		-- same export flag as their type constructor
-	in
-	doConDecls3 False{-not invisibles-} exp_flag condecl  `thenRn3` \ data_con ->
-	do_data_pragmas exp_flag pragmas		      `thenRn3` \ pragma_data_con ->
-	returnRn3 (data_con `unionBags` pragma_data_con,
-		   unitBag (tycon, TyConName uniq tycon_name (length tyvars)
-					True -- indicates data/newtype tycon
-					[ c | (_,c) <- bagToList data_con ]))
-
-    do_decl (TySynonym tycon tyvars monoty src_loc)
-      = newFullNameM3 tycon src_loc True{-tycon-ish-} Nothing
-					`thenRn3` \ (uniq, tycon_name) ->
-	returnRn3 (emptyBag,
-		   unitBag (tycon, TyConName uniq tycon_name (length tyvars) False bottom))
-					-- Flase indicates type tycon
-      where
-	bottom = panic "do_decl: data cons on synonym?"
-
-    do_data_pragmas exp_flag (DataPragmas con_decls specs)
-      = doConDecls3 True{-invisibles-} exp_flag con_decls
-\end{code}
-
-\begin{code}
-doConDecls3 :: Bool		    -- True <=> mk invisible FullNames
-	    -> ExportFlag	    -- Export flag of the TyCon; we want
-				    -- to force its use.
-	    -> [ProtoNameConDecl]
-	    -> Rn3M BagAssoc
-
-doConDecls3 _ _ [] = returnRn3 emptyBag
-
-doConDecls3 want_invisibles exp_flag (cd:cds)
-  = andRn3 unionBags (do_decl cd) (doConDecls3 want_invisibles exp_flag cds)
-  where
-    mk_name = if want_invisibles then newInvisibleNameM3 else newFullNameM3
-
-    do_decl (ConDecl con tys src_loc)
-      = mk_name con src_loc True{-tycon-ish-} (Just exp_flag) `thenRn3` \ (uniq, con_name) ->
-	returnRn3 (unitBag (con, ValName uniq con_name))
-    do_decl (ConOpDecl ty1 op ty2 src_loc)
-      = mk_name op src_loc True{-tycon-ish-} (Just exp_flag)  `thenRn3` \ (uniq, con_name) ->
-	returnRn3 (unitBag (op, ValName uniq con_name))
-    do_decl (NewConDecl con ty src_loc)
-      = mk_name con src_loc True{-tycon-ish-} (Just exp_flag) `thenRn3` \ (uniq, con_name) ->
-	returnRn3 (unitBag (con, ValName uniq con_name))
-    do_decl (RecConDecl con fields src_loc)
-      = _trace "doConDecls3:RecConDecl:nothing for fields\n" $
-        mk_name con src_loc True{-tycon-ish-} (Just exp_flag) `thenRn3` \ (uniq, con_name) ->
-	returnRn3 (unitBag (con, ValName uniq con_name))
-\end{code}
-
-
-@doClassDecls3@ uses the `name function' to map local class names into
-original names, calling @doClassOps3@ to do the same for the
-class operations. @doClassDecls3@ is used to process module
-class declarations.
-
-\begin{code}
-doClassDecls3 :: [ProtoNameClassDecl] -> Rn3M (BagAssoc, BagAssoc)
-
-doClassDecls3 [] = returnRn3 (emptyBag, emptyBag)
-
-doClassDecls3 (cd:cds)
-  = andRn3 combiner (do_decl cd) (doClassDecls3 cds)
-  where
-    combiner (ops1, classes1) (ops2, classes2)
-      = (ops1 `unionBags` ops2, classes1 `unionBags` classes2)
-
-    do_decl (ClassDecl context cname@(Prel c) tyvar sigs defaults pragmas src_loc)
-      = doClassOps3 c 1 sigs	`thenRn3` \ (_, ops) ->
-	returnRn3 (ops, unitBag (cname, c))
-
-    do_decl (ClassDecl context cname tyvar sigs defaults pragmas src_loc)
-      = newFullNameM3 cname src_loc True{-tycon-ish-} Nothing
-					`thenRn3` \ (uniq, class_name) ->
-	fixRn3 ( \ ~(clas_ops,_) ->
-	    let
-		class_Name = ClassName uniq class_name
-					[ o | (_,o) <- bagToList clas_ops ]
-	    in
-	    doClassOps3 class_Name 1 sigs   `thenRn3` \ (_, ops) ->
-	    returnRn3 (ops, class_Name)
-	)				`thenRn3` \ (ops, class_Name) ->
-
-	returnRn3 (ops, unitBag (cname, class_Name))
-\end{code}
-
-We stitch on a class-op tag to each class operation.  They are guaranteed
-to be done in left-to-right order.
-
-\begin{code}
-doClassOps3 :: Name{-class-} -> Int -> [ProtoNameSig] -> Rn3M (Int, BagAssoc)
-
-doClassOps3 clas tag [] = returnRn3 (tag, emptyBag)
-
-doClassOps3 clas tag (sig:rest)
-  = do_op		  sig	`thenRn3` \ (tag1, bag1) ->
-    doClassOps3 clas tag1 rest	`thenRn3` \ (tagr, bagr) ->
-    returnRn3 (tagr, bag1 `unionBags` bagr)
-  where
-{- LATER: NB: OtherVal is a Name, not a ProtoName
-    do_op (ClassOpSig op@(OtherVal uniq name) ty pragma src_loc)
-      =	-- A classop whose unique is pre-ordained, so the type checker
-	-- can look it up easily
-	let
-	    op_name = ClassOpName uniq clas (snd (getOrigName name)) tag
-	in
-	returnRn3 (tag+1, unitBag (op, op_name))
--}
-
-    do_op (ClassOpSig op ty pragma src_loc)
-      = newFullNameM3 op src_loc False{-not tyconish-} Nothing `thenRn3` \ (uniq, _) ->
-	let
-	    op_name = ClassOpName uniq clas (get_str op) tag
-	in
-	returnRn3 (tag+1, unitBag (op, op_name))
-      where
-	-- A rather yukky function to get the original name out of a
-	-- class operation.  The "snd (getOrigName ...)" in the other
-	-- ClassOpSig case does the corresponding yukky thing.
-	get_str :: ProtoName -> FAST_STRING
-	get_str (Unk s)       = s
-	get_str (Qunk _ s)    = s
-	get_str (Imp _ d _ _) = d
-\end{code}
-
-Remember, interface signatures don't have user-pragmas, etc., in them.
-\begin{code}
-doIntSigs3 :: [ProtoNameSig] -> Rn3M BagAssoc
-
-doIntSigs3 [] = returnRn3 emptyBag
-
-doIntSigs3 (s:ss)
-  = andRn3 unionBags (do_sig s) (doIntSigs3 ss)
-  where
-    do_sig (Sig v ty pragma src_loc)
-      = newFullNameM3 v src_loc False{-distinctly untycon-ish-} Nothing
-					     `thenRn3` \ (uniq, v_fname) ->
-	returnRn3 (unitBag (v, ValName uniq v_fname))
-\end{code}
-
-*********************************************************
-*							*
-\subsection{Bindings}
-*							*
-*********************************************************
-
-\begin{code}
-doBinds3 :: ProtoNameHsBinds -> Rn3M BagAssoc
-
-doBinds3 EmptyBinds = returnRn3 emptyBag
-
-doBinds3 (ThenBinds binds1 binds2)
-  = andRn3 unionBags (doBinds3 binds1) (doBinds3 binds2)
-
-doBinds3 (SingleBind bind)    = doBind3 bind
-
-doBinds3 (BindWith bind sigs) = doBind3 bind
-\end{code}
-
-\begin{code}
-doBind3 :: ProtoNameBind -> Rn3M BagAssoc
-doBind3 EmptyBind          = returnRn3 emptyBag
-doBind3 (NonRecBind mbind) = doMBinds3 mbind
-doBind3 (RecBind mbind)    = doMBinds3 mbind
-
-doMBinds3 :: ProtoNameMonoBinds -> Rn3M BagAssoc
-
-doMBinds3 EmptyMonoBinds 			 = returnRn3 emptyBag
-doMBinds3 (PatMonoBind pat grhss_and_binds locn) = doPat3 locn pat
-doMBinds3 (FunMonoBind p_name _ locn) 		 = doTopLevName locn p_name
-
-doMBinds3 (AndMonoBinds mbinds1 mbinds2)
-  = andRn3 unionBags (doMBinds3 mbinds1) (doMBinds3 mbinds2)
-\end{code}
-
-Fold over a list of patterns:
-\begin{code}
-doPats3 locn [] = returnRn3 emptyBag
-doPats3 locn (pat:pats)
-  = andRn3 unionBags (doPat3 locn pat) (doPats3 locn pats)
-\end{code}
-
-\begin{code}
-doPat3 :: SrcLoc -> ProtoNamePat -> Rn3M BagAssoc
-
-doPat3 locn WildPatIn       	= returnRn3 emptyBag
-doPat3 locn (LitPatIn _) 	= returnRn3 emptyBag
-doPat3 locn (LazyPatIn pat) 	= doPat3 locn pat
-doPat3 locn (VarPatIn n) 	= doTopLevName locn n
-doPat3 locn (ListPatIn pats)	= doPats3 locn pats
-doPat3 locn (TuplePatIn pats)	= doPats3 locn pats
-
-doPat3 locn (AsPatIn p_name pat)
-  = andRn3 unionBags (doTopLevName locn p_name) (doPat3 locn pat)
-
-doPat3 locn (ConPatIn name pats) = doPats3 locn pats
-
-doPat3 locn (ConOpPatIn pat1 name pat2)
-  = andRn3 unionBags (doPat3 locn pat1) (doPat3 locn pat2)
-\end{code}
-
-\begin{code}
-doTopLevName :: SrcLoc -> ProtoName -> Rn3M BagAssoc
-
-doTopLevName locn pn
-  = newFullNameM3 pn locn False{-un-tycon-ish-}	Nothing `thenRn3` \ (uniq, name) ->
-    returnRn3 (unitBag (pn, ValName uniq name))
-\end{code}
-
-Have to check that export/imports lists aren't too drug-crazed.
-
-\begin{code}
-verifyExports :: GlobalNameMapper -> GlobalNameMapper
-	      -> Bag FAST_STRING -- module names that might appear
-				 -- in an export list; includes the
-				 -- name of this module
-	      -> Maybe [IE ProtoName]	-- export list
-	      -> Rn3M (Bag Error)
-
-verifyExports _ _ _ Nothing{-no export list-} = returnRn3 emptyBag
-
-verifyExports v_gnf tc_gnf imported_mod_names export_list@(Just exports)
-  = mapRn3 verify exports	`thenRn3` \ errs ->
-    chk_exp_dups  export_list	`thenRn3` \ dup_errs ->
-    returnRn3 (unionManyBags (errs ++ dup_errs))
-  where
-    ok	    	   = returnRn3 emptyBag
-    naughty nm msg = returnRn3 (unitBag (badExportNameErr (_UNPK_ nm) msg))
-    undef_name nm  = naughty nm "is not defined."
-    dup_name (nm:_)= naughty nm "occurs more than once."
-
-    undef_name :: FAST_STRING -> Rn3M (Bag Error)
-    dup_name :: [FAST_STRING] -> Rn3M (Bag Error)
-
-    ----------------
-    chk_exp_dups :: Maybe [IE ProtoName] -> Rn3M [Bag Error]
-
-    chk_exp_dups exports
-      = let
-	    export_strs = [ nm | (nm, _) <- fst (getRawExportees exports) ]
-	    (_, dup_lists) = removeDups cmpByLocalName{-????-} export_strs
-	in
-	mapRn3 dup_name [map getOccurrenceName dl | dl <- dup_lists]
-
-    ---------------- the more serious checking
-    verify :: IE ProtoName -> Rn3M (Bag Error)
-
-    verify (IEVar v)
-      = case (v_gnf v) of { Nothing -> undef_name (getOccurrenceName v); _ -> ok }
-
-    verify (IEModuleContents mod)
-      = if not (mod `elemBag` imported_mod_names) then undef_name mod else ok
-
-    verify (IEThingAbs tc)
-      = case (tc_gnf tc) of
-	  Nothing -> undef_name (getOccurrenceName tc)
-	  Just nm -> let
-			naughty_tc = naughty (getOccurrenceName tc)
-		     in
-		     case nm of
-		       TyConName _ _ _ False{-syn-} _
-			 -> naughty_tc "must be exported with a `(..)' -- it's a synonym."
-
-		       ClassName _ _ _
-			 -> naughty_tc "cannot be exported \"abstractly\" (it's a class)."
-		       _ -> ok
-
-    verify (IEThingAll tc)
-      = case (tc_gnf tc) of
-	  Nothing -> undef_name (getOccurrenceName tc)
-	  Just nm -> let
-			naughty_tc = naughty (getOccurrenceName tc)
-		     in
-		     case nm of
-		       TyConName _ _ _ True{-data or newtype-} [{-no cons-}]
-			 -> naughty_tc "can't be exported with a `(..)' -- it was imported abstractly."
-		       _ -> ok
-
-{- OLD:
-    verify (IEConWithCons tc cs)
-      = case (tc_gnf tc) of
-	  Nothing -> undef_name tc
-	  Just nm -> mapRn3 verify (map IEVar cs) `thenRn3` \ errs ->
-		     returnRn3 (unionManyBags errs)
-		     -- ToDo: turgid checking which we don't care about (WDP 94/10)
-
-    verify (IEClsWithOps c ms)
-      = case (tc_gnf c) of
-	  Nothing -> undef_name c
-	  Just  _ -> mapRn3 verify (map IEVar ms) `thenRn3` \ errs ->
-		     returnRn3 (unionManyBags errs)
-		     -- ToDo: turgid checking which we don't care about (WDP 94/10)
--}
-\end{code}
-
-Note: we're not too particular about whether something mentioned in an
-import list is in {\em that} interface... (ToDo? Probably not.)
-
-\begin{code}
-verifyImports :: GlobalNameMapper -> GlobalNameMapper
-	      -> [ProtoNameImportedInterface]
-	      -> Rn3M (Bag Error)
-
-verifyImports v_gnf tc_gnf imports
-  = mapRn3 chk_one (map collect imports) `thenRn3` \ errs ->
-    returnRn3 (unionManyBags errs)
-  where
-    -- collect: name/locn, import list
-
-    collect (ImportMod iff qual asmod details)
-      = (iface iff, imp_list, hide_list)
-      where
-	(imp_list, hide_list)
-	  = case details of
-	      Nothing			 -> ([],  [])
-	      Just (True{-hidden-}, ies) -> ([],  ies)
-	      Just (_ {-unhidden-}, ies) -> (ies, [])
-
-    ------------
-    iface (Interface name _ _ _ _ _ _ locn) = (name, locn)
-
-    ------------
-    chk_one :: ((FAST_STRING, SrcLoc), [IE ProtoName], [IE ProtoName])
-	    -> Rn3M (Bag Error)
-
-    chk_one ((mod_name, locn), import_list, hide_list)
-      = mapRn3 verify import_list   `thenRn3` \ errs1 ->
-	chk_imp_dups  import_list   `thenRn3` \ dup_errs ->
-	-- ToDo: we could check the hiding list more carefully
-	chk_imp_dups  hide_list	    `thenRn3` \ dup_errs2 ->
-    	returnRn3 (unionManyBags (errs1 ++ dup_errs ++ dup_errs2))
-      where
-	ok	          = returnRn3 emptyBag
-	naughty nm msg    = returnRn3 (unitBag (badImportNameErr (_UNPK_ mod_name) (_UNPK_ nm) msg locn))
-	undef_name nm     = naughty nm "is not defined."
-	dup_name (nm:_)   = naughty nm "occurs more than once."
-
-	undef_name :: FAST_STRING -> Rn3M (Bag Error)
-	dup_name :: [FAST_STRING] -> Rn3M (Bag Error)
-
-	----------------
-	chk_imp_dups imports
-	  = let
-		import_strs = getRawImportees imports
-		(_, dup_lists) = removeDups _CMP_STRING_ import_strs
-	    in
-	    mapRn3 dup_name dup_lists
-
-	----------------
-	verify :: IE ProtoName -> Rn3M (Bag Error)
-
-	verify (IEVar v)
-	  = case (v_gnf v) of { Nothing -> undef_name (getOccurrenceName v); _ -> ok }
-
-	verify (IEThingAbs tc)
-	  = case (tc_gnf tc) of
-	      Nothing -> undef_name (getOccurrenceName tc)
-	      Just nm -> let
-			    naughty_tc = naughty (getOccurrenceName tc)
-		         in
-		         case nm of
-			   TyConName _ _ _ False{-syn-} _
-			     -> naughty_tc "must be imported with a `(..)' -- it's a synonym."
-			   ClassName _ _ _
-			     -> naughty_tc "cannot be imported \"abstractly\" (it's a class)."
-			   _ -> ok
-
-	verify (IEThingAll tc)
-	  = case (tc_gnf tc) of
-	      Nothing -> undef_name (getOccurrenceName tc)
-	      Just nm -> let
-			    naughty_tc = naughty (getOccurrenceName tc)
-		         in
-		         case nm of
-			   TyConName _ _ _ True{-data or newtype-} [{-no cons-}]
-			     -> naughty_tc "can't be imported with a `(..)' -- the interface says it's abstract."
-			   _ -> ok
-
-{- OLD:
-	verify (IEConWithCons tc cs)
-	  = case (tc_gnf tc) of
-	      Nothing -> undef_name (getOccurrenceName tc)
-	      Just nm -> mapRn3 verify (map IEVar cs) `thenRn3` \ errs ->
-			 returnRn3 (unionManyBags errs)
-			 -- One could add a great wad of tedious checking
-			 -- here, but I am too lazy to do so.  WDP 94/10
-
-	verify (IEClsWithOps c ms)
-	  = case (tc_gnf c) of
-	      Nothing -> undef_name (getOccurrenceName c)
-	      Just  _ -> mapRn3 verify (map IEVar ms) `thenRn3` \ errs ->
-			 returnRn3 (unionManyBags errs)
-			 -- Ditto about tedious checking.  WDP 94/10
--}
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Error messages}
-%*									*
-%************************************************************************
-
-\begin{code}
-badExportNameErr name whats_wrong
-  = dontAddErrLoc
-	"Error in the export list" ( \ sty ->
-    ppBesides [ppChar '`', ppStr name, ppStr "' ", ppStr whats_wrong] )
-
-------------------------------------------
-badImportNameErr mod name whats_wrong locn
-  = addErrLoc locn
-	("Error in an import list for the module `"++mod++"'") ( \ sty ->
-    ppBesides [ppChar '`', ppStr name, ppStr "' ", ppStr whats_wrong] )
-
-----------------------------
--- dupNamesErr: from RnUtils
-
---------------------------------------
-dupPreludeNameErr descriptor (nm, locn)
-  = addShortErrLocLine locn ( \ sty ->
-    ppBesides [ ppStr "A conflict with a Prelude ", ppStr descriptor,
-		ppStr ": ", ppr sty nm ])
-\end{code}
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
new file mode 100644
index 0000000000..235e945938
--- /dev/null
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -0,0 +1,510 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+%
+\section[RnSource]{Main pass of renamer}
+
+\begin{code}
+#include "HsVersions.h"
+
+module RnSource ( rnSource, rnPolyType ) where
+
+import Ubiq
+import RnLoop		-- *check* the RnPass4/RnExpr4/RnBinds4 loop-breaking
+
+import HsSyn
+import HsPragmas
+import RdrHsSyn
+import RnHsSyn
+import RnMonad
+import RnBinds		( rnTopBinds, rnMethodBinds )
+
+import Bag		( bagToList )
+import Class		( derivableClassKeys )
+import ListSetOps	( unionLists, minusList )
+import Name		( RdrName )
+import Maybes		( maybeToBool, catMaybes )
+import Outputable	( isLocallyDefined, isAvarid, getLocalName, ExportFlag(..) )
+import Pretty
+import SrcLoc		( SrcLoc )
+import Unique		( Unique )
+import UniqFM		( addListToUFM, listToUFM )
+import UniqSet		( UniqSet(..) )
+import Util		( isn'tIn, panic, assertPanic )
+
+rnExports mods Nothing     = returnRn (\n -> ExportAll)
+rnExports mods (Just exps) = returnRn (\n -> ExportAll)
+\end{code}
+
+rnSource `renames' the source module and export list.
+It simultaneously performs dependency analysis and precedence parsing.
+It also does the following error checks:
+\begin{enumerate}
+\item
+Checks that tyvars are used properly. This includes checking
+for undefined tyvars, and tyvars in contexts that are ambiguous.
+\item
+Checks that all variable occurences are defined.
+\item 
+Checks the (..) etc constraints in the export list.
+\end{enumerate}
+
+
+\begin{code}
+rnSource :: [Module]				-- imported modules
+	 -> Bag RenamedFixityDecl		-- fixity info for imported names
+	 -> RdrNameHsModule
+	 -> RnM s (RenamedHsModule,
+		   Name -> ExportFlag,		-- export info
+		   Bag (RnName, RdrName))	-- occurrence info
+
+rnSource imp_mods imp_fixes (HsModule mod version exports _ fixes
+	                       ty_decls specdata_sigs class_decls
+	                       inst_decls specinst_sigs defaults
+	                       binds _ src_loc)
+
+  = pushSrcLocRn src_loc $
+
+    rnExports (mod:imp_mods) exports	`thenRn` \ exported_fn ->
+    rnFixes fixes			`thenRn` \ src_fixes ->
+    let
+	pair_name (InfixL n i) = (n, i)
+	pair_name (InfixR n i) = (n, i)
+	pair_name (InfixN n i) = (n, i)
+
+	imp_fixes_fm = listToUFM (map pair_name (bagToList imp_fixes))
+	all_fixes_fm = addListToUFM imp_fixes_fm (map pair_name src_fixes)
+    in
+    setExtraRn {-all_fixes_fm-}(panic "rnSource:all_fixes_fm") $
+
+    mapRn rnTyDecl	ty_decls	`thenRn` \ new_ty_decls ->
+    mapRn rnSpecDataSig specdata_sigs	`thenRn` \ new_specdata_sigs ->
+    mapRn rnClassDecl	class_decls	`thenRn` \ new_class_decls ->
+    mapRn rnInstDecl	inst_decls	`thenRn` \ new_inst_decls ->
+    mapRn rnSpecInstSig specinst_sigs   `thenRn` \ new_specinst_sigs ->
+    rnDefaultDecl	defaults	`thenRn` \ new_defaults ->
+    rnTopBinds binds			`thenRn` \ new_binds ->
+
+    getOccurrenceUpRn			`thenRn` \ occ_info ->
+
+    returnRn (
+	      HsModule mod version
+		trashed_exports trashed_imports
+		{-new_fixes-}(panic "rnSource:new_fixes (Hi, Patrick!)")
+		new_ty_decls new_specdata_sigs new_class_decls
+		new_inst_decls new_specinst_sigs new_defaults
+		new_binds [] src_loc,
+	      exported_fn,
+	      occ_info
+	     )
+  where
+    trashed_exports = panic "rnSource:trashed_exports"
+    trashed_imports = panic "rnSource:trashed_imports"
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Type declarations}
+%*							*
+%*********************************************************
+
+@rnTyDecl@ uses the `global name function' to create a new type
+declaration in which local names have been replaced by their original
+names, reporting any unknown names.
+
+Renaming type variables is a pain. Because they now contain uniques,
+it is necessary to pass in an association list which maps a parsed
+tyvar to its Name representation. In some cases (type signatures of
+values), it is even necessary to go over the type first in order to
+get the set of tyvars used by it, make an assoc list, and then go over
+it again to rename the tyvars! However, we can also do some scoping
+checks at the same time.
+
+\begin{code}
+rnTyDecl :: RdrNameTyDecl -> RnM_Fixes s RenamedTyDecl
+
+rnTyDecl (TyData context tycon tyvars condecls derivings pragmas src_loc)
+  = pushSrcLocRn src_loc $
+    lookupTyCon tycon		       `thenRn` \ tycon' ->
+    mkTyVarNamesEnv src_loc tyvars     `thenRn` \ (tv_env, tyvars') ->
+    rnContext tv_env context	       `thenRn` \ context' ->
+    rnConDecls tv_env condecls	       `thenRn` \ condecls' ->
+    rn_derivs tycon' src_loc derivings `thenRn` \ derivings' ->
+    ASSERT(isNoDataPragmas pragmas)
+    returnRn (TyData context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc)
+
+rnTyDecl (TyNew context tycon tyvars condecl derivings pragmas src_loc)
+  = pushSrcLocRn src_loc $
+    lookupTyCon tycon		      `thenRn` \ tycon' ->
+    mkTyVarNamesEnv src_loc tyvars    `thenRn` \ (tv_env, tyvars') ->
+    rnContext tv_env context	      `thenRn` \ context' ->
+    rnConDecls tv_env condecl	      `thenRn` \ condecl' ->
+    rn_derivs tycon' src_loc derivings `thenRn` \ derivings' ->
+    ASSERT(isNoDataPragmas pragmas)
+    returnRn (TyNew context' tycon' tyvars' condecl' derivings' noDataPragmas src_loc)
+
+rnTyDecl (TySynonym name tyvars ty src_loc)
+  = pushSrcLocRn src_loc $
+    lookupTyCon name		    `thenRn` \ name' ->
+    mkTyVarNamesEnv src_loc tyvars  `thenRn` \ (tv_env, tyvars') ->
+    rnMonoType tv_env ty	    `thenRn` \ ty' ->
+    returnRn (TySynonym name' tyvars' ty' src_loc)
+
+rn_derivs tycon2 locn Nothing -- derivs not specified
+  = returnRn Nothing
+
+rn_derivs tycon2 locn (Just ds)
+  = mapRn (rn_deriv tycon2 locn) ds `thenRn` \ derivs ->
+    returnRn (Just derivs)
+  where
+    rn_deriv tycon2 locn clas
+      = lookupClass clas	    `thenRn` \ clas_name ->
+	addErrIfRn (uniqueOf clas_name `not_elem` derivableClassKeys)
+		   (derivingNonStdClassErr clas locn)
+				    `thenRn_`
+	returnRn clas_name
+      where
+	not_elem = isn'tIn "rn_deriv"
+\end{code}
+
+@rnConDecls@ uses the `global name function' to create a new
+constructor in which local names have been replaced by their original
+names, reporting any unknown names.
+
+\begin{code}
+rnConDecls :: TyVarNamesEnv
+	   -> [RdrNameConDecl]
+	   -> RnM_Fixes s [RenamedConDecl]
+
+rnConDecls tv_env con_decls
+  = mapRn rn_decl con_decls
+  where
+    rn_decl (ConDecl name tys src_loc)
+      = pushSrcLocRn src_loc $
+	lookupValue name	`thenRn` \ new_name ->
+	mapRn rn_bang_ty tys	`thenRn` \ new_tys  ->
+	returnRn (ConDecl new_name new_tys src_loc)
+
+    rn_decl (ConOpDecl ty1 op ty2 src_loc)
+      = pushSrcLocRn src_loc $
+	lookupValue op		`thenRn` \ new_op  ->
+	rn_bang_ty ty1  	`thenRn` \ new_ty1 ->
+	rn_bang_ty ty2  	`thenRn` \ new_ty2 ->
+	returnRn (ConOpDecl new_ty1 new_op new_ty2 src_loc)
+
+    rn_decl (NewConDecl name ty src_loc)
+      = pushSrcLocRn src_loc $
+	lookupValue name	`thenRn` \ new_name ->
+	rn_mono_ty ty		`thenRn` \ new_ty  ->
+	returnRn (NewConDecl new_name new_ty src_loc)
+
+    rn_decl (RecConDecl con fields src_loc)
+      = panic "rnConDecls:RecConDecl"
+
+    ----------
+    rn_mono_ty = rnMonoType tv_env
+
+    rn_bang_ty (Banged ty)
+      = rn_mono_ty ty `thenRn` \ new_ty ->
+	returnRn (Banged new_ty)
+    rn_bang_ty (Unbanged ty)
+      = rn_mono_ty ty `thenRn` \ new_ty ->
+	returnRn (Unbanged new_ty)
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{SPECIALIZE data pragmas}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnSpecDataSig :: RdrNameSpecDataSig
+	      -> RnM_Fixes s RenamedSpecDataSig
+
+rnSpecDataSig (SpecDataSig tycon ty src_loc)
+  = pushSrcLocRn src_loc $
+    let
+	tyvars = extractMonoTyNames ty
+    in
+    mkTyVarNamesEnv src_loc tyvars     	`thenRn` \ (tv_env,_) ->
+    lookupTyCon tycon			`thenRn` \ tycon' ->
+    rnMonoType tv_env ty		`thenRn` \ ty' ->
+    returnRn (SpecDataSig tycon' ty' src_loc)
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Class declarations}
+%*							*
+%*********************************************************
+
+@rnClassDecl@ uses the `global name function' to create a new
+class declaration in which local names have been replaced by their
+original names, reporting any unknown names.
+
+\begin{code}
+rnClassDecl :: RdrNameClassDecl -> RnM_Fixes s RenamedClassDecl
+
+rnClassDecl (ClassDecl context cname tyvar sigs mbinds pragmas src_loc)
+  = pushSrcLocRn src_loc $
+    mkTyVarNamesEnv src_loc [tyvar]	`thenRn` \ (tv_env, [tyvar']) ->
+    rnContext tv_env context	    	`thenRn` \ context' ->
+    lookupClass cname		    	`thenRn` \ cname' ->
+    mapRn (rn_op cname' tv_env) sigs    `thenRn` \ sigs' ->
+    rnMethodBinds cname' mbinds    	`thenRn` \ mbinds' ->
+    ASSERT(isNoClassPragmas pragmas)
+    returnRn (ClassDecl context' cname' tyvar' sigs' mbinds' NoClassPragmas src_loc)
+  where
+    rn_op clas tv_env (ClassOpSig op ty pragmas locn)
+      = pushSrcLocRn locn $
+	lookupClassOp clas op		`thenRn` \ op_name ->
+	rnPolyType tv_env ty		`thenRn` \ new_ty  ->
+
+{-
+*** Please check here that tyvar' appears in new_ty ***
+*** (used to be in tcClassSig, but it's better here)
+***	    not_elem = isn'tIn "tcClassSigs"
+***	    -- Check that the class type variable is mentioned
+***	checkTc (clas_tyvar `not_elem` extractTyVarTemplatesFromTy local_ty)
+***		(methodTypeLacksTyVarErr clas_tyvar (_UNPK_ op_name) src_loc) `thenTc_`
+-}
+
+	ASSERT(isNoClassOpPragmas pragmas)
+	returnRn (ClassOpSig op_name new_ty noClassOpPragmas locn)
+\end{code}
+
+
+%*********************************************************
+%*							*
+\subsection{Instance declarations}
+%*							*
+%*********************************************************
+
+
+@rnInstDecl@ uses the `global name function' to create a new of
+instance declaration in which local names have been replaced by their
+original names, reporting any unknown names.
+
+\begin{code}
+rnInstDecl :: RdrNameInstDecl -> RnM_Fixes s RenamedInstDecl
+
+rnInstDecl (InstDecl cname ty mbinds from_here modname uprags pragmas src_loc)
+  = pushSrcLocRn src_loc $
+    lookupClass cname 		     	`thenRn` \ cname' ->
+
+    rnPolyType [] ty			`thenRn` \ ty' ->
+	-- [] tv_env ensures that tyvars will be foralled
+
+    rnMethodBinds cname' mbinds		`thenRn` \ mbinds' ->
+    mapRn (rn_uprag cname') uprags	`thenRn` \ new_uprags ->
+
+    ASSERT(isNoInstancePragmas pragmas)
+    returnRn (InstDecl cname' ty' mbinds'
+		       from_here modname new_uprags noInstancePragmas src_loc)
+  where
+    rn_uprag class_name (SpecSig op ty using locn)
+      = pushSrcLocRn src_loc $
+	lookupClassOp class_name op	`thenRn` \ op_name ->
+	rnPolyType nullTyVarNamesEnv ty	`thenRn` \ new_ty ->
+	rn_using using			`thenRn` \ new_using ->
+	returnRn (SpecSig op_name new_ty new_using locn)
+
+    rn_uprag class_name (InlineSig op locn)
+      = pushSrcLocRn locn $
+	lookupClassOp class_name op	`thenRn` \ op_name ->
+	returnRn (InlineSig op_name locn)
+
+    rn_uprag class_name (DeforestSig op locn)
+      = pushSrcLocRn locn $
+	lookupClassOp class_name op	`thenRn` \ op_name ->
+	returnRn (DeforestSig op_name locn)
+
+    rn_uprag class_name (MagicUnfoldingSig op str locn)
+      = pushSrcLocRn locn $
+	lookupClassOp class_name op	`thenRn` \ op_name ->
+	returnRn (MagicUnfoldingSig op_name str locn)
+
+    rn_using Nothing 
+      = returnRn Nothing
+    rn_using (Just v)
+      = lookupValue v	`thenRn` \ new_v ->
+	returnRn (Just new_v)
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{@SPECIALIZE instance@ user-pragmas}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnSpecInstSig :: RdrNameSpecInstSig
+	      -> RnM_Fixes s RenamedSpecInstSig
+
+rnSpecInstSig (SpecInstSig clas ty src_loc)
+  = pushSrcLocRn src_loc $
+    let
+	tyvars = extractMonoTyNames ty
+    in
+    mkTyVarNamesEnv src_loc tyvars     	`thenRn` \ (tv_env,_) ->
+    lookupClass clas			`thenRn` \ new_clas ->
+    rnMonoType tv_env ty		`thenRn` \ new_ty ->
+    returnRn (SpecInstSig new_clas new_ty src_loc)
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Default declarations}
+%*							*
+%*********************************************************
+
+@rnDefaultDecl@ uses the `global name function' to create a new set
+of default declarations in which local names have been replaced by
+their original names, reporting any unknown names.
+
+\begin{code}
+rnDefaultDecl :: [RdrNameDefaultDecl] -> RnM_Fixes s [RenamedDefaultDecl]
+
+rnDefaultDecl [] = returnRn []
+rnDefaultDecl [DefaultDecl tys src_loc]
+  = pushSrcLocRn src_loc $
+    mapRn (rnMonoType nullTyVarNamesEnv) tys `thenRn` \ tys' ->
+    returnRn [DefaultDecl tys' src_loc]
+rnDefaultDecl defs@(d:ds)
+  = addErrRn (dupDefaultDeclErr defs) `thenRn_`
+    rnDefaultDecl [d]
+\end{code}
+
+%*************************************************************************
+%*									*
+\subsection{Fixity declarations}
+%*									*
+%*************************************************************************
+
+\begin{code}
+rnFixes :: [RdrNameFixityDecl]  -> RnM s [RenamedFixityDecl]
+
+rnFixes fixities
+  = mapRn rn_fixity fixities	`thenRn` \ fixes_maybe ->
+    returnRn (catMaybes fixes_maybe)
+  where
+    rn_fixity fix@(InfixL name i)
+      = rn_fixity_pieces InfixL name i fix
+    rn_fixity fix@(InfixR name i)
+      = rn_fixity_pieces InfixR name i fix
+    rn_fixity fix@(InfixN name i)
+      = rn_fixity_pieces InfixN name i fix
+
+    rn_fixity_pieces mk_fixity name i fix
+      = lookupValueMaybe name	`thenRn` \ maybe_res ->
+	case maybe_res of
+	  Just res | isLocallyDefined res
+	    -> returnRn (Just (mk_fixity res i))
+	  _ -> failButContinueRn Nothing (undefinedFixityDeclErr fix)
+		
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Support code to rename types}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnPolyType :: TyVarNamesEnv
+	   -> RdrNamePolyType
+	   -> RnM_Fixes s RenamedPolyType
+
+rnPolyType tv_env (HsForAllTy tvs ctxt ty)
+  = rn_poly_help tv_env tvs ctxt ty
+
+rnPolyType tv_env poly_ty@(HsPreForAllTy ctxt ty)
+  = rn_poly_help tv_env forall_tyvars ctxt ty
+  where
+    mentioned_tyvars = extract_poly_ty_names poly_ty
+    forall_tyvars    = mentioned_tyvars `minusList` domTyVarNamesEnv tv_env
+
+------------
+extract_poly_ty_names (HsPreForAllTy ctxt ty)
+  = extractCtxtTyNames ctxt
+    `unionLists`
+    extractMonoTyNames ty
+
+------------
+rn_poly_help :: TyVarNamesEnv
+	     -> [RdrName]
+	     -> RdrNameContext
+	     -> RdrNameMonoType
+	     -> RnM_Fixes s RenamedPolyType
+
+rn_poly_help tv_env tyvars ctxt ty
+  = getSrcLocRn 				`thenRn` \ src_loc ->
+    mkTyVarNamesEnv src_loc tyvars	 	`thenRn` \ (tv_env1, new_tyvars) ->
+    let
+	tv_env2 = catTyVarNamesEnvs tv_env1 tv_env
+    in
+    rnContext tv_env2 ctxt			`thenRn` \ new_ctxt ->
+    rnMonoType tv_env2 ty	`thenRn` \ new_ty ->
+    returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
+\end{code}
+
+\begin{code}
+rnMonoType :: TyVarNamesEnv
+	   -> RdrNameMonoType
+	   -> RnM_Fixes s RenamedMonoType
+
+rnMonoType tv_env (MonoTyVar tyvar)
+  = lookupTyVarName tv_env tyvar 	`thenRn` \ tyvar' ->
+    returnRn (MonoTyVar tyvar')
+
+rnMonoType tv_env (MonoListTy ty)
+  = rnMonoType tv_env ty	`thenRn` \ ty' ->
+    returnRn (MonoListTy ty')
+
+rnMonoType tv_env (MonoFunTy ty1 ty2)
+  = andRn MonoFunTy (rnMonoType tv_env ty1)
+		    (rnMonoType tv_env ty2)
+
+rnMonoType  tv_env (MonoTupleTy tys)
+  = mapRn (rnMonoType tv_env) tys `thenRn` \ tys' ->
+    returnRn (MonoTupleTy tys')
+
+rnMonoType tv_env (MonoTyApp name tys)
+  = let
+	lookup_fn = if isAvarid (getLocalName name) 
+		    then lookupTyVarName tv_env
+  	            else lookupTyCon
+    in
+    lookup_fn name					`thenRn` \ name' ->
+    mapRn (rnMonoType tv_env) tys	`thenRn` \ tys' ->
+    returnRn (MonoTyApp name' tys')
+\end{code}
+
+\begin{code}
+rnContext :: TyVarNamesEnv -> RdrNameContext -> RnM_Fixes s RenamedContext
+
+rnContext tv_env ctxt
+  = mapRn rn_ctxt ctxt
+  where
+    rn_ctxt (clas, tyvar)
+     = lookupClass clas	    	    `thenRn` \ clas_name ->
+       lookupTyVarName tv_env tyvar `thenRn` \ tyvar_name ->
+       returnRn (clas_name, tyvar_name)
+\end{code}
+
+
+\begin{code}
+derivingNonStdClassErr clas locn sty
+  = ppHang (ppStr "Non-standard class in deriving")
+         4 (ppCat [ppr sty clas, ppr sty locn])
+
+dupDefaultDeclErr defs sty
+  = ppHang (ppStr "Duplicate default declarations")
+         4 (ppAboves (map pp_def_loc defs))
+  where
+    pp_def_loc (DefaultDecl _ src_loc) = ppr sty src_loc
+
+undefinedFixityDeclErr decl sty
+  = ppHang (ppStr "Fixity declaration for unknown operator")
+	 4 (ppr sty decl)
+\end{code}
diff --git a/ghc/compiler/rename/RnUtils.lhs b/ghc/compiler/rename/RnUtils.lhs
index 1d4e45ba12..f79e7c47a4 100644
--- a/ghc/compiler/rename/RnUtils.lhs
+++ b/ghc/compiler/rename/RnUtils.lhs
@@ -7,132 +7,186 @@
 #include "HsVersions.h"
 
 module RnUtils (
-	mkGlobalNameFun, mkNameFun,
-	GlobalNameMapper(..),  GlobalNameMappers(..),
-	PreludeNameMapper(..), PreludeNameMappers(..),
-
-	dupNamesErr -- used in various places
+	RnEnv(..), QualNames(..),
+	UnqualNames(..), ScopeStack(..),
+	emptyRnEnv, extendGlobalRnEnv, extendLocalRnEnv,
+	lookupRnEnv, lookupTcRnEnv,
+
+	unknownNameErr,
+	badClassOpErr,
+	qualNameErr,
+	dupNamesErr,
+	shadowedNameWarn,
+	multipleOccWarn,
+
+	-- ToDo: nuke/move? WDP 96/04/05
+	GlobalNameMapper(..),  GlobalNameMappers(..)
     ) where
 
-import Ubiq{-uitous-}
+import Ubiq
 
-import Bag		( bagToList, Bag )
-import FiniteMap	( lookupFM, listToFM )
-import Name		( Name{-instances-} )
-import Outputable	( pprNonOp )
+import Bag		( Bag, emptyBag, snocBag, unionBags )
+import ErrUtils		( addShortErrLocLine, addErrLoc )
+import FiniteMap	( FiniteMap, emptyFM, isEmptyFM,
+			  lookupFM, addListToFM, addToFM )
+import Maybes		( maybeToBool )
+import Name		( RdrName(..), isQual )
+import Outputable	( pprNonOp, getLocalName )
 import PprStyle		( PprStyle(..) )
 import Pretty
-import ProtoName	( ProtoName(..) )
-import Util		( cmpPString, removeDups, pprPanic, panic )
-\end{code}
+import RnHsSyn		( RnName )
+import Util		( assertPanic )
 
-\begin{code}
-type GlobalNameMapper  = ProtoName -> Maybe Name
+type GlobalNameMapper  = RnName -> Maybe Name
 type GlobalNameMappers = (GlobalNameMapper, GlobalNameMapper)
-
-type PreludeNameMapper = FAST_STRING -> Maybe Name
-type PreludeNameMappers = (PreludeNameMapper,		-- Values
-			PreludeNameMapper		-- Types and classes
-		       )
 \end{code}
 
-\begin{code}
-mkGlobalNameFun :: FAST_STRING		-- The module name
-		-> PreludeNameMapper 	-- The prelude things
-		-> [(ProtoName, Name)]	-- The local and imported things
-		-> GlobalNameMapper	-- The global name function
+*********************************************************
+*							*
+\subsection{RnEnv: renaming environment}
+*							*
+*********************************************************
 
-mkGlobalNameFun this_module prel_nf alist
-  = the_fun
-  where
-    the_fun (Prel n)	  = Just n
-    the_fun (Unk s) 	  = case (unk_fun s) of
-			      Just n  -> Just n
-			      Nothing -> prel_nf s
-    the_fun (Imp m d _ _) = imp_fun (d, m) -- NB: module-name 2nd!
-
-    -- Things in the domain of the prelude function shouldn't be put
-    -- in the unk_fun; because the prel_nf will catch them.
-    -- This can arise if, for example, an interface gives a signature
-    -- for a prelude thing.
-    --
-    -- Neither should they be in the domain of the imp_fun, because
-    -- prelude things will have been converted to Prel x rather than
-    -- Imp p q r s.
-    --
-    -- So we strip out prelude things from the alist; this is not just
-    -- desirable, it's essential because get_orig and get_local don't handle
-    -- prelude things.
-
-    non_prel_alist = filter non_prel alist
-
-    non_prel (Prel _, _) = False
-    non_prel other       = True
-
-    -- unk_fun looks up local names (just strings),
-    -- imp_fun looks up original names: (string,string) pairs
-    unk_fun = lookupFM (listToFM [(get_local pn,n) | (pn,n) <- non_prel_alist])
-    imp_fun = lookupFM (listToFM [(get_orig  pn,n) | (pn,n) <- non_prel_alist])
-
-		-- the lists *are* sorted by *some* ordering (by local
-		-- names), but not generally, and not in some way we
-		-- are going to rely on.
-
-    get_local :: ProtoName -> FAST_STRING
-    get_local (Unk s)       = s
-    get_local (Imp _ _ _ l) = l
-    get_local (Prel n)	    = pprPanic "get_local: " (ppr PprShowAll n)
-
-    get_orig :: ProtoName -> (FAST_STRING, FAST_STRING) -- **NB**! module-name 2nd!
-    get_orig (Unk s)       = (s, this_module)
-    get_orig (Imp m d _ _) = (d, m)
-    get_orig (Prel n)	    = pprPanic "get_orig: " (ppr PprShowAll n)
+Seperate FiniteMaps are kept for lookup up Qual names,
+Unqual names and Local names.
+
+\begin{code}
+type RnEnv = ((QualNames, UnqualNames, QualNames, UnqualNames), ScopeStack)
+
+type QualNames    = FiniteMap (FAST_STRING,Module) RnName
+type UnqualNames  = FiniteMap FAST_STRING RnName
+type ScopeStack   = FiniteMap FAST_STRING RnName
+
+emptyRnEnv  	  :: RnEnv
+extendGlobalRnEnv :: RnEnv -> [(RdrName,RnName)] -> [(RdrName,RnName)]
+		  -> (RnEnv, Bag (RdrName, RnName, RnName))
+extendLocalRnEnv  :: Bool -> RnEnv -> [RnName] -> (RnEnv, [RnName])
+lookupRnEnv 	  :: RnEnv -> RdrName -> Maybe RnName
+lookupTcRnEnv 	  :: RnEnv -> RdrName -> Maybe RnName
 \end{code}
 
+If the @RdrName@ is a @Qual@, @lookupValue@ looks it up in the global
+value QualNames.  If it is @Unqual@, it looks it up first in the
+ScopeStack, and if it isn't found there, then in the global
+vaule Unqual Names.
 
-@mkNameFun@ builds a function from @ProtoName@s to things, where a
-``thing'' is either a @ProtoName@ (in the case of values), or a
-@(ProtoName, ProtoName -> ProtoName)@ pair in the case of types and
-classes.  It takes:
+@lookupTcRnEnv@ looks up tycons/classes in the alternative global
+name space.
 
-\begin{itemize}
-\item	The name of the interface
-\item	A bag of new string-to-thing bindings to add,
+@extendGlobalRnEnv@ adds global names to the RnEnv. It takes seperate
+value and tycon/class name lists. It returns any duplicate names
+seperatle.
 
-\item	An extractor function, to get a @ProtoName@ out of a thing,
-	for use in error messages.
-\end{itemize}
-The function it returns only expects to see @Unk@ things.
+@extendRnEnv@ adds new local names to the ScopeStack in an RnEnv.
+It optionally reports any shadowed names.
 
-@mkNameFun@ checks for clashes in the domain of the new bindings.
+\begin{code}
+emptyRnEnv
+  = ((emptyFM, emptyFM, emptyFM, emptyFM), emptyFM)
 
-ToDo: it should check for clashes with the prelude bindings too.
 
-\begin{code}
-mkNameFun :: Bag (FAST_STRING, thing)	    -- Value bindings
-	  -> (FAST_STRING -> Maybe thing,   -- The function to use
-	      [[(FAST_STRING,thing)]])	    -- Duplicates, if any
-
-mkNameFun the_bag
-  = case (removeDups cmp (bagToList the_bag)) of { (no_dup_list, dups) ->
-    case (lookupFM (listToFM no_dup_list))    of { the_fun ->
-    (the_fun, dups) }}
+extendGlobalRnEnv ((qual, unqual, tc_qual, tc_unqual), stack) val_list tc_list
+  = ASSERT(isEmptyFM stack)
+    (((qual', unqual', tc_qual, tc_unqual), stack), tc_dups `unionBags` dups)
   where
-    cmp :: (FAST_STRING, a) -> (FAST_STRING, a) -> TAG_
+    (qual', unqual', dups)          = extend_global qual unqual val_list
+    (tc_qual', tc_unqual', tc_dups) = extend_global tc_qual tc_unqual tc_list
+
+    extend_global qual unqual rdr_list = (qual', unqual', dups)
+      where
+	(qual_list, unqual_list) = partition (isQual.fst) rdr_list
+	qual_in   = map mk_qual qual_list
+	unqual_in = map mk_unqual unqual_list
+	mk_qual   (Qual m s, rn) = ((s,m), rn)
+	mk_unqual (Unqual s, rn) = (s, rn)
+
+	(qual', qual_dups)     = do_dups qual_in qual emptyBag (\ (s,m) -> Qual m s)
+	(unqual', unqual_dups) = do_dups unqual_in unqual emptyBag Unqual
 
-    cmp (s1,_) (s2,_) = _CMP_STRING_ s1 s2
+	dups = unqual_dups `unionBags` qual_dups
+
+	do_dups [] fm dups to_rdr = (fm, dups)
+	do_dups ((k,v):rest) fm dups to_rdr
+          = case lookupFM fm k of
+	      Nothing  -> do_dups rest (addToFM fm k v) dups to_rdr
+	      Just cur -> do_dups rest fm (dups `snocBag` (to_rdr k, cur, v)) to_rdr
+
+
+extendLocalRnEnv report_shadows (global, stack) new_local
+  = ((global, new_stack), dups)
+  where
+    (new_stack, dups) = extend new_local stack
+
+    extend names stack
+      = if report_shadows then
+	    do_shadows names stack []
+	else
+	    (addListToFM stack [ (getLocalName n, n) | n <- names], []) 
+
+    do_shadows [] stack dups = (stack, dups)
+    do_shadows (name:names) stack dups
+      = do_shadows names (addToFM stack str name) ext_dups
+      where
+	str = getLocalName name
+	ext_dups = if maybeToBool (lookupFM stack str)
+		   then name:dups
+		   else dups
+
+
+lookupRnEnv ((qual, unqual, _, _), stack) rdr
+  = case rdr of 
+      Unqual str   -> lookup stack str (lookup unqual str Nothing)
+      Qual mod str -> lookup qual (str,mod) Nothing
+  where
+    lookup fm thing do_on_fail
+      = case lookupFM fm thing of
+	    found@(Just name) -> found
+	    Nothing   	      -> do_on_fail
+
+lookupTcRnEnv ((_, _, tc_qual, tc_unqual), _) rdr
+  = case rdr of 
+      Unqual str   -> lookupFM tc_unqual str
+      Qual mod str -> lookupFM tc_qual (str,mod)
 \end{code}
 
+*********************************************************
+*							*
+\subsection{Errors used in RnMonad}
+*							*
+*********************************************************
+
 \begin{code}
-dupNamesErr descriptor ((first_pname,locn1) : dup_things) sty
-  = ppAboves (first_item : map dup_item dup_things)
+unknownNameErr descriptor name locn
+  = addShortErrLocLine locn ( \ sty ->
+    ppBesides [ppStr "undefined ", ppStr descriptor, ppStr ": ", pprNonOp sty name] )
+
+badClassOpErr clas op locn
+  = addErrLoc locn "" ( \ sty ->
+    ppBesides [ppChar '`', pprNonOp sty op, ppStr "' is not an operation of class `",
+	      ppr sty clas, ppStr "'"] )
+
+qualNameErr descriptor (name,locn)
+  = addShortErrLocLine locn ( \ sty ->
+    ppBesides [ppStr "invalid use of qualified ", ppStr descriptor, ppStr ": ", pprNonOp sty name ] )
+
+dupNamesErr descriptor ((name1,locn1) : dup_things) sty
+  = ppAboves (item1 : map dup_item dup_things)
   where
-    first_item
+    item1
       = ppBesides [ ppr PprForUser locn1,
 	    ppStr ": multiple declarations of a ", ppStr descriptor, ppStr ": ",
-	    pprNonOp sty first_pname ]
+	    pprNonOp sty name1 ]
 
-    dup_item (pname, locn)
+    dup_item (name, locn)
       = ppBesides [ ppr PprForUser locn,
-	    ppStr ": here was another declaration of `", pprNonOp sty pname, ppStr "'" ]
+	    ppStr ": here was another declaration of `", pprNonOp sty name, ppStr "'" ]
+
+shadowedNameWarn locn shadow
+  = addShortErrLocLine locn ( \ sty ->
+    ppBesides [ppStr "more than one value with the same name (shadowing): ", ppr sty shadow] )
+
+multipleOccWarn (name, occs) sty
+  = ppBesides [ppStr "multiple names used to refer to `", ppr sty name, ppStr "': ",
+	       ppInterleave ppComma (map (ppr sty) occs)]
 \end{code}
+