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,
#include "HsVersions.h"
-import CoreSyn
import IfaceType
-import NewDemand
+import Demand
+import Annotations
import Class
import NameSet
import Name
import CostCentre
import Literal
import ForeignCall
+import Serialized
import BasicTypes
import Outputable
import FastString
import Module
-import Data.List
-import Data.Maybe
-
infixl 3 &&&
\end{code}
\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
| 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
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
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
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
+
data IfaceIdInfo
= NoInfo -- When writing interface file without -O
| HasInfo [IfaceInfoItem] -- Has info, and here it is
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
- | 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.
+data IfaceUnfolding
+ = IfCoreUnfold IfaceExpr
+ | IfCompulsory IfaceExpr -- Only used for default methods, in fact
+
+ | IfInlineRule Arity
+ Bool -- OK to inline even if *un*-saturated
+ Bool -- OK to inline even if context is boring
+ IfaceExpr
+
+ | IfWrapper Arity Name -- NB: we need a Name (not just OccName) because the worker
+ -- can simplify to a function in another module.
+
+ | IfDFunUnfold [IfaceExpr]
+
--------------------------------
data IfaceExpr
= IfaceLcl FastString
| IfaceTick Module Int
data IfaceNote = IfaceSCC CostCentre
- | IfaceInlineMe
| IfaceCoreNote String
type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
\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
-- Newtype
ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
ifCons = IfNewTyCon (
- IfCon { ifConOcc = con_occ,
- ifConFields = fields
- }),
+ IfCon { ifConOcc = con_occ }),
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) ++
- -- 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})
- = -- 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
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 })
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,
+ 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,
- 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,
- ifOpenSyn = True, ifSynRhs = mono_ty})
+ ifSynRhs = Nothing, ifSynKind = kind })
= hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
- 4 (dcolon <+> ppr mono_ty)
+ 4 (dcolon <+> ppr kind)
pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
ifTyVars = tyvars, ifCons = condecls,
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,
- 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
+ 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
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])
]
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)
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]
ptext (sLit "} in"),
pprIfaceExpr noParens body])
-pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
+pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
------------------
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
- ppr IfaceInlineMe = ptext (sLit "__inline_me")
ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
-- 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 = ptext (sLit "DFunId")
+
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
- 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 (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 e) = parens (ppr e)
+ ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
+ pprParendIfaceExpr e]
+ ppr (IfWrapper a wkr) = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
+ ppr (IfDFunUnfold ns) = ptext (sLit "DFun:") <+> brackets (pprWithCommas pprParendIfaceExpr ns)
-- -----------------------------------------------------------------------------
-- fingerprinting the instance, so DFuns are not dependencies.
freeNamesIfDecl :: IfaceDecl -> NameSet
-freeNamesIfDecl (IfaceId _s t i) =
+freeNamesIfDecl (IfaceId _s t d i) =
freeNamesIfType t &&&
- freeNamesIfIdInfo i
+ freeNamesIfIdInfo i &&&
+ freeNamesIfIdDetails d
freeNamesIfDecl IfaceForeign{} =
emptyNameSet
freeNamesIfDecl d@IfaceData{} =
+ freeNamesIfTvBndrs (ifTyVars d) &&&
freeNamesIfTcFam (ifFamInst d) &&&
freeNamesIfContext (ifCtxt d) &&&
freeNamesIfConDecls (ifCons d)
freeNamesIfDecl d@IfaceSyn{} =
- freeNamesIfType (ifSynRhs d) &&&
+ freeNamesIfTvBndrs (ifTyVars d) &&&
+ freeNamesIfSynRhs (ifSynRhs d) &&&
freeNamesIfTcFam (ifFamInst d)
freeNamesIfDecl d@IfaceClass{} =
+ freeNamesIfTvBndrs (ifTyVars d) &&&
freeNamesIfContext (ifCtxt d) &&&
freeNamesIfDecls (ifATs d) &&&
fnList freeNamesIfClsSig (ifSigs d)
+freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
+freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
+freeNamesIfIdDetails _ = emptyNameSet
+
-- 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
freeNamesIfConDecl :: IfaceConDecl -> NameSet
freeNamesIfConDecl c =
+ freeNamesIfTvBndrs (ifConUnivTvs c) &&&
+ freeNamesIfTvBndrs (ifConExTvs c) &&&
freeNamesIfContext (ifConCtxt c) &&&
fnList freeNamesIfType (ifConArgTys c) &&&
fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st
freeNamesIfType (IfaceTyConApp tc ts) =
freeNamesIfTc tc &&& fnList freeNamesIfType ts
-freeNamesIfType (IfaceForAllTy _tv t) = freeNamesIfType t
+freeNamesIfType (IfaceForAllTy tv t) =
+ freeNamesIfTvBndr tv &&& freeNamesIfType t
freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
+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 cut-down IdInfo never contains any Names, but the type may!
+freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
+
+freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
+freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
+ -- kinds can have Names inside, when the Kind is an equality predicate
+
+freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
+freeNamesIfIdBndr = freeNamesIfTvBndr
+
freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
freeNamesIfIdInfo NoInfo = emptyNameSet
freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
freeNamesItem :: IfaceInfoItem -> NameSet
-freeNamesItem (HsUnfold u) = 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 (IfWrapper _ v) = unitNameSet v
+freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr 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 (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 s &&& freeNamesIfType ty &&& fnList freeNamesIfaceAlt alts
+ = freeNamesIfExpr s
+ &&& fnList fn_alt alts &&& fn_cons alts
+ &&& freeNamesIfType ty
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
-freeNamesIfExpr (IfaceLet (IfaceNonRec _bndr r) x)
- = freeNamesIfExpr r &&& freeNamesIfExpr x
+ -- 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 rhs) body)
+ = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
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
freeNamesIfTc _ = emptyNameSet
freeNamesIfRule :: IfaceRule -> NameSet
-freeNamesIfRule (IfaceRule _n _a _bs f es rhs _o)
- = unitNameSet f &&& fnList freeNamesIfExpr es &&& freeNamesIfExpr rhs
+freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
+ = unitNameSet f &&&
+ fnList freeNamesIfBndr bs &&&
+ fnList freeNamesIfExpr es &&&
+ freeNamesIfExpr rhs
-- helpers
(&&&) :: NameSet -> NameSet -> NameSet
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.
projects / ghc-hetmet.git / blobdiff