[project @ 1996-04-07 15:36:47 by partain]

Remove some Rn* files to make way for new renamer

4 files changed, 0 insertions, 2859 deletions

diff --git a/ghc/compiler/rename/RnBinds4.lhs b/ghc/compiler/rename/RnBinds4.lhs
deleted file mode 100644
index 57303d82b2..0000000000
--- a/ghc/compiler/rename/RnBinds4.lhs
+++ /dev/null
@@ -1,709 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-%
-\section[RnBinds4]{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 RnBinds4 (
-	rnTopBinds, rnMethodBinds,
-	rnBinds,
-	FreeVars(..), DefinedVars(..)
-   ) where
-
-import Ubiq{-uitous-}
-import RnLoop	-- break the RnPass4/RnExpr4/RnBinds4 loops
-
-import HsSyn
-import RdrHsSyn
-import RnHsSyn
-import HsPragmas	( noGenPragmas )
-import RnMonad4
-
--- others:
-import CmdLineOpts	( opt_SigsRequired )
-import Digraph		( stronglyConnComp )
-import ErrUtils		( addErrLoc, addShortErrLocLine )
-import Maybes		( catMaybes )
-import Name		( isUnboundName, Name{-instances-} )
-import Pretty
-import ProtoName	( elemByLocalNames, eqByLocalName, ProtoName{-instances-} )
-import RnExpr4		-- OK to look here; but not the other way 'round
-import UniqSet		( emptyUniqSet, unitUniqSet, mkUniqSet,
-			  unionUniqSets, unionManyUniqSets,
-			  elementOfUniqSet, addOneToUniqSet,
-			  uniqSetToList,
-			  UniqSet(..)
-			)
-import Util		( isIn, removeDups, panic, panic# )
-\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 Name
-type FreeVars    = UniqSet Name
-\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	:: ProtoNameHsBinds -> Rn4M RenamedHsBinds
-rnMethodBinds  :: Name{-class-} -> ProtoNameMonoBinds -> Rn4M RenamedMonoBinds
-rnBinds	:: ProtoNameHsBinds -> Rn4M (RenamedHsBinds, FreeVars, [Name])
-
-rnTopBinds EmptyBinds		       	   = returnRn4 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 = returnRn4 EmptyMonoBinds
-
-rnMethodBinds class_name (AndMonoBinds mb1 mb2)
-  = andRn4 AndMonoBinds (rnMethodBinds class_name mb1)
-			(rnMethodBinds class_name mb2)
-
-rnMethodBinds class_name (FunMonoBind pname matches locn)
-  = pushSrcLocRn4 locn			      	  (
-    lookupClassOp class_name pname  	`thenRn4` \ op_name ->
-    mapAndUnzipRn4 rnMatch matches	`thenRn4` \ (new_matches, _) ->
-    returnRn4 (FunMonoBind op_name new_matches locn)
-    )
-
-rnMethodBinds class_name (PatMonoBind (VarPatIn pname) grhss_and_binds locn)
-  = pushSrcLocRn4 locn				  (
-    lookupClassOp class_name pname	`thenRn4` \ op_name ->
-    rnGRHSsAndBinds grhss_and_binds	`thenRn4` \ (grhss_and_binds', _) ->
-    returnRn4 (PatMonoBind (VarPatIn op_name) grhss_and_binds' locn)
-    )
-
--- Can't handle method pattern-bindings which bind multiple methods.
-rnMethodBinds _ mbind@(PatMonoBind other_pat _ locn)
-  = failButContinueRn4 EmptyMonoBinds (methodBindErr mbind locn)
-
--- ********************************************************************
-
-rnBinds EmptyBinds			= returnRn4 (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 :: ProtoNameMonoBinds -> [ProtoNameSig] -> Rn4M RenamedHsBinds
-
-rnTopMonoBinds EmptyMonoBinds sigs = returnRn4 EmptyBinds
-
-rnTopMonoBinds mbs sigs
- = rnBindSigs True{-top-level-} (collectMonoBinders mbs) sigs `thenRn4` \ siglist ->
-   rnMonoBinds mbs siglist `thenRn4` \ (new_binds, fv_set) ->
-   returnRn4 new_binds
-
-
-rnNestedMonoBinds :: ProtoNameMonoBinds -> [ProtoNameSig]
-		      -> Rn4M (RenamedHsBinds, FreeVars, [Name])
-
-rnNestedMonoBinds EmptyMonoBinds sigs
-  = returnRn4 (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
-    namesFromProtoNames
-	"variable" -- in binding group
-	mbinders_w_srclocs		`thenRn4` \ new_mbinders ->
-
-    extendSS2 new_mbinders (
-	 rnBindSigs False{-not top- level-} mbinders sigs `thenRn4` \ siglist ->
-	 rnMonoBinds mbinds  siglist
-    )					`thenRn4` \ (new_binds, fv_set) ->
-    returnRn4 (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 :: ProtoNameMonoBinds
-	     -> [RenamedSig]	-- Signatures attached to this group
-	     -> Rn4M (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	`thenRn4` \ (_, 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 = returnRn4 (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
--- 	addErrRn4 (inlineInRecursiveBindsErr names_n_locns) `thenRn4_`
-	{-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
-		 -> ProtoNameMonoBinds
-		 -> Rn4M (Int, FlatMonoBindsInfo)
-
-flattenMonoBinds uniq sigs EmptyMonoBinds = returnRn4 (uniq, [])
-
-flattenMonoBinds uniq sigs (AndMonoBinds mB1 mB2)
-  = flattenMonoBinds uniq sigs mB1	`thenRn4` \ (uniq1, flat1) ->
-    flattenMonoBinds uniq1 sigs mB2	`thenRn4` \ (uniq2, flat2) ->
-    returnRn4 (uniq2, flat1 ++ flat2)
-
-flattenMonoBinds uniq sigs (PatMonoBind pat grhss_and_binds locn)
-  = pushSrcLocRn4 locn		 		  (
-    rnPat pat				`thenRn4` \ pat' ->
-    rnGRHSsAndBinds grhss_and_binds	`thenRn4` \ (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
-    returnRn4 (
-	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)
-  = pushSrcLocRn4 locn			    	  (
-    lookupValue name			`thenRn4` \ name' ->
-    mapAndUnzipRn4 rnMatch matches	`thenRn4` \ (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
-    returnRn4 (
-      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 = addOneToUniqSet acc 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 Name,		-- Set of names defined in this vertex
-      UniqSet Name,		-- 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
-	    -> [ProtoName]	    -- Binders for this decl group
-	    -> [ProtoNameSig]
-	    -> Rn4M [RenamedSig]    -- List of Sig constructors
-
-rnBindSigs is_toplev binder_pnames sigs
-  =
-	 -- Rename the signatures
-	 -- Will complain about sigs for variables not in this group
-    mapRn4 rename_sig sigs   `thenRn4` \ 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
-    mapRn4 (addErrRn4 . dupSigDeclErr) dups `thenRn4_`
-
-    getSrcLocRn4		`thenRn4` \ locn ->
-
-    (if (is_toplev && opt_SigsRequired) then
-	let
-	    sig_frees = catMaybes (map (sig_free sigs) binder_pnames)
-	in
-	mapRn4 (addErrRn4 . missingSigErr locn) sig_frees
-     else
-	returnRn4 []
-    )					    `thenRn4_`
-
-    returnRn4 sigs' -- bad ones and all:
-		    -- we need bindings of *some* sort for every name
-  where
-    rename_sig (Sig v ty pragma src_loc)
-      = pushSrcLocRn4 src_loc 	(
-
-	if not (v `elemByLocalNames` binder_pnames) then
-	   addErrRn4 (unknownSigDeclErr "type signature" v src_loc) `thenRn4_`
-	   returnRn4 Nothing
-	else
-	   lookupValue v				`thenRn4` \ new_v ->
-	   rnPolyType False nullTyVarNamesEnv ty	`thenRn4` \ new_ty ->
-	   recoverQuietlyRn4 noGenPragmas (
-		rnGenPragmas pragma
-	   )					    `thenRn4` \ new_pragma ->
-	   returnRn4 (Just (Sig new_v new_ty new_pragma src_loc))
-	)
-
-    -- and now, the various flavours of value-modifying user-pragmas:
-
-    rename_sig (SpecSig v ty using src_loc)
-      = pushSrcLocRn4 src_loc 	(
-
-	if not (v `elemByLocalNames` binder_pnames) then
-	   addErrRn4 (unknownSigDeclErr "SPECIALIZE pragma" v src_loc) `thenRn4_`
-	   returnRn4 Nothing
-	else
-	   lookupValue v				`thenRn4` \ new_v ->
-	   rnPolyType False nullTyVarNamesEnv ty	`thenRn4` \ new_ty ->
-	   rn_using using				`thenRn4` \ new_using ->
-	   returnRn4 (Just (SpecSig new_v new_ty new_using src_loc))
-	)
-      where
-	rn_using Nothing  = returnRn4 Nothing
-	rn_using (Just x) = lookupValue x `thenRn4` \ new_x ->
-			    returnRn4 (Just new_x)
-
-    rename_sig (InlineSig v src_loc)
-      = pushSrcLocRn4 src_loc 	(
-
-	if not (v `elemByLocalNames` binder_pnames) then
-	   addErrRn4 (unknownSigDeclErr "INLINE pragma" v src_loc) `thenRn4_`
-	   returnRn4 Nothing
-	else
-	   lookupValue v	`thenRn4` \ new_v ->
-	   returnRn4 (Just (InlineSig new_v src_loc))
-	)
-
-    rename_sig (DeforestSig v src_loc)
-      = pushSrcLocRn4 src_loc   (
-
-	if not (v `elemByLocalNames` binder_pnames) then
-	   addErrRn4 (unknownSigDeclErr "DEFOREST pragma" v src_loc) `thenRn4_`
-	   returnRn4 Nothing
-	else
-	   lookupValue v        `thenRn4` \ new_v ->
-	   returnRn4 (Just (DeforestSig new_v src_loc))
-	)
-
-    rename_sig (MagicUnfoldingSig v str src_loc)
-      = pushSrcLocRn4 src_loc 	(
-
-	if not (v `elemByLocalNames` binder_pnames) then
-	   addErrRn4 (unknownSigDeclErr "MAGIC_UNFOLDING pragma" v src_loc) `thenRn4_`
-	   returnRn4 Nothing
-	else
-	   lookupValue v	`thenRn4` \ new_v ->
-	   returnRn4 (Just (MagicUnfoldingSig new_v str src_loc))
-	)
-
-    not_unbound :: RenamedSig -> Bool
-
-    not_unbound (Sig n _ _ _)		  = not (isUnboundName n)
-    not_unbound (SpecSig n _ _ _)	  = not (isUnboundName n)
-    not_unbound (InlineSig n _)		  = not (isUnboundName n)
-    not_unbound (DeforestSig n _)	  = not (isUnboundName n)
-    not_unbound (MagicUnfoldingSig n _ _) = not (isUnboundName n)
-
-    -------------------------------------
-    sig_free :: [ProtoNameSig] -> ProtoName -> Maybe ProtoName
-	-- 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 `eqByLocalName` ny) then Nothing else sig_free rest ny
-    sig_free (_ : rest) ny = sig_free rest ny
-
-    -------------------------------------
-    compare :: RenamedSig -> RenamedSig -> TAG_
-    compare x y = c x y
-
-    c (Sig n1 _ _ _)	    	 (Sig n2 _ _ _)    	    = n1 `cmp` n2
-    c (InlineSig n1 _)  	 (InlineSig n2 _) 	    = n1 `cmp` n2
-    c (MagicUnfoldingSig n1 _ _) (MagicUnfoldingSig n2 _ _) = n1 `cmp` n2
-    c (SpecSig n1 ty1 _ _)	 (SpecSig n2 ty2 _ _)
-      = -- may have many specialisations for one value;
-	-- but not ones that are exactly the same...
-	case (n1 `cmp` n2) of
-	  EQ_   -> cmpPolyType cmp ty1 ty2
-	  other -> other
-
-    c 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(RnBinds4)"
-\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/RnExpr4.lhs b/ghc/compiler/rename/RnExpr4.lhs
deleted file mode 100644
index 99f0b7531d..0000000000
--- a/ghc/compiler/rename/RnExpr4.lhs
+++ /dev/null
@@ -1,407 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-%
-\section[RnExpr4]{Renaming of expressions (pass 4)}
-
-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 RnExpr4 (
-	rnMatch, rnGRHSsAndBinds, rnPat
-
-	-- and to make the interface self-sufficient...
-   ) where
-
-import Ubiq{-uitous-}
-import RnLoop		-- break the RnPass4/RnExpr4/RnBinds4 loops
-
-import HsSyn
-import RdrHsSyn
-import RnHsSyn
-import RnMonad4
-
--- others:
-import Name		( Name(..) )
-import NameTypes	( FullName{-instances-} )
-import Outputable	( isConop )
-import UniqSet		( emptyUniqSet, unitUniqSet,
-			  unionUniqSets, unionManyUniqSets,
-			  UniqSet(..)
-			)
-import Util		( panic )
-\end{code}
-
-
-*********************************************************
-*							*
-\subsection{Patterns}
-*							*
-*********************************************************
-
-\begin{code}
-rnPat ::  ProtoNamePat -> Rn4M RenamedPat
-
-rnPat WildPatIn = returnRn4 WildPatIn
-
-rnPat (VarPatIn name)
-  = lookupValue name	`thenRn4` \ vname ->
-    returnRn4 (VarPatIn vname)
-
-rnPat (LitPatIn n) = returnRn4 (LitPatIn n)
-
-rnPat (LazyPatIn pat)
-  = rnPat pat	`thenRn4` \ pat' ->
-    returnRn4 (LazyPatIn pat')
-
-rnPat (AsPatIn name pat)
-  = rnPat pat	`thenRn4` \ pat' ->
-    lookupValue name	`thenRn4` \ vname ->
-    returnRn4 (AsPatIn vname pat')
-
-rnPat (ConPatIn name pats)
-  = lookupValue name	    `thenRn4` \ name' ->
-    mapRn4 rnPat pats  `thenRn4` \ patslist ->
-    returnRn4 (ConPatIn name' patslist)
-
-rnPat (ConOpPatIn pat1 name pat2)
-  = lookupValue name	`thenRn4` \ name' ->
-    rnPat pat1	`thenRn4` \ pat1' ->
-    rnPat pat2	`thenRn4` \ pat2' ->
-    returnRn4 (ConOpPatIn pat1' name' pat2')
-
-rnPat (ListPatIn pats)
-  = mapRn4 rnPat pats `thenRn4` \ patslist ->
-    returnRn4 (ListPatIn patslist)
-
-rnPat (TuplePatIn pats)
-  = mapRn4 rnPat pats `thenRn4` \ patslist ->
-    returnRn4 (TuplePatIn patslist)
-
-rnPat (RecPatIn con rpats)
-  = panic "rnPat:RecPatIn"
-
-\end{code}
-
-************************************************************************
-*									*
-\subsection{Match}
-*									*
-************************************************************************
-
-\begin{code}
-rnMatch :: ProtoNameMatch -> Rn4M (RenamedMatch, FreeVars)
-
-rnMatch match
-  = getSrcLocRn4			`thenRn4` \ src_loc ->
-    namesFromProtoNames "variable in pattern"
-	 (binders `zip` repeat src_loc)	`thenRn4` \ new_binders ->
-    extendSS2 new_binders (rnMatch_aux match)
-  where
-    binders = collect_binders match
-
-    collect_binders :: ProtoNameMatch -> [ProtoName]
-
-    collect_binders (GRHSMatch _) = []
-    collect_binders (PatMatch pat match)
-      = collectPatBinders pat ++ collect_binders match
-
-rnMatch_aux (PatMatch pat match)
-  = rnPat pat		`thenRn4` \ pat' ->
-    rnMatch_aux match	`thenRn4` \ (match', fvMatch) ->
-    returnRn4 (PatMatch pat' match', fvMatch)
-
-rnMatch_aux (GRHSMatch grhss_and_binds)
-  = rnGRHSsAndBinds grhss_and_binds `thenRn4` \ (grhss_and_binds', fvs) ->
-    returnRn4 (GRHSMatch grhss_and_binds', fvs)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Guarded right-hand sides (GRHSsAndBinds)}
-%*									*
-%************************************************************************
-
-\begin{code}
-rnGRHSsAndBinds :: ProtoNameGRHSsAndBinds -> Rn4M (RenamedGRHSsAndBinds, FreeVars)
-
-rnGRHSsAndBinds (GRHSsAndBindsIn grhss binds)
-  = rnBinds binds			`thenRn4` \ (binds', fvBinds, scope) ->
-    extendSS2 scope (rnGRHSs grhss)	`thenRn4` \ (grhss', fvGRHS) ->
-    returnRn4 (GRHSsAndBindsIn grhss' binds', fvBinds `unionUniqSets` fvGRHS)
-  where
-    rnGRHSs [] = returnRn4 ([], emptyUniqSet)
-
-    rnGRHSs (grhs:grhss)
-      = rnGRHS  grhs   `thenRn4` \ (grhs',  fvs) ->
-	rnGRHSs grhss  `thenRn4` \ (grhss', fvss) ->
-	returnRn4 (grhs' : grhss', fvs `unionUniqSets` fvss)
-
-    rnGRHS (GRHS guard expr locn)
-      = pushSrcLocRn4 locn			      	  (
-	rnExpr guard   `thenRn4` \ (guard', fvsg) ->
-	rnExpr expr	`thenRn4` \ (expr',  fvse) ->
-	returnRn4 (GRHS guard' expr' locn, fvsg `unionUniqSets` fvse)
-	)
-
-    rnGRHS (OtherwiseGRHS expr locn)
-      = pushSrcLocRn4 locn			      	  (
-	rnExpr expr	`thenRn4` \ (expr', fvs) ->
-	returnRn4 (OtherwiseGRHS expr' locn, fvs)
-	)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Expressions}
-%*									*
-%************************************************************************
-
-\begin{code}
-rnExprs :: [ProtoNameHsExpr] -> Rn4M ([RenamedHsExpr], FreeVars)
-
-rnExprs [] = returnRn4 ([], emptyUniqSet)
-
-rnExprs (expr:exprs)
-  = rnExpr expr 	`thenRn4` \ (expr', fvExpr) ->
-    rnExprs exprs	`thenRn4` \ (exprs', fvExprs) ->
-    returnRn4 (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 Name returned from the lookup, and make it part of the
-free-var set iff:
-\begin{itemize}
-\item
-if it's a @Short@,
-\item
-or it's an @ValName@ and it's defined in this module
-(this includes locally-defined constructrs, but that's too bad)
-\end{itemize}
-
-\begin{code}
-rnExpr :: ProtoNameHsExpr -> Rn4M (RenamedHsExpr, FreeVars)
-
-rnExpr (HsVar v)
-  = lookupValue v	`thenRn4` \ vname ->
-    returnRn4 (HsVar vname, fv_set vname)
-  where
-    fv_set n@(Short uniq sname)	    = unitUniqSet n
-    fv_set n@(ValName uniq fname)
-	  | isLocallyDefined fname
-	  && not (isConop (getOccurrenceName fname))
-				    = unitUniqSet n
-    fv_set other  		    = emptyUniqSet
-
-rnExpr (HsLit lit)  = returnRn4 (HsLit lit, emptyUniqSet)
-
-rnExpr (HsLam match)
-  = rnMatch match	`thenRn4` \ (match', fvMatch) ->
-    returnRn4 (HsLam match', fvMatch)
-
-rnExpr (HsApp fun arg)
-  = rnExpr fun		`thenRn4` \ (fun',fvFun) ->
-    rnExpr arg		`thenRn4` \ (arg',fvArg) ->
-    returnRn4 (HsApp fun' arg', fvFun `unionUniqSets` fvArg)
-
-rnExpr (OpApp e1 op e2)
-  = rnExpr e1 		`thenRn4` \ (e1', fvs_e1) ->
-    rnExpr op 		`thenRn4` \ (op', fvs_op) ->
-    rnExpr e2 		`thenRn4` \ (e2', fvs_e2) ->
-    returnRn4 (OpApp e1' op' e2', (fvs_op `unionUniqSets` fvs_e1) `unionUniqSets` fvs_e2)
-
-rnExpr (SectionL expr op)
-  = rnExpr expr	 	`thenRn4` \ (expr', fvs_expr) ->
-    rnExpr op	 	`thenRn4` \ (op', fvs_op) ->
-    returnRn4 (SectionL expr' op', fvs_op `unionUniqSets` fvs_expr)
-
-rnExpr (SectionR op expr)
-  = rnExpr op	 	`thenRn4` \ (op',   fvs_op) ->
-    rnExpr expr	 	`thenRn4` \ (expr', fvs_expr) ->
-    returnRn4 (SectionR op' expr', fvs_op `unionUniqSets` fvs_expr)
-
-rnExpr (CCall fun args may_gc is_casm fake_result_ty)
-  = rnExprs args	 `thenRn4` \ (args', fvs_args) ->
-    returnRn4 (CCall fun args' may_gc is_casm fake_result_ty, fvs_args)
-
-rnExpr (HsSCC label expr)
-  = rnExpr expr	 	`thenRn4` \ (expr', fvs_expr) ->
-    returnRn4 (HsSCC label expr', fvs_expr)
-
-rnExpr (HsCase expr ms src_loc)
-  = pushSrcLocRn4 src_loc $
-    rnExpr expr		 	`thenRn4` \ (new_expr, e_fvs) ->
-    mapAndUnzipRn4 rnMatch ms   `thenRn4` \ (new_ms, ms_fvs) ->
-    returnRn4 (HsCase new_expr new_ms src_loc, unionManyUniqSets (e_fvs : ms_fvs))
-
-rnExpr (HsLet binds expr)
-  = rnBinds binds		`thenRn4` \ (binds', fvBinds, new_binders) ->
-    extendSS2 new_binders (rnExpr expr) `thenRn4` \ (expr',fvExpr) ->
-    returnRn4 (HsLet binds' expr', fvBinds `unionUniqSets` fvExpr)
-
-rnExpr (HsDo stmts src_loc)
-  = pushSrcLocRn4 src_loc $
-    rnStmts stmts		`thenRn4` \ (stmts', fvStmts) ->
-    returnRn4 (HsDo stmts' src_loc, fvStmts)
-
-rnExpr (ListComp expr quals)
-  = rnQuals quals 		`thenRn4` \ ((quals', qual_binders), fvQuals) ->
-    extendSS2 qual_binders (rnExpr expr) `thenRn4` \ (expr', fvExpr) ->
-    returnRn4 (ListComp expr' quals', fvExpr `unionUniqSets` fvQuals)
-
-rnExpr (ExplicitList exps)
-  = rnExprs exps	 `thenRn4` \ (exps', fvs) ->
-    returnRn4  (ExplicitList exps', fvs)
-
-rnExpr (ExplicitTuple exps)
-  = rnExprs exps	 `thenRn4` \ (exps', fvExps) ->
-    returnRn4 (ExplicitTuple exps', fvExps)
-
-rnExpr (RecordCon con rbinds)
-  = panic "rnExpr:RecordCon"
-rnExpr (RecordUpd exp rbinds)
-  = panic "rnExpr:RecordUpd"
-
-rnExpr (ExprWithTySig expr pty)
-  = rnExpr expr			    `thenRn4` \ (expr', fvExpr) ->
-    rnPolyType False nullTyVarNamesEnv pty `thenRn4` \ pty' ->
-    returnRn4 (ExprWithTySig expr' pty', fvExpr)
-
-rnExpr (HsIf p b1 b2 src_loc)
-  = pushSrcLocRn4 src_loc $
-    rnExpr p	`thenRn4` \ (p', fvP) ->
-    rnExpr b1	`thenRn4` \ (b1', fvB1) ->
-    rnExpr b2	`thenRn4` \ (b2', fvB2) ->
-    returnRn4 (HsIf p' b1' b2' src_loc, unionManyUniqSets [fvP, fvB1, fvB2])
-
-rnExpr (ArithSeqIn seq)
-  = rn_seq seq `thenRn4` \ (new_seq, fvs) ->
-    returnRn4 (ArithSeqIn new_seq, fvs)
-  where
-    rn_seq (From expr)
-     = rnExpr expr 	 `thenRn4` \ (expr', fvExpr) ->
-       returnRn4 (From expr', fvExpr)
-
-    rn_seq (FromThen expr1 expr2)
-     = rnExpr expr1 	 `thenRn4` \ (expr1', fvExpr1) ->
-       rnExpr expr2	 `thenRn4` \ (expr2', fvExpr2) ->
-       returnRn4 (FromThen expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
-
-    rn_seq (FromTo expr1 expr2)
-     = rnExpr expr1	 `thenRn4` \ (expr1', fvExpr1) ->
-       rnExpr expr2	 `thenRn4` \ (expr2', fvExpr2) ->
-       returnRn4 (FromTo expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
-
-    rn_seq (FromThenTo expr1 expr2 expr3)
-     = rnExpr expr1	 `thenRn4` \ (expr1', fvExpr1) ->
-       rnExpr expr2	 `thenRn4` \ (expr2', fvExpr2) ->
-       rnExpr expr3	 `thenRn4` \ (expr3', fvExpr3) ->
-       returnRn4 (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 :: [ProtoNameQual]
-	 -> Rn4M (([RenamedQual],	-- renamed qualifiers
-		  [Name]),		-- qualifiers' binders
-		  FreeVars)		-- free variables
-
-rnQuals [qual] 				-- must be at least one qual
-  = rnQual qual `thenRn4` \ ((new_qual, bs), fvs) ->
-    returnRn4 (([new_qual], bs), fvs)
-
-rnQuals (qual: quals)
-  = rnQual qual				`thenRn4` \ ((qual',  bs1), fvQuals1) ->
-    extendSS2 bs1 (rnQuals quals)	`thenRn4` \ ((quals', bs2), fvQuals2) ->
-    returnRn4
-       ((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		 `thenRn4` \ (expr', fvExpr) ->
-    let
-	binders = collectPatBinders pat
-    in
-    getSrcLocRn4		 `thenRn4` \ src_loc ->
-    namesFromProtoNames "variable in list-comprehension-generator pattern"
-	 (binders `zip` repeat src_loc)	  `thenRn4` \ new_binders ->
-    extendSS new_binders (rnPat pat) `thenRn4` \ pat' ->
-
-    returnRn4 ((GeneratorQual pat' expr', new_binders), fvExpr)
-
-rnQual (FilterQual expr)
-  = rnExpr expr	 `thenRn4` \ (expr', fvs) ->
-    returnRn4 ((FilterQual expr', []), fvs)
-
-rnQual (LetQual binds)
-  = rnBinds binds	`thenRn4` \ (binds', binds_fvs, new_binders) ->
-    returnRn4 ((LetQual binds', new_binders), binds_fvs)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{@Stmt@s: in @do@ expressions}
-%*									*
-%************************************************************************
-
-\begin{code}
-rnStmts :: [ProtoNameStmt]
-	-> Rn4M ([RenamedStmt],		-- renamed qualifiers
-	         FreeVars)		-- free variables
-
-rnStmts [stmt@(ExprStmt _ _)]		-- last stmt must be ExprStmt
-  = rnStmt stmt				`thenRn4` \ ((stmt',[]), fvStmt) ->
-    returnRn4 ([stmt'], fvStmt)
-
-rnStmts (stmt:stmts)
-  = rnStmt stmt				`thenRn4` \ ((stmt',bs), fvStmt) ->
-    extendSS2 bs (rnStmts stmts)	`thenRn4` \ (stmts',     fvStmts) ->
-    returnRn4 (stmt':stmts', fvStmt `unionUniqSets` fvStmts)
-
-
-rnStmt (BindStmt pat expr src_loc)
-  = pushSrcLocRn4 src_loc $
-    rnExpr expr		 		`thenRn4` \ (expr', fvExpr) ->
-    let
-	binders = collectPatBinders pat
-    in
-    namesFromProtoNames "variable in do binding"
-	 (binders `zip` repeat src_loc)	`thenRn4` \ new_binders ->
-    extendSS new_binders (rnPat pat) 	`thenRn4` \ pat' ->
-
-    returnRn4 ((BindStmt pat' expr' src_loc, new_binders), fvExpr)
-
-rnStmt (ExprStmt expr src_loc)
-  = 
-    rnExpr expr	 			`thenRn4` \ (expr', fvs) ->
-    returnRn4 ((ExprStmt expr' src_loc, []), fvs)
-
-rnStmt (LetStmt binds)
-  = rnBinds binds	`thenRn4` \ (binds', binds_fvs, new_binders) ->
-    returnRn4 ((LetStmt binds', new_binders), binds_fvs)
-
-\end{code}
diff --git a/ghc/compiler/rename/RnPass1.lhs b/ghc/compiler/rename/RnPass1.lhs
deleted file mode 100644
index bd76c69c48..0000000000
--- a/ghc/compiler/rename/RnPass1.lhs
+++ /dev/null
@@ -1,861 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-%
-\section[RnPass1]{@RnPass1@: gather up imported information}
-
-See the @Rename@ module for a basic description of the renamer.
-
-\begin{code}
-#include "HsVersions.h"
-
-module RnPass1 (
-	rnModule1
-
-	-- for completeness
-    ) where
-
-import Ubiq{-uitous-}
-
-import HsSyn
-import HsPragmas	( DataPragmas(..) )
-import RdrHsSyn		-- ProtoName* instantiations...
-
-import Bag		( emptyBag, unitBag, snocBag, unionBags, Bag )
-import ErrUtils
-import FiniteMap	( lookupFM, listToFM, elementOf )
-import Maybes		( catMaybes, maybeToBool )
-import Name		( Name{-instances-} )
-import Outputable	( isAvarid, getLocalName, interpp'SP )
-import PprStyle		( PprStyle(..) )
-import Pretty
-import ProtoName	( mkPreludeProtoName, ProtoName(..) )
-import RnMonad12
-import RnUtils
-import Util		( lengthExceeds, panic )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Types and things used herein}
-%*									*
-%************************************************************************
-
-@AllIntDecls@ is the type returned from processing import statement(s)
-in the main module.
-
-\begin{code}
-type AllIntDecls = ([ProtoNameFixityDecl], [ProtoNameTyDecl],
-		    [ProtoNameClassDecl],  [ProtoNameInstDecl],
-		    [ProtoNameSig], Bag FAST_STRING)
-\end{code}
-
-The selective-import function @SelectiveImporter@ maps a @ProtoName@
-to something which indicates how much of the thing, if anything, is
-wanted by the importing module.
-\begin{code}
-type SelectiveImporter = ProtoName -> Wantedness
-
-data Wantedness
-  = Wanted
-  | NotWanted
-  | WantedWith (IE ProtoName)
-\end{code}
-
-The @ProtoNames@ supplied to these ``name functions'' are always
-@Unks@, unless they are fully-qualified names, which occur only in
-interface pragmas (and, therefore, never on the {\em definitions} of
-things).  That doesn't happen in @RnPass1@!
-\begin{code}
-type IntNameFun	  = ProtoName -> ProtoName
-type IntTCNameFun = ProtoName -> (ProtoName, IntNameFun)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{First pass over the entire module}
-%*									*
-%************************************************************************
-
-This pass flattens out the declarations embedded within the interfaces
-which this module imports.  The result is a new module with no
-imports, but with more declarations.  The declarations which arose
-from the imported interfaces will have @ProtoNames@ with @Imp@
-constructors; the declarations in the body of this module are
-unaffected, so they will still be @Unk@'s.
-
-We import only the declarations from interfaces which are actually {\em
-used}.  This saves time later, because we don't need process the
-unused ones.
-
-\begin{code}
-rnModule1 :: PreludeNameMappers
-	  -> Bool		-- see use below
-	  -> ProtoNameHsModule
-	  -> Rn12M (ProtoNameHsModule, Bag FAST_STRING)
-
-rnModule1 pnf@(v_pnf, tc_pnf)
-	use_mentioned_vars_heuristic
-	(HsModule mod_name exports imports fixes
-		  ty_decls absty_sigs class_decls inst_decls specinst_sigs
-		  defaults binds _ src_loc)
-
-  =	-- slurp through the *body* of the module, collecting names of
-	-- mentioned *variables*, 3+ letters long & not prelude names.
-	-- Note: we *do* have to pick up top-level binders,
-	-- so we can check for conflicts with imported guys!
-    let
-	is_mentioned_fn = \ x -> True -- wimp way out
-{- OLD:
-	(uses_Mdotdot_in_exports, mentioned_vars)
-	  = getMentionedVars v_pnf exports fixes class_decls inst_decls binds
-
-	-- Using the collected "mentioned" variables, create an
-	-- "is-mentioned" function (:: FAST_STRING -> Bool), which gives
-	-- True if something is mentioned is in the list collected.
-	-- For more details, see under @selectAll@, notably the
-	-- handling of short (< 3 chars) names.
-
-	-- Note: this "is_mentioned" game doesn't work if the export
-	-- list includes any M.. constructs (because that mentions
-	-- variables *implicitly*, basically).  getMentionedVars tells
-	-- us this, and we act accordingly.
-
-	is_mentioned_maybe
-	  = lookupFM (listToFM
-		[ (x, panic "is_mentioned_fn")
-		| x <- mentioned_vars ++ needed_for_deriving ]
-		)
-	  where
-	    needed_for_deriving	-- is this a HACK or what?
-	      = [ SLIT("&&"),
-		  SLIT("."),
-		  SLIT("lex"),
-		  SLIT("map"),
-		  SLIT("not"),
-		  SLIT("readParen"),
-		  SLIT("showParen"),
-		  SLIT("showSpace__"),
-		  SLIT("showString")
-		]
-
-	is_mentioned_fn
-	  = if use_mentioned_vars_heuristic
-	    && not (uses_Mdotdot_in_exports)
-	    then \ x -> maybeToBool (is_mentioned_maybe x)
-	    else \ x -> True
--}
-    in
-	-- OK, now do the business:
-    doImportedIfaces pnf is_mentioned_fn imports
-		 `thenRn12`  \ (int_fixes, int_ty_decls,
-				int_class_decls, int_inst_decls,
-				int_sigs, import_names) ->
-    let
-	inst_decls' = doRevoltingInstDecls tc_nf inst_decls
-    in
-    returnRn12
-	 ((HsModule mod_name
-		    exports imports -- passed along mostly for later checking
-		    (int_fixes ++ fixes)
-		    (int_ty_decls ++ ty_decls)
-		    absty_sigs
-		    (int_class_decls ++ class_decls)
-		    (int_inst_decls  ++ inst_decls')
-		    specinst_sigs
-		    defaults
-		    binds
-		    int_sigs
-		    src_loc),
-	  import_names)
-  where
-    -- This function just spots prelude names
-    tc_nf pname@(Unk s) = case (tc_pnf s) of
-			   Nothing   -> pname
-			   Just name -> Prel name
-
-    tc_nf other_pname	= panic "In tc_nf passed to doRevoltingInstDecls"
-	-- The only place where Imps occur is on Ids in unfoldings;
-	-- this function is only used on type-things.
-\end{code}
-
-Instance declarations in the module itself are treated in a horribly
-special way.  Because their class name and type constructor will be
-compared against imported ones in the second pass (to eliminate
-duplicate instance decls) we need to make Prelude classes and tycons
-appear as such.  (For class and type decls, the module can't be
-declaring a prelude class or tycon, so Prel and Unk things can just
-compare non-equal.)  This is a HACK.
-
-\begin{code}
-doRevoltingInstDecls :: IntNameFun -> [ProtoNameInstDecl] -> [ProtoNameInstDecl]
-
-doRevoltingInstDecls tc_nf decls
-  = map revolt_me decls
-  where
-    revolt_me (InstDecl cname ty binds True modname uprags pragma src_loc)
-      = InstDecl
-	    (tc_nf cname)		-- Look up the class
-	    (doIfacePolyType1 tc_nf ty)	-- Ditto the type
-	    binds			-- Binds unchanged
-	    True{-yes,defined in this module-}
-	    modname
-	    uprags
-	    pragma
-	    src_loc
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Process a module's imported interfaces}
-%*									*
-%************************************************************************
-
-@doImportedIfaces@ processes the entire set of interfaces imported by the
-module being renamed.
-
-\begin{code}
-doImportedIfaces :: PreludeNameMappers
-	      -> (FAST_STRING -> Bool)
-	      -> [ProtoNameImportedInterface]
-	      -> Rn12M AllIntDecls
-
-doImportedIfaces pnfs is_mentioned_fn []
-  = returnRn12 ( [{-fixities-}],  [{-tydecls-}], [{-clasdecls-}],
-		 [{-instdecls-}], [{-sigs-}], emptyBag )
-
-doImportedIfaces pnfs is_mentioned_fn (iface:ifaces)
-  = doOneIface  pnfs is_mentioned_fn iface
-			 `thenRn12` \ (ifixes1, itd1, icd1, iid1, isd1, names1) ->
-
-    doImportedIfaces pnfs is_mentioned_fn ifaces
-			 `thenRn12` \ (ifixes2, itd2, icd2, iid2, isd2, names2) ->
-
-    returnRn12 (ifixes1 ++ ifixes2,
-		itd1 ++ itd2,
-		icd1 ++ icd2,
-		iid1 ++ iid2,
-		isd1 ++ isd2,
-		names1 `unionBags` names2)
-\end{code}
-
-\begin{code}
-doOneIface :: PreludeNameMappers
-	   -> (FAST_STRING -> Bool)
-	   -> ProtoNameImportedInterface
-	   -> Rn12M AllIntDecls
-
-doOneIface _ _ (ImportMod _ True{-qualified-} _ _)
-  = panic "RnPass1.doOneIface:can't grok `qualified'"
-
-doOneIface _ _ (ImportMod _ _ (Just _) _)
-  = panic "RnPass1.doOneIface:can't grok `as' module (blech)"
-
-doOneIface pnfs is_mentioned_fn (ImportMod iface qual asmod Nothing{-all-})
-  = doIface1 pnfs (selectAll is_mentioned_fn) iface
-
-doOneIface pnfs _ (ImportMod iface qual asmod (Just (False{-unhidden-}, ies)))
-  = doIface1 pnfs si_fun iface
-  where
-    -- the `selective import' function should not be applied
-    -- to the Imps that occur on Ids in unfoldings.
-
-    si_fun (Unk    n) = check_ie n ies
-    si_fun (Qunk _ n) = check_ie n ies
-
-    check_ie name [] = NotWanted
-    check_ie name (ie:ies)
-      = case ie of
-	  IEVar (Unk n)	     | name == n -> Wanted
-	  IEThingAbs (Unk n) | name == n -> WantedWith ie
-	  IEThingAll (Unk n) | name == n -> WantedWith ie
-	  IEModuleContents _ -> panic "Module.. in import list?"
-	  other		     -> check_ie name ies
-
-doOneIface pnfs _ (ImportMod iface qual asmod (Just (True{-hidden-}, ies)))
-  = doIface1 pnfs si_fun iface
-  where
-    -- see comment above:
-
-    si_fun x | n `elementOf` entity_info = NotWanted
-	     | otherwise		 = Wanted
-      where
-	n = case x of { Unk s -> s; Qunk _ s -> s }
-
-    entity_info = getImportees ies
-\end{code}
-
-@selectAll@ ``normally'' creates an @SelectiveImporter@ that declares
-everything from an interface to be @Wanted@.  We may, however, pass
-in a more discriminating @is_mentioned_fn@ (returns @True@ if the
-named entity is mentioned in the body of the module in question), which
-can be used to trim off junk from an interface.
-
-For @selectAll@ to say something is @NotWanted@, it must be a
-variable, it must not be in the collected-up list of mentioned
-variables (checked with @is_mentioned_fn@), and it must be three chars
-or longer.
-
-And, of course, we mustn't forget to take account of renaming!
-
-ADR Question: What's so magical about names longer than 3 characters?
-Why would we want to keep long names which aren't mentioned when we're
-quite happy to throw away short names that aren't mentioned?
-
-\begin{code}
-selectAll :: (FAST_STRING -> Bool) -> SelectiveImporter
-
-selectAll is_mentioned_fn n
-  = let
-	rn_str = case n of { Unk s -> s ; Qunk _ s -> s }
-    in
-    if (isAvarid rn_str)
-    && (not (is_mentioned_fn rn_str))
-    && (_UNPK_ rn_str `lengthExceeds` 2)
-    then NotWanted
-    else Wanted
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{First pass over a particular interface}
-%*									*
-%************************************************************************
-
-
-@doIface1@ handles a specific interface. First it looks at the
-interface imports, creating a bag that maps local names back to their
-original names, from which it makes a function that does the same. It
-then uses this function to create a triple of bags for the interface
-type, class and value declarations, in which local names have been
-mapped back into original names.
-
-Notice that @mkLocalNameFun@ makes two different functions. The first
-is the name function for the interface. This takes a local name and
-provides an original name for any name in the interface by using
-either of:
-\begin{itemize}
-\item
-the original name produced by the renaming function;
-\item
-the local name in the interface and the interface name.
-\end{itemize}
-
-The function @doIfaceImports1@ receives two association lists which will
-be described at its definition.
-
-\begin{code}
-doIface1 :: PreludeNameMappers
-	 -> SelectiveImporter
-	 -> ProtoNameInterface
-	 -> Rn12M AllIntDecls
-
-doIface1 (v_pnf, tc_pnf) sifun
-       (Interface i_name import_decls fix_decls ty_decls class_decls
-		    inst_decls sig_decls anns)
-
-  = doIfaceImports1 (panic "i_name"{-i_name-}) import_decls	`thenRn12` \ (v_bag, tc_bag) ->
-    do_body (v_bag, tc_bag)
-  where
-    do_body (v_bag, tc_bag)
-      = report_all_errors			`thenRn12` \ _ ->
-
-	doIfaceTyDecls1    sifun full_tc_nf ty_decls	`thenRn12` \ ty_decls' ->
-
-	doIfaceClassDecls1 sifun full_tc_nf class_decls  `thenRn12` \ class_decls' ->
-
-	let sig_decls'	= doIfaceSigs1      sifun v_nf tc_nf sig_decls
-	    fix_decls'	= doIfaceFixes1     sifun v_nf       fix_decls
-	    inst_decls'	= doIfaceInstDecls1 sifun      tc_nf inst_decls
-	in
-	returnRn12 (fix_decls', ty_decls', class_decls', inst_decls', sig_decls', unitBag i_name)
-      where
-	v_dups  :: [[(FAST_STRING, ProtoName)]]
-	tc_dups :: [[(FAST_STRING, (ProtoName, IntNameFun))]]
-
-	(imp_v_nf, v_dups)   = mkNameFun v_bag
-	(imp_tc_nf, tc_dups) = mkNameFun tc_bag
-
-	v_nf :: IntNameFun
-	v_nf (Unk s) = case v_pnf s of
-			 Just n	 -> mkPreludeProtoName n
-			 Nothing -> case imp_v_nf s of
-				      Just n  -> n
-				      Nothing -> Imp i_name s [i_name] s
-
-		-- used for (..)'d parts of prelude datatype/class decls
-	prel_con_or_op_nf  :: FAST_STRING{-module name-}-> IntNameFun
-	prel_con_or_op_nf m (Unk s)
-	  = case v_pnf s of
-	      Just n  -> mkPreludeProtoName n
-	      Nothing -> Imp m s [m] s
-			 -- Strictly speaking, should be *no renaming* here, folks
-
-		-- used for non-prelude constructors/ops/fields
-	local_con_or_op_nf :: IntNameFun
-	local_con_or_op_nf (Unk s) = Imp i_name s [i_name] s
-
-	full_tc_nf :: IntTCNameFun
-	full_tc_nf (Unk s)
-	  = case tc_pnf s of
-	      Just n  -> (mkPreludeProtoName n,
-			  let
-			      mod = fst (getOrigName n)
-			  in
-			  prel_con_or_op_nf mod)
-
-	      Nothing -> case imp_tc_nf s of
-			  Just pair -> pair
-			  Nothing   -> (Imp i_name s [i_name] s,
-					local_con_or_op_nf)
-
-	tc_nf = fst . full_tc_nf
-
-	-- ADR: commented out next new lines because I don't believe
-	-- ADR: the check is useful or required by the Standard. (It
-	-- ADR: also messes up the interpreter.)
-
-	tc_errs = [] -- map (map (fst . snd)) tc_dups
-		  -- Ugh! Just keep the dup'd protonames
-	v_errs	= [] -- map (map snd) v_dups
-		  -- Ditto
-
-	report_all_errors
-	  = mapRn12 (addErrRn12 . duplicateImportsInInterfaceErr (_UNPK_ i_name))
-		    (tc_errs ++ v_errs)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{doIfaceImports1}
-%*									*
-%************************************************************************
-
-@ImportNameBags@ is a pair of bags (one for values, one for types and
-classes) which specify the new names brought into scope by some
-import declarations in an interface.
-
-\begin{code}
-type ImportNameBags = (Bag (FAST_STRING, ProtoName),
-		       Bag (FAST_STRING, (ProtoName, IntNameFun))
-		      )
-\end{code}
-
-\begin{code}
-doIfaceImports1
-	:: FAST_STRING			-- name of module whose interface we're doing
-	-> [IfaceImportDecl ProtoName]
-	-> Rn12M ImportNameBags
-
-doIfaceImports1 _  [] = returnRn12 (emptyBag, emptyBag)
-
-doIfaceImports1 int_mod_name (imp_decl1 : rest)
-  = do_decl			 imp_decl1  `thenRn12` \ (vb1, tcb1) ->
-    doIfaceImports1 int_mod_name rest	    `thenRn12` \ (vb2, tcb2) ->
-    returnRn12 (vb1 `unionBags` vb2, tcb1 `unionBags` tcb2)
-  where
-    do_decl (IfaceImportDecl orig_mod_name imports src_loc)
-      =		-- Look at the renamings to get a suitable renaming function
-	doRenamings{-not really-} int_mod_name orig_mod_name
-				    `thenRn12` \ (orig_to_pn, local_to_pn) ->
-
-	    -- Now deal with one import at a time, combining results.
-	returnRn12 (
-	  foldl (doIfaceImport1 orig_to_pn local_to_pn)
-		(emptyBag, emptyBag)
-		imports
-	)
-\end{code}
-
-@doIfaceImport1@ takes a list of imports and the pair of renaming functions,
-returning a bag which maps local names to original names.
-
-\begin{code}
-doIfaceImport1 :: ( ProtoName	    -- Original local name
-		 -> (FAST_STRING,   -- Local name in this interface
-		     ProtoName)	    -- Its full protoname
-		)
-
-	     -> IntNameFun	    -- Local name to ProtoName; use for
-				    --   constructors and class ops
-
-	     -> ImportNameBags	    -- Accumulator
-	     -> (IE ProtoName)	    -- An item in the import list 
-	     -> ImportNameBags
-
-doIfaceImport1 orig_to_pn local_to_pn (v_bag, tc_bag) (IEVar orig_name)
-  = (v_bag `snocBag` (orig_to_pn orig_name), tc_bag)
-
-doIfaceImport1 orig_to_pn local_to_pn acc (IEThingAbs orig_name)
-  = int_import1_help orig_to_pn local_to_pn acc orig_name
-
-doIfaceImport1 orig_to_pn local_to_pn acc (IEThingAll orig_name)
-  = int_import1_help orig_to_pn local_to_pn acc orig_name
-
--- the next ones will go away with 1.3:
-{- OLD:
-doIfaceImport1 orig_to_pn local_to_pn acc (IEConWithCons orig_name _)
-  = int_import1_help orig_to_pn local_to_pn acc orig_name
-
-doIfaceImport1 orig_to_pn local_to_pn acc (IEClsWithOps orig_name _)
-  = int_import1_help orig_to_pn local_to_pn acc orig_name
--}
-
-doIfaceImport1 orig_to_pn local_to_pn (v_bag, tc_bag) other
-  = panic "RnPass1: strange import decl"
-
--- Little help guy...
-
-int_import1_help orig_to_pn local_to_pn (v_bag, tc_bag) orig_name
-  = case (orig_to_pn orig_name) of { (str, o_name) ->
-    (v_bag, tc_bag `snocBag` (str, (o_name, local_to_pn)))
-    }
-\end{code}
-
-
-The renaming-processing code.  It returns two name-functions. The
-first maps the {\em original} name for an entity onto a @ProtoName@
---- it is used when running over the list of things to be imported.
-The second maps the {\em local} name for a constructor or class op
-back to its original name --- it is used when scanning the RHS of
-a @data@ or @class@ decl.
-
-It can produce errors, if there is a domain clash on the renamings.
-
-\begin{code}
-doRenamings :: FAST_STRING	-- Name of the module whose interface we're working on
-	    -> FAST_STRING	-- Original-name module for these renamings
-	    -> Rn12M
-		((ProtoName	     -- Original local name to...
-		    -> (FAST_STRING, -- ... Local name in this interface
-			ProtoName)   -- ... Its full protoname
-		 ),
-		 IntNameFun)	     -- Use for constructors, class ops
-
-doRenamings int_mod orig_mod
-  = returnRn12 (
-      \ (Unk s) ->
-	let
-	    result = (s, Imp orig_mod s [int_mod] s)
-	in
-	result
-	,
-
-      \ (Unk s) ->
-	let
-	    result = Imp orig_mod s [int_mod] s
-	in
-	result
-    )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Type declarations}
-%*									*
-%************************************************************************
-
-@doIfaceTyDecls1@ uses the `name function' to map local tycon names into
-original names, calling @doConDecls1@ to do the same for the
-constructors. @doTyDecls1@ is used to do both module and interface
-type declarations.
-
-\begin{code}
-doIfaceTyDecls1 :: SelectiveImporter
-	      -> IntTCNameFun
-	      -> [ProtoNameTyDecl]
-	      -> Rn12M [ProtoNameTyDecl]
-
-doIfaceTyDecls1 sifun full_tc_nf ty_decls
-  = mapRn12 do_decl ty_decls `thenRn12` \ decls_maybe ->
-    returnRn12 (catMaybes decls_maybe)
-  where
-    do_decl (TySynonym tycon tyvars monoty src_loc)
-      = let
-	    full_thing = returnRn12 (Just ty_decl')
-	in
-	case (sifun tycon) of
-	  NotWanted		    -> returnRn12 Nothing
-	  Wanted		    -> full_thing
-	  WantedWith (IEThingAll _) -> full_thing
-
-	  WantedWith weird_ie	    -> full_thing
-      where
-	(tycon_name,_) = full_tc_nf tycon
-	tc_nf	= fst . full_tc_nf
-	monoty'	= doIfaceMonoType1 tc_nf monoty
-	ty_decl' = TySynonym tycon_name tyvars monoty' src_loc
-
-    do_decl (TyData context tycon tyvars condecls derivs pragmas src_loc)
-      = do_data context tycon condecls derivs pragmas src_loc `thenRn12` \ done_data ->
-	case done_data of
-	  Nothing -> returnRn12 Nothing
-	  Just (context', tycon', condecls', derivs', pragmas') ->
-	     returnRn12 (Just (TyData context' tycon' tyvars condecls' derivs' pragmas' src_loc))
-
-    do_decl (TyNew context tycon tyvars condecl derivs pragmas src_loc)
-      = do_data context tycon condecl derivs pragmas src_loc `thenRn12` \ done_data ->
-	case done_data of
-	  Nothing -> returnRn12 Nothing
-	  Just (context', tycon', condecl', derivs', pragmas') ->
-	     returnRn12 (Just (TyNew context' tycon' tyvars condecl' derivs' pragmas' src_loc))
-
-    --------------------------------------------
-    do_data context tycon condecls derivs (DataPragmas hidden_cons specs) src_loc
-      = let
-	    full_thing = Just (context', tycon_name, condecls', deriv', (pragmas' False))
-	    abs_thing  = Just (context', tycon_name, [],        deriv', (pragmas' True))
-	in
-	case (sifun tycon) of
-	  NotWanted			-> returnRn12 Nothing
-	  Wanted			-> returnRn12 full_thing
-	  WantedWith (IEThingAll _)	-> returnRn12 full_thing
-	  WantedWith (IEThingAbs _)	-> returnRn12 abs_thing
-
-	  WantedWith really_weird_ie -> -- probably a typo in the pgm
-	    addErrRn12 (weirdImportExportConstraintErr
-			tycon really_weird_ie src_loc) `thenRn12` \ _ ->
-	    returnRn12 full_thing
-      where
-	(tycon_name, constrfield_nf) = full_tc_nf tycon
-	tc_nf	    		     = fst . full_tc_nf
-
-	condecls'    = map (do_condecl constrfield_nf tc_nf) condecls
-	hidden_cons' = map (do_condecl constrfield_nf tc_nf) hidden_cons
-
-	pragmas' invent_hidden
-    	  = DataPragmas (if null hidden_cons && invent_hidden
-			 then condecls'  -- if importing abstractly but condecls were
-			                 -- exported we add them to the data pragma
-			 else hidden_cons')
-			specs {- ToDo: do_specs -}
-
-	context'    = doIfaceContext1 tc_nf context
-	deriv'	    = case derivs of
-			Nothing -> Nothing
-			Just ds -> panic "doIfaceTyDecls1:derivs" -- Just (map tc_nf ds)
-								  -- rename derived classes
-
-    --------------------------------------------
-    -- one name fun for the data constructor, another for the type:
-
-    do_condecl cf_nf tc_nf (ConDecl name tys src_loc)
-      = ConDecl (cf_nf name) (map (do_bang tc_nf) tys) src_loc
-
-    do_condecl cf_nf tc_nf (ConOpDecl ty1 op ty2 src_loc)
-      = ConOpDecl (do_bang tc_nf ty1) (cf_nf op) (do_bang tc_nf ty2) src_loc
-
-    do_condecl cf_nf tc_nf (NewConDecl name ty src_loc)
-      = NewConDecl (cf_nf name) (doIfaceMonoType1 tc_nf ty) src_loc
-
-    do_condecl cf_nf tc_nf (RecConDecl con fields src_loc)
-      = RecConDecl (cf_nf con) (map do_field fields) src_loc
-      where
-	do_field (vars, ty) = (map cf_nf vars, do_bang tc_nf ty)
-
-    --------------------------------------------
-    do_bang tc_nf (Banged   ty) = Banged   (doIfaceMonoType1 tc_nf ty)
-    do_bang tc_nf (Unbanged ty) = Unbanged (doIfaceMonoType1 tc_nf ty)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Class declarations}
-%*									*
-%************************************************************************
-
-@doIfaceClassDecls1@ uses the `name function' to map local class names into
-original names, calling @doIfaceClassOp1@ to do the same for the
-class operations. @doClassDecls1@ is used to process both module and
-interface class declarations.
-
-\begin{code}
-doIfaceClassDecls1 ::  SelectiveImporter
-		 -> IntTCNameFun
-		 -> [ProtoNameClassDecl]
-		 -> Rn12M [ProtoNameClassDecl]
-
-doIfaceClassDecls1 sifun full_tc_nf clas_decls
-  = mapRn12 do_decl clas_decls `thenRn12` \ decls_maybe ->
-    returnRn12 (catMaybes decls_maybe)
-  where
-    do_decl (ClassDecl ctxt cname tyvar sigs bs@EmptyMonoBinds prags locn)
-				     -- No defaults in interface
-      = let
-	    full_thing = returnRn12 (Just class_decl')
-	in
-	case (sifun cname) of
-	  NotWanted			-> returnRn12 Nothing
-	  Wanted			-> full_thing
-	  WantedWith (IEThingAll _)	-> full_thing
-	  -- ToDo: add checking of IEClassWithOps
-	  WantedWith really_weird_ie	-> -- probably a typo in the pgm
-	    addErrRn12 (weirdImportExportConstraintErr
-			cname really_weird_ie locn) `thenRn12` \ _ ->
-	    full_thing
-      where
-	(clas, op_nf) = full_tc_nf cname
-	tc_nf = fst . full_tc_nf
-
-	sigs' = map (doIfaceClassOp1 op_nf tc_nf) sigs
-	ctxt' = doIfaceContext1 tc_nf ctxt
-
-	class_decl'     = ClassDecl ctxt' clas tyvar sigs' bs prags locn
-	abs_class_decl' = ClassDecl ctxt' clas tyvar []    bs prags locn
-\end{code}
-
-\begin{code}
-doIfaceClassOp1 :: IntNameFun	-- Use this for the class ops
-	      -> IntNameFun	-- Use this for the types
-	      -> ProtoNameClassOpSig
-	      -> ProtoNameClassOpSig
-
-doIfaceClassOp1 op_nf tc_nf (ClassOpSig v ty pragma src_loc)
-  = ClassOpSig (op_nf v) (doIfacePolyType1 tc_nf ty) pragma src_loc
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Instance declarations}
-%*									*
-%************************************************************************
-
-We select the instance decl if either the class or the type constructor
-are selected.
-
-\begin{code}
-doIfaceInstDecls1 :: SelectiveImporter
-		-> IntNameFun
-		-> [ProtoNameInstDecl]
-		-> [ProtoNameInstDecl]
-
-doIfaceInstDecls1 si tc_nf inst_decls
-  = catMaybes (map do_decl inst_decls)
-  where
-    do_decl (InstDecl cname ty EmptyMonoBinds False modname uprags pragmas src_loc)
-      = case (si cname, tycon_reqd) of
-	  (NotWanted, NotWanted) -> Nothing
-	  _			 -> Just inst_decl'
-     where
-       ty'	= doIfacePolyType1 tc_nf ty
-
-       inst_decl' = InstDecl (tc_nf cname) ty' EmptyMonoBinds False modname uprags pragmas src_loc
-
-       tycon_reqd = _trace "RnPass1.tycon_reqd" NotWanted
-{- LATER:
-	 = case getNonPrelOuterTyCon ty of
-	     Nothing -> NotWanted    -- Type doesn't have a user-defined tycon
-				     -- at its outermost level
-	     Just tycon -> si tycon  -- It does, so look up in the si-fun
--}
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Signature declarations}
-%*									*
-%************************************************************************
-
-@doIfaceSigs1@ uses the name function to create a bag that
-maps local names into original names.
-
-NB: Can't have user-pragmas & other weird things in interfaces.
-
-\begin{code}
-doIfaceSigs1 :: SelectiveImporter -> IntNameFun -> IntNameFun
-	   -> [ProtoNameSig]
-	   -> [ProtoNameSig]
-
-doIfaceSigs1 si v_nf tc_nf sigs
-  = catMaybes (map do_sig sigs)
-  where
-    do_sig (Sig v ty pragma src_loc)
-      = case (si v) of
-	  NotWanted -> Nothing
-	  Wanted    -> Just (Sig (v_nf v) (doIfacePolyType1 tc_nf ty) pragma src_loc)
-	  -- WantedWith doesn't make sense
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Fixity declarations}
-%*									*
-%************************************************************************
-
-\begin{code}
-doIfaceFixes1 :: SelectiveImporter -> IntNameFun
-	    -> [ProtoNameFixityDecl]
-	    -> [ProtoNameFixityDecl]
-
-doIfaceFixes1 si vnf fixities
-  = catMaybes (map do_fixity fixities)
-  where
-    do_fixity (InfixL name i) = do_one InfixL name i
-    do_fixity (InfixR name i) = do_one InfixR name i
-    do_fixity (InfixN name i) = do_one InfixN name i
-
-    do_one con name i
-      = case si name of
-	  Wanted    -> Just (con (vnf name) i)
-	  NotWanted -> Nothing
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{doContext, MonoTypes, MonoType, Polytype}
-%*									*
-%************************************************************************
-
-\begin{code}
-doIfacePolyType1 :: IntNameFun -> ProtoNamePolyType -> ProtoNamePolyType
-
-doIfacePolyType1 tc_nf (HsPreForAllTy ctxt ty)
-  = HsPreForAllTy (doIfaceContext1 tc_nf ctxt) (doIfaceMonoType1 tc_nf ty)
-
-doIfacePolyType1 tc_nf (HsForAllTy tvs ctxt ty)
-  = HsForAllTy tvs (doIfaceContext1 tc_nf ctxt) (doIfaceMonoType1 tc_nf ty)
-\end{code}
-
-\begin{code}
-doIfaceContext1 :: IntNameFun -> ProtoNameContext -> ProtoNameContext
-doIfaceContext1 tc_nf  context = [(tc_nf clas, tyvar) | (clas,tyvar) <- context]
-\end{code}
-
-
-\begin{code}
-doIfaceMonoType1 :: IntNameFun -> ProtoNameMonoType -> ProtoNameMonoType
-
-doIfaceMonoType1 tc_nf tv@(MonoTyVar _) = tv
-
-doIfaceMonoType1 tc_nf (MonoListTy ty)
-  = MonoListTy (doIfaceMonoType1 tc_nf ty)
-
-doIfaceMonoType1 tc_nf (MonoFunTy ty1 ty2)
-  = MonoFunTy (doIfaceMonoType1 tc_nf ty1) (doIfaceMonoType1 tc_nf ty2)
-
-doIfaceMonoType1 tc_nf (MonoTupleTy tys)
-  = MonoTupleTy (map (doIfaceMonoType1 tc_nf) tys)
-
-doIfaceMonoType1 tc_nf (MonoTyApp name tys)
-  = MonoTyApp (tc_nf name) (map (doIfaceMonoType1 tc_nf) tys)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Error messages}
-%*									*
-%************************************************************************
-
-\begin{code}
-duplicateImportsInInterfaceErr iface dups
-  = panic "duplicateImportsInInterfaceErr: NOT DONE YET?"
-
-weirdImportExportConstraintErr thing constraint locn
-  = addShortErrLocLine locn ( \ sty ->
-    ppBesides [ppStr "Illegal import/export constraint on `",
-	       ppr sty thing,
-	       ppStr "': ", ppr PprForUser constraint])
-\end{code}
diff --git a/ghc/compiler/rename/RnPass4.lhs b/ghc/compiler/rename/RnPass4.lhs
deleted file mode 100644
index 5006d17290..0000000000
--- a/ghc/compiler/rename/RnPass4.lhs
+++ /dev/null
@@ -1,882 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-%
-\section[RnPass4]{Fourth of the renaming passes}
-
-\begin{code}
-#include "HsVersions.h"
-
-module RnPass4 ( rnModule, rnPolyType, rnGenPragmas ) where
-
-import Ubiq{-uitous-}
-import RnLoop -- *check* the RnPass4/RnExpr4/RnBinds4 loop-breaking
-
-import HsSyn
-import RdrHsSyn
-import RnHsSyn
-import HsPragmas	-- all of it
-import HsCore		-- all of it
-import RnMonad4
-
-import Class		( derivableClassKeys )
-import Maybes		( maybeToBool, catMaybes )
-import Name		( Name(..) )
-import Outputable	( Outputable(..), isAvarid )
-import Pretty		( ppHang, ppStr, ppCat, ppAboves )
-import ProtoName	( eqProtoName, elemProtoNames, ProtoName{-instance-} )
-import RnBinds4		( rnTopBinds, rnMethodBinds )
-import SrcLoc		( SrcLoc{-instance-} )
-import Unique		( Unique{-instances-} )
-import UniqSet		( UniqSet(..) )
-import Util		( isIn, panic, assertPanic )
-\end{code}
-
-This pass `renames' the module+imported info, simultaneously
-performing dependency analysis. 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 local variables are defined.
-\end{enumerate}
-
-\begin{code}
-rnModule :: ProtoNameHsModule -> Rn4M RenamedHsModule
-
-rnModule (HsModule mod_name exports _ fixes ty_decls specdata_sigs
-	    class_decls inst_decls specinst_sigs defaults
-	    binds int_sigs src_loc)
-
-  = pushSrcLocRn4 src_loc			  (
-
-    mapRn4 rnTyDecl	    ty_decls	    `thenRn4` \ new_ty_decls ->
-    mapRn4 rnSpecDataSig    specdata_sigs   `thenRn4` \ new_specdata_sigs ->
-    mapRn4 rnClassDecl	    class_decls	    `thenRn4` \ new_class_decls ->
-    mapRn4 rnInstDecl	    inst_decls	    `thenRn4` \ new_inst_decls ->
-    mapRn4 rnSpecInstSig    specinst_sigs   `thenRn4` \ new_specinst_sigs ->
-    rnDefaultDecl	    defaults	    `thenRn4` \ new_defaults ->
-    rnTopBinds binds			    `thenRn4` \ new_binds ->
-    mapRn4 rnIntSig	    int_sigs	    `thenRn4` \ new_int_sigs ->
-    rnFixes fixes			    `thenRn4` \ new_fixes ->
-    rnExports exports			    `thenRn4` \ new_exports ->
-
-    returnRn4 (HsModule mod_name
-		new_exports [{-imports finally clobbered-}] new_fixes
-		new_ty_decls new_specdata_sigs new_class_decls
-		new_inst_decls new_specinst_sigs new_defaults
-		new_binds new_int_sigs src_loc)
-    )
-
-rnExports Nothing = returnRn4 Nothing
-rnExports (Just exp_list)
-  = returnRn4 (Just (_trace "rnExports:trashing exports" []))
-\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 :: ProtoNameTyDecl -> Rn4M RenamedTyDecl
-
-rnTyDecl (TyData context tycon tyvars condecls derivings pragmas src_loc)
-  = pushSrcLocRn4 src_loc		        (
-    lookupTyCon tycon		      `thenRn4` \ tycon' ->
-    mkTyVarNamesEnv src_loc tyvars    `thenRn4` \ (tv_env, tyvars') ->
-    rnContext tv_env context	      `thenRn4` \ context' ->
-    rnConDecls tv_env False condecls `thenRn4` \ condecls' ->
-    rn_derivs tycon' src_loc derivings `thenRn4` \ derivings' ->
-    recoverQuietlyRn4 (DataPragmas [] []) (
-	rnDataPragmas tv_env pragmas
-    )				      `thenRn4` \ pragmas' ->
-    returnRn4 (TyData context' tycon' tyvars' condecls' derivings' pragmas' src_loc)
-    )
-
-rnTyDecl (TyNew context tycon tyvars condecl derivings pragmas src_loc)
-  = pushSrcLocRn4 src_loc		        (
-    lookupTyCon tycon		      `thenRn4` \ tycon' ->
-    mkTyVarNamesEnv src_loc tyvars    `thenRn4` \ (tv_env, tyvars') ->
-    rnContext tv_env context	      `thenRn4` \ context' ->
-    rnConDecls tv_env False condecl   `thenRn4` \ condecl' ->
-    rn_derivs tycon' src_loc derivings `thenRn4` \ derivings' ->
-    recoverQuietlyRn4 (DataPragmas [] []) (
-	rnDataPragmas tv_env pragmas
-    )				      `thenRn4` \ pragmas' ->
-    returnRn4 (TyNew context' tycon' tyvars' condecl' derivings' pragmas' src_loc)
-    )
-
-rnTyDecl (TySynonym name tyvars ty src_loc)
-  = pushSrcLocRn4 src_loc		      (
-    lookupTyCon name		    `thenRn4` \ name' ->
-    mkTyVarNamesEnv src_loc tyvars  `thenRn4` \ (tv_env, tyvars') ->
-    rnMonoType False{-no invisible types-} tv_env ty
-				    `thenRn4` \ ty' ->
-    returnRn4 (TySynonym name' tyvars' ty' src_loc)
-    )
-
-rn_derivs tycon2 locn Nothing -- derivs not specified
-  = returnRn4 Nothing
-
-rn_derivs tycon2 locn (Just ds)
-  = mapRn4 (rn_deriv tycon2 locn) ds `thenRn4` \ derivs ->
-    returnRn4 (Just derivs)
-  where
-    rn_deriv tycon2 locn clas
-      = lookupClass clas	    `thenRn4` \ clas_name ->
-	case clas_name of
-	  ClassName key _ _ | key `is_elem` derivableClassKeys
-	    -> returnRn4 clas_name
-	  _ -> addErrRn4 (derivingNonStdClassErr clas locn) `thenRn4_`
-	       returnRn4 clas_name
-      where
-	is_elem = isIn "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
-	    -> Bool		    -- True <=> allowed to see invisible data-cons
-	    -> [ProtoNameConDecl]
-	    -> Rn4M [RenamedConDecl]
-
-rnConDecls tv_env invisibles_allowed con_decls
-  = mapRn4 rn_decl con_decls
-  where
-    lookup_fn
-      = if invisibles_allowed
-	then lookupValueEvenIfInvisible
-	else lookupValue
-
-    rn_decl (ConDecl name tys src_loc)
-      = pushSrcLocRn4 src_loc			  (
-	lookup_fn name		`thenRn4` \ new_name ->
-	mapRn4 rn_bang_ty tys	`thenRn4` \ new_tys  ->
-	returnRn4 (ConDecl new_name new_tys src_loc)
-	)
-
-    rn_decl (ConOpDecl ty1 op ty2 src_loc)
-      = pushSrcLocRn4 src_loc			  (
-	lookup_fn op	`thenRn4` \ new_op  ->
-	rn_bang_ty ty1  `thenRn4` \ new_ty1 ->
-	rn_bang_ty ty2  `thenRn4` \ new_ty2 ->
-	returnRn4 (ConOpDecl new_ty1 new_op new_ty2 src_loc)
-	)
-
-    rn_decl (NewConDecl name ty src_loc)
-      = pushSrcLocRn4 src_loc			  (
-	lookup_fn name		`thenRn4` \ new_name ->
-	rn_mono_ty ty		`thenRn4` \ new_ty  ->
-	returnRn4 (NewConDecl new_name new_ty src_loc)
-	)
-
-    rn_decl (RecConDecl con fields src_loc)
-      = panic "rnConDecls:RecConDecl"
-
-    ----------
-    rn_mono_ty = rnMonoType invisibles_allowed tv_env
-
-    rn_bang_ty (Banged ty)
-      = rn_mono_ty ty `thenRn4` \ new_ty ->
-	returnRn4 (Banged new_ty)
-    rn_bang_ty (Unbanged ty)
-      = rn_mono_ty ty `thenRn4` \ new_ty ->
-	returnRn4 (Unbanged new_ty)
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{SPECIALIZE data pragmas}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnSpecDataSig :: ProtoNameSpecDataSig
-	      -> Rn4M RenamedSpecDataSig
-
-rnSpecDataSig (SpecDataSig tycon ty src_loc)
-  = pushSrcLocRn4 src_loc		(
-    let
-	tyvars = extractMonoTyNames eqProtoName ty
-    in
-    mkTyVarNamesEnv src_loc tyvars     	`thenRn4` \ (tv_env,_) ->
-    lookupTyCon tycon			`thenRn4` \ tycon' ->
-    rnMonoType False tv_env ty		`thenRn4` \ ty' ->
-    returnRn4 (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 :: ProtoNameClassDecl -> Rn4M RenamedClassDecl
-
-rnClassDecl (ClassDecl context cname tyvar sigs mbinds pragmas src_loc)
-  = pushSrcLocRn4 src_loc			  (
-    mkTyVarNamesEnv src_loc [tyvar]	`thenRn4` \ (tv_env, [tyvar']) ->
-    rnContext tv_env context	    	`thenRn4` \ context' ->
-    lookupClass cname		    	`thenRn4` \ cname' ->
-    mapRn4 (rn_op cname' tv_env) sigs   `thenRn4` \ sigs' ->
-    rnMethodBinds cname' mbinds    	`thenRn4` \ mbinds' ->
-    recoverQuietlyRn4 NoClassPragmas (
-      rnClassPragmas pragmas
-    )					`thenRn4` \ pragmas' ->
-    returnRn4 (ClassDecl context' cname' tyvar' sigs' mbinds' pragmas' src_loc)
-    )
-  where
-    rn_op clas tv_env (ClassOpSig op ty pragma locn)
-      = pushSrcLocRn4 locn	    	      (
-	lookupClassOp clas op		`thenRn4` \ op_name ->
-	rnPolyType False tv_env ty	`thenRn4` \ 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_`
--}
-	recoverQuietlyRn4 NoClassOpPragmas (
-	    rnClassOpPragmas pragma
-	)				`thenRn4` \ new_pragma ->
-	returnRn4 (ClassOpSig op_name new_ty new_pragma 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 :: ProtoNameInstDecl -> Rn4M RenamedInstDecl
-
-rnInstDecl (InstDecl cname ty mbinds from_here modname uprags pragmas src_loc)
-  = pushSrcLocRn4 src_loc		 	  (
-    let
-	tyvars = extract_poly_ty_names ty
-    in
-    mkTyVarNamesEnv src_loc tyvars     	`thenRn4` \ (tv_env,_) ->
-    lookupClass cname 		     	`thenRn4` \ cname' ->
-
-    rnPolyType False{-no invisibles-} [] ty
-	-- The "[]" was tv_env, but that means the InstDecl's tyvars aren't
-	-- pinned on the HsForAllType, which they should be.
-	-- Urgh!  Improve in the new renamer!
-
-					`thenRn4` \ ty' ->
-    rnMethodBinds cname' mbinds	`thenRn4` \ mbinds' ->
-    mapRn4 (rn_uprag cname') uprags	`thenRn4` \ new_uprags ->
-    recoverQuietlyRn4 NoInstancePragmas (
-	rnInstancePragmas cname' tv_env pragmas
-    )					`thenRn4` \ new_pragmas ->
-    returnRn4 (InstDecl cname' ty' mbinds'
-			from_here modname new_uprags new_pragmas src_loc)
-    )
-  where
-    rn_uprag class_name (SpecSig op ty using locn)
-      = ASSERT(not (maybeToBool using))	-- ToDo: SPEC method with explicit spec_id
-	pushSrcLocRn4 src_loc 				(
-	lookupClassOp class_name op		`thenRn4` \ op_name ->
-	rnPolyType False nullTyVarNamesEnv ty	`thenRn4` \ new_ty ->
-	returnRn4 (SpecSig op_name new_ty Nothing locn)
-	)
-    rn_uprag class_name (InlineSig op locn)
-      = pushSrcLocRn4 locn	      	(
-	lookupClassOp class_name op	`thenRn4` \ op_name ->
-	returnRn4 (InlineSig op_name locn)
-	)
-    rn_uprag class_name (DeforestSig op locn)
-      = pushSrcLocRn4 locn            	(
-	lookupClassOp class_name op	`thenRn4` \ op_name ->
-	returnRn4 (DeforestSig op_name locn)
-	)
-    rn_uprag class_name (MagicUnfoldingSig op str locn)
-      = pushSrcLocRn4 locn		(
-	lookupClassOp class_name op	`thenRn4` \ op_name ->
-	returnRn4 (MagicUnfoldingSig op_name str locn)
-	)
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{@SPECIALIZE instance@ user-pragmas}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnSpecInstSig :: ProtoNameSpecInstSig
-	      -> Rn4M RenamedSpecInstSig
-
-rnSpecInstSig (SpecInstSig clas ty src_loc)
-  = pushSrcLocRn4 src_loc		  (
-    let  tyvars = extractMonoTyNames eqProtoName ty  in
-    mkTyVarNamesEnv src_loc tyvars     	`thenRn4` \ (tv_env,_) ->
-    lookupClass clas			`thenRn4` \ new_clas ->
-    rnMonoType False tv_env ty		`thenRn4` \ new_ty ->
-    returnRn4 (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 :: [ProtoNameDefaultDecl] -> Rn4M [RenamedDefaultDecl]
-
-rnDefaultDecl [] = returnRn4 []
-rnDefaultDecl [DefaultDecl tys src_loc]
-  = pushSrcLocRn4 src_loc $
-    mapRn4 (rnMonoType False nullTyVarNamesEnv) tys `thenRn4` \ tys' ->
-    returnRn4 [DefaultDecl tys' src_loc]
-rnDefaultDecl defs@(d:ds)
-  = addErrRn4 (dupDefaultDeclErr defs) `thenRn4_`
-    rnDefaultDecl [d]
-\end{code}
-
-%*************************************************************************
-%*									*
-\subsection{Type signatures from interfaces}
-%*									*
-%*************************************************************************
-
-Non-interface type signatures (which may include user-pragmas) are
-handled with @HsBinds@.
-
-@ClassOpSigs@ are dealt with in class declarations.
-
-\begin{code}
-rnIntSig :: ProtoNameSig -> Rn4M RenamedSig
-
-rnIntSig (Sig name ty pragma src_loc)
-  = pushSrcLocRn4 src_loc			      (
-    lookupValue name				`thenRn4` \ new_name ->
-    rnPolyType False nullTyVarNamesEnv ty 	`thenRn4` \ new_ty   ->
-    recoverQuietlyRn4 NoGenPragmas (
-	rnGenPragmas pragma
-    )					    `thenRn4` \ new_pragma ->
-    returnRn4 (Sig new_name new_ty new_pragma src_loc)
-    )
-\end{code}
-
-%*************************************************************************
-%*									*
-\subsection{Fixity declarations}
-%*									*
-%*************************************************************************
-
-\begin{code}
-rnFixes :: [ProtoNameFixityDecl]  -> Rn4M [RenamedFixityDecl]
-
-rnFixes fixities
-  = mapRn4 rn_fixity fixities `thenRn4` \ fixes_maybe ->
-    returnRn4 (catMaybes fixes_maybe)
-  where
-    rn_fixity (InfixL name i)
-      = lookupFixityOp name `thenRn4` \ res ->
-	returnRn4 (
-	  case res of
-	    Just name2 ->  Just (InfixL name2 i)
-	    Nothing    ->  Nothing
-	)
-
-    rn_fixity (InfixR name i)
-      = lookupFixityOp name	`thenRn4` \ res ->
-	returnRn4 (
-	  case res of
-	    Just name2 ->  Just (InfixR name2 i)
-	    Nothing    ->  Nothing
-	)
-
-    rn_fixity (InfixN name i)
-      = lookupFixityOp name	`thenRn4` \ res ->
-	returnRn4 (
-	  case res of
-	    Just name2 ->  Just (InfixN name2 i)
-	    Nothing    ->  Nothing
-	)
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{Support code to rename types}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnPolyType :: Bool		-- True <=> "invisible" tycons (in pragmas) allowed
-	    -> TyVarNamesEnv
-	    -> ProtoNamePolyType
-	    -> Rn4M RenamedPolyType
-
-rnPolyType invisibles_allowed tv_env (HsForAllTy tvs ctxt ty)
-  = rn_poly_help invisibles_allowed tv_env tvs ctxt ty
-
-rnPolyType invisibles_allowed tv_env poly_ty@(HsPreForAllTy ctxt ty)
-  = rn_poly_help invisibles_allowed tv_env forall_tyvars ctxt ty
-  where
-    mentioned_tyvars = extract_poly_ty_names poly_ty
-
-    forall_tyvars = mentioned_tyvars `minus_list` domTyVarNamesEnv tv_env
-
-	-- URGH! Why is this here?  SLPJ
-	-- Because we are doing very delicate comparisons
-	-- (eqProtoName and all that); if we got rid of
-	-- that, then we could use ListSetOps stuff.  WDP
-    minus_list xs ys = [ x | x <- xs, not (x `elemProtoNames` ys)]
-
-------------
-extract_poly_ty_names (HsPreForAllTy ctxt ty)
-  = extractCtxtTyNames eqProtoName ctxt
-    `union_list`
-    extractMonoTyNames eqProtoName ty
-  where
-    -- see comment above
-    union_list []     [] = []
-    union_list []     b	 = b
-    union_list a      [] = a
-    union_list (a:as) b
-      | a `elemProtoNames` b = union_list as b
-      | otherwise            = a : union_list as b
-
-------------
-rn_poly_help :: Bool
-	     -> TyVarNamesEnv
-	     -> [ProtoName]
-	     -> ProtoNameContext
-	     -> ProtoNameMonoType
-	     -> Rn4M RenamedPolyType
-
-rn_poly_help invisibles_allowed tv_env tyvars ctxt ty
-  = getSrcLocRn4 				`thenRn4` \ src_loc ->
-    mkTyVarNamesEnv src_loc tyvars	 	`thenRn4` \ (tv_env1, new_tyvars) ->
-    let
-	tv_env2 = catTyVarNamesEnvs tv_env1 tv_env
-    in
-    rnContext tv_env2 ctxt			`thenRn4` \ new_ctxt ->
-    rnMonoType invisibles_allowed tv_env2 ty	`thenRn4` \ new_ty ->
-    returnRn4 (HsForAllTy new_tyvars new_ctxt new_ty)
-\end{code}
-
-\begin{code}
-rnMonoType :: Bool		-- allowed to look at invisible tycons
-	    -> TyVarNamesEnv
-	    -> ProtoNameMonoType
-	    -> Rn4M RenamedMonoType
-
-rnMonoType invisibles_allowed  tv_env (MonoTyVar tyvar)
-  = lookupTyVarName tv_env tyvar 	`thenRn4` \ tyvar' ->
-    returnRn4 (MonoTyVar tyvar')
-
-rnMonoType invisibles_allowed  tv_env (MonoListTy ty)
-  = rnMonoType invisibles_allowed tv_env ty	`thenRn4` \ ty' ->
-    returnRn4 (MonoListTy ty')
-
-rnMonoType invisibles_allowed  tv_env (MonoFunTy ty1 ty2)
-  = andRn4 MonoFunTy (rnMonoType invisibles_allowed tv_env ty1)
-		     (rnMonoType invisibles_allowed tv_env ty2)
-
-rnMonoType invisibles_allowed  tv_env (MonoTupleTy tys)
-  = mapRn4 (rnMonoType invisibles_allowed tv_env) tys `thenRn4` \ tys' ->
-    returnRn4 (MonoTupleTy tys')
-
-rnMonoType invisibles_allowed tv_env (MonoTyApp name tys)
-  = let
-	lookup_fn = if isAvarid (getOccurrenceName name) 
-		    then lookupTyVarName tv_env
-		    else if invisibles_allowed
-		         then lookupTyConEvenIfInvisible
-		         else lookupTyCon
-    in
-    lookup_fn name					`thenRn4` \ name' ->
-    mapRn4 (rnMonoType invisibles_allowed tv_env) tys	`thenRn4` \ tys' ->
-    returnRn4 (MonoTyApp name' tys')
-
--- for unfoldings only:
-
-rnMonoType invisibles_allowed tv_env (MonoForAllTy tyvars_w_kinds ty)
-  = getSrcLocRn4 				`thenRn4` \ src_loc ->
-    mkTyVarNamesEnv src_loc tyvars	 	`thenRn4` \ (tv_env1, new_tyvars) ->
-    let
-	tv_env2 = catTyVarNamesEnvs tv_env1 tv_env
-    in
-    rnMonoType invisibles_allowed tv_env2 ty	`thenRn4` \ ty' ->
-    returnRn4 (MonoForAllTy (new_tyvars `zip` kinds) ty')
-  where
-    (tyvars, kinds) = unzip tyvars_w_kinds
-
-rnMonoType invisibles_allowed tv_env (MonoDictTy clas ty)
-  = lookupClass clas		`thenRn4` \ new_clas ->
-    rnMonoType invisibles_allowed tv_env ty	`thenRn4` \ new_ty ->
-    returnRn4 (MonoDictTy new_clas new_ty)
-\end{code}
-
-\begin{code}
-rnContext :: TyVarNamesEnv -> ProtoNameContext -> Rn4M RenamedContext
-
-rnContext tv_env ctxt
-  = mapRn4 rn_ctxt ctxt
-  where
-    rn_ctxt (clas, tyvar)
-     = lookupClass clas	    	    `thenRn4` \ clas_name ->
-       lookupTyVarName tv_env tyvar `thenRn4` \ tyvar_name ->
-       returnRn4 (clas_name, tyvar_name)
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{Support code to rename various pragmas}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnDataPragmas tv_env (DataPragmas cons specs)
-  = rnConDecls tv_env True{-invisibles allowed-} cons `thenRn4` \ new_cons ->
-    mapRn4 types_n_spec specs			       `thenRn4` \ new_specs ->
-    returnRn4 (DataPragmas new_cons new_specs)
-  where
-    types_n_spec ty_maybes
-      = mapRn4 (rn_ty_maybe nullTyVarNamesEnv) ty_maybes
-\end{code}
-
-\begin{code}
-rnClassOpPragmas NoClassOpPragmas = returnRn4 NoClassOpPragmas
-
-rnClassOpPragmas (ClassOpPragmas dsel defm)
-  = recoverQuietlyRn4 NoGenPragmas (rnGenPragmas dsel) `thenRn4` \ new_dsel ->
-    recoverQuietlyRn4 NoGenPragmas (rnGenPragmas defm) `thenRn4` \ new_defm ->
-    returnRn4 (ClassOpPragmas new_dsel new_defm)
-\end{code}
-
-\begin{code}
-rnClassPragmas NoClassPragmas = returnRn4 NoClassPragmas
-
-rnClassPragmas (SuperDictPragmas sds)
-  = mapRn4 rnGenPragmas sds	`thenRn4` \ new_sds ->
-    returnRn4 (SuperDictPragmas new_sds)
-\end{code}
-
-NB: In various cases around here, we don't @recoverQuietlyRn4@ around
-calls to @rnGenPragmas@; not really worth it.
-
-\begin{code}
-rnInstancePragmas _ _ NoInstancePragmas = returnRn4 NoInstancePragmas
-
-rnInstancePragmas _ _ (SimpleInstancePragma dfun)
-  = rnGenPragmas dfun	`thenRn4` \ new_dfun ->
-    returnRn4 (SimpleInstancePragma new_dfun)
-
-rnInstancePragmas clas tv_env (ConstantInstancePragma dfun constms)
-  = recoverQuietlyRn4 NoGenPragmas (
-	rnGenPragmas dfun
-    )				`thenRn4` \ new_dfun ->
-    mapRn4 name_n_gen constms	`thenRn4` \ new_constms ->
-    returnRn4 (ConstantInstancePragma new_dfun new_constms)
-  where
-    name_n_gen (op, gen)
-      = lookupClassOp clas op	`thenRn4` \ new_op ->
-	rnGenPragmas gen	`thenRn4` \ new_gen ->
-	returnRn4 (new_op, new_gen)
-
-rnInstancePragmas clas tv_env (SpecialisedInstancePragma dfun specs)
-  = recoverQuietlyRn4 NoGenPragmas (
-	rnGenPragmas dfun
-    )				`thenRn4` \ new_dfun ->
-    mapRn4 types_n_spec specs	`thenRn4` \ new_specs ->
-    returnRn4 (SpecialisedInstancePragma new_dfun new_specs)
-  where
-    types_n_spec (ty_maybes, dicts_to_ignore, inst)
-      = mapRn4 (rn_ty_maybe tv_env) ty_maybes	`thenRn4` \ new_tys ->
-	rnInstancePragmas clas tv_env inst 	`thenRn4` \ new_inst ->
-	returnRn4 (new_tys, dicts_to_ignore, new_inst)
-\end{code}
-
-And some general pragma stuff: (Not sure what, if any, of this would
-benefit from a TyVarNamesEnv passed in.... [ToDo])
-\begin{code}
-rnGenPragmas :: ProtoNameGenPragmas -> Rn4M RenamedGenPragmas
-
-rnGenPragmas NoGenPragmas = returnRn4 NoGenPragmas
-
-rnGenPragmas (GenPragmas arity upd def strict unfold specs)
-  = recoverQuietlyRn4 NoImpUnfolding (
-	rn_unfolding  unfold
-    )				`thenRn4` \ new_unfold ->
-    rn_strictness strict	`thenRn4` \ new_strict ->
-    recoverQuietlyRn4 [] (
-	mapRn4 types_n_gen specs
-    )				`thenRn4` \ new_specs ->
-    returnRn4 (GenPragmas arity upd def new_strict new_unfold new_specs)
-  where
-    rn_unfolding NoImpUnfolding = returnRn4 NoImpUnfolding
-
-    rn_unfolding (ImpMagicUnfolding str) = returnRn4 (ImpMagicUnfolding str)
-
-    rn_unfolding (ImpUnfolding guidance core)
-      = rn_core nullTyVarNamesEnv core	`thenRn4` \ new_core ->
-    	returnRn4 (ImpUnfolding guidance new_core)
-
-    ------------
-    rn_strictness NoImpStrictness = returnRn4 NoImpStrictness
-
-    rn_strictness (ImpStrictness is_bot ww_info wrkr_info)
-      = recoverQuietlyRn4 NoGenPragmas (
-	    rnGenPragmas wrkr_info
-	) 			`thenRn4` \ new_wrkr_info ->
-	returnRn4 (ImpStrictness is_bot ww_info new_wrkr_info)
-
-    -------------
-    types_n_gen (ty_maybes, dicts_to_ignore, gen)
-      = mapRn4 (rn_ty_maybe no_env) ty_maybes	`thenRn4` \ new_tys ->
-	recoverQuietlyRn4 NoGenPragmas (
-	    rnGenPragmas gen
-	)				`thenRn4` \ new_gen ->
-	returnRn4 (new_tys, dicts_to_ignore, new_gen)
-      where
-	no_env = nullTyVarNamesEnv
-
-------------
-rn_ty_maybe tv_env Nothing = returnRn4 Nothing
-
-rn_ty_maybe tv_env (Just ty)
-  = rnMonoType True{-invisibles OK-} tv_env ty  `thenRn4` \ new_ty ->
-    returnRn4 (Just new_ty)
-
-------------
-rn_core tvenv (UfVar v)
-  = rn_uf_id tvenv v	`thenRn4` \ vname ->
-    returnRn4 (UfVar vname)
-
-rn_core tvenv (UfLit lit)
-  = returnRn4 (UfLit lit)
-
-rn_core tvenv (UfCon con tys as)
-  = lookupValueEvenIfInvisible con	`thenRn4` \ new_con ->
-    mapRn4 (rn_core_type tvenv) tys	`thenRn4` \ new_tys ->
-    mapRn4 (rn_atom tvenv) as   	`thenRn4` \ new_as ->
-    returnRn4 (UfCon new_con new_tys new_as)
-
-rn_core tvenv (UfPrim op tys as)
-  = rn_core_primop tvenv op		`thenRn4` \ new_op ->
-    mapRn4 (rn_core_type tvenv) tys	`thenRn4` \ new_tys ->
-    mapRn4 (rn_atom tvenv) as   	`thenRn4` \ new_as ->
-    returnRn4 (UfPrim new_op new_tys new_as)
-
-rn_core tvenv (UfLam binder body)
-  = rn_binder tvenv binder `thenRn4` \ (b,ty) ->
-    extendSS [b] (rn_core tvenv body) `thenRn4` \ new_body ->
-    returnRn4 (UfLam (b,ty) new_body)
-
-rn_core tvenv (UfApp fun arg)
-  = rn_core tvenv fun	`thenRn4` \ new_fun ->
-    rn_atom tvenv arg	`thenRn4` \ new_arg ->
-    returnRn4 (UfApp new_fun new_arg)
-
-rn_core tvenv (UfCase expr alts)
-  = rn_core tvenv expr	    `thenRn4` \ new_expr ->
-    rn_alts 	  alts	    `thenRn4` \ new_alts ->
-    returnRn4 (UfCase new_expr new_alts)
-  where
-    rn_alts (UfCoAlgAlts alg_alts deflt)
-      = mapRn4 rn_alg_alt alg_alts  `thenRn4` \ new_alts ->
-	rn_deflt deflt	    	    `thenRn4` \ new_deflt ->
-	returnRn4 (UfCoAlgAlts new_alts new_deflt)
-      where
-	rn_alg_alt (con, params, rhs)
-	  = lookupValueEvenIfInvisible con  `thenRn4` \ new_con ->
-	    mapRn4 (rn_binder tvenv) params `thenRn4` \ new_params ->
-	    let
-		bs = [ b | (b, ty) <- new_params ]
-	    in
-	    extendSS bs (rn_core tvenv rhs) `thenRn4` \ new_rhs ->
-	    returnRn4 (new_con, new_params, new_rhs)
-
-    rn_alts (UfCoPrimAlts prim_alts deflt)
-      = mapRn4 rn_prim_alt prim_alts  `thenRn4` \ new_alts ->
-	rn_deflt deflt		      `thenRn4` \ new_deflt ->
-	returnRn4 (UfCoPrimAlts new_alts new_deflt)
-      where
-	rn_prim_alt (lit, rhs)
-	  = rn_core tvenv rhs	`thenRn4` \ new_rhs ->
-	    returnRn4 (lit, new_rhs)
-
-    rn_deflt UfCoNoDefault = returnRn4 UfCoNoDefault
-    rn_deflt (UfCoBindDefault b rhs)
-      = rn_binder tvenv b		      `thenRn4` \ new_b@(binder, ty) ->
-	extendSS [binder] (rn_core tvenv rhs) `thenRn4` \ new_rhs ->
-	returnRn4 (UfCoBindDefault new_b new_rhs)
-
-rn_core tvenv (UfLet bind body)
-  = rn_bind bind			      `thenRn4` \ (new_bind, new_binders) ->
-    extendSS new_binders (rn_core tvenv body) `thenRn4` \ new_body ->
-    returnRn4 (UfLet new_bind new_body)
-  where
-    rn_bind (UfCoNonRec b rhs)
-      = rn_binder tvenv b	`thenRn4` \ new_b@(binder, ty) ->
-	rn_core   tvenv rhs 	`thenRn4` \ new_rhs ->
-	returnRn4 (UfCoNonRec new_b new_rhs, [binder])
-
-    rn_bind (UfCoRec pairs)
-      = -- conjure up Names; we do this differently than
-	-- elsewhere for Core, because of the recursion here;
-	-- no deep issue.
-	-- [BEFORE IT WAS "FIXED"... 94/05...]
- 	-- [Andy -- It *was* a 'deep' issue to me...]
-	-- [Will -- Poor wee soul.]
-
-	getSrcLocRn4			    `thenRn4` \ locn ->
-	namesFromProtoNames "core variable"
-	  [ (b, locn) | ((b,_),_) <- pairs] `thenRn4` \ binders ->
-
-	extendSS binders (mapRn4 rn_pair (pairs `zip` binders)) `thenRn4` \ new_pairs ->
-	returnRn4 (UfCoRec new_pairs, binders)
-      where
-	rn_pair (((b, ty), rhs), new_b)
-	  = rn_core_type tvenv ty	`thenRn4` \ new_ty ->
-	    rn_core      tvenv rhs	`thenRn4` \ new_rhs ->
-	    returnRn4 ((new_b, new_ty), new_rhs)
-
-rn_core tvenv (UfSCC uf_cc body)
-  = rn_cc uf_cc		`thenRn4` \ new_cc ->
-    rn_core tvenv body	`thenRn4` \ new_body ->
-    returnRn4 (UfSCC new_cc new_body)
-  where
-    rn_cc (UfAutoCC id m g is_dupd is_caf)
-      = rn_uf_id tvenv id	`thenRn4` \ new_id ->
-	returnRn4 (UfAutoCC new_id m g is_dupd is_caf)
-
-    rn_cc (UfDictCC id m g is_caf is_dupd)
-      = rn_uf_id tvenv id	`thenRn4` \ new_id ->
-	returnRn4 (UfDictCC new_id m g is_dupd is_caf)
-
-    -- the rest are boring:
-    rn_cc (UfPreludeDictsCC d) = returnRn4 (UfPreludeDictsCC d)
-    rn_cc (UfAllDictsCC m g d) = returnRn4 (UfAllDictsCC m g d)
-    rn_cc (UfUserCC n m g d c) = returnRn4 (UfUserCC n m g d c)
-
-------------
-rn_core_primop tvenv (UfCCallOp str is_casm may_gc arg_tys res_ty)
-  = mapRn4 (rn_core_type tvenv) arg_tys	`thenRn4` \ new_arg_tys ->
-    rn_core_type tvenv res_ty		`thenRn4` \ new_res_ty  ->
-    returnRn4 (UfCCallOp str is_casm may_gc new_arg_tys new_res_ty)
-rn_core_primop tvenv (UfOtherOp op)
-  = returnRn4 (UfOtherOp op)
-
-------------
-rn_uf_id tvenv (BoringUfId v)
-  = lookupValueEvenIfInvisible v    `thenRn4` \ vname ->
-    returnRn4 (BoringUfId vname)
-
-rn_uf_id tvenv (SuperDictSelUfId c sc)
-  = lookupClass{-EvenIfInvisible-} c	`thenRn4` \ new_c ->
-    lookupClass{-EvenIfInvisible-} sc	`thenRn4` \ new_sc ->
-    returnRn4 (SuperDictSelUfId new_c new_sc)
-
-rn_uf_id tvenv (ClassOpUfId c op)
-  = lookupClass{-EvenIfInvisible-} c	    	`thenRn4` \ new_c ->
-    lookupClassOp{-EvenIfInvisible-} new_c op	`thenRn4` \ new_op ->
-    returnRn4 (ClassOpUfId new_c new_op)
-
-rn_uf_id tvenv (DictFunUfId c ty)
-  = lookupClass{-EvenIfInvisible-} c	`thenRn4` \ new_c ->
-    rn_core_type tvenv ty   	    	`thenRn4` \ new_ty ->
-    returnRn4 (DictFunUfId new_c new_ty)
-
-rn_uf_id tvenv (ConstMethodUfId c op ty)
-  = lookupClass{-EvenIfInvisible-} c	      `thenRn4` \ new_c ->
-    lookupClassOp{-EvenIfInvisible-} new_c op `thenRn4` \ new_op ->
-    rn_core_type tvenv ty   	    	      `thenRn4` \ new_ty ->
-    returnRn4 (ConstMethodUfId new_c new_op new_ty)
-
-rn_uf_id tvenv (DefaultMethodUfId c op)
-  = lookupClass{-EvenIfInvisible-} c	    	`thenRn4` \ new_c ->
-    lookupClassOp{-EvenIfInvisible-} new_c op	`thenRn4` \ new_op ->
-    returnRn4 (DefaultMethodUfId new_c new_op)
-
-rn_uf_id tvenv (SpecUfId unspec ty_maybes)
-  = rn_uf_id tvenv unspec		 `thenRn4` \ new_unspec ->
-    mapRn4 (rn_ty_maybe tvenv) ty_maybes `thenRn4` \ new_ty_maybes ->
-    returnRn4 (SpecUfId new_unspec new_ty_maybes)
-
-rn_uf_id tvenv (WorkerUfId unwrkr)
-  = rn_uf_id tvenv unwrkr	`thenRn4` \ new_unwrkr ->
-    returnRn4 (WorkerUfId new_unwrkr)
-
-------------
-rn_binder tvenv (b, ty)
-  = getSrcLocRn4			`thenRn4` \ src_loc ->
-    namesFromProtoNames "binder in core unfolding" [(b, src_loc)]
-					`thenRn4` \ [new_b] ->
-    rn_core_type tvenv ty		`thenRn4` \ new_ty ->
-    returnRn4 (new_b, new_ty)
-
-------------
-rn_atom tvenv (UfCoLitAtom l) = returnRn4 (UfCoLitAtom l)
-rn_atom tvenv (UfCoVarAtom v)
-  = rn_uf_id tvenv v			`thenRn4` \ vname ->
-    returnRn4 (UfCoVarAtom vname)
-
-------------
-rn_core_type_maybe tvenv Nothing = returnRn4 Nothing
-rn_core_type_maybe tvenv (Just ty)
-  = rn_core_type tvenv ty `thenRn4` \ new_ty ->
-    returnRn4 (Just new_ty)
-
-------------
-rn_core_type tvenv ty
-  = rnPolyType True{-invisible tycons OK-} tvenv ty
-\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
-\end{code}