Improvements to record puns, wildcards

* Make C { A.a } work with punning, expanding to C { A.a = a }

* Make it so that, with -fwarn-unused-matches, 
        f (C {..}) = x
  does not complain about the bindings introduced by the "..".

* Make -XRecordWildCards implies -XDisambiguateRecordFields.

* Overall refactoring of RnPat, which had become very crufty. 
  In particular, there is now a monad, CpsRn, private to RnPat,
  which deals with the cps-style plumbing.  This is why so many
  lines of RnPat have changed.

* Refactor the treatment of renaming of record fields into two passes
	- rnHsRecFields1, used both for patterns and expressions,
	     which expands puns, wild-cards
  	- a local renamer in RnPat for fields in patterns
	- a local renamer in RnExpr for fields in construction and update
  This make it all MUCH easier to understand
 
* Improve documentation of record puns, wildcards, and disambiguation

11 files changed, 615 insertions, 596 deletions

diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index d476f4a933..ed6bd43edb 100644
--- a/compiler/basicTypes/RdrName.lhs
+++ b/compiler/basicTypes/RdrName.lhs
@@ -40,7 +40,7 @@ module RdrName (
 	showRdrName,
 
 	-- * Local mapping of 'RdrName' to 'Name.Name'
-	LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv,
+	LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
 	lookupLocalRdrEnv, lookupLocalRdrOcc, elemLocalRdrEnv,
 
 	-- * Global mapping of 'RdrName' to 'GlobalRdrElt's
@@ -48,7 +48,7 @@ module RdrName (
 	lookupGlobalRdrEnv, extendGlobalRdrEnv,
 	pprGlobalRdrEnv, globalRdrEnvElts,
 	lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
-        hideSomeUnquals, findLocalDupsRdrEnv,
+        hideSomeUnquals, findLocalDupsRdrEnv, pickGREs,
 
 	-- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
 	GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
@@ -316,8 +316,12 @@ type LocalRdrEnv = OccEnv Name
 emptyLocalRdrEnv :: LocalRdrEnv
 emptyLocalRdrEnv = emptyOccEnv
 
-extendLocalRdrEnv :: LocalRdrEnv -> [Name] -> LocalRdrEnv
-extendLocalRdrEnv env names
+extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
+extendLocalRdrEnv env name
+  = extendOccEnv env (nameOccName name) name
+
+extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
+extendLocalRdrEnvList env names
   = extendOccEnvList env [(nameOccName n, n) | n <- names]
 
 lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
@@ -474,7 +478,7 @@ pickGREs rdr_name gres
     pick :: GlobalRdrElt -> Maybe GlobalRdrElt
     pick gre@(GRE {gre_prov = LocalDef, gre_name = n}) 	-- Local def
 	| rdr_is_unqual		 	   = Just gre
-	| Just (mod,_) <- rdr_is_qual 	      	-- Qualified name
+	| Just (mod,_) <- rdr_is_qual 	     -- Qualified name
 	, Just n_mod <- nameModule_maybe n   -- Binder is External
 	, mod == moduleName n_mod  	   = Just gre
 	| otherwise 			   = Nothing
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index b0d43002e0..1969c3b629 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1856,6 +1856,12 @@ impliedFlags
     , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec)  -- Ditto for scoped type variables; see
                                                      --      Note [Scoped tyvars] in TcBinds
     , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
+
+	-- Record wild-cards implies field disambiguation
+	-- Otherwise if you write (C {..}) you may well get
+	-- stuff like " 'a' not in scope ", which is a bit silly
+ 	-- if the compiler has just filled in field 'a' of constructor 'C'
+    , (Opt_RecordWildCards,     Opt_DisambiguateRecordFields)
   ]
 
 glasgowExtsFlags :: [DynFlag]
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 5d54c2f02c..59dfe02d3e 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -53,8 +53,7 @@ import HsSyn		-- Lots of it
 import Class            ( FunDep )
 import TypeRep          ( Kind )
 import RdrName		( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc, 
-			  isRdrDataCon, isUnqual, getRdrName, isQual,
-			  setRdrNameSpace, showRdrName )
+			  isRdrDataCon, isUnqual, getRdrName, setRdrNameSpace )
 import BasicTypes	( maxPrecedence, Activation, RuleMatchInfo,
                           InlinePragma(..),  InlineSpec(..),
                           alwaysInlineSpec, neverInlineSpec )
@@ -728,11 +727,9 @@ checkPat loc _ _
 
 checkAPat :: DynFlags -> SrcSpan -> HsExpr RdrName -> P (Pat RdrName)
 checkAPat dynflags loc e = case e of
-   EWildPat	       -> return (WildPat placeHolderType)
-   HsVar x | isQual x  -> parseError loc ("Qualified variable in pattern: "
-					 ++ showRdrName x)
-   	   | otherwise -> return (VarPat x)
-   HsLit l 	       -> return (LitPat l)
+   EWildPat -> return (WildPat placeHolderType)
+   HsVar x  -> return (VarPat x)
+   HsLit l  -> return (LitPat l)
 
    -- Overloaded numeric patterns (e.g. f 0 x = x)
    -- Negation is recorded separately, so that the literal is zero or +ve
@@ -831,10 +828,6 @@ checkFunBind :: SrcSpan
              -> Located (GRHSs RdrName)
              -> P (HsBind RdrName)
 checkFunBind lhs_loc fun is_infix pats opt_sig (L rhs_span grhss)
-  | isQual (unLoc fun)
-  = parseErrorSDoc (getLoc fun) 
-	(ptext (sLit "Qualified name in function definition:") <+> ppr (unLoc fun))
-  | otherwise
   = do	ps <- checkPatterns pats
 	let match_span = combineSrcSpans lhs_loc rhs_span
 	return (makeFunBind fun is_infix [L match_span (Match ps opt_sig grhss)])
diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index d7865f45c0..2f80afced1 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -23,7 +23,7 @@ import RdrHsSyn
 import RnHsSyn
 import TcRnMonad
 import RnTypes        ( rnHsSigType, rnLHsType, checkPrecMatch)
-import RnPat          (rnPatsAndThen_LocalRightwards, rnBindPat,
+import RnPat          (rnPats, rnBindPat,
                        NameMaker, localRecNameMaker, topRecNameMaker, applyNameMaker
                       )
                       
@@ -157,8 +157,10 @@ it expects the global environment to contain bindings for the binders
 rnTopBindsLHS :: MiniFixityEnv
               -> HsValBinds RdrName 
               -> RnM (HsValBindsLR Name RdrName)
-rnTopBindsLHS fix_env binds = 
-    (uncurry $ rnValBindsLHSFromDoc (topRecNameMaker fix_env)) (bindersAndDoc binds) binds
+rnTopBindsLHS fix_env binds
+  = do { let (boundNames,doc) = bindersAndDoc binds 
+       ; mod <- getModule
+       ; rnValBindsLHSFromDoc (topRecNameMaker mod fix_env) boundNames doc binds }
 
 rnTopBindsRHS :: NameSet	-- Names bound by these binds
               -> HsValBindsLR Name RdrName 
@@ -461,8 +463,7 @@ rnBindLHS name_maker _ (L loc (FunBind { fun_id = name@(L nameLoc _),
                                          fun_tick = fun_tick
                                        }))
   = setSrcSpan loc $ 
-    do { (newname, _fvs) <- applyNameMaker name_maker name $ \ newname ->
-		 	    return (newname, emptyFVs) 
+    do { newname <- applyNameMaker name_maker name
        ; return (L loc (FunBind { fun_id = L nameLoc newname, 
                              	  fun_infix = inf, 
                              	  fun_matches = matches,
@@ -769,7 +770,7 @@ rnMatch' ctxt match@(Match pats maybe_rhs_sig grhss)
 
 	       -- Now the main event
 	       -- note that there are no local ficity decls for matches
-	; rnPatsAndThen_LocalRightwards ctxt pats	$ \ pats' -> do
+	; rnPats ctxt pats	$ \ pats' -> do
 	{ (grhss', grhss_fvs) <- rnGRHSs ctxt grhss
 
 	; return (Match pats' Nothing grhss', grhss_fvs) }}
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 414a717dd7..d3e1bdc2c5 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -12,13 +12,13 @@ module RnEnv (
 	lookupGlobalOccRn, lookupGlobalOccRn_maybe,
 	lookupLocalDataTcNames, lookupSigOccRn,
 	lookupFixityRn, lookupTyFixityRn, 
-	lookupInstDeclBndr, lookupRecordBndr, lookupConstructorFields,
+	lookupInstDeclBndr, lookupLocatedSubBndr, lookupConstructorFields,
 	lookupSyntaxName, lookupSyntaxTable, 
 	lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
 	getLookupOccRn, addUsedRdrNames,
 
-	newLocalsRn, newIPNameRn,
-	bindLocalNames, bindLocalNamesFV, 
+	newLocalBndrRn, newLocalBndrsRn, newIPNameRn,
+	bindLocalName, bindLocalNames, bindLocalNamesFV, 
 	MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv,
 	bindLocalNamesFV_WithFixities,
 	bindLocatedLocalsFV, bindLocatedLocalsRn,
@@ -30,9 +30,7 @@ module RnEnv (
 	mapFvRn, mapFvRnCPS,
 	warnUnusedMatches, warnUnusedModules, warnUnusedImports, 
 	warnUnusedTopBinds, warnUnusedLocalBinds,
-	dataTcOccs, unknownNameErr, kindSigErr, perhapsForallMsg,
-
-	checkM
+	dataTcOccs, unknownNameErr, kindSigErr, perhapsForallMsg
     ) where
 
 #include "HsVersions.h"
@@ -55,8 +53,8 @@ import DataCon		( dataConFieldLabels )
 import OccName
 import Module		( Module, ModuleName )
 import PrelNames	( mkUnboundName, rOOT_MAIN, iNTERACTIVE, 
-			  consDataConKey, hasKey, forall_tv_RDR )
-import UniqSupply
+			  consDataConKey, forall_tv_RDR )
+import Unique
 import BasicTypes
 import ErrUtils		( Message )
 import SrcLoc
@@ -75,21 +73,6 @@ import qualified Data.Set as Set
 -- XXX
 thenM :: Monad a => a b -> (b -> a c) -> a c
 thenM = (>>=)
-
-thenM_ :: Monad a => a b -> a c -> a c
-thenM_ = (>>)
-
-returnM :: Monad m => a -> m a
-returnM = return
-
-mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
-mappM = mapM
-
-mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
-mappM_ = mapM_
-
-checkM :: Monad m => Bool -> m () -> m ()
-checkM = unless
 \end{code}
 
 %*********************************************************
@@ -112,13 +95,13 @@ newTopSrcBinder this_mod (L loc rdr_name)
 	--	data T = (,) Int Int
 	-- unless we are in GHC.Tup
     ASSERT2( isExternalName name,  ppr name )
-    do	{ checkM (this_mod == nameModule name)
+    do	{ unless (this_mod == nameModule name)
 	         (addErrAt loc (badOrigBinding rdr_name))
 	; return name }
 
 
   | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
-  = do	{ checkM (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
+  = do	{ unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
 	         (addErrAt loc (badOrigBinding rdr_name))
 	-- When reading External Core we get Orig names as binders, 
 	-- but they should agree with the module gotten from the monad
@@ -141,7 +124,7 @@ newTopSrcBinder this_mod (L loc rdr_name)
 		--TODO, should pass the whole span
 
   | otherwise
-  = do	{ checkM (not (isQual rdr_name))
+  = do	{ unless (not (isQual rdr_name))
 	         (addErrAt loc (badQualBndrErr rdr_name))
 	 	-- Binders should not be qualified; if they are, and with a different
 		-- module name, we we get a confusing "M.T is not in scope" error later
@@ -207,7 +190,7 @@ lookupTopBndrRn_maybe :: RdrName -> RnM (Maybe Name)
 
 lookupTopBndrRn_maybe rdr_name
   | Just name <- isExact_maybe rdr_name
-  = returnM (Just name)
+  = return (Just name)
 
   | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name	
 	-- This deals with the case of derived bindings, where
@@ -223,12 +206,12 @@ lookupTopBndrRn_maybe rdr_name
           let occ = rdrNameOcc rdr_name
         ; when (isTcOcc occ && isSymOcc occ)
                (do { op_ok <- doptM Opt_TypeOperators
-	           ; checkM op_ok (addErr (opDeclErr rdr_name)) })
+	           ; unless op_ok (addErr (opDeclErr rdr_name)) })
 
     	; mb_gre <- lookupGreLocalRn rdr_name
 	; case mb_gre of
-		Nothing  -> returnM Nothing
-		Just gre -> returnM (Just $ gre_name gre) }
+		Nothing  -> return Nothing
+		Just gre -> return (Just $ gre_name gre) }
 	      
 
 -----------------------------------------------
@@ -244,40 +227,11 @@ lookupInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name)
 -- name is only in scope qualified.  I.e. even if method op is
 -- in scope as M.op, we still allow plain 'op' on the LHS of
 -- an instance decl
-lookupInstDeclBndr cls rdr = lookup_located_sub_bndr is_op doc rdr
+lookupInstDeclBndr cls rdr = lookupLocatedSubBndr (ParentIs cls) doc rdr
   where
     doc = ptext (sLit "method of class") <+> quotes (ppr cls)
-    is_op (GRE {gre_par = ParentIs n}) = n == cls
-    is_op _                            = False
 
 -----------------------------------------------
-lookupRecordBndr :: Maybe (Located Name) -> Located RdrName -> RnM (Located Name)
--- Used for record construction and pattern matching
--- When the -XDisambiguateRecordFields flag is on, take account of the
--- constructor name to disambiguate which field to use; it's just the
--- same as for instance decls
--- 
--- NB: Consider this:
---	module Foo where { data R = R { fld :: Int } }
---	module Odd where { import Foo; fld x = x { fld = 3 } }
--- Arguably this should work, because the reference to 'fld' is
--- unambiguous because there is only one field id 'fld' in scope.
--- But currently it's rejected.
-lookupRecordBndr Nothing rdr_name
-  = lookupLocatedGlobalOccRn rdr_name
-lookupRecordBndr (Just (L _ data_con)) rdr_name
-  = do 	{ flag_on <- doptM Opt_DisambiguateRecordFields
-	; if not flag_on 
-          then lookupLocatedGlobalOccRn rdr_name
-	  else do {
-	  fields <- lookupConstructorFields data_con
-	; let is_field gre = gre_name gre `elem` fields
-	; lookup_located_sub_bndr is_field doc rdr_name
-	}}
-   where
-     doc = ptext (sLit "field of constructor") <+> quotes (ppr data_con)
-
-
 lookupConstructorFields :: Name -> RnM [Name]
 -- Look up the fields of a given constructor
 --   *	For constructors from this module, use the record field env,
@@ -298,34 +252,57 @@ lookupConstructorFields con_name
 	     ; return (dataConFieldLabels con) } }
 
 -----------------------------------------------
-lookup_located_sub_bndr :: (GlobalRdrElt -> Bool)
+-- Used for record construction and pattern matching
+-- When the -XDisambiguateRecordFields flag is on, take account of the
+-- constructor name to disambiguate which field to use; it's just the
+-- same as for instance decls
+-- 
+-- NB: Consider this:
+--	module Foo where { data R = R { fld :: Int } }
+--	module Odd where { import Foo; fld x = x { fld = 3 } }
+-- Arguably this should work, because the reference to 'fld' is
+-- unambiguous because there is only one field id 'fld' in scope.
+-- But currently it's rejected.
+
+lookupLocatedSubBndr :: Parent  -- NoParent   => just look it up as usual
+				   -- ParentIs p => use p to disambiguate
 			-> SDoc -> Located RdrName
 			-> RnM (Located Name)
-lookup_located_sub_bndr is_good doc rdr_name
-  = wrapLocM (lookup_sub_bndr is_good doc) rdr_name
-
-lookup_sub_bndr :: (GlobalRdrElt -> Bool) -> SDoc -> RdrName -> RnM Name
-lookup_sub_bndr is_good doc rdr_name
-  | isUnqual rdr_name	-- Find all the things the rdr-name maps to
-  = do	{		-- and pick the one with the right parent name
-        ; addUsedRdrName rdr_name
+lookupLocatedSubBndr parent doc rdr_name
+  = wrapLocM (lookup_sub_bndr parent doc) rdr_name
+
+lookup_sub_bndr :: Parent -> SDoc -> RdrName -> RnM Name
+lookup_sub_bndr parent doc rdr_name
+  | Just n <- isExact_maybe rdr_name   -- This happens in derived code
+  = return n
+
+  | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
+  = lookupOrig rdr_mod rdr_occ
+
+  | otherwise	-- Find all the things the rdr-name maps to
+  = do	{	-- and pick the one with the right parent name
 	; env <- getGlobalRdrEnv
-	; case filter is_good (lookupGlobalRdrEnv env (rdrNameOcc rdr_name)) of
+        ; let gres = (lookupGlobalRdrEnv env (rdrNameOcc rdr_name))
+	; case pick parent gres  of
 		-- NB: lookupGlobalRdrEnv, not lookupGRE_RdrName!
 		--     The latter does pickGREs, but we want to allow 'x'
 		--     even if only 'M.x' is in scope
-	    [gre] -> return (gre_name gre)
+	    [gre] -> do { addUsedRdrName gre rdr_name
+                        ; return (gre_name gre) }
 	    []    -> do { addErr (unknownSubordinateErr doc rdr_name)
-			; traceRn (text "RnEnv.lookup_sub_bndr" <+> ppr rdr_name)
+			; traceRn (text "RnEnv.lookup_sub_bndr" <+> (ppr rdr_name $$ ppr gres))
 			; return (mkUnboundName rdr_name) }
 	    gres  -> do { addNameClashErrRn rdr_name gres
-			; return (gre_name (head gres)) }
-	}
+			; return (gre_name (head gres)) } }
+  where
+    pick NoParent gres		-- Normal lookup 
+      = pickGREs rdr_name gres
+    pick (ParentIs p) gres	-- Disambiguating lookup
+      | isUnqual rdr_name = filter (right_parent p) gres
+      | otherwise         = filter (right_parent p) (pickGREs rdr_name gres)
 
-  | otherwise	-- Occurs in derived instances, where we just
-		-- refer directly to the right method with an Orig
-		-- And record fields can be Quals: C { F.f = x }
-  = lookupGlobalOccRn rdr_name
+    right_parent p (GRE { gre_par = ParentIs p' }) = p==p' 
+    right_parent _ _                               = False
 
 newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
 newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
@@ -360,7 +337,7 @@ lookupOccRn :: RdrName -> RnM Name
 lookupOccRn rdr_name
   = getLocalRdrEnv			`thenM` \ local_env ->
     case lookupLocalRdrEnv local_env rdr_name of
-	  Just name -> returnM name
+	  Just name -> return name
 	  Nothing   -> lookupGlobalOccRn rdr_name
 
 lookupLocatedGlobalOccRn :: Located RdrName -> RnM (Located Name)
@@ -413,7 +390,7 @@ unboundName rdr_name
 	; traceRn (vcat [unknownNameErr rdr_name, 
 			 ptext (sLit "Global envt is:"),
 			 nest 3 (pprGlobalRdrEnv env)])
-	; returnM (mkUnboundName rdr_name) }
+	; return (mkUnboundName rdr_name) }
 
 --------------------------------------------------
 --	Lookup in the Global RdrEnv of the module
@@ -422,27 +399,7 @@ unboundName rdr_name
 lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
 -- Just look up the RdrName in the GlobalRdrEnv
 lookupGreRn_maybe rdr_name 
-  = do { mGre <- lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)
-       ; case mGre of
-           Just gre ->
-               case gre_prov gre of
-               LocalDef   -> return ()
-               Imported _ -> addUsedRdrName rdr_name
-           Nothing ->
-               return ()
-       ; return mGre }
-
-addUsedRdrName :: RdrName -> RnM ()
-addUsedRdrName rdr
-  = do { env <- getGblEnv
-       ; updMutVar (tcg_used_rdrnames env)
-	 	   (\s -> Set.insert rdr s) }
-
-addUsedRdrNames :: [RdrName] -> RnM ()
-addUsedRdrNames rdrs
-  = do { env <- getGblEnv
-       ; updMutVar (tcg_used_rdrnames env)
-	 	   (\s -> foldr Set.insert s rdrs) }
+  = lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)
 
 lookupGreRn :: RdrName -> RnM GlobalRdrElt
 -- If not found, add error message, and return a fake GRE
@@ -471,10 +428,28 @@ lookupGreRn_help :: RdrName			-- Only used in error message
 lookupGreRn_help rdr_name lookup 
   = do	{ env <- getGlobalRdrEnv
 	; case lookup env of
-	    []	  -> returnM Nothing
-	    [gre] -> returnM (Just gre)
+	    []	  -> return Nothing
+	    [gre] -> do { addUsedRdrName gre rdr_name
+                        ; return (Just gre) }
 	    gres  -> do { addNameClashErrRn rdr_name gres
-			; returnM (Just (head gres)) } }
+			; return (Just (head gres)) } }
+
+addUsedRdrName :: GlobalRdrElt -> RdrName -> RnM ()
+-- Record usage of imported RdrNames
+addUsedRdrName gre rdr
+  | isLocalGRE gre = return ()
+  | otherwise      = do { env <- getGblEnv
+       			; updMutVar (tcg_used_rdrnames env)
+		                    (\s -> Set.insert rdr s) }
+
+addUsedRdrNames :: [RdrName] -> RnM ()
+-- Record used sub-binders
+-- We don't check for imported-ness here, because it's inconvenient
+-- and not stritly necessary.
+addUsedRdrNames rdrs
+  = do { env <- getGblEnv
+       ; updMutVar (tcg_used_rdrnames env)
+	 	   (\s -> foldr Set.insert s rdrs) }
 
 ------------------------------
 --	GHCi support
@@ -715,7 +690,7 @@ lookupFixityRn name
         loadInterfaceForName doc name	`thenM` \ iface -> do {
           traceRn (text "lookupFixityRn: looking up name in iface cache and found:" <+> 
                    vcat [ppr name, ppr $ mi_fix_fn iface (nameOccName name)]);
-	   returnM (mi_fix_fn iface (nameOccName name))
+	   return (mi_fix_fn iface (nameOccName name))
                                                            }
   where
     doc = ptext (sLit "Checking fixity for") <+> ppr name
@@ -774,9 +749,9 @@ lookupSyntaxName std_name
     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)
+    return (HsVar usr_name, unitFV usr_name)
   where
-    normal_case = returnM (HsVar std_name, emptyFVs)
+    normal_case = return (HsVar std_name, emptyFVs)
 
 lookupSyntaxTable :: [Name]				-- Standard names
 		  -> RnM (SyntaxTable Name, FreeVars)	-- See comments with HsExpr.ReboundNames
@@ -785,11 +760,11 @@ lookupSyntaxTable std_names
     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 ->
+    mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names 	`thenM` \ usr_names ->
 
-    returnM (std_names `zip` map HsVar usr_names, mkFVs usr_names)
+    return (std_names `zip` map HsVar usr_names, mkFVs usr_names)
   where
-    normal_case = returnM (std_names `zip` map HsVar std_names, emptyFVs)
+    normal_case = return (std_names `zip` map HsVar std_names, emptyFVs)
 \end{code}
 
 
@@ -800,18 +775,22 @@ lookupSyntaxTable std_names
 %*********************************************************
 
 \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) loc
+newLocalBndrRn :: Located RdrName -> RnM Name
+-- Used for non-top-level binders.  These should
+-- never be qualified.
+newLocalBndrRn (L loc rdr_name)
+  | Just name <- isExact_maybe rdr_name 
+  = return name	-- This happens in code generated by Template Haskell
+		-- although I'm not sure why. Perhpas it's the call
+		-- in RnPat.newName LetMk?
+  | otherwise
+  = do { unless (isUnqual rdr_name)
+	        (addErrAt loc (badQualBndrErr rdr_name))
+       ; uniq <- newUnique
+       ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }
+
+newLocalBndrsRn :: [Located RdrName] -> RnM [Name]
+newLocalBndrsRn = mapM newLocalBndrRn
 
 ---------------------
 checkDupAndShadowedRdrNames :: SDoc -> [Located RdrName] -> RnM ()
@@ -823,26 +802,32 @@ checkDupAndShadowedRdrNames doc loc_rdr_names
 
 ---------------------
 bindLocatedLocalsRn :: SDoc	-- Documentation string for error message
-	   	        -> [Located RdrName]
+	            -> [Located RdrName]
 	    	    -> ([Name] -> RnM a)
 	    	    -> RnM a
 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
-  = checkDupAndShadowedRdrNames doc_str rdr_names_w_loc	`thenM_`
+  = do { checkDupAndShadowedRdrNames doc_str rdr_names_w_loc
 
 	-- Make fresh Names and extend the environment
-    newLocalsRn rdr_names_w_loc		`thenM` \names ->
-    bindLocalNames names (enclosed_scope names)
+       ; names <- newLocalBndrsRn rdr_names_w_loc
+       ; bindLocalNames 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
+  = do { name_env <- getLocalRdrEnv
+       ; setLocalRdrEnv (extendLocalRdrEnvList name_env names)
+		        enclosed_scope }
+
+bindLocalName :: Name -> RnM a -> RnM a
+bindLocalName name enclosed_scope
+  = do { name_env <- getLocalRdrEnv
+       ; setLocalRdrEnv (extendLocalRdrEnv name_env name)
+		        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) }
+	; return (result, delListFromNameSet fvs names) }
 
 
 -------------------------------------
@@ -853,7 +838,7 @@ bindLocatedLocalsFV :: SDoc -> [Located RdrName]
 bindLocatedLocalsFV doc rdr_names enclosed_scope
   = bindLocatedLocalsRn doc rdr_names	$ \ names ->
     enclosed_scope names		`thenM` \ (thing, fvs) ->
-    returnM (thing, delListFromNameSet fvs names)
+    return (thing, delListFromNameSet fvs names)
 
 -------------------------------------
 bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
@@ -863,7 +848,7 @@ bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
 bindTyVarsRn doc_str tyvar_names enclosed_scope
   = bindLocatedLocalsRn doc_str located_tyvars	$ \ names ->
     do { kind_sigs_ok <- doptM Opt_KindSignatures
-       ; checkM (null kinded_tyvars || kind_sigs_ok) 
+       ; unless (null kinded_tyvars || kind_sigs_ok) 
        	 	(mapM_ (addErr . kindSigErr) kinded_tyvars)
        ; enclosed_scope (zipWith replace tyvar_names names) }
   where 
@@ -898,7 +883,7 @@ bindPatSigTyVarsFV :: [LHsType RdrName]
 bindPatSigTyVarsFV tys thing_inside
   = bindPatSigTyVars tys	$ \ tvs ->
     thing_inside		`thenM` \ (result,fvs) ->
-    returnM (result, fvs `delListFromNameSet` tvs)
+    return (result, fvs `delListFromNameSet` tvs)
 
 bindSigTyVarsFV :: [Name]
 		-> RnM (a, FreeVars)
@@ -920,7 +905,7 @@ checkDupRdrNames :: SDoc
 	         -> RnM ()
 checkDupRdrNames doc_str rdr_names_w_loc
   = 	-- Check for duplicated names in a binding group
-    mappM_ (dupNamesErr getLoc doc_str) dups
+    mapM_ (dupNamesErr getLoc doc_str) dups
   where
     (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
 
@@ -929,7 +914,7 @@ checkDupNames :: SDoc
 	      -> RnM ()
 checkDupNames doc_str names
   = 	-- Check for duplicated names in a binding group
-    mappM_ (dupNamesErr nameSrcSpan doc_str) dups
+    mapM_ (dupNamesErr nameSrcSpan doc_str) dups
   where
     (_, dups) = removeDups (\n1 n2 -> nameOccName n1 `compare` nameOccName n2) names
 
@@ -938,7 +923,7 @@ checkShadowedNames :: SDoc -> (GlobalRdrEnv, LocalRdrEnv) -> [(SrcSpan,OccName)]
 checkShadowedNames doc_str (global_env,local_env) loc_rdr_names
   = ifOptM Opt_WarnNameShadowing $ 
     do	{ traceRn (text "shadow" <+> ppr loc_rdr_names)
-	; mappM_ check_shadow loc_rdr_names }
+	; mapM_ check_shadow loc_rdr_names }
   where
     check_shadow (loc, occ)
         | startsWithUnderscore occ = return ()	-- Do not report shadowing for "_x"
@@ -981,9 +966,9 @@ checkShadowedNames doc_str (global_env,local_env) loc_rdr_names
 \begin{code}
 -- A useful utility
 mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
-mapFvRn f xs = do stuff <- mappM f xs
+mapFvRn f xs = do stuff <- mapM f xs
                   case unzip stuff of
-                      (ys, fvs_s) -> returnM (ys, plusFVs fvs_s)
+                      (ys, fvs_s) -> return (ys, plusFVs fvs_s)
 
 -- because some of the rename functions are CPSed:
 -- maps the function across the list from left to right; 
@@ -1007,7 +992,7 @@ mapFvRnCPS f (x:xs) cont = f x 		   $ \ x' ->
 \begin{code}
 warnUnusedModules :: [(ModuleName,SrcSpan)] -> RnM ()
 warnUnusedModules mods
-  = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
+  = ifOptM Opt_WarnUnusedImports (mapM_ bleat mods)
   where
     bleat (mod,loc) = addWarnAt loc (mk_warn mod)
     mk_warn m = vcat [ptext (sLit "Module") <+> quotes (ppr m)
@@ -1041,7 +1026,7 @@ warnUnusedLocals names
  = warnUnusedBinds [(n,LocalDef) | n<-names]
 
 warnUnusedBinds :: [(Name,Provenance)] -> RnM ()
-warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
+warnUnusedBinds names  = mapM_ warnUnusedName (filter reportable names)
  where reportable (name,_) 
 	| isWiredInName name = False	-- Don't report unused wired-in names
 					-- Otherwise we get a zillion warnings
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index beee03730d..4b263e2a54 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -48,6 +48,7 @@ import Maybes		( expectJust )
 import Outputable
 import SrcLoc
 import FastString
+import Control.Monad
 \end{code}
 
 
@@ -248,13 +249,13 @@ rnExpr (ExplicitTuple tup_args boxity)
 
 rnExpr (RecordCon con_id _ rbinds)
   = do	{ conname <- lookupLocatedOccRn con_id
-	; (rbinds', fvRbinds) <- rnHsRecFields_Con conname rnLExpr rbinds
+	; (rbinds', fvRbinds) <- rnHsRecBinds (HsRecFieldCon (unLoc conname)) rbinds
 	; return (RecordCon conname noPostTcExpr rbinds', 
 		  fvRbinds `addOneFV` unLoc conname) }
 
 rnExpr (RecordUpd expr rbinds _ _ _)
   = do	{ (expr', fvExpr) <- rnLExpr expr
-	; (rbinds', fvRbinds) <- rnHsRecFields_Update rnLExpr rbinds
+	; (rbinds', fvRbinds) <- rnHsRecBinds HsRecFieldUpd rbinds
 	; return (RecordUpd expr' rbinds' [] [] [], 
 		  fvExpr `plusFV` fvRbinds) }
 
@@ -307,7 +308,7 @@ rnExpr e@(ELazyPat {}) = patSynErr e
 \begin{code}
 rnExpr (HsProc pat body)
   = newArrowScope $
-    rnPatsAndThen_LocalRightwards ProcExpr [pat] $ \ [pat'] ->
+    rnPats ProcExpr [pat] $ \ [pat'] ->
     rnCmdTop body	         `thenM` \ (body',fvBody) ->
     return (HsProc pat' body', fvBody)
 
@@ -364,6 +365,26 @@ rnSection other = pprPanic "rnSection" (ppr other)
 
 %************************************************************************
 %*									*
+	Records
+%*									*
+%************************************************************************
+
+\begin{code}
+rnHsRecBinds :: HsRecFieldContext -> HsRecordBinds RdrName
+             -> RnM (HsRecordBinds Name, FreeVars)
+rnHsRecBinds ctxt rec_binds@(HsRecFields { rec_dotdot = dd })
+  = do { (flds, fvs) <- rnHsRecFields1 ctxt HsVar rec_binds
+       ; (flds', fvss) <- mapAndUnzipM rn_field flds
+       ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }, 
+                 fvs `plusFV` plusFVs fvss) }
+  where 
+    rn_field fld = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)
+                      ; return (fld { hsRecFieldArg = arg' }, fvs) }
+\end{code}
+
+
+%************************************************************************
+%*									*
 	Arrow commands
 %*									*
 %************************************************************************
@@ -569,7 +590,7 @@ rnArithSeq (FromThenTo expr1 expr2 expr3)
 rnBracket :: HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
 rnBracket (VarBr n) = do { name <- lookupOccRn n
 			 ; this_mod <- getModule
-			 ; checkM (nameIsLocalOrFrom this_mod name) $	-- Reason: deprecation checking asumes the
+			 ; unless (nameIsLocalOrFrom this_mod name) $	-- Reason: deprecation checking asumes the
 			   do { _ <- loadInterfaceForName msg name	-- home interface is loaded, and this is the
 			      ; return () }				-- only way that is going to happen
 			 ; return (VarBr name, unitFV name) }
@@ -644,7 +665,7 @@ rnStmt ctxt (BindStmt pat expr _ _) thing_inside
 		-- The binders do not scope over the expression
 	; (bind_op, fvs1) <- lookupSyntaxName bindMName
 	; (fail_op, fvs2) <- lookupSyntaxName failMName
-	; rnPatsAndThen_LocalRightwards (StmtCtxt ctxt) [pat] $ \ [pat'] -> do
+	; rnPats (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) }}
@@ -793,7 +814,7 @@ rnParallelStmts ctxt segs thing_inside = do
     where
         go orig_lcl_env bndrs [] = do 
             let (bndrs', dups) = removeDups cmpByOcc bndrs
-                inner_env = extendLocalRdrEnv orig_lcl_env bndrs'
+                inner_env = extendLocalRdrEnvList orig_lcl_env bndrs'
             
             mapM_ dupErr dups
             (thing, fvs) <- setLocalRdrEnv inner_env thing_inside
diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index ac35fe55fc..b094628580 100644
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -11,14 +11,13 @@ free variables.
 
 \begin{code}
 module RnPat (-- main entry points
-              rnPatsAndThen_LocalRightwards, rnBindPat,
+              rnPats, rnBindPat,
 
               NameMaker, applyNameMaker,     -- a utility for making names:
               localRecNameMaker, topRecNameMaker,  --   sometimes we want to make local names,
                                              --   sometimes we want to make top (qualified) names.
 
-              rnHsRecFields_Con, rnHsRecFields_Update, --rename record fields in a constructor
-                                                       --and in an update
+              rnHsRecFields1, HsRecFieldContext(..),
 
 	      -- Literals
 	      rnLit, rnOverLit,     
@@ -49,448 +48,489 @@ import PrelNames
 import Constants	( mAX_TUPLE_SIZE )
 import Name
 import NameSet
+import Module
 import RdrName
 import ListSetOps	( removeDups, minusList )
 import Outputable
 import SrcLoc
 import FastString
 import Literal		( inCharRange )
+import Control.Monad	( when )
 \end{code}
 
 
 %*********************************************************
 %*							*
-\subsection{Patterns}
+	The CpsRn Monad
 %*							*
 %*********************************************************
 
+Note [CpsRn monad]
+~~~~~~~~~~~~~~~~~~
+The CpsRn monad uses continuation-passing style to support this
+style of programming:
+
+	do { ...
+           ; ns <- bindNames rs
+           ; ...blah... }
+
+   where rs::[RdrName], ns::[Name]
+
+The idea is that '...blah...' 
+  a) sees the bindings of ns
+  b) returns the free variables it mentions
+     so that bindNames can report unused ones
+
+In particular, 
+    mapM rnPatAndThen [p1, p2, p3]
+has a *left-to-right* scoping: it makes the binders in 
+p1 scope over p2,p3.
+
 \begin{code}
--- externally abstract type of name makers,
--- which is how you go from a RdrName to a Name
-data NameMaker = NM (forall a. Located RdrName -> (Name -> RnM (a, FreeVars))
-			                       -> RnM (a, FreeVars))
+newtype CpsRn b = CpsRn { unCpsRn :: forall r. (b -> RnM (r, FreeVars))
+                                            -> RnM (r, FreeVars) }
+	-- See Note [CpsRn monad]
+
+instance Monad CpsRn where
+  return x = CpsRn (\k -> k x)
+  (CpsRn m) >>= mk = CpsRn (\k -> m (\v -> unCpsRn (mk v) k))
+
+runCps :: CpsRn a -> RnM (a, FreeVars)
+runCps (CpsRn m) = m (\r -> return (r, emptyFVs))
+
+liftCps :: RnM a -> CpsRn a
+liftCps rn_thing = CpsRn (\k -> rn_thing >>= k)
+
+liftCpsFV :: RnM (a, FreeVars) -> CpsRn a
+liftCpsFV rn_thing = CpsRn (\k -> do { (v,fvs1) <- rn_thing
+                                     ; (r,fvs2) <- k v
+                                     ; return (r, fvs1 `plusFV` fvs2) })
+
+wrapSrcSpanCps :: (a -> CpsRn b) -> Located a -> CpsRn (Located b)
+-- Set the location, and also wrap it around the value returned
+wrapSrcSpanCps fn (L loc a)
+  = CpsRn (\k -> setSrcSpan loc $ 
+                 unCpsRn (fn a) $ \v -> 
+                 k (L loc v))
+
+lookupConCps :: Located RdrName -> CpsRn (Located Name)
+lookupConCps con_rdr 
+  = CpsRn (\k -> do { con_name <- lookupLocatedOccRn con_rdr
+                    ; (r, fvs) <- k con_name
+                    ; return (r, fvs `plusFV` unitFV (unLoc con_name)) })
+\end{code}
 
-matchNameMaker :: NameMaker
-matchNameMaker
-  = NM (\ rdr_name thing_inside -> 
-	do { names@[name] <- newLocalsRn [rdr_name]
-	   ; bindLocalNamesFV names $ do
-	   { (res, fvs) <- thing_inside name
-	   ; warnUnusedMatches names fvs
-	   ; return (res, fvs) }})
-			  
-topRecNameMaker, localRecNameMaker
-  :: MiniFixityEnv -> NameMaker
+%*********************************************************
+%*							*
+	Name makers
+%*							*
+%*********************************************************
 
--- topNameMaker and localBindMaker do not check for unused binding
-localRecNameMaker fix_env
-  = NM (\ rdr_name thing_inside -> 
-	do { [name] <- newLocalsRn [rdr_name]
-	   ; bindLocalNamesFV_WithFixities [name] fix_env $
-	     thing_inside name })
-  
-topRecNameMaker fix_env
-  = NM (\rdr_name thing_inside -> 
-        do { mod <- getModule
-           ; name <- newTopSrcBinder mod rdr_name
+Externally abstract type of name makers,
+which is how you go from a RdrName to a Name
+
+\begin{code}
+data NameMaker 
+  = LamMk 	-- Lambdas 
+      Bool	-- True <=> report unused bindings
+
+  | LetMk       -- Let bindings, incl top level
+		-- Do not check for unused bindings
+      (Maybe Module)   -- Just m  => top level of module m
+                       -- Nothing => not top level
+      MiniFixityEnv
+
+topRecNameMaker :: Module -> MiniFixityEnv -> NameMaker
+topRecNameMaker mod fix_env = LetMk (Just mod) fix_env
+
+localRecNameMaker :: MiniFixityEnv -> NameMaker
+localRecNameMaker fix_env = LetMk Nothing fix_env 
+
+matchNameMaker :: NameMaker
+matchNameMaker = LamMk True
+
+newName :: NameMaker -> Located RdrName -> CpsRn Name
+newName (LamMk report_unused) rdr_name
+  = CpsRn (\ thing_inside -> 
+	do { name <- newLocalBndrRn rdr_name
+	   ; (res, fvs) <- bindLocalName name (thing_inside name)
+	   ; when report_unused $ warnUnusedMatches [name] fvs
+	   ; return (res, name `delFV` fvs) })
+
+newName (LetMk mb_top fix_env) rdr_name
+  = CpsRn (\ thing_inside -> 
+        do { name <- case mb_top of
+                       Nothing  -> newLocalBndrRn rdr_name
+                       Just mod -> newTopSrcBinder mod rdr_name
 	   ; bindLocalNamesFV_WithFixities [name] fix_env $
 	     thing_inside name })
-	        -- Note: the bindLocalNamesFV_WithFixities is somewhat suspicious 
-        	--       because it binds a top-level name as a local name.
-	        --       however, this binding seems to work, and it only exists for
-	        --       the duration of the patterns and the continuation;
-	        --       then the top-level name is added to the global env
-	        --       before going on to the RHSes (see RnSource.lhs).
-
-applyNameMaker :: NameMaker -> Located RdrName
-	       -> (Name -> RnM (a,FreeVars)) -> RnM (a, FreeVars)
-applyNameMaker (NM f) = f
-
-
--- There are various entry points to renaming patterns, depending on
---  (1) whether the names created should be top-level names or local names
---  (2) whether the scope of the names is entirely given in a continuation
---      (e.g., in a case or lambda, but not in a let or at the top-level,
---       because of the way mutually recursive bindings are handled)
---  (3) whether the a type signature in the pattern can bind 
---	lexically-scoped type variables (for unpacking existential 
---	type vars in data constructors)
---  (4) whether we do duplicate and unused variable checking
---  (5) whether there are fixity declarations associated with the names
---      bound by the patterns that need to be brought into scope with them.
---      
---  Rather than burdening the clients of this module with all of these choices,
---  we export the three points in this design space that we actually need:
-
--- entry point 1:
--- binds local names; the scope of the bindings is entirely in the thing_inside
---   allows type sigs to bind type vars
---   local namemaker
---   unused and duplicate checking
---   no fixities
-rnPatsAndThen_LocalRightwards :: HsMatchContext Name -- for error messages
-                              -> [LPat RdrName] 
-                              -- the continuation gets:
-                              --    the list of renamed patterns
-                              --    the (overall) free vars of all of them
-                              -> ([LPat Name] -> RnM (a, FreeVars))
-                              -> RnM (a, FreeVars)
-
-rnPatsAndThen_LocalRightwards ctxt pats thing_inside
+			  
+    -- Note: the bindLocalNamesFV_WithFixities is somewhat suspicious 
+    --       because it binds a top-level name as a local name.
+    --       however, this binding seems to work, and it only exists for
+    --       the duration of the patterns and the continuation;
+    --       then the top-level name is added to the global env
+    --       before going on to the RHSes (see RnSource.lhs).
+\end{code}
+
+
+%*********************************************************
+%*							*
+	External entry points
+%*							*
+%*********************************************************
+
+There are various entry points to renaming patterns, depending on
+ (1) whether the names created should be top-level names or local names
+ (2) whether the scope of the names is entirely given in a continuation
+     (e.g., in a case or lambda, but not in a let or at the top-level,
+      because of the way mutually recursive bindings are handled)
+ (3) whether the a type signature in the pattern can bind 
+	lexically-scoped type variables (for unpacking existential 
+	type vars in data constructors)
+ (4) whether we do duplicate and unused variable checking
+ (5) whether there are fixity declarations associated with the names
+     bound by the patterns that need to be brought into scope with them.
+     
+ Rather than burdening the clients of this module with all of these choices,
+ we export the three points in this design space that we actually need:
+
+\begin{code}
+-- ----------- Entry point 1: rnPats -------------------
+-- Binds local names; the scope of the bindings is entirely in the thing_inside
+--   * allows type sigs to bind type vars
+--   * local namemaker
+--   * unused and duplicate checking
+--   * no fixities
+rnPats :: HsMatchContext Name -- for error messages
+       -> [LPat RdrName] 
+       -> ([LPat Name] -> RnM (a, FreeVars))
+       -> RnM (a, FreeVars)
+rnPats ctxt pats thing_inside
   = do	{ envs_before <- getRdrEnvs
 
 	  -- (0) bring into scope all of the type variables bound by the patterns
 	  -- (1) rename the patterns, bringing into scope all of the term variables
 	  -- (2) then do the thing inside.
 	; bindPatSigTyVarsFV (collectSigTysFromPats pats) $ 
-	  rnLPatsAndThen matchNameMaker pats	$ \ pats' ->
-            do { -- Check for duplicated and shadowed names 
+	  unCpsRn (rnLPatsAndThen matchNameMaker pats)	  $ \ pats' -> do
+        { -- Check for duplicated and shadowed names 
 	         -- Because we don't bind the vars all at once, we can't
 	         -- 	check incrementally for duplicates; 
 	         -- Nor can we check incrementally for shadowing, else we'll
 	         -- 	complain *twice* about duplicates e.g. f (x,x) = ...
-            ; let names = collectPatsBinders pats'
-            ; checkDupNames doc_pat names
-	    ; checkShadowedNames doc_pat envs_before
-				 [(nameSrcSpan name, nameOccName name) | name <- names]
-            ; thing_inside pats' } }
+        ; let names = collectPatsBinders pats'
+        ; checkDupNames doc_pat names
+	; checkShadowedNames doc_pat envs_before
+			     [(nameSrcSpan name, nameOccName name) | name <- names]
+        ; thing_inside pats' } }
   where
     doc_pat = ptext (sLit "In") <+> pprMatchContext ctxt
 
 
--- entry point 2:
--- binds local names; in a recursive scope that involves other bound vars
+applyNameMaker :: NameMaker -> Located RdrName -> RnM Name
+applyNameMaker mk rdr = do { (n, _fvs) <- runCps (newName mk rdr); return n }
+
+-- ----------- Entry point 2: rnBindPat -------------------
+-- Binds local names; in a recursive scope that involves other bound vars
 --	e.g let { (x, Just y) = e1; ... } in ...
---   does NOT allows type sig to bind type vars
---   local namemaker
---   no unused and duplicate checking
---   fixities might be coming in
+--   * does NOT allows type sig to bind type vars
+--   * local namemaker
+--   * no unused and duplicate checking
+--   * fixities might be coming in
 rnBindPat :: NameMaker
           -> LPat RdrName
-          -> RnM (LPat Name, 
-                       -- free variables of the pattern,
-                       -- but not including variables bound by this pattern 
-                   FreeVars)
-
-rnBindPat name_maker pat
-  = rnLPatsAndThen name_maker [pat] $ \ [pat'] ->
-    return (pat', emptyFVs)
-
-
--- general version: parametrized by how you make new names
--- invariant: what-to-do continuation only gets called with a list whose length is the same as
---            the part of the pattern we're currently renaming
-rnLPatsAndThen :: NameMaker -- how to make a new variable
-               -> [LPat RdrName]   -- part of pattern we're currently renaming
-               -> ([LPat Name] -> RnM (a, FreeVars)) -- what to do afterwards
-               -> RnM (a, FreeVars) -- renaming of the whole thing
-               
-rnLPatsAndThen var = mapFvRnCPS (rnLPatAndThen var)
-
-
--- the workhorse
-rnLPatAndThen :: NameMaker
-              -> LPat RdrName   -- part of pattern we're currently renaming
-              -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
-              -> RnM (a, FreeVars) -- renaming of the whole thing
-rnLPatAndThen var@(NM varf) (L loc p) cont = 
-    setSrcSpan loc $ 
-      let reloc = L loc 
-          lcont = \ unlocated -> cont (reloc unlocated)
-      in
-       case p of
-         WildPat _   -> lcont (WildPat placeHolderType)
-
-         ParPat pat  -> rnLPatAndThen var pat $ \ pat' -> lcont (ParPat pat')
-         LazyPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (LazyPat pat')
-         BangPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (BangPat pat')
-         
-         VarPat name -> 
-	    varf (reloc name) $ \ newBoundName -> 
-	    lcont (VarPat newBoundName)
-               -- we need to bind pattern variables for view pattern expressions
-               -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
+          -> RnM (LPat Name, FreeVars)
+   -- Returned FreeVars are the free variables of the pattern,
+   -- of course excluding variables bound by this pattern 
+
+rnBindPat name_maker pat = runCps (rnLPatAndThen name_maker pat)
+\end{code}
+
+
+%*********************************************************
+%*							*
+	The main event
+%*							*
+%*********************************************************
+
+\begin{code}
+-- ----------- Entry point 3: rnLPatAndThen -------------------
+-- General version: parametrized by how you make new names
+
+rnLPatsAndThen :: NameMaker -> [LPat RdrName] -> CpsRn [LPat Name]
+rnLPatsAndThen mk = mapM (rnLPatAndThen mk)
+  -- Despite the map, the monad ensures that each pattern binds
+  -- variables that may be mentioned in subsequent patterns in the list
+
+--------------------
+-- The workhorse
+rnLPatAndThen :: NameMaker -> LPat RdrName -> CpsRn (LPat Name)
+rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat
+
+rnPatAndThen :: NameMaker -> Pat RdrName -> CpsRn (Pat Name)
+rnPatAndThen _  (WildPat _)   = return (WildPat placeHolderType)
+rnPatAndThen mk (ParPat pat)  = do { pat' <- rnLPatAndThen mk pat; return (ParPat pat') }
+rnPatAndThen mk (LazyPat pat) = do { pat' <- rnLPatAndThen mk pat; return (LazyPat pat') }
+rnPatAndThen mk (BangPat pat) = do { pat' <- rnLPatAndThen mk pat; return (BangPat pat') }
+rnPatAndThen mk (VarPat rdr)  = do { loc <- liftCps getSrcSpanM
+                                   ; name <- newName mk (L loc rdr)
+                                   ; return (VarPat name) }
+     -- we need to bind pattern variables for view pattern expressions
+     -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
                                      
-         SigPatIn pat ty -> do
-             patsigs <- doptM Opt_ScopedTypeVariables
-             if patsigs
-              then rnLPatAndThen var pat
-                      (\ pat' -> do { (ty', fvs1) <- rnHsTypeFVs tvdoc ty
-				    ; (res, fvs2) <- lcont (SigPatIn pat' ty')
-				    ; return (res, fvs1 `plusFV` fvs2) })
-              else do addErr (patSigErr ty)
-                      rnLPatAndThen var pat cont
-           where
-             tvdoc = text "In a pattern type-signature"
+rnPatAndThen mk (SigPatIn pat ty)
+  = do { patsigs <- liftCps (doptM Opt_ScopedTypeVariables)
+       ; if patsigs
+         then do { pat' <- rnLPatAndThen mk pat
+                 ; ty' <- liftCpsFV (rnHsTypeFVs tvdoc ty)
+		 ; return (SigPatIn pat' ty') }
+         else do { liftCps (addErr (patSigErr ty))
+                 ; rnPatAndThen mk (unLoc pat) } }
+  where
+    tvdoc = text "In a pattern type-signature"
        
-         LitPat lit@(HsString s) -> 
-             do ovlStr <- doptM Opt_OverloadedStrings
-                if ovlStr 
-                 then rnLPatAndThen var (reloc $ mkNPat (mkHsIsString s placeHolderType) Nothing) cont
-                 else do { rnLit lit; lcont (LitPat lit) }   -- Same as below
-      
-         LitPat lit -> do { rnLit lit; lcont (LitPat lit) }
-
-         NPat lit mb_neg _eq ->
-           do { (lit', fvs1) <- rnOverLit lit
-	      ;	(mb_neg', fvs2) <- case mb_neg of
-			             Nothing -> return (Nothing, emptyFVs)
-			             Just _  -> do { (neg, fvs) <- lookupSyntaxName negateName
-						   ; return (Just neg, fvs) }
-	      ; (eq', fvs3) <- lookupSyntaxName eqName
-	      ; (res, fvs4) <- lcont (NPat lit' mb_neg' eq')
-	      ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
-	       	-- Needed to find equality on pattern
-
-         NPlusKPat name lit _ _ ->
-   	   varf name $ \ new_name ->
-	   do { (lit', fvs1) <- rnOverLit lit
-  	      ; (minus, fvs2) <- lookupSyntaxName minusName
-              ; (ge, fvs3) <- lookupSyntaxName geName
-              ; (res, fvs4) <- lcont (NPlusKPat (L (nameSrcSpan new_name) new_name) lit' ge minus)
-	      ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
+rnPatAndThen mk (LitPat lit)
+  | HsString s <- lit
+  = do { ovlStr <- liftCps (doptM Opt_OverloadedStrings)
+       ; if ovlStr 
+         then rnPatAndThen mk (mkNPat (mkHsIsString s placeHolderType) Nothing)
+         else normal_lit }
+  | otherwise = normal_lit
+  where
+    normal_lit = do { liftCps (rnLit lit); return (LitPat lit) }
+
+rnPatAndThen _ (NPat lit mb_neg _eq)
+  = do { lit'    <- liftCpsFV $ rnOverLit lit
+       ; mb_neg' <- liftCpsFV $ case mb_neg of
+		      Nothing -> return (Nothing, emptyFVs)
+		      Just _  -> do { (neg, fvs) <- lookupSyntaxName negateName
+				    ; return (Just neg, fvs) }
+       ; eq' <- liftCpsFV $ lookupSyntaxName eqName
+       ; return (NPat lit' mb_neg' eq') }
+
+rnPatAndThen mk (NPlusKPat rdr lit _ _)
+  = do { new_name <- newName mk rdr
+       ; lit'  <- liftCpsFV $ rnOverLit lit
+       ; minus <- liftCpsFV $ lookupSyntaxName minusName
+       ; ge    <- liftCpsFV $ lookupSyntaxName geName
+       ; return (NPlusKPat (L (nameSrcSpan new_name) new_name) lit' ge minus) }
 	   	-- The Report says that n+k patterns must be in Integral
 
-         AsPat name pat ->
-   	   varf name $ \ new_name ->
-           rnLPatAndThen var pat $ \ pat' -> 
-           lcont (AsPat (L (nameSrcSpan new_name) new_name) pat')
-
-         ViewPat expr pat ty -> 
-	   do { vp_flag <- doptM Opt_ViewPatterns
-              ; checkErr vp_flag (badViewPat p)
-                -- because of the way we're arranging the recursive calls,
-                -- this will be in the right context 
-              ; (expr', fv_expr) <- rnLExpr expr 
-              ; (res, fvs_res) <- rnLPatAndThen var pat $ \ pat' ->
-		                  lcont (ViewPat expr' pat' ty)
-	      ; return (res, fvs_res `plusFV` fv_expr) }
+rnPatAndThen mk (AsPat rdr pat)
+  = do { new_name <- newName mk rdr
+       ; pat' <- rnLPatAndThen mk pat
+       ; return (AsPat (L (nameSrcSpan new_name) new_name) pat') }
+
+rnPatAndThen mk p@(ViewPat expr pat ty)
+  = do { liftCps $ do { vp_flag <- doptM Opt_ViewPatterns
+                      ; checkErr vp_flag (badViewPat p) }
+         -- Because of the way we're arranging the recursive calls,
+         -- this will be in the right context 
+       ; expr' <- liftCpsFV $ rnLExpr expr 
+       ; pat' <- rnLPatAndThen mk pat
+       ; return (ViewPat expr' pat' ty) }
+
+rnPatAndThen mk (ConPatIn con stuff)
+   -- rnConPatAndThen takes care of reconstructing the pattern
+  = rnConPatAndThen mk con stuff
+
+rnPatAndThen mk (ListPat pats _)
+  = do { pats' <- rnLPatsAndThen mk pats
+       ; return (ListPat pats' placeHolderType) }
+
+rnPatAndThen mk (PArrPat pats _)
+  = do { pats' <- rnLPatsAndThen mk pats
+       ; return (PArrPat pats' placeHolderType) }
+
+rnPatAndThen mk (TuplePat pats boxed _)
+  = do { liftCps $ checkTupSize (length pats)
+       ; pats' <- rnLPatsAndThen mk pats
+       ; return (TuplePat pats' boxed placeHolderType) }
+
+rnPatAndThen _ (TypePat ty)
+  = do { ty' <- liftCpsFV $ rnHsTypeFVs (text "In a type pattern") ty
+       ; return (TypePat ty') }
 
 #ifndef GHCI
-         (QuasiQuotePat _) -> pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
+rnPatAndThen _ p@(QuasiQuotePat {}) 
+  = pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
 #else
-         QuasiQuotePat qq -> do
-             (qq', _) <- rnQuasiQuote qq
-             pat' <- runQuasiQuotePat qq'
-             rnLPatAndThen var pat' $ \ (L _ pat'') ->
-                 lcont pat''
+rnPatAndThen mk (QuasiQuotePat qq)
+  = do { qq' <- liftCpsFV $ rnQuasiQuote qq
+       ; pat <- liftCps $ runQuasiQuotePat qq'
+       ; L _ pat' <- rnLPatAndThen mk pat
+       ; return pat' }
 #endif 	/* GHCI */
 
-         ConPatIn con stuff -> 
-             -- rnConPatAndThen takes care of reconstructing the pattern
-             rnConPatAndThen var con stuff cont
-
-         ListPat pats _ -> 
-           rnLPatsAndThen var pats $ \ patslist ->
-               lcont (ListPat patslist placeHolderType)
-
-         PArrPat pats _ -> 
-	   do { (res, res_fvs) <- rnLPatsAndThen var pats $ \ patslist ->
-			          lcont (PArrPat patslist placeHolderType)
-	      ; return (res, res_fvs `plusFV` implicit_fvs) }
-           where
-             implicit_fvs = mkFVs [lengthPName, indexPName]
-
-         TuplePat pats boxed _ -> 
-           do { checkTupSize (length pats)
-              ; rnLPatsAndThen var pats $ \ patslist ->
-                lcont (TuplePat patslist boxed placeHolderType) }
-
-         TypePat ty -> 
-           do { (ty', fvs1) <- rnHsTypeFVs (text "In a type pattern") ty
-	      ; (res, fvs2) <- lcont (TypePat ty')
-	      ; return (res, fvs1 `plusFV` fvs2) }
-
-         p -> pprPanic "rnLPatAndThen" (ppr p)
+rnPatAndThen _ pat = pprPanic "rnLPatAndThen" (ppr pat)
 
 
--- helper for renaming constructor patterns
+--------------------
 rnConPatAndThen :: NameMaker
                 -> Located RdrName          -- the constructor
                 -> HsConPatDetails RdrName 
-                -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
-                -> RnM (a, FreeVars)
-
-rnConPatAndThen var (con@(L loc _)) (PrefixCon pats) cont
-  = do	{ con' <- lookupLocatedOccRn con
-	; (res, res_fvs) <- rnLPatsAndThen var pats $ \ pats' ->
-		            cont (L loc $ ConPatIn con' (PrefixCon pats'))
-        ; return (res, res_fvs `addOneFV` unLoc con') }
-
-rnConPatAndThen var (con@(L loc _)) (InfixCon pat1 pat2) cont
-  = do	{ con' <- lookupLocatedOccRn con
-   	; (res, res_fvs) <- rnLPatAndThen var pat1 $ \ pat1' -> 
-			    rnLPatAndThen var pat2 $ \ pat2' ->
-			    do { fixity <- lookupFixityRn (unLoc con')
-		               ; pat' <- mkConOpPatRn con' fixity pat1' pat2'
-			       ; cont (L loc pat') }
-        ; return (res, res_fvs `addOneFV` unLoc con') }
-
-rnConPatAndThen var (con@(L loc _)) (RecCon rpats) cont
-  = do	{ con' <- lookupLocatedOccRn con
-  	; (res, res_fvs) <- rnHsRecFieldsAndThen_Pattern con' var rpats $ \ rpats' -> 
-			    cont (L loc $ ConPatIn con' (RecCon rpats'))
-        ; return (res, res_fvs `addOneFV` unLoc con') }
-
--- what kind of record expression we're doing
--- the first two tell the name of the datatype constructor in question
--- and give a way of creating a variable to fill in a ..
-data RnHsRecFieldsChoice a = Constructor (Located Name) (RdrName -> a)
-                           | Pattern  (Located Name) (RdrName -> a)
-                           | Update
-
-choiceToMessage :: RnHsRecFieldsChoice t -> String
-choiceToMessage (Constructor _ _) = "construction"
-choiceToMessage (Pattern _ _) = "pattern"
-choiceToMessage Update = "update"
-
-doDotDot :: RnHsRecFieldsChoice t -> Maybe (Located Name, RdrName -> t)
-doDotDot (Constructor a b) = Just (a,b)
-doDotDot (Pattern a b) = Just (a,b)
-doDotDot Update        = Nothing
-
-getChoiceName :: RnHsRecFieldsChoice field -> Maybe (Located Name)
-getChoiceName (Constructor n _) = Just n
-getChoiceName (Pattern n _) = Just n
-getChoiceName (Update) = Nothing
-
-
-
--- helper for renaming record patterns;
--- parameterized so that it can also be used for expressions
-rnHsRecFieldsAndThen :: RnHsRecFieldsChoice field
-                     -- how to rename the fields (CPSed)
-                     -> (Located field -> (Located field' -> RnM (c, FreeVars)) 
-                                       -> RnM (c, FreeVars)) 
-                     -- the actual fields 
-                     -> HsRecFields RdrName (Located field)  
-                     -- what to do in the scope of the field vars
-                     -> (HsRecFields Name (Located field') -> RnM (c, FreeVars)) 
-                     -> RnM (c, FreeVars)
--- Haddock comments for record fields are renamed to Nothing here
-rnHsRecFieldsAndThen choice rn_thing (HsRecFields fields dd) cont = 
-    let
-
-        -- helper to collect and report duplicate record fields
-        reportDuplicateFields doingstr fields = 
-            let 
-                -- each list represents a RdrName that occurred more than once
-                -- (the list contains all occurrences)
-                -- invariant: each list in dup_fields is non-empty
-                dup_fields :: [[RdrName]]
-                (_, dup_fields) = removeDups compare
-                                                 (map (unLoc . hsRecFieldId) fields)
-                                             
-                -- duplicate field reporting function
-                field_dup_err dup_group = addErr (dupFieldErr doingstr (head dup_group))
-            in
-              mapM_ field_dup_err dup_fields
-
-        -- helper to rename each field
-        rn_field pun_ok (HsRecField field inside pun) cont = do 
-          fieldname <- lookupRecordBndr (getChoiceName choice) field
-          checkErr (not pun || pun_ok) (badPun field)
-          (res, res_fvs) <- rn_thing inside $ \ inside' -> 
-		            cont (HsRecField fieldname inside' pun) 
-          return (res, res_fvs `addOneFV` unLoc fieldname)
-
-        -- Compute the extra fields to be filled in by the dot-dot notation
-        dot_dot_fields fs con mk_field cont = do 
-            con_fields <- lookupConstructorFields (unLoc con)
-            let missing_fields = con_fields `minusList` fs
-            loc <- getSrcSpanM	-- Rather approximate
-            -- it's important that we make the RdrName fields that we morally wrote
-            -- and then rename them in the usual manner
-            -- (rather than trying to make the result of renaming directly)
-            -- because, for patterns, renaming can bind vars in the continuation
-            mapFvRnCPS rn_thing 
-             (map (L loc . mk_field . mkRdrUnqual . getOccName) missing_fields) $
-              \ rhss -> 
-                  let new_fs = [ HsRecField (L loc f) r False
-		                 | (f, r) <- missing_fields `zip` rhss ]
-                  in 
-                  cont new_fs
-
-   in do
-       -- report duplicate fields
-       let doingstr = choiceToMessage choice
-       reportDuplicateFields doingstr fields
-
-       -- rename the records as written
-       -- check whether punning (implicit x=x) is allowed
-       pun_flag <- doptM Opt_RecordPuns
-       -- rename the fields
-       mapFvRnCPS (rn_field pun_flag) fields $ \ fields1 ->
-
-           -- handle ..
-           case dd of
-             Nothing -> cont (HsRecFields fields1 dd)
-             Just n  -> ASSERT( n == length fields ) do
-                          dd_flag <- doptM Opt_RecordWildCards
-                          checkErr dd_flag (needFlagDotDot doingstr)
-                          let fld_names1 = map (unLoc . hsRecFieldId) fields1
-                          case doDotDot choice of 
-                                Nothing -> do addErr (badDotDot doingstr)
-                                              -- we return a junk value here so that error reporting goes on
-                                              cont (HsRecFields fields1 dd)
-                                Just (con, mk_field) ->
-                                    dot_dot_fields fld_names1 con mk_field $
-                                      \ fields2 -> 
-                                          cont (HsRecFields (fields1 ++ fields2) dd)
-
-needFlagDotDot :: String -> SDoc
-needFlagDotDot str = vcat [ptext (sLit "Illegal `..' in record") <+> text str,
-			  ptext (sLit "Use -XRecordWildCards to permit this")]
-
-badDotDot :: String -> SDoc
-badDotDot str = ptext (sLit "You cannot use `..' in record") <+> text str
+                -> CpsRn (Pat Name)
+
+rnConPatAndThen mk con (PrefixCon pats)
+  = do	{ con' <- lookupConCps con
+	; pats' <- rnLPatsAndThen mk pats
+	; return (ConPatIn con' (PrefixCon pats')) }
+
+rnConPatAndThen mk con (InfixCon pat1 pat2)
+  = do	{ con' <- lookupConCps con
+   	; pat1' <- rnLPatAndThen mk pat1
+	; pat2' <- rnLPatAndThen mk pat2
+	; fixity <- liftCps $ lookupFixityRn (unLoc con')
+	; liftCps $ mkConOpPatRn con' fixity pat1' pat2' }
+
+rnConPatAndThen mk con (RecCon rpats)
+  = do	{ con' <- lookupConCps con
+  	; rpats' <- rnHsRecPatsAndThen mk con' rpats
+	; return (ConPatIn con' (RecCon rpats')) }
+
+--------------------
+rnHsRecPatsAndThen :: NameMaker
+                   -> Located Name	-- Constructor
+		   -> HsRecFields RdrName (LPat RdrName)
+		   -> CpsRn (HsRecFields Name (LPat Name))
+rnHsRecPatsAndThen mk (L _ con) hs_rec_fields@(HsRecFields { rec_dotdot = dd })
+  = do { flds <- liftCpsFV $ rnHsRecFields1 (HsRecFieldPat con) VarPat hs_rec_fields
+       ; flds' <- mapM rn_field (flds `zip` [1..])
+       ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }
+  where 
+    rn_field (fld, n') = do { arg' <- rnLPatAndThen (nested_mk dd mk n') 
+                                                    (hsRecFieldArg fld)
+                            ; return (fld { hsRecFieldArg = arg' }) }
+
+	-- Suppress unused-match reporting for fields introduced by ".."
+    nested_mk Nothing  mk                    _  = mk
+    nested_mk (Just _) mk@(LetMk {})         _  = mk
+    nested_mk (Just n) (LamMk report_unused) n' = LamMk (report_unused && (n' <= n))
+\end{code}
+
+
+%************************************************************************
+%*									*
+	Record fields
+%*									*
+%************************************************************************
+
+\begin{code}
+data HsRecFieldContext 
+  = HsRecFieldCon Name
+  | HsRecFieldPat Name
+  | HsRecFieldUpd
+
+rnHsRecFields1 
+    :: HsRecFieldContext
+    -> (RdrName -> arg) -- When punning, use this to build a new field
+    -> HsRecFields RdrName (Located arg)
+    -> RnM ([HsRecField Name (Located arg)], FreeVars)
+
+-- This supprisingly complicated pass
+--   a) looks up the field name (possibly using disambiguation)
+--   b) fills in puns and dot-dot stuff
+-- When we we've finished, we've renamed the LHS, but not the RHS,
+-- of each x=e binding
+
+rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
+  = do { pun_ok      <- doptM Opt_RecordPuns
+       ; disambig_ok <- doptM Opt_DisambiguateRecordFields
+       ; parent <- check_disambiguation disambig_ok mb_con
+       ; flds1 <- mapM (rn_fld pun_ok parent) flds
+       ; mapM_ (addErr . dupFieldErr ctxt) dup_flds
+       ; flds2 <- rn_dotdot dotdot mb_con flds1
+       ; return (flds2, mkFVs (getFieldIds flds2)) }
+  where
+    mb_con = case ctxt of
+		HsRecFieldUpd     -> Nothing
+		HsRecFieldCon con -> Just con
+		HsRecFieldPat con -> Just con
+    doc = case mb_con of
+            Nothing  -> ptext (sLit "constructor field name")
+            Just con -> ptext (sLit "field of constructor") <+> quotes (ppr con)
+
+    name_to_arg (L loc n) = L loc (mk_arg (mkRdrUnqual (nameOccName n)))
+
+    rn_fld pun_ok parent (HsRecField { hsRecFieldId = fld
+                       	      	     , hsRecFieldArg = arg
+                       	      	     , hsRecPun = pun })
+      = do { fld' <- lookupLocatedSubBndr parent doc fld
+           ; arg' <- if pun 
+                     then do { checkErr pun_ok (badPun fld)
+                             ; return (name_to_arg fld') }
+                     else return arg
+           ; return (HsRecField { hsRecFieldId = fld'
+                                , hsRecFieldArg = arg'
+                                , hsRecPun = pun }) }
+
+    rn_dotdot Nothing _mb_con flds     -- No ".." at all
+      = return flds
+    rn_dotdot (Just {}) Nothing flds   -- ".." on record update
+      = do { addErr (badDotDot ctxt); return flds }
+    rn_dotdot (Just n) (Just con) flds -- ".." on record con/pat
+      = ASSERT( n == length flds )
+        do { loc <- getSrcSpanM	-- Rather approximate
+           ; dd_flag <- doptM Opt_RecordWildCards
+           ; checkErr dd_flag (needFlagDotDot ctxt)
+
+           ; con_fields <- lookupConstructorFields con
+           ; let present_flds = getFieldIds flds
+                 absent_flds  = con_fields `minusList` present_flds
+                 extras = [ HsRecField
+                              { hsRecFieldId = L loc f
+                              , hsRecFieldArg = name_to_arg (L loc f)
+                              , hsRecPun = True }
+                          | f <- absent_flds ]
+
+           ; return (flds ++ extras) }
+
+    check_disambiguation :: Bool -> Maybe Name -> RnM Parent
+    -- When disambiguation is on, return the parent *type constructor*
+    -- That is, the parent of the data constructor.  That's the parent
+    -- to use for looking up record fields.
+    check_disambiguation disambig_ok mb_con
+      | disambig_ok, Just con <- mb_con
+      = do { env <- getGlobalRdrEnv
+           ; return (case lookupGRE_Name env con of
+	       	       [gre] -> gre_par gre
+               	       gres  -> WARN( True, ppr con <+> ppr gres ) NoParent) }
+      | otherwise = return NoParent
+ 
+    dup_flds :: [[RdrName]]
+        -- Each list represents a RdrName that occurred more than once
+        -- (the list contains all occurrences)
+        -- Each list in dup_fields is non-empty
+    (_, dup_flds) = removeDups compare (getFieldIds flds)
+
+getFieldIds :: [HsRecField id arg] -> [id]
+getFieldIds flds = map (unLoc . hsRecFieldId) flds
+
+needFlagDotDot :: HsRecFieldContext -> SDoc
+needFlagDotDot ctxt = vcat [ptext (sLit "Illegal `..' in record") <+> pprRFC ctxt,
+			    ptext (sLit "Use -XRecordWildCards to permit this")]
+
+badDotDot :: HsRecFieldContext -> SDoc
+badDotDot ctxt = ptext (sLit "You cannot use `..' in a record") <+> pprRFC ctxt
 
 badPun :: Located RdrName -> SDoc
 badPun fld = vcat [ptext (sLit "Illegal use of punning for field") <+> quotes (ppr fld),
 		   ptext (sLit "Use -XNamedFieldPuns to permit this")]
 
+dupFieldErr :: HsRecFieldContext -> [RdrName] -> SDoc
+dupFieldErr ctxt dups
+  = hsep [ptext (sLit "duplicate field name"), 
+          quotes (ppr (head dups)),
+	  ptext (sLit "in record"), pprRFC ctxt]
 
--- wrappers
-rnHsRecFieldsAndThen_Pattern :: Located Name
-                             -> NameMaker -- new name maker
-                             -> HsRecFields RdrName (LPat RdrName)  
-                             -> (HsRecFields Name (LPat Name) -> RnM (c, FreeVars)) 
-                             -> RnM (c, FreeVars)
-rnHsRecFieldsAndThen_Pattern n var
-  = rnHsRecFieldsAndThen (Pattern n VarPat) (rnLPatAndThen var)
-
-
--- wrapper to use rnLExpr in CPS style;
--- because it does not bind any vars going forward, it does not need
--- to be written that way
-rnLExprAndThen :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
-               -> LHsExpr RdrName 
-               -> (LHsExpr Name -> RnM (c, FreeVars)) 
-               -> RnM (c, FreeVars) 
-rnLExprAndThen f e cont = do { (x, fvs1) <- f e
-			     ; (res, fvs2) <- cont x
-			     ; return (res, fvs1 `plusFV` fvs2) }
-
-
--- non-CPSed because exprs don't leave anything bound
-rnHsRecFields_Con :: Located Name
-                  -> (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
-                  -> HsRecFields RdrName (LHsExpr RdrName)  
-                  -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
-rnHsRecFields_Con n rnLExpr fields = rnHsRecFieldsAndThen (Constructor n HsVar) 
-                                     (rnLExprAndThen rnLExpr) fields $ \ res ->
-				     return (res, emptyFVs)
-
-rnHsRecFields_Update :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
-                     -> HsRecFields RdrName (LHsExpr RdrName)  
-                     -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
-rnHsRecFields_Update rnLExpr fields = rnHsRecFieldsAndThen Update
-                                      (rnLExprAndThen rnLExpr) fields $ \ res -> 
-				      return (res, emptyFVs)
+pprRFC :: HsRecFieldContext -> SDoc
+pprRFC (HsRecFieldCon {}) = ptext (sLit "construction")
+pprRFC (HsRecFieldPat {}) = ptext (sLit "pattern")
+pprRFC (HsRecFieldUpd {}) = ptext (sLit "update")
 \end{code}
 
 
-
 %************************************************************************
 %*									*
 \subsubsection{Literals}
@@ -517,29 +557,6 @@ rnOverLit lit@(OverLit {ol_val=val})
 		      , ol_rebindable = rebindable }, fvs) }
 \end{code}
 
-----------------------------------------------------------------
--- Old code returned extra free vars need in desugarer
--- but that is no longer necessary, I believe
---     if inIntRange i then
---        return (HsIntegral i from_integer_name placeHolderType, 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.]
-
--- (HsFractional i _ _) = do
---	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)
-
 %************************************************************************
 %*									*
 \subsubsection{Quasiquotation}
@@ -552,8 +569,8 @@ See Note [Quasi-quote overview] in TcSplice.
 rnQuasiQuote :: HsQuasiQuote RdrName -> RnM (HsQuasiQuote Name, FreeVars)
 rnQuasiQuote (HsQuasiQuote n quoter quoteSpan quote)
   = do	{ loc  <- getSrcSpanM
-   	; [n'] <- newLocalsRn [L loc n]
-   	; quoter' <-  (lookupOccRn quoter)
+   	; n' <- newLocalBndrRn (L loc n)
+   	; quoter' <- lookupOccRn quoter
 		-- If 'quoter' is not in scope, proceed no further
 		-- Otherwise lookupOcc adds an error messsage and returns 
 		-- an "unubound name", which makes the subsequent attempt to
@@ -582,12 +599,6 @@ patSigErr ty
   =  (ptext (sLit "Illegal signature in pattern:") <+> ppr ty)
 	$$ nest 4 (ptext (sLit "Use -XScopedTypeVariables to permit it"))
 
-dupFieldErr :: String -> RdrName -> SDoc
-dupFieldErr str dup
-  = hsep [ptext (sLit "duplicate field name"), 
-          quotes (ppr dup),
-	  ptext (sLit "in record"), text str]
-
 bogusCharError :: Char -> SDoc
 bogusCharError c
   = ptext (sLit "character literal out of range: '\\") <> char c  <> char '\''
@@ -595,5 +606,4 @@ bogusCharError c
 badViewPat :: Pat RdrName -> SDoc
 badViewPat pat = vcat [ptext (sLit "Illegal view pattern: ") <+> ppr pat,
                        ptext (sLit "Use -XViewPatterns to enable view patterns")]
-
 \end{code}
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 86873b0223..bbf4938776 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -21,11 +21,10 @@ import RnBinds		( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSig
                                 makeMiniFixityEnv)
 import RnEnv		( lookupLocalDataTcNames, lookupLocatedOccRn,
 			  lookupTopBndrRn, lookupLocatedTopBndrRn,
-			  lookupOccRn, newLocalsRn, 
+			  lookupOccRn, newLocalBndrsRn, 
 			  bindLocatedLocalsFV, bindPatSigTyVarsFV,
 			  bindTyVarsRn, extendTyVarEnvFVRn,
-			  bindLocalNames, checkDupRdrNames, mapFvRn,
-			  checkM
+			  bindLocalNames, checkDupRdrNames, mapFvRn
 			)
 import RnNames       	( getLocalNonValBinders, extendGlobalRdrEnvRn )
 import HscTypes      	( GenAvailInfo(..), availsToNameSet )
@@ -779,7 +778,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
 		-- No need to check for duplicate method signatures
 		-- since that is done by RnNames.extendGlobalRdrEnvRn
 		-- and the methods are already in scope
-	    ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
+	    ; gen_tyvars <- newLocalBndrsRn gen_rdr_tyvars_w_locs
 	    ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
 
   -- Haddock docs 
@@ -945,7 +944,7 @@ rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
     rn_at (tydecl@TyFamily  {}) = rnFamily tydecl lookupIdxVars
     rn_at (tydecl@TySynonym {}) = 
       do
-        checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
+        unless (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
         rnTyClDecl tydecl
     rn_at _                      = panic "RnSource.rnATs: invalid TyClDecl"
 
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index 3086b946d3..61c039cc22 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -159,7 +159,7 @@ rnHsType doc (HsListTy ty) = do
 
 rnHsType doc (HsKindSig ty k)
   = do { kind_sigs_ok <- doptM Opt_KindSignatures
-       ; checkM kind_sigs_ok (addErr (kindSigErr ty))
+       ; unless kind_sigs_ok (addErr (kindSigErr ty))
        ; ty' <- rnLHsType doc ty
        ; return (HsKindSig ty' k) }
 
@@ -610,7 +610,7 @@ rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
 rnSplice (HsSplice n expr)
   = do	{ checkTH expr "splice"
 	; loc  <- getSrcSpanM
-	; [n'] <- newLocalsRn [L loc n]
+	; n' <- newLocalBndrRn (L loc n)
 	; (expr', fvs) <- rnLExpr expr
 
 	-- Ugh!  See Note [Splices] above
diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index 055fc2cf88..df6eac119c 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -337,7 +337,7 @@ tcExtendTyVarEnv2 binds thing_inside = do
                    tcl_tyvars = gtvs,
                    tcl_rdr = rdr_env}) <- getLclEnv
     let
-	rdr_env'   = extendLocalRdrEnv rdr_env (map fst binds)
+	rdr_env'   = extendLocalRdrEnvList rdr_env (map fst binds)
 	new_tv_set = tcTyVarsOfTypes (map snd binds)
  	le'        = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
 
@@ -408,7 +408,7 @@ tc_extend_local_id_env env th_lvl names_w_ids thing_inside
 						  _        -> Wobbly})
     		      | (name,id) <- names_w_ids, let id_ty = idType id]
     le'		    = extendNameEnvList (tcl_env env) extra_env
-    rdr_env'	    = extendLocalRdrEnv (tcl_rdr env) [name | (name,_) <- names_w_ids]
+    rdr_env'	    = extendLocalRdrEnvList (tcl_rdr env) [name | (name,_) <- names_w_ids]
 \end{code}
 
 
diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 5a54f8dc8f..8c73fa9708 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -628,7 +628,7 @@ tcConPat pstate con_span data_con tycon pat_ty arg_pats thing_inside
                                                    unwrap_ty res_pat
 
 	  -- Add the stupid theta
-	; addDataConStupidTheta data_con ctxt_res_tys
+	; setSrcSpan con_span $ addDataConStupidTheta data_con ctxt_res_tys
 
 	; ex_tvs' <- tcInstSkolTyVars skol_info ex_tvs	
                      -- Get location from monad, not from ex_tvs