From 9c26739695219d8343505a88457cb55c76b65449 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 18 Jun 1997 23:53:03 +0000
Subject: [PATCH] [project @ 1997-06-18 23:52:36 by simonpj] A raft of small
 bug-fixes to 2.05 by SLPJ

---
 ghc/compiler/absCSyn/PprAbsC.lhs                   |    4 +-
 ghc/compiler/basicTypes/Name.lhs                   |    9 ++-
 ghc/compiler/hsSyn/HsBinds.lhs                     |   18 +++--
 ghc/compiler/hsSyn/HsTypes.lhs                     |   23 ++-----
 ghc/compiler/main/Main.lhs                         |    2 +-
 ghc/compiler/nativeGen/MachRegs.lhs                |    1 +
 ghc/compiler/parser/hsparser.y                     |   12 ++--
 ghc/compiler/reader/RdrHsSyn.lhs                   |   14 +++-
 ghc/compiler/rename/RnEnv.lhs                      |   71 +++++++++++++-------
 ghc/compiler/rename/RnMonad.lhs                    |   11 ++-
 ghc/compiler/rename/RnNames.lhs                    |   44 +++++-------
 ghc/compiler/rename/RnSource.lhs                   |   69 ++++++++++---------
 ghc/compiler/tests/rename/rn019.hs                 |    4 ++
 ghc/compiler/tests/rename/rn020.hs                 |   11 +++
 ghc/compiler/tests/rename/rn021.hs                 |   17 +++++
 .../tests/typecheck/should_fail/tcfail072.hs       |   24 +++++++
 .../tests/typecheck/should_succeed/Makefile        |    3 +-
 .../tests/typecheck/should_succeed/tc086.hs        |   60 +++++++++++++++++
 .../tests/typecheck/should_succeed/tc087.hs        |   32 +++++++++
 .../tests/typecheck/should_succeed/tc088.hs        |   18 +++++
 ghc/compiler/typecheck/Inst.lhs                    |    7 +-
 ghc/compiler/typecheck/TcInstDcls.lhs              |    2 +-
 ghc/compiler/typecheck/TcMatches.lhs               |   39 +++++++++--
 ghc/compiler/utils/FiniteMap.lhs                   |    1 +
 24 files changed, 362 insertions(+), 134 deletions(-)
 create mode 100644 ghc/compiler/tests/rename/rn019.hs
 create mode 100644 ghc/compiler/tests/rename/rn020.hs
 create mode 100644 ghc/compiler/tests/rename/rn021.hs
 create mode 100644 ghc/compiler/tests/typecheck/should_fail/tcfail072.hs
 create mode 100644 ghc/compiler/tests/typecheck/should_succeed/tc086.hs
 create mode 100644 ghc/compiler/tests/typecheck/should_succeed/tc087.hs
 create mode 100644 ghc/compiler/tests/typecheck/should_succeed/tc088.hs

diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index 6d4f3ba..3454645 100644
--- a/ghc/compiler/absCSyn/PprAbsC.lhs
+++ b/ghc/compiler/absCSyn/PprAbsC.lhs
@@ -954,7 +954,7 @@ ppr_amode sty (CAddr reg_rel)
 
 ppr_amode sty (CReg magic_id) = pprMagicId sty magic_id
 
-ppr_amode sty (CTemp uniq kind) = pprUnique uniq
+ppr_amode sty (CTemp uniq kind) = pprUnique uniq <> char '_'
 
 ppr_amode sty (CLbl label kind) = pprCLabel sty label
 
@@ -1214,7 +1214,7 @@ labelSeenTE label env@(seen_uniqs, seen_labels)
 \begin{code}
 pprTempDecl :: Unique -> PrimRep -> Doc
 pprTempDecl uniq kind
-  = hcat [ pprPrimKind PprDebug kind, space, pprUnique uniq, semi ]
+  = hcat [ pprPrimKind PprDebug kind, space, pprUnique uniq, ptext SLIT("_;") ]
 
 pprExternDecl :: CLabel -> PrimRep -> Doc
 
diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index 89fe135..198fc42 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -256,9 +256,12 @@ mkInstDeclName uniq mod occ loc from_here
          | otherwise = Implicit
 
 
-setNameProvenance :: Name -> Provenance -> Name		-- Implicit Globals only
-setNameProvenance (Global uniq mod occ def Implicit) prov = Global uniq mod occ def prov
-setNameProvenance other_name 			     prov = other_name
+setNameProvenance :: Name -> Provenance -> Name	
+	-- setNameProvenance used to only change the provenance of Implicit-provenance things,
+	-- but that gives bad error messages for names defined twice in the same
+	-- module, so I changed it to set the proveance of *any* global (SLPJ Jun 97)
+setNameProvenance (Global uniq mod occ def _) prov = Global uniq mod occ def prov
+setNameProvenance other_name 		      prov = other_name
 
 getNameProvenance :: Name -> Provenance
 getNameProvenance (Global uniq mod occ def prov) = prov
diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs
index 1f32b3e..f28cff8 100644
--- a/ghc/compiler/hsSyn/HsBinds.lhs
+++ b/ghc/compiler/hsSyn/HsBinds.lhs
@@ -261,27 +261,25 @@ instance (NamedThing name, Outputable name) => Outputable (Sig name) where
 
 
 ppr_sig sty (Sig var ty _)
-      = hang (hsep [ppr sty var, ptext SLIT("::")])
-	     4 (ppr sty ty)
+      = sep [ppr sty var <+> ptext SLIT("::"),
+	     nest 4 (ppr sty ty)]
 
 ppr_sig sty (ClassOpSig var _ ty _)
-      = hang (hsep [ppr sty (getOccName var), ptext SLIT("::")])
-	     4 (ppr sty ty)
+      = sep [ppr sty (getOccName var) <+> ptext SLIT("::"),
+	     nest 4 (ppr sty ty)]
 
 ppr_sig sty (DeforestSig var _)
-      = hang (hsep [text "{-# DEFOREST", ppr sty var])
-		   4 (text "#-")
+      = hsep [text "{-# DEFOREST", ppr sty var, text "#-}"]
 
 ppr_sig sty (SpecSig var ty using _)
-      = hang (hsep [text "{-# SPECIALIZE", ppr sty var, ptext SLIT("::")])
-	     4 (hsep [ppr sty ty, pp_using using, text "#-}"])
-
+      = sep [ hsep [text "{-# SPECIALIZE", ppr sty var, ptext SLIT("::")],
+	      nest 4 (hsep [ppr sty ty, pp_using using, text "#-}"])
+	]
       where
 	pp_using Nothing   = empty
 	pp_using (Just me) = hsep [char '=', ppr sty me]
 
 ppr_sig sty (InlineSig var _)
-
         = hsep [text "{-# INLINE", ppr sty var, text "#-}"]
 
 ppr_sig sty (MagicUnfoldingSig var str _)
diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index 25c1999..b83f4b8 100644
--- a/ghc/compiler/hsSyn/HsTypes.lhs
+++ b/ghc/compiler/hsSyn/HsTypes.lhs
@@ -24,7 +24,7 @@ module HsTypes (
 IMP_Ubiq()
 
 import CmdLineOpts      ( opt_PprUserLength )
-import Outputable	( Outputable(..), PprStyle(..), interppSP, ifnotPprForUser )
+import Outputable	( Outputable(..), PprStyle(..), pprQuote, interppSP )
 import Kind		( Kind {- instance Outputable -} )
 import Name		( nameOccName )
 import Pretty
@@ -100,20 +100,12 @@ replaceTyVarName (IfaceTyVar n k) n' = IfaceTyVar n' k
 \begin{code}
 
 instance (Outputable name) => Outputable (HsType name) where
-    ppr = pprHsType
+    ppr sty ty = pprQuote sty $ \ sty -> pprHsType sty ty
 
 instance (Outputable name) => Outputable (HsTyVar name) where
-    ppr sty (UserTyVar name) = ppr_hs_tyname sty name
-    ppr sty (IfaceTyVar name kind) = hsep [ppr_hs_tyname sty name, ptext SLIT("::"), ppr sty kind]
-
-
--- Here comes a rather gross hack.  
--- We want to print data and class decls in interface files, from the original source
--- When we do, we want the type variables to come out with their original names, not
--- some new unique (or else interfaces wobble too much).  So when we come to one of
--- these type variables we sneakily change the style to PprForUser!
-ppr_hs_tyname PprInterface tv_name = ppr (PprForUser opt_PprUserLength) tv_name
-ppr_hs_tyname other_sty    tv_name = ppr other_sty tv_name
+    ppr sty (UserTyVar name)       = ppr sty name
+    ppr sty (IfaceTyVar name kind) = pprQuote sty $ \ sty ->
+				     hsep [ppr sty name, ptext SLIT("::"), ppr sty kind]
 
 ppr_forall sty ctxt_prec [] [] ty
    = ppr_mono_ty sty ctxt_prec ty
@@ -150,7 +142,7 @@ pprParendHsType sty ty = ppr_mono_ty sty pREC_CON ty
 ppr_mono_ty sty ctxt_prec (HsPreForAllTy ctxt ty)     = ppr_forall sty ctxt_prec [] ctxt ty
 ppr_mono_ty sty ctxt_prec (HsForAllTy tvs ctxt ty)    = ppr_forall sty ctxt_prec tvs ctxt ty
 
-ppr_mono_ty sty ctxt_prec (MonoTyVar name) = ppr_hs_tyname sty name
+ppr_mono_ty sty ctxt_prec (MonoTyVar name) = ppr sty name
 
 ppr_mono_ty sty ctxt_prec (MonoFunTy ty1 ty2)
   = let p1 = ppr_mono_ty sty pREC_FUN ty1
@@ -170,8 +162,7 @@ ppr_mono_ty sty ctxt_prec (MonoTyApp fun_ty arg_ty)
 	       (hsep [ppr_mono_ty sty pREC_FUN fun_ty, ppr_mono_ty sty pREC_CON arg_ty])
 
 ppr_mono_ty sty ctxt_prec (MonoDictTy clas ty)
-  = braces (hsep [ppr sty clas, ppr_mono_ty sty pREC_CON ty])
-	-- Curlies are temporary
+  = hsep [ppr sty clas, ppr_mono_ty sty pREC_CON ty]
 \end{code}
 
 
diff --git a/ghc/compiler/main/Main.lhs b/ghc/compiler/main/Main.lhs
index afd2617..2ed03b4 100644
--- a/ghc/compiler/main/Main.lhs
+++ b/ghc/compiler/main/Main.lhs
@@ -74,7 +74,7 @@ main =
 doIt :: ([CoreToDo], [StgToDo]) -> String -> IO ()
 
 doIt (core_cmds, stg_cmds) input_pgm
-  = doDump opt_Verbose "Glasgow Haskell Compiler, version 2.03, for Haskell 1.4" "" >>
+  = doDump opt_Verbose "Glasgow Haskell Compiler, version 2.04, for Haskell 1.4" "" >>
 
     -- ******* READER
     show_pass "Reader"	>>
diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs
index 5beabc1..a2af742 100644
--- a/ghc/compiler/nativeGen/MachRegs.lhs
+++ b/ghc/compiler/nativeGen/MachRegs.lhs
@@ -80,6 +80,7 @@ import Unique		( mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
 			  Unique{-instance Ord3-}
 			)
 import UniqSupply	( getUnique, returnUs, thenUs, SYN_IE(UniqSM) )
+import UniqFM		( Uniquable(..) )
 import Util		( panic, Ord3(..) )
 \end{code}
 
diff --git a/ghc/compiler/parser/hsparser.y b/ghc/compiler/parser/hsparser.y
index 5203c1e..58db2df 100644
--- a/ghc/compiler/parser/hsparser.y
+++ b/ghc/compiler/parser/hsparser.y
@@ -475,12 +475,12 @@ topdecls:  topdecl
 		}
         ;
 
-topdecl	:  typed				{ $$ = $1; }
-	|  datad 				{ $$ = $1; }
-	|  newtd				{ $$ = $1; }
-	|  classd 				{ $$ = $1; }
-	|  instd 				{ $$ = $1; }
-	|  defaultd 				{ $$ = $1; }
+topdecl	:  typed				{ $$ = $1; FN = NULL; SAMEFN = 0; }
+	|  datad 				{ $$ = $1; FN = NULL; SAMEFN = 0; }
+	|  newtd				{ $$ = $1; FN = NULL; SAMEFN = 0; }
+	|  classd 				{ $$ = $1; FN = NULL; SAMEFN = 0; }
+	|  instd 				{ $$ = $1; FN = NULL; SAMEFN = 0; }
+	|  defaultd 				{ $$ = $1; FN = NULL; SAMEFN = 0; }
 	|  decl 				{ $$ = $1; }
 	;
 
diff --git a/ghc/compiler/reader/RdrHsSyn.lhs b/ghc/compiler/reader/RdrHsSyn.lhs
index f7d4e92..9f4aa00 100644
--- a/ghc/compiler/reader/RdrHsSyn.lhs
+++ b/ghc/compiler/reader/RdrHsSyn.lhs
@@ -124,9 +124,17 @@ extractHsTyVars ty
     get (MonoFunTy ty1 ty2)	 acc = get ty1 (get ty2 acc)
     get (MonoDictTy cls ty)	 acc = get ty acc
     get (MonoTyVar tv) 	         acc = insert tv acc
-    get (HsPreForAllTy ctxt ty)  acc = foldr (get . snd) (get ty acc) ctxt
-    get (HsForAllTy tvs ctxt ty) acc = filter (`notElem` locals) $
-				       foldr (get . snd) (get ty acc) ctxt
+
+	-- In (All a => a -> a) -> Int, there are no free tyvars
+	-- We just assume that we quantify over all type variables mentioned in the context.
+    get (HsPreForAllTy ctxt ty)  acc = filter (`notElem` locals) (get ty [])
+				       ++ acc
+				     where
+				       locals = foldr (get . snd) [] ctxt
+
+    get (HsForAllTy tvs ctxt ty) acc = (filter (`notElem` locals) $
+				        foldr (get . snd) (get ty []) ctxt)
+				       ++ acc
 				     where
 				       locals = map getTyVarName tvs
 
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 2844c72..d926583 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -31,7 +31,7 @@ import TysWiredIn	( tupleTyCon, listTyCon, charTyCon, intTyCon )
 import FiniteMap
 import Outputable
 import Unique		( Unique, unboundKey )
-import UniqFM           ( Uniquable(..) )
+import UniqFM           ( Uniquable(..), listToUFM, plusUFM_C )
 import Maybes		( maybeToBool )
 import UniqSupply
 import SrcLoc		( SrcLoc, noSrcLoc )
@@ -88,26 +88,29 @@ newLocallyDefinedGlobalName mod occ rec_exp_fn loc
 	-- If it's not in the cache we put it there with the correct provenance.
 	-- The idea is that, after all this, the cache
 	-- will contain a Name with the correct Provenance (i.e. Local)
+
+	-- OLD (now wrong) COMMENT:
+	--   "Actually, there's a catch.  If this is the *second* binding for something
+	--    we want to allocate a *fresh* unique, rather than using the same Name as before.
+	--    Otherwise we don't detect conflicting definitions of the same top-level name!
+	--    So the only time we re-use a Name already in the cache is when it's one of
+	--    the Implicit magic-unique ones mentioned in the previous para"
+
+	-- This (incorrect) patch doesn't work for record decls, when we have
+	-- the same field declared in multiple constructors.   With the above patch,
+	-- each occurrence got a new Name --- aargh!
 	--
-	-- Actually, there's a catch.  If this is the *second* binding for something
-	-- we want to allocate a *fresh* unique, rather than using the same Name as before.
-	-- Otherwise we don't detect conflicting definitions of the same top-level name!
-	-- So the only time we re-use a Name already in the cache is when it's one of
-	-- the Implicit magic-unique ones mentioned in the previous para
+	-- So I reverted to the simple caching method (no "second-binding" thing)
+	-- The multiple-local-binding case is now handled by improving the conflict
+	-- detection in plusNameEnv.
     let
 	provenance = LocalDef (rec_exp_fn new_name) loc
 	(us', us1) = splitUniqSupply us
 	uniq   	   = getUnique us1
         key        = (mod,occ)
 	new_name   = case lookupFM cache key of
-		         Just name | is_implicit_prov
-				   -> setNameProvenance name provenance
-				   where
-				      is_implicit_prov = case getNameProvenance name of
-							    Implicit -> True
-							    other    -> False
-		         other   -> mkGlobalName uniq mod occ VanillaDefn provenance
-
+		         Just name -> setNameProvenance name provenance
+		         other     -> mkGlobalName uniq mod occ VanillaDefn provenance
 	new_cache  = addToFM cache key new_name
     in
     setNameSupplyRn (us', inst_ns, new_cache)		`thenRn_`
@@ -358,17 +361,28 @@ plusRnEnv (RnEnv n1 f1) (RnEnv n2 f2)
 ===============  NameEnv  ================
 \begin{code}
 plusNameEnvRn :: NameEnv -> NameEnv -> RnM s d NameEnv
-plusNameEnvRn n1 n2
-  = mapRn (addErrRn.nameClashErr) (conflictsFM (/=) n1 n2)		`thenRn_`
-    returnRn (n1 `plusFM` n2)
+plusNameEnvRn env1 env2
+  = mapRn (addErrRn.nameClashErr) (conflictsFM conflicting_name env1 env2)		`thenRn_`
+    returnRn (env1 `plusFM` env2)
 
 addOneToNameEnv :: NameEnv -> RdrName -> Name -> RnM s d NameEnv
 addOneToNameEnv env rdr_name name
  = case lookupFM env rdr_name of
-	Nothing    -> returnRn (addToFM env rdr_name name)
-	Just name2 -> addErrRn (nameClashErr (rdr_name, (name, name2)))	`thenRn_`
+	Just name2 | conflicting_name name name2
+		   -> addErrRn (nameClashErr (rdr_name, (name, name2)))	`thenRn_`
 		      returnRn env
 
+	Nothing    -> returnRn (addToFM env rdr_name name)
+
+conflicting_name n1 n2 = (n1 /= n2) || (isLocallyDefinedName n1 && isLocallyDefinedName n2)
+	-- We complain of a conflict if one RdrName maps to two different Names,
+	-- OR if one RdrName maps to the same *locally-defined* Name.  The latter
+	-- case is to catch two separate, local definitions of the same thing.
+	--
+	-- If a module imports itself then there might be a local defn and an imported
+	-- defn of the same name; in this case the names will compare as equal, but
+	-- will still have different provenances.
+
 lookupNameEnv :: NameEnv -> RdrName -> Maybe Name
 lookupNameEnv = lookupFM
 
@@ -400,13 +414,20 @@ pprFixityProvenance sty (fixity, prov) = pprProvenance sty prov
 
 ===============  Avails  ================
 \begin{code}
-emptyModuleAvails :: ModuleAvails
-plusModuleAvails ::  ModuleAvails ->  ModuleAvails ->  ModuleAvails
-lookupModuleAvails :: ModuleAvails -> Module -> Maybe [AvailInfo]
+mkExportAvails :: Bool -> Module -> [AvailInfo] -> ExportAvails
+mkExportAvails unqualified_import mod_name avails
+  = (mod_avail_env, entity_avail_env)
+  where
+	-- The "module M" syntax only applies to *unqualified* imports (1.4 Report, Section 5.1.1)
+    mod_avail_env | unqualified_import = unitFM mod_name avails 
+		  | otherwise	       = emptyFM
+   
+    entity_avail_env = listToUFM [ (name,avail) | avail <- avails, 
+			  	   		  name  <- availEntityNames avail]
 
-emptyModuleAvails = emptyFM
-plusModuleAvails  = plusFM_C (++)
-lookupModuleAvails = lookupFM
+plusExportAvails ::  ExportAvails ->  ExportAvails ->  ExportAvails
+plusExportAvails (m1, e1) (m2, e2)
+  = (plusFM_C (++) m1 m2, plusUFM_C plusAvail e1 e2)
 \end{code}
 
 
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index f1d6f45..dcdc718 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -55,6 +55,7 @@ import Pretty
 import Outputable	( PprStyle(..) )
 import SrcLoc		( SrcLoc, mkGeneratedSrcLoc )
 import Unique		( Unique )
+import UniqFM		( UniqFM )
 import FiniteMap	( FiniteMap, emptyFM, bagToFM )
 import Bag		( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
 import UniqSet
@@ -185,7 +186,15 @@ type Fixities		= [(OccName, (Fixity, Provenance))]
 	-- or the same type/class/id, more than once.   Hence a boring old list.
 	-- This allows us to report duplicates in just one place, namely plusRnEnv.
 	
-type ModuleAvails	= FiniteMap Module Avails
+type ExportAvails	= (FiniteMap Module Avails,	-- Used to figure out "module M" export specifiers
+							-- Includes avails only from *unqualified* imports
+							-- (see 1.4 Report Section 5.1.1)
+
+			   UniqFM AvailInfo)		-- Used to figure out all other export specifiers.
+							-- Maps a Name to the AvailInfo that contains it
+							-- NB: Contain bindings for class ops but 
+							-- not constructors (see defn of availEntityNames)
+
 
 data AvailInfo		= NotAvailable 
 			| Avail Name		-- An ordinary identifier
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index beca595..4e745f1 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -72,13 +72,13 @@ getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
       else
 
 	-- COMBINE RESULTS
-	-- We put the local env first, so that a local provenance
+	-- We put the local env second, so that a local provenance
 	-- "wins", even if a module imports itself.
       foldlRn plusRnEnv emptyRnEnv imp_rn_envs		`thenRn` \ imp_rn_env ->
-      plusRnEnv local_rn_env imp_rn_env	 		`thenRn` \ rn_env ->
+      plusRnEnv imp_rn_env local_rn_env	 		`thenRn` \ rn_env ->
       let
-	 all_avails :: ModuleAvails
-	 all_avails = foldr plusModuleAvails local_mod_avails imp_avails_s
+	 export_avails :: ExportAvails
+	 export_avails = foldr plusExportAvails local_mod_avails imp_avails_s
 
 	 explicit_names :: NameSet 	-- locally defined or explicitly imported
 	 explicit_names = foldr add_on emptyNameSet (local_avails : explicit_imports_s)
@@ -86,7 +86,7 @@ getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
       in
   
 	-- PROCESS EXPORT LISTS
-      exportsFromAvail this_mod exports all_avails rn_env	
+      exportsFromAvail this_mod exports export_avails rn_env	
 							`thenRn` \ (export_fn, export_env) ->
 
 	-- RECORD THAT LOCALLY DEFINED THINGS ARE AVAILABLE
@@ -145,7 +145,7 @@ checkEarlyExit mod
 
 \begin{code}
 importsFromImportDecl :: RdrNameImportDecl
-		      -> RnMG (RnEnv, ModuleAvails, [AvailInfo])
+		      -> RnMG (RnEnv, ExportAvails, [AvailInfo])
 
 importsFromImportDecl (ImportDecl mod qual_only as_source as_mod import_spec loc)
   = pushSrcLocRn loc $
@@ -277,7 +277,7 @@ qualifyImports :: Module				-- Imported module
 	       -> Maybe Module				-- Optional "as M" part 
 	       -> ExportEnv				-- What's imported
 	       -> [AvailInfo]				-- What's to be hidden
-	       -> RnMG (RnEnv, ModuleAvails)
+	       -> RnMG (RnEnv, ExportAvails)
 
 qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities) hides
   = 
@@ -292,11 +292,10 @@ qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities) h
 	-- Create the fixity env
 	fixity_env = foldl (add_fixity name_env2) emptyFixityEnv fixities
 
-	-- The "module M" syntax only applies to *unqualified* imports (1.4 Report, Section 5.1.1)
-	mod_avail_env | unqual_imp = unitFM qual_mod avails
-		      | otherwise  = emptyFM
+	-- Create the export-availability info
+	export_avails = mkExportAvails unqual_imp qual_mod avails
     in
-    returnRn (RnEnv name_env2 fixity_env, mod_avail_env)
+    returnRn (RnEnv name_env2 fixity_env, export_avails)
   where
     qual_mod = case as_mod of
 		  Nothing  	    -> this_mod
@@ -395,15 +394,17 @@ includes ConcBase.StateAndSynchVar#, and so on...
 \begin{code}
 exportsFromAvail :: Module
 		 -> Maybe [RdrNameIE]	-- Export spec
-		 -> ModuleAvails
+		 -> ExportAvails
 		 -> RnEnv
 		 -> RnMG (Name -> ExportFlag, ExportEnv)
 	-- Complains if two distinct exports have same OccName
 	-- Complains about exports items not in scope
-exportsFromAvail this_mod Nothing all_avails rn_env
-  = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) all_avails rn_env
+exportsFromAvail this_mod Nothing export_avails rn_env
+  = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) export_avails rn_env
 
-exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_env)
+exportsFromAvail this_mod (Just export_items) 
+		 (mod_avail_env, entity_avail_env)
+	         (RnEnv name_env fixity_env)
   = mapRn exports_from_item export_items 		`thenRn` \ avail_envs ->
     foldlRn plusAvailEnv emptyAvailEnv avail_envs	`thenRn` \ export_avail_env -> 
     let
@@ -414,18 +415,9 @@ exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_
     returnRn (export_fn, ExportEnv export_avails export_fixities)
 
   where
-    full_avail_env :: UniqFM AvailInfo
-    full_avail_env = addListToUFM_C plusAvail emptyUFM
-			   [(name, avail) | avail <- concat (eltsFM all_avails),
-					    name  <- availEntityNames avail 
-			   ]
-
-	-- NB: full_avail_env will contain bindings for class ops but not constructors
-	-- (see defn of availEntityNames)
-
     exports_from_item :: RdrNameIE -> RnMG AvailEnv
     exports_from_item ie@(IEModuleContents mod)
-	= case lookupFM all_avails mod of
+	= case lookupFM mod_avail_env mod of
 		Nothing	    -> failWithRn emptyAvailEnv (modExportErr mod)
 		Just avails -> listToAvailEnv ie avails
 
@@ -449,7 +441,7 @@ exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_
        where
           maybe_in_scope  = lookupNameEnv name_env (ieName ie)
 	  Just name	  = maybe_in_scope
-	  maybe_avail     = lookupUFM full_avail_env name
+	  maybe_avail     = lookupUFM entity_avail_env name
 	  Just avail      = maybe_avail
  	  export_avail    = filterAvail ie avail
 	  enough_avail	  = case export_avail of {NotAvailable -> False; other -> True}
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 7affaf0..ff3620e 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -57,8 +57,8 @@ import SrcLoc		( SrcLoc )
 import Unique		( Unique )
 import UniqSet		( SYN_IE(UniqSet) )
 import UniqFM		( UniqFM, lookupUFM )
-import Util	{-	( isIn, isn'tIn, thenCmp, removeDups, cmpPString,
-			  panic, assertPanic{- , pprTrace ToDo:rm-} ) -}
+import Util
+IMPORT_1_3(List(nub))
 \end{code}
 
 rnDecl `renames' declarations.
@@ -213,11 +213,6 @@ rnDecl (ClD (ClassDecl context cname tyvar sigs mbinds pragmas src_loc))
 	        (classTyVarNotInOpTyErr clas_tyvar sig)
 							 `thenRn_`
 
-		-- Check that class tyvar *doesn't* appear in the sig's context
-        checkRn (not (clas_tyvar `elemNameSet` ctxt_fvs))
-		(classTyVarInOpCtxtErr clas_tyvar sig)
-							 `thenRn_`
-
 	returnRn (ClassOpSig op_name dm_name new_ty locn)
 \end{code}
 
@@ -398,25 +393,34 @@ rnHsSigType :: (PprStyle -> Doc) -> RdrNameHsType -> RnMS s RenamedHsType
 	-- rnHsSigType is used for source-language type signatures,
 	-- which use *implicit* universal quantification.
 
+-- Given the signature  C => T  we universally quantify over FV(T) \ {in-scope-tyvars} 
+-- 
+-- We insist that the universally quantified type vars is a superset of FV(C)
+-- It follows that FV(T) is a superset of FV(C), so that the context constrains
+-- no type variables that don't appear free in the tau-type part.
+
 rnHsSigType doc_str full_ty@(HsPreForAllTy ctxt ty)	-- From source code (no kinds on tyvars)
   = getNameEnv		`thenRn` \ name_env ->
     let
-	mentioned_tyvars = extractHsTyVars full_ty
-	forall_tyvars    = filter not_in_scope mentioned_tyvars
-	not_in_scope tv  = case lookupFM name_env tv of
-				    Nothing -> True
-				    Just _  -> False
-
-	non_foralld_constrained = [tv | (clas, ty) <- ctxt,
-					tv <- extractHsTyVars ty,
-					not (tv `elem` forall_tyvars)
-				  ]
+	mentioned_tyvars = extractHsTyVars ty
+	forall_tyvars    = filter (not . in_scope) mentioned_tyvars
+	in_scope tv      = maybeToBool (lookupFM name_env tv)
+
+	constrained_tyvars 	      = nub (concat (map (extractHsTyVars . snd) ctxt))
+	constrained_and_in_scope      = filter in_scope constrained_tyvars
+	constrained_and_not_mentioned = filter (not . (`elem` mentioned_tyvars)) constrained_tyvars
+
+	-- Zap the context if there's a problem, to avoid duplicate error message.
+	ctxt' | null constrained_and_in_scope && null constrained_and_not_mentioned = ctxt
+	      | otherwise = []
     in
-    checkRn (null non_foralld_constrained)
-	    (ctxtErr sig_doc non_foralld_constrained)	`thenRn_`
+    checkRn (null constrained_and_in_scope)
+	    (ctxtErr1 sig_doc constrained_and_in_scope)	`thenRn_`
+    checkRn (null constrained_and_not_mentioned)
+	    (ctxtErr2 sig_doc constrained_and_not_mentioned ty)	`thenRn_`
 
     (bindTyVarsRn sig_doc (map UserTyVar forall_tyvars)	$ \ new_tyvars ->
-     rnContext ctxt					`thenRn` \ new_ctxt ->
+     rnContext ctxt'					`thenRn` \ new_ctxt ->
      rnHsType ty					`thenRn` \ new_ty ->
      returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
     )
@@ -693,17 +697,12 @@ rnCorePrim (UfCCallOp str casm gc arg_tys res_ty)
 
 \begin{code}
 derivingNonStdClassErr clas sty
-  = hsep [ptext SLIT("non-standard class in deriving:"), ppr sty clas]
+  = hsep [ptext SLIT("non-standard class"), ppr sty clas, ptext SLIT("in deriving clause")]
 
 classTyVarNotInOpTyErr clas_tyvar sig sty
-  = hang (hcat [ptext SLIT("Class type variable `"), 
+  = hang (hsep [ptext SLIT("Class type variable"), 
 		       ppr sty clas_tyvar, 
-		       ptext SLIT("' does not appear in method signature:")])
-	 4 (ppr sty sig)
-
-classTyVarInOpCtxtErr clas_tyvar sig sty
-  = hang (hcat [ ptext SLIT("Class type variable `"), ppr sty clas_tyvar, 
-			ptext SLIT("' present in method's local overloading context:")])
+		       ptext SLIT("does not appear in method signature")])
 	 4 (ppr sty sig)
 
 dupClassAssertWarn ctxt dups sty
@@ -718,8 +717,16 @@ badDataCon name sty
 allOfNonTyVar ty sty
   = hsep [ptext SLIT("`All' applied to a non-type variable:"), ppr sty ty]
 
-ctxtErr doc tyvars sty
-  = hsep [ptext SLIT("Context constrains type variable(s)"), 
+ctxtErr1 doc tyvars sty
+  = hsep [ptext SLIT("Context constrains in-scope type variable(s)"), 
 	  hsep (punctuate comma (map (ppr sty) tyvars))]
-    $$ nest 4 (ptext SLIT("in") <+> doc sty)
+    $$
+    nest 4 (ptext SLIT("in") <+> doc sty)
+
+ctxtErr2 doc tyvars ty sty
+  = (ptext SLIT("Context constrains type variable(s)")
+	<+> hsep (punctuate comma (map (ppr sty) tyvars)))
+    $$
+    nest 4 (vcat [ptext SLIT("that do not appear in") <+> ppr sty ty,
+	    	  ptext SLIT("in") <+> doc sty])
 \end{code}
diff --git a/ghc/compiler/tests/rename/rn019.hs b/ghc/compiler/tests/rename/rn019.hs
new file mode 100644
index 0000000..4ff7c0d
--- /dev/null
+++ b/ghc/compiler/tests/rename/rn019.hs
@@ -0,0 +1,4 @@
+module Silly (
+	Array.accum
+  ) where
+import qualified Array
diff --git a/ghc/compiler/tests/rename/rn020.hs b/ghc/compiler/tests/rename/rn020.hs
new file mode 100644
index 0000000..4b9dbde
--- /dev/null
+++ b/ghc/compiler/tests/rename/rn020.hs
@@ -0,0 +1,11 @@
+-- Duplicate fields in record decls
+
+module OK where
+
+data X = A {a :: Int} | B {a :: Int}
+
+f x = x
+
+-- data Y = V {a :: Int}
+
+-- f y = y
diff --git a/ghc/compiler/tests/rename/rn021.hs b/ghc/compiler/tests/rename/rn021.hs
new file mode 100644
index 0000000..a9074e2
--- /dev/null
+++ b/ghc/compiler/tests/rename/rn021.hs
@@ -0,0 +1,17 @@
+{- Check that the context of a type does not
+   constrain any in-scope variables, and only constrains
+   type variables free in the type.
+-}
+
+module Foo where
+
+instance Eq a => Eq Bool where
+  (==) = error "help"
+
+
+f :: Eq a => Int -> Int
+f x = x
+
+
+class Foo a where
+  op :: Eq a => a -> a
diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail072.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail072.hs
new file mode 100644
index 0000000..f7f57a7
--- /dev/null
+++ b/ghc/compiler/tests/typecheck/should_fail/tcfail072.hs
@@ -0,0 +1,24 @@
+{- This program crashed GHC 2.03
+
+   From: Marc van Dongen <dongen@cs.ucc.ie>
+   Date: Sat, 31 May 1997 14:35:40 +0100 (BST)
+
+  zonkIdOcc: g_aoQ
+
+  panic! (the `impossible' happened):
+          lookupBindC:no info!
+  for: g_aoQ
+  (probably: data dependencies broken by an optimisation pass)
+  static binds for:
+  Tmp.$d1{-rmM,x-}
+  local binds for:
+-}
+
+module Tmp( g ) where
+
+data AB p q = A
+            | B p q
+
+g :: (Ord p,Ord q) => (AB p q) -> Bool
+g (B _ _) = g A
+
diff --git a/ghc/compiler/tests/typecheck/should_succeed/Makefile b/ghc/compiler/tests/typecheck/should_succeed/Makefile
index ce60b0c..faa1911 100644
--- a/ghc/compiler/tests/typecheck/should_succeed/Makefile
+++ b/ghc/compiler/tests/typecheck/should_succeed/Makefile
@@ -6,13 +6,14 @@ HS_SRCS = $(wildcard *.hs)
 SRC_RUNTEST_OPTS += -o1 $*.stdout -o2 $*.stderr -x 0
 HC_OPTS += -noC -ddump-tc -dcore-lint -hi
 
+# Expect failure.  Why aren't they in "should-fail"?
 tc075_RUNTEST_OPTS += -x 1
 tc080_RUNTEST_OPTS += -x 1
 
 %.o : %.hs
 
 %.o : %.hs
-	$(RUNTEST) $(HC) $(RUNTEST_OPTS) -- $(HC_OPTS) -c $< -o $@ -osuf $(subst .,,$(suffix $@)) 
+	$(RUNTEST) $(HC) $(RUNTEST_OPTS) -- $(HC_OPTS) -c $< -o $@ 
 
 all :: $(HS_OBJS)
 
diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc086.hs b/ghc/compiler/tests/typecheck/should_succeed/tc086.hs
new file mode 100644
index 0000000..4d9ba6e
--- /dev/null
+++ b/ghc/compiler/tests/typecheck/should_succeed/tc086.hs
@@ -0,0 +1,60 @@
+{-
+  From: Marc van Dongen <dongen@cs.ucc.ie>
+  Date: Sat, 31 May 1997 19:57:46 +0100 (BST)
+
+   panic! (the `impossible' happened):
+           tcLookupTyVar:a_r6F
+
+   Please report it as a compiler bug to glasgow-haskell-bugs@dcs.gla.ac.uk.
+
+
+If the instance definition for (*) at the end of this toy module
+is replaced by the definition that is commented, this all compiles
+fine. Strange, because the two implementations are equivalent modulo
+the theory {(*) = multiply}.
+
+Remove the `multiply :: a -> a -> a' part, and it compiles without
+problems.
+
+
+SPJ note: the type signature on "multiply" should be
+	multiply :: Group a => a -> a -> a
+
+-}
+
+module Rings( Group, Ring ) where
+
+import qualified Prelude( Ord(..), Eq(..), Num(..) )
+import Prelude hiding( Ord(..), Eq(..), Num(..), MonadZero( zero ) )
+
+class Group a where
+  compare     :: a -> a -> Prelude.Ordering
+  fromInteger :: Integer -> a
+  (+) :: a -> a -> a
+  (-) :: a -> a -> a
+  zero :: a
+  one  :: a
+  zero = fromInteger 0
+  one  = fromInteger 1
+
+-- class (Group a) => Ring a where
+-- (*) :: a -> a -> a
+-- (*) a b =
+--                  case (compare a zero) of
+--                    EQ -> zero
+--                    LT -> zero - ((*) (zero - a) b)
+--                    GT -> case compare a one of
+--                            EQ -> b
+--                            _  -> b + ((*) (a - one) b)
+
+class (Group a) => Ring a where
+  (*) :: a -> a -> a
+  (*) a b = multiply a b
+          where multiply :: Group a => a -> a ->a 
+                multiply a b
+                  = case (compare a zero) of
+                      EQ -> zero
+                      LT -> zero - (multiply (zero - a) b)
+                      GT -> case compare a one of
+                              EQ -> b
+                              _  -> b + (multiply (a - one) b)
diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc087.hs b/ghc/compiler/tests/typecheck/should_succeed/tc087.hs
new file mode 100644
index 0000000..8477427
--- /dev/null
+++ b/ghc/compiler/tests/typecheck/should_succeed/tc087.hs
@@ -0,0 +1,32 @@
+module SOL where
+
+import GlaExts
+
+data SeqView t a              =  Null
+                              |  Cons a (t a)
+
+class PriorityQueue q where
+    empty			:: (Ord a) => q a
+    single			:: (Ord a) => a -> q a
+    insert			:: (Ord a) => a -> q a -> q a
+    meld			:: (Ord a) => q a -> q a -> q a
+    splitMin			:: (Ord a) => q a -> SeqView q a
+    insert a q		=  single a `meld` q
+
+toOrderedList q		=  case splitMin q of
+   Null			-> []
+   Cons a q		-> a : toOrderedList q
+
+insertMany x q		=  foldr insert q x
+pqSort q x		=  toOrderedList (insertMany x q)
+
+check			:: (PriorityQueue q) => (Ord a => q a) -> IO ()
+check empty		=  do
+    putStr "*** sorting\n"
+    out (pqSort empty [1 .. 99])
+    out (pqSort empty [1.0, 1.1 ..99.9])
+
+out				:: (Num a) => [a] -> IO ()
+out x | sum x == 0		=  putStr "ok\n"
+      | otherwise		=  putStr "ok\n"
+
diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc088.hs b/ghc/compiler/tests/typecheck/should_succeed/tc088.hs
new file mode 100644
index 0000000..e1b8b88
--- /dev/null
+++ b/ghc/compiler/tests/typecheck/should_succeed/tc088.hs
@@ -0,0 +1,18 @@
+-- Check that "->" is an instance of Eval
+
+module Foo where
+
+instance (Eq b) => Eq (a -> b) where
+	(==) f g = error "attempt to compare functions"
+
+	-- Since Eval is a superclass of Num this fails 
+	-- unless -> is an instance of Eval
+instance (Num b) => Num (a -> b) where
+    f + g                     =  \a -> f a + g a
+    f - g                     =  \a -> f a - g a
+    f * g                     =  \a -> f a * g a
+    negate f                  =  \a -> negate (f a)
+    abs f                     =  \a -> abs (f a)
+    signum f                  =  \a -> signum (f a)
+    fromInteger n             =  \a -> fromInteger n
+    fromInt n                 =  \a -> fromInt n
diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index 6e07406..9e23da4 100644
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -380,11 +380,14 @@ ppr_inst sty ppr_orig (LitInst u lit ty orig loc)
 
 ppr_inst sty ppr_orig (Dict u clas ty orig loc)
   = hang (ppr_orig orig loc)
-	 4 (hsep [ppr sty clas, pprParendGenType sty ty, show_uniq sty u])
+	 4 (pprQuote sty $ \ sty -> 
+	    hsep [ppr sty clas, pprParendGenType sty ty, show_uniq sty u])
 
 ppr_inst sty ppr_orig (Method u id tys rho orig loc)
   = hang (ppr_orig orig loc)
-	 4 (hsep [ppr sty id, ptext SLIT("at"), interppSP sty tys, show_uniq sty u])
+	 4 (hsep [ppr sty id, ptext SLIT("at"), 
+		  pprQuote sty $ \ sty -> interppSP sty tys,
+		  show_uniq sty u])
 
 show_uniq PprDebug u = ppr PprDebug u
 show_uniq sty	   u = empty
diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index 6aaedcd..8d988ab 100644
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/ghc/compiler/typecheck/TcInstDcls.lhs
@@ -239,7 +239,7 @@ tcInstDecl1 mod_name (InstDecl poly_ty binds uprags (Just dfun_name) src_loc)
 					other			   -> ([],  [],  poly_ty)
     (class_name, inst_ty) = case dict_ty of
 				MonoDictTy cls ty -> (cls,ty)
-				other -> pprPanic "Malformed intance decl" (ppr PprDebug poly_ty)
+				other -> pprPanic "Malformed instance decl" (ppr PprDebug poly_ty)
 \end{code}
 
 
diff --git a/ghc/compiler/typecheck/TcMatches.lhs b/ghc/compiler/typecheck/TcMatches.lhs
index a5ca1dd..be45c99 100644
--- a/ghc/compiler/typecheck/TcMatches.lhs
+++ b/ghc/compiler/typecheck/TcMatches.lhs
@@ -16,8 +16,9 @@ IMPORT_DELOOPER(TcLoop)		( tcGRHSsAndBinds )
 import {-# SOURCE #-} TcGRHSs ( tcGRHSsAndBinds )
 #endif
 
-import HsSyn		( Match(..), GRHSsAndBinds(..), GRHS(..), InPat,
-			  HsExpr, HsBinds, OutPat, Fake, Stmt,
+import HsSyn		( Match(..), GRHSsAndBinds(..), GRHS(..), InPat, 
+			  HsExpr(..), HsBinds(..), MonoBinds(..), OutPat, Fake, Stmt,
+			  Sig, HsLit, DoOrListComp, Fixity, HsType, ArithSeqInfo, 
 			  collectPatBinders, pprMatch )
 import RnHsSyn		( SYN_IE(RenamedMatch) )
 import TcHsSyn		( TcIdOcc(..), SYN_IE(TcMatch) )
@@ -27,12 +28,13 @@ import Inst		( Inst, SYN_IE(LIE), plusLIE )
 import TcEnv		( newMonoIds )
 import TcPat		( tcPat )
 import TcType		( SYN_IE(TcType), TcMaybe, zonkTcType )
+import TcSimplify	( bindInstsOfLocalFuns )
 import Unify		( unifyTauTy, unifyTauTyList )
 import Name		( Name {- instance Outputable -} )
 
 import Kind		( Kind, mkTypeKind )
 import Pretty
-import Type		( isTyVarTy, mkFunTy, getFunTy_maybe )
+import Type		( isTyVarTy, isTauTy, mkFunTy, getFunTy_maybe )
 import Util
 import Outputable
 #if __GLASGOW_HASKELL__ >= 202
@@ -149,16 +151,38 @@ tcMatchExpected expected_ty the_match@(PatMatch pat match)
 	Just (arg_ty,rest_ty) ->	-- It's a function type!
 	    let binders = collectPatBinders pat
 	    in
-	    newMonoIds binders mkTypeKind (\ _ ->
+	    newMonoIds binders mkTypeKind (\ mono_ids ->
 		tcPat pat			`thenTc` \ (pat', lie_pat, pat_ty) ->
 		unifyTauTy pat_ty arg_ty	`thenTc_`
 		tcMatchExpected rest_ty  match	`thenTc` \ (match', lie_match) ->
-		returnTc (PatMatch pat' match',
-			  plusLIE lie_pat lie_match)
+
+			-- In case there are any polymorpic, overloaded binders in the pattern
+			-- (which can happen in the case of rank-2 type signatures, or data constructors
+			-- with polymorphic arguments), we must dd a bindInstsOfLocalFns here
+			--
+			-- 99% of the time there are no bindings.  In the unusual case we
+			-- march down the match to dump them in the right place (boring but easy).
+	        bindInstsOfLocalFuns lie_match mono_ids 	`thenTc` \ (lie_match', inst_mbinds) ->
+		let
+		   inst_binds = MonoBind inst_mbinds [] False
+		   match'' = case inst_mbinds of
+				EmptyMonoBinds -> match'
+				other          -> glue_on match'
+		   glue_on (PatMatch p m) = PatMatch p (glue_on m)
+		   glue_on (GRHSMatch (GRHSsAndBindsOut grhss binds ty))
+			= (GRHSMatch (GRHSsAndBindsOut grhss 
+						       (inst_binds `ThenBinds` binds)
+						       ty))
+		   glue_on (SimpleMatch expr) = SimpleMatch (HsLet inst_binds expr)
+		in		
+		returnTc (PatMatch pat' match'',
+			  plusLIE lie_pat lie_match')
 	    )
 
 tcMatchExpected expected_ty (GRHSMatch grhss_and_binds)
   = tcGRHSsAndBinds grhss_and_binds   	`thenTc` \ (grhss_and_binds', lie, grhss_ty) ->
+    checkTc (isTauTy expected_ty)
+	    lurkingRank2SigErr 		`thenTc_`
     unifyTauTy expected_ty grhss_ty 	`thenTc_`
     returnTc (GRHSMatch grhss_and_binds', lie)
 
@@ -230,4 +254,7 @@ matchCtxt (MFun fun) match sty
 \begin{code}
 varyingArgsErr name matches sty
   = sep [ptext SLIT("Varying number of arguments for function"), ppr sty name]
+
+lurkingRank2SigErr sty
+  = ptext SLIT("Too few explicit arguments when defining a function with a rank-2 type")
 \end{code}
diff --git a/ghc/compiler/utils/FiniteMap.lhs b/ghc/compiler/utils/FiniteMap.lhs
index 319e386..e550d1e 100644
--- a/ghc/compiler/utils/FiniteMap.lhs
+++ b/ghc/compiler/utils/FiniteMap.lhs
@@ -303,6 +303,7 @@ plusFM_C combiner fm1 (Branch split_key elt2 _ left right)
 
 -- It's worth doing plusFM specially, because we don't need
 -- to do the lookup in fm1.
+-- FM2 over-rides FM1.
 
 plusFM EmptyFM fm2 = fm2
 plusFM fm1 EmptyFM = fm1
-- 
1.7.10.4