projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2000-10-03 08:43:00 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnSource.lhs
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 1dddb22..c99a24b 100644 (file)
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -4,68 +4,68 @@
 \section[RnSource]{Main pass of renamer}
 
 \begin{code}
 \section[RnSource]{Main pass of renamer}
 
 \begin{code}
-module RnSource ( rnIfaceDecl, rnSourceDecls, rnHsType, rnHsSigType ) where
+module RnSource ( rnDecl, rnSourceDecls, rnHsType, rnHsSigType ) where
 
 #include "HsVersions.h"
 
 import RnExpr
 import HsSyn
 
 #include "HsVersions.h"
 
 import RnExpr
 import HsSyn
-import HsDecls         ( HsIdInfo(..), HsStrictnessInfo(..) )
 import HsPragmas
 import HsPragmas
-import HsTypes         ( getTyVarName, pprClassAssertion, cmpHsTypes )
-import RdrName         ( RdrName, isRdrDataCon, rdrNameOcc )
+import HsTypes         ( hsTyVarNames, pprHsContext )
+import RdrName         ( RdrName, isRdrDataCon, rdrNameOcc, mkRdrNameWkr )
 import RdrHsSyn                ( RdrNameContext, RdrNameHsType, RdrNameConDecl,
 import RdrHsSyn                ( RdrNameContext, RdrNameHsType, RdrNameConDecl,
-                         extractHsTyVars
+                         extractRuleBndrsTyVars, extractHsTyRdrTyVars,
+                         extractHsCtxtRdrTyVars, extractGenericPatTyVars
                        )
 import RnHsSyn
 import HsCore
 
 import RnBinds         ( rnTopBinds, rnMethodBinds, renameSigs )
                        )
 import RnHsSyn
 import HsCore
 
 import RnBinds         ( rnTopBinds, rnMethodBinds, renameSigs )
-import RnEnv           ( bindTyVarsRn, lookupBndrRn, lookupOccRn, 
-                         lookupImplicitOccRn, addImplicitOccRn,
-                         bindLocalsRn, 
+import RnEnv           ( lookupTopBndrRn, lookupOccRn, newIPName,
+                         lookupOrigNames, lookupSysBinder, newLocalsRn,
+                         bindLocalsFVRn, bindUVarRn,
                          bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvFVRn,
                          bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvFVRn,
+                         bindCoreLocalFVRn, bindCoreLocalsFVRn, bindLocalNames,
                          checkDupOrQualNames, checkDupNames,
                          checkDupOrQualNames, checkDupNames,
-                         newLocallyDefinedGlobalName, newImportedGlobalName, 
-                         newImportedGlobalFromRdrName,
-                         newDFunName,
-                         FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV
+                         FreeVars, emptyFVs, plusFV, plusFVs, unitFV, 
+                         addOneFV, mapFvRn
                        )
 import RnMonad
 
                        )
 import RnMonad
 
-import Name            ( Name, OccName,
-                         ExportFlag(..), Provenance(..), 
-                         nameOccName, NamedThing(..),
-                         mkDefaultMethodOcc, mkDFunOcc
-                       )
+import FunDeps         ( oclose )
+import Class           ( FunDep, DefMeth (..) )
+import Name            ( Name, OccName, nameOccName, NamedThing(..) )
 import NameSet
 import NameSet
-import BasicTypes      ( TopLevelFlag(..) )
-import TysWiredIn      ( tupleTyCon, unboxedTupleTyCon, listTyCon )
-import Type            ( funTyCon )
+import OccName         ( mkDefaultMethodOcc, isTvOcc )
 import FiniteMap       ( elemFM )
 import FiniteMap       ( elemFM )
-import PrelInfo                ( derivingOccurrences, numClass_RDR, 
-                         deRefStablePtr_NAME, makeStablePtr_NAME,
-                         bindIO_NAME
+import PrelInfo                ( derivableClassKeys, cCallishClassKeys )
+import PrelNames       ( deRefStablePtr_RDR, makeStablePtr_RDR, 
+                         bindIO_RDR, returnIO_RDR
                        )
 import Bag             ( bagToList )
                        )
 import Bag             ( bagToList )
+import List            ( partition, nub )
 import Outputable
 import SrcLoc          ( SrcLoc )
 import Outputable
 import SrcLoc          ( SrcLoc )
-import UniqFM          ( lookupUFM )
-import Maybes          ( maybeToBool, catMaybes )
-import Util
+import CmdLineOpts     ( opt_GlasgowExts, opt_WarnUnusedMatches )      -- Warn of unused for-all'd tyvars
+import Unique          ( Uniquable(..) )
+import ErrUtils                ( Message )
+import CStrings                ( isCLabelString )
+import ListSetOps      ( minusList, removeDupsEq )
 \end{code}
 
 \end{code}
 
-rnDecl `renames' declarations.
+@rnDecl@ `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}
 
 
 \end{enumerate}
 
 
@@ -76,22 +76,18 @@ Checks the (..) etc constraints in the export list.
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-rnSourceDecls :: [RdrNameHsDecl] -> RnMS s ([RenamedHsDecl], FreeVars)
+rnSourceDecls :: [RdrNameHsDecl] -> RnMS ([RenamedHsDecl], FreeVars)
        -- The decls get reversed, but that's ok
 
 rnSourceDecls decls
   = go emptyFVs [] decls
   where
        -- The decls get reversed, but that's ok
 
 rnSourceDecls decls
   = go emptyFVs [] decls
   where
-       -- Fixity decls have been dealt with already; ignore them
-    go fvs ds' []          = returnRn (ds', fvs)
-    go fvs ds' (FixD _:ds) = go fvs ds' ds
-    go fvs ds' (d:ds)      = rnDecl d  `thenRn` \(d', fvs') ->
-                            go (fvs `plusFV` fvs') (d':ds') ds
-
-rnIfaceDecl :: RdrNameHsDecl -> RnMS s RenamedHsDecl
-rnIfaceDecl d
-  = rnDecl d   `thenRn` \ (d', fvs) ->
-    returnRn d'
+       -- Fixity and deprecations have been dealt with already; ignore them
+    go fvs ds' []             = returnRn (ds', fvs)
+    go fvs ds' (FixD _:ds)    = go fvs ds' ds
+    go fvs ds' (DeprecD _:ds) = go fvs ds' ds
+    go fvs ds' (d:ds)         = rnDecl d       `thenRn` \(d', fvs') ->
+                               go (fvs `plusFV` fvs') (d':ds') ds
 \end{code}
 
 
 \end{code}
 
 
@@ -103,7 +99,7 @@ rnIfaceDecl d
 
 \begin{code}
 -- rnDecl does all the work
 
 \begin{code}
 -- rnDecl does all the work
-rnDecl :: RdrNameHsDecl -> RnMS s (RenamedHsDecl, FreeVars)
+rnDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
 
 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
                      returnRn (ValD new_binds, fvs)
 
 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
                      returnRn (ValD new_binds, fvs)
@@ -111,16 +107,10 @@ rnDecl (ValD binds) = rnTopBinds binds    `thenRn` \ (new_binds, fvs) ->
 
 rnDecl (SigD (IfaceSig name ty id_infos loc))
   = pushSrcLocRn loc $
 
 rnDecl (SigD (IfaceSig name ty id_infos loc))
   = pushSrcLocRn loc $
-    lookupBndrRn name          `thenRn` \ name' ->
-    rnIfaceType doc_str ty     `thenRn` \ ty' ->
-
-       -- Get the pragma info (if any).
-    setModeRn (InterfaceMode Optional)                 $
-       -- In all the rest of the signature we read in optional mode,
-       -- so that (a) we don't die
-    mapRn rnIdInfo id_infos    `thenRn` \ id_infos' -> 
-    returnRn (SigD (IfaceSig name' ty' id_infos' loc), emptyFVs)
-               -- Don't need free-var info for iface binds
+    lookupTopBndrRn name               `thenRn` \ name' ->
+    rnHsType doc_str ty                        `thenRn` \ (ty',fvs1) ->
+    mapFvRn rnIdInfo id_infos          `thenRn` \ (id_infos', fvs2) -> 
+    returnRn (SigD (IfaceSig name' ty' id_infos' loc), fvs1 `plusFV` fvs2)
   where
     doc_str = text "the interface signature for" <+> quotes (ppr name)
 \end{code}
   where
     doc_str = text "the interface signature for" <+> quotes (ppr name)
 \end{code}
@@ -137,41 +127,51 @@ 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
 
 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.
+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}
-rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc))
+rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls nconstrs derivings pragmas src_loc gen_name1 gen_name2))
   = pushSrcLocRn src_loc $
   = pushSrcLocRn src_loc $
-    lookupBndrRn tycon                                 `thenRn` \ tycon' ->
-    bindTyVarsFVRn data_doc tyvars                     $ \ tyvars' ->
-    rnContext data_doc context                                 `thenRn` \ (context', cxt_fvs) ->
-    checkDupOrQualNames data_doc con_names             `thenRn_`
-    mapAndUnzipRn rnConDecl condecls                   `thenRn` \ (condecls', con_fvs_s) ->
-    rnDerivs derivings                                 `thenRn` \ (derivings', deriv_fvs) ->
+    lookupTopBndrRn tycon                      `thenRn` \ tycon' ->
+    bindTyVarsFVRn data_doc tyvars             $ \ tyvars' ->
+    rnContext data_doc context                         `thenRn` \ (context', cxt_fvs) ->
+    checkDupOrQualNames data_doc con_names     `thenRn_`
+    mapFvRn rnConDecl condecls                 `thenRn` \ (condecls', con_fvs) ->
+    lookupSysBinder gen_name1                  `thenRn` \ name1' ->
+    lookupSysBinder gen_name2                  `thenRn` \ name2' ->
+    rnDerivs derivings                         `thenRn` \ (derivings', deriv_fvs) ->
     ASSERT(isNoDataPragmas pragmas)
     ASSERT(isNoDataPragmas pragmas)
-    returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc),
-             cxt_fvs `plusFV` plusFVs con_fvs_s `plusFV` deriv_fvs)
+    returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' nconstrs
+                     derivings' noDataPragmas src_loc name1' name2'),
+             cxt_fvs `plusFV` con_fvs `plusFV` deriv_fvs)
   where
     data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
     con_names = map conDeclName condecls
 
 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
   = pushSrcLocRn src_loc $
   where
     data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
     con_names = map conDeclName condecls
 
 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
   = pushSrcLocRn src_loc $
-    lookupBndrRn name                          `thenRn` \ name' ->
+    lookupTopBndrRn name                       `thenRn` \ name' ->
     bindTyVarsFVRn syn_doc tyvars              $ \ tyvars' ->
     bindTyVarsFVRn syn_doc tyvars              $ \ tyvars' ->
-    rnHsType syn_doc ty                                `thenRn` \ (ty', ty_fvs) ->
+    rnHsType syn_doc (unquantify ty)           `thenRn` \ (ty', ty_fvs) ->
     returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
   where
     syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
 
     returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
   where
     syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
 
-rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname src_loc))
+       -- For H98 we do *not* universally quantify on the RHS of a synonym
+       -- Silently discard context... but the tyvars in the rest won't be in scope
+    unquantify (HsForAllTy Nothing ctxt ty) | not opt_GlasgowExts = ty
+    unquantify ty                                                = ty
+
+rnDecl (TyClD (ClassDecl context cname tyvars fds sigs mbinds pragmas
+               names src_loc))
   = pushSrcLocRn src_loc $
 
   = pushSrcLocRn src_loc $
 
-    lookupBndrRn cname                                 `thenRn` \ cname' ->
+    lookupTopBndrRn cname                      `thenRn` \ cname' ->
 
        -- Deal with the implicit tycon and datacon name
        -- They aren't in scope (because they aren't visible to the user)
 
        -- Deal with the implicit tycon and datacon name
        -- They aren't in scope (because they aren't visible to the user)
@@ -180,27 +180,50 @@ rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname sr
        -- So the 'Imported' part of this call is not relevant. 
        -- Unclean; but since these two are the only place this happens
        -- I can't work up the energy to do it more beautifully
        -- So the 'Imported' part of this call is not relevant. 
        -- Unclean; but since these two are the only place this happens
        -- I can't work up the energy to do it more beautifully
-    newImportedGlobalFromRdrName tname                 `thenRn` \ tname' ->
-    newImportedGlobalFromRdrName dname                 `thenRn` \ dname' ->
+
+    mapRn lookupSysBinder names                `thenRn` \ names' ->
 
        -- Tyvars scope over bindings and context
 
        -- Tyvars scope over bindings and context
-    bindTyVarsFV2Rn cls_doc tyvars                     ( \ clas_tyvar_names tyvars' ->
+    bindTyVarsFV2Rn cls_doc tyvars             ( \ clas_tyvar_names tyvars' ->
 
        -- Check the superclasses
 
        -- Check the superclasses
-    rnContext cls_doc context                          `thenRn` \ (context', cxt_fvs) ->
+    rnContext cls_doc context                  `thenRn` \ (context', cxt_fvs) ->
+
+       -- Check the functional dependencies
+    rnFds cls_doc fds                          `thenRn` \ (fds', fds_fvs) ->
 
        -- Check the signatures
 
        -- Check the signatures
+       -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
     let
     let
-               -- Filter out fixity signatures;
-               -- they are done at top level
-         nofix_sigs = nonFixitySigs sigs
+       (op_sigs, non_op_sigs) = partition isClassOpSig sigs
+       sig_rdr_names_w_locs   = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
     in
     in
-    checkDupOrQualNames sig_doc sig_rdr_names_w_locs           `thenRn_` 
-    mapAndUnzipRn (rn_op cname' clas_tyvar_names) nofix_sigs   `thenRn` \ (sigs', sig_fvs_s) ->
+    checkDupOrQualNames sig_doc sig_rdr_names_w_locs     `thenRn_` 
+    mapFvRn (rn_op cname' clas_tyvar_names fds') op_sigs  `thenRn` \ (sigs', sig_fvs) ->
+    let
+       binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
+    in
+    renameSigs (okClsDclSig binders) non_op_sigs         `thenRn` \ (non_ops', fix_fvs) ->
 
        -- Check the methods
 
        -- Check the methods
+       -- 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 
+    getLocalNameEnv                                    `thenRn` \ name_env ->
+    let
+       meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
+       gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
+                                               not (tv `elemFM` name_env)]
+    in
     checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
     checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
-    rnMethodBinds mbinds                               `thenRn` \ (mbinds', meth_fvs) ->
+    newLocalsRn mkLocalName gen_rdr_tyvars_w_locs      `thenRn` \ gen_tyvars ->
+    rnMethodBinds gen_tyvars mbinds                    `thenRn` \ (mbinds', meth_fvs) ->
 
        -- Typechecker is responsible for checking that we only
        -- give default-method bindings for things in this class.
 
        -- Typechecker is responsible for checking that we only
        -- give default-method bindings for things in this class.
@@ -208,54 +231,53 @@ rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname sr
        -- for instance decls.
 
     ASSERT(isNoClassPragmas pragmas)
        -- for instance decls.
 
     ASSERT(isNoClassPragmas pragmas)
-    returnRn (TyClD (ClassDecl context' cname' tyvars' sigs' mbinds' NoClassPragmas tname' dname' src_loc),
-             plusFVs sig_fvs_s `plusFV` cxt_fvs `plusFV` meth_fvs)
+    returnRn (TyClD (ClassDecl context' cname' tyvars' fds' (non_ops' ++ sigs') mbinds'
+                              NoClassPragmas names' src_loc),
+             sig_fvs   `plusFV`
+
+             fix_fvs   `plusFV`
+             cxt_fvs   `plusFV`
+             fds_fvs   `plusFV`
+             meth_fvs
+            )
     )
   where
     cls_doc  = text "the declaration for class"        <+> ppr cname
     sig_doc  = text "the signatures for class"         <+> ppr cname
     meth_doc = text "the default-methods for class"    <+> ppr cname
 
     )
   where
     cls_doc  = text "the declaration for class"        <+> ppr cname
     sig_doc  = text "the signatures for class"         <+> ppr cname
     meth_doc = text "the default-methods for class"    <+> ppr cname
 
-    sig_rdr_names_w_locs  = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
-    meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
-    meth_rdr_names       = map fst meth_rdr_names_w_locs
-
-    rn_op clas clas_tyvars sig@(ClassOpSig op maybe_dm ty locn)
+    rn_op clas clas_tyvars clas_fds sig@(ClassOpSig op maybe_dm_stuff ty locn)
       = pushSrcLocRn locn $
       = pushSrcLocRn locn $
-       lookupBndrRn op                         `thenRn` \ op_name ->
+       lookupTopBndrRn op                      `thenRn` \ op_name ->
 
                -- Check the signature
        rnHsSigType (quotes (ppr op)) ty        `thenRn` \ (new_ty, op_ty_fvs)  ->
        let
 
                -- Check the signature
        rnHsSigType (quotes (ppr op)) ty        `thenRn` \ (new_ty, op_ty_fvs)  ->
        let
-           check_in_op_ty clas_tyvar = checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
-                                               (classTyVarNotInOpTyErr clas_tyvar sig)
+           check_in_op_ty clas_tyvar =
+                checkRn (clas_tyvar `elemNameSet` oclose clas_fds op_ty_fvs)
+                        (classTyVarNotInOpTyErr clas_tyvar sig)
        in
        in
-        mapRn check_in_op_ty clas_tyvars                `thenRn_`
+        mapRn_ check_in_op_ty clas_tyvars               `thenRn_`
 
                -- Make the default-method name
 
                -- Make the default-method name
-       let
-           dm_occ = mkDefaultMethodOcc (rdrNameOcc op)
-       in
-       getModuleRn                     `thenRn` \ mod_name ->
-       getModeRn                       `thenRn` \ mode ->
-       (case (mode, maybe_dm) of 
-           (SourceMode, _) | op `elem` meth_rdr_names
-               ->      -- There's an explicit method decl
-                  newLocallyDefinedGlobalName mod_name dm_occ 
-                                              (\_ -> Exported) locn    `thenRn` \ dm_name ->
-                  returnRn (Just dm_name)
-
-           (InterfaceMode _, Just _) 
-               ->      -- Imported class that has a default method decl
-                   newImportedGlobalName mod_name dm_occ       `thenRn` \ dm_name ->
-                   addOccurrenceName dm_name                   `thenRn_`
-                   returnRn (Just dm_name)
-
-           other -> returnRn Nothing
-       )                                       `thenRn` \ maybe_dm_name ->
-
+       (case maybe_dm_stuff of 
+           Nothing -> returnRn (Nothing, emptyFVs)             -- Source-file class decl
 
 
-       returnRn (ClassOpSig op_name maybe_dm_name new_ty locn, op_ty_fvs)
+           Just (DefMeth dm_rdr_name)
+               ->      -- Imported class that has a default method decl
+                       -- See comments with tname, snames, above
+                   lookupSysBinder dm_rdr_name         `thenRn` \ dm_name ->
+                   returnRn (Just (DefMeth dm_name), unitFV 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
+           Just GenDefMeth
+               -> returnRn (Just GenDefMeth, emptyFVs)
+           Just NoDefMeth
+               -> returnRn (Just NoDefMeth, emptyFVs)
+       )                                               `thenRn` \ (maybe_dm_stuff', dm_fvs) ->
+
+       returnRn (ClassOpSig op_name maybe_dm_stuff' new_ty locn, op_ty_fvs `plusFV` dm_fvs)
 \end{code}
 
 
 \end{code}
 
 
@@ -266,9 +288,9 @@ rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname sr
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
+rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc))
   = pushSrcLocRn src_loc $
   = pushSrcLocRn src_loc $
-    rnHsSigType (text "an instance decl") inst_ty      `thenRn` \ (inst_ty', inst_fvs) ->
+    rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) ->
     let
        inst_tyvars = case inst_ty' of
                        HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
     let
        inst_tyvars = case inst_ty' of
                        HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
@@ -276,27 +298,41 @@ rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
        -- (Slightly strangely) the forall-d tyvars scope over
        -- the method bindings too
     in
        -- (Slightly strangely) the forall-d tyvars scope over
        -- the method bindings too
     in
-    extendTyVarEnvFVRn inst_tyvars             $
 
        -- Rename the bindings
        -- NB meth_names can be qualified!
     checkDupNames meth_doc meth_names          `thenRn_`
 
        -- Rename the bindings
        -- NB meth_names can be qualified!
     checkDupNames meth_doc meth_names          `thenRn_`
-    rnMethodBinds mbinds                       `thenRn` \ (mbinds', meth_fvs) ->
+    extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (         
+       rnMethodBinds [] mbinds
+    )                                          `thenRn` \ (mbinds', meth_fvs) ->
     let 
     let 
-       binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds')))
+       binders    = collectMonoBinders mbinds'
+       binder_set = mkNameSet binders
     in
     in
-    renameSigs NotTopLevel True binders uprags `thenRn` \ (new_uprags, prag_fvs) ->
-    mkDFunName inst_ty' maybe_dfun src_loc     `thenRn` \ dfun_name ->
-    addOccurrenceName dfun_name                        `thenRn_`
-                       -- The dfun is not optional, because we use its version number
-                       -- to identify the version of the instance declaration
-
-       -- The typechecker checks that all the bindings are for the right class.
-    returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc),
-             inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs)
+       -- Rename the prags and signatures.
+       -- Note that the type variables are not in scope here,
+       -- so that      instance Eq a => Eq (T a) where
+       --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
+       -- works OK. 
+       --
+       -- But the (unqualified) method names are in scope
+    bindLocalNames binders (
+       renameSigs (okInstDclSig binder_set) uprags
+    )                                                  `thenRn` \ (new_uprags, prag_fvs) ->
+
+    (case maybe_dfun_rdr_name of
+       Nothing            -> returnRn (Nothing, emptyFVs)
+
+       Just dfun_rdr_name -> lookupSysBinder dfun_rdr_name     `thenRn` \ dfun_name ->
+                             returnRn (Just dfun_name, unitFV dfun_name)
+    )                                                  `thenRn` \ (maybe_dfun_name, dfun_fv) ->
+
+    -- The typechecker checks that all the bindings are for the right class.
+    returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags maybe_dfun_name src_loc),
+             inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs `plusFV` dfun_fv)
   where
   where
-    meth_doc = text "the bindings in an instance declaration"
-    meth_names   = bagToList (collectMonoBinders mbinds)
+    meth_doc   = text "the bindings in an instance declaration"
+    meth_names = collectLocatedMonoBinders mbinds
 \end{code}
 
 %*********************************************************
 \end{code}
 
 %*********************************************************
@@ -309,7 +345,6 @@ rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
 rnDecl (DefD (DefaultDecl tys src_loc))
   = pushSrcLocRn src_loc $
     rnHsTypes doc_str tys              `thenRn` \ (tys', fvs) ->
 rnDecl (DefD (DefaultDecl tys src_loc))
   = pushSrcLocRn src_loc $
     rnHsTypes doc_str tys              `thenRn` \ (tys', fvs) ->
-    lookupImplicitOccRn numClass_RDR   `thenRn_` 
     returnRn (DefD (DefaultDecl tys' src_loc), fvs)
   where
     doc_str = text "a `default' declaration"
     returnRn (DefD (DefaultDecl tys' src_loc), fvs)
   where
     doc_str = text "a `default' declaration"
@@ -324,24 +359,86 @@ rnDecl (DefD (DefaultDecl tys src_loc))
 \begin{code}
 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
   = pushSrcLocRn src_loc $
 \begin{code}
 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
   = pushSrcLocRn src_loc $
-    lookupBndrRn name                  `thenRn` \ name' ->
-    (case imp_exp of
-       FoImport _ | not isDyn -> addImplicitOccRn name'
-       FoLabel    -> addImplicitOccRn name'
-       FoExport   | isDyn ->
-          addImplicitOccRn makeStablePtr_NAME  `thenRn_`
-          addImplicitOccRn deRefStablePtr_NAME `thenRn_`
-          addImplicitOccRn bindIO_NAME         `thenRn_`
-          returnRn name'
-       _ -> returnRn name')            `thenRn_`
-    rnHsSigType fo_decl_msg ty         `thenRn` \ (ty', fvs) ->
-    returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc), fvs)
+    lookupOccRn name                   `thenRn` \ name' ->
+    let 
+       extra_fvs FoExport 
+         | isDyn = lookupOrigNames [makeStablePtr_RDR, deRefStablePtr_RDR,
+                                    bindIO_RDR, returnIO_RDR]
+         | otherwise =
+               lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs ->
+               returnRn (addOneFV fvs name')
+       extra_fvs other = returnRn emptyFVs
+    in
+    checkRn (ok_ext_nm ext_nm) (badExtName ext_nm)     `thenRn_`
+
+    extra_fvs imp_exp                                  `thenRn` \ fvs1 -> 
+
+    rnHsSigType fo_decl_msg ty                         `thenRn` \ (ty', fvs2) ->
+    returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc), 
+             fvs1 `plusFV` fvs2)
  where
   fo_decl_msg = ptext SLIT("a foreign declaration")
  where
   fo_decl_msg = ptext SLIT("a foreign declaration")
-  isDyn              = isDynamic ext_nm
+  isDyn              = isDynamicExtName ext_nm
+
+  ok_ext_nm Dynamic               = True
+  ok_ext_nm (ExtName nm (Just mb)) = isCLabelString nm && isCLabelString mb
+  ok_ext_nm (ExtName nm Nothing)   = isCLabelString nm
+\end{code}
 
 
+%*********************************************************
+%*                                                     *
+\subsection{Rules}
+%*                                                     *
+%*********************************************************
+
+\begin{code}
+rnDecl (RuleD (IfaceRule rule_name vars fn args rhs src_loc))
+  = pushSrcLocRn src_loc       $
+    lookupOccRn fn             `thenRn` \ fn' ->
+    rnCoreBndrs vars           $ \ vars' ->
+    mapFvRn rnCoreExpr args    `thenRn` \ (args', fvs1) ->
+    rnCoreExpr rhs             `thenRn` \ (rhs',  fvs2) ->
+    returnRn (RuleD (IfaceRule rule_name vars' fn' args' rhs' src_loc), 
+             (fvs1 `plusFV` fvs2) `addOneFV` fn')
+
+rnDecl (RuleD (IfaceRuleOut fn rule))
+       -- This one is used for BuiltInRules
+       -- The rule itself is already done, but the thing
+       -- to attach it to is not.
+  = lookupOccRn fn             `thenRn` \ fn' ->
+    returnRn (RuleD (IfaceRuleOut fn' rule), unitFV fn')
+
+rnDecl (RuleD (HsRule rule_name tvs vars lhs rhs src_loc))
+  = ASSERT( null tvs )
+    pushSrcLocRn src_loc                       $
+
+    bindTyVarsFV2Rn doc (map UserTyVar sig_tvs)        $ \ sig_tvs' _ ->
+    bindLocalsFVRn doc (map get_var vars)      $ \ ids ->
+    mapFvRn rn_var (vars `zip` ids)            `thenRn` \ (vars', fv_vars) ->
+
+    rnExpr lhs                                 `thenRn` \ (lhs', fv_lhs) ->
+    rnExpr rhs                                 `thenRn` \ (rhs', fv_rhs) ->
+    checkRn (validRuleLhs ids lhs')
+           (badRuleLhsErr rule_name lhs')      `thenRn_`
+    let
+       bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
+    in
+    mapRn (addErrRn . badRuleVar rule_name) bad_vars   `thenRn_`
+    returnRn (RuleD (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc),
+             fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
+  where
+    doc = text "the transformation rule" <+> ptext rule_name
+    sig_tvs = extractRuleBndrsTyVars vars
+  
+    get_var (RuleBndr v)      = v
+    get_var (RuleBndrSig v _) = v
+
+    rn_var (RuleBndr v, id)     = returnRn (RuleBndr id, emptyFVs)
+    rn_var (RuleBndrSig v t, id) = rnHsType doc t      `thenRn` \ (t', fvs) ->
+                                  returnRn (RuleBndrSig id t', fvs)
 \end{code}
 
 \end{code}
 
+
 %*********************************************************
 %*                                                     *
 \subsection{Support code for type/data declarations}
 %*********************************************************
 %*                                                     *
 \subsection{Support code for type/data declarations}
@@ -349,75 +446,60 @@ rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name], FreeVars)
+rnDerivs :: Maybe [RdrName] -> RnMS (Maybe [Name], FreeVars)
 
 rnDerivs Nothing -- derivs not specified
   = returnRn (Nothing, emptyFVs)
 
 
 rnDerivs Nothing -- derivs not specified
   = returnRn (Nothing, emptyFVs)
 
-rnDerivs (Just ds)
-  = mapRn rn_deriv ds `thenRn` \ derivs ->
-    returnRn (Just derivs, foldl addOneFV emptyFVs derivs)
+rnDerivs (Just clss)
+  = mapRn do_one clss  `thenRn` \ clss' ->
+    returnRn (Just clss', mkNameSet clss')
   where
   where
-    rn_deriv clas
-      = lookupOccRn clas           `thenRn` \ clas_name ->
-
-               -- Now add extra "occurrences" for things that
-               -- the deriving mechanism will later need in order to
-               -- generate code for this class.
-       case lookupUFM derivingOccurrences clas_name of
-               Nothing -> addErrRn (derivingNonStdClassErr clas_name)  `thenRn_`
-                          returnRn clas_name
-
-               Just occs -> mapRn lookupImplicitOccRn occs     `thenRn_`
-                            returnRn clas_name
-
+    do_one cls = lookupOccRn cls       `thenRn` \ clas_name ->
+                checkRn (getUnique clas_name `elem` derivableClassKeys)
+                        (derivingNonStdClassErr clas_name)     `thenRn_`
+                returnRn clas_name
 \end{code}
 
 \begin{code}
 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
 \end{code}
 
 \begin{code}
 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
-conDeclName (ConDecl n _ _ _ l) = (n,l)
+conDeclName (ConDecl n _ _ _ _ l) = (n,l)
 
 
-rnConDecl :: RdrNameConDecl -> RnMS s (RenamedConDecl, FreeVars)
-rnConDecl (ConDecl name tvs cxt details locn)
+rnConDecl :: RdrNameConDecl -> RnMS (RenamedConDecl, FreeVars)
+rnConDecl (ConDecl name wkr tvs cxt details locn)
   = pushSrcLocRn locn $
   = pushSrcLocRn locn $
-    checkConName name                  `thenRn_` 
-    lookupBndrRn name                  `thenRn` \ new_name ->
+    checkConName name          `thenRn_` 
+    lookupTopBndrRn name       `thenRn` \ new_name ->
+
+    lookupSysBinder wkr                `thenRn` \ new_wkr ->
+       -- See comments with ClassDecl
+
     bindTyVarsFVRn doc tvs             $ \ new_tyvars ->
     rnContext doc cxt                  `thenRn` \ (new_context, cxt_fvs) ->
     rnConDetails doc locn details      `thenRn` \ (new_details, det_fvs) -> 
     bindTyVarsFVRn doc tvs             $ \ new_tyvars ->
     rnContext doc cxt                  `thenRn` \ (new_context, cxt_fvs) ->
     rnConDetails doc locn details      `thenRn` \ (new_details, det_fvs) -> 
-    returnRn (ConDecl new_name new_tyvars new_context new_details locn,
+    returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn,
              cxt_fvs `plusFV` det_fvs)
   where
     doc = text "the definition of data constructor" <+> quotes (ppr name)
 
 rnConDetails doc locn (VanillaCon tys)
              cxt_fvs `plusFV` det_fvs)
   where
     doc = text "the definition of data constructor" <+> quotes (ppr name)
 
 rnConDetails doc locn (VanillaCon tys)
-  = mapAndUnzipRn (rnBangTy doc) tys   `thenRn` \ (new_tys, fvs_s)  ->
-    returnRn (VanillaCon new_tys, plusFVs fvs_s)
+  = mapFvRn (rnBangTy doc) tys `thenRn` \ (new_tys, fvs)  ->
+    returnRn (VanillaCon new_tys, fvs)
 
 rnConDetails doc locn (InfixCon ty1 ty2)
   = rnBangTy doc ty1           `thenRn` \ (new_ty1, fvs1) ->
     rnBangTy doc ty2           `thenRn` \ (new_ty2, fvs2) ->
     returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
 
 
 rnConDetails doc locn (InfixCon ty1 ty2)
   = rnBangTy doc ty1           `thenRn` \ (new_ty1, fvs1) ->
     rnBangTy doc ty2           `thenRn` \ (new_ty2, fvs2) ->
     returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
 
-rnConDetails doc locn (NewCon ty mb_field)
-  = rnHsType doc ty                    `thenRn` \ (new_ty, fvs) ->
-    rn_field mb_field                  `thenRn` \ new_mb_field  ->
-    returnRn (NewCon new_ty new_mb_field, fvs)
-  where
-    rn_field Nothing  = returnRn Nothing
-    rn_field (Just f) =
-       lookupBndrRn f      `thenRn` \ new_f ->
-       returnRn (Just new_f)
-
 rnConDetails doc locn (RecCon fields)
   = checkDupOrQualNames doc field_names        `thenRn_`
 rnConDetails doc locn (RecCon fields)
   = checkDupOrQualNames doc field_names        `thenRn_`
-    mapAndUnzipRn (rnField doc) fields `thenRn` \ (new_fields, fvs_s) ->
-    returnRn (RecCon new_fields, plusFVs fvs_s)
+    mapFvRn (rnField doc) fields       `thenRn` \ (new_fields, fvs) ->
+    returnRn (RecCon new_fields, fvs)
   where
     field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
 
 rnField doc (names, ty)
   where
     field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
 
 rnField doc (names, ty)
-  = mapRn lookupBndrRn names   `thenRn` \ new_names ->
+  = mapRn lookupTopBndrRn names        `thenRn` \ new_names ->
     rnBangTy doc ty            `thenRn` \ (new_ty, fvs) ->
     returnRn ((new_names, new_ty), fvs) 
 
     rnBangTy doc ty            `thenRn` \ (new_ty, fvs) ->
     returnRn ((new_names, new_ty), fvs) 
 
@@ -426,9 +508,13 @@ rnBangTy doc (Banged ty)
     returnRn (Banged new_ty, fvs)
 
 rnBangTy doc (Unbanged ty)
     returnRn (Banged new_ty, fvs)
 
 rnBangTy doc (Unbanged ty)
-  = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
+  = rnHsType doc ty            `thenRn` \ (new_ty, fvs) ->
     returnRn (Unbanged new_ty, fvs)
 
     returnRn (Unbanged new_ty, fvs)
 
+rnBangTy doc (Unpacked ty)
+  = rnHsType doc ty            `thenRn` \ (new_ty, fvs) ->
+    returnRn (Unpacked new_ty, fvs)
+
 -- This data decl will parse OK
 --     data T = a Int
 -- treating "a" as the constructor.
 -- This data decl will parse OK
 --     data T = a Int
 -- treating "a" as the constructor.
@@ -447,329 +533,367 @@ checkConName name
 
 %*********************************************************
 %*                                                     *
 
 %*********************************************************
 %*                                                     *
-\subsection{Naming a dfun}
-%*                                                     *
-%*********************************************************
-
-Make a name for the dict fun for an instance decl
-
-\begin{code}
-mkDFunName :: RenamedHsType    -- Instance type
-           -> Maybe RdrName    -- Dfun thing from decl; Nothing <=> source
-           -> SrcLoc
-           -> RnMS s Name
-
-mkDFunName inst_ty maybe_df src_loc
-  = newDFunName cl_occ tycon_occ maybe_df src_loc
-  where
-    (cl_occ, tycon_occ) = get_key inst_ty
-
-    get_key (HsForAllTy _ _ ty)     = get_key ty
-    get_key (MonoFunTy _ ty)        = get_key ty
-    get_key (MonoDictTy cls (ty:_)) = (nameOccName cls, get_tycon_key ty)
-
-    get_tycon_key (MonoTyVar tv)   = nameOccName (getName tv)
-    get_tycon_key (MonoTyApp ty _) = get_tycon_key ty
-    get_tycon_key (MonoTupleTy tys True)  = getOccName (tupleTyCon        (length tys))
-    get_tycon_key (MonoTupleTy tys False) = getOccName (unboxedTupleTyCon (length tys))
-    get_tycon_key (MonoListTy _)   = getOccName listTyCon
-    get_tycon_key (MonoFunTy _ _)  = getOccName funTyCon
-\end{code}
-
-
-%*********************************************************
-%*                                                     *
 \subsection{Support code to rename types}
 %*                                                     *
 %*********************************************************
 
 \begin{code}
 \subsection{Support code to rename types}
 %*                                                     *
 %*********************************************************
 
 \begin{code}
-rnHsSigType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
+rnHsSigType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
        -- rnHsSigType is used for source-language type signatures,
        -- which use *implicit* universal quantification.
 rnHsSigType doc_str ty
   = rnHsType (text "the type signature for" <+> doc_str) ty
     
        -- rnHsSigType is used for source-language type signatures,
        -- which use *implicit* universal quantification.
 rnHsSigType doc_str ty
   = rnHsType (text "the type signature for" <+> doc_str) ty
     
-rnIfaceType :: SDoc -> RdrNameHsType -> RnMS s RenamedHsType
-rnIfaceType doc ty 
- = rnHsType doc ty     `thenRn` \ (ty,_) ->
-   returnRn ty
-
-
-rnForAll doc forall_tyvars ctxt ty
-  = bindTyVarsFVRn doc forall_tyvars                   $ \ new_tyvars ->
-    rnContext doc ctxt                                 `thenRn` \ (new_ctxt, cxt_fvs) ->
-    rnHsType doc ty                                    `thenRn` \ (new_ty, ty_fvs) ->
-    returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty,
-             cxt_fvs `plusFV` ty_fvs)
-
--- Check that each constraint mentions at least one of the forall'd type variables
--- Since the forall'd type variables are a subset of the free tyvars
--- of the tau-type part, this guarantees that every constraint mentions
--- at least one of the free tyvars in ty
-checkConstraints explicit_forall doc forall_tyvars ctxt ty
-   = mapRn check ctxt                  `thenRn` \ maybe_ctxt' ->
-     returnRn (catMaybes maybe_ctxt')
-           -- Remove problem ones, to avoid duplicate error message.
-   where
-     check ct@(_,tys)
-       | forall_mentioned = returnRn (Just ct)
-       | otherwise        = addErrRn (ctxtErr explicit_forall doc forall_tyvars ct ty) `thenRn_`
-                            returnRn Nothing
-        where
-         forall_mentioned = foldr ((||) . any (`elem` forall_tyvars) . extractHsTyVars)
-                            False
-                            tys
-
-
-rnHsType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
+---------------------------------------
+rnHsType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
 
 rnHsType doc (HsForAllTy Nothing ctxt ty)
 
 rnHsType doc (HsForAllTy Nothing ctxt ty)
-       -- From source code (no kinds on tyvars)
+       -- Implicit quantifiction in source code (no kinds on tyvars)
        -- Given the signature  C => T  we universally quantify 
        -- over FV(T) \ {in-scope-tyvars} 
   = getLocalNameEnv            `thenRn` \ name_env ->
     let
        -- Given the signature  C => T  we universally quantify 
        -- over FV(T) \ {in-scope-tyvars} 
   = getLocalNameEnv            `thenRn` \ name_env ->
     let
-       mentioned_tyvars = extractHsTyVars ty
-       forall_tyvars    = filter (not . (`elemFM` name_env)) mentioned_tyvars
+       mentioned_in_tau  = extractHsTyRdrTyVars ty
+       mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
+       mentioned         = nub (mentioned_in_tau ++ mentioned_in_ctxt)
+       forall_tyvars     = filter (not . (`elemFM` name_env)) mentioned
     in
     in
-    checkConstraints False doc forall_tyvars ctxt ty   `thenRn` \ ctxt' ->
-    rnForAll doc (map UserTyVar forall_tyvars) ctxt' ty
+    rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
 
 
-rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt ty)
+rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
        -- Explicit quantification.
        -- Explicit quantification.
-       -- Check that the forall'd tyvars are a subset of the
-       -- free tyvars in the tau-type part
+       -- Check that the forall'd tyvars are actually 
+       -- mentioned in the type, and produce a warning if not
   = let
   = let
-       mentioned_tyvars   = extractHsTyVars ty
-       bad_guys           = filter (`notElem` mentioned_tyvars) forall_tyvar_names
-       forall_tyvar_names = map getTyVarName forall_tyvars
+       mentioned_in_tau                = extractHsTyRdrTyVars tau
+       mentioned_in_ctxt               = extractHsCtxtRdrTyVars ctxt
+       mentioned                       = nub (mentioned_in_tau ++ mentioned_in_ctxt)
+       forall_tyvar_names              = hsTyVarNames forall_tyvars
+
+       -- Explicitly quantified but not mentioned in ctxt or tau
+       warn_guys                       = filter (`notElem` mentioned) forall_tyvar_names
     in
     in
-    mapRn (forAllErr doc ty) bad_guys                          `thenRn_`
-    checkConstraints True doc forall_tyvar_names ctxt ty       `thenRn` \ ctxt' ->
-    rnForAll doc forall_tyvars ctxt' ty
+    mapRn_ (forAllWarn doc tau) warn_guys                      `thenRn_`
+    rnForAll doc forall_tyvars ctxt tau
 
 
-rnHsType doc (MonoTyVar tyvar)
+rnHsType doc (HsTyVar tyvar)
   = lookupOccRn tyvar          `thenRn` \ tyvar' ->
   = lookupOccRn tyvar          `thenRn` \ tyvar' ->
-    returnRn (MonoTyVar tyvar', unitFV tyvar')
+    returnRn (HsTyVar tyvar', unitFV tyvar')
 
 
-rnHsType doc (MonoFunTy ty1 ty2)
-  = rnHsType doc ty1   `thenRn` \ (ty1', fvs1) ->
-    rnHsType doc ty2   `thenRn` \ (ty2', fvs2) ->
-    returnRn (MonoFunTy ty1' ty2', fvs1 `plusFV` fvs2)
+rnHsType doc (HsOpTy ty1 opname ty2)
+  = lookupOccRn opname `thenRn` \ name' ->
+    rnHsType doc ty1   `thenRn` \ (ty1', fvs1) ->
+    rnHsType doc ty2   `thenRn` \ (ty2',fvs2) -> 
+    returnRn (HsOpTy ty1' name' ty2', fvs1 `plusFV` fvs2 `addOneFV` name')
 
 
-rnHsType doc (MonoListTy ty)
-  = addImplicitOccRn listTyCon_name            `thenRn_`
-    rnHsType doc ty                            `thenRn` \ (ty', fvs) ->
-    returnRn (MonoListTy ty', fvs `addOneFV` listTyCon_name)
+rnHsType doc (HsNumTy i)
+  | i == 1    = returnRn (HsNumTy i, emptyFVs)
+  | otherwise = failWithRn (HsNumTy i, emptyFVs)
+                          (ptext SLIT("Only unit numeric type pattern is valid"))
 
 
-rnHsType doc (MonoTupleTy tys boxed)
-  = addImplicitOccRn tup_con_name      `thenRn_`
-    rnHsTypes doc tys                  `thenRn` \ (tys', fvs) ->
-    returnRn (MonoTupleTy tys' boxed, fvs `addOneFV` tup_con_name)
+rnHsType doc (HsFunTy ty1 ty2)
+  = rnHsType doc ty1   `thenRn` \ (ty1', fvs1) ->
+       -- Might find a for-all as the arg of a function type
+    rnHsType doc ty2   `thenRn` \ (ty2', fvs2) ->
+       -- Or as the result.  This happens when reading Prelude.hi
+       -- when we find return :: forall m. Monad m -> forall a. a -> m a
+    returnRn (HsFunTy ty1' ty2', fvs1 `plusFV` fvs2)
+
+rnHsType doc (HsListTy ty)
+  = rnHsType doc ty                            `thenRn` \ (ty', fvs) ->
+    returnRn (HsListTy ty', fvs `addOneFV` listTyCon_name)
+
+-- Unboxed tuples are allowed to have poly-typed arguments.  These
+-- sometimes crop up as a result of CPR worker-wrappering dictionaries.
+rnHsType doc (HsTupleTy (HsTupCon _ boxity) tys)
+       -- Don't do lookupOccRn, because this is built-in syntax
+       -- so it doesn't need to be in scope
+  = mapFvRn (rnHsType doc) tys         `thenRn` \ (tys', fvs) ->
+    returnRn (HsTupleTy (HsTupCon n' boxity) tys', fvs `addOneFV` n')
   where
   where
-    tup_con_name = tupleTyCon_name boxed (length tys)
+    n' = tupleTyCon_name boxity (length tys)
+  
 
 
-rnHsType doc (MonoTyApp ty1 ty2)
+rnHsType doc (HsAppTy ty1 ty2)
   = rnHsType doc ty1           `thenRn` \ (ty1', fvs1) ->
     rnHsType doc ty2           `thenRn` \ (ty2', fvs2) ->
   = rnHsType doc ty1           `thenRn` \ (ty1', fvs1) ->
     rnHsType doc ty2           `thenRn` \ (ty2', fvs2) ->
-    returnRn (MonoTyApp ty1' ty2', fvs1 `plusFV` fvs2)
-
-rnHsType doc (MonoDictTy clas tys)
-  = lookupOccRn clas           `thenRn` \ clas' ->
-    rnHsTypes doc tys          `thenRn` \ (tys', fvs) ->
-    returnRn (MonoDictTy clas' tys', fvs `addOneFV` clas')
+    returnRn (HsAppTy ty1' ty2', fvs1 `plusFV` fvs2)
+
+rnHsType doc (HsPredTy pred)
+  = rnPred doc pred    `thenRn` \ (pred', fvs) ->
+    returnRn (HsPredTy pred', fvs)
+
+rnHsType doc (HsUsgForAllTy uv_rdr ty)
+  = bindUVarRn doc uv_rdr $ \ uv_name ->
+    rnHsType doc ty       `thenRn` \ (ty', fvs) ->
+    returnRn (HsUsgForAllTy uv_name ty',
+              fvs )
+
+rnHsType doc (HsUsgTy usg ty)
+  = newUsg usg                      `thenRn` \ (usg', usg_fvs) ->
+    rnHsType doc ty                 `thenRn` \ (ty', ty_fvs) ->
+       -- A for-all can occur inside a usage annotation
+    returnRn (HsUsgTy usg' ty',
+              usg_fvs `plusFV` ty_fvs)
+  where
+    newUsg usg = case usg of
+                   HsUsOnce       -> returnRn (HsUsOnce, emptyFVs)
+                   HsUsMany       -> returnRn (HsUsMany, emptyFVs)
+                   HsUsVar uv_rdr -> lookupOccRn uv_rdr `thenRn` \ uv_name ->
+                                       returnRn (HsUsVar uv_name, emptyFVs)
 
 
-rnHsTypes doc tys
-  = mapAndUnzipRn (rnHsType doc) tys   `thenRn` \ (tys, fvs_s) ->
-    returnRn (tys, plusFVs fvs_s)
+rnHsTypes doc tys = mapFvRn (rnHsType doc) tys
 \end{code}
 
 \end{code}
 
+\begin{code}
+-- We use lookupOcc here because this is interface file only stuff
+-- and we need the workers...
+rnHsTupCon (HsTupCon n boxity)
+  = lookupOccRn n      `thenRn` \ n' ->
+    returnRn (HsTupCon n' boxity, unitFV n')
+
+rnHsTupConWkr (HsTupCon n boxity)
+       -- Tuple construtors are for the *worker* of the tuple
+       -- Going direct saves needless messing about 
+  = lookupOccRn (mkRdrNameWkr n)       `thenRn` \ n' ->
+    returnRn (HsTupCon n' boxity, unitFV n')
+\end{code}
 
 \begin{code}
 
 \begin{code}
-rnContext :: SDoc -> RdrNameContext -> RnMS s (RenamedContext, FreeVars)
+rnForAll doc forall_tyvars ctxt ty
+  = bindTyVarsFVRn doc forall_tyvars   $ \ new_tyvars ->
+    rnContext doc ctxt                 `thenRn` \ (new_ctxt, cxt_fvs) ->
+    rnHsType doc ty                    `thenRn` \ (new_ty, ty_fvs) ->
+    returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty,
+             cxt_fvs `plusFV` ty_fvs)
+\end{code}
 
 
+\begin{code}
+rnContext :: SDoc -> RdrNameContext -> RnMS (RenamedContext, FreeVars)
 rnContext doc ctxt
 rnContext doc ctxt
-  = mapAndUnzipRn rn_ctxt ctxt         `thenRn` \ (theta, fvs_s) ->
+  = mapAndUnzipRn rn_pred ctxt         `thenRn` \ (theta, fvs_s) ->
     let
     let
-       (_, dup_asserts) = removeDups cmp_assert theta
+       (_, dups) = removeDupsEq theta
+               -- We only have equality, not ordering
     in
        -- Check for duplicate assertions
        -- If this isn't an error, then it ought to be:
     in
        -- Check for duplicate assertions
        -- If this isn't an error, then it ought to be:
-    mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts   `thenRn_`
-
+    mapRn (addWarnRn . dupClassAssertWarn theta) dups          `thenRn_`
     returnRn (theta, plusFVs fvs_s)
   where
     returnRn (theta, plusFVs fvs_s)
   where
-    rn_ctxt (clas, tys)
-      =        lookupOccRn clas                `thenRn` \ clas_name ->
-       rnHsTypes doc tys               `thenRn` \ (tys', fvs) ->
-       returnRn ((clas_name, tys'), fvs `addOneFV` clas_name)
+       --Someone discovered that @CCallable@ and @CReturnable@
+       -- could be used in contexts such as:
+       --      foo :: CCallable a => a -> PrimIO Int
+       -- Doing this utterly wrecks the whole point of introducing these
+       -- classes so we specifically check that this isn't being done.
+    rn_pred pred = rnPred doc pred                             `thenRn` \ (pred', fvs)->
+                  checkRn (not (bad_pred pred'))
+                          (naughtyCCallContextErr pred')       `thenRn_`
+                  returnRn (pred', fvs)
+
+    bad_pred (HsPClass clas _) = getUnique clas `elem` cCallishClassKeys
+    bad_pred other            = False
+
+
+rnPred doc (HsPClass clas tys)
+  = lookupOccRn clas           `thenRn` \ clas_name ->
+    rnHsTypes doc tys          `thenRn` \ (tys', fvs) ->
+    returnRn (HsPClass clas_name tys', fvs `addOneFV` clas_name)
 
 
-    cmp_assert (c1,tys1) (c2,tys2)
-      = (c1 `compare` c2) `thenCmp` (cmpHsTypes compare tys1 tys2)
+rnPred doc (HsPIParam n ty)
+  = newIPName n                        `thenRn` \ name ->
+    rnHsType doc ty            `thenRn` \ (ty', fvs) ->
+    returnRn (HsPIParam name ty', fvs)
 \end{code}
 
 \end{code}
 
+\begin{code}
+rnFds :: SDoc -> [FunDep RdrName] -> RnMS ([FunDep Name], FreeVars)
+
+rnFds doc fds
+  = mapAndUnzipRn rn_fds fds           `thenRn` \ (theta, fvs_s) ->
+    returnRn (theta, plusFVs fvs_s)
+  where
+    rn_fds (tys1, tys2)
+      =        rnHsTyVars doc tys1             `thenRn` \ (tys1', fvs1) ->
+       rnHsTyVars doc tys2             `thenRn` \ (tys2', fvs2) ->
+       returnRn ((tys1', tys2'), fvs1 `plusFV` fvs2)
+
+rnHsTyVars doc tvs = mapFvRn (rnHsTyvar doc) tvs
+rnHsTyvar doc tyvar
+  = lookupOccRn tyvar          `thenRn` \ tyvar' ->
+    returnRn (tyvar', unitFV tyvar')
+\end{code}
 
 %*********************************************************
 
 %*********************************************************
-%*                                                     *
+%*                                                      *
 \subsection{IdInfo}
 \subsection{IdInfo}
-%*                                                     *
+%*                                                      *
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-rnIdInfo (HsStrictness strict)
-  = rnStrict strict    `thenRn` \ strict' ->
-    returnRn (HsStrictness strict')
-
-rnIdInfo (HsUnfold inline (Just expr)) = rnCoreExpr expr       `thenRn` \ expr' ->
-                                         returnRn (HsUnfold inline (Just expr'))
-rnIdInfo (HsUnfold inline Nothing)     = returnRn (HsUnfold inline Nothing)
-rnIdInfo (HsArity arity)       = returnRn (HsArity arity)
-rnIdInfo (HsUpdate update)     = returnRn (HsUpdate update)
-rnIdInfo (HsNoCafRefs)         = returnRn (HsNoCafRefs)
-rnIdInfo (HsSpecialise tyvars tys expr)
-  = bindTyVarsRn doc tyvars    $ \ tyvars' ->
-    rnCoreExpr expr            `thenRn` \ expr' ->
-    mapRn (rnIfaceType doc) tys        `thenRn` \ tys' ->
-    returnRn (HsSpecialise tyvars' tys' expr')
-  where
-    doc = text "Specialise in interface pragma"
-    
+rnIdInfo (HsStrictness str) = returnRn (HsStrictness str, emptyFVs)
 
 
-rnStrict (HsStrictnessInfo demands (Just (worker,cons)))
-       -- The sole purpose of the "cons" field is so that we can mark the constructors
-       -- needed to build the wrapper as "needed", so that their data type decl will be
-       -- slurped in. After that their usefulness is o'er, so we just put in the empty list.
+rnIdInfo (HsWorker worker)
   = lookupOccRn worker                 `thenRn` \ worker' ->
   = lookupOccRn worker                 `thenRn` \ worker' ->
-    mapRn lookupOccRn cons             `thenRn_` 
-    returnRn (HsStrictnessInfo demands (Just (worker',[])))
+    returnRn (HsWorker worker', unitFV worker')
+
+rnIdInfo (HsUnfold inline expr)        = rnCoreExpr expr `thenRn` \ (expr', fvs) ->
+                                 returnRn (HsUnfold inline expr', fvs)
+rnIdInfo (HsArity arity)       = returnRn (HsArity arity, emptyFVs)
+rnIdInfo HsNoCafRefs           = returnRn (HsNoCafRefs, emptyFVs)
+rnIdInfo HsCprInfo             = returnRn (HsCprInfo, emptyFVs)
 
 
--- Boring, but necessary for the type checker.
-rnStrict (HsStrictnessInfo demands Nothing) = returnRn (HsStrictnessInfo demands Nothing)
-rnStrict HsBottom                        = returnRn HsBottom
 \end{code}
 
 \end{code}
 
-UfCore expressions.
+@UfCore@ expressions.
 
 \begin{code}
 rnCoreExpr (UfType ty)
 
 \begin{code}
 rnCoreExpr (UfType ty)
-  = rnIfaceType (text "unfolding type") ty     `thenRn` \ ty' ->
-    returnRn (UfType ty')
+  = rnHsType (text "unfolding type") ty        `thenRn` \ (ty', fvs) ->
+    returnRn (UfType ty', fvs)
 
 rnCoreExpr (UfVar v)
   = lookupOccRn v      `thenRn` \ v' ->
 
 rnCoreExpr (UfVar v)
   = lookupOccRn v      `thenRn` \ v' ->
-    returnRn (UfVar v')
+    returnRn (UfVar v', unitFV v')
 
 
-rnCoreExpr (UfCon con args) 
-  = rnUfCon con                        `thenRn` \ con' ->
-    mapRn rnCoreExpr args      `thenRn` \ args' ->
-    returnRn (UfCon con' args')
+rnCoreExpr (UfLit l)
+  = returnRn (UfLit l, emptyFVs)
+
+rnCoreExpr (UfLitLit l ty)
+  = rnHsType (text "litlit") ty        `thenRn` \ (ty', fvs) ->
+    returnRn (UfLitLit l ty', fvs)
+
+rnCoreExpr (UfCCall cc ty)
+  = rnHsType (text "ccall") ty `thenRn` \ (ty', fvs) ->
+    returnRn (UfCCall cc ty', fvs)
 
 rnCoreExpr (UfTuple con args) 
 
 rnCoreExpr (UfTuple con args) 
-  = lookupOccRn con            `thenRn` \ con' ->
-    mapRn rnCoreExpr args      `thenRn` \ args' ->
-    returnRn (UfTuple con' args')
+  = rnHsTupConWkr con                  `thenRn` \ (con', fvs1) ->
+    mapFvRn rnCoreExpr args            `thenRn` \ (args', fvs2) ->
+    returnRn (UfTuple con' args', fvs1 `plusFV` fvs2)
 
 rnCoreExpr (UfApp fun arg)
 
 rnCoreExpr (UfApp fun arg)
-  = rnCoreExpr fun             `thenRn` \ fun' ->
-    rnCoreExpr arg             `thenRn` \ arg' ->
-    returnRn (UfApp fun' arg')
-
-rnCoreExpr (UfCase scrut bndr alts) 
-  = rnCoreExpr scrut                   `thenRn` \ scrut' ->
-    bindLocalsRn "a UfCase" [bndr]     $ \ [bndr'] ->
-    mapRn rnCoreAlt alts               `thenRn` \ alts' ->
-    returnRn (UfCase scrut' bndr' alts')
+  = rnCoreExpr fun             `thenRn` \ (fun', fv1) ->
+    rnCoreExpr arg             `thenRn` \ (arg', fv2) ->
+    returnRn (UfApp fun' arg', fv1 `plusFV` fv2)
+
+rnCoreExpr (UfCase scrut bndr alts)
+  = rnCoreExpr scrut                   `thenRn` \ (scrut', fvs1) ->
+    bindCoreLocalFVRn bndr             ( \ bndr' ->
+       mapFvRn rnCoreAlt alts          `thenRn` \ (alts', fvs2) ->
+       returnRn (UfCase scrut' bndr' alts', fvs2)
+    )                                          `thenRn` \ (case', fvs3) ->
+    returnRn (case', fvs1 `plusFV` fvs3)
 
 rnCoreExpr (UfNote note expr) 
 
 rnCoreExpr (UfNote note expr) 
-  = rnNote note                        `thenRn` \ note' ->
-    rnCoreExpr expr            `thenRn` \ expr' ->
-    returnRn  (UfNote note' expr') 
+  = rnNote note                        `thenRn` \ (note', fvs1) ->
+    rnCoreExpr expr            `thenRn` \ (expr', fvs2) ->
+    returnRn  (UfNote note' expr', fvs1 `plusFV` fvs2) 
 
 rnCoreExpr (UfLam bndr body)
   = rnCoreBndr bndr            $ \ bndr' ->
 
 rnCoreExpr (UfLam bndr body)
   = rnCoreBndr bndr            $ \ bndr' ->
-    rnCoreExpr body            `thenRn` \ body' ->
-    returnRn (UfLam bndr' body')
+    rnCoreExpr body            `thenRn` \ (body', fvs) ->
+    returnRn (UfLam bndr' body', fvs)
 
 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
 
 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
-  = rnCoreExpr rhs             `thenRn` \ rhs' ->
-    rnCoreBndr bndr            $ \ bndr' ->
-    rnCoreExpr body            `thenRn` \ body' ->
-    returnRn (UfLet (UfNonRec bndr' rhs') body')
+  = rnCoreExpr rhs             `thenRn` \ (rhs', fvs1) ->
+    rnCoreBndr bndr            ( \ bndr' ->
+       rnCoreExpr body         `thenRn` \ (body', fvs2) ->
+       returnRn (UfLet (UfNonRec bndr' rhs') body', fvs2)
+    )                          `thenRn` \ (result, fvs3) ->
+    returnRn (result, fvs1 `plusFV` fvs3)
 
 rnCoreExpr (UfLet (UfRec pairs) body)
   = rnCoreBndrs bndrs          $ \ bndrs' ->
 
 rnCoreExpr (UfLet (UfRec pairs) body)
   = rnCoreBndrs bndrs          $ \ bndrs' ->
-    mapRn rnCoreExpr rhss      `thenRn` \ rhss' ->
-    rnCoreExpr body            `thenRn` \ body' ->
-    returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
+    mapFvRn rnCoreExpr rhss    `thenRn` \ (rhss', fvs1) ->
+    rnCoreExpr body            `thenRn` \ (body', fvs2) ->
+    returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body', fvs1 `plusFV` fvs2)
   where
     (bndrs, rhss) = unzip pairs
 \end{code}
 
 \begin{code}
 rnCoreBndr (UfValBinder name ty) thing_inside
   where
     (bndrs, rhss) = unzip pairs
 \end{code}
 
 \begin{code}
 rnCoreBndr (UfValBinder name ty) thing_inside
-  = rnIfaceType (text str) ty  `thenRn` \ ty' ->
-    bindLocalsRn str [name]    $ \ [name'] ->
-    thing_inside (UfValBinder name' ty')
+  = rnHsType doc ty            `thenRn` \ (ty', fvs1) ->
+    bindCoreLocalFVRn name     ( \ name' ->
+           thing_inside (UfValBinder name' ty')
+    )                          `thenRn` \ (result, fvs2) ->
+    returnRn (result, fvs1 `plusFV` fvs2)
   where
   where
-    str = "unfolding id"
+    doc = text "unfolding id"
     
 rnCoreBndr (UfTyBinder name kind) thing_inside
     
 rnCoreBndr (UfTyBinder name kind) thing_inside
-  = bindLocalsRn "an unfolding tyvar" [name] $ \ [name'] ->
+  = bindCoreLocalFVRn name             $ \ name' ->
     thing_inside (UfTyBinder name' kind)
     
     thing_inside (UfTyBinder name' kind)
     
-rnCoreBndrs bndrs thing_inside         -- Expect them all to be ValBinders
-  = mapRn (rnIfaceType (text str)) tys `thenRn` \ tys' ->
-    bindLocalsRn str names             $ \ names' ->
-    thing_inside (zipWith UfValBinder names' tys')
-  where
-    str   = "unfolding id"
-    names = map (\ (UfValBinder name _ ) -> name) bndrs
-    tys   = map (\ (UfValBinder _    ty) -> ty)   bndrs
+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)
 \end{code}    
 
 \begin{code}
 rnCoreAlt (con, bndrs, rhs)
-  = rnUfCon con                                        `thenRn` \ con' ->
-    bindLocalsRn "an unfolding alt" bndrs      $ \ bndrs' ->
-    rnCoreExpr rhs                             `thenRn` \ rhs' ->
-    returnRn (con', bndrs', rhs')
-
+  = rnUfCon con bndrs                  `thenRn` \ (con', fvs1) ->
+    bindCoreLocalsFVRn bndrs           ( \ bndrs' ->
+       rnCoreExpr rhs                  `thenRn` \ (rhs', fvs2) ->
+       returnRn ((con', bndrs', rhs'), fvs2)
+    )                                  `thenRn` \ (result, fvs3) ->
+    returnRn (result, fvs1 `plusFV` fvs3)
 
 rnNote (UfCoerce ty)
 
 rnNote (UfCoerce ty)
-  = rnIfaceType (text "unfolding coerce") ty   `thenRn` \ ty' ->
-    returnRn (UfCoerce ty')
+  = rnHsType (text "unfolding coerce") ty      `thenRn` \ (ty', fvs) ->
+    returnRn (UfCoerce ty', fvs)
+
+rnNote (UfSCC cc)   = returnRn (UfSCC cc, emptyFVs)
+rnNote UfInlineCall = returnRn (UfInlineCall, emptyFVs)
+rnNote UfInlineMe   = returnRn (UfInlineMe, emptyFVs)
 
 
-rnNote (UfSCC cc)   = returnRn (UfSCC cc)
-rnNote UfInlineCall = returnRn UfInlineCall
 
 
+rnUfCon UfDefault _
+  = returnRn (UfDefault, emptyFVs)
 
 
-rnUfCon UfDefault
-  = returnRn UfDefault
+rnUfCon (UfTupleAlt tup_con) bndrs
+  = rnHsTupCon tup_con                 `thenRn` \ (HsTupCon con' _, fvs) -> 
+    returnRn (UfDataAlt con', fvs)
+       -- Makes the type checker a little easier
 
 
-rnUfCon (UfDataCon con)
+rnUfCon (UfDataAlt con) _
   = lookupOccRn con            `thenRn` \ con' ->
   = lookupOccRn con            `thenRn` \ con' ->
-    returnRn (UfDataCon con')
+    returnRn (UfDataAlt con', unitFV con')
 
 
-rnUfCon (UfLitCon lit)
-  = returnRn (UfLitCon lit)
+rnUfCon (UfLitAlt lit) _
+  = returnRn (UfLitAlt lit, emptyFVs)
 
 
-rnUfCon (UfLitLitCon lit ty)
-  = rnIfaceType (text "litlit") ty             `thenRn` \ ty' ->
-    returnRn (UfLitLitCon lit ty')
+rnUfCon (UfLitLitAlt lit ty) _
+  = rnHsType (text "litlit") ty                `thenRn` \ (ty', fvs) ->
+    returnRn (UfLitLitAlt lit ty', fvs)
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Rule shapes}
+%*                                                      *
+%*********************************************************
 
 
-rnUfCon (UfPrimOp op)
-  = lookupOccRn op             `thenRn` \ op' ->
-    returnRn (UfPrimOp op')
+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.
 
 
-rnUfCon (UfCCallOp str is_dyn casm gc)
-  = returnRn (UfCCallOp str is_dyn casm gc)
+\begin{code}
+validRuleLhs foralls lhs
+  = check lhs
+  where
+    check (HsApp e1 e2)                  = check e1
+    check (HsVar v) | v `notElem` foralls = True
+    check other                                  = False
 \end{code}
 
 \end{code}
 
+
 %*********************************************************
 %*********************************************************
-%*                                                     *
+%*                                                      *
 \subsection{Errors}
 \subsection{Errors}
-%*                                                     *
+%*                                                      *
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
@@ -782,30 +906,50 @@ classTyVarNotInOpTyErr clas_tyvar sig
                       ptext SLIT("does not appear in method signature")])
         4 (ppr sig)
 
                       ptext SLIT("does not appear in method signature")])
         4 (ppr sig)
 
-dupClassAssertWarn ctxt (assertion : dups)
-  = sep [hsep [ptext SLIT("Duplicate class assertion"), 
-              quotes (pprClassAssertion assertion),
-              ptext SLIT("in the context:")],
-        nest 4 (pprContext ctxt <+> ptext SLIT("..."))]
-
 badDataCon name
    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 
 badDataCon name
    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 
-forAllErr doc ty tyvar
-  = addErrRn (
+forAllWarn doc ty tyvar
+  | not opt_WarnUnusedMatches = returnRn ()
+  | otherwise
+  = getModeRn          `thenRn` \ mode ->
+    case mode of {
+#ifndef DEBUG
+       InterfaceMode -> returnRn () ;  -- Don't warn of unused tyvars in interface files
+                                       -- unless DEBUG is on, in which case it is slightly
+                                       -- informative.  They can arise from mkRhsTyLam,
+#endif                                 -- leading to (say)     f :: forall a b. [b] -> [b]
+       other ->
+
+    addWarnRn (
       sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
           nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
       $$
       (ptext SLIT("In") <+> doc))
       sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
           nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
       $$
       (ptext SLIT("In") <+> doc))
+    }
 
 
-ctxtErr explicit_forall doc tyvars constraint ty
-  = sep [ptext SLIT("The constraint") <+> quotes (pprClassAssertion constraint) <+>
-                  ptext SLIT("does not mention any of"),
-        if explicit_forall then
-          nest 4 (ptext SLIT("the universally quantified type variables") <+> braces (interpp'SP tyvars))
-        else
-          nest 4 (ptext SLIT("the type variables in the type") <+> quotes (ppr ty))
-    ]
+badRuleLhsErr name lhs
+  = sep [ptext SLIT("Rule") <+> ptext name <> colon,
+        nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
     $$
     $$
-    (ptext SLIT("In") <+> doc)
+    ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
+
+badRuleVar name var
+  = sep [ptext SLIT("Rule") <+> ptext name <> colon,
+        ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+> 
+               ptext SLIT("does not appear on left hand side")]
+
+badExtName :: ExtName -> Message
+badExtName ext_nm
+  = sep [quotes (ppr ext_nm) <+> ptext SLIT("is not a valid C identifier")]
+
+dupClassAssertWarn ctxt (assertion : dups)
+  = sep [hsep [ptext SLIT("Duplicate class assertion"), 
+              quotes (ppr assertion),
+              ptext SLIT("in the context:")],
+        nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
+
+naughtyCCallContextErr (HsPClass clas _)
+  = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas), 
+        ptext SLIT("in a context")]
 \end{code}
 \end{code}
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)