Reorganisation of the source tree

Most of the other users of the fptools build system have migrated to
Cabal, and with the move to darcs we can now flatten the source tree
without losing history, so here goes.

The main change is that the ghc/ subdir is gone, and most of what it
contained is now at the top level.  The build system now makes no
pretense at being multi-project, it is just the GHC build system.

No doubt this will break many things, and there will be a period of
instability while we fix the dependencies.  A straightforward build
should work, but I haven't yet fixed binary/source distributions.
Changes to the Building Guide will follow, too.

11 files changed, 5308 insertions, 0 deletions

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
new file mode 100644
index 0000000000..13035e72e2
--- /dev/null
+++ b/compiler/rename/RnBinds.lhs
@@ -0,0 +1,660 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[RnBinds]{Renaming and dependency analysis of bindings}
+
+This module does renaming and dependency analysis on value bindings in
+the abstract syntax.  It does {\em not} do cycle-checks on class or
+type-synonym declarations; those cannot be done at this stage because
+they may be affected by renaming (which isn't fully worked out yet).
+
+\begin{code}
+module RnBinds (
+	rnTopBinds, 
+	rnLocalBindsAndThen, rnValBindsAndThen, rnValBinds, trimWith,
+	rnMethodBinds, renameSigs, 
+	rnMatchGroup, rnGRHSs
+   ) where
+
+#include "HsVersions.h"
+
+import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts )
+
+import HsSyn
+import RdrHsSyn
+import RnHsSyn
+import TcRnMonad
+import RnTypes		( rnHsSigType, rnLHsType, rnHsTypeFVs, 
+			  rnLPat, rnPatsAndThen, patSigErr, checkPrecMatch )
+import RnEnv		( bindLocatedLocalsRn, lookupLocatedBndrRn, 
+			  lookupLocatedInstDeclBndr, newIPNameRn,
+			  lookupLocatedSigOccRn, bindPatSigTyVars, bindPatSigTyVarsFV,
+			  bindLocalFixities, bindSigTyVarsFV, 
+			  warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
+			)
+import DynFlags	( DynFlag(..) )
+import Name		( Name, nameOccName, nameSrcLoc )
+import NameEnv
+import NameSet
+import PrelNames	( isUnboundName )
+import RdrName		( RdrName, rdrNameOcc )
+import SrcLoc		( mkSrcSpan, Located(..), unLoc )
+import ListSetOps	( findDupsEq )
+import BasicTypes	( RecFlag(..) )
+import Digraph		( SCC(..), stronglyConnComp )
+import Bag
+import Outputable
+import Maybes		( orElse, isJust )
+import Util		( filterOut )
+import Monad		( foldM )
+\end{code}
+
+-- ToDo: Put the annotations into the monad, so that they arrive in the proper
+-- place and can be used when complaining.
+
+The code tree received by the function @rnBinds@ contains definitions
+in where-clauses which are all apparently mutually recursive, but which may
+not really depend upon each other. For example, in the top level program
+\begin{verbatim}
+f x = y where a = x
+	      y = x
+\end{verbatim}
+the definitions of @a@ and @y@ do not depend on each other at all.
+Unfortunately, the typechecker cannot always check such definitions.
+\footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
+definitions. In Proceedings of the International Symposium on Programming,
+Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
+However, the typechecker usually can check definitions in which only the
+strongly connected components have been collected into recursive bindings.
+This is precisely what the function @rnBinds@ does.
+
+ToDo: deal with case where a single monobinds binds the same variable
+twice.
+
+The vertag tag is a unique @Int@; the tags only need to be unique
+within one @MonoBinds@, so that unique-Int plumbing is done explicitly
+(heavy monad machinery not needed).
+
+
+%************************************************************************
+%*									*
+%* 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 (HsBindGroup, HsBind)
+%*									*
+%************************************************************************
+
+\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 @FlatMonoBinds@) 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).
+
+%************************************************************************
+%*									*
+\subsubsection{ Top-level bindings}
+%*									*
+%************************************************************************
+
+@rnTopMonoBinds@ assumes that the environment already
+contains bindings for the binders of this particular binding.
+
+\begin{code}
+rnTopBinds :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
+
+-- The binders of the binding are in scope already;
+-- the top level scope resolution does that
+
+rnTopBinds binds
+ =  do	{ is_boot <- tcIsHsBoot
+	; if is_boot then rnTopBindsBoot binds
+		     else rnTopBindsSrc  binds }
+
+rnTopBindsBoot :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
+-- A hs-boot file has no bindings. 
+-- Return a single HsBindGroup with empty binds and renamed signatures
+rnTopBindsBoot (ValBindsIn mbinds sigs)
+  = do	{ checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
+	; sigs' <- renameSigs okHsBootSig sigs
+	; return (ValBindsOut [] sigs', usesOnly (hsSigsFVs sigs')) }
+
+rnTopBindsSrc :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
+rnTopBindsSrc binds@(ValBindsIn mbinds _)
+  = do	{ (binds', dus) <- rnValBinds noTrim binds
+
+		-- Warn about missing signatures, 
+	; let	{ ValBindsOut _ sigs' = binds'
+		; ty_sig_vars = mkNameSet [ unLoc n | L _ (TypeSig n _) <- sigs']
+		; un_sigd_bndrs = duDefs dus `minusNameSet` ty_sig_vars }
+
+	; warn_missing_sigs <- doptM Opt_WarnMissingSigs
+	; ifM (warn_missing_sigs)
+	      (mappM_ missingSigWarn (nameSetToList un_sigd_bndrs))
+
+	; return (binds', dus)
+	}
+\end{code}
+
+
+
+%*********************************************************
+%*							*
+		HsLocalBinds
+%*							*
+%*********************************************************
+
+\begin{code}
+rnLocalBindsAndThen 
+  :: HsLocalBinds RdrName
+  -> (HsLocalBinds Name -> RnM (result, FreeVars))
+  -> RnM (result, FreeVars)
+-- This version (a) assumes that the binding vars are not already in scope
+--		(b) removes the binders from the free vars of the thing inside
+-- The parser doesn't produce ThenBinds
+rnLocalBindsAndThen EmptyLocalBinds thing_inside
+  = thing_inside EmptyLocalBinds
+
+rnLocalBindsAndThen (HsValBinds val_binds) thing_inside
+  = rnValBindsAndThen val_binds $ \ val_binds' -> 
+    thing_inside (HsValBinds val_binds')
+
+rnLocalBindsAndThen (HsIPBinds binds) thing_inside
+  = rnIPBinds binds			`thenM` \ (binds',fv_binds) ->
+    thing_inside (HsIPBinds binds')	`thenM` \ (thing, fvs_thing) ->
+    returnM (thing, fvs_thing `plusFV` fv_binds)
+
+-------------
+rnIPBinds (IPBinds ip_binds _no_dict_binds)
+  = do	{ (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds
+	; return (IPBinds ip_binds' emptyLHsBinds, plusFVs fvs_s) }
+
+rnIPBind (IPBind n expr)
+  = newIPNameRn  n		`thenM` \ name ->
+    rnLExpr expr		`thenM` \ (expr',fvExpr) ->
+    return (IPBind name expr', fvExpr)
+\end{code}
+
+
+%************************************************************************
+%*									*
+		ValBinds
+%*									*
+%************************************************************************
+
+\begin{code}
+rnValBindsAndThen :: HsValBinds RdrName
+	          -> (HsValBinds Name -> RnM (result, FreeVars))
+	          -> RnM (result, FreeVars)
+
+rnValBindsAndThen binds@(ValBindsIn mbinds sigs) thing_inside
+  =	-- Extract all the binders in this group, and extend the
+	-- current scope, inventing new names for the new binders
+	-- This also checks that the names form a set
+    bindLocatedLocalsRn doc mbinders_w_srclocs			$ \ bndrs ->
+
+	-- Then install local fixity declarations
+	-- Notice that they scope over thing_inside too
+    bindLocalFixities [sig | L _ (FixSig sig) <- sigs ] 	$
+
+	-- Do the business
+    rnValBinds (trimWith bndrs) binds	`thenM` \ (binds, bind_dus) ->
+
+	-- Now do the "thing inside"
+    thing_inside binds 			`thenM` \ (result,result_fvs) ->
+
+	-- Final error checking
+    let
+	all_uses = duUses bind_dus `plusFV` result_fvs
+	-- duUses: It's important to return all the uses, not the 'real uses' 
+	-- used for warning about unused bindings.  Otherwise consider:
+	--	x = 3
+	--	y = let p = x in 'x'	-- NB: p not used
+	-- If we don't "see" the dependency of 'y' on 'x', we may put the
+	-- bindings in the wrong order, and the type checker will complain
+	-- that x isn't in scope
+
+	unused_bndrs = [ b | b <- bndrs, not (b `elemNameSet` all_uses)]
+    in
+    warnUnusedLocalBinds unused_bndrs	`thenM_`
+
+    returnM (result, delListFromNameSet all_uses bndrs)
+  where
+    mbinders_w_srclocs = collectHsBindLocatedBinders mbinds
+    doc = text "In the binding group for:"
+	  <+> pprWithCommas ppr (map unLoc mbinders_w_srclocs)
+
+---------------------
+rnValBinds :: (FreeVars -> FreeVars)
+	   -> HsValBinds RdrName
+	   -> RnM (HsValBinds Name, DefUses)
+-- Assumes the binders of the binding are in scope already
+
+rnValBinds trim (ValBindsIn mbinds sigs)
+  = do	{ sigs' <- rename_sigs sigs
+
+	; binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
+
+	; let (binds', bind_dus) = depAnalBinds binds_w_dus
+
+	-- We do the check-sigs after renaming the bindings,
+	-- so that we have convenient access to the binders
+	; check_sigs (okBindSig (duDefs bind_dus)) sigs'
+
+	; return (ValBindsOut binds' sigs', 
+		  usesOnly (hsSigsFVs sigs') `plusDU` bind_dus) }
+
+
+---------------------
+depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
+	     -> ([(RecFlag, LHsBinds Name)], DefUses)
+-- Dependency analysis; this is important so that 
+-- unused-binding reporting is accurate
+depAnalBinds binds_w_dus
+  = (map get_binds sccs, map get_du sccs)
+  where
+    sccs = stronglyConnComp edges
+
+    keyd_nodes = bagToList binds_w_dus `zip` [0::Int ..]
+
+    edges = [ (node, key, [key | n <- nameSetToList uses,
+			         Just key <- [lookupNameEnv key_map n] ])
+	    | (node@(_,_,uses), key) <- keyd_nodes ]
+
+    key_map :: NameEnv Int	-- Which binding it comes from
+    key_map = mkNameEnv [(bndr, key) | ((_, bndrs, _), key) <- keyd_nodes
+				     , bndr <- bndrs ]
+
+    get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
+    get_binds (CyclicSCC  binds_w_dus)  = (Recursive, listToBag [b | (b,d,u) <- binds_w_dus])
+
+    get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses)
+    get_du (CyclicSCC  binds_w_dus)      = (Just defs, uses)
+	where
+	  defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]
+	  uses = unionManyNameSets [u | (_,_,u) <- binds_w_dus]
+
+
+---------------------
+-- Bind the top-level forall'd type variables in the sigs.
+-- E.g 	f :: a -> a
+--	f = rhs
+--	The 'a' scopes over the rhs
+--
+-- NB: there'll usually be just one (for a function binding)
+--     but if there are many, one may shadow the rest; too bad!
+--	e.g  x :: [a] -> [a]
+--	     y :: [(a,a)] -> a
+--	     (x,y) = e
+--      In e, 'a' will be in scope, and it'll be the one from 'y'!
+
+mkSigTvFn :: [LSig Name] -> (Name -> [Name])
+-- Return a lookup function that maps an Id Name to the names
+-- of the type variables that should scope over its body..
+mkSigTvFn sigs
+  = \n -> lookupNameEnv env n `orElse` []
+  where
+    env :: NameEnv [Name]
+    env = mkNameEnv [ (name, map hsLTyVarName ltvs)
+		    | L _ (TypeSig (L _ name) 
+			           (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs]
+	-- Note the pattern-match on "Explicit"; we only bind
+	-- type variables from signatures with an explicit top-level for-all
+				
+-- The trimming function trims the free vars we attach to a
+-- binding so that it stays reasonably small
+noTrim :: FreeVars -> FreeVars
+noTrim fvs = fvs	-- Used at top level
+
+trimWith :: [Name] -> FreeVars -> FreeVars
+-- Nested bindings; trim by intersection with the names bound here
+trimWith bndrs = intersectNameSet (mkNameSet bndrs)
+
+---------------------
+rnBind :: (Name -> [Name])		-- Signature tyvar function
+       -> (FreeVars -> FreeVars)	-- Trimming function for rhs free vars
+       -> LHsBind RdrName
+       -> RnM (LHsBind Name, [Name], Uses)
+rnBind sig_fn trim (L loc (PatBind { pat_lhs = pat, pat_rhs = grhss }))
+  = setSrcSpan loc $ 
+    do	{ (pat', pat_fvs) <- rnLPat pat
+
+	; let bndrs = collectPatBinders pat'
+
+	; (grhss', fvs) <- bindSigTyVarsFV (concatMap sig_fn bndrs) $
+			   rnGRHSs PatBindRhs grhss
+
+	; return (L loc (PatBind { pat_lhs = pat', pat_rhs = grhss', 
+				   pat_rhs_ty = placeHolderType, bind_fvs = trim fvs }), 
+		  bndrs, pat_fvs `plusFV` fvs) }
+
+rnBind sig_fn trim (L loc (FunBind { fun_id = name, fun_infix = inf, fun_matches = matches }))
+  = setSrcSpan loc $ 
+    do	{ new_name <- lookupLocatedBndrRn name
+	; let plain_name = unLoc new_name
+
+	; (matches', fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
+			     rnMatchGroup (FunRhs plain_name) matches
+
+	; checkPrecMatch inf plain_name matches'
+
+	; return (L loc (FunBind { fun_id = new_name, fun_infix = inf, fun_matches = matches',
+				   bind_fvs = trim fvs, fun_co_fn = idCoercion }), 
+		  [plain_name], fvs)
+      }
+\end{code}
+
+
+@rnMethodBinds@ is used for the method bindings of a class and an instance
+declaration.   Like @rnBinds@ but without dependency analysis.
+
+NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
+That's crucial when dealing with an instance decl:
+\begin{verbatim}
+	instance Foo (T a) where
+	   op x = ...
+\end{verbatim}
+This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
+and unless @op@ occurs we won't treat the type signature of @op@ in the class
+decl for @Foo@ as a source of instance-decl gates.  But we should!  Indeed,
+in many ways the @op@ in an instance decl is just like an occurrence, not
+a binder.
+
+\begin{code}
+rnMethodBinds :: Name			-- Class name
+	      -> [Name]			-- Names for generic type variables
+	      -> LHsBinds RdrName
+	      -> RnM (LHsBinds Name, FreeVars)
+
+rnMethodBinds cls gen_tyvars binds
+  = foldM do_one (emptyBag,emptyFVs) (bagToList binds)
+  where do_one (binds,fvs) bind = do
+	   (bind', fvs_bind) <- rnMethodBind cls gen_tyvars bind
+	   return (bind' `unionBags` binds, fvs_bind `plusFV` fvs)
+
+rnMethodBind cls gen_tyvars (L loc (FunBind { fun_id = name, fun_infix = inf, 
+					      fun_matches = MatchGroup matches _ }))
+  =  setSrcSpan loc $ 
+     lookupLocatedInstDeclBndr cls name			`thenM` \ sel_name -> 
+     let plain_name = unLoc sel_name in
+	-- We use the selector name as the binder
+
+    mapFvRn (rn_match plain_name) matches		`thenM` \ (new_matches, fvs) ->
+    let 
+	new_group = MatchGroup new_matches placeHolderType
+    in
+    checkPrecMatch inf plain_name new_group		`thenM_`
+    returnM (unitBag (L loc (FunBind { fun_id = sel_name, fun_infix = inf, fun_matches = new_group,
+				       bind_fvs = fvs, fun_co_fn = idCoercion })), 
+	     fvs `addOneFV` plain_name)
+	-- The 'fvs' field isn't used for method binds
+  where
+	-- Truly gruesome; bring into scope the correct members of the generic 
+	-- type variables.  See comments in RnSource.rnSourceDecl(ClassDecl)
+    rn_match sel_name match@(L _ (Match (L _ (TypePat ty) : _) _ _))
+	= extendTyVarEnvFVRn gen_tvs 	$
+	  rnMatch (FunRhs sel_name) match
+	where
+	  tvs     = map (rdrNameOcc.unLoc) (extractHsTyRdrTyVars ty)
+	  gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs] 
+
+    rn_match sel_name match = rnMatch (FunRhs sel_name) match
+
+
+-- Can't handle method pattern-bindings which bind multiple methods.
+rnMethodBind cls gen_tyvars mbind@(L loc (PatBind other_pat _ _ _))
+  = addLocErr mbind methodBindErr	`thenM_`
+    returnM (emptyBag, emptyFVs) 
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
+%*									*
+%************************************************************************
+
+@renameSigs@ checks for:
+\begin{enumerate}
+\item more than one sig for one thing;
+\item signatures given for things not bound here;
+\item with suitably flaggery, that all top-level things have type signatures.
+\end{enumerate}
+%
+At the moment we don't gather free-var info from the types in
+signatures.  We'd only need this if we wanted to report unused tyvars.
+
+\begin{code}
+renameSigs :: (LSig Name -> Bool) -> [LSig RdrName] -> RnM [LSig Name]
+-- Renames the signatures and performs error checks
+renameSigs ok_sig sigs 
+  = do	{ sigs' <- rename_sigs sigs
+	; check_sigs ok_sig sigs'
+	; return sigs' }
+
+----------------------
+rename_sigs :: [LSig RdrName] -> RnM [LSig Name]
+rename_sigs sigs = mappM (wrapLocM renameSig)
+			 (filter (not . isFixityLSig) sigs)
+		-- Remove fixity sigs which have been dealt with already
+
+----------------------
+check_sigs :: (LSig Name -> Bool) -> [LSig Name] -> RnM ()
+-- Used for class and instance decls, as well as regular bindings
+check_sigs ok_sig sigs 
+	-- Check for (a) duplicate signatures
+	--	     (b) signatures for things not in this group
+  = do	{ mappM_ unknownSigErr (filter (not . ok_sig) sigs')
+	; mappM_ dupSigDeclErr (findDupsEq eqHsSig sigs') }
+  where
+	-- Don't complain about an unbound name again
+    sigs' = filterOut bad_name sigs
+    bad_name sig = case sigName sig of
+			Just n -> isUnboundName n
+			other  -> False
+
+-- We use lookupLocatedSigOccRn in the signatures, which is a little bit unsatisfactory
+-- because this won't work for:
+--	instance Foo T where
+--	  {-# INLINE op #-}
+--	  Baz.op = ...
+-- We'll just rename the INLINE prag to refer to whatever other 'op'
+-- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
+-- Doesn't seem worth much trouble to sort this.
+
+renameSig :: Sig RdrName -> RnM (Sig Name)
+-- FixitSig is renamed elsewhere.
+renameSig (TypeSig v ty)
+  = lookupLocatedSigOccRn v			`thenM` \ new_v ->
+    rnHsSigType (quotes (ppr v)) ty		`thenM` \ new_ty ->
+    returnM (TypeSig new_v new_ty)
+
+renameSig (SpecInstSig ty)
+  = rnLHsType (text "A SPECIALISE instance pragma") ty `thenM` \ new_ty ->
+    returnM (SpecInstSig new_ty)
+
+renameSig (SpecSig v ty inl)
+  = lookupLocatedSigOccRn v		`thenM` \ new_v ->
+    rnHsSigType (quotes (ppr v)) ty	`thenM` \ new_ty ->
+    returnM (SpecSig new_v new_ty inl)
+
+renameSig (InlineSig v s)
+  = lookupLocatedSigOccRn v		`thenM` \ new_v ->
+    returnM (InlineSig new_v s)
+\end{code}
+
+
+************************************************************************
+*									*
+\subsection{Match}
+*									*
+************************************************************************
+
+\begin{code}
+rnMatchGroup :: HsMatchContext Name -> MatchGroup RdrName -> RnM (MatchGroup Name, FreeVars)
+rnMatchGroup ctxt (MatchGroup ms _)
+  = mapFvRn (rnMatch ctxt) ms	`thenM` \ (new_ms, ms_fvs) ->
+    returnM (MatchGroup new_ms placeHolderType, ms_fvs)
+
+rnMatch :: HsMatchContext Name -> LMatch RdrName -> RnM (LMatch Name, FreeVars)
+rnMatch ctxt  = wrapLocFstM (rnMatch' ctxt)
+
+rnMatch' ctxt match@(Match pats maybe_rhs_sig grhss)
+  = 
+	-- Deal with the rhs type signature
+    bindPatSigTyVarsFV rhs_sig_tys	$ 
+    doptM Opt_GlasgowExts		`thenM` \ opt_GlasgowExts ->
+    (case maybe_rhs_sig of
+	Nothing -> returnM (Nothing, emptyFVs)
+	Just ty | opt_GlasgowExts -> rnHsTypeFVs doc_sig ty	`thenM` \ (ty', ty_fvs) ->
+				     returnM (Just ty', ty_fvs)
+		| otherwise	  -> addLocErr ty patSigErr	`thenM_`
+				     returnM (Nothing, emptyFVs)
+    )					`thenM` \ (maybe_rhs_sig', ty_fvs) ->
+
+	-- Now the main event
+    rnPatsAndThen ctxt pats	$ \ pats' ->
+    rnGRHSs ctxt grhss		`thenM` \ (grhss', grhss_fvs) ->
+
+    returnM (Match pats' maybe_rhs_sig' grhss', grhss_fvs `plusFV` ty_fvs)
+	-- The bindPatSigTyVarsFV and rnPatsAndThen will remove the bound FVs
+  where
+     rhs_sig_tys =  case maybe_rhs_sig of
+			Nothing -> []
+			Just ty -> [ty]
+     doc_sig = text "In a result type-signature"
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsubsection{Guarded right-hand sides (GRHSs)}
+%*									*
+%************************************************************************
+
+\begin{code}
+rnGRHSs :: HsMatchContext Name -> GRHSs RdrName -> RnM (GRHSs Name, FreeVars)
+
+rnGRHSs ctxt (GRHSs grhss binds)
+  = rnLocalBindsAndThen binds	$ \ binds' ->
+    mapFvRn (rnGRHS ctxt) grhss	`thenM` \ (grhss', fvGRHSs) ->
+    returnM (GRHSs grhss' binds', fvGRHSs)
+
+rnGRHS :: HsMatchContext Name -> LGRHS RdrName -> RnM (LGRHS Name, FreeVars)
+rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)
+
+rnGRHS' ctxt (GRHS guards rhs)
+  = do	{ opt_GlasgowExts <- doptM Opt_GlasgowExts
+	; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $
+				    rnLExpr rhs
+
+	; checkM (opt_GlasgowExts || is_standard_guard guards')
+	  	 (addWarn (nonStdGuardErr guards'))
+
+	; return (GRHS guards' rhs', fvs) }
+  where
+	-- Standard Haskell 1.4 guards are just a single boolean
+	-- expression, rather than a list of qualifiers as in the
+	-- Glasgow extension
+    is_standard_guard []                     = True
+    is_standard_guard [L _ (ExprStmt _ _ _)] = True
+    is_standard_guard other	      	     = False
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{Error messages}
+%*									*
+%************************************************************************
+
+\begin{code}
+dupSigDeclErr sigs@(L loc sig : _)
+  = addErrAt loc $
+	vcat [ptext SLIT("Duplicate") <+> what_it_is <> colon,
+	      nest 2 (vcat (map ppr_sig sigs))]
+  where
+    what_it_is = hsSigDoc sig
+    ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig
+
+unknownSigErr (L loc sig)
+  = addErrAt loc $
+	sep [ptext SLIT("Misplaced") <+> what_it_is <> colon, ppr sig]
+  where
+    what_it_is = hsSigDoc sig
+
+missingSigWarn var
+  = addWarnAt (mkSrcSpan loc loc) $
+      sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)]
+  where 
+    loc = nameSrcLoc var  -- TODO: make a proper span
+
+methodBindErr mbind
+ =  hang (ptext SLIT("Pattern bindings (except simple variables) not allowed in instance declarations"))
+       2 (ppr mbind)
+
+bindsInHsBootFile mbinds
+  = hang (ptext SLIT("Bindings in hs-boot files are not allowed"))
+       2 (ppr mbinds)
+
+nonStdGuardErr guards
+  = hang (ptext SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)"))
+       4 (interpp'SP guards)
+\end{code}
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
new file mode 100644
index 0000000000..2be3bfd5c0
--- /dev/null
+++ b/compiler/rename/RnEnv.lhs
@@ -0,0 +1,811 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[RnEnv]{Environment manipulation for the renamer monad}
+
+\begin{code}
+module RnEnv ( 
+	newTopSrcBinder, 
+	lookupLocatedBndrRn, lookupBndrRn, 
+	lookupLocatedTopBndrRn, lookupTopBndrRn,
+	lookupLocatedOccRn, lookupOccRn, 
+	lookupLocatedGlobalOccRn, lookupGlobalOccRn,
+	lookupLocalDataTcNames, lookupSrcOcc_maybe,
+	lookupFixityRn, lookupTyFixityRn, lookupLocatedSigOccRn, 
+	lookupLocatedInstDeclBndr,
+	lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
+
+	newLocalsRn, newIPNameRn,
+	bindLocalNames, bindLocalNamesFV,
+	bindLocatedLocalsFV, bindLocatedLocalsRn,
+	bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
+	bindTyVarsRn, extendTyVarEnvFVRn,
+	bindLocalFixities,
+
+	checkDupNames, mapFvRn,
+	warnUnusedMatches, warnUnusedModules, warnUnusedImports, 
+	warnUnusedTopBinds, warnUnusedLocalBinds,
+	dataTcOccs, unknownNameErr,
+    ) where
+
+#include "HsVersions.h"
+
+import LoadIface	( loadHomeInterface, loadSrcInterface )
+import IfaceEnv		( lookupOrig, newGlobalBinder, newIPName )
+import HsSyn		( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable,
+			  LHsTyVarBndr, LHsType, 
+			  Fixity, hsLTyVarLocNames, replaceTyVarName )
+import RdrHsSyn		( extractHsTyRdrTyVars )
+import RdrName		( RdrName, rdrNameModule, isQual, isUnqual, isOrig,
+			  mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
+			  pprGlobalRdrEnv, lookupGRE_RdrName, 
+			  isExact_maybe, isSrcRdrName,
+			  GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv, 
+			  isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
+			  Provenance(..), pprNameProvenance,
+			  importSpecLoc, importSpecModule
+			)
+import HscTypes		( availNames, ModIface(..), FixItem(..), lookupFixity )
+import TcRnMonad
+import Name		( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
+			  nameSrcLoc, nameOccName, nameModule, nameParent, isExternalName )
+import NameSet
+import OccName		( tcName, isDataOcc, pprNonVarNameSpace, occNameSpace,
+			  reportIfUnused )
+import Module		( Module )
+import PrelNames	( mkUnboundName, rOOT_MAIN, iNTERACTIVE, consDataConKey, hasKey )
+import UniqSupply
+import BasicTypes	( IPName, mapIPName )
+import SrcLoc		( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc,
+			  srcLocSpan, getLoc, combineSrcSpans, srcSpanStartLine, srcSpanEndLine )
+import Outputable
+import Util		( sortLe )
+import ListSetOps	( removeDups )
+import List		( nubBy )
+import Monad		( when )
+import DynFlags
+\end{code}
+
+%*********************************************************
+%*							*
+		Source-code binders
+%*							*
+%*********************************************************
+
+\begin{code}
+newTopSrcBinder :: Module -> Maybe Name -> Located RdrName -> RnM Name
+newTopSrcBinder this_mod mb_parent (L loc rdr_name)
+  | Just name <- isExact_maybe rdr_name
+  =	-- This is here to catch 
+	--   (a) Exact-name binders created by Template Haskell
+	--   (b) The PrelBase defn of (say) [] and similar, for which
+	--	 the parser reads the special syntax and returns an Exact RdrName
+   	-- We are at a binding site for the name, so check first that it 
+	-- the current module is the correct one; otherwise GHC can get
+	-- very confused indeed. This test rejects code like
+	--	data T = (,) Int Int
+	-- unless we are in GHC.Tup
+    ASSERT2( isExternalName name,  ppr name )
+    do	checkErr (this_mod == nameModule name)
+	         (badOrigBinding rdr_name)
+	returnM name
+
+
+  | isOrig rdr_name
+  = do	checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
+	         (badOrigBinding rdr_name)
+	-- When reading External Core we get Orig names as binders, 
+	-- but they should agree with the module gotten from the monad
+	--
+	-- We can get built-in syntax showing up here too, sadly.  If you type
+	--	data T = (,,,)
+	-- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon 
+	-- uses setRdrNameSpace to make it into a data constructors.  At that point
+	-- the nice Exact name for the TyCon gets swizzled to an Orig name.
+	-- Hence the badOrigBinding error message.
+	--
+	-- Except for the ":Main.main = ..." definition inserted into 
+	-- the Main module; ugh!
+
+	-- Because of this latter case, we call newGlobalBinder with a module from 
+	-- the RdrName, not from the environment.  In principle, it'd be fine to 
+	-- have an arbitrary mixture of external core definitions in a single module,
+	-- (apart from module-initialisation issues, perhaps).
+	newGlobalBinder rdr_mod (rdrNameOcc rdr_name) mb_parent 
+	    	        (srcSpanStart loc) --TODO, should pass the whole span
+
+  | otherwise
+  = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc)
+  where
+    rdr_mod  = rdrNameModule rdr_name
+\end{code}
+
+%*********************************************************
+%*							*
+	Source code occurrences
+%*							*
+%*********************************************************
+
+Looking up a name in the RnEnv.
+
+\begin{code}
+lookupLocatedBndrRn :: Located RdrName -> RnM (Located Name)
+lookupLocatedBndrRn = wrapLocM lookupBndrRn
+
+lookupBndrRn :: RdrName -> RnM Name
+-- NOTE: assumes that the SrcSpan of the binder has already been setSrcSpan'd
+lookupBndrRn rdr_name
+  = getLocalRdrEnv		`thenM` \ local_env ->
+    case lookupLocalRdrEnv local_env rdr_name of 
+	  Just name -> returnM name
+	  Nothing   -> lookupTopBndrRn rdr_name
+
+lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
+lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn
+
+lookupTopBndrRn :: RdrName -> RnM Name
+-- Look up a top-level source-code binder.   We may be looking up an unqualified 'f',
+-- and there may be several imported 'f's too, which must not confuse us.
+-- For example, this is OK:
+--	import Foo( f )
+--	infix 9 f	-- The 'f' here does not need to be qualified
+--	f x = x		-- Nor here, of course
+-- So we have to filter out the non-local ones.
+--
+-- A separate function (importsFromLocalDecls) reports duplicate top level
+-- decls, so here it's safe just to choose an arbitrary one.
+--
+-- There should never be a qualified name in a binding position in Haskell,
+-- but there can be if we have read in an external-Core file.
+-- The Haskell parser checks for the illegal qualified name in Haskell 
+-- source files, so we don't need to do so here.
+
+lookupTopBndrRn rdr_name
+  | Just name <- isExact_maybe rdr_name
+  = returnM name
+
+  | isOrig rdr_name	
+	-- This deals with the case of derived bindings, where
+	-- we don't bother to call newTopSrcBinder first
+	-- We assume there is no "parent" name
+  = do	{ loc <- getSrcSpanM
+	; newGlobalBinder (rdrNameModule rdr_name)
+		          (rdrNameOcc rdr_name) Nothing (srcSpanStart loc) }
+
+  | otherwise
+  = do	{ mb_gre <- lookupGreLocalRn rdr_name
+	; case mb_gre of
+		Nothing  -> unboundName rdr_name
+		Just gre -> returnM (gre_name gre) }
+	      
+-- lookupLocatedSigOccRn is used for type signatures and pragmas
+-- Is this valid?
+--   module A
+--	import M( f )
+--	f :: Int -> Int
+--	f x = x
+-- It's clear that the 'f' in the signature must refer to A.f
+-- The Haskell98 report does not stipulate this, but it will!
+-- So we must treat the 'f' in the signature in the same way
+-- as the binding occurrence of 'f', using lookupBndrRn
+lookupLocatedSigOccRn :: Located RdrName -> RnM (Located Name)
+lookupLocatedSigOccRn = lookupLocatedBndrRn
+
+-- lookupInstDeclBndr is used for the binders in an 
+-- instance declaration.   Here we use the class name to
+-- disambiguate.  
+
+lookupLocatedInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name)
+lookupLocatedInstDeclBndr cls = wrapLocM (lookupInstDeclBndr cls)
+
+lookupInstDeclBndr :: Name -> RdrName -> RnM Name
+lookupInstDeclBndr cls_name rdr_name
+  | isUnqual rdr_name	-- Find all the things the rdr-name maps to
+  = do	{		-- and pick the one with the right parent name
+	  let { is_op gre     = cls_name == nameParent (gre_name gre)
+	      ; occ	      = rdrNameOcc rdr_name
+	      ; lookup_fn env = filter is_op (lookupGlobalRdrEnv env occ) }
+	; mb_gre <- lookupGreRn_help rdr_name lookup_fn
+	; case mb_gre of
+	    Just gre -> return (gre_name gre)
+	    Nothing  -> do { addErr (unknownInstBndrErr cls_name rdr_name)
+			   ; return (mkUnboundName rdr_name) } }
+
+  | otherwise	-- Occurs in derived instances, where we just
+		-- refer directly to the right method
+  = ASSERT2( not (isQual rdr_name), ppr rdr_name )
+	  -- NB: qualified names are rejected by the parser
+    lookupImportedName rdr_name
+
+newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
+newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
+
+--------------------------------------------------
+--		Occurrences
+--------------------------------------------------
+
+lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
+lookupLocatedOccRn = wrapLocM lookupOccRn
+
+-- lookupOccRn looks up an occurrence of a RdrName
+lookupOccRn :: RdrName -> RnM Name
+lookupOccRn rdr_name
+  = getLocalRdrEnv			`thenM` \ local_env ->
+    case lookupLocalRdrEnv local_env rdr_name of
+	  Just name -> returnM name
+	  Nothing   -> lookupGlobalOccRn rdr_name
+
+lookupLocatedGlobalOccRn :: Located RdrName -> RnM (Located Name)
+lookupLocatedGlobalOccRn = wrapLocM lookupGlobalOccRn
+
+lookupGlobalOccRn :: RdrName -> RnM Name
+-- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global 
+-- environment.  It's used only for
+--	record field names
+--	class op names in class and instance decls
+
+lookupGlobalOccRn rdr_name
+  | not (isSrcRdrName rdr_name)
+  = lookupImportedName rdr_name	
+
+  | otherwise
+  =	-- First look up the name in the normal environment.
+   lookupGreRn rdr_name			`thenM` \ mb_gre ->
+   case mb_gre of {
+	Just gre -> returnM (gre_name gre) ;
+	Nothing   -> 
+
+	-- We allow qualified names on the command line to refer to 
+	--  *any* name exported by any module in scope, just as if 
+	-- there was an "import qualified M" declaration for every 
+	-- module.
+   getModule 		`thenM` \ mod ->
+   if isQual rdr_name && mod == iNTERACTIVE then	
+					-- This test is not expensive,
+	lookupQualifiedName rdr_name	-- and only happens for failed lookups
+   else	
+	unboundName rdr_name }
+
+lookupImportedName :: RdrName -> TcRnIf m n Name
+-- Lookup the occurrence of an imported name
+-- The RdrName is *always* qualified or Exact
+-- Treat it as an original name, and conjure up the Name
+-- Usually it's Exact or Orig, but it can be Qual if it
+--	comes from an hi-boot file.  (This minor infelicity is 
+--	just to reduce duplication in the parser.)
+lookupImportedName rdr_name
+  | Just n <- isExact_maybe rdr_name 
+	-- This happens in derived code
+  = returnM n
+
+  | otherwise	-- Always Orig, even when reading a .hi-boot file
+  = ASSERT( not (isUnqual rdr_name) )
+    lookupOrig (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
+
+unboundName :: RdrName -> RnM Name
+unboundName rdr_name 
+  = do	{ addErr (unknownNameErr rdr_name)
+	; env <- getGlobalRdrEnv;
+	; traceRn (vcat [unknownNameErr rdr_name, 
+			 ptext SLIT("Global envt is:"),
+			 nest 3 (pprGlobalRdrEnv env)])
+	; returnM (mkUnboundName rdr_name) }
+
+--------------------------------------------------
+--	Lookup in the Global RdrEnv of the module
+--------------------------------------------------
+
+lookupSrcOcc_maybe :: RdrName -> RnM (Maybe Name)
+-- No filter function; does not report an error on failure
+lookupSrcOcc_maybe rdr_name
+  = do	{ mb_gre <- lookupGreRn rdr_name
+	; case mb_gre of
+		Nothing  -> returnM Nothing
+		Just gre -> returnM (Just (gre_name gre)) }
+	
+-------------------------
+lookupGreRn :: RdrName -> RnM (Maybe GlobalRdrElt)
+-- Just look up the RdrName in the GlobalRdrEnv
+lookupGreRn rdr_name 
+  = lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)
+
+lookupGreLocalRn :: RdrName -> RnM (Maybe GlobalRdrElt)
+-- Similar, but restricted to locally-defined things
+lookupGreLocalRn rdr_name 
+  = lookupGreRn_help rdr_name lookup_fn
+  where
+    lookup_fn env = filter isLocalGRE (lookupGRE_RdrName rdr_name env)
+
+lookupGreRn_help :: RdrName			-- Only used in error message
+		 -> (GlobalRdrEnv -> [GlobalRdrElt])	-- Lookup function
+		 -> RnM (Maybe GlobalRdrElt)
+-- Checks for exactly one match; reports deprecations
+-- Returns Nothing, without error, if too few
+lookupGreRn_help rdr_name lookup 
+  = do	{ env <- getGlobalRdrEnv
+	; case lookup env of
+	    []	  -> returnM Nothing
+	    [gre] -> returnM (Just gre)
+	    gres  -> do { addNameClashErrRn rdr_name gres
+			; returnM (Just (head gres)) } }
+
+------------------------------
+--	GHCi support
+------------------------------
+
+-- A qualified name on the command line can refer to any module at all: we
+-- try to load the interface if we don't already have it.
+lookupQualifiedName :: RdrName -> RnM Name
+lookupQualifiedName rdr_name
+ = let 
+       mod = rdrNameModule rdr_name
+       occ = rdrNameOcc rdr_name
+   in
+   -- Note: we want to behave as we would for a source file import here,
+   -- and respect hiddenness of modules/packages, hence loadSrcInterface.
+   loadSrcInterface doc mod False	`thenM` \ iface ->
+
+   case  [ (mod,occ) | 
+	   (mod,avails) <- mi_exports iface,
+    	   avail	<- avails,
+    	   name 	<- availNames avail,
+    	   name == occ ] of
+      ((mod,occ):ns) -> ASSERT (null ns) 
+			lookupOrig mod occ
+      _ -> unboundName rdr_name
+  where
+    doc = ptext SLIT("Need to find") <+> ppr rdr_name
+\end{code}
+
+%*********************************************************
+%*							*
+		Fixities
+%*							*
+%*********************************************************
+
+\begin{code}
+lookupLocalDataTcNames :: RdrName -> RnM [Name]
+-- GHC extension: look up both the tycon and data con 
+-- for con-like things
+-- Complain if neither is in scope
+lookupLocalDataTcNames rdr_name
+  | Just n <- isExact_maybe rdr_name	
+	-- Special case for (:), which doesn't get into the GlobalRdrEnv
+  = return [n]	-- For this we don't need to try the tycon too
+  | otherwise
+  = do	{ mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name)
+	; case [gre_name gre | Just gre <- mb_gres] of
+	    [] -> do { addErr (unknownNameErr rdr_name)
+		     ; return [] }
+	    names -> return names
+    }
+
+--------------------------------
+bindLocalFixities :: [FixitySig RdrName] -> RnM a -> RnM a
+-- Used for nested fixity decls
+-- No need to worry about type constructors here,
+-- Should check for duplicates but we don't
+bindLocalFixities fixes thing_inside
+  | null fixes = thing_inside
+  | otherwise  = mappM rn_sig fixes	`thenM` \ new_bit ->
+		 extendFixityEnv new_bit thing_inside
+  where
+    rn_sig (FixitySig lv@(L loc v) fix)
+	= addLocM lookupBndrRn lv	`thenM` \ new_v ->
+	  returnM (new_v, (FixItem (rdrNameOcc v) fix loc))
+\end{code}
+
+--------------------------------
+lookupFixity is a bit strange.  
+
+* Nested local fixity decls are put in the local fixity env, which we
+  find with getFixtyEnv
+
+* Imported fixities are found in the HIT or PIT
+
+* Top-level fixity decls in this module may be for Names that are
+    either  Global	   (constructors, class operations)
+    or 	    Local/Exported (everything else)
+  (See notes with RnNames.getLocalDeclBinders for why we have this split.)
+  We put them all in the local fixity environment
+
+\begin{code}
+lookupFixityRn :: Name -> RnM Fixity
+lookupFixityRn name
+  = getModule				`thenM` \ this_mod ->
+    if nameIsLocalOrFrom this_mod name
+    then	-- It's defined in this module
+	getFixityEnv		`thenM` \ local_fix_env ->
+	traceRn (text "lookupFixityRn" <+> (ppr name $$ ppr local_fix_env)) `thenM_`
+	returnM (lookupFixity local_fix_env name)
+
+    else	-- It's imported
+      -- For imported names, we have to get their fixities by doing a
+      -- loadHomeInterface, and consulting the Ifaces that comes back
+      -- from that, because the interface file for the Name might not
+      -- have been loaded yet.  Why not?  Suppose you import module A,
+      -- which exports a function 'f', thus;
+      --        module CurrentModule where
+      --	  import A( f )
+      -- 	module A( f ) where
+      --	  import B( f )
+      -- Then B isn't loaded right away (after all, it's possible that
+      -- nothing from B will be used).  When we come across a use of
+      -- 'f', we need to know its fixity, and it's then, and only
+      -- then, that we load B.hi.  That is what's happening here.
+      --
+      -- loadHomeInterface will find B.hi even if B is a hidden module,
+      -- and that's what we want.
+        loadHomeInterface doc name	`thenM` \ iface ->
+	returnM (mi_fix_fn iface (nameOccName name))
+  where
+    doc = ptext SLIT("Checking fixity for") <+> ppr name
+
+---------------
+lookupTyFixityRn :: Located Name -> RnM Fixity
+lookupTyFixityRn (L loc n)
+  = doptM Opt_GlasgowExts 			`thenM` \ glaExts ->
+    when (not glaExts) 
+    	 (setSrcSpan loc $ addWarn (infixTyConWarn n))	`thenM_`
+    lookupFixityRn n
+
+---------------
+dataTcOccs :: RdrName -> [RdrName]
+-- If the input is a data constructor, return both it and a type
+-- constructor.  This is useful when we aren't sure which we are
+-- looking at.
+dataTcOccs rdr_name
+  | Just n <- isExact_maybe rdr_name		-- Ghastly special case
+  , n `hasKey` consDataConKey = [rdr_name]	-- see note below
+  | isDataOcc occ 	      = [rdr_name_tc, rdr_name]
+  | otherwise 	  	      = [rdr_name]
+  where    
+    occ 	= rdrNameOcc rdr_name
+    rdr_name_tc = setRdrNameSpace rdr_name tcName
+
+-- If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
+-- and setRdrNameSpace generates an Orig, which is fine
+-- But it's not fine for (:), because there *is* no corresponding type
+-- constructor.  If we generate an Orig tycon for GHC.Base.(:), it'll
+-- appear to be in scope (because Orig's simply allocate a new name-cache
+-- entry) and then we get an error when we use dataTcOccs in 
+-- TcRnDriver.tcRnGetInfo.  Large sigh.
+\end{code}
+
+%************************************************************************
+%*									*
+			Rebindable names
+	Dealing with rebindable syntax is driven by the 
+	Opt_NoImplicitPrelude dynamic flag.
+
+	In "deriving" code we don't want to use rebindable syntax
+	so we switch off the flag locally
+
+%*									*
+%************************************************************************
+
+Haskell 98 says that when you say "3" you get the "fromInteger" from the
+Standard Prelude, regardless of what is in scope.   However, to experiment
+with having a language that is less coupled to the standard prelude, we're
+trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
+happens to be in scope.  Then you can
+	import Prelude ()
+	import MyPrelude as Prelude
+to get the desired effect.
+
+At the moment this just happens for
+  * fromInteger, fromRational on literals (in expressions and patterns)
+  * negate (in expressions)
+  * minus  (arising from n+k patterns)
+  * "do" notation
+
+We store the relevant Name in the HsSyn tree, in 
+  * HsIntegral/HsFractional	
+  * NegApp
+  * NPlusKPat
+  * HsDo
+respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
+fromRationalName etc), but the renamer changes this to the appropriate user
+name if Opt_NoImplicitPrelude is on.  That is what lookupSyntaxName does.
+
+We treat the orignal (standard) names as free-vars too, because the type checker
+checks the type of the user thing against the type of the standard thing.
+
+\begin{code}
+lookupSyntaxName :: Name 				-- The standard name
+	         -> RnM (SyntaxExpr Name, FreeVars)	-- Possibly a non-standard name
+lookupSyntaxName std_name
+  = doptM Opt_ImplicitPrelude		`thenM` \ implicit_prelude -> 
+    if implicit_prelude then normal_case
+    else
+	-- Get the similarly named thing from the local environment
+    lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
+    returnM (HsVar usr_name, unitFV usr_name)
+  where
+    normal_case = returnM (HsVar std_name, emptyFVs)
+
+lookupSyntaxTable :: [Name]				-- Standard names
+		  -> RnM (SyntaxTable Name, FreeVars)	-- See comments with HsExpr.ReboundNames
+lookupSyntaxTable std_names
+  = doptM Opt_ImplicitPrelude		`thenM` \ implicit_prelude -> 
+    if implicit_prelude then normal_case 
+    else
+    	-- Get the similarly named thing from the local environment
+    mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names 	`thenM` \ usr_names ->
+
+    returnM (std_names `zip` map HsVar usr_names, mkFVs usr_names)
+  where
+    normal_case = returnM (std_names `zip` map HsVar std_names, emptyFVs)
+\end{code}
+
+
+%*********************************************************
+%*							*
+\subsection{Binding}
+%*							*
+%*********************************************************
+
+\begin{code}
+newLocalsRn :: [Located RdrName] -> RnM [Name]
+newLocalsRn rdr_names_w_loc
+  = newUniqueSupply 		`thenM` \ us ->
+    returnM (zipWith mk rdr_names_w_loc (uniqsFromSupply us))
+  where
+    mk (L loc rdr_name) uniq
+	| Just name <- isExact_maybe rdr_name = name
+		-- This happens in code generated by Template Haskell 
+	| otherwise = ASSERT2( isUnqual rdr_name, ppr rdr_name )
+			-- We only bind unqualified names here
+			-- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
+		      mkInternalName uniq (rdrNameOcc rdr_name) (srcSpanStart loc)
+
+bindLocatedLocalsRn :: SDoc	-- Documentation string for error message
+	   	    -> [Located RdrName]
+	    	    -> ([Name] -> RnM a)
+	    	    -> RnM a
+bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
+  = 	-- Check for duplicate names
+    checkDupNames doc_str rdr_names_w_loc	`thenM_`
+
+    	-- Warn about shadowing, but only in source modules
+    ifOptM Opt_WarnNameShadowing 
+      (checkShadowing doc_str rdr_names_w_loc)	`thenM_`
+
+	-- Make fresh Names and extend the environment
+    newLocalsRn rdr_names_w_loc		`thenM` \ names ->
+    getLocalRdrEnv			`thenM` \ local_env ->
+    setLocalRdrEnv (extendLocalRdrEnv local_env names)
+		   (enclosed_scope names)
+
+
+bindLocalNames :: [Name] -> RnM a -> RnM a
+bindLocalNames names enclosed_scope
+  = getLocalRdrEnv 		`thenM` \ name_env ->
+    setLocalRdrEnv (extendLocalRdrEnv name_env names)
+		    enclosed_scope
+
+bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
+bindLocalNamesFV names enclosed_scope
+  = do	{ (result, fvs) <- bindLocalNames names enclosed_scope
+	; returnM (result, delListFromNameSet fvs names) }
+
+
+-------------------------------------
+	-- binLocalsFVRn is the same as bindLocalsRn
+	-- except that it deals with free vars
+bindLocatedLocalsFV :: SDoc -> [Located RdrName] -> ([Name] -> RnM (a,FreeVars))
+  -> RnM (a, FreeVars)
+bindLocatedLocalsFV doc rdr_names enclosed_scope
+  = bindLocatedLocalsRn doc rdr_names	$ \ names ->
+    enclosed_scope names		`thenM` \ (thing, fvs) ->
+    returnM (thing, delListFromNameSet fvs names)
+
+-------------------------------------
+bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
+	      -> ([LHsTyVarBndr Name] -> RnM a)
+	      -> RnM a
+-- Haskell-98 binding of type variables; e.g. within a data type decl
+bindTyVarsRn doc_str tyvar_names enclosed_scope
+  = let
+	located_tyvars = hsLTyVarLocNames tyvar_names
+    in
+    bindLocatedLocalsRn doc_str located_tyvars	$ \ names ->
+    enclosed_scope (zipWith replace tyvar_names names)
+    where 
+	replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)
+
+bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
+  -- Find the type variables in the pattern type 
+  -- signatures that must be brought into scope
+bindPatSigTyVars tys thing_inside
+  = do 	{ scoped_tyvars <- doptM Opt_ScopedTypeVariables
+	; if not scoped_tyvars then 
+		thing_inside []
+	  else 
+    do 	{ name_env <- getLocalRdrEnv
+	; let locd_tvs  = [ tv | ty <- tys
+			       , tv <- extractHsTyRdrTyVars ty
+			       , not (unLoc tv `elemLocalRdrEnv` name_env) ]
+	      nubbed_tvs = nubBy eqLocated locd_tvs
+		-- The 'nub' is important.  For example:
+		--	f (x :: t) (y :: t) = ....
+		-- We don't want to complain about binding t twice!
+
+	; bindLocatedLocalsRn doc_sig nubbed_tvs thing_inside }}
+  where
+    doc_sig = text "In a pattern type-signature"
+
+bindPatSigTyVarsFV :: [LHsType RdrName]
+		   -> RnM (a, FreeVars)
+	  	   -> RnM (a, FreeVars)
+bindPatSigTyVarsFV tys thing_inside
+  = bindPatSigTyVars tys	$ \ tvs ->
+    thing_inside		`thenM` \ (result,fvs) ->
+    returnM (result, fvs `delListFromNameSet` tvs)
+
+bindSigTyVarsFV :: [Name]
+		-> RnM (a, FreeVars)
+	  	-> RnM (a, FreeVars)
+bindSigTyVarsFV tvs thing_inside
+  = do	{ scoped_tyvars <- doptM Opt_ScopedTypeVariables
+	; if not scoped_tyvars then 
+		thing_inside 
+	  else
+		bindLocalNamesFV tvs thing_inside }
+
+extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
+	-- This function is used only in rnSourceDecl on InstDecl
+extendTyVarEnvFVRn tyvars thing_inside = bindLocalNamesFV tyvars thing_inside
+
+-------------------------------------
+checkDupNames :: SDoc
+	      -> [Located RdrName]
+	      -> RnM ()
+checkDupNames doc_str rdr_names_w_loc
+  = 	-- Check for duplicated names in a binding group
+    mappM_ (dupNamesErr doc_str) dups
+  where
+    (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
+
+-------------------------------------
+checkShadowing doc_str loc_rdr_names
+  = getLocalRdrEnv		`thenM` \ local_env ->
+    getGlobalRdrEnv		`thenM` \ global_env ->
+    let
+      check_shadow (L loc rdr_name)
+	|  rdr_name `elemLocalRdrEnv` local_env 
+ 	|| not (null (lookupGRE_RdrName rdr_name global_env ))
+	= setSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name)
+        | otherwise = returnM ()
+    in
+    mappM_ check_shadow loc_rdr_names
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Free variable manipulation}
+%*									*
+%************************************************************************
+
+\begin{code}
+-- A useful utility
+mapFvRn f xs = mappM f xs	`thenM` \ stuff ->
+	       let
+		  (ys, fvs_s) = unzip stuff
+	       in
+	       returnM (ys, plusFVs fvs_s)
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Envt utility functions}
+%*									*
+%************************************************************************
+
+\begin{code}
+warnUnusedModules :: [(Module,SrcSpan)] -> RnM ()
+warnUnusedModules mods
+  = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
+  where
+    bleat (mod,loc) = setSrcSpan loc $ addWarn (mk_warn mod)
+    mk_warn m = vcat [ptext SLIT("Module") <+> quotes (ppr m)
+			<+> text "is imported, but nothing from it is used,",
+		      nest 2 (ptext SLIT("except perhaps instances visible in") 
+			<+> quotes (ppr m)),
+		      ptext SLIT("To suppress this warning, use:") 
+			<+> ptext SLIT("import") <+> ppr m <> parens empty ]
+
+
+warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
+warnUnusedImports gres  = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres)
+warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds   (warnUnusedGREs gres)
+
+warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM ()
+warnUnusedLocalBinds names = ifOptM Opt_WarnUnusedBinds   (warnUnusedLocals names)
+warnUnusedMatches    names = ifOptM Opt_WarnUnusedMatches (warnUnusedLocals names)
+
+-------------------------
+--	Helpers
+warnUnusedGREs gres 
+ = warnUnusedBinds [(n,Just p) | GRE {gre_name = n, gre_prov = p} <- gres]
+
+warnUnusedLocals names
+ = warnUnusedBinds [(n,Nothing) | n<-names]
+
+warnUnusedBinds :: [(Name,Maybe Provenance)] -> RnM ()
+warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
+ where reportable (name,_) 
+	| isWiredInName name = False	-- Don't report unused wired-in names
+					-- Otherwise we get a zillion warnings
+					-- from Data.Tuple
+	| otherwise = reportIfUnused (nameOccName name)
+
+-------------------------
+
+warnUnusedName :: (Name, Maybe Provenance) -> RnM ()
+warnUnusedName (name, prov)
+  = addWarnAt loc $
+    sep [msg <> colon, 
+	 nest 2 $ pprNonVarNameSpace (occNameSpace (nameOccName name))
+			<+> quotes (ppr name)]
+	-- TODO should be a proper span
+  where
+    (loc,msg) = case prov of
+		  Just (Imported is)
+		        -> (importSpecLoc imp_spec, imp_from (importSpecModule imp_spec))
+		        where
+			  imp_spec = head is
+		  other -> (srcLocSpan (nameSrcLoc name), unused_msg)
+
+    unused_msg   = text "Defined but not used"
+    imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
+\end{code}
+
+\begin{code}
+addNameClashErrRn rdr_name (np1:nps)
+  = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
+		  ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
+  where
+    msg1 = ptext  SLIT("either") <+> mk_ref np1
+    msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
+    mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
+
+shadowedNameWarn doc shadow
+  = hsep [ptext SLIT("This binding for"), 
+	       quotes (ppr shadow),
+	       ptext SLIT("shadows an existing binding")]
+    $$ doc
+
+unknownNameErr rdr_name
+  = sep [ptext SLIT("Not in scope:"), 
+	 nest 2 $ pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
+		  <+> quotes (ppr rdr_name)]
+
+unknownInstBndrErr cls op
+  = quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)
+
+badOrigBinding name
+  = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
+	-- The rdrNameOcc is because we don't want to print Prelude.(,)
+
+dupNamesErr :: SDoc -> [Located RdrName] -> RnM ()
+dupNamesErr descriptor located_names
+  = setSrcSpan big_loc $
+    addErr (vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1),
+		  locations,
+		  descriptor])
+  where
+    L _ name1 = head located_names
+    locs      = map getLoc located_names
+    big_loc   = foldr1 combineSrcSpans locs
+    one_line  = srcSpanStartLine big_loc == srcSpanEndLine big_loc
+    locations | one_line  = empty 
+	      | otherwise = ptext SLIT("Bound at:") <+> 
+			    vcat (map ppr (sortLe (<=) locs))
+
+infixTyConWarn op
+  = vcat [ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op),
+	  ftext FSLIT("Use -fglasgow-exts to avoid this warning")]
+\end{code}
diff --git a/compiler/rename/RnExpr.hi-boot-6 b/compiler/rename/RnExpr.hi-boot-6
new file mode 100644
index 0000000000..8f6c7f154b
--- /dev/null
+++ b/compiler/rename/RnExpr.hi-boot-6
@@ -0,0 +1,11 @@
+module RnExpr where

+

+rnLExpr :: HsExpr.LHsExpr RdrName.RdrName

+	-> TcRnTypes.RnM (HsExpr.LHsExpr Name.Name, NameSet.FreeVars)

+

+rnStmts :: forall thing.

+	   HsExpr.HsStmtContext Name.Name -> [HsExpr.LStmt RdrName.RdrName] 

+	-> TcRnTypes.RnM (thing, NameSet.FreeVars)

+	-> TcRnTypes.RnM (([HsExpr.LStmt Name.Name], thing), NameSet.FreeVars)

+

+

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
new file mode 100644
index 0000000000..716a85a3b3
--- /dev/null
+++ b/compiler/rename/RnExpr.lhs
@@ -0,0 +1,996 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[RnExpr]{Renaming of expressions}
+
+Basically dependency analysis.
+
+Handles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes.  In
+general, all of these functions return a renamed thing, and a set of
+free variables.
+
+\begin{code}
+module RnExpr (
+	rnLExpr, rnExpr, rnStmts
+   ) where
+
+#include "HsVersions.h"
+
+import RnSource  ( rnSrcDecls, rnSplice, checkTH ) 
+import RnBinds	 ( rnLocalBindsAndThen, rnValBinds,
+		   rnMatchGroup, trimWith ) 
+import HsSyn
+import RnHsSyn
+import TcRnMonad
+import RnEnv
+import OccName		( plusOccEnv )
+import RnNames		( getLocalDeclBinders, extendRdrEnvRn )
+import RnTypes		( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit,
+			  mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec, 
+			  dupFieldErr, checkTupSize )
+import DynFlags		( DynFlag(..) )
+import BasicTypes	( FixityDirection(..) )
+import PrelNames	( thFAKE, hasKey, assertIdKey, assertErrorName,
+			  loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
+			  negateName, thenMName, bindMName, failMName )
+#if defined(GHCI) && defined(BREAKPOINT)
+import PrelNames        ( breakpointJumpName, undefined_RDR, breakpointIdKey )
+import UniqFM           ( eltsUFM )
+import DynFlags         ( GhcMode(..) )
+import SrcLoc           ( srcSpanFile, srcSpanStartLine )
+import Name             ( isTyVarName )
+#endif
+import Name		( Name, nameOccName, nameIsLocalOrFrom )
+import NameSet
+import RdrName		( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv )
+import LoadIface	( loadHomeInterface )
+import UniqFM		( isNullUFM )
+import UniqSet		( emptyUniqSet )
+import List		( nub )
+import Util		( isSingleton )
+import ListSetOps	( removeDups )
+import Maybes		( expectJust )
+import Outputable
+import SrcLoc		( Located(..), unLoc, getLoc, cmpLocated )
+import FastString
+
+import List		( unzip4 )
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsubsection{Expressions}
+%*									*
+%************************************************************************
+
+\begin{code}
+rnExprs :: [LHsExpr RdrName] -> RnM ([LHsExpr Name], FreeVars)
+rnExprs ls = rnExprs' ls emptyUniqSet
+ where
+  rnExprs' [] acc = returnM ([], acc)
+  rnExprs' (expr:exprs) acc
+   = rnLExpr expr 	        `thenM` \ (expr', fvExpr) ->
+
+	-- Now we do a "seq" on the free vars because typically it's small
+	-- or empty, especially in very long lists of constants
+    let
+	acc' = acc `plusFV` fvExpr
+    in
+    (grubby_seqNameSet acc' rnExprs') exprs acc'	`thenM` \ (exprs', fvExprs) ->
+    returnM (expr':exprs', fvExprs)
+
+-- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
+grubby_seqNameSet ns result | isNullUFM ns = result
+			    | otherwise    = result
+\end{code}
+
+Variables. We look up the variable and return the resulting name. 
+
+\begin{code}
+rnLExpr :: LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars)
+rnLExpr = wrapLocFstM rnExpr
+
+rnExpr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
+
+rnExpr (HsVar v)
+  = do name           <- lookupOccRn v
+       localRdrEnv    <- getLocalRdrEnv
+       lclEnv         <- getLclEnv
+       ignore_asserts <- doptM Opt_IgnoreAsserts
+       ignore_breakpoints <- doptM Opt_IgnoreBreakpoints
+       let conds = [ (name `hasKey` assertIdKey
+                      && not ignore_asserts,
+                      do (e, fvs) <- mkAssertErrorExpr
+                         return (e, fvs `addOneFV` name))
+#if defined(GHCI) && defined(BREAKPOINT)
+                   , (name `hasKey` breakpointIdKey
+                      && not ignore_breakpoints,
+                      do ghcMode <- getGhcMode
+                         case ghcMode of
+                           Interactive
+                               -> do let isWantedName = not.isTyVarName
+                                     (e, fvs) <- mkBreakPointExpr (filter isWantedName (eltsUFM localRdrEnv))
+                                     return (e, fvs `addOneFV` name)
+                           _ -> return (HsVar name, unitFV name)
+                     )
+#endif
+                   ]
+       case lookup True conds of
+         Just action -> action
+         Nothing     -> return (HsVar name, unitFV name)
+
+rnExpr (HsIPVar v)
+  = newIPNameRn v		`thenM` \ name ->
+    returnM (HsIPVar name, emptyFVs)
+
+rnExpr (HsLit lit) 
+  = rnLit lit		`thenM_`
+    returnM (HsLit lit, emptyFVs)
+
+rnExpr (HsOverLit lit) 
+  = rnOverLit lit		`thenM` \ (lit', fvs) ->
+    returnM (HsOverLit lit', fvs)
+
+rnExpr (HsApp fun arg)
+  = rnLExpr fun		`thenM` \ (fun',fvFun) ->
+    rnLExpr arg		`thenM` \ (arg',fvArg) ->
+    returnM (HsApp fun' arg', fvFun `plusFV` fvArg)
+
+rnExpr (OpApp e1 op _ e2) 
+  = rnLExpr e1				`thenM` \ (e1', fv_e1) ->
+    rnLExpr e2				`thenM` \ (e2', fv_e2) ->
+    rnLExpr op				`thenM` \ (op'@(L _ (HsVar op_name)), fv_op) ->
+
+	-- Deal with fixity
+	-- When renaming code synthesised from "deriving" declarations
+	-- we used to avoid fixity stuff, but we can't easily tell any
+	-- more, so I've removed the test.  Adding HsPars in TcGenDeriv
+	-- should prevent bad things happening.
+    lookupFixityRn op_name		`thenM` \ fixity ->
+    mkOpAppRn e1' op' fixity e2'	`thenM` \ final_e -> 
+
+    returnM (final_e,
+	      fv_e1 `plusFV` fv_op `plusFV` fv_e2)
+
+rnExpr (NegApp e _)
+  = rnLExpr e			`thenM` \ (e', fv_e) ->
+    lookupSyntaxName negateName	`thenM` \ (neg_name, fv_neg) ->
+    mkNegAppRn e' neg_name	`thenM` \ final_e ->
+    returnM (final_e, fv_e `plusFV` fv_neg)
+
+rnExpr (HsPar e)
+  = rnLExpr e 		`thenM` \ (e', fvs_e) ->
+    returnM (HsPar e', fvs_e)
+
+-- Template Haskell extensions
+-- Don't ifdef-GHCI them because we want to fail gracefully
+-- (not with an rnExpr crash) in a stage-1 compiler.
+rnExpr e@(HsBracket br_body)
+  = checkTH e "bracket"		`thenM_`
+    rnBracket br_body		`thenM` \ (body', fvs_e) ->
+    returnM (HsBracket body', fvs_e)
+
+rnExpr e@(HsSpliceE splice)
+  = rnSplice splice 		`thenM` \ (splice', fvs) ->
+    returnM (HsSpliceE splice', fvs)
+
+rnExpr section@(SectionL expr op)
+  = rnLExpr expr	 	`thenM` \ (expr', fvs_expr) ->
+    rnLExpr op	 		`thenM` \ (op', fvs_op) ->
+    checkSectionPrec InfixL section op' expr' `thenM_`
+    returnM (SectionL expr' op', fvs_op `plusFV` fvs_expr)
+
+rnExpr section@(SectionR op expr)
+  = rnLExpr op	 				`thenM` \ (op',   fvs_op) ->
+    rnLExpr expr	 				`thenM` \ (expr', fvs_expr) ->
+    checkSectionPrec InfixR section op' expr'	`thenM_`
+    returnM (SectionR op' expr', fvs_op `plusFV` fvs_expr)
+
+rnExpr (HsCoreAnn ann expr)
+  = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
+    returnM (HsCoreAnn ann expr', fvs_expr)
+
+rnExpr (HsSCC lbl expr)
+  = rnLExpr expr	 	`thenM` \ (expr', fvs_expr) ->
+    returnM (HsSCC lbl expr', fvs_expr)
+
+rnExpr (HsLam matches)
+  = rnMatchGroup LambdaExpr matches	`thenM` \ (matches', fvMatch) ->
+    returnM (HsLam matches', fvMatch)
+
+rnExpr (HsCase expr matches)
+  = rnLExpr expr		 	`thenM` \ (new_expr, e_fvs) ->
+    rnMatchGroup CaseAlt matches	`thenM` \ (new_matches, ms_fvs) ->
+    returnM (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
+
+rnExpr (HsLet binds expr)
+  = rnLocalBindsAndThen binds		$ \ binds' ->
+    rnLExpr expr			 `thenM` \ (expr',fvExpr) ->
+    returnM (HsLet binds' expr', fvExpr)
+
+rnExpr e@(HsDo do_or_lc stmts body _)
+  = do 	{ ((stmts', body'), fvs) <- rnStmts do_or_lc stmts $
+				    rnLExpr body
+	; return (HsDo do_or_lc stmts' body' placeHolderType, fvs) }
+
+rnExpr (ExplicitList _ exps)
+  = rnExprs exps		 	`thenM` \ (exps', fvs) ->
+    returnM  (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
+
+rnExpr (ExplicitPArr _ exps)
+  = rnExprs exps		 	`thenM` \ (exps', fvs) ->
+    returnM  (ExplicitPArr placeHolderType exps', fvs)
+
+rnExpr e@(ExplicitTuple exps boxity)
+  = checkTupSize tup_size			`thenM_`
+    rnExprs exps	 			`thenM` \ (exps', fvs) ->
+    returnM (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
+  where
+    tup_size   = length exps
+    tycon_name = tupleTyCon_name boxity tup_size
+
+rnExpr (RecordCon con_id _ rbinds)
+  = lookupLocatedOccRn con_id		`thenM` \ conname ->
+    rnRbinds "construction" rbinds	`thenM` \ (rbinds', fvRbinds) ->
+    returnM (RecordCon conname noPostTcExpr rbinds', 
+	     fvRbinds `addOneFV` unLoc conname)
+
+rnExpr (RecordUpd expr rbinds _ _)
+  = rnLExpr expr		`thenM` \ (expr', fvExpr) ->
+    rnRbinds "update" rbinds	`thenM` \ (rbinds', fvRbinds) ->
+    returnM (RecordUpd expr' rbinds' placeHolderType placeHolderType, 
+	     fvExpr `plusFV` fvRbinds)
+
+rnExpr (ExprWithTySig expr pty)
+  = rnLExpr expr		`thenM` \ (expr', fvExpr) ->
+    rnHsTypeFVs doc pty		`thenM` \ (pty', fvTy) ->
+    returnM (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
+  where 
+    doc = text "In an expression type signature"
+
+rnExpr (HsIf p b1 b2)
+  = rnLExpr p		`thenM` \ (p', fvP) ->
+    rnLExpr b1		`thenM` \ (b1', fvB1) ->
+    rnLExpr b2		`thenM` \ (b2', fvB2) ->
+    returnM (HsIf p' b1' b2', plusFVs [fvP, fvB1, fvB2])
+
+rnExpr (HsType a)
+  = rnHsTypeFVs doc a	`thenM` \ (t, fvT) -> 
+    returnM (HsType t, fvT)
+  where 
+    doc = text "In a type argument"
+
+rnExpr (ArithSeq _ seq)
+  = rnArithSeq seq	 `thenM` \ (new_seq, fvs) ->
+    returnM (ArithSeq noPostTcExpr new_seq, fvs)
+
+rnExpr (PArrSeq _ seq)
+  = rnArithSeq seq	 `thenM` \ (new_seq, fvs) ->
+    returnM (PArrSeq noPostTcExpr new_seq, fvs)
+\end{code}
+
+These three are pattern syntax appearing in expressions.
+Since all the symbols are reservedops we can simply reject them.
+We return a (bogus) EWildPat in each case.
+
+\begin{code}
+rnExpr e@EWildPat      = patSynErr e
+rnExpr e@(EAsPat {})   = patSynErr e
+rnExpr e@(ELazyPat {}) = patSynErr e
+\end{code}
+
+%************************************************************************
+%*									*
+	Arrow notation
+%*									*
+%************************************************************************
+
+\begin{code}
+rnExpr (HsProc pat body)
+  = newArrowScope $
+    rnPatsAndThen ProcExpr [pat] $ \ [pat'] ->
+    rnCmdTop body	         `thenM` \ (body',fvBody) ->
+    returnM (HsProc pat' body', fvBody)
+
+rnExpr (HsArrApp arrow arg _ ho rtl)
+  = select_arrow_scope (rnLExpr arrow)	`thenM` \ (arrow',fvArrow) ->
+    rnLExpr arg				`thenM` \ (arg',fvArg) ->
+    returnM (HsArrApp arrow' arg' placeHolderType ho rtl,
+	     fvArrow `plusFV` fvArg)
+  where
+    select_arrow_scope tc = case ho of
+        HsHigherOrderApp -> tc
+        HsFirstOrderApp  -> escapeArrowScope tc
+
+-- infix form
+rnExpr (HsArrForm op (Just _) [arg1, arg2])
+  = escapeArrowScope (rnLExpr op)
+			`thenM` \ (op'@(L _ (HsVar op_name)),fv_op) ->
+    rnCmdTop arg1	`thenM` \ (arg1',fv_arg1) ->
+    rnCmdTop arg2	`thenM` \ (arg2',fv_arg2) ->
+
+	-- Deal with fixity
+
+    lookupFixityRn op_name		`thenM` \ fixity ->
+    mkOpFormRn arg1' op' fixity arg2'	`thenM` \ final_e -> 
+
+    returnM (final_e,
+	      fv_arg1 `plusFV` fv_op `plusFV` fv_arg2)
+
+rnExpr (HsArrForm op fixity cmds)
+  = escapeArrowScope (rnLExpr op)	`thenM` \ (op',fvOp) ->
+    rnCmdArgs cmds			`thenM` \ (cmds',fvCmds) ->
+    returnM (HsArrForm op' fixity cmds', fvOp `plusFV` fvCmds)
+
+rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
+	-- DictApp, DictLam, TyApp, TyLam
+\end{code}
+
+
+%************************************************************************
+%*									*
+	Arrow commands
+%*									*
+%************************************************************************
+
+\begin{code}
+rnCmdArgs [] = returnM ([], emptyFVs)
+rnCmdArgs (arg:args)
+  = rnCmdTop arg	`thenM` \ (arg',fvArg) ->
+    rnCmdArgs args	`thenM` \ (args',fvArgs) ->
+    returnM (arg':args', fvArg `plusFV` fvArgs)
+
+
+rnCmdTop = wrapLocFstM rnCmdTop'
+ where
+  rnCmdTop' (HsCmdTop cmd _ _ _) 
+   = rnLExpr (convertOpFormsLCmd cmd) `thenM` \ (cmd', fvCmd) ->
+     let 
+	cmd_names = [arrAName, composeAName, firstAName] ++
+		    nameSetToList (methodNamesCmd (unLoc cmd'))
+     in
+	-- Generate the rebindable syntax for the monad
+     lookupSyntaxTable cmd_names	`thenM` \ (cmd_names', cmd_fvs) ->
+
+     returnM (HsCmdTop cmd' [] placeHolderType cmd_names', 
+	     fvCmd `plusFV` cmd_fvs)
+
+---------------------------------------------------
+-- convert OpApp's in a command context to HsArrForm's
+
+convertOpFormsLCmd :: LHsCmd id -> LHsCmd id
+convertOpFormsLCmd = fmap convertOpFormsCmd
+
+convertOpFormsCmd :: HsCmd id -> HsCmd id
+
+convertOpFormsCmd (HsApp c e) = HsApp (convertOpFormsLCmd c) e
+convertOpFormsCmd (HsLam match) = HsLam (convertOpFormsMatch match)
+convertOpFormsCmd (OpApp c1 op fixity c2)
+  = let
+	arg1 = L (getLoc c1) $ HsCmdTop (convertOpFormsLCmd c1) [] placeHolderType []
+	arg2 = L (getLoc c2) $ HsCmdTop (convertOpFormsLCmd c2) [] placeHolderType []
+    in
+    HsArrForm op (Just fixity) [arg1, arg2]
+
+convertOpFormsCmd (HsPar c) = HsPar (convertOpFormsLCmd c)
+
+-- gaw 2004
+convertOpFormsCmd (HsCase exp matches)
+  = HsCase exp (convertOpFormsMatch matches)
+
+convertOpFormsCmd (HsIf exp c1 c2)
+  = HsIf exp (convertOpFormsLCmd c1) (convertOpFormsLCmd c2)
+
+convertOpFormsCmd (HsLet binds cmd)
+  = HsLet binds (convertOpFormsLCmd cmd)
+
+convertOpFormsCmd (HsDo ctxt stmts body ty)
+  = HsDo ctxt (map (fmap convertOpFormsStmt) stmts)
+	      (convertOpFormsLCmd body) ty
+
+-- Anything else is unchanged.  This includes HsArrForm (already done),
+-- things with no sub-commands, and illegal commands (which will be
+-- caught by the type checker)
+convertOpFormsCmd c = c
+
+convertOpFormsStmt (BindStmt pat cmd _ _)
+  = BindStmt pat (convertOpFormsLCmd cmd) noSyntaxExpr noSyntaxExpr
+convertOpFormsStmt (ExprStmt cmd _ _)
+  = ExprStmt (convertOpFormsLCmd cmd) noSyntaxExpr placeHolderType
+convertOpFormsStmt (RecStmt stmts lvs rvs es binds)
+  = RecStmt (map (fmap convertOpFormsStmt) stmts) lvs rvs es binds
+convertOpFormsStmt stmt = stmt
+
+convertOpFormsMatch (MatchGroup ms ty)
+  = MatchGroup (map (fmap convert) ms) ty
+ where convert (Match pat mty grhss)
+	  = Match pat mty (convertOpFormsGRHSs grhss)
+
+convertOpFormsGRHSs (GRHSs grhss binds)
+  = GRHSs (map convertOpFormsGRHS grhss) binds
+
+convertOpFormsGRHS = fmap convert
+ where 
+   convert (GRHS stmts cmd) = GRHS stmts (convertOpFormsLCmd cmd)
+
+---------------------------------------------------
+type CmdNeeds = FreeVars	-- Only inhabitants are 
+				-- 	appAName, choiceAName, loopAName
+
+-- find what methods the Cmd needs (loop, choice, apply)
+methodNamesLCmd :: LHsCmd Name -> CmdNeeds
+methodNamesLCmd = methodNamesCmd . unLoc
+
+methodNamesCmd :: HsCmd Name -> CmdNeeds
+
+methodNamesCmd cmd@(HsArrApp _arrow _arg _ HsFirstOrderApp _rtl)
+  = emptyFVs
+methodNamesCmd cmd@(HsArrApp _arrow _arg _ HsHigherOrderApp _rtl)
+  = unitFV appAName
+methodNamesCmd cmd@(HsArrForm {}) = emptyFVs
+
+methodNamesCmd (HsPar c) = methodNamesLCmd c
+
+methodNamesCmd (HsIf p c1 c2)
+  = methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
+
+methodNamesCmd (HsLet b c) = methodNamesLCmd c
+
+methodNamesCmd (HsDo sc stmts body ty) 
+  = methodNamesStmts stmts `plusFV` methodNamesLCmd body
+
+methodNamesCmd (HsApp c e) = methodNamesLCmd c
+
+methodNamesCmd (HsLam match) = methodNamesMatch match
+
+methodNamesCmd (HsCase scrut matches)
+  = methodNamesMatch matches `addOneFV` choiceAName
+
+methodNamesCmd other = emptyFVs
+   -- Other forms can't occur in commands, but it's not convenient 
+   -- to error here so we just do what's convenient.
+   -- The type checker will complain later
+
+---------------------------------------------------
+methodNamesMatch (MatchGroup ms ty)
+  = plusFVs (map do_one ms)
+ where 
+    do_one (L _ (Match pats sig_ty grhss)) = methodNamesGRHSs grhss
+
+-------------------------------------------------
+-- gaw 2004
+methodNamesGRHSs (GRHSs grhss binds) = plusFVs (map methodNamesGRHS grhss)
+
+-------------------------------------------------
+methodNamesGRHS (L _ (GRHS stmts rhs)) = methodNamesLCmd rhs
+
+---------------------------------------------------
+methodNamesStmts stmts = plusFVs (map methodNamesLStmt stmts)
+
+---------------------------------------------------
+methodNamesLStmt = methodNamesStmt . unLoc
+
+methodNamesStmt (ExprStmt cmd _ _)     = methodNamesLCmd cmd
+methodNamesStmt (BindStmt pat cmd _ _) = methodNamesLCmd cmd
+methodNamesStmt (RecStmt stmts _ _ _ _)
+  = methodNamesStmts stmts `addOneFV` loopAName
+methodNamesStmt (LetStmt b)  = emptyFVs
+methodNamesStmt (ParStmt ss) = emptyFVs
+   -- ParStmt can't occur in commands, but it's not convenient to error 
+   -- here so we just do what's convenient
+\end{code}
+
+
+%************************************************************************
+%*									*
+	Arithmetic sequences
+%*									*
+%************************************************************************
+
+\begin{code}
+rnArithSeq (From expr)
+ = rnLExpr expr 	`thenM` \ (expr', fvExpr) ->
+   returnM (From expr', fvExpr)
+
+rnArithSeq (FromThen expr1 expr2)
+ = rnLExpr expr1 	`thenM` \ (expr1', fvExpr1) ->
+   rnLExpr expr2	`thenM` \ (expr2', fvExpr2) ->
+   returnM (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
+
+rnArithSeq (FromTo expr1 expr2)
+ = rnLExpr expr1	`thenM` \ (expr1', fvExpr1) ->
+   rnLExpr expr2	`thenM` \ (expr2', fvExpr2) ->
+   returnM (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
+
+rnArithSeq (FromThenTo expr1 expr2 expr3)
+ = rnLExpr expr1	`thenM` \ (expr1', fvExpr1) ->
+   rnLExpr expr2	`thenM` \ (expr2', fvExpr2) ->
+   rnLExpr expr3	`thenM` \ (expr3', fvExpr3) ->
+   returnM (FromThenTo expr1' expr2' expr3',
+	    plusFVs [fvExpr1, fvExpr2, fvExpr3])
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
+%*									*
+%************************************************************************
+
+\begin{code}
+rnRbinds str rbinds 
+  = mappM_ field_dup_err dup_fields	`thenM_`
+    mapFvRn rn_rbind rbinds		`thenM` \ (rbinds', fvRbind) ->
+    returnM (rbinds', fvRbind)
+  where
+    (_, dup_fields) = removeDups cmpLocated [ f | (f,_) <- rbinds ]
+
+    field_dup_err dups = mappM_ (\f -> addLocErr f (dupFieldErr str)) dups
+
+    rn_rbind (field, expr)
+      = lookupLocatedGlobalOccRn field	`thenM` \ fieldname ->
+	rnLExpr expr			`thenM` \ (expr', fvExpr) ->
+	returnM ((fieldname, expr'), fvExpr `addOneFV` unLoc fieldname)
+\end{code}
+
+%************************************************************************
+%*									*
+	Template Haskell brackets
+%*									*
+%************************************************************************
+
+\begin{code}
+rnBracket (VarBr n) = do { name <- lookupOccRn n
+			 ; this_mod <- getModule
+			 ; checkM (nameIsLocalOrFrom this_mod name) $	-- Reason: deprecation checking asumes the
+			   do { loadHomeInterface msg name		-- home interface is loaded, and this is the
+			      ; return () }				-- only way that is going to happen
+			 ; returnM (VarBr name, unitFV name) }
+		    where
+		      msg = ptext SLIT("Need interface for Template Haskell quoted Name")
+
+rnBracket (ExpBr e) = do { (e', fvs) <- rnLExpr e
+			 ; return (ExpBr e', fvs) }
+rnBracket (PatBr p) = do { (p', fvs) <- rnLPat p
+			 ; return (PatBr p', fvs) }
+rnBracket (TypBr t) = do { (t', fvs) <- rnHsTypeFVs doc t
+			 ; return (TypBr t', fvs) }
+		    where
+		      doc = ptext SLIT("In a Template-Haskell quoted type")
+rnBracket (DecBr group) 
+  = do 	{ gbl_env  <- getGblEnv
+
+	; let gbl_env1 = gbl_env { tcg_mod = thFAKE }
+	-- Note the thFAKE.  The top-level names from the bracketed 
+	-- declarations will go into the name cache, and we don't want them to 
+	-- confuse the Names for the current module.  
+	-- By using a pretend module, thFAKE, we keep them safely out of the way.
+
+	; names    <- getLocalDeclBinders gbl_env1 group
+	; rdr_env' <- extendRdrEnvRn emptyGlobalRdrEnv names
+	-- Furthermore, the names in the bracket shouldn't conflict with
+	-- existing top-level names E.g.
+	--	foo = 1
+	--	bar = [d| foo = 1|]
+	-- But both 'foo's get a LocalDef provenance, so we'd get a complaint unless
+	-- we start with an emptyGlobalRdrEnv
+
+	; setGblEnv (gbl_env { tcg_rdr_env = tcg_rdr_env gbl_env1 `plusOccEnv` rdr_env',
+			       tcg_dus = emptyDUs }) $ do
+		-- Notice plusOccEnv, not plusGlobalRdrEnv.  In this situation we want
+		-- to *shadow* top-level bindings.  (See the 'foo' example above.)
+		-- If we don't shadow, we'll get an ambiguity complaint when we do 
+		-- a lookupTopBndrRn (which uses lookupGreLocalRn) on the binder of the 'foo'
+		--
+		-- Furthermore, arguably if the splice does define foo, that should hide
+		-- any foo's further out
+		--
+		-- The emptyDUs is so that we just collect uses for this group alone
+
+	{ (tcg_env, group') <- rnSrcDecls group
+		-- Discard the tcg_env; it contains only extra info about fixity
+	; return (DecBr group', allUses (tcg_dus tcg_env)) } }
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection{@Stmt@s: in @do@ expressions}
+%*									*
+%************************************************************************
+
+\begin{code}
+rnStmts :: HsStmtContext Name -> [LStmt RdrName] 
+	-> RnM (thing, FreeVars)
+	-> RnM (([LStmt Name], thing), FreeVars)
+
+rnStmts (MDoExpr _) = rnMDoStmts
+rnStmts ctxt        = rnNormalStmts ctxt
+
+rnNormalStmts :: HsStmtContext Name -> [LStmt RdrName]
+	      -> RnM (thing, FreeVars)
+	      -> RnM (([LStmt Name], thing), FreeVars)	
+-- Used for cases *other* than recursive mdo
+-- Implements nested scopes
+
+rnNormalStmts ctxt [] thing_inside 
+  = do	{ (thing, fvs) <- thing_inside
+	; return (([],thing), fvs) } 
+
+rnNormalStmts ctxt (L loc stmt : stmts) thing_inside
+  = do	{ ((stmt', (stmts', thing)), fvs) 
+		<- rnStmt ctxt stmt 	$
+		   rnNormalStmts ctxt stmts thing_inside
+	; return (((L loc stmt' : stmts'), thing), fvs) }
+    
+rnStmt :: HsStmtContext Name -> Stmt RdrName
+       -> RnM (thing, FreeVars)
+       -> RnM ((Stmt Name, thing), FreeVars)
+
+rnStmt ctxt (ExprStmt expr _ _) thing_inside
+  = do	{ (expr', fv_expr) <- rnLExpr expr
+	; (then_op, fvs1)  <- lookupSyntaxName thenMName
+	; (thing, fvs2)    <- thing_inside
+	; return ((ExprStmt expr' then_op placeHolderType, thing),
+		  fv_expr `plusFV` fvs1 `plusFV` fvs2) }
+
+rnStmt ctxt (BindStmt pat expr _ _) thing_inside
+  = do	{ (expr', fv_expr) <- rnLExpr expr
+		-- The binders do not scope over the expression
+	; (bind_op, fvs1) <- lookupSyntaxName bindMName
+	; (fail_op, fvs2) <- lookupSyntaxName failMName
+	; rnPatsAndThen (StmtCtxt ctxt) [pat] $ \ [pat'] -> do
+	{ (thing, fvs3) <- thing_inside
+	; return ((BindStmt pat' expr' bind_op fail_op, thing),
+		  fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }}
+	-- fv_expr shouldn't really be filtered by the rnPatsAndThen
+	-- but it does not matter because the names are unique
+
+rnStmt ctxt (LetStmt binds) thing_inside
+  = do	{ checkErr (ok ctxt binds) 
+		   (badIpBinds (ptext SLIT("a parallel list comprehension:")) binds)
+	; rnLocalBindsAndThen binds		$ \ binds' -> do
+	{ (thing, fvs) <- thing_inside
+	; return ((LetStmt binds', thing), fvs) }}
+  where
+	-- We do not allow implicit-parameter bindings in a parallel
+	-- list comprehension.  I'm not sure what it might mean.
+    ok (ParStmtCtxt _) (HsIPBinds _) = False
+    ok _	       _	     = True
+
+rnStmt ctxt (RecStmt rec_stmts _ _ _ _) thing_inside
+  = bindLocatedLocalsRn doc (collectLStmtsBinders rec_stmts)	$ \ bndrs ->
+    rn_rec_stmts bndrs rec_stmts	`thenM` \ segs ->
+    thing_inside 			`thenM` \ (thing, fvs) ->
+    let
+	segs_w_fwd_refs     	 = addFwdRefs segs
+	(ds, us, fs, rec_stmts') = unzip4 segs_w_fwd_refs
+	later_vars = nameSetToList (plusFVs ds `intersectNameSet` fvs)
+	fwd_vars   = nameSetToList (plusFVs fs)
+	uses	   = plusFVs us
+	rec_stmt   = RecStmt rec_stmts' later_vars fwd_vars [] emptyLHsBinds
+    in	
+    returnM ((rec_stmt, thing), uses `plusFV` fvs)
+  where
+    doc = text "In a recursive do statement"
+
+rnStmt ctxt (ParStmt segs) thing_inside
+  = do	{ opt_GlasgowExts <- doptM Opt_GlasgowExts
+	; checkM opt_GlasgowExts parStmtErr
+ 	; orig_lcl_env <- getLocalRdrEnv
+	; ((segs',thing), fvs) <- go orig_lcl_env [] segs
+	; return ((ParStmt segs', thing), fvs) }
+  where
+--  type ParSeg id = [([LStmt id], [id])]
+--  go :: NameSet -> [ParSeg RdrName]
+--       -> RnM (([ParSeg Name], thing), FreeVars)
+
+    go orig_lcl_env bndrs [] 
+	= do { let { (bndrs', dups) = removeDups cmpByOcc bndrs
+		   ; inner_env = extendLocalRdrEnv orig_lcl_env bndrs' }
+	     ; mappM dupErr dups
+	     ; (thing, fvs) <- setLocalRdrEnv inner_env thing_inside
+	     ; return (([], thing), fvs) }
+
+    go orig_lcl_env bndrs_so_far ((stmts, _) : segs)
+	= do { ((stmts', (bndrs, segs', thing)), fvs)
+		  <- rnNormalStmts par_ctxt stmts $ do
+		     { 	-- Find the Names that are bound by stmts
+		       lcl_env <- getLocalRdrEnv
+		     ; let { rdr_bndrs = collectLStmtsBinders stmts
+		     	   ; bndrs = map ( expectJust "rnStmt"
+		     		         . lookupLocalRdrEnv lcl_env
+		     		         . unLoc) rdr_bndrs
+		           ; new_bndrs = nub bndrs ++ bndrs_so_far 
+				-- The nub is because there might be shadowing
+				--	x <- e1; x <- e2
+				-- So we'll look up (Unqual x) twice, getting
+				-- the second binding both times, which is the
+			}	-- one we want
+
+			-- Typecheck the thing inside, passing on all
+			-- the Names bound, but separately; revert the envt
+		     ; ((segs', thing), fvs) <- setLocalRdrEnv orig_lcl_env $
+						go orig_lcl_env new_bndrs segs
+
+			-- Figure out which of the bound names are used
+		     ; let used_bndrs = filter (`elemNameSet` fvs) bndrs
+		     ; return ((used_bndrs, segs', thing), fvs) }
+
+	     ; let seg' = (stmts', bndrs)
+	     ; return (((seg':segs'), thing), 
+		       delListFromNameSet fvs bndrs) }
+
+    par_ctxt = ParStmtCtxt ctxt
+
+    cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
+    dupErr vs = addErr (ptext SLIT("Duplicate binding in parallel list comprehension for:")
+		        <+> quotes (ppr (head vs)))
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsubsection{mdo expressions}
+%*									*
+%************************************************************************
+
+\begin{code}
+type FwdRefs = NameSet
+type Segment stmts = (Defs,
+		      Uses, 	-- May include defs
+		      FwdRefs,	-- A subset of uses that are 
+				--   (a) used before they are bound in this segment, or 
+				--   (b) used here, and bound in subsequent segments
+		      stmts)	-- Either Stmt or [Stmt]
+
+
+----------------------------------------------------
+rnMDoStmts :: [LStmt RdrName]
+	   -> RnM (thing, FreeVars)
+	   -> RnM (([LStmt Name], thing), FreeVars)	
+rnMDoStmts stmts thing_inside
+  = 	-- Step1: bring all the binders of the mdo into scope
+	-- Remember that this also removes the binders from the
+	-- finally-returned free-vars
+    bindLocatedLocalsRn doc (collectLStmtsBinders stmts)	$ \ bndrs ->
+    do	{ 
+	-- Step 2: Rename each individual stmt, making a
+	--	   singleton segment.  At this stage the FwdRefs field
+	--	   isn't finished: it's empty for all except a BindStmt
+	--	   for which it's the fwd refs within the bind itself
+	-- 	   (This set may not be empty, because we're in a recursive 
+	--	    context.)
+	  segs <- rn_rec_stmts bndrs stmts
+
+	; (thing, fvs_later) <- thing_inside
+
+	; let
+	-- Step 3: Fill in the fwd refs.
+	-- 	   The segments are all singletons, but their fwd-ref
+	--	   field mentions all the things used by the segment
+	--	   that are bound after their use
+	    segs_w_fwd_refs = addFwdRefs segs
+
+	-- Step 4: Group together the segments to make bigger segments
+	--	   Invariant: in the result, no segment uses a variable
+	--	   	      bound in a later segment
+	    grouped_segs = glomSegments segs_w_fwd_refs
+
+	-- Step 5: Turn the segments into Stmts
+	--	   Use RecStmt when and only when there are fwd refs
+	--	   Also gather up the uses from the end towards the
+	--	   start, so we can tell the RecStmt which things are
+	--	   used 'after' the RecStmt
+	    (stmts', fvs) = segsToStmts grouped_segs fvs_later
+
+	; return ((stmts', thing), fvs) }
+  where
+    doc = text "In a recursive mdo-expression"
+
+---------------------------------------------
+rn_rec_stmts :: [Name] -> [LStmt RdrName] -> RnM [Segment (LStmt Name)]
+rn_rec_stmts bndrs stmts = mappM (rn_rec_stmt bndrs) stmts	`thenM` \ segs_s ->
+		   	   returnM (concat segs_s)
+
+----------------------------------------------------
+rn_rec_stmt :: [Name] -> LStmt RdrName -> RnM [Segment (LStmt Name)]
+	-- Rename a Stmt that is inside a RecStmt (or mdo)
+	-- Assumes all binders are already in scope
+	-- Turns each stmt into a singleton Stmt
+
+rn_rec_stmt all_bndrs (L loc (ExprStmt expr _ _))
+  = rnLExpr expr 		`thenM` \ (expr', fvs) ->
+    lookupSyntaxName thenMName	`thenM` \ (then_op, fvs1) ->
+    returnM [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
+	      L loc (ExprStmt expr' then_op placeHolderType))]
+
+rn_rec_stmt all_bndrs (L loc (BindStmt pat expr _ _))
+  = rnLExpr expr		`thenM` \ (expr', fv_expr) ->
+    rnLPat pat			`thenM` \ (pat', fv_pat) ->
+    lookupSyntaxName bindMName	`thenM` \ (bind_op, fvs1) ->
+    lookupSyntaxName failMName	`thenM` \ (fail_op, fvs2) ->
+    let
+	bndrs = mkNameSet (collectPatBinders pat')
+	fvs   = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
+    in
+    returnM [(bndrs, fvs, bndrs `intersectNameSet` fvs,
+	      L loc (BindStmt pat' expr' bind_op fail_op))]
+
+rn_rec_stmt all_bndrs (L loc (LetStmt binds@(HsIPBinds _)))
+  = do	{ addErr (badIpBinds (ptext SLIT("an mdo expression")) binds)
+	; failM }
+
+rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds)))
+  = rnValBinds (trimWith all_bndrs) binds	`thenM` \ (binds', du_binds) ->
+    returnM [(duDefs du_binds, duUses du_binds, 
+	      emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
+
+rn_rec_stmt all_bndrs (L loc (RecStmt stmts _ _ _ _))	-- Flatten Rec inside Rec
+  = rn_rec_stmts all_bndrs stmts
+
+rn_rec_stmt all_bndrs stmt@(L _ (ParStmt _))	-- Syntactically illegal in mdo
+  = pprPanic "rn_rec_stmt" (ppr stmt)
+
+---------------------------------------------
+addFwdRefs :: [Segment a] -> [Segment a]
+-- So far the segments only have forward refs *within* the Stmt
+-- 	(which happens for bind:  x <- ...x...)
+-- This function adds the cross-seg fwd ref info
+
+addFwdRefs pairs 
+  = fst (foldr mk_seg ([], emptyNameSet) pairs)
+  where
+    mk_seg (defs, uses, fwds, stmts) (segs, later_defs)
+	= (new_seg : segs, all_defs)
+	where
+	  new_seg = (defs, uses, new_fwds, stmts)
+	  all_defs = later_defs `unionNameSets` defs
+	  new_fwds = fwds `unionNameSets` (uses `intersectNameSet` later_defs)
+		-- Add the downstream fwd refs here
+
+----------------------------------------------------
+-- 	Glomming the singleton segments of an mdo into 
+--	minimal recursive groups.
+--
+-- At first I thought this was just strongly connected components, but
+-- there's an important constraint: the order of the stmts must not change.
+--
+-- Consider
+--	mdo { x <- ...y...
+--	      p <- z
+--	      y <- ...x...
+--	      q <- x
+--	      z <- y
+--	      r <- x }
+--
+-- Here, the first stmt mention 'y', which is bound in the third.  
+-- But that means that the innocent second stmt (p <- z) gets caught
+-- up in the recursion.  And that in turn means that the binding for
+-- 'z' has to be included... and so on.
+--
+-- Start at the tail { r <- x }
+-- Now add the next one { z <- y ; r <- x }
+-- Now add one more     { q <- x ; z <- y ; r <- x }
+-- Now one more... but this time we have to group a bunch into rec
+--	{ rec { y <- ...x... ; q <- x ; z <- y } ; r <- x }
+-- Now one more, which we can add on without a rec
+--	{ p <- z ; 
+--	  rec { y <- ...x... ; q <- x ; z <- y } ; 
+-- 	  r <- x }
+-- Finally we add the last one; since it mentions y we have to
+-- glom it togeher with the first two groups
+--	{ rec { x <- ...y...; p <- z ; y <- ...x... ; 
+--		q <- x ; z <- y } ; 
+-- 	  r <- x }
+
+glomSegments :: [Segment (LStmt Name)] -> [Segment [LStmt Name]]
+
+glomSegments [] = []
+glomSegments ((defs,uses,fwds,stmt) : segs)
+	-- Actually stmts will always be a singleton
+  = (seg_defs, seg_uses, seg_fwds, seg_stmts)  : others
+  where
+    segs'	     = glomSegments segs
+    (extras, others) = grab uses segs'
+    (ds, us, fs, ss) = unzip4 extras
+    
+    seg_defs  = plusFVs ds `plusFV` defs
+    seg_uses  = plusFVs us `plusFV` uses
+    seg_fwds  = plusFVs fs `plusFV` fwds
+    seg_stmts = stmt : concat ss
+
+    grab :: NameSet	 	-- The client
+	 -> [Segment a]
+	 -> ([Segment a],	-- Needed by the 'client'
+	     [Segment a])	-- Not needed by the client
+	-- The result is simply a split of the input
+    grab uses dus 
+	= (reverse yeses, reverse noes)
+	where
+	  (noes, yeses) 	  = span not_needed (reverse dus)
+	  not_needed (defs,_,_,_) = not (intersectsNameSet defs uses)
+
+
+----------------------------------------------------
+segsToStmts :: [Segment [LStmt Name]] 
+	    -> FreeVars			-- Free vars used 'later'
+	    -> ([LStmt Name], FreeVars)
+
+segsToStmts [] fvs_later = ([], fvs_later)
+segsToStmts ((defs, uses, fwds, ss) : segs) fvs_later
+  = ASSERT( not (null ss) )
+    (new_stmt : later_stmts, later_uses `plusFV` uses)
+  where
+    (later_stmts, later_uses) = segsToStmts segs fvs_later
+    new_stmt | non_rec	 = head ss
+	     | otherwise = L (getLoc (head ss)) $ 
+			   RecStmt ss (nameSetToList used_later) (nameSetToList fwds) 
+				      [] emptyLHsBinds
+	     where
+	       non_rec    = isSingleton ss && isEmptyNameSet fwds
+	       used_later = defs `intersectNameSet` later_uses
+				-- The ones needed after the RecStmt
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection{breakpoint utils}
+%*									*
+%************************************************************************
+
+\begin{code}
+#if defined(GHCI) && defined(BREAKPOINT)
+mkBreakPointExpr :: [Name] -> RnM (HsExpr Name, FreeVars)
+mkBreakPointExpr scope
+    = do sloc <- getSrcSpanM
+         undef <- lookupOccRn undefined_RDR
+         let inLoc = L sloc
+             lHsApp x y = inLoc (HsApp x y)
+             mkExpr fnName args = mkExpr' fnName (reverse args)
+             mkExpr' fnName [] = inLoc (HsVar fnName)
+             mkExpr' fnName (arg:args)
+                 = lHsApp (mkExpr' fnName args) (inLoc arg)
+             expr = unLoc $ mkExpr breakpointJumpName [mkScopeArg scope, HsVar undef, HsLit msg]
+             mkScopeArg args
+                 = unLoc $ mkExpr undef (map HsVar args)
+             msg = HsString (mkFastString (unpackFS (srcSpanFile sloc) ++ ":" ++ show (srcSpanStartLine sloc)))
+         return (expr, emptyFVs)
+#endif
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection{Assertion utils}
+%*									*
+%************************************************************************
+
+\begin{code}
+mkAssertErrorExpr :: RnM (HsExpr Name, FreeVars)
+-- Return an expression for (assertError "Foo.hs:27")
+mkAssertErrorExpr
+  = getSrcSpanM    			`thenM` \ sloc ->
+    let
+	expr = HsApp (L sloc (HsVar assertErrorName)) (L sloc (HsLit msg))
+	msg  = HsStringPrim (mkFastString (showSDoc (ppr sloc)))
+    in
+    returnM (expr, emptyFVs)
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection{Errors}
+%*									*
+%************************************************************************
+
+\begin{code}
+patSynErr e = do { addErr (sep [ptext SLIT("Pattern syntax in expression context:"),
+			 	nest 4 (ppr e)])
+		 ; return (EWildPat, emptyFVs) }
+
+parStmtErr = addErr (ptext SLIT("Illegal parallel list comprehension: use -fglasgow-exts"))
+
+badIpBinds what binds
+  = hang (ptext SLIT("Implicit-parameter bindings illegal in") <+> what)
+	 2 (ppr binds)
+\end{code}
diff --git a/compiler/rename/RnExpr.lhs-boot b/compiler/rename/RnExpr.lhs-boot
new file mode 100644
index 0000000000..b03f50a890
--- /dev/null
+++ b/compiler/rename/RnExpr.lhs-boot
@@ -0,0 +1,17 @@
+\begin{code}

+module RnExpr where

+import HsSyn

+import Name	( Name )

+import NameSet	( FreeVars )

+import RdrName	( RdrName )

+import TcRnTypes

+

+rnLExpr :: LHsExpr RdrName

+	-> RnM (LHsExpr Name, FreeVars)

+

+rnStmts :: forall thing.

+	   HsStmtContext Name -> [LStmt RdrName] 

+	-> RnM (thing, FreeVars)

+	-> RnM (([LStmt Name], thing), FreeVars)

+\end{code}

+

diff --git a/compiler/rename/RnHsSyn.lhs b/compiler/rename/RnHsSyn.lhs
new file mode 100644
index 0000000000..6752218b29
--- /dev/null
+++ b/compiler/rename/RnHsSyn.lhs
@@ -0,0 +1,156 @@
+%
+% (c) The AQUA Project, Glasgow University, 1996-1998
+%
+\section[RnHsSyn]{Specialisations of the @HsSyn@ syntax for the renamer}
+
+\begin{code}
+module RnHsSyn( 
+	-- Names
+	charTyCon_name, listTyCon_name, parrTyCon_name, tupleTyCon_name,
+	extractHsTyVars, extractHsTyNames, extractHsTyNames_s, 
+	extractFunDepNames, extractHsCtxtTyNames, extractHsPredTyNames,
+
+	-- Free variables
+	hsSigsFVs, hsSigFVs, conDeclFVs, bangTyFVs,
+	
+	maybeGenericMatch
+  ) where
+
+#include "HsVersions.h"
+
+import HsSyn
+import Class		( FunDep )
+import TysWiredIn	( tupleTyCon, listTyCon, parrTyCon, charTyCon )
+import Name		( Name, getName, isTyVarName )
+import NameSet
+import BasicTypes	( Boxity )
+import SrcLoc		( Located(..), unLoc )
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{Free variables}
+%*									*
+%************************************************************************
+
+These free-variable finders returns tycons and classes too.
+
+\begin{code}
+charTyCon_name, listTyCon_name, parrTyCon_name :: Name
+charTyCon_name    = getName charTyCon
+listTyCon_name    = getName listTyCon
+parrTyCon_name    = getName parrTyCon
+
+tupleTyCon_name :: Boxity -> Int -> Name
+tupleTyCon_name boxity n = getName (tupleTyCon boxity n)
+
+extractHsTyVars :: LHsType Name -> NameSet
+extractHsTyVars x = filterNameSet isTyVarName (extractHsTyNames x)
+
+extractFunDepNames :: FunDep Name -> NameSet
+extractFunDepNames (ns1, ns2) = mkNameSet ns1 `unionNameSets` mkNameSet ns2
+
+extractHsTyNames   :: LHsType Name -> NameSet
+extractHsTyNames ty
+  = getl ty
+  where
+    getl (L _ ty) = get ty
+
+    get (HsAppTy ty1 ty2)      = getl ty1 `unionNameSets` getl ty2
+    get (HsListTy ty)          = unitNameSet listTyCon_name `unionNameSets` getl ty
+    get (HsPArrTy ty)          = unitNameSet parrTyCon_name `unionNameSets` getl ty
+    get (HsTupleTy con tys)    = extractHsTyNames_s tys
+    get (HsFunTy ty1 ty2)      = getl ty1 `unionNameSets` getl ty2
+    get (HsPredTy p)	       = extractHsPredTyNames p
+    get (HsOpTy ty1 op ty2)    = getl ty1 `unionNameSets` getl ty2 `unionNameSets` unitNameSet (unLoc op)
+    get (HsParTy ty)           = getl ty
+    get (HsBangTy _ ty)        = getl ty
+    get (HsNumTy n)            = emptyNameSet
+    get (HsTyVar tv)	       = unitNameSet tv
+    get (HsSpliceTy _)         = emptyNameSet	-- Type splices mention no type variables
+    get (HsKindSig ty k)       = getl ty
+    get (HsForAllTy _ tvs 
+		    ctxt ty)   = (extractHsCtxtTyNames ctxt
+					 `unionNameSets` getl ty)
+					    `minusNameSet`
+				  mkNameSet (hsLTyVarNames tvs)
+
+extractHsTyNames_s  :: [LHsType Name] -> NameSet
+extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
+
+extractHsCtxtTyNames :: LHsContext Name -> NameSet
+extractHsCtxtTyNames (L _ ctxt)
+  = foldr (unionNameSets . extractHsPredTyNames . unLoc) emptyNameSet ctxt
+
+-- You don't import or export implicit parameters,
+-- so don't mention the IP names
+extractHsPredTyNames (HsClassP cls tys)
+  = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
+extractHsPredTyNames (HsIParam n ty)
+  = extractHsTyNames ty
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Free variables of declarations}
+%*									*
+%************************************************************************
+
+Return the Names that must be in scope if we are to use this declaration.
+In all cases this is set up for interface-file declarations:
+	- for class decls we ignore the bindings
+	- for instance decls likewise, plus the pragmas
+	- for rule decls, we ignore HsRules
+        - for data decls, we ignore derivings
+
+	*** See "THE NAMING STORY" in HsDecls ****
+
+\begin{code}
+----------------
+hsSigsFVs :: [LSig Name] -> FreeVars
+hsSigsFVs sigs = plusFVs (map (hsSigFVs.unLoc) sigs)
+
+hsSigFVs (TypeSig v ty)     = extractHsTyNames ty
+hsSigFVs (SpecInstSig ty)   = extractHsTyNames ty
+hsSigFVs (SpecSig v ty inl) = extractHsTyNames ty
+hsSigFVs other		    = emptyFVs
+
+----------------
+conDeclFVs (L _ (ConDecl { con_qvars = tyvars, con_cxt = context, 
+			   con_details = details, con_res = res_ty}))
+  = delFVs (map hsLTyVarName tyvars) $
+    extractHsCtxtTyNames context  `plusFV`
+    conDetailsFVs details	  `plusFV`
+    conResTyFVs res_ty
+
+conResTyFVs ResTyH98       = emptyFVs
+conResTyFVs (ResTyGADT ty) = extractHsTyNames ty
+
+conDetailsFVs (PrefixCon btys)     = plusFVs (map bangTyFVs btys)
+conDetailsFVs (InfixCon bty1 bty2) = bangTyFVs bty1 `plusFV` bangTyFVs bty2
+conDetailsFVs (RecCon flds)	   = plusFVs [bangTyFVs bty | (_, bty) <- flds]
+
+bangTyFVs bty = extractHsTyNames (getBangType bty)
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{A few functions on generic defintions
+%*									*
+%************************************************************************
+
+These functions on generics are defined over Matches Name, which is
+why they are here and not in HsMatches.
+
+\begin{code}
+maybeGenericMatch :: LMatch Name -> Maybe (HsType Name, LMatch Name)
+  -- Tells whether a Match is for a generic definition
+  -- and extract the type from a generic match and put it at the front
+
+maybeGenericMatch (L loc (Match (L _ (TypePat (L _ ty)) : pats) sig_ty grhss))
+  = Just (ty, L loc (Match pats sig_ty grhss))
+
+maybeGenericMatch other_match = Nothing
+\end{code}
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
new file mode 100644
index 0000000000..654c101cd5
--- /dev/null
+++ b/compiler/rename/RnNames.lhs
@@ -0,0 +1,1138 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[RnNames]{Extracting imported and top-level names in scope}
+
+\begin{code}
+module RnNames (
+	rnImports, mkRdrEnvAndImports, importsFromLocalDecls,
+	rnExports, mkExportNameSet,
+	getLocalDeclBinders, extendRdrEnvRn,
+	reportUnusedNames, reportDeprecations
+    ) where
+
+#include "HsVersions.h"
+
+import DynFlags		( DynFlag(..), GhcMode(..) )
+import HsSyn		( IE(..), ieName, ImportDecl(..), LImportDecl,
+			  ForeignDecl(..), HsGroup(..), HsValBinds(..),
+			  Sig(..), collectHsBindLocatedBinders, tyClDeclNames,
+			  LIE )
+import RnEnv
+import IfaceEnv		( ifaceExportNames )
+import LoadIface	( loadSrcInterface )
+import TcRnMonad hiding (LIE)
+
+import FiniteMap
+import PrelNames	( pRELUDE, isUnboundName, main_RDR_Unqual )
+import Module		( Module, moduleString, unitModuleEnv, 
+			  lookupModuleEnv, moduleEnvElts, foldModuleEnv )
+import Name		( Name, nameSrcLoc, nameOccName, nameModule, isWiredInName,
+			  nameParent, nameParent_maybe, isExternalName,
+			  isBuiltInSyntax )
+import NameSet
+import NameEnv
+import OccName		( srcDataName, isTcOcc, pprNonVarNameSpace,
+			  occNameSpace,
+			  OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
+			  extendOccEnv )
+import HscTypes		( GenAvailInfo(..), AvailInfo,
+			  HomePackageTable, PackageIfaceTable, 
+			  unQualInScope, 
+			  Deprecs(..), ModIface(..), Dependencies(..), 
+			  lookupIface, ExternalPackageState(..)
+			)
+import Packages		( PackageIdH(..) )
+import RdrName		( RdrName, rdrNameOcc, setRdrNameSpace, 
+		  	  GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..), 
+			  emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
+			  extendGlobalRdrEnv, lookupGlobalRdrEnv, unQualOK, lookupGRE_Name,
+			  Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), 
+			  importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance )
+import Outputable
+import Maybes		( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse )
+import SrcLoc		( Located(..), mkGeneralSrcSpan,
+			  unLoc, noLoc, srcLocSpan, SrcSpan )
+import BasicTypes	( DeprecTxt )
+import DriverPhases	( isHsBoot )
+import Util		( notNull )
+import List		( partition )
+import IO		( openFile, IOMode(..) )
+\end{code}
+
+
+
+%************************************************************************
+%*									*
+		rnImports
+%*									*
+%************************************************************************
+
+\begin{code}
+rnImports :: [LImportDecl RdrName] -> RnM [LImportDecl Name]
+rnImports imports
+         -- PROCESS IMPORT DECLS
+         -- Do the non {- SOURCE -} ones first, so that we get a helpful
+         -- warning for {- SOURCE -} ones that are unnecessary
+    = do this_mod <- getModule
+         implicit_prelude <- doptM Opt_ImplicitPrelude
+         let all_imports	       = mk_prel_imports this_mod implicit_prelude ++ imports
+             (source, ordinary) = partition is_source_import all_imports
+             is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
+             get_imports = rnImportDecl this_mod
+
+         stuff1 <- mapM get_imports ordinary
+         stuff2 <- mapM get_imports source
+         return (stuff1 ++ stuff2)
+    where
+-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
+-- because the former doesn't even look at Prelude.hi for instance 
+-- declarations, whereas the latter does.
+   mk_prel_imports this_mod implicit_prelude
+       |  this_mod == pRELUDE
+          || explicit_prelude_import
+          || not implicit_prelude
+           = []
+       | otherwise = [preludeImportDecl]
+   explicit_prelude_import
+       = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- imports, 
+	           unLoc mod == pRELUDE ]
+
+preludeImportDecl :: LImportDecl RdrName
+preludeImportDecl
+  = L loc $
+	ImportDecl (L loc pRELUDE)
+	       False {- Not a boot interface -}
+	       False	{- Not qualified -}
+	       Nothing	{- No "as" -}
+	       Nothing	{- No import list -}
+  where
+    loc = mkGeneralSrcSpan FSLIT("Implicit import declaration")         
+
+mkRdrEnvAndImports :: [LImportDecl Name] -> RnM (GlobalRdrEnv, ImportAvails)
+mkRdrEnvAndImports imports
+  = do this_mod <- getModule
+       let get_imports = importsFromImportDecl this_mod
+       stuff <- mapM get_imports imports
+       let (imp_gbl_envs, imp_avails) = unzip stuff
+           gbl_env :: GlobalRdrEnv
+           gbl_env = foldr plusGlobalRdrEnv emptyGlobalRdrEnv imp_gbl_envs
+
+           all_avails :: ImportAvails
+           all_avails = foldr plusImportAvails emptyImportAvails imp_avails
+       -- ALL DONE
+       return (gbl_env, all_avails)
+
+\end{code}
+	
+\begin{code}
+rnImportDecl :: Module
+             -> LImportDecl RdrName
+             -> RnM (LImportDecl Name)
+rnImportDecl this_mod (L loc importDecl@(ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details))
+    = setSrcSpan loc $
+      do iface <- loadSrcInterface doc imp_mod_name want_boot
+         let qual_mod_name = case as_mod of
+                               Nothing           -> imp_mod_name
+                               Just another_name -> another_name
+             imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,  
+                                       is_dloc = loc, is_as = qual_mod_name }
+         total_avails <- ifaceExportNames (mi_exports iface)
+         importDecl' <- rnImportDecl' iface imp_spec importDecl total_avails
+         return (L loc importDecl')
+    where imp_mod_name = unLoc loc_imp_mod_name
+          doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
+
+rnImportDecl' :: ModIface -> ImpDeclSpec -> ImportDecl RdrName -> NameSet -> RnM (ImportDecl Name)
+rnImportDecl' iface decl_spec (ImportDecl mod_name want_boot qual_only as_mod Nothing) all_names
+    = return $ ImportDecl mod_name want_boot qual_only as_mod Nothing
+rnImportDecl' iface decl_spec (ImportDecl mod_name want_boot qual_only as_mod (Just (want_hiding,import_items))) all_names
+    = do import_items_mbs <- mapM (srcSpanWrapper) import_items
+         let rn_import_items = concat . catMaybes $ import_items_mbs
+         return $ ImportDecl mod_name want_boot qual_only as_mod (Just (want_hiding,rn_import_items))
+    where
+    srcSpanWrapper (L span ieRdr)
+        = setSrcSpan span $
+          case get_item ieRdr of
+            Nothing
+                -> do addErr (badImportItemErr iface decl_spec ieRdr)
+                      return Nothing
+            Just ieNames
+                -> return (Just [L span ie | ie <- ieNames])
+    occ_env :: OccEnv Name	-- Maps OccName to corresponding Name
+    occ_env = mkOccEnv [(nameOccName n, n) | n <- nameSetToList all_names]
+	-- This env will have entries for data constructors too,
+	-- they won't make any difference because naked entities like T
+	-- in an import list map to TcOccs, not VarOccs.
+
+    sub_env :: NameEnv [Name]
+    sub_env = mkSubNameEnv all_names
+
+    get_item :: IE RdrName -> Maybe [IE Name]
+        -- Empty result for a bad item.
+	-- Singleton result is typical case.
+        -- Can have two when we are hiding, and mention C which might be
+	--	both a class and a data constructor.  
+    get_item item@(IEModuleContents _) 
+        = Nothing
+    get_item (IEThingAll tc)
+        = do name <- check_name tc
+             return [IEThingAll name]
+    get_item (IEThingAbs tc)
+        | want_hiding   -- hiding ( C )
+                        -- Here the 'C' can be a data constructor 
+                        --  *or* a type/class, or even both
+            = case catMaybes [check_name tc, check_name (setRdrNameSpace tc srcDataName)] of
+                []    -> Nothing
+                names -> return [ IEThingAbs n | n <- names ]
+        | otherwise
+            = do name <- check_name tc
+                 return [IEThingAbs name]
+    get_item (IEThingWith n ns) -- import (C (A,B))
+        = do name <- check_name n
+             let env = mkOccEnv [(nameOccName s, s) | s <- subNames sub_env name]
+                 mb_names = map (lookupOccEnv env . rdrNameOcc) ns
+             names <- sequence mb_names
+             return [IEThingWith name names]
+    get_item (IEVar n)
+        = do name <- check_name n
+             return [IEVar name]
+
+    check_name :: RdrName -> Maybe Name
+    check_name rdrName
+	= lookupOccEnv occ_env (rdrNameOcc rdrName)
+
+
+importsFromImportDecl :: Module
+		      -> LImportDecl Name
+		      -> RnM (GlobalRdrEnv, ImportAvails)
+
+importsFromImportDecl this_mod
+	(L loc (ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details))
+  = 
+    setSrcSpan loc $
+
+	-- If there's an error in loadInterface, (e.g. interface
+	-- file not found) we get lots of spurious errors from 'filterImports'
+    let
+	imp_mod_name = unLoc loc_imp_mod_name
+	doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
+    in
+    loadSrcInterface doc imp_mod_name want_boot	`thenM` \ iface ->
+
+	-- Compiler sanity check: if the import didn't say
+	-- {-# SOURCE #-} we should not get a hi-boot file
+    WARN( not want_boot && mi_boot iface, ppr imp_mod_name )
+
+	-- Issue a user warning for a redundant {- SOURCE -} import
+	-- NB that we arrange to read all the ordinary imports before 
+	-- any of the {- SOURCE -} imports
+    warnIf (want_boot && not (mi_boot iface))
+	   (warnRedundantSourceImport imp_mod_name)	`thenM_`
+
+    let
+	imp_mod	= mi_module iface
+	deprecs	= mi_deprecs iface
+	is_orph	= mi_orphan iface 
+	deps 	= mi_deps iface
+
+	filtered_exports = filter not_this_mod (mi_exports iface)
+	not_this_mod (mod,_) = mod /= this_mod
+	-- If the module exports anything defined in this module, just ignore it.
+	-- Reason: otherwise it looks as if there are two local definition sites
+	-- for the thing, and an error gets reported.  Easiest thing is just to
+	-- filter them out up front. This situation only arises if a module
+	-- imports itself, or another module that imported it.  (Necessarily,
+	-- this invoves a loop.)  
+	--
+	-- Tiresome consequence: if you say
+	--	module A where
+	--	   import B( AType )
+	--	   type AType = ...
+	--
+	--	module B( AType ) where
+	--	   import {-# SOURCE #-} A( AType )
+	--
+	-- then you'll get a 'B does not export AType' message.  Oh well.
+
+	qual_mod_name = case as_mod of
+			  Nothing  	    -> imp_mod_name
+			  Just another_name -> another_name
+	imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,  
+		  		  is_dloc = loc, is_as = qual_mod_name }
+    in
+	-- Get the total imports, and filter them according to the import list
+    ifaceExportNames filtered_exports		`thenM` \ total_avails ->
+    filterImports iface imp_spec
+		  imp_details total_avails	`thenM` \ (avail_env, gbl_env) ->
+
+    getDOpts `thenM` \ dflags ->
+
+    let
+	-- Compute new transitive dependencies
+
+ 	orphans | is_orph   = ASSERT( not (imp_mod_name `elem` dep_orphs deps) )
+			      imp_mod_name : dep_orphs deps
+		| otherwise = dep_orphs deps
+
+	(dependent_mods, dependent_pkgs) 
+	   = case mi_package iface of
+		HomePackage ->
+	    	-- Imported module is from the home package
+		-- Take its dependent modules and add imp_mod itself
+		-- Take its dependent packages unchanged
+		--
+		-- NB: (dep_mods deps) might include a hi-boot file
+		-- for the module being compiled, CM. Do *not* filter
+		-- this out (as we used to), because when we've
+		-- finished dealing with the direct imports we want to
+		-- know if any of them depended on CM.hi-boot, in
+		-- which case we should do the hi-boot consistency
+		-- check.  See LoadIface.loadHiBootInterface
+		  ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)
+
+		ExtPackage pkg ->
+ 	   	-- Imported module is from another package
+		-- Dump the dependent modules
+		-- Add the package imp_mod comes from to the dependent packages
+	         ASSERT2( not (pkg `elem` dep_pkgs deps), ppr pkg <+> ppr (dep_pkgs deps) )
+	         ([], pkg : dep_pkgs deps)
+
+	-- True <=> import M ()
+	import_all = case imp_details of
+			Just (is_hiding, ls) -> not is_hiding && null ls	
+			other 		     -> False
+
+	-- unqual_avails is the Avails that are visible in *unqualified* form
+	-- We need to know this so we know what to export when we see
+	--	module M ( module P ) where ...
+	-- Then we must export whatever came from P unqualified.
+	imports   = ImportAvails { 
+			imp_env      = unitModuleEnv qual_mod_name avail_env,
+			imp_mods     = unitModuleEnv imp_mod (imp_mod, import_all, loc),
+			imp_orphs    = orphans,
+			imp_dep_mods = mkModDeps dependent_mods,
+			imp_dep_pkgs = dependent_pkgs }
+
+    in
+	-- Complain if we import a deprecated module
+    ifOptM Opt_WarnDeprecations	(
+       case deprecs of	
+	  DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt)
+	  other	        -> returnM ()
+    )							`thenM_`
+
+    returnM (gbl_env, imports)
+
+warnRedundantSourceImport mod_name
+  = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
+          <+> quotes (ppr mod_name)
+\end{code}
+
+
+%************************************************************************
+%*									*
+		importsFromLocalDecls
+%*									*
+%************************************************************************
+
+From the top-level declarations of this module produce
+  	* the lexical environment
+	* the ImportAvails
+created by its bindings.  
+	
+Complain about duplicate bindings
+
+\begin{code}
+importsFromLocalDecls :: HsGroup RdrName -> RnM TcGblEnv
+importsFromLocalDecls group
+  = do	{ gbl_env  <- getGblEnv
+
+	; names <- getLocalDeclBinders gbl_env group
+
+	; implicit_prelude <- doptM Opt_ImplicitPrelude
+	; let {
+	    -- Optimisation: filter out names for built-in syntax
+	    -- They just clutter up the environment (esp tuples), and the parser
+	    -- will generate Exact RdrNames for them, so the cluttered
+	    -- envt is no use.  To avoid doing this filter all the time,
+	    -- we use -fno-implicit-prelude as a clue that the filter is
+	    -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
+	    --
+	    -- It's worth doing because it makes the environment smaller for
+	    -- every module that imports the Prelude
+	    --
+	    -- Note: don't filter the gbl_env (hence all_names, not filered_all_names
+	    -- in defn of gres above).      Stupid reason: when parsing 
+	    -- data type decls, the constructors start as Exact tycon-names,
+	    -- and then get turned into data con names by zapping the name space;
+	    -- but that stops them being Exact, so they get looked up.  
+	    -- Ditto in fixity decls; e.g. 	infix 5 :
+	    -- Sigh. It doesn't matter because it only affects the Data.Tuple really.
+	    -- The important thing is to trim down the exports.
+	      filtered_names 
+	        | implicit_prelude = names
+	        | otherwise	   = filter (not . isBuiltInSyntax) names ;
+
+	    ; this_mod = tcg_mod gbl_env
+	    ; imports = emptyImportAvails {
+			  imp_env = unitModuleEnv this_mod $
+				    mkNameSet filtered_names
+		        }
+	    }
+
+	; rdr_env' <- extendRdrEnvRn (tcg_rdr_env gbl_env) names
+
+	; returnM (gbl_env { tcg_rdr_env = rdr_env',
+			     tcg_imports = imports `plusImportAvails` tcg_imports gbl_env }) 
+	}
+
+extendRdrEnvRn :: GlobalRdrEnv -> [Name] -> RnM GlobalRdrEnv
+-- Add the new locally-bound names one by one, checking for duplicates as
+-- we do so.  Remember that in Template Haskell the duplicates
+-- might *already be* in the GlobalRdrEnv from higher up the module
+extendRdrEnvRn rdr_env names
+  = foldlM add_local rdr_env names
+  where
+    add_local rdr_env name
+	| gres <- lookupGlobalRdrEnv rdr_env (nameOccName name)
+	, (dup_gre:_) <- filter isLocalGRE gres	-- Check for existing *local* defns
+	= do { addDupDeclErr (gre_name dup_gre) name
+	     ; return rdr_env }
+	| otherwise
+	= return (extendGlobalRdrEnv rdr_env new_gre)
+	where
+	  new_gre = GRE {gre_name = name, gre_prov = LocalDef}
+\end{code}
+
+@getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
+used for source code.
+
+	*** See "THE NAMING STORY" in HsDecls ****
+
+\begin{code}
+getLocalDeclBinders :: TcGblEnv -> HsGroup RdrName -> RnM [Name]
+getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs, 
+				      hs_tyclds = tycl_decls, 
+				      hs_fords = foreign_decls })
+  = do	{ tc_names_s <- mappM new_tc tycl_decls
+	; val_names  <- mappM new_simple val_bndrs
+	; return (foldr (++) val_names tc_names_s) }
+  where
+    mod        = tcg_mod gbl_env
+    is_hs_boot = isHsBoot (tcg_src gbl_env) ;
+    val_bndrs | is_hs_boot = sig_hs_bndrs
+	      | otherwise  = for_hs_bndrs ++ val_hs_bndrs
+	-- In a hs-boot file, the value binders come from the
+	--  *signatures*, and there should be no foreign binders 
+
+    new_simple rdr_name = newTopSrcBinder mod Nothing rdr_name
+
+    sig_hs_bndrs = [nm | L _ (TypeSig nm _) <- val_sigs]
+    val_hs_bndrs = collectHsBindLocatedBinders val_decls
+    for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls]
+
+    new_tc tc_decl 
+	= do { main_name <- newTopSrcBinder mod Nothing main_rdr
+	     ; sub_names <- mappM (newTopSrcBinder mod (Just main_name)) sub_rdrs
+	     ; return (main_name : sub_names) }
+	where
+	  (main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Filtering imports}
+%*									*
+%************************************************************************
+
+@filterImports@ takes the @ExportEnv@ telling what the imported module makes
+available, and filters it through the import spec (if any).
+
+\begin{code}
+filterImports :: ModIface
+	      -> ImpDeclSpec			-- The span for the entire import decl
+	      -> Maybe (Bool, [LIE Name])	-- Import spec; True => hiding
+	      -> NameSet			-- What's available
+	      -> RnM (NameSet,			-- What's imported (qualified or unqualified)
+		      GlobalRdrEnv)		-- Same again, but in GRE form
+
+	-- Complains if import spec mentions things that the module doesn't export
+        -- Warns/informs if import spec contains duplicates.
+			
+mkGenericRdrEnv decl_spec names
+  = mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] }
+		   | name <- nameSetToList names ]
+  where
+    imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
+
+filterImports iface decl_spec Nothing all_names
+  = return (all_names, mkGenericRdrEnv decl_spec all_names)
+
+filterImports iface decl_spec (Just (want_hiding, import_items)) all_names
+  = mapM (addLocM get_item) import_items >>= \gres_s ->
+    let gres = concat gres_s
+        specified_names = mkNameSet (map gre_name gres)
+    in if not want_hiding then
+       return (specified_names, mkGlobalRdrEnv gres)
+    else let keep n = not (n `elemNameSet` specified_names)
+             pruned_avails = filterNameSet keep all_names
+         in return (pruned_avails, mkGenericRdrEnv decl_spec pruned_avails)
+  where
+    sub_env :: NameEnv [Name]	-- Classify each name by its parent
+    sub_env = mkSubNameEnv all_names
+
+    succeed_with :: Bool -> [Name] -> RnM [GlobalRdrElt]
+    succeed_with all_explicit names
+      = do { loc <- getSrcSpanM
+	   ; returnM (map (mk_gre loc) names) }
+      where
+	mk_gre loc name = GRE { gre_name = name, 
+				gre_prov = Imported [imp_spec] }
+	  where
+	    imp_spec  = ImpSpec { is_decl = decl_spec, is_item = item_spec }
+	    item_spec = ImpSome { is_explicit = explicit, is_iloc = loc }
+	    explicit  = all_explicit || isNothing (nameParent_maybe name)
+
+    get_item :: IE Name -> RnM [GlobalRdrElt]
+	-- Empty result for a bad item.
+	-- Singleton result is typical case.
+	-- Can have two when we are hiding, and mention C which might be
+	--	both a class and a data constructor.  
+    get_item item@(IEModuleContents _) 
+        -- This case should be filtered out by 'rnImports'.
+        = panic "filterImports: IEModuleContents?" 
+
+    get_item (IEThingAll name)
+        = case subNames sub_env name of
+            [] ->       -- This occurs when you import T(..), but
+                        -- only export T abstractly.
+                  do ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn name))
+                     succeed_with False [name]
+            names -> succeed_with False (name:names)
+
+    get_item (IEThingAbs name)
+        = succeed_with True [name]
+
+    get_item (IEThingWith name names)
+        = succeed_with True (name:names)
+    get_item (IEVar name)
+        = succeed_with True [name]
+
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Export list processing}
+%*									*
+%************************************************************************
+
+Processing the export list.
+
+You might think that we should record things that appear in the export
+list as ``occurrences'' (using @addOccurrenceName@), but you'd be
+wrong.  We do check (here) that they are in scope, but there is no
+need to slurp in their actual declaration (which is what
+@addOccurrenceName@ forces).
+
+Indeed, doing so would big trouble when compiling @PrelBase@, because
+it re-exports @GHC@, which includes @takeMVar#@, whose type includes
+@ConcBase.StateAndSynchVar#@, and so on...
+
+\begin{code}
+type ExportAccum	-- The type of the accumulating parameter of
+			-- the main worker function in rnExports
+     = ([Module], 		-- 'module M's seen so far
+	ExportOccMap,		-- Tracks exported occurrence names
+	NameSet)		-- The accumulated exported stuff
+emptyExportAccum = ([], emptyOccEnv, emptyNameSet) 
+
+type ExportOccMap = OccEnv (Name, IE RdrName)
+	-- Tracks what a particular exported OccName
+	--   in an export list refers to, and which item
+	--   it came from.  It's illegal to export two distinct things
+	--   that have the same occurrence name
+
+rnExports :: Maybe [LIE RdrName]
+          -> RnM (Maybe [LIE Name])
+rnExports Nothing = return Nothing
+rnExports (Just exports)
+    = do TcGblEnv { tcg_imports = ImportAvails { imp_env = imp_env } } <- getGblEnv
+         let sub_env :: NameEnv [Name]	-- Classify each name by its parent
+             sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env)
+             rnExport (IEVar rdrName)
+                 = do name <- lookupGlobalOccRn rdrName
+                      return (IEVar name)
+             rnExport (IEThingAbs rdrName)
+                 = do name <- lookupGlobalOccRn rdrName
+                      return (IEThingAbs name)
+             rnExport (IEThingAll rdrName)
+                 = do name <- lookupGlobalOccRn rdrName
+                      return (IEThingAll name)
+             rnExport ie@(IEThingWith rdrName rdrNames)
+                 = do name <- lookupGlobalOccRn rdrName
+                      if isUnboundName name
+                         then return (IEThingWith name [])
+                         else do
+                      let env = mkOccEnv [(nameOccName s, s) | s <- subNames sub_env name]
+                          mb_names = map (lookupOccEnv env . rdrNameOcc) rdrNames
+                      if any isNothing mb_names
+                         then do addErr (exportItemErr ie)
+                                 return (IEThingWith name [])
+                         else return (IEThingWith name (catMaybes mb_names))
+             rnExport (IEModuleContents mod)
+                 = return (IEModuleContents mod)
+         rn_exports <- mapM (wrapLocM rnExport) exports
+         return (Just rn_exports)
+
+mkExportNameSet :: Bool  -- False => no 'module M(..) where' header at all
+                -> Maybe ([LIE Name], [LIE RdrName]) -- Nothing => no explicit export list
+                -> RnM NameSet
+	-- Complains if two distinct exports have same OccName
+        -- Warns about identical exports.
+	-- Complains about exports items not in scope
+
+mkExportNameSet explicit_mod exports
+ = do TcGblEnv { tcg_rdr_env = rdr_env, 
+                 tcg_imports = imports } <- getGblEnv
+
+	-- If the module header is omitted altogether, then behave
+	-- as if the user had written "module Main(main) where..."
+	-- EXCEPT in interactive mode, when we behave as if he had
+	-- written "module Main where ..."
+	-- Reason: don't want to complain about 'main' not in scope
+	--	   in interactive mode
+      ghc_mode <- getGhcMode
+      real_exports <- case () of
+                        () | explicit_mod
+                               -> return exports
+                           | ghc_mode == Interactive
+                               -> return Nothing
+                           | otherwise
+                               -> do mainName <- lookupGlobalOccRn main_RDR_Unqual
+                                     return (Just ([noLoc (IEVar mainName)]
+                                                  ,[noLoc (IEVar main_RDR_Unqual)]))
+		-- ToDo: the 'noLoc' here is unhelpful if 'main' turns out to be out of scope
+      exports_from_avail real_exports rdr_env imports
+
+
+exports_from_avail Nothing rdr_env imports
+ =  	-- Export all locally-defined things
+	-- We do this by filtering the global RdrEnv,
+	-- keeping only things that are locally-defined
+   return (mkNameSet [ gre_name gre 
+		     | gre <- globalRdrEnvElts rdr_env,
+		       isLocalGRE gre ])
+
+exports_from_avail (Just (items,origItems)) rdr_env (ImportAvails { imp_env = imp_env }) 
+  = do (_, _, exports) <- foldlM do_litem emptyExportAccum (zip items origItems)
+       return exports
+  where
+    sub_env :: NameEnv [Name]	-- Classify each name by its parent
+    sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env)
+
+    do_litem :: ExportAccum -> (LIE Name, LIE RdrName) -> RnM ExportAccum
+    do_litem acc (ieName, ieRdr)
+        = addLocM (exports_from_item acc (unLoc ieRdr)) ieName
+
+    exports_from_item :: ExportAccum -> IE RdrName -> IE Name -> RnM ExportAccum
+    exports_from_item acc@(mods, occs, exports) ieRdr@(IEModuleContents mod) ie
+	| mod `elem` mods 	-- Duplicate export of M
+	= do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
+	       warnIf warn_dup_exports (dupModuleExport mod) ;
+	       returnM acc }
+
+	| otherwise
+	= case lookupModuleEnv imp_env mod of
+            Nothing -> do addErr (modExportErr mod)
+                          return acc
+            Just names
+                -> do let new_exports = filterNameSet (inScopeUnqual rdr_env) names
+                      -- This check_occs not only finds conflicts between this item
+                      -- and others, but also internally within this item.  That is,
+                      -- if 'M.x' is in scope in several ways, we'll have several
+                      -- members of mod_avails with the same OccName.
+                      occs' <- check_occs ieRdr occs (nameSetToList new_exports)
+                      return (mod:mods, occs', exports `unionNameSets` new_exports)
+
+    exports_from_item acc@(mods, occs, exports) ieRdr ie
+        = if isUnboundName (ieName ie)
+          then return acc 	-- Avoid error cascade
+          else let new_exports = filterAvail ie sub_env in
+          do -- checkErr (not (null (drop 1 new_exports))) (exportItemErr ie)
+             checkForDodgyExport ie new_exports
+             occs' <- check_occs ieRdr occs new_exports
+             return (mods, occs', addListToNameSet exports new_exports)
+	  
+-------------------------------
+filterAvail :: IE Name  	-- Wanted
+	    -> NameEnv [Name]	-- Maps type/class names to their sub-names
+	    -> [Name]
+
+filterAvail (IEVar n)          subs = [n]
+filterAvail (IEThingAbs n)     subs = [n]
+filterAvail (IEThingAll n)     subs = n : subNames subs n
+filterAvail (IEThingWith n ns) subs = n : ns
+filterAvail (IEModuleContents _) _  = panic "filterAvail"
+
+subNames :: NameEnv [Name] -> Name -> [Name]
+subNames env n = lookupNameEnv env n `orElse` []
+
+mkSubNameEnv :: NameSet -> NameEnv [Name]
+-- Maps types and classes to their constructors/classops respectively
+-- This mapping just makes it easier to deal with A(..) export items
+mkSubNameEnv names
+  = foldNameSet add_name emptyNameEnv names
+  where
+    add_name name env 
+	| Just parent <- nameParent_maybe name 
+	= extendNameEnv_C (\ns _ -> name:ns) env parent [name]
+	| otherwise = env
+
+-------------------------------
+inScopeUnqual :: GlobalRdrEnv -> Name -> Bool
+-- Checks whether the Name is in scope unqualified, 
+-- regardless of whether it's ambiguous or not
+inScopeUnqual env n = any unQualOK (lookupGRE_Name env n)
+
+-------------------------------
+checkForDodgyExport :: IE Name -> [Name] -> RnM ()
+checkForDodgyExport ie@(IEThingAll tc) [n] 
+  | isTcOcc (nameOccName n) = addWarn (dodgyExportWarn tc)
+	-- This occurs when you export T(..), but
+	-- only import T abstractly, or T is a synonym.  
+	-- The single [n] is the type or class itself
+  | otherwise = addErr (exportItemErr ie)
+	-- This happes if you export x(..), which is bogus
+checkForDodgyExport _ _ = return ()
+
+-------------------------------
+check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap
+check_occs ie occs names
+  = foldlM check occs names
+  where
+    check occs name
+      = case lookupOccEnv occs name_occ of
+	  Nothing -> returnM (extendOccEnv occs name_occ (name, ie))
+
+	  Just (name', ie') 
+	    | name == name'  	-- Duplicate export
+	    ->	do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
+		     warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ;
+		     returnM occs }
+
+	    | otherwise		-- Same occ name but different names: an error
+	    ->	do { global_env <- getGlobalRdrEnv ;
+  		     addErr (exportClashErr global_env name name' ie ie') ;
+		     returnM occs }
+      where
+	name_occ = nameOccName name
+\end{code}
+
+%*********************************************************
+%*						 	 *
+		Deprecations
+%*							 *
+%*********************************************************
+
+\begin{code}
+reportDeprecations :: TcGblEnv -> RnM ()
+reportDeprecations tcg_env
+  = ifOptM Opt_WarnDeprecations	$
+    do	{ (eps,hpt) <- getEpsAndHpt
+		-- By this time, typechecking is complete, 
+		-- so the PIT is fully populated
+	; mapM_ (check hpt (eps_PIT eps)) all_gres }
+  where
+    used_names = allUses (tcg_dus tcg_env) 
+	-- Report on all deprecated uses; hence allUses
+    all_gres   = globalRdrEnvElts (tcg_rdr_env tcg_env)
+
+    check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
+      | name `elemNameSet` used_names
+      ,	Just deprec_txt <- lookupDeprec hpt pit name
+      = setSrcSpan (importSpecLoc imp_spec) $
+	addWarn (sep [ptext SLIT("Deprecated use of") <+> 
+			pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> 
+		 	quotes (ppr name),
+		      (parens imp_msg) <> colon,
+		      (ppr deprec_txt) ])
+	where
+	  name_mod = nameModule name
+	  imp_mod  = importSpecModule imp_spec
+	  imp_msg  = ptext SLIT("imported from") <+> ppr imp_mod <> extra
+	  extra | imp_mod == name_mod = empty
+		| otherwise = ptext SLIT(", but defined in") <+> ppr name_mod
+
+    check hpt pit ok_gre = returnM ()	-- Local, or not used, or not deprectated
+	    -- The Imported pattern-match: don't deprecate locally defined names
+	    -- For a start, we may be exporting a deprecated thing
+	    -- Also we may use a deprecated thing in the defn of another
+	    -- deprecated things.  We may even use a deprecated thing in
+	    -- the defn of a non-deprecated thing, when changing a module's 
+	    -- interface
+
+lookupDeprec :: HomePackageTable -> PackageIfaceTable 
+	     -> Name -> Maybe DeprecTxt
+lookupDeprec hpt pit n 
+  = case lookupIface hpt pit (nameModule n) of
+	Just iface -> mi_dep_fn iface n `seqMaybe` 	-- Bleat if the thing, *or
+		      mi_dep_fn iface (nameParent n)	-- its parent*, is deprec'd
+	Nothing    
+	  | isWiredInName n -> Nothing
+		-- We have not necessarily loaded the .hi file for a 
+		-- wired-in name (yet), although we *could*.
+		-- And we never deprecate them
+
+	 | otherwise -> pprPanic "lookupDeprec" (ppr n)	
+		-- By now all the interfaces should have been loaded
+
+gre_is_used :: NameSet -> GlobalRdrElt -> Bool
+gre_is_used used_names gre = gre_name gre `elemNameSet` used_names
+\end{code}
+
+%*********************************************************
+%*						 	 *
+		Unused names
+%*							 *
+%*********************************************************
+
+\begin{code}
+reportUnusedNames :: Maybe [LIE RdrName] 	-- Export list
+		  -> TcGblEnv -> RnM ()
+reportUnusedNames export_decls gbl_env 
+  = do	{ traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env)))
+	; warnUnusedTopBinds   unused_locals
+	; warnUnusedModules    unused_imp_mods
+	; warnUnusedImports    unused_imports	
+	; warnDuplicateImports defined_and_used
+	; printMinimalImports  minimal_imports }
+  where
+    used_names, all_used_names :: NameSet
+    used_names = findUses (tcg_dus gbl_env) emptyNameSet
+	-- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
+	-- Hence findUses
+
+    all_used_names = used_names `unionNameSets` 
+		     mkNameSet (mapCatMaybes nameParent_maybe (nameSetToList used_names))
+			-- A use of C implies a use of T,
+			-- if C was brought into scope by T(..) or T(C)
+
+	-- Collect the defined names from the in-scope environment
+    defined_names :: [GlobalRdrElt]
+    defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
+
+	-- Note that defined_and_used, defined_but_not_used
+	-- are both [GRE]; that's why we need defined_and_used
+	-- rather than just all_used_names
+    defined_and_used, defined_but_not_used :: [GlobalRdrElt]
+    (defined_and_used, defined_but_not_used) 
+	= partition (gre_is_used all_used_names) defined_names
+    
+	-- Filter out the ones that are 
+	--  (a) defined in this module, and
+	--  (b) not defined by a 'deriving' clause 
+	-- The latter have an Internal Name, so we can filter them out easily
+    unused_locals :: [GlobalRdrElt]
+    unused_locals = filter is_unused_local defined_but_not_used
+    is_unused_local :: GlobalRdrElt -> Bool
+    is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)
+    
+    unused_imports :: [GlobalRdrElt]
+    unused_imports = filter unused_imp defined_but_not_used
+    unused_imp (GRE {gre_prov = Imported imp_specs}) 
+	= not (all (module_unused . importSpecModule) imp_specs)
+	  && or [exp | ImpSpec { is_item = ImpSome { is_explicit = exp } } <- imp_specs]
+		-- Don't complain about unused imports if we've already said the
+		-- entire import is unused
+    unused_imp other = False
+    
+    -- To figure out the minimal set of imports, start with the things
+    -- that are in scope (i.e. in gbl_env).  Then just combine them
+    -- into a bunch of avails, so they are properly grouped
+    --
+    -- BUG WARNING: this does not deal properly with qualified imports!
+    minimal_imports :: FiniteMap Module AvailEnv
+    minimal_imports0 = foldr add_expall   emptyFM 	   expall_mods
+    minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
+    minimal_imports  = foldr add_inst_mod minimal_imports1 direct_import_mods
+ 	-- The last line makes sure that we retain all direct imports
+    	-- even if we import nothing explicitly.
+    	-- It's not necessarily redundant to import such modules. Consider 
+    	--	      module This
+    	--		import M ()
+    	--
+    	-- The import M() is not *necessarily* redundant, even if
+    	-- we suck in no instance decls from M (e.g. it contains 
+    	-- no instance decls, or This contains no code).  It may be 
+    	-- that we import M solely to ensure that M's orphan instance 
+    	-- decls (or those in its imports) are visible to people who 
+    	-- import This.  Sigh. 
+    	-- There's really no good way to detect this, so the error message 
+    	-- in RnEnv.warnUnusedModules is weakened instead
+    
+	-- We've carefully preserved the provenance so that we can
+	-- construct minimal imports that import the name by (one of)
+	-- the same route(s) as the programmer originally did.
+    add_name (GRE {gre_name = n, gre_prov = Imported imp_specs}) acc 
+	= addToFM_C plusAvailEnv acc (importSpecModule (head imp_specs))
+		    (unitAvailEnv (mk_avail n (nameParent_maybe n)))
+    add_name other acc 
+	= acc
+
+	-- Modules mentioned as 'module M' in the export list
+    expall_mods = case export_decls of
+		    Nothing -> []
+		    Just es -> [m | L _ (IEModuleContents m) <- es]
+
+	-- This is really bogus.  The idea is that if we see 'module M' in 
+	-- the export list we must retain the import decls that drive it
+	-- If we aren't careful we might see
+	--	module A( module M ) where
+	--	  import M
+	--	  import N
+	-- and suppose that N exports everything that M does.  Then we 
+	-- must not drop the import of M even though N brings it all into
+	-- scope.
+	--
+	-- BUG WARNING: 'module M' exports aside, what if M.x is mentioned?!
+	--
+	-- The reason that add_expall is bogus is that it doesn't take
+	-- qualified imports into account.  But it's an improvement.
+    add_expall mod acc = addToFM_C plusAvailEnv acc mod emptyAvailEnv
+
+	-- n is the name of the thing, p is the name of its parent
+    mk_avail n (Just p)			 	 = AvailTC p [p,n]
+    mk_avail n Nothing | isTcOcc (nameOccName n) = AvailTC n [n]
+		       | otherwise		 = Avail n
+    
+    add_inst_mod (mod,_,_) acc 
+      | mod `elemFM` acc = acc	-- We import something already
+      | otherwise        = addToFM acc mod emptyAvailEnv
+      where
+    	-- Add an empty collection of imports for a module
+    	-- from which we have sucked only instance decls
+   
+    imports = tcg_imports gbl_env
+
+    direct_import_mods :: [(Module, Bool, SrcSpan)]
+	-- See the type of the imp_mods for this triple
+    direct_import_mods = moduleEnvElts (imp_mods imports)
+
+    -- unused_imp_mods are the directly-imported modules 
+    -- that are not mentioned in minimal_imports1
+    -- [Note: not 'minimal_imports', because that includes directly-imported
+    --	      modules even if we use nothing from them; see notes above]
+    --
+    -- BUG WARNING: does not deal correctly with multiple imports of the same module
+    --	 	    becuase direct_import_mods has only one entry per module
+    unused_imp_mods = [(mod,loc) | (mod,no_imp,loc) <- direct_import_mods,
+    		       not (mod `elemFM` minimal_imports1),
+    		       mod /= pRELUDE,
+		       not no_imp]
+	-- The not no_imp part is not to complain about
+	-- import M (), which is an idiom for importing
+	-- instance declarations
+    
+    module_unused :: Module -> Bool
+    module_unused mod = any (((==) mod) . fst) unused_imp_mods
+
+---------------------
+warnDuplicateImports :: [GlobalRdrElt] -> RnM ()
+-- Given the GREs for names that are used, figure out which imports 
+-- could be omitted without changing the top-level environment.
+--
+-- NB: Given import Foo( T )
+--     	     import qualified Foo
+-- we do not report a duplicate import, even though Foo.T is brought
+-- into scope by both, because there's nothing you can *omit* without
+-- changing the top-level environment.  So we complain only if it's
+-- explicitly named in both imports or neither.
+--
+-- Furthermore, we complain about Foo.T only if 
+-- there is no complaint about (unqualified) T
+
+warnDuplicateImports gres
+  = ifOptM Opt_WarnUnusedImports $ 
+    sequenceM_	[ warn name pr
+			-- The 'head' picks the first offending group
+			-- for this particular name
+		| GRE { gre_name = name, gre_prov = Imported imps } <- gres
+		, pr <- redundants imps ]
+  where
+    warn name (red_imp, cov_imp)
+	= addWarnAt (importSpecLoc red_imp)
+	    (vcat [ptext SLIT("Redundant import of:") <+> quotes pp_name,
+	           ptext SLIT("It is also") <+> ppr cov_imp])
+	where
+	  pp_name | is_qual red_decl = ppr (is_as red_decl) <> dot <> ppr occ
+		  | otherwise	    = ppr occ
+	  occ = nameOccName name
+	  red_decl = is_decl red_imp
+    
+    redundants :: [ImportSpec] -> [(ImportSpec,ImportSpec)]
+	-- The returned pair is (redundant-import, covering-import)
+    redundants imps 
+	= [ (red_imp, cov_imp) 
+	  | red_imp <- imps
+	  , cov_imp <- take 1 (filter (covers red_imp) imps) ]
+
+	-- "red_imp" is a putative redundant import
+	-- "cov_imp" potentially covers it
+	-- This test decides whether red_imp could be dropped 
+	--
+	-- NOTE: currently the test does not warn about
+	--		import M( x )
+	--		imoprt N( x )
+	-- even if the same underlying 'x' is involved, because dropping
+	-- either import would change the qualified names in scope (M.x, N.x)
+	-- But if the qualified names aren't used, the import is indeed redundant
+	-- Sadly we don't know that.  Oh well.
+    covers red_imp@(ImpSpec { is_decl = red_decl, is_item = red_item }) 
+	   cov_imp@(ImpSpec { is_decl = cov_decl, is_item = cov_item })
+	| red_loc == cov_loc
+  	= False		-- Ignore diagonal elements
+	| not (is_as red_decl == is_as cov_decl)
+	= False		-- They bring into scope different qualified names
+	| not (is_qual red_decl) && is_qual cov_decl
+	= False		-- Covering one doesn't bring unqualified name into scope
+	| red_selective
+	= not cov_selective 	-- Redundant one is selective and covering one isn't
+	  || red_later		-- Both are explicit; tie-break using red_later
+	| otherwise		
+	= not cov_selective 	-- Neither import is selective
+	  && (is_mod red_decl == is_mod cov_decl)	-- They import the same module
+	  && red_later 		-- Tie-break
+	where
+	  red_loc   = importSpecLoc red_imp
+	  cov_loc   = importSpecLoc cov_imp
+	  red_later = red_loc > cov_loc
+	  cov_selective = selectiveImpItem cov_item
+	  red_selective = selectiveImpItem red_item
+
+selectiveImpItem :: ImpItemSpec -> Bool
+selectiveImpItem ImpAll       = False
+selectiveImpItem (ImpSome {}) = True
+
+-- ToDo: deal with original imports with 'qualified' and 'as M' clauses
+printMinimalImports :: FiniteMap Module AvailEnv	-- Minimal imports
+		    -> RnM ()
+printMinimalImports imps
+ = ifOptM Opt_D_dump_minimal_imports $ do {
+
+   mod_ies  <-  mappM to_ies (fmToList imps) ;
+   this_mod <- getModule ;
+   rdr_env  <- getGlobalRdrEnv ;
+   ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ;
+		  printForUser h (unQualInScope rdr_env) 
+				 (vcat (map ppr_mod_ie mod_ies)) })
+   }
+  where
+    mkFilename this_mod = moduleString this_mod ++ ".imports"
+    ppr_mod_ie (mod_name, ies) 
+	| mod_name == pRELUDE 
+	= empty
+	| null ies	-- Nothing except instances comes from here
+	= ptext SLIT("import") <+> ppr mod_name <> ptext SLIT("()    -- Instances only")
+	| otherwise
+	= ptext SLIT("import") <+> ppr mod_name <> 
+		    parens (fsep (punctuate comma (map ppr ies)))
+
+    to_ies (mod, avail_env) = do ies <- mapM to_ie (availEnvElts avail_env)
+                                 returnM (mod, ies)
+
+    to_ie :: AvailInfo -> RnM (IE Name)
+	-- The main trick here is that if we're importing all the constructors
+	-- we want to say "T(..)", but if we're importing only a subset we want
+	-- to say "T(A,B,C)".  So we have to find out what the module exports.
+    to_ie (Avail n)       = returnM (IEVar n)
+    to_ie (AvailTC n [m]) = ASSERT( n==m ) 
+			    returnM (IEThingAbs n)
+    to_ie (AvailTC n ns)  
+	= loadSrcInterface doc n_mod False			`thenM` \ iface ->
+	  case [xs | (m,as) <- mi_exports iface,
+		     m == n_mod,
+		     AvailTC x xs <- as, 
+		     x == nameOccName n] of
+	      [xs] | all_used xs -> returnM (IEThingAll n)
+		   | otherwise	 -> returnM (IEThingWith n (filter (/= n) ns))
+	      other		 -> pprTrace "to_ie" (ppr n <+> ppr n_mod <+> ppr other) $
+				    returnM (IEVar n)
+	where
+	  all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
+	  doc = text "Compute minimal imports from" <+> ppr n
+	  n_mod = nameModule n
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Errors}
+%*									*
+%************************************************************************
+
+\begin{code}
+badImportItemErr iface decl_spec ie
+  = sep [ptext SLIT("Module"), quotes (ppr (is_mod decl_spec)), source_import,
+	 ptext SLIT("does not export"), quotes (ppr ie)]
+  where
+    source_import | mi_boot iface = ptext SLIT("(hi-boot interface)")
+		  | otherwise     = empty
+
+dodgyImportWarn item = dodgyMsg (ptext SLIT("import")) item
+dodgyExportWarn item = dodgyMsg (ptext SLIT("export")) item
+
+dodgyMsg kind tc
+  = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr (IEThingAll tc)),
+	  ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"),
+	  ptext SLIT("but it has none; it is a type synonym or abstract type or class") ]
+	  
+modExportErr mod
+  = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (ppr mod)]
+
+exportItemErr export_item
+  = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item),
+	  ptext SLIT("attempts to export constructors or class methods that are not visible here") ]
+
+exportClashErr global_env name1 name2 ie1 ie2
+  = vcat [ ptext SLIT("Conflicting exports for") <+> quotes (ppr occ) <> colon
+	 , ppr_export ie1 name1 
+	 , ppr_export ie2 name2  ]
+  where
+    occ = nameOccName name1
+    ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext SLIT("exports") <+> 
+			 	 quotes (ppr name) <+> pprNameProvenance (get_gre name))
+
+	-- get_gre finds a GRE for the Name, so that we can show its provenance
+    get_gre name
+	= case lookupGRE_Name global_env name of
+	     (gre:_) -> gre
+	     []	     -> pprPanic "exportClashErr" (ppr name)
+
+addDupDeclErr :: Name -> Name -> TcRn ()
+addDupDeclErr name_a name_b
+  = addErrAt (srcLocSpan loc2) $
+    vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr name1),
+	  ptext SLIT("Declared at:") <+> vcat [ppr (nameSrcLoc name1), ppr loc2]]
+  where
+    loc2 = nameSrcLoc name2
+    (name1,name2) | nameSrcLoc name_a > nameSrcLoc name_b = (name_b,name_a)
+		  | otherwise				  = (name_a,name_b)
+	-- Report the error at the later location
+
+dupExportWarn occ_name ie1 ie2
+  = hsep [quotes (ppr occ_name), 
+          ptext SLIT("is exported by"), quotes (ppr ie1),
+          ptext SLIT("and"),            quotes (ppr ie2)]
+
+dupModuleExport mod
+  = hsep [ptext SLIT("Duplicate"),
+	  quotes (ptext SLIT("Module") <+> ppr mod), 
+          ptext SLIT("in export list")]
+
+moduleDeprec mod txt
+  = sep [ ptext SLIT("Module") <+> quotes (ppr mod) <+> ptext SLIT("is deprecated:"), 
+	  nest 4 (ppr txt) ]	  
+\end{code}
diff --git a/compiler/rename/RnSource.hi-boot-5 b/compiler/rename/RnSource.hi-boot-5
new file mode 100644
index 0000000000..1ec4d52522
--- /dev/null
+++ b/compiler/rename/RnSource.hi-boot-5
@@ -0,0 +1,13 @@
+__interface RnSource 1 0 where
+__export RnSource rnBindsAndThen rnBinds rnSrcDecls;
+
+1 rnBindsAndThen :: __forall [b] => [HsBinds.HsBindGroup RdrName.RdrName]
+	-> ([HsBinds.HsBindGroup Name.Name]
+ 	-> TcRnTypes.RnM (b, NameSet.FreeVars))
+	-> TcRnTypes.RnM (b, NameSet.FreeVars) ;
+
+1 rnBinds :: [HsBinds.HsBindGroup RdrName.RdrName]
+	-> TcRnTypes.RnM ([HsBinds.HsBindGroup Name.Name], NameSet.DefUses) ;
+
+1 rnSrcDecls :: HsDecls.HsGroup RdrName.RdrName
+	   -> TcRnTypes.RnM (TcRnTypes.TcGblEnv, HsDecls.HsGroup Name.Name)
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
new file mode 100644
index 0000000000..9150440aee
--- /dev/null
+++ b/compiler/rename/RnSource.lhs
@@ -0,0 +1,722 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[RnSource]{Main pass of renamer}
+
+\begin{code}
+module RnSource ( 
+	rnSrcDecls, addTcgDUs, 
+	rnTyClDecls, checkModDeprec,
+	rnSplice, checkTH
+    ) where
+
+#include "HsVersions.h"
+
+import {-# SOURCE #-} RnExpr( rnLExpr )
+
+import HsSyn
+import RdrName		( RdrName, isRdrDataCon, elemLocalRdrEnv, globalRdrEnvElts,
+			  GlobalRdrElt(..), isLocalGRE )
+import RdrHsSyn		( extractGenericPatTyVars, extractHsRhoRdrTyVars )
+import RnHsSyn
+import RnTypes		( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
+import RnBinds		( rnTopBinds, rnMethodBinds, renameSigs )
+import RnEnv		( lookupLocalDataTcNames,
+			  lookupLocatedTopBndrRn, lookupLocatedOccRn,
+			  lookupOccRn, newLocalsRn, 
+			  bindLocatedLocalsFV, bindPatSigTyVarsFV,
+			  bindTyVarsRn, extendTyVarEnvFVRn,
+			  bindLocalNames, checkDupNames, mapFvRn
+			)
+import TcRnMonad
+
+import HscTypes		( FixityEnv, FixItem(..),
+			  Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
+import Class		( FunDep )
+import Name		( Name, nameOccName )
+import NameSet
+import NameEnv
+import OccName		( occEnvElts )
+import Outputable
+import SrcLoc		( Located(..), unLoc, getLoc, noLoc )
+import DynFlags	( DynFlag(..) )
+import Maybes		( seqMaybe )
+import Maybe            ( isNothing )
+import BasicTypes       ( Boxity(..) )
+\end{code}
+
+@rnSourceDecl@ `renames' declarations.
+It simultaneously performs dependency analysis and precedence parsing.
+It also does the following error checks:
+\begin{enumerate}
+\item
+Checks that tyvars are used properly. This includes checking
+for undefined tyvars, and tyvars in contexts that are ambiguous.
+(Some of this checking has now been moved to module @TcMonoType@,
+since we don't have functional dependency information at this point.)
+\item
+Checks that all variable occurences are defined.
+\item 
+Checks the @(..)@ etc constraints in the export list.
+\end{enumerate}
+
+
+\begin{code}
+rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
+
+rnSrcDecls (HsGroup { hs_valds  = val_decls,
+		      hs_tyclds = tycl_decls,
+		      hs_instds = inst_decls,
+		      hs_fixds  = fix_decls,
+		      hs_depds  = deprec_decls,
+		      hs_fords  = foreign_decls,
+		      hs_defds  = default_decls,
+		      hs_ruleds = rule_decls })
+
+ = do {		-- Deal with deprecations (returns only the extra deprecations)
+	deprecs <- rnSrcDeprecDecls deprec_decls ;
+	updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
+		  $ do {
+
+		-- Deal with top-level fixity decls 
+		-- (returns the total new fixity env)
+	fix_env <- rnSrcFixityDeclsEnv fix_decls ;
+        rn_fix_decls <- rnSrcFixityDecls fix_decls ;
+	updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
+		  $ do {
+
+		-- Rename other declarations
+	traceRn (text "Start rnmono") ;
+	(rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
+	traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
+
+		-- You might think that we could build proper def/use information
+		-- for type and class declarations, but they can be involved
+		-- in mutual recursion across modules, and we only do the SCC
+		-- analysis for them in the type checker.
+		-- So we content ourselves with gathering uses only; that
+		-- means we'll only report a declaration as unused if it isn't
+		-- mentioned at all.  Ah well.
+	(rn_tycl_decls,    src_fvs1)
+	   <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
+	(rn_inst_decls,    src_fvs2)
+	   <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
+	(rn_rule_decls,    src_fvs3)
+	   <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
+	(rn_foreign_decls, src_fvs4)
+	   <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
+	(rn_default_decls, src_fvs5)
+	   <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
+	
+	let {
+	   rn_group = HsGroup { hs_valds  = rn_val_decls,
+			    	hs_tyclds = rn_tycl_decls,
+			    	hs_instds = rn_inst_decls,
+			    	hs_fixds  = rn_fix_decls,
+			    	hs_depds  = [],
+			    	hs_fords  = rn_foreign_decls,
+			    	hs_defds  = rn_default_decls,
+			    	hs_ruleds = rn_rule_decls } ;
+
+	   other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, 
+				src_fvs4, src_fvs5] ;
+	   src_dus = bind_dus `plusDU` usesOnly other_fvs 
+		-- Note: src_dus will contain *uses* for locally-defined types
+		-- and classes, but no *defs* for them.  (Because rnTyClDecl 
+		-- returns only the uses.)  This is a little 
+		-- surprising but it doesn't actually matter at all.
+	} ;
+
+	traceRn (text "finish rnSrc" <+> ppr rn_group) ;
+	traceRn (text "finish Dus" <+> ppr src_dus ) ;
+	tcg_env <- getGblEnv ;
+	return (tcg_env `addTcgDUs` src_dus, rn_group)
+    }}}
+
+rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
+rnTyClDecls tycl_decls = do 
+  (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
+  return decls'
+
+addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv 
+addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
+\end{code}
+
+
+%*********************************************************
+%*						 	 *
+	Source-code fixity declarations
+%*							 *
+%*********************************************************
+
+\begin{code}
+rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
+rnSrcFixityDecls fix_decls
+    = do fix_decls <- mapM rnFixityDecl fix_decls
+         return (concat fix_decls)
+
+rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
+rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
+    = do names <- lookupLocalDataTcNames rdr_name
+         return [ L loc (FixitySig (L nameLoc name) fixity)
+                      | name <- names ]
+
+rnSrcFixityDeclsEnv :: [LFixitySig RdrName] -> RnM FixityEnv
+rnSrcFixityDeclsEnv fix_decls
+  = getGblEnv					`thenM` \ gbl_env ->
+    foldlM rnFixityDeclEnv (tcg_fix_env gbl_env) 
+	    fix_decls				 	`thenM` \ fix_env ->
+    traceRn (text "fixity env" <+> pprFixEnv fix_env)	`thenM_`
+    returnM fix_env
+
+rnFixityDeclEnv :: FixityEnv -> LFixitySig RdrName -> RnM FixityEnv
+rnFixityDeclEnv fix_env (L loc (FixitySig rdr_name fixity))
+  = setSrcSpan loc $
+        -- GHC extension: look up both the tycon and data con 
+	-- for con-like things
+	-- If neither are in scope, report an error; otherwise
+	-- add both to the fixity env
+     addLocM lookupLocalDataTcNames rdr_name	`thenM` \ names ->
+     foldlM add fix_env names
+  where
+    add fix_env name
+      = case lookupNameEnv fix_env name of
+          Just (FixItem _ _ loc') 
+		  -> addLocErr rdr_name (dupFixityDecl loc')	`thenM_`
+    		     returnM fix_env
+    	  Nothing -> returnM (extendNameEnv fix_env name fix_item)
+      where
+	fix_item = FixItem (nameOccName name) fixity (getLoc rdr_name)
+
+pprFixEnv :: FixityEnv -> SDoc
+pprFixEnv env 
+  = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
+		  (nameEnvElts env)
+
+dupFixityDecl loc rdr_name
+  = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
+	  ptext SLIT("also at ") <+> ppr loc
+	]
+\end{code}
+
+
+%*********************************************************
+%*						 	 *
+	Source-code deprecations declarations
+%*							 *
+%*********************************************************
+
+For deprecations, all we do is check that the names are in scope.
+It's only imported deprecations, dealt with in RnIfaces, that we
+gather them together.
+
+\begin{code}
+rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
+rnSrcDeprecDecls [] 
+  = returnM NoDeprecs
+
+rnSrcDeprecDecls decls
+  = mappM (addLocM rn_deprec) decls	`thenM` \ pairs_s ->
+    returnM (DeprecSome (mkNameEnv (concat pairs_s)))
+ where
+   rn_deprec (Deprecation rdr_name txt)
+     = lookupLocalDataTcNames rdr_name	`thenM` \ names ->
+       returnM [(name, (nameOccName name, txt)) | name <- names]
+
+checkModDeprec :: Maybe DeprecTxt -> Deprecations
+-- Check for a module deprecation; done once at top level
+checkModDeprec Nothing    = NoDeprecs
+checkModDeprec (Just txt) = DeprecAll txt
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Source code declarations}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnDefaultDecl (DefaultDecl tys)
+  = mapFvRn (rnHsTypeFVs doc_str) tys	`thenM` \ (tys', fvs) ->
+    returnM (DefaultDecl tys', fvs)
+  where
+    doc_str = text "In a `default' declaration"
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Foreign declarations}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnHsForeignDecl (ForeignImport name ty spec isDeprec)
+  = lookupLocatedTopBndrRn name	        `thenM` \ name' ->
+    rnHsTypeFVs (fo_decl_msg name) ty	`thenM` \ (ty', fvs) ->
+    returnM (ForeignImport name' ty' spec isDeprec, fvs)
+
+rnHsForeignDecl (ForeignExport name ty spec isDeprec)
+  = lookupLocatedOccRn name	        `thenM` \ name' ->
+    rnHsTypeFVs (fo_decl_msg name) ty  	`thenM` \ (ty', fvs) ->
+    returnM (ForeignExport name' ty' spec isDeprec, fvs )
+	-- NB: a foreign export is an *occurrence site* for name, so 
+	--     we add it to the free-variable list.  It might, for example,
+	--     be imported from another module
+
+fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
+\end{code}
+
+
+%*********************************************************
+%*							*
+\subsection{Instance declarations}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnSrcInstDecl (InstDecl inst_ty mbinds uprags)
+	-- Used for both source and interface file decls
+  = rnHsSigType (text "an instance decl") inst_ty	`thenM` \ inst_ty' ->
+
+	-- Rename the bindings
+	-- The typechecker (not the renamer) checks that all 
+	-- the bindings are for the right class
+    let
+	meth_doc    = text "In the bindings in an instance declaration"
+	meth_names  = collectHsBindLocatedBinders mbinds
+	(inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
+    in
+    checkDupNames meth_doc meth_names 	`thenM_`
+    extendTyVarEnvForMethodBinds inst_tyvars (		
+	-- (Slightly strangely) the forall-d tyvars scope over
+	-- the method bindings too
+	rnMethodBinds cls [] mbinds
+    )						`thenM` \ (mbinds', meth_fvs) ->
+	-- Rename the prags and signatures.
+	-- Note that the type variables are not in scope here,
+	-- so that	instance Eq a => Eq (T a) where
+	--			{-# SPECIALISE instance Eq a => Eq (T [a]) #-}
+	-- works OK. 
+	--
+	-- But the (unqualified) method names are in scope
+    let 
+	binders = collectHsBindBinders mbinds'
+	ok_sig  = okInstDclSig (mkNameSet binders)
+    in
+    bindLocalNames binders (renameSigs ok_sig uprags)	`thenM` \ uprags' ->
+
+    returnM (InstDecl inst_ty' mbinds' uprags',
+	     meth_fvs `plusFV` hsSigsFVs uprags'
+		      `plusFV` extractHsTyNames inst_ty')
+\end{code}
+
+For the method bindings in class and instance decls, we extend the 
+type variable environment iff -fglasgow-exts
+
+\begin{code}
+extendTyVarEnvForMethodBinds tyvars thing_inside
+  = doptM Opt_GlasgowExts			`thenM` \ opt_GlasgowExts ->
+    if opt_GlasgowExts then
+	extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
+    else
+	thing_inside
+\end{code}
+
+
+%*********************************************************
+%*							*
+\subsection{Rules}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
+  = bindPatSigTyVarsFV (collectRuleBndrSigTys vars)	$
+
+    bindLocatedLocalsFV doc (map get_var vars)		$ \ ids ->
+    mapFvRn rn_var (vars `zip` ids)		`thenM` \ (vars', fv_vars) ->
+
+    rnLExpr lhs					`thenM` \ (lhs', fv_lhs') ->
+    rnLExpr rhs					`thenM` \ (rhs', fv_rhs') ->
+    let
+	mb_bad = validRuleLhs ids lhs'
+    in
+    checkErr (isNothing mb_bad)
+	     (badRuleLhsErr rule_name lhs' mb_bad)	`thenM_`
+    let
+	bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
+    in
+    mappM (addErr . badRuleVar rule_name) bad_vars	`thenM_`
+    returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
+	     fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
+  where
+    doc = text "In the transformation rule" <+> ftext rule_name
+  
+    get_var (RuleBndr v)      = v
+    get_var (RuleBndrSig v _) = v
+
+    rn_var (RuleBndr (L loc v), id)
+	= returnM (RuleBndr (L loc id), emptyFVs)
+    rn_var (RuleBndrSig (L loc v) t, id)
+	= rnHsTypeFVs doc t	`thenM` \ (t', fvs) ->
+	  returnM (RuleBndrSig (L loc id) t', fvs)
+\end{code}
+
+Check the shape of a transformation rule LHS.  Currently
+we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
+not one of the @forall@'d variables.  We also restrict the form of the LHS so
+that it may be plausibly matched.  Basically you only get to write ordinary 
+applications.  (E.g. a case expression is not allowed: too elaborate.)
+
+NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
+
+\begin{code}
+validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
+-- Nothing => OK
+-- Just e  => Not ok, and e is the offending expression
+validRuleLhs foralls lhs
+  = checkl lhs
+  where
+    checkl (L loc e) = check e
+
+    check (OpApp e1 op _ e2)		  = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
+    check (HsApp e1 e2) 		  = checkl e1 `seqMaybe` checkl_e e2
+    check (HsVar v) | v `notElem` foralls = Nothing
+    check other				  = Just other 	-- Failure
+
+    checkl_e (L loc e) = check_e e
+
+    check_e (HsVar v)     = Nothing
+    check_e (HsPar e) 	  = checkl_e e
+    check_e (HsLit e) 	  = Nothing
+    check_e (HsOverLit e) = Nothing
+
+    check_e (OpApp e1 op _ e2) 	 = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
+    check_e (HsApp e1 e2)      	 = checkl_e e1 `seqMaybe` checkl_e e2
+    check_e (NegApp e _)       	 = checkl_e e
+    check_e (ExplicitList _ es)	 = checkl_es es
+    check_e (ExplicitTuple es _) = checkl_es es
+    check_e other		 = Just other	-- Fails
+
+    checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
+
+badRuleLhsErr name lhs (Just bad_e)
+  = sep [ptext SLIT("Rule") <+> ftext name <> colon,
+	 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e, 
+		       ptext SLIT("in left-hand side:") <+> ppr lhs])]
+    $$
+    ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
+
+badRuleVar name var
+  = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
+	 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+> 
+		ptext SLIT("does not appear on left hand side")]
+\end{code}
+
+
+%*********************************************************
+%*							*
+\subsection{Type, class and iface sig 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}
+rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
+  = lookupLocatedTopBndrRn name		`thenM` \ name' ->
+    returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
+	     emptyFVs)
+
+rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
+		    tcdTyVars = tyvars, tcdCons = condecls, 
+		    tcdKindSig = sig, tcdDerivs = derivs})
+  | is_vanilla	-- Normal Haskell data type decl
+  = ASSERT( isNothing sig )	-- In normal H98 form, kind signature on the 
+				-- data type is syntactically illegal
+    bindTyVarsRn data_doc tyvars		$ \ tyvars' ->
+    do	{ tycon' <- lookupLocatedTopBndrRn tycon
+	; context' <- rnContext data_doc context
+	; (derivs', deriv_fvs) <- rn_derivs derivs
+	; checkDupNames data_doc con_names
+	; condecls' <- rnConDecls (unLoc tycon') condecls
+	; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
+			   tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls', 
+			   tcdDerivs = derivs'}, 
+		   delFVs (map hsLTyVarName tyvars')	$
+	     	   extractHsCtxtTyNames context'	`plusFV`
+	     	   plusFVs (map conDeclFVs condecls') `plusFV`
+	     	   deriv_fvs) }
+
+  | otherwise	-- GADT
+  = do	{ tycon' <- lookupLocatedTopBndrRn tycon
+	; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
+    	; tyvars' <- bindTyVarsRn data_doc tyvars 
+				  (\ tyvars' -> return tyvars')
+		-- For GADTs, the type variables in the declaration 
+		-- do not scope over the constructor signatures
+		-- 	data T a where { T1 :: forall b. b-> b }
+	; (derivs', deriv_fvs) <- rn_derivs derivs
+	; checkDupNames data_doc con_names
+	; condecls' <- rnConDecls (unLoc tycon') condecls
+	; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
+			   tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
+			   tcdDerivs = derivs'}, 
+	     	   plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
+
+  where
+    is_vanilla = case condecls of	-- Yuk
+		     [] 		   -> True
+		     L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
+		     other		   -> False
+
+    data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
+    con_names = map con_names_helper condecls
+
+    con_names_helper (L _ c) = con_name c
+
+    rn_derivs Nothing   = returnM (Nothing, emptyFVs)
+    rn_derivs (Just ds) = rnLHsTypes data_doc ds	`thenM` \ ds' -> 
+			  returnM (Just ds', extractHsTyNames_s ds')
+    
+rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
+  = lookupLocatedTopBndrRn name			`thenM` \ name' ->
+    bindTyVarsRn syn_doc tyvars 		$ \ tyvars' ->
+    rnHsTypeFVs syn_doc ty			`thenM` \ (ty', fvs) ->
+    returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars', 
+			tcdSynRhs = ty'},
+	     delFVs (map hsLTyVarName tyvars') fvs)
+  where
+    syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
+
+rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname, 
+		       tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs, 
+		       tcdMeths = mbinds})
+  = lookupLocatedTopBndrRn cname		`thenM` \ cname' ->
+
+	-- Tyvars scope over superclass context and method signatures
+    bindTyVarsRn cls_doc tyvars			( \ tyvars' ->
+	rnContext cls_doc context	`thenM` \ context' ->
+	rnFds cls_doc fds		`thenM` \ fds' ->
+	renameSigs okClsDclSig sigs	`thenM` \ sigs' ->
+	returnM   (tyvars', context', fds', sigs')
+    )	`thenM` \ (tyvars', context', fds', sigs') ->
+
+	-- Check the signatures
+	-- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
+    let
+	sig_rdr_names_w_locs   = [op | L _ (TypeSig op _) <- sigs]
+    in
+    checkDupNames sig_doc sig_rdr_names_w_locs	`thenM_` 
+	-- Typechecker is responsible for checking that we only
+	-- give default-method bindings for things in this class.
+	-- The renamer *could* check this for class decls, but can't
+	-- for instance decls.
+
+   	-- The newLocals call is tiresome: given a generic class decl
+	--	class C a where
+	--	  op :: a -> a
+	--	  op {| x+y |} (Inl a) = ...
+	--	  op {| x+y |} (Inr b) = ...
+	--	  op {| a*b |} (a*b)   = ...
+	-- we want to name both "x" tyvars with the same unique, so that they are
+	-- easy to group together in the typechecker.  
+    extendTyVarEnvForMethodBinds tyvars' (
+   	 getLocalRdrEnv					`thenM` \ name_env ->
+   	 let
+ 	     meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
+ 	     gen_rdr_tyvars_w_locs = 
+		[ tv | tv <- extractGenericPatTyVars mbinds,
+ 		      not (unLoc tv `elemLocalRdrEnv` name_env) ]
+   	 in
+   	 checkDupNames meth_doc meth_rdr_names_w_locs	`thenM_`
+   	 newLocalsRn gen_rdr_tyvars_w_locs	`thenM` \ gen_tyvars ->
+   	 rnMethodBinds (unLoc cname') gen_tyvars mbinds
+    ) `thenM` \ (mbinds', meth_fvs) ->
+
+    returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
+			 tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
+	     delFVs (map hsLTyVarName tyvars')	$
+	     extractHsCtxtTyNames context'	    `plusFV`
+	     plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
+	     hsSigsFVs sigs'		  	    `plusFV`
+	     meth_fvs)
+  where
+    meth_doc = text "In the default-methods for class"	<+> ppr cname
+    cls_doc  = text "In the declaration for class" 	<+> ppr cname
+    sig_doc  = text "In the signatures for class"  	<+> ppr cname
+
+badGadtStupidTheta tycon
+  = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
+	  ptext SLIT("(You can put a context on each contructor, though.)")]
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Support code for type/data declarations}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
+rnConDecls tycon condecls
+  = mappM (wrapLocM rnConDecl) condecls
+
+rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
+rnConDecl (ConDecl name expl tvs cxt details res_ty)
+  = do	{ addLocM checkConName name
+
+	; new_name <- lookupLocatedTopBndrRn name
+	; name_env <- getLocalRdrEnv
+	
+	-- For H98 syntax, the tvs are the existential ones
+	-- For GADT syntax, the tvs are all the quantified tyvars
+	-- Hence the 'filter' in the ResTyH98 case only
+	; let not_in_scope  = not . (`elemLocalRdrEnv` name_env) . unLoc
+	      arg_tys       = hsConArgs details
+	      implicit_tvs  = case res_ty of
+	      	    		ResTyH98 -> filter not_in_scope $
+						get_rdr_tvs arg_tys
+	      	    		ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
+	      tvs' = case expl of
+	        	Explicit -> tvs
+		    	Implicit -> userHsTyVarBndrs implicit_tvs
+
+	; bindTyVarsRn doc tvs' $ \new_tyvars -> do
+	{ new_context <- rnContext doc cxt
+        ; new_details <- rnConDetails doc details
+        ; new_res_ty  <- rnConResult doc res_ty
+        ; let rv = ConDecl new_name expl new_tyvars new_context new_details new_res_ty
+        ; traceRn (text "****** - autrijus" <> ppr rv)
+        ; return rv } }
+  where
+    doc = text "In the definition of data constructor" <+> quotes (ppr name)
+    get_rdr_tvs tys  = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
+
+rnConResult _ ResTyH98 = return ResTyH98
+rnConResult doc (ResTyGADT ty) = do
+    ty' <- rnHsSigType doc ty
+    return $ ResTyGADT ty'
+
+rnConDetails doc (PrefixCon tys)
+  = mappM (rnLHsType doc) tys	`thenM` \ new_tys  ->
+    returnM (PrefixCon new_tys)
+
+rnConDetails doc (InfixCon ty1 ty2)
+  = rnLHsType doc ty1  		`thenM` \ new_ty1 ->
+    rnLHsType doc ty2  		`thenM` \ new_ty2 ->
+    returnM (InfixCon new_ty1 new_ty2)
+
+rnConDetails doc (RecCon fields)
+  = checkDupNames doc field_names	`thenM_`
+    mappM (rnField doc) fields		`thenM` \ new_fields ->
+    returnM (RecCon new_fields)
+  where
+    field_names = [fld | (fld, _) <- fields]
+
+rnField doc (name, ty)
+  = lookupLocatedTopBndrRn name	`thenM` \ new_name ->
+    rnLHsType doc ty		`thenM` \ new_ty ->
+    returnM (new_name, new_ty) 
+
+-- This data decl will parse OK
+--	data T = a Int
+-- treating "a" as the constructor.
+-- It is really hard to make the parser spot this malformation.
+-- So the renamer has to check that the constructor is legal
+--
+-- We can get an operator as the constructor, even in the prefix form:
+--	data T = :% Int Int
+-- from interface files, which always print in prefix form
+
+checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
+
+badDataCon name
+   = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
+\end{code}
+
+
+%*********************************************************
+%*							*
+\subsection{Support code to rename types}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
+
+rnFds doc fds
+  = mappM (wrapLocM rn_fds) fds
+  where
+    rn_fds (tys1, tys2)
+      =	rnHsTyVars doc tys1		`thenM` \ tys1' ->
+	rnHsTyVars doc tys2		`thenM` \ tys2' ->
+	returnM (tys1', tys2')
+
+rnHsTyVars doc tvs  = mappM (rnHsTyvar doc) tvs
+rnHsTyvar doc tyvar = lookupOccRn tyvar
+\end{code}
+
+
+%*********************************************************
+%*							*
+		Splices
+%*							*
+%*********************************************************
+
+Note [Splices]
+~~~~~~~~~~~~~~
+Consider
+	f = ...
+	h = ...$(thing "f")...
+
+The splice can expand into literally anything, so when we do dependency
+analysis we must assume that it might mention 'f'.  So we simply treat
+all locally-defined names as mentioned by any splice.  This is terribly
+brutal, but I don't see what else to do.  For example, it'll mean
+that every locally-defined thing will appear to be used, so no unused-binding
+warnings.  But if we miss the dependency, then we might typecheck 'h' before 'f',
+and that will crash the type checker because 'f' isn't in scope.
+
+Currently, I'm not treating a splice as also mentioning every import,
+which is a bit inconsistent -- but there are a lot of them.  We might
+thereby get some bogus unused-import warnings, but we won't crash the
+type checker.  Not very satisfactory really.
+
+\begin{code}
+rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
+rnSplice (HsSplice n expr)
+  = do	{ checkTH expr "splice"
+	; loc  <- getSrcSpanM
+	; [n'] <- newLocalsRn [L loc n]
+	; (expr', fvs) <- rnLExpr expr
+
+	-- Ugh!  See Note [Splices] above
+	; lcl_rdr <- getLocalRdrEnv
+	; gbl_rdr <- getGlobalRdrEnv
+	; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr, 
+						    isLocalGRE gre]
+	      lcl_names = mkNameSet (occEnvElts lcl_rdr)
+
+	; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
+
+#ifdef GHCI 
+checkTH e what = returnM ()	-- OK
+#else
+checkTH e what 	-- Raise an error in a stage-1 compiler
+  = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>  
+	          ptext SLIT("illegal in a stage-1 compiler"),
+	          nest 2 (ppr e)])
+#endif   
+\end{code}
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
new file mode 100644
index 0000000000..d7d435ce97
--- /dev/null
+++ b/compiler/rename/RnTypes.lhs
@@ -0,0 +1,766 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[RnSource]{Main pass of renamer}
+
+\begin{code}
+module RnTypes ( 
+	-- Type related stuff
+	rnHsType, rnLHsType, rnLHsTypes, rnContext,
+	rnHsSigType, rnHsTypeFVs,
+
+	-- Patterns and literals
+	rnLPat, rnPat, rnPatsAndThen,	-- Here because it's not part 
+	rnLit, rnOverLit, 		-- of any mutual recursion	
+
+	-- Precence related stuff
+	mkOpAppRn, mkNegAppRn, mkOpFormRn, 
+	checkPrecMatch, checkSectionPrec, 
+	
+	-- Error messages
+	dupFieldErr, patSigErr, checkTupSize
+  ) where
+
+import DynFlags		( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts) )
+
+import HsSyn
+import RdrHsSyn		( extractHsRhoRdrTyVars )
+import RnHsSyn		( extractHsTyNames, parrTyCon_name, tupleTyCon_name, 
+			  listTyCon_name
+			)
+import RnEnv		( lookupOccRn, lookupBndrRn, lookupSyntaxName,
+			  lookupLocatedOccRn, lookupLocatedBndrRn,
+			  lookupLocatedGlobalOccRn, bindTyVarsRn, 
+			  lookupFixityRn, lookupTyFixityRn,
+			  mapFvRn, warnUnusedMatches,
+			  newIPNameRn, bindPatSigTyVarsFV, bindLocatedLocalsFV )
+import TcRnMonad
+import RdrName		( RdrName, elemLocalRdrEnv )
+import PrelNames	( eqClassName, integralClassName, geName, eqName,
+		  	  negateName, minusName, lengthPName, indexPName,
+			  plusIntegerName, fromIntegerName, timesIntegerName,
+			  ratioDataConName, fromRationalName )
+import TypeRep		( funTyCon )
+import Constants	( mAX_TUPLE_SIZE )
+import Name		( Name )
+import SrcLoc		( SrcSpan, Located(..), unLoc, noLoc, combineLocs )
+import NameSet
+
+import Literal		( inIntRange, inCharRange )
+import BasicTypes	( compareFixity, funTyFixity, negateFixity, 
+			  Fixity(..), FixityDirection(..) )
+import ListSetOps	( removeDups )
+import Outputable
+
+#include "HsVersions.h"
+\end{code}
+
+These type renamers are in a separate module, rather than in (say) RnSource,
+to break several loop.
+
+%*********************************************************
+%*							*
+\subsection{Renaming types}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnHsTypeFVs :: SDoc -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
+rnHsTypeFVs doc_str ty 
+  = rnLHsType doc_str ty	`thenM` \ ty' ->
+    returnM (ty', extractHsTyNames ty')
+
+rnHsSigType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
+	-- rnHsSigType is used for source-language type signatures,
+	-- which use *implicit* universal quantification.
+rnHsSigType doc_str ty
+  = rnLHsType (text "In the type signature for" <+> doc_str) ty
+\end{code}
+
+rnHsType is here because we call it from loadInstDecl, and I didn't
+want a gratuitous knot.
+
+\begin{code}
+rnLHsType  :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
+rnLHsType doc = wrapLocM (rnHsType doc)
+
+rnHsType :: SDoc -> HsType RdrName -> RnM (HsType Name)
+
+rnHsType doc (HsForAllTy Implicit _ ctxt ty)
+	-- Implicit quantifiction in source code (no kinds on tyvars)
+	-- Given the signature  C => T  we universally quantify 
+	-- over FV(T) \ {in-scope-tyvars} 
+  = getLocalRdrEnv		`thenM` \ name_env ->
+    let
+	mentioned = extractHsRhoRdrTyVars ctxt ty
+
+	-- Don't quantify over type variables that are in scope;
+	-- when GlasgowExts is off, there usually won't be any, except for
+	-- class signatures:
+	--	class C a where { op :: a -> a }
+	forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned
+	tyvar_bndrs   = userHsTyVarBndrs forall_tyvars
+    in
+    rnForAll doc Implicit tyvar_bndrs ctxt ty
+
+rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau)
+	-- Explicit quantification.
+	-- Check that the forall'd tyvars are actually 
+	-- mentioned in the type, and produce a warning if not
+  = let
+	mentioned	   = map unLoc (extractHsRhoRdrTyVars ctxt tau)
+	forall_tyvar_names = hsLTyVarLocNames forall_tyvars
+
+	-- Explicitly quantified but not mentioned in ctxt or tau
+	warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
+    in
+    mappM_ (forAllWarn doc tau) warn_guys	`thenM_`
+    rnForAll doc Explicit forall_tyvars ctxt tau
+
+rnHsType doc (HsTyVar tyvar)
+  = lookupOccRn tyvar 		`thenM` \ tyvar' ->
+    returnM (HsTyVar tyvar')
+
+rnHsType doc (HsOpTy ty1 (L loc op) ty2)
+  = setSrcSpan loc (
+      lookupOccRn op			`thenM` \ op' ->
+      let
+	l_op' = L loc op'
+      in
+      lookupTyFixityRn l_op'		`thenM` \ fix ->
+      rnLHsType doc ty1			`thenM` \ ty1' ->
+      rnLHsType doc ty2			`thenM` \ ty2' -> 
+      mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) (ppr op') fix ty1' ty2'
+   )
+
+rnHsType doc (HsParTy ty)
+  = rnLHsType doc ty 	        `thenM` \ ty' ->
+    returnM (HsParTy ty')
+
+rnHsType doc (HsBangTy b ty)
+  = rnLHsType doc ty 	        `thenM` \ ty' ->
+    returnM (HsBangTy b ty')
+
+rnHsType doc (HsNumTy i)
+  | i == 1    = returnM (HsNumTy i)
+  | otherwise = addErr err_msg	`thenM_`  returnM (HsNumTy i)
+  where
+    err_msg = ptext SLIT("Only unit numeric type pattern is valid")
+			   
+
+rnHsType doc (HsFunTy ty1 ty2)
+  = rnLHsType doc ty1	`thenM` \ ty1' ->
+	-- Might find a for-all as the arg of a function type
+    rnLHsType doc ty2	`thenM` \ ty2' ->
+	-- Or as the result.  This happens when reading Prelude.hi
+	-- when we find return :: forall m. Monad m -> forall a. a -> m a
+
+	-- Check for fixity rearrangements
+    mkHsOpTyRn HsFunTy (ppr funTyCon) funTyFixity ty1' ty2'
+
+rnHsType doc (HsListTy ty)
+  = rnLHsType doc ty				`thenM` \ ty' ->
+    returnM (HsListTy ty')
+
+rnHsType doc (HsKindSig ty k)
+  = rnLHsType doc ty				`thenM` \ ty' ->
+    returnM (HsKindSig ty' k)
+
+rnHsType doc (HsPArrTy ty)
+  = rnLHsType doc ty				`thenM` \ ty' ->
+    returnM (HsPArrTy ty')
+
+-- Unboxed tuples are allowed to have poly-typed arguments.  These
+-- sometimes crop up as a result of CPR worker-wrappering dictionaries.
+rnHsType doc (HsTupleTy tup_con tys)
+  = mappM (rnLHsType doc) tys	  	`thenM` \ tys' ->
+    returnM (HsTupleTy tup_con tys')
+
+rnHsType doc (HsAppTy ty1 ty2)
+  = rnLHsType doc ty1		`thenM` \ ty1' ->
+    rnLHsType doc ty2		`thenM` \ ty2' ->
+    returnM (HsAppTy ty1' ty2')
+
+rnHsType doc (HsPredTy pred)
+  = rnPred doc pred	`thenM` \ pred' ->
+    returnM (HsPredTy pred')
+
+rnHsType doc (HsSpliceTy _)
+  = do	{ addErr (ptext SLIT("Type splices are not yet implemented"))
+ 	; failM }
+
+rnLHsTypes doc tys = mappM (rnLHsType doc) tys
+\end{code}
+
+
+\begin{code}
+rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
+	 -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
+
+rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty
+	-- One reason for this case is that a type like Int#
+	-- starts off as (HsForAllTy Nothing [] Int), in case
+	-- there is some quantification.  Now that we have quantified
+	-- and discovered there are no type variables, it's nicer to turn
+	-- it into plain Int.  If it were Int# instead of Int, we'd actually
+	-- get an error, because the body of a genuine for-all is
+	-- of kind *.
+
+rnForAll doc exp forall_tyvars ctxt ty
+  = bindTyVarsRn doc forall_tyvars	$ \ new_tyvars ->
+    rnContext doc ctxt			`thenM` \ new_ctxt ->
+    rnLHsType doc ty			`thenM` \ new_ty ->
+    returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
+	-- Retain the same implicit/explicit flag as before
+	-- so that we can later print it correctly
+\end{code}
+
+
+%************************************************************************
+%*									*
+	Fixities and precedence parsing
+%*									*
+%************************************************************************
+
+@mkOpAppRn@ deals with operator fixities.  The argument expressions
+are assumed to be already correctly arranged.  It needs the fixities
+recorded in the OpApp nodes, because fixity info applies to the things
+the programmer actually wrote, so you can't find it out from the Name.
+
+Furthermore, the second argument is guaranteed not to be another
+operator application.  Why? Because the parser parses all
+operator appications left-associatively, EXCEPT negation, which
+we need to handle specially.
+Infix types are read in a *right-associative* way, so that
+	a `op` b `op` c
+is always read in as
+	a `op` (b `op` c)
+
+mkHsOpTyRn rearranges where necessary.  The two arguments
+have already been renamed and rearranged.  It's made rather tiresome
+by the presence of ->, which is a separate syntactic construct.
+
+\begin{code}
+---------------
+-- Building (ty1 `op1` (ty21 `op2` ty22))
+mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
+	   -> SDoc -> Fixity -> LHsType Name -> LHsType Name 
+	   -> RnM (HsType Name)
+
+mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
+  = do  { fix2 <- lookupTyFixityRn op2
+	; mk_hs_op_ty mk1 pp_op1 fix1 ty1 
+		      (\t1 t2 -> HsOpTy t1 op2 t2)
+		      (ppr op2) fix2 ty21 ty22 loc2 }
+
+mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2@(L loc2 (HsFunTy ty21 ty22))
+  = mk_hs_op_ty mk1 pp_op1 fix1 ty1 
+		HsFunTy (ppr funTyCon) funTyFixity ty21 ty22 loc2
+
+mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2 		-- Default case, no rearrangment
+  = return (mk1 ty1 ty2)
+
+---------------
+mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
+	    -> SDoc -> Fixity -> LHsType Name
+	    -> (LHsType Name -> LHsType Name -> HsType Name)
+	    -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
+	    -> RnM (HsType Name)
+mk_hs_op_ty mk1 pp_op1 fix1 ty1 
+	    mk2 pp_op2 fix2 ty21 ty22 loc2
+  | nofix_error     = do { addErr (precParseErr (quotes pp_op1,fix1) 
+			 		        (quotes pp_op2,fix2))
+		         ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
+  | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
+  | otherwise	    = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
+			   new_ty <- mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty21
+			 ; return (mk2 (noLoc new_ty) ty22) }
+  where
+    (nofix_error, associate_right) = compareFixity fix1 fix2
+
+
+---------------------------
+mkOpAppRn :: LHsExpr Name			-- Left operand; already rearranged
+	  -> LHsExpr Name -> Fixity 		-- Operator and fixity
+	  -> LHsExpr Name			-- Right operand (not an OpApp, but might
+						-- be a NegApp)
+	  -> RnM (HsExpr Name)
+
+-- (e11 `op1` e12) `op2` e2
+mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
+  | nofix_error
+  = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))	`thenM_`
+    returnM (OpApp e1 op2 fix2 e2)
+
+  | associate_right
+  = mkOpAppRn e12 op2 fix2 e2		`thenM` \ new_e ->
+    returnM (OpApp e11 op1 fix1 (L loc' new_e))
+  where
+    loc'= combineLocs e12 e2
+    (nofix_error, associate_right) = compareFixity fix1 fix2
+
+---------------------------
+--	(- neg_arg) `op` e2
+mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
+  | nofix_error
+  = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2))	`thenM_`
+    returnM (OpApp e1 op2 fix2 e2)
+
+  | associate_right
+  = mkOpAppRn neg_arg op2 fix2 e2	`thenM` \ new_e ->
+    returnM (NegApp (L loc' new_e) neg_name)
+  where
+    loc' = combineLocs neg_arg e2
+    (nofix_error, associate_right) = compareFixity negateFixity fix2
+
+---------------------------
+--	e1 `op` - neg_arg
+mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp neg_arg _))	-- NegApp can occur on the right
+  | not associate_right				-- We *want* right association
+  = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity))	`thenM_`
+    returnM (OpApp e1 op1 fix1 e2)
+  where
+    (_, associate_right) = compareFixity fix1 negateFixity
+
+---------------------------
+--	Default case
+mkOpAppRn e1 op fix e2 			-- Default case, no rearrangment
+  = ASSERT2( right_op_ok fix (unLoc e2),
+	     ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
+    )
+    returnM (OpApp e1 op fix e2)
+
+-- Parser left-associates everything, but 
+-- derived instances may have correctly-associated things to
+-- in the right operarand.  So we just check that the right operand is OK
+right_op_ok fix1 (OpApp _ _ fix2 _)
+  = not error_please && associate_right
+  where
+    (error_please, associate_right) = compareFixity fix1 fix2
+right_op_ok fix1 other
+  = True
+
+-- Parser initially makes negation bind more tightly than any other operator
+-- And "deriving" code should respect this (use HsPar if not)
+mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
+mkNegAppRn neg_arg neg_name
+  = ASSERT( not_op_app (unLoc neg_arg) )
+    returnM (NegApp neg_arg neg_name)
+
+not_op_app (OpApp _ _ _ _) = False
+not_op_app other	   = True
+
+---------------------------
+mkOpFormRn :: LHsCmdTop Name		-- Left operand; already rearranged
+	  -> LHsExpr Name -> Fixity 	-- Operator and fixity
+	  -> LHsCmdTop Name		-- Right operand (not an infix)
+	  -> RnM (HsCmd Name)
+
+-- (e11 `op1` e12) `op2` e2
+mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
+	op2 fix2 a2
+  | nofix_error
+  = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))	`thenM_`
+    returnM (HsArrForm op2 (Just fix2) [a1, a2])
+
+  | associate_right
+  = mkOpFormRn a12 op2 fix2 a2		`thenM` \ new_c ->
+    returnM (HsArrForm op1 (Just fix1)
+	[a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
+	-- TODO: locs are wrong
+  where
+    (nofix_error, associate_right) = compareFixity fix1 fix2
+
+--	Default case
+mkOpFormRn arg1 op fix arg2 			-- Default case, no rearrangment
+  = returnM (HsArrForm op (Just fix) [arg1, arg2])
+
+
+--------------------------------------
+mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
+	     -> RnM (Pat Name)
+
+mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
+  = lookupFixityRn (unLoc op1)	`thenM` \ fix1 ->
+    let
+	(nofix_error, associate_right) = compareFixity fix1 fix2
+    in
+    if nofix_error then
+	addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))	`thenM_`
+	returnM (ConPatIn op2 (InfixCon p1 p2))
+    else 
+    if associate_right then
+	mkConOpPatRn op2 fix2 p12 p2		`thenM` \ new_p ->
+	returnM (ConPatIn op1 (InfixCon p11 (L loc new_p)))  -- XXX loc right?
+    else
+    returnM (ConPatIn op2 (InfixCon p1 p2))
+
+mkConOpPatRn op fix p1 p2 			-- Default case, no rearrangment
+  = ASSERT( not_op_pat (unLoc p2) )
+    returnM (ConPatIn op (InfixCon p1 p2))
+
+not_op_pat (ConPatIn _ (InfixCon _ _)) = False
+not_op_pat other   	               = True
+
+--------------------------------------
+checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
+	-- True indicates an infix lhs
+	-- See comments with rnExpr (OpApp ...) about "deriving"
+
+checkPrecMatch False fn match 
+  = returnM ()
+checkPrecMatch True op (MatchGroup ms _)	
+  = mapM_ check ms			 	
+  where
+    check (L _ (Match (p1:p2:_) _ _))
+      = checkPrec op (unLoc p1) False	`thenM_`
+        checkPrec op (unLoc p2) True
+
+    check _ = panic "checkPrecMatch"
+
+checkPrec op (ConPatIn op1 (InfixCon _ _)) right
+  = lookupFixityRn op		`thenM` \  op_fix@(Fixity op_prec  op_dir) ->
+    lookupFixityRn (unLoc op1)	`thenM` \ op1_fix@(Fixity op1_prec op1_dir) ->
+    let
+	inf_ok = op1_prec > op_prec || 
+	         (op1_prec == op_prec &&
+		  (op1_dir == InfixR && op_dir == InfixR && right ||
+		   op1_dir == InfixL && op_dir == InfixL && not right))
+
+	info  = (ppr_op op,  op_fix)
+	info1 = (ppr_op op1, op1_fix)
+	(infol, infor) = if right then (info, info1) else (info1, info)
+    in
+    checkErr inf_ok (precParseErr infol infor)
+
+checkPrec op pat right
+  = returnM ()
+
+-- Check precedence of (arg op) or (op arg) respectively
+-- If arg is itself an operator application, then either
+--   (a) its precedence must be higher than that of op
+--   (b) its precedency & associativity must be the same as that of op
+checkSectionPrec :: FixityDirection -> HsExpr RdrName
+	-> LHsExpr Name -> LHsExpr Name -> RnM ()
+checkSectionPrec direction section op arg
+  = case unLoc arg of
+	OpApp _ op fix _ -> go_for_it (ppr_op op)     fix
+	NegApp _ _	 -> go_for_it pp_prefix_minus negateFixity
+	other		 -> returnM ()
+  where
+    L _ (HsVar op_name) = op
+    go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
+	= lookupFixityRn op_name	`thenM` \ op_fix@(Fixity op_prec _) ->
+	  checkErr (op_prec < arg_prec
+		     || op_prec == arg_prec && direction == assoc)
+		  (sectionPrecErr (ppr_op op_name, op_fix) 	
+		  (pp_arg_op, arg_fix) section)
+\end{code}
+
+Precedence-related error messages
+
+\begin{code}
+precParseErr op1 op2 
+  = hang (ptext SLIT("precedence parsing error"))
+      4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"), 
+	       ppr_opfix op2,
+	       ptext SLIT("in the same infix expression")])
+
+sectionPrecErr op arg_op section
+ = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
+	 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
+	 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
+
+pp_prefix_minus = ptext SLIT("prefix `-'")
+ppr_op op = quotes (ppr op)	-- Here, op can be a Name or a (Var n), where n is a Name
+ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Contexts and predicates}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
+rnContext doc = wrapLocM (rnContext' doc)
+
+rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
+rnContext' doc ctxt = mappM (rnLPred doc) ctxt
+
+rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
+rnLPred doc  = wrapLocM (rnPred doc)
+
+rnPred doc (HsClassP clas tys)
+  = lookupOccRn clas		`thenM` \ clas_name ->
+    rnLHsTypes doc tys		`thenM` \ tys' ->
+    returnM (HsClassP clas_name tys')
+
+rnPred doc (HsIParam n ty)
+  = newIPNameRn n		`thenM` \ name ->
+    rnLHsType doc ty		`thenM` \ ty' ->
+    returnM (HsIParam name ty')
+\end{code}
+
+
+*********************************************************
+*							*
+\subsection{Patterns}
+*							*
+*********************************************************
+
+\begin{code}
+rnPatsAndThen :: HsMatchContext Name
+	      -> [LPat RdrName] 
+	      -> ([LPat Name] -> RnM (a, FreeVars))
+	      -> RnM (a, FreeVars)
+-- Bring into scope all the binders and type variables
+-- bound by the patterns; then rename the patterns; then
+-- do the thing inside.
+--
+-- Note that we do a single bindLocalsRn for all the
+-- matches together, so that we spot the repeated variable in
+--	f x x = 1
+
+rnPatsAndThen ctxt pats thing_inside
+  = bindPatSigTyVarsFV pat_sig_tys 	$
+    bindLocatedLocalsFV doc_pat bndrs	$ \ new_bndrs ->
+    rnLPats pats			`thenM` \ (pats', pat_fvs) ->
+    thing_inside pats'			`thenM` \ (res, res_fvs) ->
+
+    let
+	unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
+    in
+    warnUnusedMatches unused_binders   `thenM_`
+    returnM (res, res_fvs `plusFV` pat_fvs)
+  where
+    pat_sig_tys = collectSigTysFromPats pats
+    bndrs 	= collectLocatedPatsBinders pats
+    doc_pat     = ptext SLIT("In") <+> pprMatchContext ctxt
+
+rnLPats :: [LPat RdrName] -> RnM ([LPat Name], FreeVars)
+rnLPats ps = mapFvRn rnLPat ps
+
+rnLPat :: LPat RdrName -> RnM (LPat Name, FreeVars)
+rnLPat = wrapLocFstM rnPat
+
+-- -----------------------------------------------------------------------------
+-- rnPat
+
+rnPat :: Pat RdrName -> RnM (Pat Name, FreeVars)
+
+rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
+
+rnPat (VarPat name)
+  = lookupBndrRn  name			`thenM` \ vname ->
+    returnM (VarPat vname, emptyFVs)
+
+rnPat (SigPatIn pat ty)
+  = doptM Opt_GlasgowExts `thenM` \ glaExts ->
+    
+    if glaExts
+    then rnLPat pat		`thenM` \ (pat', fvs1) ->
+         rnHsTypeFVs doc ty	`thenM` \ (ty',  fvs2) ->
+         returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
+
+    else addErr (patSigErr ty)	`thenM_`
+         rnPat (unLoc pat) -- XXX shouldn't throw away the loc
+  where
+    doc = text "In a pattern type-signature"
+    
+rnPat (LitPat lit) 
+  = rnLit lit 	`thenM_` 
+    returnM (LitPat lit, emptyFVs) 
+
+rnPat (NPat lit mb_neg eq _) 
+  = rnOverLit lit			`thenM` \ (lit', fvs1) ->
+    (case mb_neg of
+	Nothing -> returnM (Nothing, emptyFVs)
+	Just _  -> lookupSyntaxName negateName	`thenM` \ (neg, fvs) ->
+		   returnM (Just neg, fvs)
+    )					`thenM` \ (mb_neg', fvs2) ->
+    lookupSyntaxName eqName		`thenM` \ (eq', fvs3) -> 
+    returnM (NPat lit' mb_neg' eq' placeHolderType, 
+	      fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` eqClassName)	
+	-- Needed to find equality on pattern
+
+rnPat (NPlusKPat name lit _ _)
+  = rnOverLit lit			`thenM` \ (lit', fvs1) ->
+    lookupLocatedBndrRn name		`thenM` \ name' ->
+    lookupSyntaxName minusName		`thenM` \ (minus, fvs2) ->
+    lookupSyntaxName geName		`thenM` \ (ge, fvs3) ->
+    returnM (NPlusKPat name' lit' ge minus,
+	     fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` integralClassName)
+	-- The Report says that n+k patterns must be in Integral
+
+rnPat (LazyPat pat)
+  = rnLPat pat		`thenM` \ (pat', fvs) ->
+    returnM (LazyPat pat', fvs)
+
+rnPat (BangPat pat)
+  = rnLPat pat		`thenM` \ (pat', fvs) ->
+    returnM (BangPat pat', fvs)
+
+rnPat (AsPat name pat)
+  = rnLPat pat			`thenM` \ (pat', fvs) ->
+    lookupLocatedBndrRn name	`thenM` \ vname ->
+    returnM (AsPat vname pat', fvs)
+
+rnPat (ConPatIn con stuff) = rnConPat con stuff
+
+
+rnPat (ParPat pat)
+  = rnLPat pat		`thenM` \ (pat', fvs) ->
+    returnM (ParPat pat', fvs)
+
+rnPat (ListPat pats _)
+  = rnLPats pats			`thenM` \ (patslist, fvs) ->
+    returnM (ListPat patslist placeHolderType, fvs `addOneFV` listTyCon_name)
+
+rnPat (PArrPat pats _)
+  = rnLPats pats			`thenM` \ (patslist, fvs) ->
+    returnM (PArrPat patslist placeHolderType, 
+	      fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
+  where
+    implicit_fvs = mkFVs [lengthPName, indexPName]
+
+rnPat (TuplePat pats boxed _)
+  = checkTupSize tup_size	`thenM_`
+    rnLPats pats			`thenM` \ (patslist, fvs) ->
+    returnM (TuplePat patslist boxed placeHolderType, 
+	     fvs `addOneFV` tycon_name)
+  where
+    tup_size   = length pats
+    tycon_name = tupleTyCon_name boxed tup_size
+
+rnPat (TypePat name) =
+    rnHsTypeFVs (text "In a type pattern") name	`thenM` \ (name', fvs) ->
+    returnM (TypePat name', fvs)
+
+-- -----------------------------------------------------------------------------
+-- rnConPat
+
+rnConPat con (PrefixCon pats)
+  = lookupLocatedOccRn con 	`thenM` \ con' ->
+    rnLPats pats		`thenM` \ (pats', fvs) ->
+    returnM (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` unLoc con')
+
+rnConPat con (RecCon rpats)
+  = lookupLocatedOccRn con 	`thenM` \ con' ->
+    rnRpats rpats		`thenM` \ (rpats', fvs) ->
+    returnM (ConPatIn con' (RecCon rpats'), fvs `addOneFV` unLoc con')
+
+rnConPat con (InfixCon pat1 pat2)
+  = lookupLocatedOccRn con			`thenM` \ con' ->
+    rnLPat pat1					`thenM` \ (pat1', fvs1) ->
+    rnLPat pat2					`thenM` \ (pat2', fvs2) ->
+    lookupFixityRn (unLoc con')			`thenM` \ fixity ->
+    mkConOpPatRn con' fixity pat1' pat2'	`thenM` \ pat' ->
+    returnM (pat', fvs1 `plusFV` fvs2 `addOneFV` unLoc con')
+
+-- -----------------------------------------------------------------------------
+-- rnRpats
+
+rnRpats :: [(Located RdrName, LPat RdrName)]
+        -> RnM ([(Located Name, LPat Name)], FreeVars)
+rnRpats rpats
+  = mappM_ field_dup_err dup_fields 	`thenM_`
+    mapFvRn rn_rpat rpats		`thenM` \ (rpats', fvs) ->
+    returnM (rpats', fvs)
+  where
+    (_, dup_fields) = removeDups compare [ unLoc f | (f,_) <- rpats ]
+
+    field_dup_err dups = addErr (dupFieldErr "pattern" dups)
+
+    rn_rpat (field, pat)
+      = lookupLocatedGlobalOccRn field	`thenM` \ fieldname ->
+	rnLPat pat			`thenM` \ (pat', fvs) ->
+	returnM ((fieldname, pat'), fvs `addOneFV` unLoc fieldname)
+
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsubsection{Literals}
+%*									*
+%************************************************************************
+
+When literals occur we have to make sure
+that the types and classes they involve
+are made available.
+
+\begin{code}
+rnLit :: HsLit -> RnM ()
+rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
+rnLit other	 = returnM ()
+
+rnOverLit (HsIntegral i _)
+  = lookupSyntaxName fromIntegerName	`thenM` \ (from_integer_name, fvs) ->
+    if inIntRange i then
+	returnM (HsIntegral i from_integer_name, fvs)
+    else let
+	extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
+	-- Big integer literals are built, using + and *, 
+	-- out of small integers (DsUtils.mkIntegerLit)
+	-- [NB: plusInteger, timesInteger aren't rebindable... 
+	--	they are used to construct the argument to fromInteger, 
+	--	which is the rebindable one.]
+    in
+    returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
+
+rnOverLit (HsFractional i _)
+  = lookupSyntaxName fromRationalName		`thenM` \ (from_rat_name, fvs) ->
+    let
+	extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
+	-- We have to make sure that the Ratio type is imported with
+	-- its constructor, because literals of type Ratio t are
+	-- built with that constructor.
+	-- The Rational type is needed too, but that will come in
+	-- as part of the type for fromRational.
+	-- The plus/times integer operations may be needed to construct the numerator
+	-- and denominator (see DsUtils.mkIntegerLit)
+    in
+    returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
+\end{code}
+
+
+
+%*********************************************************
+%*							*
+\subsection{Errors}
+%*							*
+%*********************************************************
+
+\begin{code}
+checkTupSize :: Int -> RnM ()
+checkTupSize tup_size
+  | tup_size <= mAX_TUPLE_SIZE 
+  = returnM ()
+  | otherwise		       
+  = addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
+		 nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
+		 nest 2 (ptext SLIT("Workaround: use nested tuples or define a data type"))])
+
+forAllWarn doc ty (L loc tyvar)
+  = ifOptM Opt_WarnUnusedMatches 	$
+    setSrcSpan loc $
+    addWarn (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
+		   nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
+		   $$
+		   doc
+                )
+
+bogusCharError c
+  = ptext SLIT("character literal out of range: '\\") <> char c  <> char '\''
+
+patSigErr ty
+  =  (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
+	$$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
+
+dupFieldErr str dup
+  = hsep [ptext SLIT("duplicate field name"), 
+          quotes (ppr dup),
+	  ptext SLIT("in record"), text str]
+\end{code}
diff --git a/compiler/rename/rename.tex b/compiler/rename/rename.tex
new file mode 100644
index 0000000000..b3f8e1d770
--- /dev/null
+++ b/compiler/rename/rename.tex
@@ -0,0 +1,18 @@
+\documentstyle{report}
+\input{lit-style}
+
+\begin{document}
+\centerline{{\Large{rename}}}
+\tableofcontents
+
+\input{Rename}    % {Renaming and dependency analysis passes}
+\input{RnSource}  % {Main pass of renamer}
+\input{RnMonad}   % {The monad used by the renamer}
+\input{RnEnv}     % {Environment manipulation for the renamer monad}
+\input{RnHsSyn}   % {Specialisations of the @HsSyn@ syntax for the renamer}
+\input{RnNames}   % {Extracting imported and top-level names in scope}
+\input{RnExpr}    % {Renaming of expressions}
+\input{RnBinds}   % {Renaming and dependency analysis of bindings}
+\input{RnIfaces}  % {Cacheing and Renaming of Interfaces}
+
+\end{document}