projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
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 f86f4b9..49fded9 100644 (file)
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -5,33 +5,34 @@
 
 \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(..), IfaceIdDetails(..), IfaceUnfolding(..),
-       IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
-       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,
 
         -- Free Names
         freeNamesIfDecl, freeNamesIfRule,
 
         ifaceDeclSubBndrs, visibleIfConDecls,
 
         -- Free Names
         freeNamesIfDecl, freeNamesIfRule,
 
-       -- Pretty printing
-       pprIfaceExpr, pprIfaceDeclHead 
+        -- Pretty printing
+        pprIfaceExpr, pprIfaceDeclHead
     ) where
 
 #include "HsVersions.h"
 
 import IfaceType
     ) where
 
 #include "HsVersions.h"
 
 import IfaceType
-
+import CoreSyn( DFunArg, dfunArgExprs )
+import PprCore()     -- Printing DFunArgs
 import Demand
 import Annotations
 import Class
 import Demand
 import Annotations
 import Class
-import NameSet 
+import NameSet
 import Name
 import CostCentre
 import Literal
 import Name
 import CostCentre
 import Literal
@@ -47,74 +48,67 @@ infixl 3 &&&
 
 
 %************************************************************************
 
 
 %************************************************************************
-%*                                                                     *
-               Data type declarations
-%*                                                                     *
+%*                                                                      *
+    Data type declarations
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
-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 
-               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
-               ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
-               ifSynRhs  :: Maybe IfaceType,   -- Just rhs for an ordinary synonyn
-                                               -- Nothing for an open family
+  | 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
     }
 
                 ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
                                                 -- 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 DefMethSpec 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
 
 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  = []
@@ -122,49 +116,49 @@ 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
-       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
+        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
   = IfaceFamInst { ifFamInstFam   :: IfExtName                -- Family tycon
 
 data IfaceFamInst
   = 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
+                 }
 
 data IfaceRule
 
 data IfaceRule
-  = 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
+  = 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
     }
 
 data IfaceAnnotation
@@ -183,83 +177,84 @@ 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
 
 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
   | HsInline     InlinePragma
   | HsStrictness StrictSig
   | HsInline     InlinePragma
-  | HsUnfold    Bool             -- True <=> isNonRuleLoopBreaker is true
-                IfaceUnfolding   -- See Note [Expose recursive functions] 
+  | HsUnfold     Bool             -- True <=> isNonRuleLoopBreaker is true
+                 IfaceUnfolding   -- See Note [Expose recursive functions]
   | HsNoCafRefs
 
 -- NB: Specialisations and rules come in separately and are
 -- only later attached to the Id.  Partial reason: some are orphans.
 
   | HsNoCafRefs
 
 -- NB: Specialisations and rules come in separately and are
 -- only later attached to the Id.  Partial reason: some are orphans.
 
-data IfaceUnfolding 
+data IfaceUnfolding
   = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
                                 -- Possibly could eliminate the Bool here, the information
                                 -- is also in the InlinePragma.
 
   = 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
+  | IfCompulsory IfaceExpr      -- Only used for default methods, in fact
 
   | IfInlineRule Arity          -- INLINE pragmas
 
   | IfInlineRule Arity          -- INLINE pragmas
-                 Bool          -- OK to inline even if *un*-saturated
-                Bool           -- OK to inline even if context is boring
-                 IfaceExpr 
+                 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.
+  | 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 [IfaceExpr]
+  | IfDFunUnfold [DFunArg IfaceExpr]
 
 --------------------------------
 data IfaceExpr
 
 --------------------------------
 data IfaceExpr
-  = IfaceLcl   IfLclName
+  = IfaceLcl    IfLclName
   | IfaceExt    IfExtName
   | IfaceType   IfaceType
   | IfaceExt    IfExtName
   | 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 IfLclName 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
                | IfaceCoreNote String
 
 type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
   | IfaceTick   Module Int
 
 data IfaceNote = IfaceSCC CostCentre
                | IfaceCoreNote String
 
 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
+        -- 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 IfExtName
-                | 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
 
 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
 -- It's used for *non-top-level* let/rec binders
@@ -298,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
@@ -314,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.)
@@ -341,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
@@ -355,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}
@@ -379,7 +374,7 @@ ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon}  = []
 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
                               ifCons = IfNewTyCon (
                                         IfCon { ifConOcc = con_occ }),
 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
                               ifCons = IfNewTyCon (
                                         IfCon { ifConOcc = con_occ }),
-                              ifFamInst = famInst}) 
+                              ifFamInst = famInst})
   =   -- implicit coerion and (possibly) family instance coercion
     (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
       -- data constructor and worker (newtypes don't have a wrapper)
   =   -- implicit coerion and (possibly) family instance coercion
     (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++
       -- data constructor and worker (newtypes don't have a wrapper)
@@ -387,8 +382,8 @@ ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 
 
 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 
 
 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
-                             ifCons = IfDataTyCon cons, 
-                             ifFamInst = famInst})
+                              ifCons = IfDataTyCon cons,
+                              ifFamInst = famInst})
   =   -- (possibly) family instance coercion;
       -- there is no implicit coercion for non-newtypes
     famInstCo famInst tc_occ
   =   -- (possibly) family instance coercion;
       -- there is no implicit coercion for non-newtypes
     famInstCo famInst tc_occ
@@ -397,20 +392,20 @@ ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
     ++ 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
-         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 })
+        | 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)
@@ -427,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 _ = []
@@ -450,54 +445,50 @@ instance Outputable IfaceDecl where
   ppr = pprIfaceDecl
 
 pprIfaceDecl :: IfaceDecl -> SDoc
   ppr = pprIfaceDecl
 
 pprIfaceDecl :: IfaceDecl -> SDoc
-pprIfaceDecl (IfaceId {ifName = var, ifType = ty, 
+pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
                        ifIdDetails = details, ifIdInfo = info})
                        ifIdDetails = details, ifIdInfo = info})
-  = sep [ ppr var <+> dcolon <+> ppr ty, 
-         nest 2 (ppr details),
-         nest 2 (ppr 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, 
-                       ifSynRhs = Just 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, 
-                       ifSynRhs = Nothing, ifSynKind = kind })
+pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
+                        ifSynRhs = Nothing, ifSynKind = kind })
   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
        4 (dcolon <+> ppr kind)
 
   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
        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
@@ -507,68 +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, ifConWrapper = has_wrap,
-                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 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))]
+         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
-    ppr_bang HsNoBang = char '_'       -- Want to see these
+    ppr_bang HsNoBang = char '_'        -- Want to see these
     ppr_bang bang     = ppr bang
     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] 
+    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]
 
 
-       -- 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 pprParendIfaceExpr 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
@@ -586,9 +577,11 @@ instance Outputable IfaceExpr where
 pprParendIfaceExpr :: IfaceExpr -> SDoc
 pprParendIfaceExpr = pprIfaceExpr parens
 
 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
@@ -596,114 +589,121 @@ 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)
   = sep [pprParendIfaceExpr expr,
                        <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") 
                        <+> ppr bndr <+> char '{',
                  nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 
 pprIfaceExpr _       (IfaceCast expr co)
   = sep [pprParendIfaceExpr expr,
-        nest 2 (ptext (sLit "`cast`")),
-        pprParendIfaceType co]
+         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 <+> pprParendIfaceExpr body)
+pprIfaceExpr add_par (IfaceNote note body) = add_par $ ppr note
+                                                <+> pprParendIfaceExpr body
 
 ppr_alt :: (IfaceConAlt, [IfLclName], 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 -> [IfLclName] -> SDoc
 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 
 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 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 (pprParendIfaceExpr arg) : args)
-pprIfaceApp fun                       args = sep (pprParendIfaceExpr 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 (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
 
 ------------------
 instance Outputable IfaceIdDetails where
     -- IfaceTupleAlt is handled by the case-alternative printer
 
 ------------------
 instance Outputable IfaceIdDetails where
-  ppr IfVanillaId    = empty
+  ppr IfVanillaId       = empty
   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
-                         <+> if b then ptext (sLit "<naughty>") else empty
-  ppr IfDFunId       = ptext (sLit "DFunId")
+                          <+> 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 "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}")
+  ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is
+                     <+> ptext (sLit "-}")
 
 instance Outputable IfaceInfoItem where
 
 instance Outputable IfaceInfoItem where
-  ppr (HsUnfold lb unf)  = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)")) 
+  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
                            <> 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 HsNoCafRefs        = ptext (sLit "HasNoCafRefs")
 
 instance Outputable IfaceUnfolding where
   ppr (IfCompulsory e)     = ptext (sLit "<compulsory>") <+> parens (ppr e)
 
 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 (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:")
   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 pprParendIfaceExpr ns)
-
+                             <+> brackets (pprWithCommas ppr ns)
 
 -- -----------------------------------------------------------------------------
 
 -- -----------------------------------------------------------------------------
--- Finding the Names in IfaceSyn
+-- | 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
 
 -- This is used for dependency analysis in MkIface, so that we
 -- fingerprint a declaration before the things that depend on it.  It
@@ -713,11 +713,11 @@ instance Outputable IfaceUnfolding where
 -- fingerprinting the instance, so DFuns are not dependencies.
 
 freeNamesIfDecl :: IfaceDecl -> NameSet
 -- fingerprinting the instance, so DFuns are not dependencies.
 
 freeNamesIfDecl :: IfaceDecl -> NameSet
-freeNamesIfDecl (IfaceId _s t d i) = 
+freeNamesIfDecl (IfaceId _s t d i) =
   freeNamesIfType t &&&
   freeNamesIfIdInfo i &&&
   freeNamesIfIdDetails d
   freeNamesIfType t &&&
   freeNamesIfIdInfo i &&&
   freeNamesIfIdDetails d
-freeNamesIfDecl IfaceForeign{} = 
+freeNamesIfDecl IfaceForeign{} =
   emptyNameSet
 freeNamesIfDecl d@IfaceData{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
   emptyNameSet
 freeNamesIfDecl d@IfaceData{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
@@ -744,7 +744,7 @@ freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
 freeNamesIfSynRhs Nothing   = emptyNameSet
 
 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
 freeNamesIfSynRhs Nothing   = emptyNameSet
 
 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
-freeNamesIfTcFam (Just (tc,tys)) = 
+freeNamesIfTcFam (Just (tc,tys)) =
   freeNamesIfTc tc &&& fnList freeNamesIfType tys
 freeNamesIfTcFam Nothing =
   emptyNameSet
   freeNamesIfTc tc &&& fnList freeNamesIfType tys
 freeNamesIfTcFam Nothing =
   emptyNameSet
@@ -764,15 +764,15 @@ freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
 freeNamesIfConDecls _               = emptyNameSet
 
 freeNamesIfConDecl :: IfaceConDecl -> NameSet
 freeNamesIfConDecls _               = emptyNameSet
 
 freeNamesIfConDecl :: IfaceConDecl -> NameSet
-freeNamesIfConDecl c = 
+freeNamesIfConDecl c =
   freeNamesIfTvBndrs (ifConUnivTvs c) &&&
   freeNamesIfTvBndrs (ifConExTvs c) &&&
   freeNamesIfTvBndrs (ifConUnivTvs c) &&&
   freeNamesIfTvBndrs (ifConExTvs c) &&&
-  freeNamesIfContext (ifConCtxt c) &&& 
+  freeNamesIfContext (ifConCtxt c) &&&
   fnList freeNamesIfType (ifConArgTys c) &&&
   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
 
 freeNamesIfPredType :: IfacePredType -> NameSet
   fnList freeNamesIfType (ifConArgTys c) &&&
   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
 
 freeNamesIfPredType :: IfacePredType -> NameSet
-freeNamesIfPredType (IfaceClassP cl tys) = 
+freeNamesIfPredType (IfaceClassP cl tys) =
    unitNameSet cl &&& fnList freeNamesIfType tys
 freeNamesIfPredType (IfaceIParam _n ty) =
    freeNamesIfType ty
    unitNameSet cl &&& fnList freeNamesIfType tys
 freeNamesIfPredType (IfaceIParam _n ty) =
    freeNamesIfType ty
@@ -783,11 +783,13 @@ freeNamesIfType :: IfaceType -> NameSet
 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
-freeNamesIfType (IfaceTyConApp tc ts) = 
+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
    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
 
 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
@@ -798,8 +800,10 @@ freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
 
 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
 -- Remember IfaceLetBndr is used only for *nested* bindings
 
 freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
 -- Remember IfaceLetBndr is used only for *nested* bindings
--- The cut-down IdInfo never contains any Names, but the type may!
-freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
+-- 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
 
 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
 freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
@@ -809,7 +813,7 @@ freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
 freeNamesIfIdBndr = freeNamesIfTvBndr
 
 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
 freeNamesIfIdBndr = freeNamesIfTvBndr
 
 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
-freeNamesIfIdInfo NoInfo = emptyNameSet
+freeNamesIfIdInfo NoInfo      = emptyNameSet
 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 
 freeNamesItem :: IfaceInfoItem -> NameSet
 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 
 freeNamesItem :: IfaceInfoItem -> NameSet
@@ -822,31 +826,31 @@ freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
 freeNamesIfUnfold (IfExtWrapper _ v)     = unitNameSet v
 freeNamesIfUnfold (IfLclWrapper {})      = emptyNameSet
 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
 freeNamesIfUnfold (IfExtWrapper _ v)     = unitNameSet v
 freeNamesIfUnfold (IfLclWrapper {})      = emptyNameSet
-freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr vs
+freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr (dfunArgExprs vs)
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
-freeNamesIfExpr (IfaceExt v)     = unitNameSet v
+freeNamesIfExpr (IfaceExt v)      = unitNameSet v
 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
 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 (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 (IfaceNote _n r)  = freeNamesIfExpr r
 
 
-freeNamesIfExpr (IfaceCase s _ ty alts)
+freeNamesIfExpr (IfaceCase s _ alts)
   = freeNamesIfExpr s 
     &&& fnList fn_alt alts &&& fn_cons alts
   = freeNamesIfExpr s 
     &&& fnList fn_alt alts &&& fn_cons alts
-    &&& freeNamesIfType ty
   where
     fn_alt (_con,_bs,r) = freeNamesIfExpr r
 
     -- Depend on the data constructors.  Just one will do!
     -- Note [Tracking data constructors]
   where
     fn_alt (_con,_bs,r) = freeNamesIfExpr r
 
     -- Depend on the data constructors.  Just one will do!
     -- Note [Tracking data constructors]
-    fn_cons []                              = emptyNameSet
-    fn_cons ((IfaceDefault    ,_,_) : alts) = fn_cons alts
-    fn_cons ((IfaceDataAlt con,_,_) : _   ) = unitNameSet con    
-    fn_cons (_                      : _   ) = emptyNameSet
+    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
 
 freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
   = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
@@ -858,12 +862,15 @@ 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
 
 freeNamesIfTc :: IfaceTyCon -> NameSet
 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 -- ToDo: shouldn't we include IfaceIntTc & co.?
 freeNamesIfTc _ = emptyNameSet
 
+freeNamesIfCo :: IfaceCoCon -> NameSet
+freeNamesIfCo (IfaceCoAx tc) = unitNameSet tc
+freeNamesIfCo _ = emptyNameSet
+
 freeNamesIfRule :: IfaceRule -> NameSet
 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
                            , ifRuleArgs = es, ifRuleRhs = rhs })
 freeNamesIfRule :: IfaceRule -> NameSet
 freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
                            , ifRuleArgs = es, ifRuleRhs = rhs })
@@ -882,18 +889,18 @@ fnList f = foldr (&&&) emptyNameSet . map f
 
 Note [Tracking data constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 Note [Tracking data constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In a case expression 
+In a case expression
    case e of { C a -> ...; ... }
 You might think that we don't need to include the datacon C
    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 
+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:
 
 the free names of 'e'.  But in rare circumstances this may
 not happen.   Here's the one that bit me:
 
-   module DynFlags where 
+   module DynFlags where
      import {-# SOURCE #-} Packages( PackageState )
      data DynFlags = DF ... PackageState ...
 
      import {-# SOURCE #-} Packages( PackageState )
      data DynFlags = DF ... PackageState ...
 
-   module Packages where 
+   module Packages where
      import DynFlags
      data PackageState = PS ...
      lookupModule (df :: DynFlags)
      import DynFlags
      data PackageState = PS ...
      lookupModule (df :: DynFlags)
@@ -904,3 +911,4 @@ not happen.   Here's the one that bit me:
 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.
 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.
+
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)