[project @ 2003-07-24 11:44:42 by simonmar]

[ghc-hetmet.git] / ghc / compiler / rename / RnSource.lhs

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 277862f..f74c712 100644 (file)
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -1,662 +1,761 @@
 %
 %

-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998

 %
 \section[RnSource]{Main pass of renamer}
 
 \begin{code}
 %
 \section[RnSource]{Main pass of renamer}
 
 \begin{code}

-#include "HsVersions.h"
-
-module RnSource ( rnSource, rnTyDecl, rnClassDecl, rnInstDecl, rnPolyType ) where
+module RnSource ( 
+       rnSrcDecls, checkModDeprec,
+       rnTyClDecl, rnIfaceRuleDecl, rnInstDecl, 
+       rnBinds, rnBindsAndThen, rnStats,
+    ) where

 
 

-IMP_Ubiq()
-IMPORT_DELOOPER(RnLoop)                -- *check* the RnPass/RnExpr/RnBinds loop-breaking
-IMPORT_1_3(List(partition))
+#include "HsVersions.h"

 
 import HsSyn
 
 import HsSyn

-import HsPragmas
-import RdrHsSyn
+import RdrName         ( RdrName, isRdrDataCon, elemRdrEnv )
+import RdrHsSyn                ( RdrNameConDecl, RdrNameTyClDecl, 
+                         RdrNameDeprecation, RdrNameFixitySig,
+                         RdrNameHsBinds,
+                         extractGenericPatTyVars
+                       )

 import RnHsSyn
 import RnHsSyn

-import RnMonad
-import RnBinds         ( rnTopBinds, rnMethodBinds )
-import RnUtils         ( getLocalsFromRnEnv, lookupGlobalRnEnv, lubExportFlag )
-
-import Bag             ( emptyBag, unitBag, consBag, unionManyBags, unionBags, listToBag, bagToList )
-import Class           ( derivableClassKeys )
-import CmdLineOpts     ( opt_CompilingGhcInternals )
-import ErrUtils                ( addErrLoc, addShortErrLocLine, addShortWarnLocLine )
-import FiniteMap       ( emptyFM, lookupFM, addListToFM_C )
-import Id              ( isDataCon, GenId{-instance NamedThing-} )
-import ListSetOps      ( unionLists, minusList )
-import Maybes          ( maybeToBool, catMaybes )
-import Name            ( isLocallyDefined, isLexVarId, getLocalName, ExportFlag(..), 
-                         nameImportFlag, RdrName, pprNonSym, Name )
-import Outputable      -- ToDo:rm
-import PprStyle        -- ToDo:rm 
-import Pretty
+import HsCore
+import RnExpr          ( rnExpr )
+import RnTypes         ( rnHsType, rnHsSigType, rnHsTypeFVs, rnContext )
+
+import RnBinds         ( rnTopMonoBinds, rnMonoBinds, rnMethodBinds, 
+                         rnMonoBindsAndThen, renameSigs, checkSigs )
+import RnEnv           ( lookupTopBndrRn, lookupOccRn, lookupSysBndr,
+                         newLocalsRn, lookupGlobalOccRn,
+                         bindLocalsFV, bindPatSigTyVarsFV,
+                         bindTyVarsRn, extendTyVarEnvFVRn,
+                         bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
+                         checkDupOrQualNames, checkDupNames, mapFvRn,
+                         lookupTopSrcBndr_maybe, lookupTopSrcBndr,
+                         dataTcOccs, newIPName, unknownNameErr
+                       )
+import TcRnMonad
+
+import BasicTypes      ( FixitySig(..), TopLevelFlag(..)  )
+import HscTypes                ( ExternalPackageState(..), FixityEnv, 
+                         Deprecations(..), plusDeprecs )
+import Module          ( moduleEnvElts )
+import Class           ( FunDep, DefMeth (..) )
+import TyCon           ( DataConDetails(..), visibleDataCons )
+import Name            ( Name )
+import NameSet
+import NameEnv
+import ErrUtils                ( dumpIfSet )
+import PrelNames       ( newStablePtrName, bindIOName, returnIOName
+                         -- dotnet interop
+                       , objectTyConName, 
+                       , unmarshalObjectName, marshalObjectName
+                       , unmarshalStringName, marshalStringName
+                       , checkDotnetResName
+                       )
+import List            ( partition )
+import Bag             ( bagToList )
+import Outputable

 import SrcLoc          ( SrcLoc )
 import SrcLoc          ( SrcLoc )

-import TyCon           ( tyConDataCons, TyCon{-instance NamedThing-} )
-import Unique          ( Unique )
-import UniqFM          ( emptyUFM, addListToUFM_C, listToUFM, plusUFM, lookupUFM, eltsUFM )
-import UniqSet         ( SYN_IE(UniqSet) )
-import Util            ( isIn, isn'tIn, thenCmp, sortLt, removeDups, mapAndUnzip3, cmpPString,
-                         panic, assertPanic, pprTrace{-ToDo:rm-} )
+import CmdLineOpts     ( DynFlag(..) )
+                               -- Warn of unused for-all'd tyvars
+import Maybes          ( maybeToBool, seqMaybe )
+import Maybe            ( maybe, catMaybes, isNothing )

 \end{code}
 
 \end{code}
 

-rnSource `renames' the source module and export list.
+@rnSourceDecl@ `renames' declarations.

 It simultaneously performs dependency analysis and precedence parsing.
 It also does the following error checks:
 \begin{enumerate}
 \item
 Checks that tyvars are used properly. This includes checking
 for undefined tyvars, and tyvars in contexts that are ambiguous.
 It simultaneously performs dependency analysis and precedence parsing.
 It also does the following error checks:
 \begin{enumerate}
 \item
 Checks that tyvars are used properly. This includes checking
 for undefined tyvars, and tyvars in contexts that are ambiguous.

+(Some of this checking has now been moved to module @TcMonoType@,
+since we don't have functional dependency information at this point.)

 \item
 Checks that all variable occurences are defined.
 \item 
 \item
 Checks that all variable occurences are defined.
 \item 

-Checks the (..) etc constraints in the export list.
+Checks the @(..)@ etc constraints in the export list.

 \end{enumerate}
 
 
 \begin{code}
 \end{enumerate}
 
 
 \begin{code}

-rnSource :: [Module]                   -- imported modules
-        -> Bag (Module,RnName)         -- unqualified imports from module
-        -> Bag RenamedFixityDecl       -- fixity info for imported names
-        -> RdrNameHsModule
-        -> RnM s (RenamedHsModule,
-                  Name -> ExportFlag,          -- export info
-                  ([(Name, ExportFlag)],       -- export module X stuff
-                   [(Name, ExportFlag)]),
-                  Bag (RnName, RdrName))       -- occurrence info
-
-rnSource imp_mods unqual_imps imp_fixes
-       (HsModule mod version exports _ fixes
-          ty_decls specdata_sigs class_decls
-          inst_decls specinst_sigs defaults
-          binds _ src_loc)
-
-  = pushSrcLocRn src_loc $
-
-    rnExports (mod:imp_mods) unqual_imps exports       `thenRn` \ (exported_fn, module_dotdots) ->
-    rnFixes fixes                                      `thenRn` \ src_fixes ->
-    let
-       all_fixes     = src_fixes ++ bagToList imp_fixes
-       all_fixes_fm  = listToUFM (map pair_name all_fixes)
+rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name, DefUses)
+
+rnSrcDecls (HsGroup { hs_valds  = MonoBind binds sigs _,
+                     hs_tyclds = tycl_decls,
+                     hs_instds = inst_decls,
+                     hs_fixds  = fix_decls,
+                     hs_depds  = deprec_decls,
+                     hs_fords  = foreign_decls,
+                     hs_defds  = default_decls,
+                     hs_ruleds = rule_decls,
+                     hs_coreds = core_decls })
+
+ = do {                -- Deal with deprecations (returns only the extra deprecations)
+       deprecs <- rnSrcDeprecDecls deprec_decls ;
+       updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
+                 $ do {
+
+               -- Deal with top-level fixity decls 
+               -- (returns the total new fixity env)
+       fix_env <- rnSrcFixityDecls fix_decls ;
+       updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
+                 $ do {
+
+               -- Rename other declarations
+       (rn_val_decls, bind_dus) <- rnTopMonoBinds binds sigs ;
+
+               -- You might think that we could build proper def/use information
+               -- for type and class declarations, but they can be involved
+               -- in mutual recursion across modules, and we only do the SCC
+               -- analysis for them in the type checker.
+               -- So we content ourselves with gathering uses only; that
+               -- means we'll only report a declaration as unused if it isn't
+               -- mentioned at all.  Ah well.
+       (rn_tycl_decls,    src_fvs1) <- mapFvRn rnSrcTyClDecl tycl_decls ;
+       (rn_inst_decls,    src_fvs2) <- mapFvRn rnSrcInstDecl inst_decls ;
+       (rn_rule_decls,    src_fvs3) <- mapFvRn rnHsRuleDecl rule_decls ;
+       (rn_foreign_decls, src_fvs4) <- mapFvRn rnHsForeignDecl foreign_decls ;
+       (rn_default_decls, src_fvs5) <- mapFvRn rnDefaultDecl default_decls ;
+       (rn_core_decls,    src_fvs6) <- mapFvRn rnCoreDecl core_decls ;
+       
+       let {
+          rn_group = HsGroup { hs_valds  = rn_val_decls,
+                               hs_tyclds = rn_tycl_decls,
+                               hs_instds = rn_inst_decls,
+                               hs_fixds  = [],
+                               hs_depds  = [],
+                               hs_fords  = rn_foreign_decls,
+                               hs_defds  = rn_default_decls,
+                               hs_ruleds = rn_rule_decls,
+                               hs_coreds = rn_core_decls } ;
+
+          other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, 
+                               src_fvs4, src_fvs5, src_fvs6] ;
+          src_dus = bind_dus `plusDU` usesOnly other_fvs 
+       } ;
+
+       tcg_env <- getGblEnv ;
+       return (tcg_env, rn_group, src_dus)
+    }}}
+\end{code}

 
 

-       pair_name inf = (fixDeclName inf, inf)
-    in
-    setExtraRn all_fixes_fm $
-
-    mapRn rnTyDecl     ty_decls        `thenRn` \ new_ty_decls ->
-    mapRn rnSpecDataSig specdata_sigs  `thenRn` \ new_specdata_sigs ->
-    mapRn rnClassDecl  class_decls     `thenRn` \ new_class_decls ->
-    mapRn rnInstDecl   inst_decls      `thenRn` \ new_inst_decls ->
-    mapRn rnSpecInstSig specinst_sigs   `thenRn` \ new_specinst_sigs ->
-    rnDefaultDecl      defaults        `thenRn` \ new_defaults ->
-    rnTopBinds binds                   `thenRn` \ new_binds ->
-
-    getOccurrenceUpRn                  `thenRn` \ occ_info ->
-
-    returnRn (
-             HsModule mod version
-               trashed_exports trashed_imports all_fixes
-               new_ty_decls new_specdata_sigs new_class_decls
-               new_inst_decls new_specinst_sigs new_defaults
-               new_binds [] src_loc,
-             exported_fn, module_dotdots,
-             occ_info
-            )
+
+%*********************************************************
+%*                                                      *
+       Source-code fixity declarations
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+rnSrcFixityDecls :: [RdrNameFixitySig] -> TcRn m FixityEnv
+rnSrcFixityDecls fix_decls
+  = getGblEnv                                  `thenM` \ gbl_env ->
+    foldlM rnFixityDecl (tcg_fix_env gbl_env) 
+           fix_decls                           `thenM` \ fix_env ->
+    traceRn (text "fixity env" <+> ppr fix_env)        `thenM_`
+    returnM fix_env
+
+rnFixityDecl :: FixityEnv -> RdrNameFixitySig -> TcRn m FixityEnv
+rnFixityDecl fix_env (FixitySig rdr_name fixity loc)
+  =    -- GHC extension: look up both the tycon and data con 
+       -- for con-like things
+       -- If neither are in scope, report an error; otherwise
+       -- add both to the fixity env
+     mappM lookupTopSrcBndr_maybe (dataTcOccs rdr_name)        `thenM` \ maybe_ns ->
+     case catMaybes maybe_ns of
+         [] -> addSrcLoc loc                   $
+               addErr (unknownNameErr rdr_name)        `thenM_`
+               returnM fix_env
+         ns -> foldlM add fix_env ns

   where
   where

-    trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
-    trashed_imports = {-trace "rnSource:trashed_imports"-} []
+    add fix_env name 
+      = case lookupNameEnv fix_env name of
+          Just (FixitySig _ _ loc') -> addErr (dupFixityDecl rdr_name loc loc')        `thenM_`
+                                      returnM fix_env
+         Nothing -> returnM (extendNameEnv fix_env name (FixitySig name fixity loc))
+
+dupFixityDecl rdr_name loc1 loc2
+  = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
+         ptext SLIT("at ") <+> ppr loc1,
+         ptext SLIT("and") <+> ppr loc2]

 \end{code}
 
 
 %*********************************************************
 \end{code}
 
 
 %*********************************************************

+%*                                                      *
+       Source-code deprecations declarations
+%*                                                      *
+%*********************************************************
+
+For deprecations, all we do is check that the names are in scope.
+It's only imported deprecations, dealt with in RnIfaces, that we
+gather them together.
+
+\begin{code}
+rnSrcDeprecDecls :: [RdrNameDeprecation] -> TcRn m Deprecations
+rnSrcDeprecDecls [] 
+  = returnM NoDeprecs
+
+rnSrcDeprecDecls decls
+  = mappM rn_deprec decls      `thenM` \ pairs ->
+    returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
+ where
+   rn_deprec (Deprecation rdr_name txt loc)
+     = addSrcLoc loc                   $
+       lookupTopSrcBndr rdr_name       `thenM` \ name ->
+       returnM (Just (name, (name,txt)))
+
+checkModDeprec :: Maybe DeprecTxt -> Deprecations
+-- Check for a module deprecation; done once at top level
+checkModDeprec Nothing    = NoDeprecs
+checkModdeprec (Just txt) = DeprecAll txt
+
+badDeprec d
+  = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
+        nest 4 (ppr d)]
+\end{code}
+
+%*********************************************************

 %*                                                     *
 %*                                                     *

-\subsection{Export list}
+\subsection{Source code declarations}

 %*                                                     *
 %*********************************************************
 
 \begin{code}
 %*                                                     *
 %*********************************************************
 
 \begin{code}

-rnExports :: [Module]
-         -> Bag (Module,RnName)
-         -> Maybe [RdrNameIE]
-         -> RnM s (Name -> ExportFlag,    -- main export-flag fun
-                   ([(Name,ExportFlag)],  -- info about "module X" exports
-                    [(Name,ExportFlag)])
-                  )
-
-rnExports mods unqual_imps Nothing
-  = returnRn (\n -> if isLocallyDefined n then ExportAll else NotExported
-            , ([], [])
-            )
-
-rnExports mods unqual_imps (Just exps)
-  = getModuleRn                           `thenRn` \ this_mod ->
-    getRnEnv                      `thenRn` \ rn_env ->
-    mapAndUnzipRn (rnIE mods) exps `thenRn` \ (mod_maybes, exp_bags) ->
-    let 
-       (tc_bags, val_bags) = unzip exp_bags
-       tc_names  = bagToList (unionManyBags tc_bags)
-        val_names = bagToList (unionManyBags val_bags)
-        exp_mods  = catMaybes mod_maybes
-
-       -- Warn for duplicate names and modules
-       (_, dup_tc_names)  = removeDups cmp_fst tc_names
-       (_, dup_val_names) = removeDups cmp_fst val_names
-       cmp_fst (x,_) (y,_) = x `cmp` y
-
-       (uniq_mods, dup_mods) = removeDups cmpPString exp_mods
-       (expmods_this, expmods_imps) = partition (== this_mod) uniq_mods
-
-       -- Get names for "module This_Mod" export
-       (this_tcs, this_vals)
-         = if null expmods_this 
-           then ([], [])
-           else getLocalsFromRnEnv rn_env
-
-       -- Get names for exported imported modules
-       (mod_tcs, mod_vals, empty_mods)
-         = case mapAndUnzip3 get_mod_names expmods_imps of
-             (tcs, vals, emptys) -> (concat tcs, concat vals, catMaybes emptys)
-               
-       (unqual_tcs, unqual_vals) = partition (isRnTyConOrClass.snd) (bagToList unqual_imps)
-
-        get_mod_names mod
-         = --pprTrace "get_mod_names" (ppAboves [ppPStr mod, interpp'SP PprDebug (map fst tcs), interpp'SP PprDebug (map fst vals)]) $
-           (tcs, vals, empty_mod)
-          where
-            tcs  = [(getName rn, nameImportFlag (getName rn))
-                  | (mod',rn) <- unqual_tcs, mod == mod']
-            vals = [(getName rn, nameImportFlag (getName rn))
-                  | (mod',rn) <- unqual_vals, mod == mod', fun_looking rn]
-           empty_mod = if null tcs && null vals
-                       then Just mod
-                       else Nothing
-                                                           
-           -- fun_looking: must avoid class ops and data constructors
-           -- and record fieldnames
-           fun_looking (RnName    _) = True
-           fun_looking (WiredInId i) = not (isDataCon i)
-           fun_looking _             = False
-
-       -- Build finite map of exported names to export flag
-       tc_map0  = addListToUFM_C lub_expflag emptyUFM (map pair_fst tc_names)
-       tc_map1  = addListToUFM_C lub_expflag tc_map0  (map pair_fst mod_tcs)
-       tc_map   = addListToUFM_C lub_expflag tc_map1  (map (pair_fst.exp_all) this_tcs)
-       
-        val_map0 = addListToUFM_C lub_expflag emptyUFM (map pair_fst val_names)
-        val_map1 = addListToUFM_C lub_expflag val_map0 (map pair_fst mod_vals)
-        val_map  = addListToUFM_C lub_expflag val_map1 (map (pair_fst.exp_all) this_vals)
-
-       pair_fst pr@(n,_) = (n,pr)
-       exp_all rn = (getName rn, ExportAll)
-       lub_expflag (n, flag1) (_, flag2) = (n, lubExportFlag flag1 flag2)
-
-       -- Check for exporting of duplicate local names
-       tc_locals  = [(getLocalName n, n) | (n,_) <- eltsUFM tc_map]
-       val_locals = [(getLocalName n, n) | (n,_) <- eltsUFM val_map]
-       (_, dup_tc_locals)  = removeDups cmp_local tc_locals
-       (_, dup_val_locals) = removeDups cmp_local val_locals
-       cmp_local (x,_) (y,_) = x `cmpPString` y
-
-       -- Build export flag function
-       final_exp_map = plusUFM tc_map val_map
-       exp_fn n = case lookupUFM final_exp_map n of
-                     Nothing       -> NotExported
-                     Just (_,flag) -> flag
-    in
-    getSrcLocRn                                                        `thenRn` \ src_loc ->
-    mapRn (addWarnRn . dupNameExportWarn  src_loc) dup_tc_names        `thenRn_`
-    mapRn (addWarnRn . dupNameExportWarn  src_loc) dup_val_names       `thenRn_`
-    mapRn (addWarnRn . dupModExportWarn   src_loc) dup_mods            `thenRn_`
-    mapRn (addWarnRn . emptyModExportWarn src_loc) empty_mods          `thenRn_`
-    mapRn (addErrRn  . dupLocalsExportErr src_loc) dup_tc_locals       `thenRn_`
-    mapRn (addErrRn  . dupLocalsExportErr src_loc) dup_val_locals      `thenRn_`
-    returnRn (exp_fn, (mod_vals, mod_tcs))
-
-------------------------------------
--- rename an "IE" in the export list
-
-rnIE ::        [Module]    -- this module and all the (directly?) imported modules
-     -> RdrNameIE
-     -> RnM s (
-           Maybe Module,               -- Just m => a "module X" export item
-           (Bag (Name, ExportFlag),    -- Exported tycons/classes
-            Bag (Name, ExportFlag)))   -- Exported values
-
-rnIE mods (IEVar name)
-  = lookupValue name   `thenRn` \ rn ->
-    checkIEVar rn      `thenRn` \ exps ->
-    returnRn (Nothing, exps)
-  where
-    checkIEVar (RnName    n)      = returnRn (emptyBag, unitBag (n,ExportAll))
-    checkIEVar (WiredInId i)     = returnRn (emptyBag, unitBag (getName i, ExportAll))
-    checkIEVar rn@(RnClassOp _ _) = getSrcLocRn `thenRn` \ src_loc ->
-                                   failButContinueRn (emptyBag, emptyBag) (classOpExportErr rn src_loc)
-    checkIEVar rn@(RnField _ _)          = getSrcLocRn `thenRn` \ src_loc ->
-                                   failButContinueRn (emptyBag, emptyBag) (fieldExportErr rn src_loc)
-    checkIEVar rn                = --pprTrace "rnIE:IEVar:panic? ToDo?:" (ppr PprDebug rn) $
-                                   returnRn (emptyBag, emptyBag)
-
-rnIE mods (IEThingAbs name)
-  = lookupTyConOrClass name    `thenRn` \ rn ->
-    checkIEAbs rn              `thenRn` \ exps ->
-    returnRn (Nothing, exps)
-  where
-    checkIEAbs (RnSyn n)       = returnRn (unitBag (n,ExportAbs), emptyBag)
-    checkIEAbs (RnData n _ _)  = returnRn (unitBag (n,ExportAbs), emptyBag)
-    checkIEAbs (RnClass n _)   = returnRn (unitBag (n,ExportAbs), emptyBag)
-    checkIEAbs (WiredInTyCon t) = returnRn (unitBag (getName t,ExportAbs), emptyBag)
-    checkIEAbs rn               = --pprTrace "rnIE:IEAbs:panic? ToDo?:" (ppr PprDebug rn) $
-                                 returnRn (emptyBag, emptyBag)
-
-rnIE mods (IEThingAll name)
-  = lookupTyConOrClass name    `thenRn` \ rn ->
-    checkIEAll rn              `thenRn` \ exps ->
-    checkImportAll rn           `thenRn_`
-    returnRn (Nothing, exps)
+rnSrcTyClDecl tycl_decl
+  = rnTyClDecl tycl_decl                       `thenM` \ new_decl ->
+    finishSourceTyClDecl tycl_decl new_decl    `thenM` \ (new_decl', fvs) ->
+    returnM (new_decl', fvs `plusFV` tyClDeclFVs new_decl')
+
+rnSrcInstDecl inst
+  = rnInstDecl inst                    `thenM` \ new_inst ->
+    finishSourceInstDecl inst new_inst `thenM` \ (new_inst', fvs) ->
+    returnM (new_inst', fvs `plusFV` instDeclFVs new_inst')
+
+rnDefaultDecl (DefaultDecl tys src_loc)
+  = addSrcLoc src_loc $
+    mapFvRn (rnHsTypeFVs doc_str) tys          `thenM` \ (tys', fvs) ->
+    returnM (DefaultDecl tys' src_loc, fvs)

   where
   where

-    checkIEAll (RnData n cons fields)
-      = returnRn (unitBag (exp_all n),
-           listToBag (map exp_all cons) `unionBags` listToBag (map exp_all fields))
-
-    checkIEAll (WiredInTyCon t)
-      = returnRn (unitBag (exp_all (getName t)), listToBag (map exp_all cons))
-      where
-       cons   = map getName (tyConDataCons t)
-
-    checkIEAll (RnClass n ops)
-      = returnRn (unitBag (exp_all n), listToBag (map exp_all ops))
-    checkIEAll rn@(RnSyn n)
-      = getSrcLocRn `thenRn` \ src_loc ->
-       warnAndContinueRn (unitBag (n, ExportAbs), emptyBag)
-                         (synAllExportErr False{-warning-} rn src_loc)
-
-    checkIEAll rn = --pprTrace "rnIE:IEAll:panic? ToDo?:" (ppr PprDebug rn) $
-                   returnRn (emptyBag, emptyBag)
-
-    exp_all n = (n, ExportAll)
-
-rnIE mods (IEThingWith name names)
-  = lookupTyConOrClass name    `thenRn` \ rn ->
-    mapRn lookupValue names    `thenRn` \ rns ->
-    checkIEWith rn rns         `thenRn` \ exps ->
-    checkImportAll rn          `thenRn_`
-    returnRn (Nothing, exps)
+    doc_str = text "In a `default' declaration"
+
+
+rnCoreDecl (CoreDecl name ty rhs loc)
+  = addSrcLoc loc $
+    lookupTopBndrRn name               `thenM` \ name' ->
+    rnHsTypeFVs doc_str ty             `thenM` \ (ty', ty_fvs) ->
+    rnCoreExpr rhs                      `thenM` \ rhs' ->
+    returnM (CoreDecl name' ty' rhs' loc, 
+            ty_fvs `plusFV` ufExprFVs rhs')

   where
   where

-    checkIEWith rn@(RnData n cons fields) rns
-       | same_names (cons++fields) rns
-       = returnRn (unitBag (exp_all n), listToBag (map exp_all cons)
-                                          `unionBags`
-                                        listToBag (map exp_all fields))
-       | otherwise
-       = rnWithErr "constructors (and fields)" rn (cons++fields) rns 
-    checkIEWith rn@(RnClass n ops) rns
-       | same_names ops rns
-       = returnRn (unitBag (exp_all n), listToBag (map exp_all ops))
-       | otherwise
-       = rnWithErr "class ops" rn ops rns
-    checkIEWith rn@(RnSyn _) rns
-       = getSrcLocRn `thenRn` \ src_loc ->
-         failButContinueRn (emptyBag, emptyBag) (synAllExportErr True{-error-} rn src_loc)
-    checkIEWith (WiredInTyCon _) rns = panic "RnSource.rnIE:checkIEWith:WiredInTyCon:ToDo (boring)"
-    checkIEWith rn rns
-       = pprTrace "rnIE:IEWith:panic? ToDo?:" (ppr PprDebug rn) $
-         returnRn (emptyBag, emptyBag)
-
-    exp_all n = (n, ExportAll)
-
-    same_names has rns
-      = all (not.isRnUnbound) rns &&
-       sortLt (<) (map uniqueOf has) == sortLt (<) (map uniqueOf rns)
-
-    rnWithErr str rn has rns
-      = getSrcLocRn `thenRn` \ src_loc ->
-       failButContinueRn (emptyBag, emptyBag) (withExportErr str rn has rns src_loc)
-
-rnIE mods (IEModuleContents mod)
-  | isIn "rnIE:IEModule" mod mods
-  = returnRn (Just mod, (emptyBag, emptyBag))
-  | otherwise
-  = getSrcLocRn `thenRn` \ src_loc ->
-    failButContinueRn (Nothing, (emptyBag, emptyBag)) (badModExportErr mod src_loc)
-
-
-checkImportAll rn 
-  = case nameImportFlag (getName rn) of
-      ExportAll -> returnRn ()
-      exp      -> getSrcLocRn `thenRn` \ src_loc ->
-                  addErrRn (importAllErr rn src_loc)
+    doc_str = text "In the Core declaration for" <+> quotes (ppr name)

 \end{code}
 
 %*********************************************************
 %*                                                     *
 \end{code}
 
 %*********************************************************
 %*                                                     *

-\subsection{Type declarations}
+               Bindings

 %*                                                     *
 %*********************************************************
 
 %*                                                     *
 %*********************************************************
 

-@rnTyDecl@ uses the `global name function' to create a new type
-declaration in which local names have been replaced by their original
-names, reporting any unknown names.
-
-Renaming type variables is a pain. Because they now contain uniques,
-it is necessary to pass in an association list which maps a parsed
-tyvar to its Name representation. In some cases (type signatures of
-values), it is even necessary to go over the type first in order to
-get the set of tyvars used by it, make an assoc list, and then go over
-it again to rename the tyvars! However, we can also do some scoping
-checks at the same time.
+These chaps are here, rather than in TcBinds, so that there
+is just one hi-boot file (for RnSource).  rnSrcDecls is part
+of the loop too, and it must be defined in this module.

 
 \begin{code}
 
 \begin{code}

-rnTyDecl :: RdrNameTyDecl -> RnM_Fixes s RenamedTyDecl
-
-rnTyDecl (TyData context tycon tyvars condecls derivings pragmas src_loc)
-  = pushSrcLocRn src_loc $
-    lookupTyCon tycon                 `thenRn` \ tycon' ->
-    mkTyVarNamesEnv src_loc tyvars     `thenRn` \ (tv_env, tyvars') ->
-    rnContext tv_env src_loc context   `thenRn` \ context' ->
-    rnConDecls tv_env condecls        `thenRn` \ condecls' ->
-    rn_derivs tycon' src_loc derivings `thenRn` \ derivings' ->
-    ASSERT(isNoDataPragmas pragmas)
-    returnRn (TyData context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc)
-
-rnTyDecl (TyNew context tycon tyvars condecl derivings pragmas src_loc)
-  = pushSrcLocRn src_loc $
-    lookupTyCon tycon                `thenRn` \ tycon' ->
-    mkTyVarNamesEnv src_loc tyvars    `thenRn` \ (tv_env, tyvars') ->
-    rnContext tv_env src_loc context  `thenRn` \ context' ->
-    rnConDecls tv_env condecl        `thenRn` \ condecl' ->
-    rn_derivs tycon' src_loc derivings `thenRn` \ derivings' ->
-    ASSERT(isNoDataPragmas pragmas)
-    returnRn (TyNew context' tycon' tyvars' condecl' derivings' noDataPragmas src_loc)
-
-rnTyDecl (TySynonym name tyvars ty src_loc)
-  = pushSrcLocRn src_loc $
-    lookupTyCon name               `thenRn` \ name' ->
-    mkTyVarNamesEnv src_loc tyvars  `thenRn` \ (tv_env, tyvars') ->
-    rnMonoType tv_env ty           `thenRn` \ ty' ->
-    returnRn (TySynonym name' tyvars' ty' src_loc)
-
-rn_derivs tycon2 locn Nothing -- derivs not specified
-  = returnRn Nothing
-
-rn_derivs tycon2 locn (Just ds)
-  = mapRn (rn_deriv tycon2 locn) ds `thenRn` \ derivs ->
-    returnRn (Just derivs)
-  where
-    rn_deriv tycon2 locn clas
-      = lookupClass clas           `thenRn` \ clas_name ->
-       addErrIfRn (uniqueOf clas_name `not_elem` derivableClassKeys)
-                  (derivingNonStdClassErr clas_name locn)
-                                   `thenRn_`
-       returnRn clas_name
-      where
-       not_elem = isn'tIn "rn_deriv"
+rnBinds    :: RdrNameHsBinds -> RnM (RenamedHsBinds, DefUses)
+-- This version assumes that the binders are already in scope
+-- It's used only in 'mdo'
+rnBinds EmptyBinds            = returnM (EmptyBinds, emptyDUs)
+rnBinds (MonoBind bind sigs _) = rnMonoBinds NotTopLevel bind sigs
+rnBinds b@(IPBinds bind _)     = addErr (badIpBinds b) `thenM_` 
+                                returnM (EmptyBinds, emptyDUs)
+
+rnBindsAndThen :: RdrNameHsBinds 
+               -> (RenamedHsBinds -> RnM (result, FreeVars))
+               -> RnM (result, FreeVars)
+-- This version (a) assumes that the binding vars are not already in scope
+--             (b) removes the binders from the free vars of the thing inside
+-- The parser doesn't produce ThenBinds
+rnBindsAndThen EmptyBinds             thing_inside = thing_inside EmptyBinds
+rnBindsAndThen (MonoBind bind sigs _)  thing_inside = rnMonoBindsAndThen bind sigs thing_inside
+rnBindsAndThen (IPBinds binds is_with) thing_inside
+  = warnIf is_with withWarning                 `thenM_`
+    rnIPBinds binds                            `thenM` \ (binds',fv_binds) ->
+    thing_inside (IPBinds binds' is_with)      `thenM` \ (thing, fvs_thing) ->
+    returnM (thing, fvs_thing `plusFV` fv_binds)

 \end{code}
 
 \end{code}
 

-@rnConDecls@ uses the `global name function' to create a new
-constructor in which local names have been replaced by their original
-names, reporting any unknown names.
+
+%************************************************************************
+%*                                                                     *
+\subsubsection{@rnIPBinds@s: in implicit parameter bindings}           *
+%*                                                                     *
+%************************************************************************

 
 \begin{code}
 
 \begin{code}

-rnConDecls :: TyVarNamesEnv
-          -> [RdrNameConDecl]
-          -> RnM_Fixes s [RenamedConDecl]
+rnIPBinds [] = returnM ([], emptyFVs)
+rnIPBinds ((n, expr) : binds)
+  = newIPName n                        `thenM` \ name ->
+    rnExpr expr                        `thenM` \ (expr',fvExpr) ->
+    rnIPBinds binds            `thenM` \ (binds',fvBinds) ->
+    returnM ((name, expr') : binds', fvExpr `plusFV` fvBinds)

 
 

-rnConDecls tv_env con_decls
-  = mapRn rn_decl con_decls
-  where
-    rn_decl (ConDecl name tys src_loc)
-      = pushSrcLocRn src_loc $
-       lookupConstr name       `thenRn` \ new_name ->
-       mapRn rn_bang_ty tys    `thenRn` \ new_tys  ->
-       returnRn (ConDecl new_name new_tys src_loc)
-
-    rn_decl (ConOpDecl ty1 op ty2 src_loc)
-      = pushSrcLocRn src_loc $
-       lookupConstr op         `thenRn` \ new_op  ->
-       rn_bang_ty ty1          `thenRn` \ new_ty1 ->
-       rn_bang_ty ty2          `thenRn` \ new_ty2 ->
-       returnRn (ConOpDecl new_ty1 new_op new_ty2 src_loc)
-
-    rn_decl (NewConDecl name ty src_loc)
-      = pushSrcLocRn src_loc $
-       lookupConstr name       `thenRn` \ new_name ->
-       rn_mono_ty ty           `thenRn` \ new_ty  ->
-       returnRn (NewConDecl new_name new_ty src_loc)
-
-    rn_decl (RecConDecl name fields src_loc)
-      = pushSrcLocRn src_loc $
-       lookupConstr name       `thenRn` \ new_name ->
-       mapRn rn_field fields   `thenRn` \ new_fields ->
-       returnRn (RecConDecl new_name new_fields src_loc)
-
-    rn_field (names, ty)
-      = mapRn lookupField names `thenRn` \ new_names ->
-       rn_bang_ty ty           `thenRn` \ new_ty ->
-       returnRn (new_names, new_ty) 
-
-    rn_mono_ty = rnMonoType tv_env
-    rn_poly_ty = rnPolyType tv_env
-
-    rn_bang_ty (Banged ty)
-      = rn_poly_ty ty `thenRn` \ new_ty ->
-       returnRn (Banged new_ty)
-    rn_bang_ty (Unbanged ty)
-      = rn_poly_ty ty `thenRn` \ new_ty ->
-       returnRn (Unbanged new_ty)

 \end{code}
 
 \end{code}
 

+

 %*********************************************************
 %*********************************************************

-%*                                                      *
-\subsection{SPECIALIZE data pragmas}
-%*                                                      *
+%*                                                     *
+\subsection{Foreign declarations}
+%*                                                     *

 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}

-rnSpecDataSig :: RdrNameSpecDataSig
-             -> RnM_Fixes s RenamedSpecDataSig
+rnHsForeignDecl (ForeignImport name ty spec isDeprec src_loc)
+  = addSrcLoc src_loc          $
+    lookupTopBndrRn name               `thenM` \ name' ->
+    rnHsTypeFVs (fo_decl_msg name) ty  `thenM` \ (ty', fvs) ->
+    returnM (ForeignImport name' ty' spec isDeprec src_loc, 
+             fvs `plusFV` extras spec)
+  where
+    extras (CImport _ _ _ _ CWrapper) 
+      = mkFVs [ newStablePtrName
+             , bindIOName
+             , returnIOName
+             ]
+    extras (DNImport _)               
+      = mkFVs [ bindIOName
+              , objectTyConName
+             , unmarshalObjectName
+             , marshalObjectName
+             , marshalStringName
+             , unmarshalStringName
+             , checkDotnetResName
+             ]
+    extras _                         = emptyFVs
+
+rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
+  = addSrcLoc src_loc                  $
+    lookupOccRn name                           `thenM` \ name' ->
+    rnHsTypeFVs (fo_decl_msg name) ty                  `thenM` \ (ty', fvs) ->
+    returnM (ForeignExport name' ty' spec isDeprec src_loc, 
+             mkFVs [name', bindIOName, returnIOName] `plusFV` fvs )
+       -- NB: a foreign export is an *occurrence site* for name, so 
+       --     we add it to the free-variable list.  It might, for example,
+       --     be imported from another module
+
+fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
+\end{code}
+
+
+%*********************************************************
+%*                                                     *
+\subsection{Instance declarations}
+%*                                                     *
+%*********************************************************

 
 

-rnSpecDataSig (SpecDataSig tycon ty src_loc)
-  = pushSrcLocRn src_loc $
+\begin{code}
+rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
+       -- Used for both source and interface file decls
+  = addSrcLoc src_loc $
+    rnHsSigType (text "an instance decl") inst_ty      `thenM` \ inst_ty' ->
+
+    (case maybe_dfun_rdr_name of
+       Nothing            -> returnM Nothing
+       Just dfun_rdr_name -> lookupGlobalOccRn dfun_rdr_name   `thenM` \ dfun_name ->
+                             returnM (Just dfun_name)
+    )                                                  `thenM` \ maybe_dfun_name ->
+
+    -- The typechecker checks that all the bindings are for the right class.
+    returnM (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
+
+-- Compare finishSourceTyClDecl
+finishSourceInstDecl (InstDecl _       mbinds uprags _               _      )
+                    (InstDecl inst_ty _      _      maybe_dfun_name src_loc)
+       -- Used for both source decls only
+  = ASSERT( not (maybeToBool maybe_dfun_name) )        -- Source decl!

     let
     let

-       tyvars = extractMonoTyNames is_tyvar_name ty
+       meth_doc    = text "In the bindings in an instance declaration"
+       meth_names  = collectLocatedMonoBinders mbinds
+       (inst_tyvars, _, cls,_) = splitHsInstDeclTy inst_ty
+       -- (Slightly strangely) the forall-d tyvars scope over
+       -- the method bindings too

     in
     in

-    mkTyVarNamesEnv src_loc tyvars             `thenRn` \ (tv_env,_) ->
-    lookupTyCon tycon                  `thenRn` \ tycon' ->
-    rnMonoType tv_env ty               `thenRn` \ ty' ->
-    returnRn (SpecDataSig tycon' ty' src_loc)

 
 

-is_tyvar_name n = isLexVarId (getLocalName n)
+       -- Rename the bindings
+       -- NB meth_names can be qualified!
+    checkDupNames meth_doc meth_names          `thenM_`
+    extendTyVarEnvForMethodBinds inst_tyvars (         
+       rnMethodBinds cls [] mbinds
+    )                                          `thenM` \ (mbinds', meth_fvs) ->
+    let 
+       binders = collectMonoBinders mbinds'
+    in
+       -- Rename the prags and signatures.
+       -- Note that the type variables are not in scope here,
+       -- so that      instance Eq a => Eq (T a) where
+       --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
+       -- works OK. 
+       --
+       -- But the (unqualified) method names are in scope
+    bindLocalNames binders (renameSigs uprags)                 `thenM` \ uprags' ->
+    checkSigs (okInstDclSig (mkNameSet binders)) uprags'       `thenM_`
+
+    returnM (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
+             meth_fvs `plusFV` hsSigsFVs uprags')

 \end{code}
 
 %*********************************************************
 %*                                                     *
 \end{code}
 
 %*********************************************************
 %*                                                     *

-\subsection{Class declarations}
+\subsection{Rules}

 %*                                                     *
 %*********************************************************
 
 %*                                                     *
 %*********************************************************
 

-@rnClassDecl@ uses the `global name function' to create a new
-class declaration in which local names have been replaced by their
-original names, reporting any unknown names.
+\begin{code}
+rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
+  = addSrcLoc src_loc  $
+    lookupOccRn fn             `thenM` \ fn' ->
+    rnCoreBndrs vars           $ \ vars' ->
+    mappM rnCoreExpr args      `thenM` \ args' ->
+    rnCoreExpr rhs             `thenM` \ rhs' ->
+    returnM (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
+
+rnIfaceRuleDecl (IfaceRuleOut fn rule)         -- Builtin rules come this way
+  = lookupOccRn fn             `thenM` \ fn' ->
+    returnM (IfaceRuleOut fn' rule)
+
+rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
+  = addSrcLoc src_loc                                  $
+    bindPatSigTyVarsFV (collectRuleBndrSigTys vars)    $
+
+    bindLocalsFV doc (map get_var vars)                $ \ ids ->
+    mapFvRn rn_var (vars `zip` ids)            `thenM` \ (vars', fv_vars) ->
+
+    rnExpr lhs                                 `thenM` \ (lhs', fv_lhs) ->
+    rnExpr rhs                                 `thenM` \ (rhs', fv_rhs) ->
+    let
+       mb_bad = validRuleLhs ids lhs'
+    in
+    checkErr (isNothing mb_bad)
+            (badRuleLhsErr rule_name lhs' mb_bad)      `thenM_`
+    let
+       bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
+    in
+    mappM (addErr . badRuleVar rule_name) bad_vars     `thenM_`
+    returnM (HsRule rule_name act vars' lhs' rhs' src_loc,
+             fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
+  where
+    doc = text "In the transformation rule" <+> ftext rule_name
+  
+    get_var (RuleBndr v)      = v
+    get_var (RuleBndrSig v _) = v
+
+    rn_var (RuleBndr v, id)     = returnM (RuleBndr id, emptyFVs)
+    rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t   `thenM` \ (t', fvs) ->
+                                  returnM (RuleBndrSig id t', fvs)
+\end{code}
+
+Check the shape of a transformation rule LHS.  Currently
+we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
+not one of the @forall@'d variables.  We also restrict the form of the LHS so
+that it may be plausibly matched.  Basically you only get to write ordinary 
+applications.  (E.g. a case expression is not allowed: too elaborate.)
+
+NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs

 
 \begin{code}
 
 \begin{code}

-rnClassDecl :: RdrNameClassDecl -> RnM_Fixes s RenamedClassDecl
-
-rnClassDecl (ClassDecl context cname tyvar sigs mbinds pragmas src_loc)
-  = pushSrcLocRn src_loc $
-    mkTyVarNamesEnv src_loc [tyvar]        `thenRn` \ (tv_env, [tyvar']) ->
-    rnContext tv_env src_loc context       `thenRn` \ context' ->
-    lookupClass cname                      `thenRn` \ cname' ->
-    mapRn (rn_op cname' tyvar' tv_env) sigs `thenRn` \ sigs' ->
-    rnMethodBinds cname' mbinds                    `thenRn` \ mbinds' ->
-    ASSERT(isNoClassPragmas pragmas)
-    returnRn (ClassDecl context' cname' tyvar' sigs' mbinds' NoClassPragmas src_loc)
+validRuleLhs :: [Name] -> RenamedHsExpr -> Maybe RenamedHsExpr
+-- Nothing => OK
+-- Just e  => Not ok, and e is the offending expression
+validRuleLhs foralls lhs
+  = check lhs

   where
   where

-    rn_op clas clas_tyvar tv_env sig@(ClassOpSig op ty pragmas locn)
-      = pushSrcLocRn locn $
-       lookupClassOp clas op           `thenRn` \ op_name ->
-       rnPolyType tv_env ty            `thenRn` \ new_ty  ->
-       let
-           (HsForAllTy tvs ctxt op_ty) = new_ty
-           ctxt_tvs = extractCtxtTyNames ctxt
-           op_tvs   = extractMonoTyNames is_tyvar_name op_ty
-       in
-       -- check that class tyvar appears in op_ty
-        ( if isIn "rn_op" clas_tyvar op_tvs
-         then returnRn ()
-         else addErrRn (classTyVarNotInOpTyErr clas_tyvar sig locn)
-       ) `thenRn_`
-
-       -- check that class tyvar *doesn't* appear in the sig's context
-        ( if isIn "rn_op(2)" clas_tyvar ctxt_tvs
-         then addErrRn (classTyVarInOpCtxtErr clas_tyvar sig locn)
-         else returnRn ()
-       ) `thenRn_`
-
-       ASSERT(isNoClassOpPragmas pragmas)
-       returnRn (ClassOpSig op_name new_ty noClassOpPragmas locn)
+    check (OpApp e1 op _ e2)             = check op `seqMaybe` check_e e1 `seqMaybe` check_e e2
+    check (HsApp e1 e2)                  = check e1 `seqMaybe` check_e e2
+    check (HsVar v) | v `notElem` foralls = Nothing
+    check other                                  = Just other  -- Failure
+
+    check_e (HsVar v)     = Nothing
+    check_e (HsPar e)    = check_e e
+    check_e (HsLit e)    = Nothing
+    check_e (HsOverLit e) = Nothing
+
+    check_e (OpApp e1 op _ e2)          = check_e e1 `seqMaybe` check_e op `seqMaybe` check_e e2
+    check_e (HsApp e1 e2)               = check_e e1 `seqMaybe` check_e e2
+    check_e (NegApp e _)                = check_e e
+    check_e (ExplicitList _ es)         = check_es es
+    check_e (ExplicitTuple es _) = check_es es
+    check_e other               = Just other   -- Fails
+
+    check_es es = foldr (seqMaybe . check_e) Nothing es

 \end{code}
 
 
 %*********************************************************
 %*                                                     *
 \end{code}
 
 
 %*********************************************************
 %*                                                     *

-\subsection{Instance declarations}
+\subsection{Type, class and iface sig declarations}

 %*                                                     *
 %*********************************************************
 
 %*                                                     *
 %*********************************************************
 

+@rnTyDecl@ uses the `global name function' to create a new type
+declaration in which local names have been replaced by their original
+names, reporting any unknown names.

 
 

-@rnInstDecl@ uses the `global name function' to create a new of
-instance declaration in which local names have been replaced by their
-original names, reporting any unknown names.
+Renaming type variables is a pain. Because they now contain uniques,
+it is necessary to pass in an association list which maps a parsed
+tyvar to its @Name@ representation.
+In some cases (type signatures of values),
+it is even necessary to go over the type first
+in order to get the set of tyvars used by it, make an assoc list,
+and then go over it again to rename the tyvars!
+However, we can also do some scoping checks at the same time.

 
 \begin{code}
 
 \begin{code}

-rnInstDecl :: RdrNameInstDecl -> RnM_Fixes s RenamedInstDecl
+rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
+  = addSrcLoc loc $
+    lookupTopBndrRn name               `thenM` \ name' ->
+    rnHsType doc_str ty                        `thenM` \ ty' ->
+    mappM rnIdInfo id_infos            `thenM` \ id_infos' -> 
+    returnM (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
+  where
+    doc_str = text "In the interface signature for" <+> quotes (ppr name)
+
+rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
+  = addSrcLoc loc                      $
+    lookupTopBndrRn name               `thenM` \ name' ->
+    returnM (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
+
+rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
+                   tcdTyVars = tyvars, tcdCons = condecls, tcdGeneric = want_generic,
+                   tcdDerivs = derivs, tcdLoc = src_loc})
+  = addSrcLoc src_loc $
+    lookupTopBndrRn tycon                      `thenM` \ tycon' ->
+    bindTyVarsRn data_doc tyvars               $ \ tyvars' ->
+    rnContext data_doc context                         `thenM` \ context' ->
+    rn_derivs derivs                           `thenM` \ derivs' ->
+    checkDupOrQualNames data_doc con_names     `thenM_`
+
+    rnConDecls tycon' condecls                 `thenM` \ condecls' ->
+    returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
+                    tcdTyVars = tyvars', tcdCons = condecls', tcdGeneric = want_generic,
+                    tcdDerivs = derivs', tcdLoc = src_loc})
+  where
+    data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
+    con_names = map conDeclName (visibleDataCons condecls)
+
+    rn_derivs Nothing   = returnM Nothing
+    rn_derivs (Just ds) = rnContext data_doc ds        `thenM` \ ds' -> returnM (Just ds')
+    
+rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
+  = addSrcLoc src_loc $
+    lookupTopBndrRn name                       `thenM` \ name' ->
+    bindTyVarsRn syn_doc tyvars                $ \ tyvars' ->
+    rnHsType syn_doc ty                                `thenM` \ ty' ->
+    returnM (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
+  where
+    syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
+
+rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname, 
+                      tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs, 
+                      tcdLoc = src_loc})
+       -- Used for both source and interface file decls
+  = addSrcLoc src_loc $
+
+    lookupTopBndrRn cname                      `thenM` \ cname' ->

 
 

-rnInstDecl (InstDecl cname ty mbinds from_here modname uprags pragmas src_loc)
-  = pushSrcLocRn src_loc $
-    lookupClass cname                  `thenRn` \ cname' ->
+       -- Tyvars scope over superclass context and method signatures
+    bindTyVarsRn cls_doc tyvars                        $ \ tyvars' ->

 
 

-    rnPolyType [] ty                   `thenRn` \ ty' ->
-       -- [] tv_env ensures that tyvars will be foralled
+       -- Check the superclasses
+    rnContext cls_doc context                  `thenM` \ context' ->

 
 

-    rnMethodBinds cname' mbinds                `thenRn` \ mbinds' ->
-    mapRn (rn_uprag cname') uprags     `thenRn` \ new_uprags ->
+       -- Check the functional dependencies
+    rnFds cls_doc fds                          `thenM` \ fds' ->

 
 

-    ASSERT(isNoInstancePragmas pragmas)
-    returnRn (InstDecl cname' ty' mbinds'
-                      from_here modname new_uprags noInstancePragmas src_loc)
+       -- Check the signatures
+       -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
+    let
+       (op_sigs, non_op_sigs) = partition isClassOpSig sigs
+       sig_rdr_names_w_locs   = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
+    in
+    checkDupOrQualNames sig_doc sig_rdr_names_w_locs   `thenM_` 
+    mappM (rnClassOp cname' fds') op_sigs              `thenM` \ sigs' ->
+    renameSigs non_op_sigs                             `thenM` \ non_ops' ->
+    checkSigs okClsDclSig  non_ops'                    `thenM_`
+       -- Typechecker is responsible for checking that we only
+       -- give default-method bindings for things in this class.
+       -- The renamer *could* check this for class decls, but can't
+       -- for instance decls.
+
+    returnM (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
+                        tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing, 
+                        tcdLoc = src_loc})
+  where
+    cls_doc  = text "In the declaration for class"     <+> ppr cname
+    sig_doc  = text "In the signatures for class"      <+> ppr cname
+
+rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
+  = addSrcLoc locn $
+    lookupTopBndrRn op                 `thenM` \ op_name ->
+    
+       -- Check the signature
+    rnHsSigType (quotes (ppr op)) ty   `thenM` \ new_ty ->
+    
+       -- Make the default-method name
+    (case dm_stuff of 
+        DefMeth dm_rdr_name
+           ->  -- Imported class that has a default method decl
+               lookupSysBndr dm_rdr_name       `thenM` \ dm_name ->
+               returnM (DefMeth dm_name)
+                       -- An imported class decl for a class decl that had an explicit default
+                       -- method, mentions, rather than defines,
+                       -- the default method, so we must arrange to pull it in
+
+        GenDefMeth -> returnM GenDefMeth
+        NoDefMeth  -> returnM NoDefMeth
+    )                                          `thenM` \ dm_stuff' ->
+    
+    returnM (ClassOpSig op_name dm_stuff' new_ty locn)
+
+finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnM (RenamedTyClDecl, FreeVars)
+       -- Used for source file decls only
+       -- Renames the default-bindings of a class decl
+finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc})    -- Get mbinds from here
+        rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars})            -- Everything else is here
+  -- There are some default-method bindings (abeit possibly empty) so 
+  -- this is a source-code class declaration
+  =    -- The newLocals call is tiresome: given a generic class decl
+       --      class C a where
+       --        op :: a -> a
+       --        op {| x+y |} (Inl a) = ...
+       --        op {| x+y |} (Inr b) = ...
+       --        op {| a*b |} (a*b)   = ...
+       -- we want to name both "x" tyvars with the same unique, so that they are
+       -- easy to group together in the typechecker.  
+       -- Hence the 
+    addSrcLoc src_loc                          $
+    extendTyVarEnvForMethodBinds tyvars                        $
+    getLocalRdrEnv                                     `thenM` \ name_env ->
+    let
+       meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
+       gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
+                                               not (tv `elemRdrEnv` name_env)]
+    in
+    checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenM_`
+    newLocalsRn gen_rdr_tyvars_w_locs                  `thenM` \ gen_tyvars ->
+    rnMethodBinds cls gen_tyvars mbinds                        `thenM` \ (mbinds', meth_fvs) ->
+    returnM (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)

   where
   where

-    rn_uprag class_name (SpecSig op ty using locn)
-      = pushSrcLocRn src_loc $
-       lookupClassOp class_name op     `thenRn` \ op_name ->
-       rnPolyType nullTyVarNamesEnv ty `thenRn` \ new_ty ->
-       rn_using using                  `thenRn` \ new_using ->
-       returnRn (SpecSig op_name new_ty new_using locn)
-
-    rn_uprag class_name (InlineSig op locn)
-      = pushSrcLocRn locn $
-       lookupClassOp class_name op     `thenRn` \ op_name ->
-       returnRn (InlineSig op_name locn)
-
-    rn_uprag class_name (DeforestSig op locn)
-      = pushSrcLocRn locn $
-       lookupClassOp class_name op     `thenRn` \ op_name ->
-       returnRn (DeforestSig op_name locn)
-
-    rn_uprag class_name (MagicUnfoldingSig op str locn)
-      = pushSrcLocRn locn $
-       lookupClassOp class_name op     `thenRn` \ op_name ->
-       returnRn (MagicUnfoldingSig op_name str locn)
-
-    rn_using Nothing 
-      = returnRn Nothing
-    rn_using (Just v)
-      = lookupValue v  `thenRn` \ new_v ->
-       returnRn (Just new_v)
+    meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
+
+finishSourceTyClDecl _ tycl_decl@(TyData {tcdDerivs = derivings})
+  -- Derivings are returned here so that they don't form part of the tyClDeclFVs.
+  -- This is important, because tyClDeclFVs should contain only the
+  -- FVs that are `needed' by the interface file declaration, and
+  -- derivings do not appear in this.  It also means that the tcGroups
+  -- are smaller, which turned out to be important for the usage inference. KSW 2002-02.
+  = returnM (tycl_decl,
+              maybe emptyFVs extractHsCtxtTyNames derivings)
+
+finishSourceTyClDecl _ tycl_decl = returnM (tycl_decl, emptyFVs)
+       -- Not a class declaration

 \end{code}
 
 \end{code}
 

-%*********************************************************
-%*                                                     *
-\subsection{@SPECIALIZE instance@ user-pragmas}
-%*                                                     *
-%*********************************************************
+For the method bindings in class and instance decls, we extend the 
+type variable environment iff -fglasgow-exts

 
 \begin{code}
 
 \begin{code}

-rnSpecInstSig :: RdrNameSpecInstSig
-             -> RnM_Fixes s RenamedSpecInstSig
-
-rnSpecInstSig (SpecInstSig clas ty src_loc)
-  = pushSrcLocRn src_loc $
-    let
-       tyvars = extractMonoTyNames is_tyvar_name ty
-    in
-    mkTyVarNamesEnv src_loc tyvars             `thenRn` \ (tv_env,_) ->
-    lookupClass clas                   `thenRn` \ new_clas ->
-    rnMonoType tv_env ty               `thenRn` \ new_ty ->
-    returnRn (SpecInstSig new_clas new_ty src_loc)
+extendTyVarEnvForMethodBinds tyvars thing_inside
+  = doptM Opt_GlasgowExts                      `thenM` \ opt_GlasgowExts ->
+    if opt_GlasgowExts then
+       extendTyVarEnvFVRn (map hsTyVarName tyvars) thing_inside
+    else
+       thing_inside

 \end{code}
 
 \end{code}
 

+

 %*********************************************************
 %*                                                     *
 %*********************************************************
 %*                                                     *

-\subsection{Default declarations}
+\subsection{Support code for type/data declarations}

 %*                                                     *
 %*********************************************************
 
 %*                                                     *
 %*********************************************************
 

-@rnDefaultDecl@ uses the `global name function' to create a new set
-of default declarations in which local names have been replaced by
-their original names, reporting any unknown names.
-

 \begin{code}
 \begin{code}

-rnDefaultDecl :: [RdrNameDefaultDecl] -> RnM_Fixes s [RenamedDefaultDecl]
-
-rnDefaultDecl [] = returnRn []
-rnDefaultDecl [DefaultDecl tys src_loc]
-  = pushSrcLocRn src_loc $
-    mapRn (rnMonoType nullTyVarNamesEnv) tys `thenRn` \ tys' ->
-    returnRn [DefaultDecl tys' src_loc]
-rnDefaultDecl defs@(d:ds)
-  = addErrRn (dupDefaultDeclErr defs) `thenRn_`
-    rnDefaultDecl [d]
-\end{code}
+conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
+conDeclName (ConDecl n _ _ _ l) = (n,l)
+
+rnConDecls :: Name -> DataConDetails RdrNameConDecl -> RnM (DataConDetails RenamedConDecl)
+rnConDecls tycon Unknown     = returnM Unknown
+rnConDecls tycon (HasCons n) = returnM (HasCons n)
+rnConDecls tycon (DataCons condecls)
+  =    -- Check that there's at least one condecl,
+       -- or else we're reading an interface file, or -fglasgow-exts
+    (if null condecls then
+       doptM Opt_GlasgowExts   `thenM` \ glaExts ->
+       getModeRn               `thenM` \ mode ->
+       checkErr (glaExts || isInterfaceMode mode)
+               (emptyConDeclsErr tycon)
+     else returnM ()
+    )                                          `thenM_` 
+
+    mappM rnConDecl condecls                   `thenM` \ condecls' ->
+    returnM (DataCons condecls')
+
+rnConDecl :: RdrNameConDecl -> RnM RenamedConDecl
+rnConDecl (ConDecl name tvs cxt details locn)
+  = addSrcLoc locn $
+    checkConName name          `thenM_` 
+    lookupTopBndrRn name       `thenM` \ new_name ->
+
+    bindTyVarsRn doc tvs               $ \ new_tyvars ->
+    rnContext doc cxt                  `thenM` \ new_context ->
+    rnConDetails doc locn details      `thenM` \ new_details -> 
+    returnM (ConDecl new_name new_tyvars new_context new_details locn)
+  where
+    doc = text "In the definition of data constructor" <+> quotes (ppr name)

 
 

-%*************************************************************************
-%*                                                                     *
-\subsection{Fixity declarations}
-%*                                                                     *
-%*************************************************************************
+rnConDetails doc locn (PrefixCon tys)
+  = mappM (rnBangTy doc) tys   `thenM` \ new_tys  ->
+    returnM (PrefixCon new_tys)

 
 

-\begin{code}
-rnFixes :: [RdrNameFixityDecl]  -> RnM s [RenamedFixityDecl]
+rnConDetails doc locn (InfixCon ty1 ty2)
+  = rnBangTy doc ty1           `thenM` \ new_ty1 ->
+    rnBangTy doc ty2           `thenM` \ new_ty2 ->
+    returnM (InfixCon new_ty1 new_ty2)

 
 

-rnFixes fixities
-  = getSrcLocRn        `thenRn` \ src_loc ->
-    let
-        (_, dup_fixes) = removeDups cmp_fix fixities
-       cmp_fix fix1 fix2 = fixDeclName fix1 `cmp` fixDeclName fix2
-
-        rn_fixity fix@(InfixL name i)
-         = rn_fixity_pieces InfixL name i fix
-       rn_fixity fix@(InfixR name i)
-         = rn_fixity_pieces InfixR name i fix
-       rn_fixity fix@(InfixN name i)
-         = rn_fixity_pieces InfixN name i fix
-
-       rn_fixity_pieces mk_fixity name i fix
-         = getRnEnv `thenRn` \ env ->
-             case lookupGlobalRnEnv env name of
-               Just res | isLocallyDefined res -- || opt_CompilingGhcInternals
-                 -- the opt_CompilingGhcInternals thing is a *HACK* to get (:)'s
-                 -- fixity decl to go through.  It has a builtin name, which
-                 -- doesn't respond to isLocallyDefined...  sigh.
-                 -> returnRn (Just (mk_fixity res i))
-               _ -> failButContinueRn Nothing (undefinedFixityDeclErr src_loc fix)
-    in
-    mapRn (addErrRn . dupFixityDeclErr src_loc) dup_fixes `thenRn_`
-    mapRn rn_fixity fixities                             `thenRn` \ fixes_maybe ->
-    returnRn (catMaybes fixes_maybe)
+rnConDetails doc locn (RecCon fields)
+  = checkDupOrQualNames doc field_names        `thenM_`
+    mappM (rnField doc) fields         `thenM` \ new_fields ->
+    returnM (RecCon new_fields)
+  where
+    field_names = [(fld, locn) | (fld, _) <- fields]
+
+rnField doc (name, ty)
+  = lookupTopBndrRn name       `thenM` \ new_name ->
+    rnBangTy doc ty            `thenM` \ new_ty ->
+    returnM (new_name, new_ty) 
+
+rnBangTy doc (BangType s ty)
+  = rnHsType doc ty            `thenM` \ new_ty ->
+    returnM (BangType s new_ty)
+
+-- This data decl will parse OK
+--     data T = a Int
+-- treating "a" as the constructor.
+-- It is really hard to make the parser spot this malformation.
+-- So the renamer has to check that the constructor is legal
+--
+-- We can get an operator as the constructor, even in the prefix form:
+--     data T = :% Int Int
+-- from interface files, which always print in prefix form
+
+checkConName name
+  = checkErr (isRdrDataCon name) (badDataCon name)

 \end{code}
 
 \end{code}
 

+

 %*********************************************************
 %*                                                     *
 \subsection{Support code to rename types}
 %*********************************************************
 %*                                                     *
 \subsection{Support code to rename types}

@@ -664,180 +763,239 @@ rnFixes fixities
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}

-rnPolyType :: TyVarNamesEnv
-          -> RdrNamePolyType
-          -> RnM_Fixes s RenamedPolyType
+rnFds :: SDoc -> [FunDep RdrName] -> RnM [FunDep Name]

 
 

-rnPolyType tv_env (HsForAllTy tvs ctxt ty)
-  = rn_poly_help tv_env tvs ctxt ty
-
-rnPolyType tv_env (HsPreForAllTy ctxt ty)
-  = rn_poly_help tv_env forall_tyvars ctxt ty
+rnFds doc fds
+  = mappM rn_fds fds

   where
   where

-    mentioned_tyvars = extractCtxtTyNames ctxt `unionLists` extractMonoTyNames is_tyvar_name ty
-    forall_tyvars    = {-
-                      pprTrace "mentioned:" (ppCat (map (ppr PprShowAll) mentioned_tyvars)) $
-                      pprTrace "from_ty:" (ppCat (map (ppr PprShowAll) (extractMonoTyNames is_tyvar_name ty))) $
-                      -}
-                      mentioned_tyvars `minusList` domTyVarNamesEnv tv_env
-
-------------
-rn_poly_help :: TyVarNamesEnv
-            -> [RdrName]
-            -> RdrNameContext
-            -> RdrNameMonoType
-            -> RnM_Fixes s RenamedPolyType
-
-rn_poly_help tv_env tyvars ctxt ty
-  = {-
-    pprTrace "rnPolyType:"
-       (ppCat [ppCat (map (ppr PprShowAll . snd) tv_env),
-               ppStr ";tvs=", ppCat (map (ppr PprShowAll) tyvars),
-               ppStr ";ctxt=", ppCat (map (ppr PprShowAll) ctxt),
-               ppStr ";ty=", ppr PprShowAll ty]) $
-    -}
-    getSrcLocRn                        `thenRn` \ src_loc ->
-    mkTyVarNamesEnv src_loc tyvars     `thenRn` \ (tv_env1, new_tyvars) ->
-    let
-       tv_env2 = catTyVarNamesEnvs tv_env1 tv_env
-    in
-    rnContext tv_env2 src_loc ctxt     `thenRn` \ new_ctxt ->
-    rnMonoType tv_env2 ty              `thenRn` \ new_ty ->
-    returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
+    rn_fds (tys1, tys2)
+      =        rnHsTyVars doc tys1             `thenM` \ tys1' ->
+       rnHsTyVars doc tys2             `thenM` \ tys2' ->
+       returnM (tys1', tys2')
+
+rnHsTyVars doc tvs  = mappM (rnHsTyvar doc) tvs
+rnHsTyvar doc tyvar = lookupOccRn tyvar

 \end{code}
 
 \end{code}
 

+%*********************************************************
+%*                                                      *
+\subsection{IdInfo}
+%*                                                      *
+%*********************************************************
+

 \begin{code}
 \begin{code}

-rnMonoType :: TyVarNamesEnv
-          -> RdrNameMonoType
-          -> RnM_Fixes s RenamedMonoType
-
-rnMonoType tv_env (MonoTyVar tyvar)
-  = lookupTyVarName tv_env tyvar       `thenRn` \ tyvar' ->
-    returnRn (MonoTyVar tyvar')
-
-rnMonoType tv_env (MonoListTy ty)
-  = rnMonoType tv_env ty       `thenRn` \ ty' ->
-    returnRn (MonoListTy ty')
-
-rnMonoType tv_env (MonoFunTy ty1 ty2)
-  = andRn MonoFunTy (rnMonoType tv_env ty1)
-                   (rnMonoType tv_env ty2)
-
-rnMonoType  tv_env (MonoTupleTy tys)
-  = mapRn (rnMonoType tv_env) tys `thenRn` \ tys' ->
-    returnRn (MonoTupleTy tys')
-
-rnMonoType tv_env (MonoTyApp name tys)
-  = let
-       lookup_fn = if isLexVarId (getLocalName name) 
-                   then lookupTyVarName tv_env
-                   else lookupTyCon
-    in
-    lookup_fn name                     `thenRn` \ name' ->
-    mapRn (rnMonoType tv_env) tys      `thenRn` \ tys' ->
-    returnRn (MonoTyApp name' tys')
+rnIdInfo (HsWorker worker arity)
+  = lookupOccRn worker                 `thenM` \ worker' ->
+    returnM (HsWorker worker' arity)
+
+rnIdInfo (HsUnfold inline expr)        = rnCoreExpr expr `thenM` \ expr' ->
+                                 returnM (HsUnfold inline expr')
+rnIdInfo (HsStrictness str)     = returnM (HsStrictness str)
+rnIdInfo (HsArity arity)       = returnM (HsArity arity)
+rnIdInfo HsNoCafRefs           = returnM HsNoCafRefs

 \end{code}
 
 \end{code}
 

+@UfCore@ expressions.
+

 \begin{code}
 \begin{code}

-rnContext :: TyVarNamesEnv -> SrcLoc -> RdrNameContext -> RnM_Fixes s RenamedContext
+rnCoreExpr (UfType ty)
+  = rnHsType (text "unfolding type") ty        `thenM` \ ty' ->
+    returnM (UfType ty')
+
+rnCoreExpr (UfVar v)
+  = lookupOccRn v      `thenM` \ v' ->
+    returnM (UfVar v')
+
+rnCoreExpr (UfLit l)
+  = returnM (UfLit l)
+
+rnCoreExpr (UfLitLit l ty)
+  = rnHsType (text "litlit") ty        `thenM` \ ty' ->
+    returnM (UfLitLit l ty')
+
+rnCoreExpr (UfFCall cc ty)
+  = rnHsType (text "ccall") ty `thenM` \ ty' ->
+    returnM (UfFCall cc ty')
+
+rnCoreExpr (UfTuple (HsTupCon boxity arity) args) 
+  = mappM rnCoreExpr args              `thenM` \ args' ->
+    returnM (UfTuple (HsTupCon boxity arity) args')
+
+rnCoreExpr (UfApp fun arg)
+  = rnCoreExpr fun             `thenM` \ fun' ->
+    rnCoreExpr arg             `thenM` \ arg' ->
+    returnM (UfApp fun' arg')
+
+rnCoreExpr (UfCase scrut bndr alts)
+  = rnCoreExpr scrut                   `thenM` \ scrut' ->
+    bindCoreLocalRn bndr               $ \ bndr' ->
+    mappM rnCoreAlt alts               `thenM` \ alts' ->
+    returnM (UfCase scrut' bndr' alts')
+
+rnCoreExpr (UfNote note expr) 
+  = rnNote note                        `thenM` \ note' ->
+    rnCoreExpr expr            `thenM` \ expr' ->
+    returnM  (UfNote note' expr')
+
+rnCoreExpr (UfLam bndr body)
+  = rnCoreBndr bndr            $ \ bndr' ->
+    rnCoreExpr body            `thenM` \ body' ->
+    returnM (UfLam bndr' body')
+
+rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
+  = rnCoreExpr rhs             `thenM` \ rhs' ->
+    rnCoreBndr bndr            $ \ bndr' ->
+    rnCoreExpr body            `thenM` \ body' ->
+    returnM (UfLet (UfNonRec bndr' rhs') body')
+
+rnCoreExpr (UfLet (UfRec pairs) body)
+  = rnCoreBndrs bndrs          $ \ bndrs' ->
+    mappM rnCoreExpr rhss      `thenM` \ rhss' ->
+    rnCoreExpr body            `thenM` \ body' ->
+    returnM (UfLet (UfRec (bndrs' `zip` rhss')) body')
+  where
+    (bndrs, rhss) = unzip pairs
+\end{code}

 
 

-rnContext tv_env locn ctxt
-  = mapRn rn_ctxt ctxt `thenRn` \ result ->
-    let
-       (_, dup_asserts) = removeDups cmp_assert result
-    in
-    -- If this isn't an error, then it ought to be:
-    mapRn (addWarnRn . dupClassAssertWarn result locn) dup_asserts `thenRn_`
-    returnRn result
+\begin{code}
+rnCoreBndr (UfValBinder name ty) thing_inside
+  = rnHsType doc ty            `thenM` \ ty' ->
+    bindCoreLocalRn name       $ \ name' ->
+    thing_inside (UfValBinder name' ty')

   where
   where

-    rn_ctxt (clas, tyvar)
-      = lookupClass clas            `thenRn` \ clas_name ->
-       lookupTyVarName tv_env tyvar `thenRn` \ tyvar_name ->
-       returnRn (clas_name, tyvar_name)
+    doc = text "unfolding id"
+    
+rnCoreBndr (UfTyBinder name kind) thing_inside
+  = bindCoreLocalRn name               $ \ name' ->
+    thing_inside (UfTyBinder name' kind)
+    
+rnCoreBndrs []     thing_inside = thing_inside []
+rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b         $ \ name' ->
+                                 rnCoreBndrs bs        $ \ names' ->
+                                 thing_inside (name':names')
+\end{code}    
+
+\begin{code}
+rnCoreAlt (con, bndrs, rhs)
+  = rnUfCon con                        `thenM` \ con' ->
+    bindCoreLocalsRn bndrs             $ \ bndrs' ->
+    rnCoreExpr rhs                     `thenM` \ rhs' ->
+    returnM (con', bndrs', rhs')
+
+rnNote (UfCoerce ty)
+  = rnHsType (text "unfolding coerce") ty      `thenM` \ ty' ->
+    returnM (UfCoerce ty')

 
 

-    cmp_assert (c1,tv1) (c2,tv2)
-      = (c1 `cmp` c2) `thenCmp` (tv1 `cmp` tv2)
+rnNote (UfSCC cc)   = returnM (UfSCC cc)
+rnNote UfInlineCall = returnM UfInlineCall
+rnNote UfInlineMe   = returnM UfInlineMe
+rnNote (UfCoreNote s) = returnM (UfCoreNote s)
+
+rnUfCon UfDefault
+  = returnM UfDefault
+
+rnUfCon (UfTupleAlt tup_con)
+  = returnM (UfTupleAlt tup_con)
+
+rnUfCon (UfDataAlt con)
+  = lookupOccRn con            `thenM` \ con' ->
+    returnM (UfDataAlt con')
+
+rnUfCon (UfLitAlt lit)
+  = returnM (UfLitAlt lit)
+
+rnUfCon (UfLitLitAlt lit ty)
+  = rnHsType (text "litlit") ty                `thenM` \ ty' ->
+    returnM (UfLitLitAlt lit ty')

 \end{code}
 
 \end{code}
 

+%*********************************************************
+%*                                                     *
+\subsection{Statistics}
+%*                                                     *
+%*********************************************************

 
 \begin{code}
 
 \begin{code}

-dupNameExportWarn locn names@((n,_):_)
-  = addShortWarnLocLine locn $ \ sty ->
-    ppCat [pprNonSym sty n, ppStr "exported", ppInt (length names), ppStr "times"]
-
-dupLocalsExportErr locn locals@((str,_):_)
-  = addErrLoc locn "exported names have same local name" $ \ sty ->
-    ppInterleave ppSP (map (pprNonSym sty . snd) locals)
-
-classOpExportErr op locn
-  = addShortErrLocLine locn $ \ sty ->
-    ppBesides [ppStr "class operation `", ppr sty op, ppStr "' can only be exported with its class"]
-
-fieldExportErr op locn
-  = addShortErrLocLine locn $ \ sty ->
-    ppBesides [ppStr "field name `", ppr sty op, ppStr "' can only be exported with its data type"]
-
-synAllExportErr is_error syn locn
-  = (if is_error then addShortErrLocLine else addShortWarnLocLine) locn $ \ sty ->
-    ppBesides [ppStr "type synonym `", ppr sty syn, ppStr "' should be exported abstractly"]
-
-withExportErr str rn has rns locn
-  = addErrLoc locn "" $ \ sty ->
-    ppAboves [ ppBesides [ppStr "inconsistent list of ", ppStr str, ppStr " in export list for `", ppr sty rn, ppStr "'"],
-              ppCat [ppStr "    expected:", ppInterleave ppComma (map (ppr sty) has)],
-              ppCat [ppStr "    found:   ", ppInterleave ppComma (map (ppr sty) rns)] ]
-
-importAllErr rn locn
-  = addShortErrLocLine locn $ \ sty ->
-    ppBesides [ ppStr "`", pprNonSym sty rn, ppStr "' has been exported with (..), but is only imported abstractly"]
-
-badModExportErr mod locn
-  = addShortErrLocLine locn $ \ sty ->
-    ppCat [ ppStr "unknown module in export list: module", ppPStr mod]
-
-emptyModExportWarn locn mod
-  = addShortWarnLocLine locn $ \ sty ->
-    ppCat [ppStr "module", ppPStr mod, ppStr "has no unqualified imports to export"]
-
-dupModExportWarn locn mods@(mod:_)
-  = addShortWarnLocLine locn $ \ sty ->
-    ppCat [ppStr "module", ppPStr mod, ppStr "appears", ppInt (length mods), ppStr "times in export list"]
-
-derivingNonStdClassErr clas locn
-  = addShortErrLocLine locn $ \ sty ->
-    ppCat [ppStr "non-standard class in deriving:", ppr sty clas]
-
-dupDefaultDeclErr (DefaultDecl _ locn1 : dup_things) sty
-  = ppAboves (item1 : map dup_item dup_things)
+rnStats :: [RenamedHsDecl]     -- Imported decls
+       -> TcRn m ()
+rnStats imp_decls
+  = doptM Opt_D_dump_rn_trace  `thenM` \ dump_rn_trace ->
+    doptM Opt_D_dump_rn_stats  `thenM` \ dump_rn_stats ->
+    doptM Opt_D_dump_rn        `thenM` \ dump_rn ->
+    getEps                     `thenM` \ eps ->
+
+    ioToTcRn (dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
+                       "Renamer statistics"
+                       (getRnStats eps imp_decls))     `thenM_`
+    returnM ()
+
+getRnStats :: ExternalPackageState -> [RenamedHsDecl] -> SDoc
+getRnStats eps imported_decls
+  = hcat [text "Renamer stats: ", stats]

   where
   where

-    item1
-      = addShortErrLocLine locn1 (\ sty ->
-       ppStr "multiple default declarations") sty
-
-    dup_item (DefaultDecl _ locn)
-      = addShortErrLocLine locn (\ sty ->
-       ppStr "here was another default declaration") sty
-
-undefinedFixityDeclErr locn decl
-  = addErrLoc locn "fixity declaration for unknown operator" $ \ sty ->
-    ppr sty decl
-
-dupFixityDeclErr locn dups
-  = addErrLoc locn "multiple fixity declarations for same operator" $ \ sty ->
-    ppAboves (map (ppr sty) dups)
-
-classTyVarNotInOpTyErr clas_tyvar sig locn
-  = addShortErrLocLine locn $ \ sty ->
-    ppHang (ppBesides [ppStr "Class type variable `", ppr sty clas_tyvar, ppStr "' does not appear in method signature:"])
-        4 (ppr sty sig)
-
-classTyVarInOpCtxtErr clas_tyvar sig locn
-  = addShortErrLocLine locn $ \ sty ->
-    ppHang (ppBesides [ppStr "Class type variable `", ppr sty clas_tyvar, ppStr "' present in method's local overloading context:"])
-        4 (ppr sty sig)
-
-dupClassAssertWarn ctxt locn dups
-  = addShortWarnLocLine locn $ \ sty ->
-    ppHang (ppBesides [ppStr "Duplicate class assertion `", ppr sty dups, ppStr "' in context:"])
-        4 (ppr sty ctxt)
+    n_mods = length [() | _ <- moduleEnvElts (eps_PIT eps)]
+       -- This is really only right for a one-shot compile
+
+    (decls_map, n_decls_slurped) = eps_decls eps
+    
+    n_decls_left   = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
+                       -- Data, newtype, and class decls are in the decls_fm
+                       -- under multiple names; the tycon/class, and each
+                       -- constructor/class op too.
+                       -- The 'True' selects just the 'main' decl
+                    ]
+    
+    (insts_left, n_insts_slurped) = eps_insts eps
+    n_insts_left  = length (bagToList insts_left)
+    
+    (rules_left, n_rules_slurped) = eps_rules eps
+    n_rules_left  = length (bagToList rules_left)
+    
+    stats = vcat 
+       [int n_mods <+> text "interfaces read",
+        hsep [ int n_decls_slurped, text "type/class/variable imported, out of", 
+               int (n_decls_slurped + n_decls_left), text "read"],
+        hsep [ int n_insts_slurped, text "instance decls imported, out of",  
+               int (n_insts_slurped + n_insts_left), text "read"],
+        hsep [ int n_rules_slurped, text "rule decls imported, out of",  
+               int (n_rules_slurped + n_rules_left), text "read"]
+       ]
+\end{code}    
+
+%*********************************************************
+%*                                                      *
+\subsection{Errors}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+badDataCon name
+   = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
+
+badRuleLhsErr name lhs (Just bad_e)
+  = sep [ptext SLIT("Rule") <+> ftext name <> colon,
+        nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e, 
+                      ptext SLIT("in left-hand side:") <+> ppr lhs])]
+    $$
+    ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
+
+badRuleVar name var
+  = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
+        ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+> 
+               ptext SLIT("does not appear on left hand side")]
+
+emptyConDeclsErr tycon
+  = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
+        nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
+
+withWarning
+  = sep [quotes (ptext SLIT("with")),
+        ptext SLIT("is deprecated, use"),
+        quotes (ptext SLIT("let")),
+        ptext SLIT("instead")]
+
+badIpBinds binds
+  = hang (ptext SLIT("Implicit-parameter bindings illegal in 'mdo':")) 4
+        (ppr binds)

 \end{code}
 \end{code}

+