Make dumpIfSet_dyn_or use dumpSDoc

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

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 062cd30..49fded9 100644 (file)
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -5,120 +5,110 @@
 
 \begin{code}
 module IfaceSyn (
 
 \begin{code}
 module IfaceSyn (

-       module IfaceType,               -- Re-export all this
+        module IfaceType,

 
 

-       IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
-       IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
-       IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..),
-       IfaceInfoItem(..), IfaceRule(..), IfaceInst(..), IfaceFamInst(..),
+        IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
+        IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
+        IfaceBinding(..), IfaceConAlt(..),
+        IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
+        IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
+        IfaceInst(..), IfaceFamInst(..),

 
 

-       -- Misc
+        -- Misc

         ifaceDeclSubBndrs, visibleIfConDecls,
 
         ifaceDeclSubBndrs, visibleIfConDecls,
 

-       -- Equality
-       GenIfaceEq(..), IfaceEq, (&&&), bool, eqListBy, eqMaybeBy,
-       eqIfDecl, eqIfInst, eqIfFamInst, eqIfRule, checkBootDecl,
-       
-       -- Pretty printing
-       pprIfaceExpr, pprIfaceDeclHead 
+        -- Free Names
+        freeNamesIfDecl, freeNamesIfRule,
+
+        -- Pretty printing
+        pprIfaceExpr, pprIfaceDeclHead

     ) where
 
 #include "HsVersions.h"
 
     ) where
 
 #include "HsVersions.h"
 

-import CoreSyn

 import IfaceType
 import IfaceType

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

 import Class
 import Class

-import UniqFM
-import UniqSet
-import NameSet 
+import NameSet

 import Name
 import CostCentre
 import Literal
 import ForeignCall
 import Name
 import CostCentre
 import Literal
 import ForeignCall

+import Serialized

 import BasicTypes
 import Outputable
 import FastString
 import Module
 
 import BasicTypes
 import Outputable
 import FastString
 import Module
 

-import Data.List
-import Data.Maybe
-

 infixl 3 &&&
 infixl 3 &&&

-infix  4 `eqIfExt`, `eqIfIdInfo`, `eqIfType`

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

-%*                                                                     *
-               Data type declarations
-%*                                                                     *
+%*                                                                      *
+    Data type declarations
+%*                                                                      *

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

-data IfaceDecl 
-  = IfaceId { ifName   :: OccName,
-             ifType   :: IfaceType, 
-             ifIdInfo :: IfaceIdInfo }
-
-  | IfaceData { ifName       :: OccName,       -- Type constructor
-               ifTyVars     :: [IfaceTvBndr],  -- Type variables
-               ifCtxt       :: IfaceContext,   -- The "stupid theta"
-               ifCons       :: IfaceConDecls,  -- Includes new/data info
-               ifRec        :: RecFlag,        -- Recursive or not?
-               ifGadtSyntax :: Bool,           -- True <=> declared using
-                                               -- GADT syntax 
-               ifGeneric    :: Bool,           -- True <=> generic converter
-                                               --          functions available
-                                               -- We need this for imported
-                                               -- data decls, since the
-                                               -- imported modules may have
-                                               -- been compiled with
-                                               -- different flags to the
-                                               -- current compilation unit 
+data IfaceDecl
+  = IfaceId { ifName      :: OccName,
+              ifType      :: IfaceType,
+              ifIdDetails :: IfaceIdDetails,
+              ifIdInfo    :: IfaceIdInfo }
+
+  | IfaceData { ifName       :: OccName,        -- Type constructor
+                ifTyVars     :: [IfaceTvBndr],  -- Type variables
+                ifCtxt       :: IfaceContext,   -- The "stupid theta"
+                ifCons       :: IfaceConDecls,  -- Includes new/data info
+                ifRec        :: RecFlag,        -- Recursive or not?
+                ifGadtSyntax :: Bool,           -- True <=> declared using
+                                                -- GADT syntax

                 ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
                                                 -- Just <=> instance of family
                 ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
                                                 -- Just <=> instance of family

-                                                -- Invariant: 
+                                                -- Invariant:

                                                 --   ifCons /= IfOpenDataTyCon
                                                 --   for family instances
     }
 
                                                 --   ifCons /= IfOpenDataTyCon
                                                 --   for family instances
     }
 

-  | IfaceSyn  {        ifName    :: OccName,           -- Type constructor
-               ifTyVars  :: [IfaceTvBndr],     -- Type variables
-               ifOpenSyn :: Bool,              -- Is an open family?
-               ifSynRhs  :: IfaceType,         -- Type for an ordinary
-                                               -- synonym and kind for an
-                                               -- open family
-                ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
+  | IfaceSyn  { ifName    :: OccName,           -- Type constructor
+                ifTyVars  :: [IfaceTvBndr],     -- Type variables
+                ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
+                ifSynRhs  :: Maybe IfaceType,   -- Just rhs for an ordinary synonyn
+                                                -- Nothing for an open family
+                ifFamInst :: Maybe (IfaceTyCon, [IfaceType])

                                                 -- Just <=> instance of family
                                                 -- Invariant: ifOpenSyn == False
                                                 --   for family instances
     }
 
                                                 -- Just <=> instance of family
                                                 -- Invariant: ifOpenSyn == False
                                                 --   for family instances
     }
 

-  | IfaceClass { ifCtxt    :: IfaceContext,    -- Context...
-                ifName    :: OccName,          -- Name of the class
-                ifTyVars  :: [IfaceTvBndr],    -- Type variables
-                ifFDs     :: [FunDep FastString], -- Functional dependencies
-                ifATs     :: [IfaceDecl],      -- Associated type families
-                ifSigs    :: [IfaceClassOp],   -- Method signatures
-                ifRec     :: RecFlag           -- Is newtype/datatype associated with the class recursive?
+  | IfaceClass { ifCtxt    :: IfaceContext,     -- Context...
+                 ifName    :: OccName,          -- Name of the class
+                 ifTyVars  :: [IfaceTvBndr],    -- Type variables
+                 ifFDs     :: [FunDep FastString], -- Functional dependencies
+                 ifATs     :: [IfaceDecl],      -- Associated type families
+                 ifSigs    :: [IfaceClassOp],   -- Method signatures
+                 ifRec     :: RecFlag           -- Is newtype/datatype associated
+                                                --   with the class recursive?

     }
 
   | IfaceForeign { ifName :: OccName,           -- Needs expanding when we move
                                                 -- beyond .NET
     }
 
   | IfaceForeign { ifName :: OccName,           -- Needs expanding when we move
                                                 -- beyond .NET

-                  ifExtName :: Maybe FastString }
+                   ifExtName :: Maybe FastString }

 
 

-data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
-       -- Nothing    => no default method
-       -- Just False => ordinary polymorphic default method
-       -- Just True  => generic default method
+data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
+        -- Nothing    => no default method
+        -- Just False => ordinary polymorphic default method
+        -- Just True  => generic default method

 
 data IfaceConDecls
 
 data IfaceConDecls

-  = IfAbstractTyCon            -- No info
-  | IfOpenDataTyCon            -- Open data family
-  | IfDataTyCon [IfaceConDecl] -- data type decls
-  | IfNewTyCon  IfaceConDecl   -- newtype decls
+  = IfAbstractTyCon             -- No info
+  | IfOpenDataTyCon             -- Open data family
+  | IfDataTyCon [IfaceConDecl]  -- data type decls
+  | IfNewTyCon  IfaceConDecl    -- newtype decls

 
 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
 visibleIfConDecls IfAbstractTyCon  = []
 
 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
 visibleIfConDecls IfAbstractTyCon  = []

@@ -126,116 +116,159 @@ visibleIfConDecls IfOpenDataTyCon  = []
 visibleIfConDecls (IfDataTyCon cs) = cs
 visibleIfConDecls (IfNewTyCon c)   = [c]
 
 visibleIfConDecls (IfDataTyCon cs) = cs
 visibleIfConDecls (IfNewTyCon c)   = [c]
 

-data IfaceConDecl 
+data IfaceConDecl

   = IfCon {
   = IfCon {

-       ifConOcc     :: OccName,                -- Constructor name
-       ifConInfix   :: Bool,                   -- True <=> declared infix
-       ifConUnivTvs :: [IfaceTvBndr],          -- Universal tyvars
-       ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
-       ifConEqSpec  :: [(OccName,IfaceType)],  -- Equality contraints
-       ifConCtxt    :: IfaceContext,           -- Non-stupid context
-       ifConArgTys  :: [IfaceType],            -- Arg types
-       ifConFields  :: [OccName],              -- ...ditto... (field labels)
-       ifConStricts :: [StrictnessMark]}       -- Empty (meaning all lazy),
-                                               -- or 1-1 corresp with arg tys
-
-data IfaceInst 
-  = IfaceInst { ifInstCls  :: Name,                    -- See comments with
-               ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance
-               ifDFun     :: Name,                     -- The dfun
-               ifOFlag    :: OverlapFlag,              -- Overlap flag
-               ifInstOrph :: Maybe OccName }           -- See Note [Orphans]
-       -- There's always a separate IfaceDecl for the DFun, which gives 
-       -- its IdInfo with its full type and version number.
-       -- The instance declarations taken together have a version number,
-       -- and we don't want that to wobble gratuitously
-       -- If this instance decl is *used*, we'll record a usage on the dfun;
-       -- and if the head does not change it won't be used if it wasn't before
+        ifConOcc     :: OccName,                -- Constructor name
+        ifConWrapper :: Bool,                   -- True <=> has a wrapper
+        ifConInfix   :: Bool,                   -- True <=> declared infix
+        ifConUnivTvs :: [IfaceTvBndr],          -- Universal tyvars
+        ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
+        ifConEqSpec  :: [(OccName,IfaceType)],  -- Equality contraints
+        ifConCtxt    :: IfaceContext,           -- Non-stupid context
+        ifConArgTys  :: [IfaceType],            -- Arg types
+        ifConFields  :: [OccName],              -- ...ditto... (field labels)
+        ifConStricts :: [HsBang]}               -- Empty (meaning all lazy),
+                                                -- or 1-1 corresp with arg tys
+
+data IfaceInst
+  = IfaceInst { ifInstCls  :: IfExtName,                -- See comments with
+                ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance
+                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
+        -- its IdInfo with its full type and version number.
+        -- The instance declarations taken together have a version number,
+        -- and we don't want that to wobble gratuitously
+        -- If this instance decl is *used*, we'll record a usage on the dfun;
+        -- and if the head does not change it won't be used if it wasn't before

 
 data IfaceFamInst
 
 data IfaceFamInst

-  = IfaceFamInst { ifFamInstFam   :: Name                -- Family tycon
-                , ifFamInstTys   :: [Maybe IfaceTyCon]  -- Rough match types
-                , ifFamInstTyCon :: IfaceTyCon          -- Instance decl
-                }
+  = IfaceFamInst { ifFamInstFam   :: IfExtName                -- Family tycon
+                 , ifFamInstTys   :: [Maybe IfaceTyCon]  -- Rough match types
+                 , ifFamInstTyCon :: IfaceTyCon          -- Instance decl
+                 }

 
 data IfaceRule
 
 data IfaceRule

-  = IfaceRule { 
-       ifRuleName   :: RuleName,
-       ifActivation :: Activation,
-       ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
-       ifRuleHead   :: Name,           -- Head of lhs
-       ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
-       ifRuleRhs    :: IfaceExpr,
-       ifRuleOrph   :: Maybe OccName   -- Just like IfaceInst
+  = IfaceRule {
+        ifRuleName   :: RuleName,
+        ifActivation :: Activation,
+        ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
+        ifRuleHead   :: IfExtName,      -- Head of lhs
+        ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
+        ifRuleRhs    :: IfaceExpr,
+        ifRuleAuto   :: Bool,
+        ifRuleOrph   :: Maybe OccName   -- Just like IfaceInst

     }
 
     }
 

+data IfaceAnnotation
+  = IfaceAnnotation {
+        ifAnnotatedTarget :: IfaceAnnTarget,
+        ifAnnotatedValue :: Serialized
+  }
+
+type IfaceAnnTarget = AnnTarget OccName
+
+-- We only serialise the IdDetails of top-level Ids, and even then
+-- we only need a very limited selection.  Notably, none of the
+-- implicit ones are needed here, becuase they are not put it
+-- interface files
+
+data IfaceIdDetails
+  = IfVanillaId
+  | IfRecSelId IfaceTyCon Bool
+  | IfDFunId Int          -- Number of silent args
+

 data IfaceIdInfo
 data IfaceIdInfo

-  = NoInfo                     -- When writing interface file without -O
-  | HasInfo [IfaceInfoItem]    -- Has info, and here it is
+  = NoInfo                      -- When writing interface file without -O
+  | HasInfo [IfaceInfoItem]     -- Has info, and here it is

 
 -- Here's a tricky case:
 --   * Compile with -O module A, and B which imports A.f
 --   * Change function f in A, and recompile without -O
 --   * When we read in old A.hi we read in its IdInfo (as a thunk)
 
 -- Here's a tricky case:
 --   * Compile with -O module A, and B which imports A.f
 --   * Change function f in A, and recompile without -O
 --   * When we read in old A.hi we read in its IdInfo (as a thunk)

---     (In earlier GHCs we used to drop IdInfo immediately on reading,
---      but we do not do that now.  Instead it's discarded when the
---      ModIface is read into the various decl pools.)
+--      (In earlier GHCs we used to drop IdInfo immediately on reading,
+--       but we do not do that now.  Instead it's discarded when the
+--       ModIface is read into the various decl pools.)

 --   * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
 --   * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)

---     and so gives a new version.
+--      and so gives a new version.

 
 data IfaceInfoItem
 
 data IfaceInfoItem

-  = HsArity     Arity
+  = HsArity      Arity

   | HsStrictness StrictSig
   | HsStrictness StrictSig

-  | HsInline     Activation
-  | HsUnfold    IfaceExpr
+  | HsInline     InlinePragma
+  | 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
   | IfaceType   IfaceType

-  | IfaceTuple         Boxity [IfaceExpr]              -- Saturated; type arguments omitted
+  | IfaceCo     IfaceType              -- We re-use IfaceType for coercions
+  | IfaceTuple         Boxity [IfaceExpr]      -- Saturated; type arguments omitted

   | IfaceLam   IfaceBndr IfaceExpr
   | IfaceApp   IfaceExpr IfaceExpr
   | IfaceLam   IfaceBndr IfaceExpr
   | IfaceApp   IfaceExpr IfaceExpr

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

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

-  | IfaceLit   Literal
-  | IfaceFCall ForeignCall IfaceType
+  | IfaceLit    Literal
+  | IfaceFCall  ForeignCall IfaceType

   | 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)
-       -- We reconstruct the kind/type of the thing from the context
-       -- thus saving bulk in interface files
+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
 
 data IfaceConAlt = IfaceDefault

-                | IfaceDataAlt Name
-                | IfaceTupleAlt Boxity
-                | IfaceLitAlt Literal
+                 | IfaceDataAlt IfExtName
+                 | IfaceTupleAlt Boxity
+                 | IfaceLitAlt Literal

 
 data IfaceBinding
 
 data IfaceBinding

-  = IfaceNonRec        IfaceLetBndr IfaceExpr
-  | IfaceRec   [(IfaceLetBndr, IfaceExpr)]
+  = IfaceNonRec IfaceLetBndr IfaceExpr
+  | IfaceRec    [(IfaceLetBndr, IfaceExpr)]

 
 -- 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

@@ -243,10 +276,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
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

@@ -262,9 +293,9 @@ complicate the situation though. Consider
 and suppose we are compiling module X:
 
   module X where
 and suppose we are compiling module X:
 
   module X where

-       import M
-       data T = ...
-       instance C Int T where ...
+        import M
+        data T = ...
+        instance C Int T where ...

 
 This instance is an orphan, because when compiling a third module Y we
 might get a constraint (C Int v), and we'd want to improve v to T.  So
 
 This instance is an orphan, because when compiling a third module Y we
 might get a constraint (C Int v), and we'd want to improve v to T.  So

@@ -278,7 +309,7 @@ More precisely, an instance is an orphan iff
 
   If there are fundeps, then for every fundep, at least one of the
   names free in a *non-determined* part of the instance head is
 
   If there are fundeps, then for every fundep, at least one of the
   names free in a *non-determined* part of the instance head is

-  defined in this module.  
+  defined in this module.

 
 (Note that these conditions hold trivially if the class is locally
 defined.)
 
 (Note that these conditions hold trivially if the class is locally
 defined.)

@@ -305,10 +336,10 @@ a functionally-dependent part of the instance decl.  E.g.
 and suppose we are compiling module X:
 
   module X where
 and suppose we are compiling module X:
 
   module X where

-       import M
-       data S  = ...
-       data T = ...
-       instance C S T where ...
+        import M
+        data S  = ...
+        data T = ...
+        instance C S T where ...

 
 If we base the instance verion on T, I'm worried that changing S to S'
 would change T's version, but not S or S'.  But an importing module might
 
 If we base the instance verion on T, I'm worried that changing S to S'
 would change T's version, but not S or S'.  But an importing module might

@@ -319,8 +350,8 @@ and it seems deeply obscure, so I'm going to leave it for now.
 
 Note [Versioning of rules]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 Note [Versioning of rules]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~

-A rule that is not an orphan has an ifRuleOrph field of (Just n), where
-n appears on the LHS of the rule; any change in the rule changes the version of n.
+A rule that is not an orphan has an ifRuleOrph field of (Just n), where n
+appears on the LHS of the rule; any change in the rule changes the version of n.

 
 
 \begin{code}
 
 
 \begin{code}

@@ -342,48 +373,39 @@ ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon}  = []
 -- Newtype
 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
                               ifCons = IfNewTyCon (
 -- Newtype
 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
                               ifCons = IfNewTyCon (

-                                        IfCon { ifConOcc = con_occ, 
-                                                ifConFields = fields
-                                                 }),
-                              ifFamInst = famInst}) 
-  = -- fields (names of selectors)
-    fields ++ 
-    -- implicit coerion and (possibly) family instance coercion
+                                        IfCon { ifConOcc = con_occ }),
+                              ifFamInst = famInst})
+  =   -- implicit coerion and (possibly) family instance coercion

     (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
     (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++

-    -- data constructor and worker (newtypes don't have a wrapper)
+      -- data constructor and worker (newtypes don't have a wrapper)

     [con_occ, mkDataConWorkerOcc con_occ]
 
 
 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
     [con_occ, mkDataConWorkerOcc con_occ]
 
 
 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,

-                             ifCons = IfDataTyCon cons, 
-                             ifFamInst = famInst})
-  = -- fields (names of selectors) 
-    nub (concatMap ifConFields cons)   -- Eliminate duplicate fields
-    -- (possibly) family instance coercion;
-    -- there is no implicit coercion for non-newtypes
-    ++ famInstCo famInst tc_occ
-    -- for each data constructor in order,
-    --    data constructor, worker, and (possibly) wrapper
+                              ifCons = IfDataTyCon cons,
+                              ifFamInst = famInst})
+  =   -- (possibly) family instance coercion;
+      -- there is no implicit coercion for non-newtypes
+    famInstCo famInst tc_occ
+      -- for each data constructor in order,
+      --    data constructor, worker, and (possibly) wrapper

     ++ concatMap dc_occs cons
   where
     dc_occs con_decl
     ++ concatMap dc_occs cons
   where
     dc_occs con_decl

-       | has_wrapper = [con_occ, work_occ, wrap_occ]
-       | otherwise   = [con_occ, work_occ]
-       where
-         con_occ  = ifConOcc con_decl                  -- DataCon namespace
-         wrap_occ = mkDataConWrapperOcc con_occ        -- Id namespace
-         work_occ = mkDataConWorkerOcc con_occ         -- Id namespace
-         strs     = ifConStricts con_decl
-         has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
-                       || not (null . ifConEqSpec $ con_decl)
-                       || isJust famInst
-               -- ToDo: may miss strictness in existential dicts
-
-ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, 
-                              ifSigs = sigs, ifATs = ats })
+        | has_wrapper = [con_occ, work_occ, wrap_occ]
+        | otherwise   = [con_occ, work_occ]
+        where
+          con_occ  = ifConOcc con_decl            -- DataCon namespace
+          wrap_occ = mkDataConWrapperOcc con_occ  -- Id namespace
+          work_occ = mkDataConWorkerOcc con_occ   -- Id namespace
+          has_wrapper = ifConWrapper con_decl     -- This is the reason for
+                                                  -- having the ifConWrapper field!
+
+ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
+                               ifSigs = sigs, ifATs = ats })

   = -- dictionary datatype:
     --   type constructor
   = -- dictionary datatype:
     --   type constructor

-    tc_occ : 
+    tc_occ :

     --   (possibly) newtype coercion
     co_occs ++
     --    data constructor (DataCon namespace)
     --   (possibly) newtype coercion
     co_occs ++
     --    data constructor (DataCon namespace)

@@ -400,14 +422,14 @@ ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
     n_ctxt = length sc_ctxt
     n_sigs = length sigs
     tc_occ  = mkClassTyConOcc cls_occ
     n_ctxt = length sc_ctxt
     n_sigs = length sigs
     tc_occ  = mkClassTyConOcc cls_occ

-    dc_occ  = mkClassDataConOcc cls_occ        
+    dc_occ  = mkClassDataConOcc cls_occ

     co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
     co_occs | is_newtype = [mkNewTyCoOcc tc_occ]

-           | otherwise  = []
+            | otherwise  = []

     dcww_occ = mkDataConWorkerOcc dc_occ
     dcww_occ = mkDataConWorkerOcc dc_occ

-    is_newtype = n_sigs + n_ctxt == 1                  -- Sigh 
+    is_newtype = n_sigs + n_ctxt == 1 -- Sigh

 
 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,
 
 ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ,

-                            ifFamInst = famInst})
+                             ifFamInst = famInst})

   = famInstCo famInst tc_occ
 
 ifaceDeclSubBndrs _ = []
   = famInstCo famInst tc_occ
 
 ifaceDeclSubBndrs _ = []

@@ -423,52 +445,50 @@ instance Outputable IfaceDecl where
   ppr = pprIfaceDecl
 
 pprIfaceDecl :: IfaceDecl -> SDoc
   ppr = pprIfaceDecl
 
 pprIfaceDecl :: IfaceDecl -> SDoc

-pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
-  = sep [ ppr var <+> dcolon <+> ppr ty, 
-         nest 2 (ppr info) ]
+pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
+                       ifIdDetails = details, ifIdInfo = info})
+  = sep [ ppr var <+> dcolon <+> ppr ty,
+          nest 2 (ppr details),
+          nest 2 (ppr info) ]

 
 pprIfaceDecl (IfaceForeign {ifName = tycon})
   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 
 
 pprIfaceDecl (IfaceForeign {ifName = tycon})
   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 

-pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
-                       ifOpenSyn = False, ifSynRhs = mono_ty, 
+pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
+                        ifSynRhs = Just mono_ty,

                         ifFamInst = mbFamInst})
   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
        4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
 
                         ifFamInst = mbFamInst})
   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
        4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
 

-pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
-                       ifOpenSyn = True, ifSynRhs = mono_ty})
+pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
+                        ifSynRhs = Nothing, ifSynKind = kind })

   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)

-       4 (dcolon <+> ppr mono_ty)
+       4 (dcolon <+> ppr kind)

 
 

-pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
-                        ifTyVars = tyvars, ifCons = condecls, 
-                        ifRec = isrec, ifFamInst = mbFamInst})
+pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context,
+                         ifTyVars = tyvars, ifCons = condecls,
+                         ifRec = isrec, ifFamInst = mbFamInst})

   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)

-       4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
-               pprFamily mbFamInst])
+       4 (vcat [pprRec isrec, pp_condecls tycon condecls,
+                pprFamily mbFamInst])

   where
     pp_nd = case condecls of
   where
     pp_nd = case condecls of

-               IfAbstractTyCon -> ptext (sLit "data")
-               IfOpenDataTyCon -> ptext (sLit "data family")
-               IfDataTyCon _   -> ptext (sLit "data")
-               IfNewTyCon _    -> ptext (sLit "newtype")
-
-pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars, 
-                         ifFDs = fds, ifATs = ats, ifSigs = sigs, 
-                         ifRec = isrec})
+                IfAbstractTyCon -> ptext (sLit "data")
+                IfOpenDataTyCon -> ptext (sLit "data family")
+                IfDataTyCon _   -> ptext (sLit "data")
+                IfNewTyCon _    -> ptext (sLit "newtype")
+
+pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
+                          ifFDs = fds, ifATs = ats, ifSigs = sigs,
+                          ifRec = isrec})

   = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
        4 (vcat [pprRec isrec,
   = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
        4 (vcat [pprRec isrec,

-               sep (map ppr ats),
-               sep (map ppr sigs)])
+                sep (map ppr ats),
+                sep (map ppr sigs)])

 
 pprRec :: RecFlag -> SDoc
 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
 
 
 pprRec :: RecFlag -> SDoc
 pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
 

-pprGen :: Bool -> SDoc
-pprGen True  = ptext (sLit "Generics: yes")
-pprGen False = ptext (sLit "Generics: no")
-

 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
 pprFamily Nothing        = ptext (sLit "FamilyInstance: none")
 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
 pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
 pprFamily Nothing        = ptext (sLit "FamilyInstance: none")
 pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst

@@ -478,64 +498,68 @@ instance Outputable IfaceClassOp where
 
 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
 pprIfaceDeclHead context thing tyvars
 
 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
 pprIfaceDeclHead context thing tyvars

-  = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing), 
-         pprIfaceTvBndrs tyvars]
+  = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
+          pprIfaceTvBndrs tyvars]

 
 pp_condecls :: OccName -> IfaceConDecls -> SDoc
 pp_condecls _  IfAbstractTyCon  = ptext (sLit "{- abstract -}")
 pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
 pp_condecls _  IfOpenDataTyCon  = empty
 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
 
 pp_condecls :: OccName -> IfaceConDecls -> SDoc
 pp_condecls _  IfAbstractTyCon  = ptext (sLit "{- abstract -}")
 pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
 pp_condecls _  IfOpenDataTyCon  = empty
 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))

-                                                            (map (pprIfaceConDecl tc) cs))
+                                                            (map (pprIfaceConDecl tc) cs))

 
 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
 pprIfaceConDecl tc
 
 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
 pprIfaceConDecl tc

-       (IfCon { ifConOcc = name, ifConInfix = is_infix, 
-                ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs, 
-                ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys, 
-                ifConStricts = strs, ifConFields = fields })
+        (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
+                 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
+                 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
+                 ifConStricts = strs, ifConFields = fields })

   = sep [main_payload,
   = sep [main_payload,

-        if is_infix then ptext (sLit "Infix") 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))]
+         if is_infix then ptext (sLit "Infix") else empty,
+         if has_wrap then ptext (sLit "HasWrapper") else empty,
+         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

-    main_payload = ppr name <+> dcolon <+> 
-                  pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
+    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

 
 

-    eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty) 
-             | (tv,ty) <- eq_spec] 
+    eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
+              | (tv,ty) <- eq_spec]

 
 

-       -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
-       -- because we don't have a Name for the tycon, only an OccName
+        -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
+        -- because we don't have a Name for the tycon, only an OccName

     pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
     pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of

-               (t:ts) -> fsep (t : map (arrow <+>) ts)
-               []     -> panic "pp_con_taus"
+                (t:ts) -> fsep (t : map (arrow <+>) ts)
+                []     -> panic "pp_con_taus"

 
     pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
 
 instance Outputable IfaceRule where
   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
 
     pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
 
 instance Outputable IfaceRule where
   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,

-                  ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs }) 
+                   ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })

     = sep [hsep [doubleQuotes (ftext name), ppr act,
     = sep [hsep [doubleQuotes (ftext name), ppr act,

-                ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
-          nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
-                       ptext (sLit "=") <+> ppr rhs])
+                 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
+           nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
+                        ptext (sLit "=") <+> ppr rhs])

       ]
 
 instance Outputable IfaceInst where
       ]
 
 instance Outputable IfaceInst where

-  ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag, 
-                 ifInstCls = cls, ifInstTys = mb_tcs})
-    = hang (ptext (sLit "instance") <+> ppr flag 
-               <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
+  ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
+                  ifInstCls = cls, ifInstTys = mb_tcs})
+    = hang (ptext (sLit "instance") <+> ppr flag
+                <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))

          2 (equals <+> ppr dfun_id)
 
 instance Outputable IfaceFamInst where
   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
          2 (equals <+> ppr dfun_id)
 
 instance Outputable IfaceFamInst where
   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,

-                    ifFamInstTyCon = tycon_id})
-    = hang (ptext (sLit "family instance") <+> 
-           ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
+                     ifFamInstTyCon = tycon_id})
+    = hang (ptext (sLit "family instance") <+>
+            ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))

          2 (equals <+> ppr tycon_id)
 
 ppr_rough :: Maybe IfaceTyCon -> SDoc
          2 (equals <+> ppr tycon_id)
 
 ppr_rough :: Maybe IfaceTyCon -> SDoc

@@ -550,9 +574,14 @@ 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
+
+-- | Pretty Print an IfaceExpre
+--
+-- The first argument should be a function that adds parens in context that need
+-- an atomic value (e.g. function args)

 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc

-       -- The function adds parens in context that need
-       -- an atomic value (e.g. function args)

 
 pprIfaceExpr _       (IfaceLcl v)       = ppr v
 pprIfaceExpr _       (IfaceExt v)       = ppr v
 
 pprIfaceExpr _       (IfaceLcl v)       = ppr v
 pprIfaceExpr _       (IfaceExt v)       = ppr v

@@ -560,473 +589,326 @@ pprIfaceExpr _       (IfaceLit l)       = ppr l
 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
 pprIfaceExpr _       (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
 pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
 pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
 pprIfaceExpr _       (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
 pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty

+pprIfaceExpr _       (IfaceCo co)       = text "@~" <+> pprParendIfaceType co

 
 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
 pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
 
 
 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
 pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (interpp'SP as)
 

-pprIfaceExpr add_par e@(IfaceLam _ _)   
+pprIfaceExpr add_par i@(IfaceLam _ _)

   = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
   = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,

-                 pprIfaceExpr noParens body])
-  where 
-    (bndrs,body) = collect [] e
+                  pprIfaceExpr noParens body])
+  where
+    (bndrs,body) = collect [] i

     collect bs (IfaceLam b e) = collect (b:bs) e
     collect bs e              = (reverse bs, e)
 
     collect bs (IfaceLam b e) = collect (b:bs) e
     collect bs e              = (reverse bs, e)
 

-pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
-  = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
+pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])
+  = add_par (sep [ptext (sLit "case") 

                        <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") 
                        <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
                  pprIfaceExpr noParens rhs <+> char '}'])
 
                        <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") 
                        <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
                  pprIfaceExpr noParens rhs <+> char '}'])
 

-pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
-  = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
+pprIfaceExpr add_par (IfaceCase scrut bndr alts)
+  = add_par (sep [ptext (sLit "case") 

                        <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") 
                        <+> ppr bndr <+> char '{',
                  nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 
 pprIfaceExpr _       (IfaceCast expr co)
                        <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") 
                        <+> ppr bndr <+> char '{',
                  nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 
 pprIfaceExpr _       (IfaceCast expr co)

-  = sep [pprIfaceExpr parens expr,
-        nest 2 (ptext (sLit "`cast`")),
-        pprParendIfaceType co]
+  = sep [pprParendIfaceExpr expr,
+         nest 2 (ptext (sLit "`cast`")),
+         pprParendIfaceType co]

 
 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
 
 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)

-  = add_par (sep [ptext (sLit "let {"), 
-                 nest 2 (ppr_bind (b, rhs)),
-                 ptext (sLit "} in"), 
-                 pprIfaceExpr noParens body])
+  = add_par (sep [ptext (sLit "let {"),
+                  nest 2 (ppr_bind (b, rhs)),
+                  ptext (sLit "} in"),
+                  pprIfaceExpr noParens body])

 
 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
   = add_par (sep [ptext (sLit "letrec {"),
 
 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
   = add_par (sep [ptext (sLit "letrec {"),

-                 nest 2 (sep (map ppr_bind pairs)), 
-                 ptext (sLit "} in"),
-                 pprIfaceExpr noParens body])
+                  nest 2 (sep (map ppr_bind pairs)),
+                  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 (con, bs, rhs) = sep [ppr_con_bs con bs, 
-                             arrow <+> pprIfaceExpr noParens rhs]
+ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
+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 (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)

-ppr_con_bs con bs                    = ppr con <+> hsep (map ppr bs)
-  
+ppr_con_bs con bs                     = ppr con <+> hsep (map ppr bs)
+

 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc

-ppr_bind (IfLetBndr b ty info, rhs) 
+ppr_bind (IfLetBndr b ty info, rhs)

   = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
   = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),

-        equals <+> pprIfaceExpr noParens rhs]
+         equals <+> pprIfaceExpr noParens 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)

 
 
 instance Outputable IfaceConAlt where
     ppr IfaceDefault      = text "DEFAULT"
     ppr (IfaceLitAlt l)   = ppr l
     ppr (IfaceDataAlt d)  = ppr d
 
 
 instance Outputable IfaceConAlt where
     ppr IfaceDefault      = text "DEFAULT"
     ppr (IfaceLitAlt l)   = ppr l
     ppr (IfaceDataAlt d)  = ppr d

-    ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt" 
+    ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt"

     -- IfaceTupleAlt is handled by the case-alternative printer
 
 ------------------
     -- IfaceTupleAlt is handled by the case-alternative printer
 
 ------------------

+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 (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 (HsInline act)     = ptext (sLit "Inline:") <+> ppr act
+  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 (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
-\end{code}
-
-
-%************************************************************************
-%*                                                                     *
-       Equality, for interface file version generaion only
-%*                                                                     *
-%************************************************************************
+  ppr HsNoCafRefs        = ptext (sLit "HasNoCafRefs")
+
+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)

 
 

-Equality over IfaceSyn returns an IfaceEq, not a Bool.  The new
-constructor is EqBut, which gives the set of things whose version must
-be equal for the whole thing to be equal.  So the key function is
-eqIfExt, which compares Names.
-
-Of course, equality is also done modulo alpha conversion.
+-- -----------------------------------------------------------------------------
+-- | Finding the Names in IfaceSyn
+
+-- This is used for dependency analysis in MkIface, so that we
+-- fingerprint a declaration before the things that depend on it.  It
+-- is specific to interface-file fingerprinting in the sense that we
+-- don't collect *all* Names: for example, the DFun of an instance is
+-- recorded textually rather than by its fingerprint when
+-- fingerprinting the instance, so DFuns are not dependencies.
+
+freeNamesIfDecl :: IfaceDecl -> NameSet
+freeNamesIfDecl (IfaceId _s t d i) =
+  freeNamesIfType t &&&
+  freeNamesIfIdInfo i &&&
+  freeNamesIfIdDetails d
+freeNamesIfDecl IfaceForeign{} =
+  emptyNameSet
+freeNamesIfDecl d@IfaceData{} =
+  freeNamesIfTvBndrs (ifTyVars d) &&&
+  freeNamesIfTcFam (ifFamInst d) &&&
+  freeNamesIfContext (ifCtxt d) &&&
+  freeNamesIfConDecls (ifCons d)
+freeNamesIfDecl d@IfaceSyn{} =
+  freeNamesIfTvBndrs (ifTyVars d) &&&
+  freeNamesIfSynRhs (ifSynRhs d) &&&
+  freeNamesIfTcFam (ifFamInst d)
+freeNamesIfDecl d@IfaceClass{} =
+  freeNamesIfTvBndrs (ifTyVars d) &&&
+  freeNamesIfContext (ifCtxt d) &&&
+  freeNamesIfDecls   (ifATs d) &&&
+  fnList freeNamesIfClsSig (ifSigs d)
+
+freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
+freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
+freeNamesIfIdDetails _                 = emptyNameSet

 
 

-\begin{code}
-data GenIfaceEq a
-  = Equal              -- Definitely exactly the same
-  | NotEqual           -- Definitely different
-  | EqBut (UniqSet a)   -- The same provided these things have not changed
-
-type IfaceEq = GenIfaceEq Name
-
-instance Outputable a => Outputable (GenIfaceEq a) where
-  ppr Equal          = ptext (sLit "Equal")
-  ppr NotEqual       = ptext (sLit "NotEqual")
-  ppr (EqBut occset) = ptext (sLit "EqBut") <+> ppr (uniqSetToList occset)
-
-bool :: Bool -> IfaceEq
-bool True  = Equal
-bool False = NotEqual
-
-toBool :: IfaceEq -> Bool
-toBool Equal     = True
-toBool (EqBut _) = True
-toBool NotEqual  = False
-
-zapEq :: IfaceEq -> IfaceEq    -- Used to forget EqBut information
-zapEq (EqBut _) = Equal
-zapEq other    = other
-
-(&&&) :: IfaceEq -> IfaceEq -> IfaceEq
-Equal       &&& x           = x
-NotEqual    &&& _           = NotEqual
-EqBut nms   &&& Equal       = EqBut nms
-EqBut _     &&& NotEqual    = NotEqual
-EqBut nms1  &&& EqBut nms2  = EqBut (nms1 `unionNameSets` nms2)
-
--- This function is the core of the EqBut stuff
--- ASSUMPTION: The left-hand argument is the NEW CODE, and hence
--- any Names in the left-hand arg have the correct parent in them.
-eqIfExt :: Name -> Name -> IfaceEq
-eqIfExt name1 name2 
-  | name1 == name2 = EqBut (unitNameSet name1)
-  | otherwise      = NotEqual
-
----------------------
-checkBootDecl :: IfaceDecl     -- The boot decl
-             -> IfaceDecl      -- The real decl
-             -> Bool           -- True <=> compatible
-checkBootDecl (IfaceId s1 t1 _) (IfaceId s2 t2 _)
-  = ASSERT( s1==s2 ) toBool (t1 `eqIfType` t2)
-
-checkBootDecl d1@(IfaceForeign {}) d2@(IfaceForeign {})
-  = ASSERT (ifName d1 == ifName d2 ) ifExtName d1 == ifExtName d2
-
-checkBootDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
-  = ASSERT( ifName d1 == ifName d2 )
-    toBool $ eqWith (ifTyVars d1) (ifTyVars d2) $ \ env -> 
-          eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
-
-checkBootDecl d1@(IfaceData {}) d2@(IfaceData {})
--- We don't check the recursion flags because the boot-one is
--- recursive, to be conservative, but the real one may not be.
--- I'm not happy with the way recursive flags are dealt with.
-  = ASSERT( ifName d1    == ifName d2 ) 
-    toBool $ eqWith (ifTyVars d1) (ifTyVars d2) $ \ env -> 
-       eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&& 
-       case ifCons d1 of
-           IfAbstractTyCon -> Equal
-           cons1           -> eq_hsCD env cons1 (ifCons d2)
-
-checkBootDecl d1@(IfaceClass {}) d2@(IfaceClass {})
-  = ASSERT( ifName d1 == ifName d2 )
-    toBool $ eqWith (ifTyVars d1) (ifTyVars d2) $ \ env -> 
-         eqListBy (eq_hsFD env)    (ifFDs d1)  (ifFDs d2) &&&
-         case (ifCtxt d1, ifSigs d1) of
-            ([], [])      -> Equal
-            (cxt1, sigs1) -> eq_ifContext env cxt1 (ifCtxt d2)  &&&
-                             eqListBy (eq_cls_sig env) sigs1 (ifSigs d2)
-
-checkBootDecl _ _ = False      -- default case
-
----------------------
-eqIfDecl :: IfaceDecl -> IfaceDecl -> IfaceEq
-eqIfDecl (IfaceId s1 t1 i1) (IfaceId s2 t2 i2)
-  = bool (s1 == s2) &&& (t1 `eqIfType` t2) &&& (i1 `eqIfIdInfo` i2)
-
-eqIfDecl d1@(IfaceForeign {}) d2@(IfaceForeign {})
-  = bool (ifName d1 == ifName d2 && ifExtName d1 == ifExtName d2)
-
-eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
-  = bool (ifName d1    == ifName d2 && 
-         ifRec d1     == ifRec   d2 && 
-         ifGadtSyntax d1 == ifGadtSyntax   d2 && 
-         ifGeneric d1 == ifGeneric d2) &&&
-    ifFamInst d1 `eqIfTc_fam` ifFamInst d2 &&&
-    eqWith (ifTyVars d1) (ifTyVars d2) (\ env -> 
-           eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&& 
-           eq_hsCD env (ifCons d1) (ifCons d2) 
-       )
-       -- The type variables of the data type do not scope
-       -- over the constructors (any more), but they do scope
-       -- over the stupid context in the IfaceConDecls
-
-eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
-  = bool (ifName d1 == ifName d2) &&&
-    ifFamInst d1 `eqIfTc_fam` ifFamInst d2 &&&
-    eqWith (ifTyVars d1) (ifTyVars d2) (\ env -> 
-          eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
-        )
-
-eqIfDecl d1@(IfaceClass {}) d2@(IfaceClass {})
-  = bool (ifName d1 == ifName d2 && 
-         ifRec d1  == ifRec  d2) &&&
-    eqWith (ifTyVars d1) (ifTyVars d2) (\ env -> 
-         eq_ifContext env (ifCtxt d1) (ifCtxt d2)  &&&
-         eqListBy (eq_hsFD env)    (ifFDs d1)  (ifFDs d2) &&&
-         eqListBy eqIfDecl         (ifATs d1)  (ifATs d2) &&&
-         eqListBy (eq_cls_sig env) (ifSigs d1) (ifSigs d2)
-       )
-
-eqIfDecl _ _ = NotEqual        -- default case
-
--- Helper
-eqWith :: [IfaceTvBndr] -> [IfaceTvBndr] -> (EqEnv -> IfaceEq) -> IfaceEq
-eqWith = eq_ifTvBndrs emptyEqEnv
-
-eqIfTc_fam :: Maybe (IfaceTyCon, [IfaceType]) 
-           -> Maybe (IfaceTyCon, [IfaceType])
-           -> IfaceEq
-Nothing             `eqIfTc_fam` Nothing             = Equal
-(Just (fam1, tys1)) `eqIfTc_fam` (Just (fam2, tys2)) = 
-  fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2
-_                      `eqIfTc_fam` _               = NotEqual
-
-
------------------------
-eqIfInst :: IfaceInst -> IfaceInst -> IfaceEq
-eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2 && ifOFlag d1 == ifOFlag d2)
--- All other changes are handled via the version info on the dfun
-
-eqIfFamInst :: IfaceFamInst -> IfaceFamInst -> IfaceEq
-eqIfFamInst d1 d2 = bool (ifFamInstTyCon d1 == ifFamInstTyCon d2)

 -- All other changes are handled via the version info on the tycon
 -- All other changes are handled via the version info on the tycon

+freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
+freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
+freeNamesIfSynRhs Nothing   = emptyNameSet
+
+freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
+freeNamesIfTcFam (Just (tc,tys)) =
+  freeNamesIfTc tc &&& fnList freeNamesIfType tys
+freeNamesIfTcFam Nothing =
+  emptyNameSet
+
+freeNamesIfContext :: IfaceContext -> NameSet
+freeNamesIfContext = fnList freeNamesIfPredType
+
+freeNamesIfDecls :: [IfaceDecl] -> NameSet
+freeNamesIfDecls = fnList freeNamesIfDecl
+
+freeNamesIfClsSig :: IfaceClassOp -> NameSet
+freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
+
+freeNamesIfConDecls :: IfaceConDecls -> NameSet
+freeNamesIfConDecls (IfDataTyCon c) = fnList freeNamesIfConDecl c
+freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
+freeNamesIfConDecls _               = emptyNameSet
+
+freeNamesIfConDecl :: IfaceConDecl -> NameSet
+freeNamesIfConDecl c =
+  freeNamesIfTvBndrs (ifConUnivTvs c) &&&
+  freeNamesIfTvBndrs (ifConExTvs c) &&&
+  freeNamesIfContext (ifConCtxt c) &&&
+  fnList freeNamesIfType (ifConArgTys c) &&&
+  fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
+
+freeNamesIfPredType :: IfacePredType -> NameSet
+freeNamesIfPredType (IfaceClassP cl tys) =
+   unitNameSet cl &&& fnList freeNamesIfType tys
+freeNamesIfPredType (IfaceIParam _n ty) =
+   freeNamesIfType ty
+freeNamesIfPredType (IfaceEqPred ty1 ty2) =
+   freeNamesIfType ty1 &&& freeNamesIfType ty2
+
+freeNamesIfType :: IfaceType -> NameSet
+freeNamesIfType (IfaceTyVar _)        = emptyNameSet
+freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
+freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
+freeNamesIfType (IfaceTyConApp tc ts) =
+   freeNamesIfTc tc &&& fnList freeNamesIfType ts
+freeNamesIfType (IfaceForAllTy tv t)  =
+   freeNamesIfTvBndr tv &&& freeNamesIfType t
+freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
+freeNamesIfType (IfaceCoConApp tc ts) = 
+   freeNamesIfCo tc &&& fnList freeNamesIfType ts
+
+freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
+freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
+
+freeNamesIfBndr :: IfaceBndr -> NameSet
+freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
+freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
+
+freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
+-- Remember IfaceLetBndr is used only for *nested* bindings
+-- The IdInfo can contain an unfolding (in the case of
+-- local INLINE pragmas), so look there too
+freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
+                                             &&& freeNamesIfIdInfo info
+
+freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
+freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
+    -- kinds can have Names inside, when the Kind is an equality predicate
+
+freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
+freeNamesIfIdBndr = freeNamesIfTvBndr
+
+freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
+freeNamesIfIdInfo NoInfo      = emptyNameSet
+freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
+
+freeNamesItem :: IfaceInfoItem -> NameSet
+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 (IfaceFCall _ ty) = freeNamesIfType ty
+freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
+freeNamesIfExpr (IfaceCo co)      = freeNamesIfType co
+freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
+freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
+freeNamesIfExpr (IfaceApp f a)    = freeNamesIfExpr f &&& freeNamesIfExpr a
+freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfType co
+freeNamesIfExpr (IfaceNote _n r)  = freeNamesIfExpr r
+
+freeNamesIfExpr (IfaceCase s _ alts)
+  = freeNamesIfExpr s 
+    &&& fnList fn_alt alts &&& fn_cons alts
+  where
+    fn_alt (_con,_bs,r) = freeNamesIfExpr r

 
 

-eqIfRule :: IfaceRule -> IfaceRule -> IfaceEq
-eqIfRule (IfaceRule n1 a1 bs1 f1 es1 rhs1 o1)
-        (IfaceRule n2 a2 bs2 f2 es2 rhs2 o2)
-       = bool (n1==n2 && a1==a2 && o1 == o2) &&&
-        f1 `eqIfExt` f2 &&&
-         eq_ifBndrs emptyEqEnv bs1 bs2 (\env -> 
-        zapEq (eqListBy (eq_ifaceExpr env) es1 es2) &&&
-               -- zapEq: for the LHSs, ignore the EqBut part
-         eq_ifaceExpr env rhs1 rhs2)
-
-eq_hsCD :: EqEnv -> IfaceConDecls -> IfaceConDecls -> IfaceEq
-eq_hsCD env (IfDataTyCon c1) (IfDataTyCon c2) 
-  = eqListBy (eq_ConDecl env) c1 c2
-
-eq_hsCD env (IfNewTyCon c1)  (IfNewTyCon c2)  = eq_ConDecl env c1 c2
-eq_hsCD _   IfAbstractTyCon  IfAbstractTyCon  = Equal
-eq_hsCD _   IfOpenDataTyCon  IfOpenDataTyCon  = Equal
-eq_hsCD _   _                _                = NotEqual
-
-eq_ConDecl :: EqEnv -> IfaceConDecl -> IfaceConDecl -> IfaceEq
-eq_ConDecl env c1 c2
-  = bool (ifConOcc c1     == ifConOcc c2 && 
-         ifConInfix c1   == ifConInfix c2 && 
-         ifConStricts c1 == ifConStricts c2 && 
-         ifConFields c1  == ifConFields c2) &&&
-    eq_ifTvBndrs env (ifConUnivTvs c1) (ifConUnivTvs c2) (\ env ->
-    eq_ifTvBndrs env (ifConExTvs c1) (ifConExTvs c2) (\ env ->
-       eq_ifContext env (ifConCtxt c1) (ifConCtxt c2) &&&
-       eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2)))
-
-eq_hsFD :: EqEnv
-        -> ([FastString], [FastString])
-        -> ([FastString], [FastString])
-        -> IfaceEq
-eq_hsFD env (ns1,ms1) (ns2,ms2)
-  = eqListBy (eqIfOcc env) ns1 ns2 &&& eqListBy (eqIfOcc env) ms1 ms2
-
-eq_cls_sig :: EqEnv -> IfaceClassOp -> IfaceClassOp -> IfaceEq
-eq_cls_sig env (IfaceClassOp n1 dm1 ty1) (IfaceClassOp n2 dm2 ty2)
-  = bool (n1==n2 && dm1 == dm2) &&& eq_ifType env ty1 ty2
-\end{code}
+    -- Depend on the data constructors.  Just one will do!
+    -- Note [Tracking data constructors]
+    fn_cons []                            = emptyNameSet
+    fn_cons ((IfaceDefault    ,_,_) : xs) = fn_cons xs
+    fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
+    fn_cons (_                      : _ ) = emptyNameSet

 
 

+freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
+  = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body

 
 

-\begin{code}
------------------
-eqIfIdInfo :: IfaceIdInfo -> IfaceIdInfo -> GenIfaceEq Name
-eqIfIdInfo NoInfo        NoInfo        = Equal
-eqIfIdInfo (HasInfo is1) (HasInfo is2) = eqListBy eq_item is1 is2
-eqIfIdInfo _             _             = NotEqual
-
-eq_item :: IfaceInfoItem -> IfaceInfoItem -> IfaceEq
-eq_item (HsInline a1)     (HsInline a2)      = bool (a1 == a2)
-eq_item (HsArity a1)      (HsArity a2)       = bool (a1 == a2)
-eq_item (HsStrictness s1)  (HsStrictness s2)  = bool (s1 == s2)
-eq_item (HsUnfold u1)   (HsUnfold u2)         = eq_ifaceExpr emptyEqEnv u1 u2
-eq_item HsNoCafRefs        HsNoCafRefs       = Equal
-eq_item (HsWorker wkr1 a1) (HsWorker wkr2 a2) = bool (a1==a2) &&& (wkr1 `eqIfExt` wkr2)
-eq_item _ _ = NotEqual
-
------------------
-eq_ifaceExpr :: EqEnv -> IfaceExpr -> IfaceExpr -> IfaceEq
-eq_ifaceExpr env (IfaceLcl v1)       (IfaceLcl v2)        = eqIfOcc env v1 v2
-eq_ifaceExpr _   (IfaceExt v1)       (IfaceExt v2)        = eqIfExt v1 v2
-eq_ifaceExpr _   (IfaceLit l1)        (IfaceLit l2)       = bool (l1 == l2)
-eq_ifaceExpr env (IfaceFCall c1 ty1)  (IfaceFCall c2 ty2)  = bool (c1==c2) &&& eq_ifType env ty1 ty2
-eq_ifaceExpr _   (IfaceTick m1 ix1)   (IfaceTick m2 ix2)   = bool (m1==m2) &&& bool (ix1 == ix2)
-eq_ifaceExpr env (IfaceType ty1)      (IfaceType ty2)     = eq_ifType env ty1 ty2
-eq_ifaceExpr env (IfaceTuple n1 as1)  (IfaceTuple n2 as2)  = bool (n1==n2) &&& eqListBy (eq_ifaceExpr env) as1 as2
-eq_ifaceExpr env (IfaceLam b1 body1)  (IfaceLam b2 body2)  = eq_ifBndr env b1 b2 (\env -> eq_ifaceExpr env body1 body2)
-eq_ifaceExpr env (IfaceApp f1 a1)     (IfaceApp f2 a2)    = eq_ifaceExpr env f1 f2 &&& eq_ifaceExpr env a1 a2
-eq_ifaceExpr env (IfaceCast e1 co1)   (IfaceCast e2 co2)   = eq_ifaceExpr env e1 e2 &&& eq_ifType env co1 co2
-eq_ifaceExpr env (IfaceNote n1 r1)    (IfaceNote n2 r2)    = eq_ifaceNote env n1 n2 &&& eq_ifaceExpr env r1 r2
-
-eq_ifaceExpr env (IfaceCase s1 b1 ty1 as1) (IfaceCase s2 b2 ty2 as2)
-  = eq_ifaceExpr env s1 s2 &&&
-    eq_ifType env ty1 ty2 &&&
-    eq_ifNakedBndr env b1 b2 (\env -> eqListBy (eq_ifaceAlt env) as1 as2)
+freeNamesIfExpr (IfaceLet (IfaceRec as) x)
+  = fnList fn_pair as &&& freeNamesIfExpr x

   where
   where

-    eq_ifaceAlt env (c1,bs1,r1) (c2,bs2,r2)
-       = bool (eq_ifaceConAlt c1 c2) &&& 
-         eq_ifNakedBndrs env bs1 bs2 (\env -> eq_ifaceExpr env r1 r2)
+    fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs

 
 

-eq_ifaceExpr env (IfaceLet (IfaceNonRec b1 r1) x1) (IfaceLet (IfaceNonRec b2 r2) x2)
-  = eq_ifaceExpr env r1 r2 &&& eq_ifLetBndr env b1 b2 (\env -> eq_ifaceExpr env x1 x2)
+freeNamesIfExpr _ = emptyNameSet

 
 

-eq_ifaceExpr env (IfaceLet (IfaceRec as1) x1) (IfaceLet (IfaceRec as2) x2)
-  = eq_ifLetBndrs env bs1 bs2 (\env -> eqListBy (eq_ifaceExpr env) rs1 rs2 &&& eq_ifaceExpr env x1 x2)
-  where
-    (bs1,rs1) = unzip as1
-    (bs2,rs2) = unzip as2
-
-
-eq_ifaceExpr _ _ _ = NotEqual
-
------------------
-eq_ifaceConAlt :: IfaceConAlt -> IfaceConAlt -> Bool
-eq_ifaceConAlt IfaceDefault      IfaceDefault          = True
-eq_ifaceConAlt (IfaceDataAlt n1)  (IfaceDataAlt n2)    = n1==n2
-eq_ifaceConAlt (IfaceTupleAlt c1) (IfaceTupleAlt c2)   = c1==c2
-eq_ifaceConAlt (IfaceLitAlt l1)          (IfaceLitAlt l2)      = l1==l2
-eq_ifaceConAlt _ _ = False
-
------------------
-eq_ifaceNote :: EqEnv -> IfaceNote -> IfaceNote -> IfaceEq
-eq_ifaceNote _   (IfaceSCC c1)    (IfaceSCC c2)        = bool (c1==c2)
-eq_ifaceNote _   IfaceInlineMe    IfaceInlineMe        = Equal
-eq_ifaceNote _   (IfaceCoreNote s1) (IfaceCoreNote s2) = bool (s1==s2)
-eq_ifaceNote _   _ _ = NotEqual
-\end{code}
+freeNamesIfTc :: IfaceTyCon -> NameSet
+freeNamesIfTc (IfaceTc tc) = unitNameSet tc
+-- ToDo: shouldn't we include IfaceIntTc & co.?
+freeNamesIfTc _ = emptyNameSet

 
 

-\begin{code}
----------------------
-eqIfType :: IfaceType -> IfaceType -> IfaceEq
-eqIfType t1 t2 = eq_ifType emptyEqEnv t1 t2
-
--------------------
-eq_ifType :: EqEnv -> IfaceType -> IfaceType -> IfaceEq
-eq_ifType env (IfaceTyVar n1)         (IfaceTyVar n2)         = eqIfOcc env n1 n2
-eq_ifType env (IfaceAppTy s1 t1)      (IfaceAppTy s2 t2)      = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
-eq_ifType env (IfacePredTy st1)       (IfacePredTy st2)       = eq_ifPredType env st1 st2
-eq_ifType env (IfaceTyConApp tc1 ts1) (IfaceTyConApp tc2 ts2) = tc1 `eqIfTc` tc2 &&& eq_ifTypes env ts1 ts2
-eq_ifType env (IfaceForAllTy tv1 t1)  (IfaceForAllTy tv2 t2)  = eq_ifTvBndr env tv1 tv2 (\env -> eq_ifType env t1 t2)
-eq_ifType env (IfaceFunTy s1 t1)      (IfaceFunTy s2 t2)      = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
-eq_ifType _ _ _ = NotEqual
-
--------------------
-eq_ifTypes :: EqEnv -> [IfaceType] -> [IfaceType] -> IfaceEq
-eq_ifTypes env = eqListBy (eq_ifType env)
-
--------------------
-eq_ifContext :: EqEnv -> [IfacePredType] -> [IfacePredType] -> IfaceEq
-eq_ifContext env a b = eqListBy (eq_ifPredType env) a b
-
--------------------
-eq_ifPredType :: EqEnv -> IfacePredType -> IfacePredType -> IfaceEq
-eq_ifPredType env (IfaceClassP c1 tys1) (IfaceClassP c2 tys2) = c1 `eqIfExt` c2 &&&  eq_ifTypes env tys1 tys2
-eq_ifPredType env (IfaceIParam n1 ty1) (IfaceIParam n2 ty2)   = bool (n1 == n2) &&& eq_ifType env ty1 ty2
-eq_ifPredType _   _ _ = NotEqual
-
--------------------
-eqIfTc :: IfaceTyCon -> IfaceTyCon -> IfaceEq
-eqIfTc (IfaceTc tc1) (IfaceTc tc2) = tc1 `eqIfExt` tc2
-eqIfTc IfaceIntTc    IfaceIntTc           = Equal
-eqIfTc IfaceCharTc   IfaceCharTc   = Equal
-eqIfTc IfaceBoolTc   IfaceBoolTc   = Equal
-eqIfTc IfaceListTc   IfaceListTc   = Equal
-eqIfTc IfacePArrTc   IfacePArrTc   = Equal
-eqIfTc (IfaceTupTc bx1 ar1) (IfaceTupTc bx2 ar2) = bool (bx1==bx2 && ar1==ar2)
-eqIfTc IfaceLiftedTypeKindTc   IfaceLiftedTypeKindTc   = Equal
-eqIfTc IfaceOpenTypeKindTc     IfaceOpenTypeKindTc     = Equal
-eqIfTc IfaceUnliftedTypeKindTc IfaceUnliftedTypeKindTc = Equal
-eqIfTc IfaceUbxTupleKindTc     IfaceUbxTupleKindTc     = Equal
-eqIfTc IfaceArgTypeKindTc      IfaceArgTypeKindTc      = Equal
-eqIfTc _                      _                       = NotEqual
-\end{code}
+freeNamesIfCo :: IfaceCoCon -> NameSet
+freeNamesIfCo (IfaceCoAx tc) = unitNameSet tc
+freeNamesIfCo _ = emptyNameSet

 
 

------------------------------------------------------------
-       Support code for equality checking
------------------------------------------------------------
+freeNamesIfRule :: IfaceRule -> NameSet
+freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
+                           , ifRuleArgs = es, ifRuleRhs = rhs })
+  = unitNameSet f &&&
+    fnList freeNamesIfBndr bs &&&
+    fnList freeNamesIfExpr es &&&
+    freeNamesIfExpr rhs

 
 

-\begin{code}
-------------------------------------
-type EqEnv = UniqFM FastString -- Tracks the mapping from L-variables to R-variables
-
-eqIfOcc :: EqEnv -> FastString -> FastString -> IfaceEq
-eqIfOcc env n1 n2 = case lookupUFM env n1 of
-                       Just n1 -> bool (n1 == n2)
-                       Nothing -> bool (n1 == n2)
-
-extendEqEnv :: EqEnv -> FastString -> FastString -> EqEnv
-extendEqEnv env n1 n2 | n1 == n2  = env
-                     | otherwise = addToUFM env n1 n2
-
-emptyEqEnv :: EqEnv
-emptyEqEnv = emptyUFM
-
-------------------------------------
-type ExtEnv bndr = EqEnv -> bndr -> bndr -> (EqEnv -> IfaceEq) -> IfaceEq
-
-eq_ifNakedBndr :: ExtEnv FastString
-eq_ifBndr      :: ExtEnv IfaceBndr
-eq_ifTvBndr    :: ExtEnv IfaceTvBndr
-eq_ifIdBndr    :: ExtEnv IfaceIdBndr
-
-eq_ifNakedBndr env n1 n2 k = k (extendEqEnv env n1 n2)
-
-eq_ifBndr env (IfaceIdBndr b1) (IfaceIdBndr b2) k = eq_ifIdBndr env b1 b2 k
-eq_ifBndr env (IfaceTvBndr b1) (IfaceTvBndr b2) k = eq_ifTvBndr env b1 b2 k
-eq_ifBndr _ _ _ _ = NotEqual
-
-eq_ifTvBndr env (v1, k1) (v2, k2) k = eq_ifType env k1 k2 &&& k (extendEqEnv env v1 v2)
-eq_ifIdBndr env (v1, t1) (v2, t2) k = eq_ifType env t1 t2 &&& k (extendEqEnv env v1 v2)
-
-eq_ifLetBndr :: EqEnv -> IfaceLetBndr -> IfaceLetBndr -> (EqEnv -> IfaceEq)
-             -> IfaceEq
-eq_ifLetBndr env (IfLetBndr v1 t1 i1) (IfLetBndr v2 t2 i2) k 
-  = eq_ifType env t1 t2 &&& eqIfIdInfo i1 i2 &&& k (extendEqEnv env v1 v2)
-
-eq_ifBndrs     :: ExtEnv [IfaceBndr]
-eq_ifLetBndrs  :: ExtEnv [IfaceLetBndr]
-eq_ifTvBndrs   :: ExtEnv [IfaceTvBndr]
-eq_ifNakedBndrs :: ExtEnv [FastString]
-eq_ifBndrs     = eq_bndrs_with eq_ifBndr
-eq_ifTvBndrs   = eq_bndrs_with eq_ifTvBndr
-eq_ifNakedBndrs = eq_bndrs_with eq_ifNakedBndr
-eq_ifLetBndrs   = eq_bndrs_with eq_ifLetBndr
-
--- eq_bndrs_with :: (a -> a -> IfaceEq) -> ExtEnv a
-eq_bndrs_with :: ExtEnv a -> ExtEnv [a]
-eq_bndrs_with _  env []       []       k = k env
-eq_bndrs_with eq env (b1:bs1) (b2:bs2) k = eq env b1 b2 (\env -> eq_bndrs_with eq env bs1 bs2 k)
-eq_bndrs_with _  _   _       _        _ = NotEqual
-\end{code}
+-- helpers
+(&&&) :: NameSet -> NameSet -> NameSet
+(&&&) = unionNameSets

 
 

-\begin{code}
-eqListBy :: (a->a->IfaceEq) -> [a] -> [a] -> IfaceEq
-eqListBy _  []     []     = Equal
-eqListBy eq (x:xs) (y:ys) = eq x y &&& eqListBy eq xs ys
-eqListBy _  _      _      = NotEqual
-
-eqMaybeBy :: (a->a->IfaceEq) -> Maybe a -> Maybe a -> IfaceEq
-eqMaybeBy _  Nothing  Nothing  = Equal
-eqMaybeBy eq (Just x) (Just y) = eq x y
-eqMaybeBy _  _        _        = NotEqual
+fnList :: (a -> NameSet) -> [a] -> NameSet
+fnList f = foldr (&&&) emptyNameSet . map f

 \end{code}
 \end{code}

+
+Note [Tracking data constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In a case expression
+   case e of { C a -> ...; ... }
+You might think that we don't need to include the datacon C
+in the free names, because its type will probably show up in
+the free names of 'e'.  But in rare circumstances this may
+not happen.   Here's the one that bit me:
+
+   module DynFlags where
+     import {-# SOURCE #-} Packages( PackageState )
+     data DynFlags = DF ... PackageState ...
+
+   module Packages where
+     import DynFlags
+     data PackageState = PS ...
+     lookupModule (df :: DynFlags)
+        = case df of
+              DF ...p... -> case p of
+                               PS ... -> ...
+
+Now, lookupModule depends on DynFlags, but the transitive dependency
+on the *locally-defined* type PackageState is not visible. We need
+to take account of the use of the data constructor PS in the pattern match.
+