Remove code that is dead now that we need >= 6.12 to build

[ghc-hetmet.git] / compiler / iface / IfaceSyn.lhs

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 129ebd0..c06137c 100644 (file)
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -9,7 +9,8 @@ module IfaceSyn (
 
        IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
        IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
 
        IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
        IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),

-       IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..), IfaceIdDetails(..),
+       IfaceBinding(..), IfaceConAlt(..), 
+       IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),

        IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
        IfaceInst(..), IfaceFamInst(..),
 
        IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
        IfaceInst(..), IfaceFamInst(..),
 

@@ -26,8 +27,9 @@ module IfaceSyn (
 #include "HsVersions.h"
 
 import IfaceType
 #include "HsVersions.h"
 
 import IfaceType

-
-import NewDemand
+import CoreSyn( DFunArg, dfunArgExprs )
+import PprCore()            -- Printing DFunArgs
+import Demand

 import Annotations
 import Class
 import NameSet 
 import Annotations
 import Class
 import NameSet 

@@ -104,7 +106,7 @@ data IfaceDecl
                                                 -- beyond .NET
                   ifExtName :: Maybe FastString }
 
                                                 -- beyond .NET
                   ifExtName :: Maybe FastString }
 

-data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
+data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType

        -- Nothing    => no default method
        -- Just False => ordinary polymorphic default method
        -- Just True  => generic default method
        -- Nothing    => no default method
        -- Just False => ordinary polymorphic default method
        -- Just True  => generic default method

@@ -132,13 +134,13 @@ data IfaceConDecl
        ifConCtxt    :: IfaceContext,           -- Non-stupid context
        ifConArgTys  :: [IfaceType],            -- Arg types
        ifConFields  :: [OccName],              -- ...ditto... (field labels)
        ifConCtxt    :: IfaceContext,           -- Non-stupid context
        ifConArgTys  :: [IfaceType],            -- Arg types
        ifConFields  :: [OccName],              -- ...ditto... (field labels)

-       ifConStricts :: [StrictnessMark]}       -- Empty (meaning all lazy),
+       ifConStricts :: [HsBang]}               -- Empty (meaning all lazy),

                                                -- or 1-1 corresp with arg tys
 
 data IfaceInst 
                                                -- or 1-1 corresp with arg tys
 
 data IfaceInst 

-  = IfaceInst { ifInstCls  :: Name,                    -- See comments with
+  = IfaceInst { ifInstCls  :: IfExtName,               -- See comments with

                ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance
                ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance

-               ifDFun     :: Name,                     -- The dfun
+               ifDFun     :: IfExtName,                -- The dfun

                ifOFlag    :: OverlapFlag,              -- Overlap flag
                ifInstOrph :: Maybe OccName }           -- See Note [Orphans]
        -- There's always a separate IfaceDecl for the DFun, which gives 
                ifOFlag    :: OverlapFlag,              -- Overlap flag
                ifInstOrph :: Maybe OccName }           -- See Note [Orphans]
        -- There's always a separate IfaceDecl for the DFun, which gives 

@@ -149,7 +151,7 @@ data IfaceInst
        -- and if the head does not change it won't be used if it wasn't before
 
 data IfaceFamInst
        -- and if the head does not change it won't be used if it wasn't before
 
 data IfaceFamInst

-  = IfaceFamInst { ifFamInstFam   :: Name                -- Family tycon
+  = IfaceFamInst { ifFamInstFam   :: IfExtName                -- Family tycon

                 , ifFamInstTys   :: [Maybe IfaceTyCon]  -- Rough match types
                 , ifFamInstTyCon :: IfaceTyCon          -- Instance decl
                 }
                 , ifFamInstTys   :: [Maybe IfaceTyCon]  -- Rough match types
                 , ifFamInstTyCon :: IfaceTyCon          -- Instance decl
                 }

@@ -159,9 +161,10 @@ data IfaceRule
        ifRuleName   :: RuleName,
        ifActivation :: Activation,
        ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
        ifRuleName   :: RuleName,
        ifActivation :: Activation,
        ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars

-       ifRuleHead   :: Name,           -- Head of lhs
+       ifRuleHead   :: IfExtName,      -- Head of lhs

        ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
        ifRuleRhs    :: IfaceExpr,
        ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
        ifRuleRhs    :: IfaceExpr,

+       ifRuleAuto   :: Bool,

        ifRuleOrph   :: Maybe OccName   -- Just like IfaceInst
     }
 
        ifRuleOrph   :: Maybe OccName   -- Just like IfaceInst
     }
 

@@ -181,7 +184,7 @@ type IfaceAnnTarget = AnnTarget OccName
 data IfaceIdDetails
   = IfVanillaId
   | IfRecSelId IfaceTyCon Bool
 data IfaceIdDetails
   = IfVanillaId
   | IfRecSelId IfaceTyCon Bool

-  | IfDFunId
+  | IfDFunId Int          -- Number of silent args

 
 data IfaceIdInfo
   = NoInfo                     -- When writing interface file without -O
 
 data IfaceIdInfo
   = NoInfo                     -- When writing interface file without -O

@@ -201,24 +204,40 @@ data IfaceInfoItem
   = HsArity     Arity
   | HsStrictness StrictSig
   | HsInline     InlinePragma
   = HsArity     Arity
   | HsStrictness StrictSig
   | HsInline     InlinePragma

-  | HsUnfold    IfaceExpr
+  | HsUnfold    Bool             -- True <=> isNonRuleLoopBreaker is true
+                IfaceUnfolding   -- See Note [Expose recursive functions] 

   | HsNoCafRefs
   | HsNoCafRefs

-  | HsWorker    Name Arity     -- Worker, if any see IdInfo.WorkerInfo
-                                       -- for why we want arity here.
-       -- NB: we need IfaceExtName (not just OccName) because the worker
-       --     can simplify to a function in another module.
+

 -- NB: Specialisations and rules come in separately and are
 -- only later attached to the Id.  Partial reason: some are orphans.
 
 -- NB: Specialisations and rules come in separately and are
 -- only later attached to the Id.  Partial reason: some are orphans.
 

+data IfaceUnfolding 
+  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
+                                -- Possibly could eliminate the Bool here, the information
+                                -- is also in the InlinePragma.
+
+  | IfCompulsory IfaceExpr     -- Only used for default methods, in fact
+
+  | IfInlineRule Arity          -- INLINE pragmas
+                 Bool          -- OK to inline even if *un*-saturated
+                Bool           -- OK to inline even if context is boring
+                 IfaceExpr 
+
+  | IfExtWrapper Arity IfExtName  -- NB: sometimes we need a IfExtName (not just IfLclName) 
+  | IfLclWrapper Arity IfLclName  --     because the worker can simplify to a function in 
+                                 --     another module.
+
+  | IfDFunUnfold [DFunArg IfaceExpr]
+

 --------------------------------
 data IfaceExpr
 --------------------------------
 data IfaceExpr

-  = IfaceLcl   FastString
-  | IfaceExt    Name
+  = IfaceLcl   IfLclName
+  | IfaceExt    IfExtName

   | IfaceType   IfaceType
   | IfaceTuple         Boxity [IfaceExpr]              -- Saturated; type arguments omitted
   | IfaceLam   IfaceBndr IfaceExpr
   | IfaceApp   IfaceExpr IfaceExpr
   | IfaceType   IfaceType
   | IfaceTuple         Boxity [IfaceExpr]              -- Saturated; type arguments omitted
   | IfaceLam   IfaceBndr IfaceExpr
   | IfaceApp   IfaceExpr IfaceExpr

-  | IfaceCase  IfaceExpr FastString IfaceType [IfaceAlt]
+  | IfaceCase  IfaceExpr IfLclName IfaceType [IfaceAlt]

   | IfaceLet   IfaceBinding  IfaceExpr
   | IfaceNote  IfaceNote IfaceExpr
   | IfaceCast   IfaceExpr IfaceCoercion
   | IfaceLet   IfaceBinding  IfaceExpr
   | IfaceNote  IfaceNote IfaceExpr
   | IfaceCast   IfaceExpr IfaceCoercion

@@ -227,16 +246,15 @@ data IfaceExpr
   | IfaceTick   Module Int
 
 data IfaceNote = IfaceSCC CostCentre
   | IfaceTick   Module Int
 
 data IfaceNote = IfaceSCC CostCentre

-              | IfaceInlineMe

                | IfaceCoreNote String
 
                | IfaceCoreNote String
 

-type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
-       -- Note: FastString, not IfaceBndr (and same with the case binder)
+type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
+       -- Note: IfLclName, not IfaceBndr (and same with the case binder)

        -- We reconstruct the kind/type of the thing from the context
        -- thus saving bulk in interface files
 
 data IfaceConAlt = IfaceDefault
        -- We reconstruct the kind/type of the thing from the context
        -- thus saving bulk in interface files
 
 data IfaceConAlt = IfaceDefault

-                | IfaceDataAlt Name
+                | IfaceDataAlt IfExtName

                 | IfaceTupleAlt Boxity
                 | IfaceLitAlt Literal
 
                 | IfaceTupleAlt Boxity
                 | IfaceLitAlt Literal
 

@@ -247,9 +265,16 @@ data IfaceBinding
 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
 -- It's used for *non-top-level* let/rec binders
 -- See Note [IdInfo on nested let-bindings]
 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
 -- It's used for *non-top-level* let/rec binders
 -- See Note [IdInfo on nested let-bindings]

-data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
+data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo

 \end{code}
 
 \end{code}
 

+Note [Expose recursive functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For supercompilation we want to put *all* unfoldings in the interface
+file, even for functions that are recursive (or big).  So we need to
+know when an unfolding belongs to a loop-breaker so that we can refrain
+from inlining it (except during supercompilation).
+

 Note [IdInfo on nested let-bindings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Occasionally we want to preserve IdInfo on nested let bindings. The one
 Note [IdInfo on nested let-bindings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Occasionally we want to preserve IdInfo on nested let bindings. The one

@@ -257,10 +282,8 @@ that came up was a NOINLINE pragma on a let-binding inside an INLINE
 function.  The user (Duncan Coutts) really wanted the NOINLINE control
 to cross the separate compilation boundary.
 
 function.  The user (Duncan Coutts) really wanted the NOINLINE control
 to cross the separate compilation boundary.
 

-So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
-Currently we only actually retain InlinePragInfo, but in principle we could
-add strictness etc.
-
+In general we retain all info that is left by CoreTidy.tidyLetBndr, since
+that is what is seen by importing module with --make

 
 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

@@ -504,11 +527,14 @@ pprIfaceConDecl tc
   = sep [main_payload,
         if is_infix then ptext (sLit "Infix") else empty,
         if has_wrap then ptext (sLit "HasWrapper") else empty,
   = sep [main_payload,
         if is_infix then ptext (sLit "Infix") else empty,
         if has_wrap then ptext (sLit "HasWrapper") else empty,

-        if null strs then empty 
-             else nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
-        if null fields then empty
-             else nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
+        ppUnless (null strs) $
+           nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
+        ppUnless (null fields) $
+           nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]

   where
   where

+    ppr_bang HsNoBang = char '_'       -- Want to see these
+    ppr_bang bang     = ppr bang
+        

     main_payload = ppr name <+> dcolon <+> 
                   pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 
     main_payload = ppr name <+> dcolon <+> 
                   pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 

@@ -528,7 +554,7 @@ instance Outputable IfaceRule where
                   ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs }) 
     = sep [hsep [doubleQuotes (ftext name), ppr act,
                 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
                   ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs }) 
     = sep [hsep [doubleQuotes (ftext name), ppr act,
                 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],

-          nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
+          nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),

                        ptext (sLit "=") <+> ppr rhs])
       ]
 
                        ptext (sLit "=") <+> ppr rhs])
       ]
 

@@ -558,6 +584,9 @@ ppr_rough (Just tc) = ppr tc
 instance Outputable IfaceExpr where
     ppr e = pprIfaceExpr noParens e
 
 instance Outputable IfaceExpr where
     ppr e = pprIfaceExpr noParens e
 

+pprParendIfaceExpr :: IfaceExpr -> SDoc
+pprParendIfaceExpr = pprIfaceExpr parens
+

 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
        -- The function adds parens in context that need
        -- an atomic value (e.g. function args)
 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
        -- The function adds parens in context that need
        -- an atomic value (e.g. function args)

@@ -593,7 +622,7 @@ pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
                  nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 
 pprIfaceExpr _       (IfaceCast expr co)
                  nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 
 pprIfaceExpr _       (IfaceCast expr co)

-  = sep [pprIfaceExpr parens expr,
+  = sep [pprParendIfaceExpr expr,

         nest 2 (ptext (sLit "`cast`")),
         pprParendIfaceType co]
 
         nest 2 (ptext (sLit "`cast`")),
         pprParendIfaceType co]
 

@@ -609,13 +638,13 @@ pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
                  ptext (sLit "} in"),
                  pprIfaceExpr noParens body])
 
                  ptext (sLit "} in"),
                  pprIfaceExpr noParens body])
 

-pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
+pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)

 
 

-ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
+ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc

 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs, 
                              arrow <+> pprIfaceExpr noParens rhs]
 
 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs, 
                              arrow <+> pprIfaceExpr noParens rhs]
 

-ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
+ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc

 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 ppr_con_bs con bs                    = ppr con <+> hsep (map ppr bs)
   
 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 ppr_con_bs con bs                    = ppr con <+> hsep (map ppr bs)
   

@@ -626,13 +655,12 @@ ppr_bind (IfLetBndr b ty info, rhs)
 
 ------------------
 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
 
 ------------------
 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc

-pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
-pprIfaceApp fun                       args = sep (pprIfaceExpr parens fun : args)
+pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
+pprIfaceApp fun                       args = sep (pprParendIfaceExpr fun : args)

 
 ------------------
 instance Outputable IfaceNote where
     ppr (IfaceSCC cc)     = pprCostCentreCore cc
 
 ------------------
 instance Outputable IfaceNote where
     ppr (IfaceSCC cc)     = pprCostCentreCore cc

-    ppr IfaceInlineMe     = ptext (sLit "__inline_me")

     ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
 
 
     ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
 
 

@@ -648,21 +676,31 @@ instance Outputable IfaceIdDetails where
   ppr IfVanillaId    = empty
   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
                          <+> if b then ptext (sLit "<naughty>") else empty
   ppr IfVanillaId    = empty
   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
                          <+> if b then ptext (sLit "<naughty>") else empty

-  ppr IfDFunId       = ptext (sLit "DFunId")
+  ppr (IfDFunId ns)     = ptext (sLit "DFunId") <> brackets (int ns)

 
 instance Outputable IfaceIdInfo where
   ppr NoInfo       = empty
 
 instance Outputable IfaceIdInfo where
   ppr NoInfo       = empty

-  ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
+  ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")

 
 instance Outputable IfaceInfoItem where
 
 instance Outputable IfaceInfoItem where

-  ppr (HsUnfold unf)    = ptext (sLit "Unfolding:") <+>
-                                       parens (pprIfaceExpr noParens unf)
+  ppr (HsUnfold lb unf)  = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)")) 
+                           <> colon <+> ppr unf

   ppr (HsInline prag)    = ptext (sLit "Inline:") <+> ppr prag
   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
   ppr HsNoCafRefs       = ptext (sLit "HasNoCafRefs")
   ppr (HsInline prag)    = ptext (sLit "Inline:") <+> ppr prag
   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
   ppr HsNoCafRefs       = ptext (sLit "HasNoCafRefs")

-  ppr (HsWorker w a)    = ptext (sLit "Worker:") <+> ppr w <+> int a

 
 

+instance Outputable IfaceUnfolding where
+  ppr (IfCompulsory e)     = ptext (sLit "<compulsory>") <+> parens (ppr e)
+  ppr (IfCoreUnfold s e)   = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
+  ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
+                                       pprParendIfaceExpr e]
+  ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
+                             <+> parens (ptext (sLit "arity") <+> int a)
+  ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
+                             <+> parens (ptext (sLit "arity") <+> int a)
+  ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:")
+                             <+> brackets (pprWithCommas ppr ns)

 
 -- -----------------------------------------------------------------------------
 -- Finding the Names in IfaceSyn
 
 -- -----------------------------------------------------------------------------
 -- Finding the Names in IfaceSyn

@@ -775,9 +813,16 @@ freeNamesIfIdInfo NoInfo = emptyNameSet
 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 
 freeNamesItem :: IfaceInfoItem -> NameSet
 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 
 freeNamesItem :: IfaceInfoItem -> NameSet

-freeNamesItem (HsUnfold u)     = freeNamesIfExpr u
-freeNamesItem (HsWorker wkr _) = unitNameSet wkr
-freeNamesItem _                = emptyNameSet
+freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
+freeNamesItem _              = emptyNameSet
+
+freeNamesIfUnfold :: IfaceUnfolding -> NameSet
+freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e
+freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
+freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
+freeNamesIfUnfold (IfExtWrapper _ v)     = unitNameSet v
+freeNamesIfUnfold (IfLclWrapper {})      = emptyNameSet
+freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr (dfunArgExprs vs)

 
 freeNamesIfExpr :: IfaceExpr -> NameSet
 freeNamesIfExpr (IfaceExt v)     = unitNameSet v
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
 freeNamesIfExpr (IfaceExt v)     = unitNameSet v

@@ -813,14 +858,14 @@ freeNamesIfExpr (IfaceLet (IfaceRec as) x)
 
 freeNamesIfExpr _ = emptyNameSet
 
 
 freeNamesIfExpr _ = emptyNameSet
 

-

 freeNamesIfTc :: IfaceTyCon -> NameSet
 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 -- ToDo: shouldn't we include IfaceIntTc & co.?
 freeNamesIfTc _ = emptyNameSet
 
 freeNamesIfRule :: IfaceRule -> NameSet
 freeNamesIfTc :: IfaceTyCon -> NameSet
 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 -- ToDo: shouldn't we include IfaceIntTc & co.?
 freeNamesIfTc _ = emptyNameSet
 
 freeNamesIfRule :: IfaceRule -> NameSet

-freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
+freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
+                           , ifRuleArgs = es, ifRuleRhs = rhs })

   = unitNameSet f &&&
     fnList freeNamesIfBndr bs &&&
     fnList freeNamesIfExpr es &&&
   = unitNameSet f &&&
     fnList freeNamesIfBndr bs &&&
     fnList freeNamesIfExpr es &&&