[project @ 2000-11-20 16:07:12 by simonpj]
[ghc-hetmet.git] / ghc / compiler / hsSyn / HsDecls.lhs
index 1c3c8d4..c464de5 100644 (file)
@@ -11,36 +11,36 @@ module HsDecls (
        HsDecl(..), TyClDecl(..), InstDecl(..), RuleDecl(..), RuleBndr(..),
        DefaultDecl(..), ForeignDecl(..), ForKind(..),
        ExtName(..), isDynamicExtName, extNameStatic,
-       ConDecl(..), ConDetails(..), BangType(..),
-       IfaceSig(..),  SpecDataSig(..), 
+       ConDecl(..), ConDetails(..), 
+       BangType(..), getBangType,
        DeprecDecl(..), DeprecTxt,
-       hsDeclName, tyClDeclName, isClassDecl, isSynDecl, isDataDecl, countTyClDecls, toHsRule
+       hsDeclName, instDeclName, tyClDeclName, tyClDeclNames, tyClDeclSysNames,
+       isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl, countTyClDecls,
+       mkClassDeclSysNames, isIfaceRuleDecl, ifaceRuleDeclName,
+       getClassDeclSysNames, conDetailsTys
     ) where
 
 #include "HsVersions.h"
 
 -- friends:
-import HsBinds         ( HsBinds, MonoBinds, Sig(..), FixitySig(..), nullMonoBinds )
+import HsBinds         ( HsBinds, MonoBinds, Sig(..), FixitySig(..) )
 import HsExpr          ( HsExpr )
-import HsPragmas       ( DataPragmas, ClassPragmas )
-import HsImpExp                ( IE(..) )
 import HsTypes
 import PprCore         ( pprCoreRule )
-import HsCore          ( UfExpr(UfVar), UfBinder, IfaceSig(..), eq_ufBinders, eq_ufExpr, pprUfExpr, toUfExpr, toUfBndr )
+import HsCore          ( UfExpr, UfBinder, HsIdInfo, pprHsIdInfo,
+                         eq_ufBinders, eq_ufExpr, pprUfExpr 
+                       )
 import CoreSyn         ( CoreRule(..) )
-import BasicTypes      ( Fixity, NewOrData(..) )
+import BasicTypes      ( NewOrData(..) )
 import CallConv                ( CallConv, pprCallConv )
-import Var             ( TyVar, Id )
-import Name            ( toRdrName )
 
 -- others:
-import PprType
+import Name            ( NamedThing )
 import FunDeps         ( pprFundeps )
-import Class           ( FunDep )
+import Class           ( FunDep, DefMeth(..) )
 import CStrings                ( CLabelString, pprCLabelString )
 import Outputable      
-import SrcLoc          ( SrcLoc, noSrcLoc )
-import Util
+import SrcLoc          ( SrcLoc )
 \end{code}
 
 
@@ -57,7 +57,6 @@ data HsDecl name pat
   | DefD       (DefaultDecl name)
   | ValD       (HsBinds name pat)
   | ForD        (ForeignDecl name)
-  | SigD       (IfaceSig name)
   | FixD       (FixitySig name)
   | DeprecD    (DeprecDecl name)
   | RuleD      (RuleDecl name pat)
@@ -78,31 +77,29 @@ data HsDecl name pat
 
 \begin{code}
 #ifdef DEBUG
-hsDeclName :: (Outputable name, Outputable pat)
+hsDeclName :: (NamedThing name, Outputable name, Outputable pat)
           => HsDecl name pat -> name
 #endif
-hsDeclName (TyClD decl)                                  = tyClDeclName decl
-hsDeclName (SigD    (IfaceSig name _ _ _))       = name
-hsDeclName (InstD   (InstDecl _ _ _ name _))      = name
-hsDeclName (ForD    (ForeignDecl name _ _ _ _ _)) = name
-hsDeclName (FixD    (FixitySig name _ _))        = name
+hsDeclName (TyClD decl)                                    = tyClDeclName decl
+hsDeclName (InstD   decl)                          = instDeclName decl
+hsDeclName (ForD    (ForeignDecl name _ _ _ _ _))   = name
+hsDeclName (FixD    (FixitySig name _ _))          = name
 -- Others don't make sense
 #ifdef DEBUG
 hsDeclName x                                 = pprPanic "HsDecls.hsDeclName" (ppr x)
 #endif
 
-tyClDeclName :: TyClDecl name pat -> name
-tyClDeclName (TyData _ _ name _ _ _ _ _ _)          = name
-tyClDeclName (TySynonym name _ _ _)                 = name
-tyClDeclName (ClassDecl _ name _ _ _ _ _ _ _ _ _ _) = name
+
+instDeclName :: InstDecl name pat -> name
+instDeclName (InstDecl _ _ _ (Just name) _) = name
+
 \end{code}
 
 \begin{code}
-instance (Outputable name, Outputable pat)
+instance (NamedThing name, Outputable name, Outputable pat)
        => Outputable (HsDecl name pat) where
 
     ppr (TyClD dcl)  = ppr dcl
-    ppr (SigD sig)   = ppr sig
     ppr (ValD binds) = ppr binds
     ppr (DefD def)   = ppr def
     ppr (InstD inst) = ppr inst
@@ -112,15 +109,6 @@ instance (Outputable name, Outputable pat)
     ppr (DeprecD dd) = ppr dd
 \end{code}
 
-\begin{code}
-instance Ord name => Eq (HsDecl name pat) where
-       -- Used only when comparing interfaces, 
-       -- at which time only signature and type/class decls
-   (SigD s1)  == (SigD s2)  = s1 == s2
-   (TyClD d1) == (TyClD d2) = d1 == d2
-   _          == _          = False
-\end{code}
-
 
 %************************************************************************
 %*                                                                     *
@@ -128,9 +116,56 @@ instance Ord name => Eq (HsDecl name pat) where
 %*                                                                     *
 %************************************************************************
 
+Type and class declarations carry 'implicit names'.  In particular:
+
+Type A.  
+~~~~~~~
+  Each data type decl defines 
+       a worker name for each constructor
+       to-T and from-T convertors
+  Each class decl defines
+       a tycon for the class
+       a data constructor for that tycon
+       the worker for that constructor
+       a selector for each superclass
+
+All have occurrence names that are derived uniquely from their parent declaration.
+
+None of these get separate definitions in an interface file; they are
+fully defined by the data or class decl.  But they may *occur* in
+interface files, of course.  Any such occurrence must haul in the
+relevant type or class decl.
+
+Plan of attack:
+ - Make up their occurrence names immediately
+
+ - Ensure they "point to" the parent data/class decl 
+   when loading that decl from an interface file
+
+ - When renaming the decl look them up in the name cache,
+   ensure correct module and provenance is set
+
+Type B: Default methods and dictionary functions
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Have their own binding in an interface file.
+
+Default methods : occurrence name is derived uniquely from the class decl.
+Dict functions  : occurrence name is derived from the instance decl, plus a unique number.
+
+Plan of attack: 
+  - Do *not* make them point to the parent class decl
+  - Interface-file decls: treat just like Type A
+  - Source-file decls:    the names aren't in the decl at all; 
+                         instead the typechecker makes them up
+
 \begin{code}
 data TyClDecl name pat
-  = TyData     NewOrData
+  = IfaceSig   name                    -- It may seem odd to classify an interface-file signature
+               (HsType name)           -- as a 'TyClDecl', but it's very convenient.  These three
+               [HsIdInfo name]         -- are the kind that appear in interface files.
+               SrcLoc
+
+  | TyData     NewOrData
                (HsContext name) -- context
                name             -- type constructor
                [HsTyVarBndr name]       -- type variables
@@ -140,12 +175,13 @@ data TyClDecl name pat
                                 -- (i.e., derive default); Just [] => derive
                                 -- *nothing*; Just <list> => as you would
                                 -- expect...
-               (DataPragmas name)
                SrcLoc
+               name             -- generic converter functions
+               name             -- generic converter functions
 
-  | TySynonym  name            -- type constructor
-               [HsTyVarBndr name]      -- type variables
-               (HsType name)   -- synonym expansion
+  | TySynonym  name                    -- type constructor
+                [HsTyVarBndr name]     -- type variables
+               (HsType name)           -- synonym expansion
                SrcLoc
 
   | ClassDecl  (HsContext name)        -- context...
@@ -154,20 +190,92 @@ data TyClDecl name pat
                [FunDep name]           -- functional dependencies
                [Sig name]              -- methods' signatures
                (MonoBinds name pat)    -- default methods
-               (ClassPragmas name)
-               name name name [name]   -- The names of the tycon, datacon wrapper, datacon worker,
-                                       -- and superclass selectors for this class.
-                                       -- These are filled in as the ClassDecl is made.
+               (ClassDeclSysNames name)
                SrcLoc
+\end{code}
+
+Simple classifiers
+
+\begin{code}
+isIfaceSigDecl, isDataDecl, isSynDecl, isClassDecl :: TyClDecl name pat -> Bool
+
+isIfaceSigDecl (IfaceSig _ _ _ _) = True
+isIfaceSigDecl other             = False
+
+isSynDecl (TySynonym _ _ _ _) = True
+isSynDecl other                      = False
+
+isDataDecl (TyData _ _ _ _ _ _ _ _ _ _) = True
+isDataDecl other                       = False
+
+isClassDecl (ClassDecl _ _ _ _ _ _ _ _ ) = True
+isClassDecl other                       = False
+\end{code}
+
+Dealing with names
+
+\begin{code}
+--------------------------------
+tyClDeclName :: TyClDecl name pat -> name
+tyClDeclName (IfaceSig name _ _ _)          = name
+tyClDeclName (TyData _ _ name _ _ _ _ _ _ _) = name
+tyClDeclName (TySynonym name _ _ _)          = name
+tyClDeclName (ClassDecl _ name _ _ _ _ _ _)  = name
+
+
+--------------------------------
+tyClDeclNames :: Eq name => TyClDecl name pat -> [(name, SrcLoc)]
+-- Returns all the binding names of the decl, along with their SrcLocs
+-- The first one is guaranteed to be the name of the decl
+-- For record fields, the first one counts as the SrcLoc
+-- We use the equality to filter out duplicate field names
+
+tyClDeclNames (TySynonym name _ _ loc)
+  = [(name,loc)]
+
+tyClDeclNames (ClassDecl _ cls_name _ _ sigs _ _ loc)
+  = (cls_name,loc) : [(n,loc) | ClassOpSig n _ _ loc <- sigs]
+
+tyClDeclNames (TyData _ _ tc_name _ cons _ _ loc _ _)
+  = (tc_name,loc) : conDeclsNames cons
+
+tyClDeclNames (IfaceSig name _ _ loc) = [(name,loc)]
+
+--------------------------------
+tyClDeclSysNames :: TyClDecl name pat -> [(name, SrcLoc)]
+-- Similar to tyClDeclNames, but returns the "implicit" 
+-- or "system" names of the declaration
+
+tyClDeclSysNames (ClassDecl _ _ _ _ _ _ names loc) = [(n,loc)        | n <- names]
+tyClDeclSysNames (TyData _ _ _ _ cons _ _ _ _ _)   = [(wkr_name,loc) | ConDecl _ wkr_name _ _ _ loc <- cons]
+tyClDeclSysNames decl                             = []
+
+
+--------------------------------
+type ClassDeclSysNames name = [name]
+       --      [tycon, datacon wrapper, datacon worker, 
+       --       superclass selector 1, ..., superclass selector n]
+       -- They are kept in a list rather than a tuple to make the
+       -- renamer easier.
+
+mkClassDeclSysNames  :: (name, name, name, [name]) -> [name]
+getClassDeclSysNames :: [name] -> (name, name, name, [name])
+mkClassDeclSysNames  (a,b,c,ds) = a:b:c:ds
+getClassDeclSysNames (a:b:c:ds) = (a,b,c,ds)
+\end{code}
 
-instance Ord name => Eq (TyClDecl name pat) where
+\begin{code}
+instance (NamedThing name, Ord name) => Eq (TyClDecl name pat) where
        -- Used only when building interface files
-  (==) (TyData nd1 cxt1 n1 tvs1 cons1 _ _ _ _)
-       (TyData nd2 cxt2 n2 tvs2 cons2 _ _ _ _)
+  (==) (IfaceSig n1 t1 i1 _)
+       (IfaceSig n2 t2 i2 _) = n1==n2 && t1==t2 && i1==i2
+
+  (==) (TyData nd1 cxt1 n1 tvs1 cons1 _ _ _ _ _)
+       (TyData nd2 cxt2 n2 tvs2 cons2 _ _ _ _ _)
     = n1 == n2 &&
       nd1 == nd2 &&
       eqWithHsTyVars tvs1 tvs2 (\ env -> 
-         eq_hsContext env cxt1 cxt2 &&
+         eq_hsContext env cxt1 cxt2  &&
          eqListBy (eq_ConDecl env) cons1 cons2
       )
 
@@ -176,8 +284,8 @@ instance Ord name => Eq (TyClDecl name pat) where
     =  n1 == n2 &&
        eqWithHsTyVars tvs1 tvs2 (\ env -> eq_hsType env ty1 ty2)
 
-  (==) (ClassDecl cxt1 n1 tvs1 fds1 sigs1 _ _ _ _ _ _ _)
-       (ClassDecl cxt2 n2 tvs2 fds2 sigs2 _ _ _ _ _ _ _)
+  (==) (ClassDecl cxt1 n1 tvs1 fds1 sigs1 _ _ _ )
+       (ClassDecl cxt2 n2 tvs2 fds2 sigs2 _ _ _ )
     =  n1 == n2 &&
        eqWithHsTyVars tvs1 tvs2 (\ env -> 
          eq_hsContext env cxt1 cxt2 &&
@@ -185,43 +293,50 @@ instance Ord name => Eq (TyClDecl name pat) where
          eqListBy (eq_cls_sig env) sigs1 sigs2
        )
 
+  (==) _ _ = False     -- default case
+
 eq_hsFD env (ns1,ms1) (ns2,ms2)
   = eqListBy (eq_hsVar env) ns1 ns2 && eqListBy (eq_hsVar env) ms1 ms2
 
-eq_cls_sig env (ClassOpSig n1 _ b1 ty1 _) (ClassOpSig n2 _ b2 ty2 _)
-  = n1==n2 && b1==b2 && eq_hsType env ty1 ty2
+eq_cls_sig env (ClassOpSig n1 dm1 ty1 _) (ClassOpSig n2 dm2 ty2 _)
+  = n1==n2 && dm1 `eq_dm` dm2 && eq_hsType env ty1 ty2
+  where
+       -- Ignore the name of the default method for (DefMeth id)
+       -- This is used for comparing declarations before putting
+       -- them into interface files, and the name of the default 
+       -- method isn't relevant
+    Nothing           `eq_dm` Nothing            = True
+    (Just NoDefMeth)   `eq_dm` (Just NoDefMeth)   = True
+    (Just GenDefMeth)  `eq_dm` (Just GenDefMeth)  = True
+    (Just (DefMeth _)) `eq_dm` (Just (DefMeth _)) = True
+    dm1                       `eq_dm` dm2                = False
+
+    
 \end{code}
 
 \begin{code}
-countTyClDecls :: [TyClDecl name pat] -> (Int, Int, Int, Int)
+countTyClDecls :: [TyClDecl name pat] -> (Int, Int, Int, Int, Int)
        -- class, data, newtype, synonym decls
 countTyClDecls decls 
- = (length [() | ClassDecl _ _ _ _ _ _ _ _ _ _ _ _ <- decls],
-    length [() | TyData DataType _ _ _ _ _ _ _ _   <- decls],
-    length [() | TyData NewType  _ _ _ _ _ _ _ _   <- decls],
-    length [() | TySynonym _ _ _ _                <- decls])
-
-isDataDecl, isSynDecl, isClassDecl :: TyClDecl name pat -> Bool
-
-isSynDecl (TySynonym _ _ _ _) = True
-isSynDecl other                      = False
-
-isDataDecl (TyData _ _ _ _ _ _ _ _ _) = True
-isDataDecl other                     = False
-
-isClassDecl (ClassDecl _ _ _ _ _ _ _ _ _ _ _ _) = True
-isClassDecl other                              = False
+ = (length [() | ClassDecl _ _ _ _ _ _ _ _        <- decls],
+    length [() | TyData DataType _ _ _ _ _ _ _ _ _ <- decls],
+    length [() | TyData NewType  _ _ _ _ _ _ _ _ _ <- decls],
+    length [() | TySynonym _ _ _ _                <- decls],
+    length [() | IfaceSig _ _ _ _                 <- decls])
 \end{code}
 
 \begin{code}
-instance (Outputable name, Outputable pat)
+instance (NamedThing name, Outputable name, Outputable pat)
              => Outputable (TyClDecl name pat) where
 
+    ppr (IfaceSig var ty info _) = hsep [ppr var, dcolon, ppr ty, pprHsIdInfo info]
+
     ppr (TySynonym tycon tyvars mono_ty src_loc)
       = hang (ptext SLIT("type") <+> pp_decl_head [] tycon tyvars <+> equals)
             4 (ppr mono_ty)
 
-    ppr (TyData new_or_data context tycon tyvars condecls ncons derivings pragmas src_loc)
+    ppr (TyData new_or_data context tycon tyvars condecls ncons 
+               derivings src_loc gen_conv1 gen_conv2) -- The generic names are not printed out ATM
       = pp_tydecl
                  (ptext keyword <+> pp_decl_head context tycon tyvars <+> equals)
                  (pp_condecls condecls ncons)
@@ -231,7 +346,7 @@ instance (Outputable name, Outputable pat)
                        NewType  -> SLIT("newtype")
                        DataType -> SLIT("data")
 
-    ppr (ClassDecl context clas tyvars fds sigs methods pragmas _ _ _ _ src_loc)
+    ppr (ClassDecl context clas tyvars fds sigs methods _ src_loc)
       | null sigs      -- No "where" part
       = top_matter
 
@@ -244,7 +359,6 @@ instance (Outputable name, Outputable pat)
        pp_methods = getPprStyle $ \ sty ->
                     if ifaceStyle sty then empty else ppr methods
         
-
 pp_decl_head :: Outputable name => HsContext name -> name -> [HsTyVarBndr name] -> SDoc
 pp_decl_head context thing tyvars = hsep [pprHsContext context, ppr thing, interppSP tyvars]
 
@@ -260,22 +374,6 @@ pp_tydecl pp_head pp_decl_rhs derivings
     ])
 \end{code}
 
-A type for recording what types a datatype should be specialised to.
-It's called a ``Sig'' because it's sort of like a ``type signature''
-for an datatype declaration.
-
-\begin{code}
-data SpecDataSig name
-  = SpecDataSig name           -- tycon to specialise
-               (HsType name)
-               SrcLoc
-
-instance (Outputable name)
-             => Outputable (SpecDataSig name) where
-
-    ppr (SpecDataSig tycon ty _)
-      = hsep [text "{-# SPECIALIZE data", ppr ty, text "#-}"]
-\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -291,7 +389,7 @@ data ConDecl name
                name                    -- Name of the constructor's 'worker Id'
                                        -- Filled in as the ConDecl is built
 
-               [HsTyVarBndr name]              -- Existentially quantified type variables
+               [HsTyVarBndr name]      -- Existentially quantified type variables
                (HsContext name)        -- ...and context
                                        -- If both are empty then there are no existentials
 
@@ -308,21 +406,40 @@ data ConDetails name
 
   | RecCon                     -- record-style con decl
                [([name], BangType name)]       -- list of "fields"
+\end{code}
+
+\begin{code}
+conDeclsNames :: Eq name => [ConDecl name] -> [(name,SrcLoc)]
+  -- See tyClDeclNames for what this does
+  -- The function is boringly complicated because of the records
+  -- And since we only have equality, we have to be a little careful
+conDeclsNames cons
+  = snd (foldl do_one ([], []) cons)
+  where
+    do_one (flds_seen, acc) (ConDecl name _ _ _ details loc)
+       = do_details ((name,loc):acc) details
+       where
+         do_details acc (RecCon flds) = foldl do_fld (flds_seen, acc) flds
+         do_details acc other         = (flds_seen, acc)
 
-  | NewCon                     -- newtype con decl, possibly with a labelled field.
-               (HsType name)
-               (Maybe name)    -- Just x => labelled field 'x'
+         do_fld acc (flds, _) = foldl do_fld1 acc flds
 
-data BangType name
-  = Banged   (HsType name)     -- HsType: to allow Haskell extensions
-  | Unbanged (HsType name)     -- (MonoType only needed for straight Haskell)
-  | Unpacked (HsType name)     -- Field is strict and to be unpacked if poss.
+         do_fld1 (flds_seen, acc) fld
+               | fld `elem` flds_seen = (flds_seen,acc)
+               | otherwise            = (fld:flds_seen, (fld,loc):acc)
+\end{code}
+
+\begin{code}
+conDetailsTys :: ConDetails name -> [HsType name]
+conDetailsTys (VanillaCon btys)    = map getBangType btys
+conDetailsTys (InfixCon bty1 bty2) = [getBangType bty1, getBangType bty2]
+conDetailsTys (RecCon fields)     = [getBangType bty | (_, bty) <- fields]
 
 
 eq_ConDecl env (ConDecl n1 _ tvs1 cxt1 cds1 _)
               (ConDecl n2 _ tvs2 cxt2 cds2 _)
   = n1 == n2 &&
-    (eqWithHsTyVars tvs1 tvs2  $ \ env ->
+    (eq_hsTyVars env tvs1 tvs2 $ \ env ->
      eq_hsContext env cxt1 cxt2        &&
      eq_ConDetails env cds1 cds2)
 
@@ -332,11 +449,20 @@ eq_ConDetails env (InfixCon bta1 btb1) (InfixCon bta2 btb2)
   = eq_btype env bta1 bta2 && eq_btype env btb1 btb2
 eq_ConDetails env (RecCon fs1) (RecCon fs2)
   = eqListBy (eq_fld env) fs1 fs2
-eq_ConDetails env (NewCon t1 mn1) (NewCon t2 mn2)
-  = eq_hsType env t1 t2 && mn1 == mn2
 eq_ConDetails env _ _ = False
 
 eq_fld env (ns1,bt1) (ns2, bt2) = ns1==ns2 && eq_btype env bt1 bt2
+\end{code}
+  
+\begin{code}
+data BangType name
+  = Banged   (HsType name)     -- HsType: to allow Haskell extensions
+  | Unbanged (HsType name)     -- (MonoType only needed for straight Haskell)
+  | Unpacked (HsType name)     -- Field is strict and to be unpacked if poss.
+
+getBangType (Banged ty)   = ty
+getBangType (Unbanged ty) = ty
+getBangType (Unpacked ty) = ty
 
 eq_btype env (Banged t1)   (Banged t2)   = eq_hsType env t1 t2
 eq_btype env (Unbanged t1) (Unbanged t2) = eq_hsType env t1 t2
@@ -355,14 +481,6 @@ ppr_con_details con (InfixCon ty1 ty2)
 ppr_con_details con (VanillaCon tys)
   = ppr con <+> hsep (map (ppr_bang) tys)
 
-ppr_con_details con (NewCon ty Nothing)
-  = ppr con <+> pprParendHsType ty
-
-ppr_con_details con (NewCon ty (Just x))
-  = ppr con <+> braces pp_field 
-   where
-    pp_field = ppr x <+> dcolon <+> pprParendHsType ty
 ppr_con_details con (RecCon fields)
   = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
   where
@@ -395,7 +513,8 @@ data InstDecl name pat
 
                [Sig name]              -- User-supplied pragmatic info
 
-               name                    -- Name for the dictionary function
+               (Maybe name)            -- Name for the dictionary function
+                                       -- Nothing for source-file instance decls
 
                SrcLoc
 \end{code}
@@ -404,14 +523,18 @@ data InstDecl name pat
 instance (Outputable name, Outputable pat)
              => Outputable (InstDecl name pat) where
 
-    ppr (InstDecl inst_ty binds uprags dfun_name src_loc)
+    ppr (InstDecl inst_ty binds uprags maybe_dfun_name src_loc)
       = getPprStyle $ \ sty ->
         if ifaceStyle sty then
-           hsep [ptext SLIT("instance"), ppr inst_ty, equals, ppr dfun_name]
+           hsep [ptext SLIT("instance"), ppr inst_ty, equals, pp_dfun]
        else
           vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
                 nest 4 (ppr uprags),
                 nest 4 (ppr binds) ]
+      where
+       pp_dfun = case maybe_dfun_name of
+                   Just df -> ppr df
+                   Nothing -> empty
 \end{code}
 
 \begin{code}
@@ -531,19 +654,26 @@ data RuleDecl name pat
        name                    -- Head of LHS
        CoreRule
 
+isIfaceRuleDecl (HsRule _ _ _ _ _ _) = False
+isIfaceRuleDecl other               = True
+
+ifaceRuleDeclName :: RuleDecl name pat -> name
+ifaceRuleDeclName (IfaceRule _ _ n _ _ _) = n
+ifaceRuleDeclName (IfaceRuleOut n r)     = n
+ifaceRuleDeclName (HsRule fs _ _ _ _ _)   = pprPanic "ifaceRuleDeclName" (ppr fs)
 
 data RuleBndr name
   = RuleBndr name
   | RuleBndrSig name (HsType name)
 
-instance Ord name => Eq (RuleDecl name pat) where
+instance (NamedThing name, Ord name) => Eq (RuleDecl name pat) where
   -- Works for IfaceRules only; used when comparing interface file versions
   (IfaceRule n1 bs1 f1 es1 rhs1 _) == (IfaceRule n2 bs2 f2 es2 rhs2 _)
      = n1==n2 && f1 == f2 && 
        eq_ufBinders emptyEqHsEnv bs1 bs2 (\env -> 
        eqListBy (eq_ufExpr env) (rhs1:es1) (rhs2:es2))
 
-instance (Outputable name, Outputable pat)
+instance (NamedThing name, Outputable name, Outputable pat)
              => Outputable (RuleDecl name pat) where
   ppr (HsRule name tvs ns lhs rhs loc)
        = sep [text "{-# RULES" <+> doubleQuotes (ptext name),
@@ -567,16 +697,6 @@ instance (Outputable name, Outputable pat)
 instance Outputable name => Outputable (RuleBndr name) where
    ppr (RuleBndr name) = ppr name
    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
-
-toHsRule id (BuiltinRule _)
-  = pprTrace "toHsRule: builtin" (ppr id) (bogusIfaceRule id)
-
-toHsRule id (Rule name bndrs args rhs)
-  = IfaceRule name (map toUfBndr bndrs) (toRdrName id)
-             (map toUfExpr args) (toUfExpr rhs) noSrcLoc
-
-bogusIfaceRule id
-  = IfaceRule SLIT("bogus") [] (toRdrName id) [] (UfVar (toRdrName id)) noSrcLoc
 \end{code}
 
 
@@ -586,17 +706,14 @@ bogusIfaceRule id
 %*                                                                     *
 %************************************************************************
 
-We use exported entities for things to deprecate. Cunning trick (hack?):
-`IEModuleContents undefined' is used for module deprecation.
+We use exported entities for things to deprecate.
 
 \begin{code}
-data DeprecDecl name = Deprecation (IE name) DeprecTxt SrcLoc
+data DeprecDecl name = Deprecation name DeprecTxt SrcLoc
 
 type DeprecTxt = FAST_STRING   -- reason/explanation for deprecation
 
 instance Outputable name => Outputable (DeprecDecl name) where
-   ppr (Deprecation (IEModuleContents _) txt _)
-      = hsep [text "{-# DEPRECATED",            doubleQuotes (ppr txt), text "#-}"]
-   ppr (Deprecation thing txt _)
+    ppr (Deprecation thing txt _)
       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
 \end{code}