projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Remove the hasGenerics field of TyCon, improve the way the Generics flags is handled...
[ghc-hetmet.git] / compiler / iface / IfaceSyn.lhs
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 9bea260..ea1ace8 100644 (file)
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -9,8 +9,10 @@ module IfaceSyn (
 
        IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
        IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
 
        IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
        IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
-       IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..),
-       IfaceInfoItem(..), IfaceRule(..), IfaceInst(..), IfaceFamInst(..),
+       IfaceBinding(..), IfaceConAlt(..), 
+       IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
+       IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
+       IfaceInst(..), IfaceFamInst(..),
 
        -- Misc
         ifaceDeclSubBndrs, visibleIfConDecls,
 
        -- Misc
         ifaceDeclSubBndrs, visibleIfConDecls,
@@ -24,24 +26,23 @@ module IfaceSyn (
 
 #include "HsVersions.h"
 
 
 #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 NameSet 
 import Name
 import CostCentre
 import Literal
 import ForeignCall
 import Class
 import NameSet 
 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 &&&
 \end{code}
 
 infixl 3 &&&
 \end{code}
 
@@ -54,9 +55,10 @@ infixl 3 &&&
 
 \begin{code}
 data IfaceDecl 
 
 \begin{code}
 data IfaceDecl 
-  = IfaceId { ifName   :: OccName,
-             ifType   :: IfaceType, 
-             ifIdInfo :: IfaceIdInfo }
+  = IfaceId { ifName             :: OccName,
+             ifType      :: IfaceType, 
+             ifIdDetails :: IfaceIdDetails,
+             ifIdInfo    :: IfaceIdInfo }
 
   | IfaceData { ifName       :: OccName,       -- Type constructor
                ifTyVars     :: [IfaceTvBndr],  -- Type variables
 
   | IfaceData { ifName       :: OccName,       -- Type constructor
                ifTyVars     :: [IfaceTvBndr],  -- Type variables
@@ -65,14 +67,6 @@ data IfaceDecl
                ifRec        :: RecFlag,        -- Recursive or not?
                ifGadtSyntax :: Bool,           -- True <=> declared using
                                                -- GADT syntax 
                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 
                 ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
                                                 -- Just <=> instance of family
                                                 -- Invariant: 
                 ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
                                                 -- Just <=> instance of family
                                                 -- Invariant: 
@@ -82,11 +76,10 @@ data IfaceDecl
 
   | IfaceSyn  {        ifName    :: OccName,           -- Type constructor
                ifTyVars  :: [IfaceTvBndr],     -- Type variables
 
   | 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])
+               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
@@ -105,7 +98,7 @@ data IfaceDecl
                                                 -- beyond .NET
                   ifExtName :: Maybe FastString }
 
                                                 -- beyond .NET
                   ifExtName :: Maybe FastString }
 
-data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
+data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
        -- Nothing    => no default method
        -- Just False => ordinary polymorphic default method
        -- Just True  => generic default method
        -- Nothing    => no default method
        -- Just False => ordinary polymorphic default method
        -- Just True  => generic default method
@@ -125,6 +118,7 @@ visibleIfConDecls (IfNewTyCon c)   = [c]
 data IfaceConDecl 
   = IfCon {
        ifConOcc     :: OccName,                -- Constructor name
 data IfaceConDecl 
   = IfCon {
        ifConOcc     :: OccName,                -- Constructor name
+       ifConWrapper :: Bool,                   -- True <=> has a wrapper
        ifConInfix   :: Bool,                   -- True <=> declared infix
        ifConUnivTvs :: [IfaceTvBndr],          -- Universal tyvars
        ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
        ifConInfix   :: Bool,                   -- True <=> declared infix
        ifConUnivTvs :: [IfaceTvBndr],          -- Universal tyvars
        ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
@@ -132,13 +126,13 @@ data IfaceConDecl
        ifConCtxt    :: IfaceContext,           -- Non-stupid context
        ifConArgTys  :: [IfaceType],            -- Arg types
        ifConFields  :: [OccName],              -- ...ditto... (field labels)
        ifConCtxt    :: IfaceContext,           -- Non-stupid context
        ifConArgTys  :: [IfaceType],            -- Arg types
        ifConFields  :: [OccName],              -- ...ditto... (field labels)
-       ifConStricts :: [StrictnessMark]}       -- Empty (meaning all lazy),
+       ifConStricts :: [HsBang]}               -- Empty (meaning all lazy),
                                                -- or 1-1 corresp with arg tys
 
 data IfaceInst 
                                                -- or 1-1 corresp with arg tys
 
 data IfaceInst 
-  = IfaceInst { ifInstCls  :: Name,                    -- See comments with
+  = IfaceInst { ifInstCls  :: IfExtName,               -- See comments with
                ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance
                ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance
-               ifDFun     :: Name,                     -- The dfun
+               ifDFun     :: IfExtName,                -- The dfun
                ifOFlag    :: OverlapFlag,              -- Overlap flag
                ifInstOrph :: Maybe OccName }           -- See Note [Orphans]
        -- There's always a separate IfaceDecl for the DFun, which gives 
                ifOFlag    :: OverlapFlag,              -- Overlap flag
                ifInstOrph :: Maybe OccName }           -- See Note [Orphans]
        -- There's always a separate IfaceDecl for the DFun, which gives 
@@ -149,7 +143,7 @@ data IfaceInst
        -- and if the head does not change it won't be used if it wasn't before
 
 data IfaceFamInst
        -- and if the head does not change it won't be used if it wasn't before
 
 data IfaceFamInst
-  = IfaceFamInst { ifFamInstFam   :: Name                -- Family tycon
+  = IfaceFamInst { ifFamInstFam   :: IfExtName                -- Family tycon
                 , ifFamInstTys   :: [Maybe IfaceTyCon]  -- Rough match types
                 , ifFamInstTyCon :: IfaceTyCon          -- Instance decl
                 }
                 , ifFamInstTys   :: [Maybe IfaceTyCon]  -- Rough match types
                 , ifFamInstTyCon :: IfaceTyCon          -- Instance decl
                 }
@@ -159,12 +153,31 @@ data IfaceRule
        ifRuleName   :: RuleName,
        ifActivation :: Activation,
        ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
        ifRuleName   :: RuleName,
        ifActivation :: Activation,
        ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
-       ifRuleHead   :: Name,           -- Head of lhs
+       ifRuleHead   :: IfExtName,      -- Head of lhs
        ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
        ifRuleRhs    :: IfaceExpr,
        ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
        ifRuleRhs    :: IfaceExpr,
+       ifRuleAuto   :: Bool,
        ifRuleOrph   :: Maybe OccName   -- Just like IfaceInst
     }
 
        ifRuleOrph   :: Maybe OccName   -- Just like IfaceInst
     }
 
+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
   = NoInfo                     -- When writing interface file without -O
   | HasInfo [IfaceInfoItem]    -- Has info, and here it is
 data IfaceIdInfo
   = NoInfo                     -- When writing interface file without -O
   | HasInfo [IfaceInfoItem]    -- Has info, and here it is
@@ -182,25 +195,41 @@ data IfaceIdInfo
 data IfaceInfoItem
   = HsArity     Arity
   | HsStrictness StrictSig
 data IfaceInfoItem
   = HsArity     Arity
   | 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
   | IfaceTuple         Boxity [IfaceExpr]              -- Saturated; type arguments omitted
   | IfaceLam   IfaceBndr IfaceExpr
   | IfaceApp   IfaceExpr IfaceExpr
   | IfaceType   IfaceType
   | IfaceTuple         Boxity [IfaceExpr]              -- Saturated; type arguments omitted
   | IfaceLam   IfaceBndr IfaceExpr
   | IfaceApp   IfaceExpr IfaceExpr
-  | IfaceCase  IfaceExpr FastString IfaceType [IfaceAlt]
+  | IfaceCase  IfaceExpr IfLclName IfaceType [IfaceAlt]
   | IfaceLet   IfaceBinding  IfaceExpr
   | IfaceNote  IfaceNote IfaceExpr
   | IfaceCast   IfaceExpr IfaceCoercion
   | IfaceLet   IfaceBinding  IfaceExpr
   | IfaceNote  IfaceNote IfaceExpr
   | IfaceCast   IfaceExpr IfaceCoercion
@@ -209,16 +238,15 @@ data IfaceExpr
   | IfaceTick   Module Int
 
 data IfaceNote = IfaceSCC CostCentre
   | IfaceTick   Module Int
 
 data IfaceNote = IfaceSCC CostCentre
-              | IfaceInlineMe
                | IfaceCoreNote String
 
                | IfaceCoreNote String
 
-type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
-       -- Note: FastString, not IfaceBndr (and same with the case binder)
+type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
+       -- Note: IfLclName, not IfaceBndr (and same with the case binder)
        -- We reconstruct the kind/type of the thing from the context
        -- thus saving bulk in interface files
 
 data IfaceConAlt = IfaceDefault
        -- We reconstruct the kind/type of the thing from the context
        -- thus saving bulk in interface files
 
 data IfaceConAlt = IfaceDefault
-                | IfaceDataAlt Name
+                | IfaceDataAlt IfExtName
                 | IfaceTupleAlt Boxity
                 | IfaceLitAlt Literal
 
                 | IfaceTupleAlt Boxity
                 | IfaceLitAlt Literal
 
@@ -229,9 +257,16 @@ data IfaceBinding
 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
 -- It's used for *non-top-level* let/rec binders
 -- See Note [IdInfo on nested let-bindings]
 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
 -- It's used for *non-top-level* let/rec binders
 -- See Note [IdInfo on nested let-bindings]
-data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
+data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
 \end{code}
 
 \end{code}
 
+Note [Expose recursive functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For supercompilation we want to put *all* unfoldings in the interface
+file, even for functions that are recursive (or big).  So we need to
+know when an unfolding belongs to a loop-breaker so that we can refrain
+from inlining it (except during supercompilation).
+
 Note [IdInfo on nested let-bindings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Occasionally we want to preserve IdInfo on nested let bindings. The one
 Note [IdInfo on nested let-bindings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Occasionally we want to preserve IdInfo on nested let bindings. The one
@@ -239,10 +274,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
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -338,28 +371,22 @@ 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
-                                                 }),
+                                        IfCon { ifConOcc = con_occ }),
                               ifFamInst = famInst}) 
                               ifFamInst = famInst}) 
-  = -- fields (names of selectors)
-    fields ++ 
-    -- implicit coerion and (possibly) family instance coercion
+  =   -- 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,
                              ifCons = IfDataTyCon cons, 
                              ifFamInst = famInst})
     [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
+  =   -- (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
@@ -369,11 +396,8 @@ ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
          con_occ  = ifConOcc con_decl                  -- DataCon namespace
          wrap_occ = mkDataConWrapperOcc con_occ        -- Id namespace
          work_occ = mkDataConWorkerOcc con_occ         -- Id namespace
          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
+         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 })
 
 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, 
                               ifSigs = sigs, ifATs = ats })
@@ -419,29 +443,31 @@ instance Outputable IfaceDecl where
   ppr = pprIfaceDecl
 
 pprIfaceDecl :: IfaceDecl -> SDoc
   ppr = pprIfaceDecl
 
 pprIfaceDecl :: IfaceDecl -> SDoc
-pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
+pprIfaceDecl (IfaceId {ifName = var, ifType = ty, 
+                       ifIdDetails = details, ifIdInfo = info})
   = sep [ ppr var <+> dcolon <+> ppr ty, 
   = 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 (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
          nest 2 (ppr info) ]
 
 pprIfaceDecl (IfaceForeign {ifName = tycon})
   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
-                       ifOpenSyn = False, ifSynRhs = mono_ty, 
+                       ifSynRhs = Just mono_ty, 
                         ifFamInst = mbFamInst})
   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
        4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
                         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})
+                       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,
+pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context,
                         ifTyVars = tyvars, ifCons = condecls, 
                         ifRec = isrec, ifFamInst = mbFamInst})
   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
                         ifTyVars = tyvars, ifCons = condecls, 
                         ifRec = isrec, ifFamInst = mbFamInst})
   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
-       4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
+       4 (vcat [pprRec isrec, pp_condecls tycon condecls,
                pprFamily mbFamInst])
   where
     pp_nd = case condecls of
                pprFamily mbFamInst])
   where
     pp_nd = case condecls of
@@ -461,10 +487,6 @@ pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
 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
@@ -486,17 +508,21 @@ pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
 
 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
 pprIfaceConDecl tc
 
 pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
 pprIfaceConDecl tc
-       (IfCon { ifConOcc = name, ifConInfix = is_infix, 
+       (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,
         if is_infix then ptext (sLit "Infix") else empty,
                 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs, 
                 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys, 
                 ifConStricts = strs, ifConFields = fields })
   = 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 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 bang     = ppr bang
+        
     main_payload = ppr name <+> dcolon <+> 
                   pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 
     main_payload = ppr name <+> dcolon <+> 
                   pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 
@@ -516,7 +542,7 @@ instance Outputable IfaceRule where
                   ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs }) 
     = sep [hsep [doubleQuotes (ftext name), ppr act,
                 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
                   ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs }) 
     = sep [hsep [doubleQuotes (ftext name), ppr act,
                 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
-          nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
+          nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
                        ptext (sLit "=") <+> ppr rhs])
       ]
 
                        ptext (sLit "=") <+> ppr rhs])
       ]
 
@@ -546,6 +572,9 @@ ppr_rough (Just tc) = ppr tc
 instance Outputable IfaceExpr where
     ppr e = pprIfaceExpr noParens e
 
 instance Outputable IfaceExpr where
     ppr e = pprIfaceExpr noParens e
 
+pprParendIfaceExpr :: IfaceExpr -> SDoc
+pprParendIfaceExpr = pprIfaceExpr parens
+
 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
        -- The function adds parens in context that need
        -- an atomic value (e.g. function args)
 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
        -- The function adds parens in context that need
        -- an atomic value (e.g. function args)
@@ -581,7 +610,7 @@ pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
                  nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 
 pprIfaceExpr _       (IfaceCast expr co)
                  nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 
 pprIfaceExpr _       (IfaceCast expr co)
-  = sep [pprIfaceExpr parens expr,
+  = sep [pprParendIfaceExpr expr,
         nest 2 (ptext (sLit "`cast`")),
         pprParendIfaceType co]
 
         nest 2 (ptext (sLit "`cast`")),
         pprParendIfaceType co]
 
@@ -597,13 +626,13 @@ pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
                  ptext (sLit "} in"),
                  pprIfaceExpr noParens body])
 
                  ptext (sLit "} in"),
                  pprIfaceExpr noParens body])
 
-pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
+pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
 
 
-ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
+ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs, 
                              arrow <+> pprIfaceExpr noParens rhs]
 
 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs, 
                              arrow <+> pprIfaceExpr noParens rhs]
 
-ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
+ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 ppr_con_bs con bs                    = ppr con <+> hsep (map ppr bs)
   
 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 ppr_con_bs con bs                    = ppr con <+> hsep (map ppr bs)
   
@@ -614,13 +643,12 @@ ppr_bind (IfLetBndr b ty info, rhs)
 
 ------------------
 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
 
 ------------------
 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
-pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
-pprIfaceApp fun                       args = sep (pprIfaceExpr parens fun : args)
+pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args)
+pprIfaceApp fun                       args = sep (pprParendIfaceExpr fun : args)
 
 ------------------
 instance Outputable IfaceNote where
     ppr (IfaceSCC cc)     = pprCostCentreCore cc
 
 ------------------
 instance Outputable IfaceNote where
     ppr (IfaceSCC cc)     = pprCostCentreCore cc
-    ppr IfaceInlineMe     = ptext (sLit "__inline_me")
     ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
 
 
     ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
 
 
@@ -632,19 +660,35 @@ instance Outputable IfaceConAlt where
     -- 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 HsNoCafRefs       = ptext (sLit "HasNoCafRefs")
   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
   ppr HsNoCafRefs       = ptext (sLit "HasNoCafRefs")
-  ppr (HsWorker w a)    = ptext (sLit "Worker:") <+> ppr w <+> int a
 
 
+instance Outputable IfaceUnfolding where
+  ppr (IfCompulsory e)     = ptext (sLit "<compulsory>") <+> parens (ppr e)
+  ppr (IfCoreUnfold s e)   = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
+  ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
+                                       pprParendIfaceExpr e]
+  ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
+                             <+> parens (ptext (sLit "arity") <+> int a)
+  ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
+                             <+> parens (ptext (sLit "arity") <+> int a)
+  ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:")
+                             <+> brackets (pprWithCommas ppr ns)
 
 -- -----------------------------------------------------------------------------
 -- Finding the Names in IfaceSyn
 
 -- -----------------------------------------------------------------------------
 -- Finding the Names in IfaceSyn
@@ -657,9 +701,10 @@ instance Outputable IfaceInfoItem 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 i) = 
+freeNamesIfDecl (IfaceId _s t d i) = 
   freeNamesIfType t &&&
   freeNamesIfType t &&&
-  freeNamesIfIdInfo i
+  freeNamesIfIdInfo i &&&
+  freeNamesIfIdDetails d
 freeNamesIfDecl IfaceForeign{} = 
   emptyNameSet
 freeNamesIfDecl d@IfaceData{} =
 freeNamesIfDecl IfaceForeign{} = 
   emptyNameSet
 freeNamesIfDecl d@IfaceData{} =
@@ -669,7 +714,7 @@ freeNamesIfDecl d@IfaceData{} =
   freeNamesIfConDecls (ifCons d)
 freeNamesIfDecl d@IfaceSyn{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
   freeNamesIfConDecls (ifCons d)
 freeNamesIfDecl d@IfaceSyn{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
-  freeNamesIfType    (ifSynRhs d) &&&
+  freeNamesIfSynRhs (ifSynRhs d) &&&
   freeNamesIfTcFam (ifFamInst d)
 freeNamesIfDecl d@IfaceClass{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
   freeNamesIfTcFam (ifFamInst d)
 freeNamesIfDecl d@IfaceClass{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
@@ -677,7 +722,15 @@ freeNamesIfDecl d@IfaceClass{} =
   freeNamesIfDecls   (ifATs d) &&&
   fnList freeNamesIfClsSig (ifSigs d)
 
   freeNamesIfDecls   (ifATs d) &&&
   fnList freeNamesIfClsSig (ifSigs d)
 
+freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
+freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
+freeNamesIfIdDetails _                 = emptyNameSet
+
 -- 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 :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
 freeNamesIfTcFam (Just (tc,tys)) = 
   freeNamesIfTc tc &&& fnList freeNamesIfType tys
@@ -727,53 +780,86 @@ freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
 freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
 
 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
 
 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
 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
 freeNamesIfIdInfo NoInfo = emptyNameSet
 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 
 freeNamesItem :: IfaceInfoItem -> NameSet
-freeNamesItem (HsUnfold u)     = freeNamesIfExpr u
-freeNamesItem (HsWorker wkr _) = unitNameSet wkr
-freeNamesItem _                = emptyNameSet
+freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
+freeNamesItem _              = emptyNameSet
+
+freeNamesIfUnfold :: IfaceUnfolding -> NameSet
+freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e
+freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
+freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
+freeNamesIfUnfold (IfExtWrapper _ v)     = unitNameSet v
+freeNamesIfUnfold (IfLclWrapper {})      = emptyNameSet
+freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr (dfunArgExprs vs)
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
 freeNamesIfExpr (IfaceExt v)     = unitNameSet v
 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
 freeNamesIfExpr (IfaceExt v)     = unitNameSet v
 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
 freeNamesIfExpr (IfaceType ty)    = freeNamesIfType ty
 freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
-freeNamesIfExpr (IfaceLam _ body) = freeNamesIfExpr body
+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 _ ty alts)
 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 _ ty alts)
-  = freeNamesIfExpr s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
+  = freeNamesIfExpr s 
+    &&& fnList fn_alt alts &&& fn_cons alts
+    &&& freeNamesIfType ty
   where
   where
-    -- no need to look at the constructor, because we'll already have its
-    -- parent recorded by the type on the case expression.
-    freeNamesIfaceAlt (_con,_bs,r) = freeNamesIfExpr r
+    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
 
 
-freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
-  = freeNamesIfExpr r &&& freeNamesIfExpr x
+freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
+  = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
 
 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
 
 freeNamesIfExpr (IfaceLet (IfaceRec as) x)
-  = fnList freeNamesIfExpr (map snd as) &&& freeNamesIfExpr x
+  = fnList fn_pair as &&& freeNamesIfExpr x
+  where
+    fn_pair (bndr, rhs) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs
 
 freeNamesIfExpr _ = emptyNameSet
 
 
 freeNamesIfExpr _ = emptyNameSet
 
-
 freeNamesIfTc :: IfaceTyCon -> NameSet
 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 -- ToDo: shouldn't we include IfaceIntTc & co.?
 freeNamesIfTc _ = emptyNameSet
 
 freeNamesIfRule :: IfaceRule -> NameSet
 freeNamesIfTc :: IfaceTyCon -> NameSet
 freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 -- ToDo: shouldn't we include IfaceIntTc & co.?
 freeNamesIfTc _ = emptyNameSet
 
 freeNamesIfRule :: IfaceRule -> NameSet
-freeNamesIfRule (IfaceRule _n _a _bs f es rhs _o)
-  = unitNameSet f &&& fnList freeNamesIfExpr es &&& freeNamesIfExpr rhs
+freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
+                           , ifRuleArgs = es, ifRuleRhs = rhs })
+  = unitNameSet f &&&
+    fnList freeNamesIfBndr bs &&&
+    fnList freeNamesIfExpr es &&&
+    freeNamesIfExpr rhs
 
 -- helpers
 (&&&) :: NameSet -> NameSet -> NameSet
 
 -- helpers
 (&&&) :: NameSet -> NameSet -> NameSet
@@ -782,3 +868,28 @@ freeNamesIfRule (IfaceRule _n _a _bs f es rhs _o)
 fnList :: (a -> NameSet) -> [a] -> NameSet
 fnList f = foldr (&&&) emptyNameSet . map f
 \end{code}
 fnList :: (a -> NameSet) -> [a] -> NameSet
 fnList f = foldr (&&&) emptyNameSet . map f
 \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.
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)